summaryrefslogtreecommitdiffstats
path: root/gnu
diff options
context:
space:
mode:
authormillert <millert@openbsd.org>1999-04-29 22:50:42 +0000
committermillert <millert@openbsd.org>1999-04-29 22:50:42 +0000
commit6345ca90897845000e1f48f7d44c6708faafc8fe (patch)
treee7174a5c6faa27f561efe81248738dbd85a405a2 /gnu
parentperl5.005_03 (diff)
downloadwireguard-openbsd-6345ca90897845000e1f48f7d44c6708faafc8fe.tar.xz
wireguard-openbsd-6345ca90897845000e1f48f7d44c6708faafc8fe.zip
perl5.005_03 (stock)
Diffstat (limited to 'gnu')
-rw-r--r--gnu/usr.bin/perl/Changes32898
-rw-r--r--gnu/usr.bin/perl/Configure4974
-rw-r--r--gnu/usr.bin/perl/EXTERN.h8
-rw-r--r--gnu/usr.bin/perl/INSTALL752
-rw-r--r--gnu/usr.bin/perl/INTERN.h13
-rw-r--r--gnu/usr.bin/perl/MANIFEST280
-rw-r--r--gnu/usr.bin/perl/Makefile.SH264
-rw-r--r--gnu/usr.bin/perl/Porting/Glossary1446
-rw-r--r--gnu/usr.bin/perl/Porting/makerel81
-rw-r--r--gnu/usr.bin/perl/Porting/patchls180
-rw-r--r--gnu/usr.bin/perl/Porting/pumpkin.pod247
-rw-r--r--gnu/usr.bin/perl/README15
-rw-r--r--gnu/usr.bin/perl/README.os2296
-rw-r--r--gnu/usr.bin/perl/README.vms644
-rw-r--r--gnu/usr.bin/perl/README.win321341
-rw-r--r--gnu/usr.bin/perl/Todo10
-rw-r--r--gnu/usr.bin/perl/XSUB.h126
-rw-r--r--gnu/usr.bin/perl/av.c432
-rw-r--r--gnu/usr.bin/perl/av.h11
-rw-r--r--gnu/usr.bin/perl/cflags.SH2
-rw-r--r--gnu/usr.bin/perl/compat3.sym46
-rw-r--r--gnu/usr.bin/perl/config.sh.OpenBSD543
-rw-r--r--gnu/usr.bin/perl/config_H1781
-rw-r--r--gnu/usr.bin/perl/config_h.SH1612
-rw-r--r--gnu/usr.bin/perl/configpm133
-rw-r--r--gnu/usr.bin/perl/configure127
-rw-r--r--gnu/usr.bin/perl/cop.h176
-rw-r--r--gnu/usr.bin/perl/cv.h45
-rw-r--r--gnu/usr.bin/perl/cygwin32/cw32imp.h1
-rw-r--r--gnu/usr.bin/perl/cygwin32/ld22
-rw-r--r--gnu/usr.bin/perl/cygwin32/perlgcc25
-rw-r--r--gnu/usr.bin/perl/cygwin32/perlld26
-rw-r--r--gnu/usr.bin/perl/deb.c110
-rw-r--r--gnu/usr.bin/perl/doio.c699
-rw-r--r--gnu/usr.bin/perl/doop.c126
-rw-r--r--gnu/usr.bin/perl/dosish.h60
-rw-r--r--gnu/usr.bin/perl/dump.c286
-rw-r--r--gnu/usr.bin/perl/eg/ADB2
-rw-r--r--gnu/usr.bin/perl/eg/cgi/RunMeFirst15
-rw-r--r--gnu/usr.bin/perl/eg/cgi/file_upload.cgi12
-rw-r--r--gnu/usr.bin/perl/eg/cgi/index.html13
-rw-r--r--gnu/usr.bin/perl/eg/cgi/monty.cgi11
-rw-r--r--gnu/usr.bin/perl/eg/cgi/save_state.cgi2
-rw-r--r--gnu/usr.bin/perl/eg/cgi/wilogo.gif.uu3
-rw-r--r--gnu/usr.bin/perl/eg/changes2
-rw-r--r--gnu/usr.bin/perl/eg/dus2
-rw-r--r--gnu/usr.bin/perl/eg/findcp2
-rw-r--r--gnu/usr.bin/perl/eg/findtar2
-rw-r--r--gnu/usr.bin/perl/eg/g/gcp2
-rw-r--r--gnu/usr.bin/perl/eg/g/gcp.man2
-rw-r--r--gnu/usr.bin/perl/eg/g/ged2
-rw-r--r--gnu/usr.bin/perl/eg/g/gsh2
-rw-r--r--gnu/usr.bin/perl/eg/g/gsh.man2
-rw-r--r--gnu/usr.bin/perl/eg/muck.man2
-rw-r--r--gnu/usr.bin/perl/eg/myrup2
-rw-r--r--gnu/usr.bin/perl/eg/nih2
-rw-r--r--gnu/usr.bin/perl/eg/relink6
-rw-r--r--gnu/usr.bin/perl/eg/rename6
-rw-r--r--gnu/usr.bin/perl/eg/rmfrom2
-rw-r--r--gnu/usr.bin/perl/eg/scan/scan_df2
-rw-r--r--gnu/usr.bin/perl/eg/scan/scan_last2
-rw-r--r--gnu/usr.bin/perl/eg/scan/scan_messages2
-rw-r--r--gnu/usr.bin/perl/eg/scan/scan_passwd2
-rw-r--r--gnu/usr.bin/perl/eg/scan/scan_ps2
-rw-r--r--gnu/usr.bin/perl/eg/scan/scan_sudo2
-rw-r--r--gnu/usr.bin/perl/eg/scan/scan_suid2
-rw-r--r--gnu/usr.bin/perl/eg/scan/scanner2
-rw-r--r--gnu/usr.bin/perl/eg/shmkill2
-rw-r--r--gnu/usr.bin/perl/eg/van/empty2
-rw-r--r--gnu/usr.bin/perl/eg/van/unvanish2
-rw-r--r--gnu/usr.bin/perl/eg/van/vanexp2
-rw-r--r--gnu/usr.bin/perl/eg/van/vanish2
-rw-r--r--gnu/usr.bin/perl/eg/wrapsuid6
-rw-r--r--gnu/usr.bin/perl/emacs/cperl-mode.el3936
-rw-r--r--gnu/usr.bin/perl/embed.h750
-rw-r--r--gnu/usr.bin/perl/embed.pl233
-rw-r--r--gnu/usr.bin/perl/ext/DB_File/DB_File.pm485
-rw-r--r--gnu/usr.bin/perl/ext/DB_File/DB_File.xs755
-rw-r--r--gnu/usr.bin/perl/ext/DB_File/Makefile.PL8
-rw-r--r--gnu/usr.bin/perl/ext/DB_File/typemap19
-rw-r--r--gnu/usr.bin/perl/ext/DynaLoader/Makefile.PL9
-rw-r--r--gnu/usr.bin/perl/ext/DynaLoader/dl_aix.xs107
-rw-r--r--gnu/usr.bin/perl/ext/DynaLoader/dl_cygwin32.xs10
-rw-r--r--gnu/usr.bin/perl/ext/DynaLoader/dl_dld.xs6
-rw-r--r--gnu/usr.bin/perl/ext/DynaLoader/dl_dlopen.xs2
-rw-r--r--gnu/usr.bin/perl/ext/DynaLoader/dl_hpux.xs7
-rw-r--r--gnu/usr.bin/perl/ext/DynaLoader/dl_next.xs11
-rw-r--r--gnu/usr.bin/perl/ext/DynaLoader/dl_vms.xs14
-rw-r--r--gnu/usr.bin/perl/ext/DynaLoader/dlutils.c16
-rw-r--r--gnu/usr.bin/perl/ext/Fcntl/Fcntl.pm70
-rw-r--r--gnu/usr.bin/perl/ext/Fcntl/Fcntl.xs163
-rw-r--r--gnu/usr.bin/perl/ext/GDBM_File/GDBM_File.pm2
-rw-r--r--gnu/usr.bin/perl/ext/GDBM_File/typemap4
-rw-r--r--gnu/usr.bin/perl/ext/IO/IO.pm2
-rw-r--r--gnu/usr.bin/perl/ext/IO/IO.xs23
-rw-r--r--gnu/usr.bin/perl/ext/IO/Makefile.PL2
-rw-r--r--gnu/usr.bin/perl/ext/IO/lib/IO/Handle.pm25
-rw-r--r--gnu/usr.bin/perl/ext/IO/lib/IO/Pipe.pm10
-rw-r--r--gnu/usr.bin/perl/ext/IO/lib/IO/Seekable.pm2
-rw-r--r--gnu/usr.bin/perl/ext/IO/lib/IO/Socket.pm4
-rw-r--r--gnu/usr.bin/perl/ext/IPC/SysV/Makefile.PL2
-rw-r--r--gnu/usr.bin/perl/ext/NDBM_File/NDBM_File.pm3
-rw-r--r--gnu/usr.bin/perl/ext/NDBM_File/typemap4
-rw-r--r--gnu/usr.bin/perl/ext/ODBM_File/ODBM_File.xs10
-rw-r--r--gnu/usr.bin/perl/ext/Opcode/Makefile.PL4
-rw-r--r--gnu/usr.bin/perl/ext/Opcode/Opcode.pm18
-rw-r--r--gnu/usr.bin/perl/ext/Opcode/Opcode.xs169
-rw-r--r--gnu/usr.bin/perl/ext/Opcode/Safe.pm22
-rw-r--r--gnu/usr.bin/perl/ext/Opcode/ops.pm2
-rw-r--r--gnu/usr.bin/perl/ext/POSIX/POSIX.pm122
-rw-r--r--gnu/usr.bin/perl/ext/POSIX/POSIX.pod19
-rw-r--r--gnu/usr.bin/perl/ext/POSIX/POSIX.xs351
-rw-r--r--gnu/usr.bin/perl/ext/SDBM_File/Makefile.PL27
-rw-r--r--gnu/usr.bin/perl/ext/SDBM_File/sdbm/Makefile.PL40
-rw-r--r--gnu/usr.bin/perl/ext/SDBM_File/sdbm/pair.c50
-rw-r--r--gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.c74
-rw-r--r--gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.h44
-rw-r--r--gnu/usr.bin/perl/ext/SDBM_File/typemap4
-rw-r--r--gnu/usr.bin/perl/ext/Socket/Socket.pm52
-rw-r--r--gnu/usr.bin/perl/ext/Socket/Socket.xs170
-rw-r--r--gnu/usr.bin/perl/ext/util/make_ext6
-rw-r--r--gnu/usr.bin/perl/form.h2
-rw-r--r--gnu/usr.bin/perl/global.sym245
-rw-r--r--gnu/usr.bin/perl/gv.c496
-rw-r--r--gnu/usr.bin/perl/gv.h13
-rw-r--r--gnu/usr.bin/perl/handy.h91
-rw-r--r--gnu/usr.bin/perl/hints/README.hints200
-rw-r--r--gnu/usr.bin/perl/hints/aix.sh65
-rw-r--r--gnu/usr.bin/perl/hints/amigaos.sh4
-rw-r--r--gnu/usr.bin/perl/hints/apollo.sh8
-rw-r--r--gnu/usr.bin/perl/hints/bsdos.sh13
-rw-r--r--gnu/usr.bin/perl/hints/dec_osf.sh63
-rw-r--r--gnu/usr.bin/perl/hints/dynixptx.sh49
-rw-r--r--gnu/usr.bin/perl/hints/freebsd.sh121
-rw-r--r--gnu/usr.bin/perl/hints/hpux.sh86
-rw-r--r--gnu/usr.bin/perl/hints/irix_4.sh11
-rw-r--r--gnu/usr.bin/perl/hints/irix_5.sh13
-rw-r--r--gnu/usr.bin/perl/hints/irix_6.sh123
-rw-r--r--gnu/usr.bin/perl/hints/irix_6_0.sh11
-rw-r--r--gnu/usr.bin/perl/hints/irix_6_1.sh11
-rw-r--r--gnu/usr.bin/perl/hints/isc.sh3
-rw-r--r--gnu/usr.bin/perl/hints/linux.sh62
-rw-r--r--gnu/usr.bin/perl/hints/machten.sh164
-rw-r--r--gnu/usr.bin/perl/hints/mpeix.sh164
-rw-r--r--gnu/usr.bin/perl/hints/netbsd.sh54
-rw-r--r--gnu/usr.bin/perl/hints/next_3.sh12
-rw-r--r--gnu/usr.bin/perl/hints/next_4.sh19
-rw-r--r--gnu/usr.bin/perl/hints/os2.sh72
-rw-r--r--gnu/usr.bin/perl/hints/os390.sh34
-rw-r--r--gnu/usr.bin/perl/hints/powerux.sh10
-rw-r--r--gnu/usr.bin/perl/hints/qnx.sh22
-rw-r--r--gnu/usr.bin/perl/hints/sco.sh279
-rw-r--r--gnu/usr.bin/perl/hints/solaris_2.sh166
-rw-r--r--gnu/usr.bin/perl/hints/sunos_4_1.sh10
-rw-r--r--gnu/usr.bin/perl/hints/svr4.sh143
-rw-r--r--gnu/usr.bin/perl/hints/ultrix_4.sh8
-rw-r--r--gnu/usr.bin/perl/hints/unicos.sh13
-rw-r--r--gnu/usr.bin/perl/hints/unicosmk.sh9
-rw-r--r--gnu/usr.bin/perl/hv.c599
-rw-r--r--gnu/usr.bin/perl/hv.h7
-rw-r--r--gnu/usr.bin/perl/installhtml2
-rw-r--r--gnu/usr.bin/perl/installman32
-rw-r--r--gnu/usr.bin/perl/installperl354
-rw-r--r--gnu/usr.bin/perl/interp.sym151
-rw-r--r--gnu/usr.bin/perl/keywords.h469
-rw-r--r--gnu/usr.bin/perl/keywords.pl3
-rw-r--r--gnu/usr.bin/perl/lib/AutoLoader.pm78
-rw-r--r--gnu/usr.bin/perl/lib/AutoSplit.pm394
-rw-r--r--gnu/usr.bin/perl/lib/Benchmark.pm194
-rw-r--r--gnu/usr.bin/perl/lib/CGI.pm3287
-rw-r--r--gnu/usr.bin/perl/lib/CGI/Apache.pm6
-rw-r--r--gnu/usr.bin/perl/lib/CGI/Carp.pm171
-rw-r--r--gnu/usr.bin/perl/lib/CGI/Fast.pm21
-rw-r--r--gnu/usr.bin/perl/lib/CGI/Push.pm118
-rw-r--r--gnu/usr.bin/perl/lib/CGI/Switch.pm11
-rw-r--r--gnu/usr.bin/perl/lib/CPAN.pm1986
-rw-r--r--gnu/usr.bin/perl/lib/CPAN/FirstTime.pm440
-rw-r--r--gnu/usr.bin/perl/lib/CPAN/Nox.pm4
-rw-r--r--gnu/usr.bin/perl/lib/Carp.pm172
-rw-r--r--gnu/usr.bin/perl/lib/Class/Struct.pm7
-rw-r--r--gnu/usr.bin/perl/lib/Cwd.pm141
-rw-r--r--gnu/usr.bin/perl/lib/English.pm9
-rw-r--r--gnu/usr.bin/perl/lib/Env.pm4
-rw-r--r--gnu/usr.bin/perl/lib/ExtUtils/Command.pm7
-rw-r--r--gnu/usr.bin/perl/lib/ExtUtils/Embed.pm34
-rw-r--r--gnu/usr.bin/perl/lib/ExtUtils/Install.pm93
-rw-r--r--gnu/usr.bin/perl/lib/ExtUtils/Liblist.pm285
-rw-r--r--gnu/usr.bin/perl/lib/ExtUtils/MM_OS2.pm38
-rw-r--r--gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm330
-rw-r--r--gnu/usr.bin/perl/lib/ExtUtils/MM_VMS.pm341
-rw-r--r--gnu/usr.bin/perl/lib/ExtUtils/MM_Win32.pm88
-rw-r--r--gnu/usr.bin/perl/lib/ExtUtils/MakeMaker.pm299
-rw-r--r--gnu/usr.bin/perl/lib/ExtUtils/Manifest.pm18
-rw-r--r--gnu/usr.bin/perl/lib/ExtUtils/Mkbootstrap.pm6
-rw-r--r--gnu/usr.bin/perl/lib/ExtUtils/Mksymlists.pm68
-rw-r--r--gnu/usr.bin/perl/lib/ExtUtils/testlib.pm4
-rw-r--r--gnu/usr.bin/perl/lib/ExtUtils/typemap44
-rw-r--r--gnu/usr.bin/perl/lib/ExtUtils/xsubpp216
-rw-r--r--gnu/usr.bin/perl/lib/File/Basename.pm23
-rw-r--r--gnu/usr.bin/perl/lib/File/CheckTree.pm6
-rw-r--r--gnu/usr.bin/perl/lib/File/Copy.pm25
-rw-r--r--gnu/usr.bin/perl/lib/File/DosGlob.pm69
-rw-r--r--gnu/usr.bin/perl/lib/File/Find.pm206
-rw-r--r--gnu/usr.bin/perl/lib/File/Path.pm29
-rw-r--r--gnu/usr.bin/perl/lib/FileHandle.pm6
-rw-r--r--gnu/usr.bin/perl/lib/FindBin.pm47
-rw-r--r--gnu/usr.bin/perl/lib/Getopt/Long.pm1566
-rw-r--r--gnu/usr.bin/perl/lib/Getopt/Std.pm27
-rw-r--r--gnu/usr.bin/perl/lib/IPC/Open3.pm72
-rw-r--r--gnu/usr.bin/perl/lib/Math/BigInt.pm35
-rw-r--r--gnu/usr.bin/perl/lib/Math/Complex.pm522
-rw-r--r--gnu/usr.bin/perl/lib/Math/Trig.pm264
-rw-r--r--gnu/usr.bin/perl/lib/Net/Ping.pm2
-rw-r--r--gnu/usr.bin/perl/lib/Net/hostent.pm2
-rw-r--r--gnu/usr.bin/perl/lib/Net/netent.pm2
-rw-r--r--gnu/usr.bin/perl/lib/Pod/Html.pm212
-rw-r--r--gnu/usr.bin/perl/lib/Pod/Text.pm14
-rw-r--r--gnu/usr.bin/perl/lib/SelfLoader.pm8
-rw-r--r--gnu/usr.bin/perl/lib/Symbol.pm37
-rw-r--r--gnu/usr.bin/perl/lib/Sys/Syslog.pm53
-rw-r--r--gnu/usr.bin/perl/lib/Term/Cap.pm2
-rw-r--r--gnu/usr.bin/perl/lib/Term/Complete.pm24
-rw-r--r--gnu/usr.bin/perl/lib/Term/ReadLine.pm48
-rw-r--r--gnu/usr.bin/perl/lib/Test/Harness.pm124
-rw-r--r--gnu/usr.bin/perl/lib/Text/ParseWords.pm300
-rw-r--r--gnu/usr.bin/perl/lib/Text/Soundex.pm6
-rw-r--r--gnu/usr.bin/perl/lib/Text/Wrap.pm143
-rw-r--r--gnu/usr.bin/perl/lib/Tie/Hash.pm6
-rw-r--r--gnu/usr.bin/perl/lib/Tie/SubstrHash.pm2
-rw-r--r--gnu/usr.bin/perl/lib/Time/Local.pm22
-rw-r--r--gnu/usr.bin/perl/lib/Time/gmtime.pm2
-rw-r--r--gnu/usr.bin/perl/lib/Time/localtime.pm2
-rw-r--r--gnu/usr.bin/perl/lib/User/grent.pm2
-rw-r--r--gnu/usr.bin/perl/lib/User/pwent.pm2
-rw-r--r--gnu/usr.bin/perl/lib/autouse.pm9
-rw-r--r--gnu/usr.bin/perl/lib/base.pm38
-rw-r--r--gnu/usr.bin/perl/lib/bigint.pl2
-rw-r--r--gnu/usr.bin/perl/lib/blib.pm1
-rw-r--r--gnu/usr.bin/perl/lib/constant.pm23
-rw-r--r--gnu/usr.bin/perl/lib/diagnostics.pm2
-rw-r--r--gnu/usr.bin/perl/lib/dumpvar.pl16
-rw-r--r--gnu/usr.bin/perl/lib/ftp.pl6
-rw-r--r--gnu/usr.bin/perl/lib/lib.pm4
-rw-r--r--gnu/usr.bin/perl/lib/overload.pm646
-rw-r--r--gnu/usr.bin/perl/lib/perl5db.pl443
-rw-r--r--gnu/usr.bin/perl/lib/strict.pm22
-rw-r--r--gnu/usr.bin/perl/lib/subs.pm2
-rw-r--r--gnu/usr.bin/perl/lib/vars.pm21
-rw-r--r--gnu/usr.bin/perl/makedepend.SH29
-rw-r--r--gnu/usr.bin/perl/malloc.c1511
-rw-r--r--gnu/usr.bin/perl/mg.c1195
-rw-r--r--gnu/usr.bin/perl/mg.h21
-rw-r--r--gnu/usr.bin/perl/miniperlmain.c40
-rw-r--r--gnu/usr.bin/perl/myconfig12
-rw-r--r--gnu/usr.bin/perl/op.c3429
-rw-r--r--gnu/usr.bin/perl/op.h103
-rw-r--r--gnu/usr.bin/perl/opcode.h2056
-rw-r--r--gnu/usr.bin/perl/opcode.pl761
-rw-r--r--gnu/usr.bin/perl/os2/Changes58
-rw-r--r--gnu/usr.bin/perl/os2/Makefile.SHs126
-rw-r--r--gnu/usr.bin/perl/os2/OS2/PrfDB/PrfDB.xs12
-rw-r--r--gnu/usr.bin/perl/os2/OS2/PrfDB/typemap2
-rw-r--r--gnu/usr.bin/perl/os2/OS2/Process/Makefile.PL5
-rw-r--r--gnu/usr.bin/perl/os2/OS2/Process/Process.pm185
-rw-r--r--gnu/usr.bin/perl/os2/OS2/Process/Process.xs232
-rw-r--r--gnu/usr.bin/perl/os2/OS2/REXX/REXX.xs18
-rw-r--r--gnu/usr.bin/perl/os2/diff.configure255
-rw-r--r--gnu/usr.bin/perl/os2/os2.c822
-rw-r--r--gnu/usr.bin/perl/os2/os2ish.h111
-rw-r--r--gnu/usr.bin/perl/os2/perl2cmd.pl2
-rw-r--r--gnu/usr.bin/perl/patchlevel.h14
-rw-r--r--gnu/usr.bin/perl/perl.c2463
-rw-r--r--gnu/usr.bin/perl/perl.h1367
-rw-r--r--gnu/usr.bin/perl/perl_exp.SH79
-rw-r--r--gnu/usr.bin/perl/perlio.c213
-rw-r--r--gnu/usr.bin/perl/perlio.h200
-rw-r--r--gnu/usr.bin/perl/perlsdio.h15
-rw-r--r--gnu/usr.bin/perl/perly.c2588
-rw-r--r--gnu/usr.bin/perl/perly.c.diff387
-rw-r--r--gnu/usr.bin/perl/perly.fixer26
-rw-r--r--gnu/usr.bin/perl/perly.h1
-rw-r--r--gnu/usr.bin/perl/perly.y78
-rw-r--r--gnu/usr.bin/perl/plan9/config.plan912
-rw-r--r--gnu/usr.bin/perl/plan9/plan9ish.h24
-rw-r--r--gnu/usr.bin/perl/pod/Makefile41
-rw-r--r--gnu/usr.bin/perl/pod/buildtoc13
-rw-r--r--gnu/usr.bin/perl/pod/checkpods.PL24
-rw-r--r--gnu/usr.bin/perl/pod/perl.pod190
-rw-r--r--gnu/usr.bin/perl/pod/perlapio.pod10
-rw-r--r--gnu/usr.bin/perl/pod/perlbook.pod37
-rw-r--r--gnu/usr.bin/perl/pod/perlcall.pod166
-rw-r--r--gnu/usr.bin/perl/pod/perldata.pod101
-rw-r--r--gnu/usr.bin/perl/pod/perldebug.pod595
-rw-r--r--gnu/usr.bin/perl/pod/perldelta.pod1873
-rw-r--r--gnu/usr.bin/perl/pod/perldiag.pod368
-rw-r--r--gnu/usr.bin/perl/pod/perldsc.pod14
-rw-r--r--gnu/usr.bin/perl/pod/perlembed.pod197
-rw-r--r--gnu/usr.bin/perl/pod/perlfaq.pod695
-rw-r--r--gnu/usr.bin/perl/pod/perlfaq1.pod218
-rw-r--r--gnu/usr.bin/perl/pod/perlfaq2.pod440
-rw-r--r--gnu/usr.bin/perl/pod/perlfaq3.pod413
-rw-r--r--gnu/usr.bin/perl/pod/perlfaq4.pod863
-rw-r--r--gnu/usr.bin/perl/pod/perlfaq5.pod617
-rw-r--r--gnu/usr.bin/perl/pod/perlfaq6.pod172
-rw-r--r--gnu/usr.bin/perl/pod/perlfaq7.pod211
-rw-r--r--gnu/usr.bin/perl/pod/perlfaq8.pod477
-rw-r--r--gnu/usr.bin/perl/pod/perlfaq9.pod371
-rw-r--r--gnu/usr.bin/perl/pod/perlform.pod33
-rw-r--r--gnu/usr.bin/perl/pod/perlfunc.pod2918
-rw-r--r--gnu/usr.bin/perl/pod/perlguts.pod1158
-rw-r--r--gnu/usr.bin/perl/pod/perlipc.pod342
-rw-r--r--gnu/usr.bin/perl/pod/perllocale.pod531
-rw-r--r--gnu/usr.bin/perl/pod/perllol.pod18
-rw-r--r--gnu/usr.bin/perl/pod/perlmod.pod161
-rw-r--r--gnu/usr.bin/perl/pod/perlmodlib.pod217
-rw-r--r--gnu/usr.bin/perl/pod/perlobj.pod185
-rw-r--r--gnu/usr.bin/perl/pod/perlop.pod887
-rw-r--r--gnu/usr.bin/perl/pod/perlpod.pod68
-rw-r--r--gnu/usr.bin/perl/pod/perlre.pod508
-rw-r--r--gnu/usr.bin/perl/pod/perlref.pod237
-rw-r--r--gnu/usr.bin/perl/pod/perlrun.pod191
-rw-r--r--gnu/usr.bin/perl/pod/perlsec.pod36
-rw-r--r--gnu/usr.bin/perl/pod/perlstyle.pod6
-rw-r--r--gnu/usr.bin/perl/pod/perlsub.pod503
-rw-r--r--gnu/usr.bin/perl/pod/perlsyn.pod195
-rw-r--r--gnu/usr.bin/perl/pod/perltie.pod66
-rw-r--r--gnu/usr.bin/perl/pod/perltoc.pod1983
-rw-r--r--gnu/usr.bin/perl/pod/perltoot.pod40
-rw-r--r--gnu/usr.bin/perl/pod/perltrap.pod80
-rw-r--r--gnu/usr.bin/perl/pod/perlvar.pod246
-rw-r--r--gnu/usr.bin/perl/pod/perlxs.pod176
-rw-r--r--gnu/usr.bin/perl/pod/perlxstut.pod4
-rw-r--r--gnu/usr.bin/perl/pod/pod2html.PL5
-rw-r--r--gnu/usr.bin/perl/pod/pod2latex.PL11
-rw-r--r--gnu/usr.bin/perl/pod/pod2man.PL47
-rw-r--r--gnu/usr.bin/perl/pod/pod2text.PL3
-rw-r--r--gnu/usr.bin/perl/pod/roffitall159
-rw-r--r--gnu/usr.bin/perl/pp.c1405
-rw-r--r--gnu/usr.bin/perl/pp.h113
-rw-r--r--gnu/usr.bin/perl/pp_ctl.c2378
-rw-r--r--gnu/usr.bin/perl/pp_hot.c1256
-rw-r--r--gnu/usr.bin/perl/pp_sys.c1666
-rw-r--r--gnu/usr.bin/perl/proto.h1319
-rw-r--r--gnu/usr.bin/perl/regcomp.c2420
-rw-r--r--gnu/usr.bin/perl/regcomp.h307
-rw-r--r--gnu/usr.bin/perl/regexec.c1387
-rw-r--r--gnu/usr.bin/perl/regexp.h90
-rw-r--r--gnu/usr.bin/perl/run.c101
-rw-r--r--gnu/usr.bin/perl/scope.c480
-rw-r--r--gnu/usr.bin/perl/scope.h121
-rw-r--r--gnu/usr.bin/perl/sv.c1838
-rw-r--r--gnu/usr.bin/perl/sv.h216
-rw-r--r--gnu/usr.bin/perl/t/TEST211
-rw-r--r--gnu/usr.bin/perl/t/base/lex.t45
-rw-r--r--gnu/usr.bin/perl/t/base/term.t12
-rw-r--r--gnu/usr.bin/perl/t/cmd/for.t14
-rw-r--r--gnu/usr.bin/perl/t/cmd/mod.t23
-rw-r--r--gnu/usr.bin/perl/t/cmd/subval.t9
-rw-r--r--gnu/usr.bin/perl/t/cmd/while.t21
-rw-r--r--gnu/usr.bin/perl/t/comp/cpp.aux2
-rw-r--r--gnu/usr.bin/perl/t/comp/cpp.t2
-rw-r--r--gnu/usr.bin/perl/t/comp/multiline.t8
-rw-r--r--gnu/usr.bin/perl/t/comp/package.t22
-rw-r--r--gnu/usr.bin/perl/t/comp/proto.t45
-rw-r--r--gnu/usr.bin/perl/t/comp/script.t2
-rw-r--r--gnu/usr.bin/perl/t/harness14
-rw-r--r--gnu/usr.bin/perl/t/io/argv.t21
-rw-r--r--gnu/usr.bin/perl/t/io/fs.t81
-rw-r--r--gnu/usr.bin/perl/t/io/inplace.t12
-rw-r--r--gnu/usr.bin/perl/t/io/pipe.t33
-rw-r--r--gnu/usr.bin/perl/t/lib/anydbm.t28
-rw-r--r--gnu/usr.bin/perl/t/lib/basename.t22
-rw-r--r--gnu/usr.bin/perl/t/lib/bigintpm.t4
-rw-r--r--gnu/usr.bin/perl/t/lib/complex.t157
-rw-r--r--gnu/usr.bin/perl/t/lib/db-btree.t20
-rw-r--r--gnu/usr.bin/perl/t/lib/db-hash.t12
-rw-r--r--gnu/usr.bin/perl/t/lib/db-recno.t120
-rw-r--r--gnu/usr.bin/perl/t/lib/dosglob.t20
-rw-r--r--gnu/usr.bin/perl/t/lib/filecopy.t2
-rw-r--r--gnu/usr.bin/perl/t/lib/filefind.t3
-rw-r--r--gnu/usr.bin/perl/t/lib/filehand.t8
-rw-r--r--gnu/usr.bin/perl/t/lib/gdbm.t12
-rw-r--r--gnu/usr.bin/perl/t/lib/io_pipe.t8
-rw-r--r--gnu/usr.bin/perl/t/lib/io_sel.t2
-rw-r--r--gnu/usr.bin/perl/t/lib/io_sock.t12
-rw-r--r--gnu/usr.bin/perl/t/lib/io_tell.t2
-rw-r--r--gnu/usr.bin/perl/t/lib/io_udp.t10
-rw-r--r--gnu/usr.bin/perl/t/lib/ndbm.t10
-rw-r--r--gnu/usr.bin/perl/t/lib/odbm.t10
-rw-r--r--gnu/usr.bin/perl/t/lib/open2.t21
-rw-r--r--gnu/usr.bin/perl/t/lib/open3.t39
-rw-r--r--gnu/usr.bin/perl/t/lib/parsewords.t100
-rw-r--r--gnu/usr.bin/perl/t/lib/posix.t22
-rw-r--r--gnu/usr.bin/perl/t/lib/safe2.t14
-rw-r--r--gnu/usr.bin/perl/t/lib/sdbm.t35
-rw-r--r--gnu/usr.bin/perl/t/lib/searchdict.t38
-rw-r--r--gnu/usr.bin/perl/t/lib/soundex.t6
-rw-r--r--gnu/usr.bin/perl/t/lib/textwrap.t136
-rw-r--r--gnu/usr.bin/perl/t/lib/timelocal.t5
-rw-r--r--gnu/usr.bin/perl/t/lib/trig.t105
-rw-r--r--gnu/usr.bin/perl/t/op/array.t97
-rw-r--r--gnu/usr.bin/perl/t/op/auto.t6
-rw-r--r--gnu/usr.bin/perl/t/op/bop.t21
-rw-r--r--gnu/usr.bin/perl/t/op/closure.t30
-rw-r--r--gnu/usr.bin/perl/t/op/delete.t6
-rw-r--r--gnu/usr.bin/perl/t/op/do.t2
-rw-r--r--gnu/usr.bin/perl/t/op/each.t17
-rw-r--r--gnu/usr.bin/perl/t/op/eval.t122
-rw-r--r--gnu/usr.bin/perl/t/op/exec.t9
-rw-r--r--gnu/usr.bin/perl/t/op/flip.t2
-rw-r--r--gnu/usr.bin/perl/t/op/goto.t23
-rw-r--r--gnu/usr.bin/perl/t/op/gv.t41
-rw-r--r--gnu/usr.bin/perl/t/op/local.t187
-rw-r--r--gnu/usr.bin/perl/t/op/magic.t64
-rw-r--r--gnu/usr.bin/perl/t/op/method.t8
-rw-r--r--gnu/usr.bin/perl/t/op/misc.t118
-rw-r--r--gnu/usr.bin/perl/t/op/mkdir.t2
-rw-r--r--gnu/usr.bin/perl/t/op/my.t13
-rw-r--r--gnu/usr.bin/perl/t/op/oct.t5
-rw-r--r--gnu/usr.bin/perl/t/op/ord.t8
-rw-r--r--gnu/usr.bin/perl/t/op/pack.t261
-rw-r--r--gnu/usr.bin/perl/t/op/pat.t389
-rw-r--r--gnu/usr.bin/perl/t/op/push.t13
-rw-r--r--gnu/usr.bin/perl/t/op/quotemeta.t26
-rw-r--r--gnu/usr.bin/perl/t/op/range.t27
-rw-r--r--gnu/usr.bin/perl/t/op/re_tests199
-rw-r--r--gnu/usr.bin/perl/t/op/ref.t50
-rw-r--r--gnu/usr.bin/perl/t/op/regexp.t57
-rw-r--r--gnu/usr.bin/perl/t/op/repeat.t53
-rw-r--r--gnu/usr.bin/perl/t/op/runlevel.t306
-rw-r--r--gnu/usr.bin/perl/t/op/sort.t84
-rw-r--r--gnu/usr.bin/perl/t/op/split.t23
-rw-r--r--gnu/usr.bin/perl/t/op/sprintf.t4
-rw-r--r--gnu/usr.bin/perl/t/op/stat.t58
-rw-r--r--gnu/usr.bin/perl/t/op/subst.t93
-rw-r--r--gnu/usr.bin/perl/t/op/substr.t39
-rw-r--r--gnu/usr.bin/perl/t/op/sysio.t40
-rw-r--r--gnu/usr.bin/perl/t/op/taint.t331
-rw-r--r--gnu/usr.bin/perl/t/op/tie.t13
-rw-r--r--gnu/usr.bin/perl/t/op/undef.t11
-rw-r--r--gnu/usr.bin/perl/t/op/universal.t12
-rw-r--r--gnu/usr.bin/perl/t/op/vec.t5
-rw-r--r--gnu/usr.bin/perl/t/op/write.t25
-rw-r--r--gnu/usr.bin/perl/t/pragma/constant.t20
-rw-r--r--gnu/usr.bin/perl/t/pragma/locale.t28
-rw-r--r--gnu/usr.bin/perl/t/pragma/overload.t355
-rw-r--r--gnu/usr.bin/perl/t/pragma/strict-subs4
-rw-r--r--gnu/usr.bin/perl/t/pragma/strict-vars26
-rw-r--r--gnu/usr.bin/perl/t/pragma/subs.t3
-rw-r--r--gnu/usr.bin/perl/t/pragma/warn-1global13
-rw-r--r--gnu/usr.bin/perl/t/pragma/warning.t25
-rw-r--r--gnu/usr.bin/perl/taint.c52
-rw-r--r--gnu/usr.bin/perl/toke.c3549
-rw-r--r--gnu/usr.bin/perl/universal.c74
-rw-r--r--gnu/usr.bin/perl/unixish.h28
-rw-r--r--gnu/usr.bin/perl/util.c1662
-rw-r--r--gnu/usr.bin/perl/util.h2
-rw-r--r--gnu/usr.bin/perl/utils/Makefile15
-rw-r--r--gnu/usr.bin/perl/utils/c2ph.PL3
-rw-r--r--gnu/usr.bin/perl/utils/h2ph.PL533
-rw-r--r--gnu/usr.bin/perl/utils/h2xs.PL72
-rw-r--r--gnu/usr.bin/perl/utils/perlbug.PL1180
-rw-r--r--gnu/usr.bin/perl/utils/perldoc.PL261
-rw-r--r--gnu/usr.bin/perl/utils/pl2pm.PL3
-rw-r--r--gnu/usr.bin/perl/utils/splain.PL3
-rw-r--r--gnu/usr.bin/perl/vms/ext/DCLsym/DCLsym.xs2
-rw-r--r--gnu/usr.bin/perl/vms/ext/DCLsym/Makefile.PL3
-rw-r--r--gnu/usr.bin/perl/vms/ext/Filespec.pm11
-rw-r--r--gnu/usr.bin/perl/vms/ext/Stdio/Stdio.pm437
-rw-r--r--gnu/usr.bin/perl/vms/ext/Stdio/Stdio.xs146
-rw-r--r--gnu/usr.bin/perl/vms/ext/Stdio/test.pl32
-rw-r--r--gnu/usr.bin/perl/vms/ext/filespec.t36
-rw-r--r--gnu/usr.bin/perl/vms/gen_shrfls.pl75
-rw-r--r--gnu/usr.bin/perl/vms/genconfig.pl94
-rw-r--r--gnu/usr.bin/perl/vms/perlvms.pod59
-rw-r--r--gnu/usr.bin/perl/vms/perly_c.vms2503
-rw-r--r--gnu/usr.bin/perl/vms/sockadapt.h3
-rw-r--r--gnu/usr.bin/perl/vms/test.com28
-rw-r--r--gnu/usr.bin/perl/vms/vms.c740
-rw-r--r--gnu/usr.bin/perl/vms/vms_yfix.pl5
-rw-r--r--gnu/usr.bin/perl/vms/vmsish.h142
-rw-r--r--gnu/usr.bin/perl/vos/config_h.SH_orig2
-rw-r--r--gnu/usr.bin/perl/win32/Makefile1476
-rw-r--r--gnu/usr.bin/perl/win32/bin/pl2bat.pl195
-rw-r--r--gnu/usr.bin/perl/win32/bin/search.pl5
-rw-r--r--gnu/usr.bin/perl/win32/config.bc255
-rw-r--r--gnu/usr.bin/perl/win32/config.vc253
-rw-r--r--gnu/usr.bin/perl/win32/config_H.bc1570
-rw-r--r--gnu/usr.bin/perl/win32/config_H.vc1572
-rw-r--r--gnu/usr.bin/perl/win32/config_h.PL39
-rw-r--r--gnu/usr.bin/perl/win32/config_sh.PL28
-rw-r--r--gnu/usr.bin/perl/win32/dl_win32.xs74
-rw-r--r--gnu/usr.bin/perl/win32/include/dirent.h12
-rw-r--r--gnu/usr.bin/perl/win32/include/sys/socket.h67
-rw-r--r--gnu/usr.bin/perl/win32/makedef.pl358
-rw-r--r--gnu/usr.bin/perl/win32/makefile.mk1728
-rw-r--r--gnu/usr.bin/perl/win32/perlglob.c4
-rw-r--r--gnu/usr.bin/perl/win32/perllib.c31
-rw-r--r--gnu/usr.bin/perl/win32/pod.mak85
-rw-r--r--gnu/usr.bin/perl/win32/runperl.c96
-rw-r--r--gnu/usr.bin/perl/win32/win32.c1942
-rw-r--r--gnu/usr.bin/perl/win32/win32.h381
-rw-r--r--gnu/usr.bin/perl/win32/win32iop.h269
-rw-r--r--gnu/usr.bin/perl/win32/win32sck.c501
-rw-r--r--gnu/usr.bin/perl/x2p/Makefile.SH45
-rw-r--r--gnu/usr.bin/perl/x2p/a2p.c2
-rw-r--r--gnu/usr.bin/perl/x2p/a2p.h33
-rw-r--r--gnu/usr.bin/perl/x2p/a2py.c130
-rw-r--r--gnu/usr.bin/perl/x2p/find2perl.PL54
-rw-r--r--gnu/usr.bin/perl/x2p/hash.c28
-rw-r--r--gnu/usr.bin/perl/x2p/s2p.PL51
-rw-r--r--gnu/usr.bin/perl/x2p/str.c86
-rw-r--r--gnu/usr.bin/perl/x2p/util.c74
-rw-r--r--gnu/usr.bin/perl/x2p/util.h6
-rw-r--r--gnu/usr.bin/perl/x2p/walk.c40
515 files changed, 98987 insertions, 58222 deletions
diff --git a/gnu/usr.bin/perl/Changes b/gnu/usr.bin/perl/Changes
index 74755010ca3..00a38d5eeba 100644
--- a/gnu/usr.bin/perl/Changes
+++ b/gnu/usr.bin/perl/Changes
@@ -12,13895 +12,19325 @@ releases.)
CAST AND CREW
---------------
-To give due honor to those who have made Perl 5.004 what is is today,
+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 March 1997):
+current addresses (as of July 1998):
Gisle Aas <gisle@aas.no>
+ Abigail <abigail@fnx.com>
Kenneth Albanowski <kjahds@kjahds.com>
- Graham Barr <gbarr@ti.com>
+ Russ Allbery <rra@stanford.edu>
Spider Boardman <spider@orb.nashua.nh.us>
Tom Christiansen <tchrist@perl.com>
Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
M. J. T. Guy <mjtg@cus.cam.ac.uk>
- Gurusamy Sarathy <gsar@engin.umich.edu>
Jarkko Hietaniemi <jhi@iki.fi>
Nick Ing-Simmons <nik@tiuk.ti.com>
Andreas Koenig <a.koenig@mind.de>
Doug MacEachern <dougm@opengroup.org>
Paul Marquess <pmarquess@bfsec.bt.co.uk>
- Hans Mulder <hansm@euronet.nl>
+ Stephen McCamant <alias@mcs.com>
+ Laszlo Molnar <molnarl@cdata.tvnet.hu>
+ Hans Mulder <hansmu@xs4all.nl>
+ Matthias Neeracher <neeri@iis.ee.ethz.ch>
Jeff Okamoto <okamoto@hpcc123.corp.hp.com>
Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de>
Tom Phoenix <rootbeer@teleport.com>
+ Joshua Pritikin <joshua.pritikin@db.com>
Norbert Pueschel <pueschel@imsdd.meb.uni-bonn.de>
Dean Roehrich <roehrich@cray.com>
+ Hugo van der Sanden <hv@crypt0.demon.co.uk>
Roderick Schertler <roderick@argon.org>
+ Kurt D. Starsinic <kstar@chapin.edu>
+ Dan Sugalski <sugalskd@osshe.edu>
Larry W. Virden <lvirden@cas.org>
Ilya Zakharevich <ilya@math.ohio-state.edu>
And the Keepers of the Patch Pumpkin:
Charles Bailey <bailey@hmivax.humgen.upenn.edu>
+ Graham Barr <gbarr@pobox.com>
+ Malcolm Beattie <mbeattie@sable.ox.ac.uk>
Tim Bunce <Tim.Bunce@ig.co.uk>
Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Gurusamy Sarathy <gsar@umich.edu>
Chip Salzenberg <chip@perl.com>
+And, of course, the Author of Perl:
-----------------
-Version 5.004_04 Maintenance release 4 for 5.004
-----------------
-
-"1. Out of clutter, find simplicity.
- 2. From discord, find harmony.
- 3. In the middle of difficulty lies opportunity."
- -- Albert Einstein, three rules of work
-
-
- HEADLINES FOR THIS MAINTENANCE RELEASE
-
- Fixed gaps in tainting (readdir, readlink, gecos, bit vector ops).
- Fixed memory leak in splice(@_).
- Fixed debugger core dumps.
- IO::Socket now sets autoflush by default.
- Several perldoc bugs fixed, now faster and more helpful.
- Fixed Win32 handle leak.
- Many other improvements to Win32 support.
- Many many other bug fixes and enhancements.
-
-
- ------ BUILD PROCESS ------
-
- Title: "ExtUtils::Liblist prints diagnostics to STDOUT (vs. STDERR)"
- From: Andy Dougherty <doughera@newton.phys.lafayette.edu>, jesse@ginger
- (Jesse Glick)
- Msg-ID: <199708290032.UAA15663@ginger>,
- <Pine.SUN.3.96.970829132217.28552A-100000@newton.phys>
- Files: MANIFEST lib/ExtUtils/Liblist.pm
-
- Title: "Set LD_RUN_PATH when building suidperl"
- From: Chip Salzenberg <chip@rio.atlantic.net>, Tony Sanders
- <sanders@bsdi.com>
- Msg-ID: <199708272226.QAA10206@austin.bsdi.com>
- Files: Makefile.SH
-
- Title: "INSTALL version 1.26"
- From: Andy Dougherty <doughera@newton.phys.lafayette.edu>
- Msg-ID: <Pine.SUN.3.96.970828143314.27416B-100000@newton.phys>
- Files: INSTALL
-
- Title: "Propagate MAKE=$(MAKE) through perl build"
- From: Andy Dougherty <doughera@newton.phys.lafayette.edu>
- Msg-ID: <Pine.SUN.3.96.970908143853.13750C-100000@newton.phys>
- Files: Makefile.SH makedepend.SH x2p/Makefile.SH ext/util/make_ext
-
- Title: "update to installperl for perl5.004_02 to skip CVS dir"
- From: Tony Sanders <sanders@bsdi.com>
- Msg-ID: <199708272307.RAA13451@austin.bsdi.com>
- Files: installperl
-
- Title: "makedepend loop on HP-UX 10.20"
- Msg-ID: <1997Sep20.183731.2297443@cor.newman>
- Files: Makefile.SH
-
- Title: "Tiny Grammaro in INSTALL"
- From: koenig@anna.mind.de (Andreas J. Koenig)
- Msg-ID: <sfcwwkb2pc8.fsf@anna.in-berlin.de>
- Files: INSTALL
-
- Title: "Fix Configured osvers under Linux 1"
- From: Andy Dougherty <doughera@newton.phys.lafayette.edu>, Hugo van der
- Sanden <hv@crypt.compulink.co.uk>
- Msg-ID: <199709241439.PAA17114@crypt.compulink.co.uk>,
- <Pine.SUN.3.96.970924112654.5054D-100000@newton.phys>
- Files: Configure
-
- Title: "INSTALL-1.28"
- From: Andy Dougherty <doughera@newton.phys.lafayette.edu>
- Msg-ID: <Pine.SUN.3.96.971010131207.23751A-100000@newton.phys>
- Files: INSTALL
-
- Title: "makedepend.SH fix for UNICOS"
- From: Jarkko Hietaniemi <jhi@iki.fi>
- Msg-ID: <199710132039.XAA21459@alpha.hut.fi>
- Files: makedepend.SH
-
- ------ CORE LANGUAGE ------
-
- Title: "Re: "perl -d" dumps core when loading syslog.ph"
- From: Jochen Wiedmann <wiedmann@neckar-alb.de>, Stephen McCamant
- <alias@mcs.com>, ilya@math.ohio-state.edu (Ilya
- Zakharevich)
- Msg-ID: <1997Aug30.034921.2297381@cor.newman.upenn.edu>,
- <3407639E.FEBF20BA@neckar-alb.de>,
- <m0x4ZGj-000EZYC@alias-2.pr.mcs.net>
- Files: pp_ctl.c
-
- Title: "Allow $obj->$coderef()"
- From: Chip Salzenberg <salzench@nielsenmedia.com>
- Msg-ID: <199708291649.MAA23276@nielsenmedia.com>
- Files: pp_hot.c
-
- Title: "Localize PV value in save_gp()", "typeglob differences in perl4 and
- perl5"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>, Stephen McCamant
- <alias@mcs.com>
- Msg-ID: <199708272348.TAA03139@aatma.engin.umich.edu>,
- <m0x4u2o-000EZkC@alias-2.pr.mcs.net>
- Files: scope.c t/op/ref.t
-
- Title: "Avoid assumption that STRLEN == I32"
- From: Chip Salzenberg <chip@rio.atlantic.net>, Hallvard B Furuseth
- <h.b.furuseth@usit.uio.no>
- Msg-ID: <199708242310.BAA05497@bombur2.uio.no>
- Files: hv.c
-
- Title: "Fix memory leak in splice(@_)"
- From: "Tuomas J. Lukka" <tjl@fkfuga.pc.helsinki.fi>, Chip Salzenberg
- <chip@rio.atlantic.net>
- Msg-ID: <m0x3iQE-000CBrC@lukka.student.harvard.edu>
- Files: proto.h av.c global.sym pp.c
-
- Title: "Fix line number of warnings in while() conditional", "misleading
- uninit value warning"
- From: Chip Salzenberg <chip@rio.atlantic.net>, Greg Bacon
- <gbacon@crp-201.adtran.com>
- Msg-ID: <199708271607.LAA01403@crp-201.adtran.com>
- Files: proto.h op.c perly.c perly.y
-
- Title: "-t and POSIX::isatty on IO::Handle objects", "Fix C<-t $handle>"
- From: Chip Salzenberg <chip@rio.atlantic.net>, Greg Ward
- <greg@bic.mni.mcgill.ca>
- Msg-ID: <199708261754.NAA24826@bottom.bic.mni.mcgill.ca>
- Files: pp_sys.c
-
- Title: "Fix output of invalid printf formats"
- From: Chip Salzenberg <chip@rio.atlantic.net>, Hugo van der Sanden
- <hv@crypt.compulink.co.uk>
- Msg-ID: <199708241529.QAA02457@crypt.compulink.co.uk>
- Files: sv.c t/op/sprintf.t
-
- Title: "regexec.c regcppartblow declaration missing an arg"
- From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
- Msg-ID: <199708290059.BAA05808@crypt.compulink.co.uk>
- Files: regexec.c
-
- Title: "taint readlink, readdir, gecos"
- From: Jarkko Hietaniemi <jhi@iki.fi>
- Msg-ID: <199709131651.TAA13471@alpha.hut.fi>
- Files: pod/perlfunc.pod pod/perlsec.pod pp_sys.c t/op/taint.t
-
- Title: "clean up old style package' usage in op.c"
- From: Stephen Potter <spp@psa.pencom.com>
- Msg-ID: <199709151813.NAA14433@psisa.psa.pencom.com>
- Files: op.c
-
- Title: "beautifying usage() code in perl.c"
- From: "John L. Allen" <"John L. Allen"<allen@gateway.grumman.com>>
- Msg-ID: <Pine.SOL.3.91.970905091314.5991C-100000@gateway>
- Files: perl.c
-
- Title: "debugger to fix core dumps, adds $^S"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199709170823.EAA21359@monk.mps.ohio-state.edu>
- Files: pod/perlvar.pod perl.h gv.c lib/perl5db.pl mg.c perl.c toke.c
-
- Title: "downgrade "my $foo masks earlier" from mandatory to "-w""
- From: Gurusamy Sarathy <gsar@engin.umich.edu>, Stephen Potter
- <spp@psa.pencom.com>
- Msg-ID: <199709091832.NAA14763@psisa.psa.pencom.com>,
- <199709102019.QAA09591@aatma.engin.umich.edu>
- Files: pod/perldelta.pod pod/perldiag.pod op.c
-
- Title: "fix overridden glob() problems"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199709171645.MAA13988@aatma.engin.umich.edu>
- Files: MANIFEST pod/perlsub.pod lib/File/DosGlob.pm op.c t/lib/dosglob.t
- toke.c
-
- Title: "Reverse previous "Fix C<qq #hi#>" patch"
- From: Chip Salzenberg <chip@rio.atlantic.net>, Kenneth Albanowski
- <kjahds@kjahds.com>, Tom Christiansen
- <tchrist@jhereg.perl.com>
- Msg-ID: <199707050155.VAA27394@rio.atlantic.net>,
- <199708172326.RAA19344@jhereg.perl.com>,
- <Pine.LNX.3.93.970817200236.170F-100000@kjahds.com>
- Files: toke.c
-
- Title: "printf type warning buglets in m3t2"
- From: Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
- Msg-ID: <199708141017.MAA10225@bombur2.uio.no>
- Files: regcomp.c regexec.c scope.c sv.c util.c x2p/util.c
-
- Title: "Localize PV value in save_gp()", "typeglob differences in perl4 and
- perl5"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>, Stephen McCamant
- <alias@mcs.com>
- Msg-ID: <199708272348.TAA03139@aatma.engin.umich.edu>,
- <m0x4AUk-000EUJC@alias-2.pr.mcs.net>
- Files: scope.c t/op/ref.t
-
- Title: "unpack now allows commas but -w warns", "unpack() difference
- 5.003->5.004"
- From: "John L. Allen" <allen@gateway.grumman.com>, Chip Salzenberg
- <chip@rio.atlantic.net>, Jarkko Hietaniemi <jhi@iki.fi>,
- Jim Esten <jesten@wdynamic.com>, Jim Esten
- <jesten@wepco.com>, timbo (Tim Bunce)
- Msg-ID: <199709031632.LAA29584@wepco.com>,
- <199709090257.WAA32670@rio.atlantic.net>,
- <199709090917.MAA05602@alpha.hut.fi>,
- <199709091000.LAA24094@toad.ig.co.uk>,
- <341077FE.132F@wdynamic.com>,
- <Pine.SOL.3.91.970905171243.14630A-100000@gateway>
- Files: pod/perldiag.pod pp.c
-
- Title: "5.004_04 trial 1 assorted minor details"
- From: Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
- Msg-ID: <HBF.970921p5f6@bombur2.uio.no>
- Files: Porting/pumpkin.pod hv.c op.c sv.c x2p/util.c
-
- Title: "A couple of 4_04t1 problems"
- From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
- Msg-ID: <9709210959.AA28772@claudius.bfsec.bt.co.uk>
- Files: lib/Cwd.pm perl.c
-
- Title: "Minor changes to ease port to MVS"
- From: Len Johnson <lenjay@ibm.net>, SMTP%"BAHUFF@us.oracle.com" ,
- SMTP%"pfuntner@vnet.ibm.com" , pvhp@forte.com (Peter
- Prymmer)
- Msg-ID: <199709162058.NAA00952@mailsun2.us.oracle.com>
- Files: unixish.h miniperlmain.c
-
- Title: "Truer version string and more robust perlbug"
- From: "Michael A. Chase" <mchase@ix.netcom.com>, Hugo van der Sanden
- <hv@crypt.compulink.co.uk>
- Msg-ID: <199709201514.QAA21187@crypt.compulink.co.uk>,
- <1997Sep22.090701.2297448@cor.newman>
- Files: perl.c utils/perlbug.PL
-
- Title: "Fix locale bug for constant (readonly) strings"
- From: Jarkko Hietaniemi <jhi@iki.fi>
- Msg-ID: <199709262125.AAA28292@alpha.hut.fi>
- Files: sv.c t/pragma/locale.t
-
- Title: "Enable truly global glob()"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199710080000.UAA18972@aatma.engin.umich.edu>
- Files: op.c
-
- Title: "Fix for $0 truncation"
- From: Tim Bunce <Tim.Bunce@ig.co.uk>
- Msg-ID: <199710081703.SAA02653@toad.ig.co.uk>
- Files: mg.c
-
- Title: "Fix for missing &import leaving stack untidy"
- From: Chip Salzenberg <salzench@nielsenmedia.com>
- Msg-ID: <199709282252.SAA22915@nielsenmedia.com>
- Files: pp_hot.c
-
- Title: "Larry's proto fix"
- From: Chip Salzenberg <salzench@nielsenmedia.com>
- Msg-ID: <199709290004.UAA07559@nielsenmedia.com>
- Files: op.c t/comp/proto.t
-
- Title: "Fix bugs with magical arrays and hashes (@ISA)"
- From: Chip Salzenberg <chip@rio.atlantic.net>
- Msg-ID: <199709232148.RAA29967@rio.atlantic.net>
- Files: perl.h proto.h av.c global.sym gv.c mg.c pp.c pp_hot.c scope.c
- t/op/method.t
-
- Title: "Perl_debug_log stream used for all DEBUG_*(...) macro uses"
- From: Nick Ing-Simmons <nik@tiuk.ti.com>, Tim Bunce
- Msg-ID: <199709230820.JAA11945@tiuk.ti.com>
- Files: perl.c taint.c util.c
-
- Title: "Tainting bitwise vector ops"
- From: Chip Salzenberg <chip@rio.atlantic.net>
- Msg-ID: <199710061726.NAA16438@rio.atlantic.net>
- Files: doop.c t/op/taint.t
-
- Title: "Enhance $^E on OS/2"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199709232236.SAA04463@monk.mps.ohio-state.edu>
- Files: pod/perlvar.pod mg.c os2/Changes
-
- Title: "option "!#... -- ..." in perl 5.004.03 seems not to work"
- From: "John L. Allen" <allen@gateway.grumman.com>, Urs Thuermann
- <urs@isnogud.escape.de>
- Msg-ID: <199709232030.WAA30425@isnogud.escape.de>,
- <Pine.SOL.3.91.970930105158.10789A-100000@gateway>
- Files: perl.c
-
- Title: "syswrite will again write a zero length buffer"
- From: Cameron Simpson <cs@zip.com.au>, Jarkko Hietaniemi <jhi@iki.fi>,
- aml@world.std.com (Andrew M. Langmead)
- Msg-ID: <199710042107.AAA28561@alpha.hut.fi>,
- <19971007104652-cameron-1-10391@sid.research.canon.com.au>
- Files: pp_sys.c
-
- Title: "make Odd number of elements in hash list warning non-mandatory"
- From: Jason Varsoke {81530} <jjv@caesun10.msd.ray.com>
- Msg-ID: <199710021651.MAA15690@caesun7.msd.ray.com>
- Files: pp.c pp_hot.c
-
- Title: "Fix defined() bug in m4t3 affecting LWP"
- From: chip@atlantic.net@ig.co.uk ()
- Msg-ID: <199710101822.OAA14249@cyprus.atlantic.net>
- Files: pp.c
-
- Title: "Include $archname in perl -v output"
- From: Tim Bunce <Tim.Bunce@ig.co.uk>
- Files: perl.c
-
- Title: "-I flag can easily lead to whitespace in @INC"
- From: Kenneth Stephen <y2kmvs@us.ibm.com>, Tim Bunce <Tim.Bunce@ig.co.uk>,
- pvhp@forte.com (Peter Prymmer)
- Msg-ID: <199710130922.KAA07780@toad.ig.co.uk>,
- <5040400007001448000002L082*@MHS>,
- <9710132015.AA12457@forte.com>
- Files: perl.c
-
- ------ DOCUMENTATION ------
-
- Title: "perldiag.pod: gotcha in short pattern/char ops"
- From: Jarkko Hietaniemi <jhi@iki.fi>
- Msg-ID: <199709050718.KAA31405@alpha.hut.fi>
- Files: pod/perldiag.pod
-
- Title: "Documenting the perl-thanks address"
- From: Tom Phoenix <rootbeer@teleport.com>
- Msg-ID: <Pine.GSO.3.96.970913064628.12359F-100000@julie.teleport.com>
- Files: pod/perl.pod
-
- Title: "Missing section for @_ in perlvar."
- From: abigail@fnx.com (Abigail)
- Msg-ID: <199708142146.RAA13146@fnx.com>
- Files: pod/perlvar.pod
-
- Title: "Promised information about AvHASH in perguts is not delivered"
- From: mjd@plover.com
- Files: pod/perlguts.pod
-
- Title: "perlfunc.doc - $_ aliasing in map, grep, foreach etc"
- From: Ted Ashton <ashted@southern.edu>
- Msg-ID: <199708181852.OAA15901@ns.southern.edu>
- Files: pod/perlfunc.pod
-
- Title: "-U Unsafe operations need -w to warn"
- From: Tom Phoenix <rootbeer@teleport.com>
- Msg-ID: <Pine.GSO.3.96.970826141343.13463h-100000@julie.teleport.com>
- Files: pod/perlrun.pod
-
- Title: "document the return value of syscall"
- From: Hans Mulder <hansm@icgned.nl>
- Msg-ID: <1997Sep7.160817.2297395@cor.newman>
- Files: pod/perlfunc.pod
-
- Title: "minor fix for perltrap.pod"
- From: abigail@fnx.com (Abigail)
- Msg-ID: <199709170500.BAA14805@fnx.com>
- Files: pod/perltrap.pod
-
- Title: "xsubpp: document advanced dynamic typemap usage"
- From: "Rujith S. de Silva" <desilva@netbox.com>
- Files: pod/perlxs.pod
-
- Title: "Improved diagnostic docs for here-documents"
- From: Tom Phoenix <rootbeer@teleport.com>
- Msg-ID: <Pine.GSO.3.96.970921074004.21358G-100000@julie.teleport.com>
- Files: pod/perldiag.pod
-
- Title: "[POD patch] do-FILE forces scalar context."
- From: Robin Houston <robin@oneworld.org>
- Msg-ID: <199709221553.QAA28409@carryon.oneworld.org>
- Files: pod/perlfunc.pod
-
- Title: "perlop.pop. Behaviour of C<qq#hi#> vs C<qq #hi#>."
- From: abigail@fnx.com (Abigail)
- Msg-ID: <199709220107.VAA27064@fnx.com>
- Files: pod/perlop.pod
-
- Title: "Clarify exec docs in perlfunc.pod"
- From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
- Msg-ID: <199710081353.OAA00834@crypt.compulink.co.uk>
- Files: pod/perlfunc.pod
-
- Title: "Documentation patch for perlguts.pod--document tainting routines"
- From: Dan Sugalski <sugalskd@osshe.edu>
- Msg-ID: <3.0.3.32.19971007165226.02fd2cd4@osshe.edu>
- Files: pod/perlguts.pod
-
- Title: "Man perlfunc: incorrect split example"
- From: Joerg Porath <Joerg.Porath@informatik.tu-chemnitz.de>
- Msg-ID: <199709240620.IAA30928@pandora.hrz.tu-chemnitz.de>
- Files: pod/perlfunc.pod
-
- Title: "Improve "Use of inherited AUTOLOAD for non-method" disgnostic"
- From: rjray@uswest.com (Randy J. Ray)
- Msg-ID: <199709231710.LAA08854@tremere.ecte.uswc.uswest.com>
- Files: pod/perldiag.pod
-
- Title: "Document split-with-limit on empty string perl4/perl5 change"
- From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Gisle Aas <aas@bergen.sn.no>, Hugo
- van der Sanden <hv@crypt.compulink.co.uk>
- Msg-ID: <199709221419.PAA03987@crypt.compulink.co.uk>,
- <hiuvttdkv.fsf@bergen.sn.no>
- Files: pod/perlfunc.pod pod/perltrap.pod URI/URL/http.pm t/op/split.t
-
- Title: "Clarify close() docs"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199710081653.MAA20611@monk.mps.ohio-state.edu>
- Files: pod/perlfunc.pod
-
- Title: "perldiag log & sqrt - refer to Math::Complex package"
- From: Jarkko Hietaniemi <jhi@cc.hut.fi>
- Msg-ID: <199710042129.AAA20367@alpha.hut.fi>
- Files: pod/perldiag.pod
-
- Title: "perlfunc.pod: sysread, syswrite docs"
- From: Jarkko Hietaniemi <jhi@cc.hut.fi>
- Msg-ID: <199710061910.WAA15266@alpha.hut.fi>
- Files: pod/perlfunc.pod
-
- Title: "Document //gc"
- From: abigail@fnx.com (Abigail)
- Msg-ID: <199709232302.TAA27947@fnx.com>
- Files: pod/perlop.pod
-
- Title: "repeating #! switches"
- From: Chip Salzenberg <chip@rio.atlantic.net>, Robin Barker
- <rmb1@cise.npl.co.uk>
- Msg-ID: <199709241736.NAA25855@rio.atlantic.net>,
- <24778.9709241501@tempest.cise.npl.co.uk>
- Files: pod/perlrun.pod
-
- Title: "Re: taint documentation bug"
- From: Ken Estes <estes@ms.com>, Tom Phoenix <rootbeer@teleport.com>
- Msg-ID: <Pine.GSO.3.96.971006121349.10551X-100000@usertest.teleport.com>
- Files: pod/perlsec.pod
-
- ------ LIBRARY AND EXTENSIONS ------
-
- Title: "FileHandle.pm fails if Exporter has not been loaded previously"
- From: jan.dubois@ibm.net (Jan Dubois)
- Msg-ID: <3445e05b.17874041@smtp2.ibm.net>
- Files: lib/FileHandle.pm
-
- Title: "Prefer startperl path over perlpath in MakeMaker"
- From: Andreas Klussmann <andreas@infosys.heitec.de>
- Msg-ID: <199709162017.WAA05043@troubadix.infosys.heitec.net>
- Files: lib/ExtUtils/MM_Unix.pm
-
- Title: "Sys::Hostname fails under Solaris 2.5 when setuid"
- From: Patrick Hayes <Patrick.Hayes.CAP_SESA@renault.fr>
- Msg-ID: <199708201240.OAA04243@goblin.renault.fr>
- Files: lib/Sys/Hostname.pm
-
- Title: "Cwd::getcwd cannot handle path contains '0' element"
- From: Hironori Ikura <hikura@tcc.co.jp>, Hironori Ikura
- <hikura@trans-nt.com>, Stephen Zander <srz@mckesson.com>
- Msg-ID: <19970830060142J.hikura@matsu.tcc.co.jp>,
- <m0x4TzI-0003F1C@wsuse5.mckesson.com>
- Files: lib/Cwd.pm
-
- Title: "Getopt::Long 2.11"
- From: JVromans@squirrel.nl (Johan Vromans)
- Msg-ID: <m0xBcdR-000RArC@plume.nl.compuware.com>
- Files: lib/Getopt/Long.pm
-
- Title: "IO::Socket autoflush by default, assume tcp and PeerAddr"
- From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Andy Dougherty
- <doughera@newton.phys.lafayette.edu>, Gisle Aas
- <aas@bergen.sn.no>
- Msg-ID: <E0x9WpH-0003HT-00@ursa.cus.cam.ac.uk>,
- <Pine.SUN.3.96.970915115856.23236F-100000@newton.phys>,
- <hvi07zvo9.fsf@bergen.sn.no>
- Files: ext/IO/lib/IO/Socket.pm
-
- Title: "Syslog.pm and missing _PATH_LOG"
- From: Ulrich Pfeifer <upf@de.uu.net>
- Msg-ID: <p5iuw1cris.fsf@knowway.de.uu.net>
- Files: lib/Sys/Syslog.pm
-
- Title: "Undocumented: $Test::Harness::switches"
- From: Achim Bohnet <ach@mpe.mpg.de>
- Msg-ID: <9708272110.AA26904@o09.xray.mpe.mpg.de>
- Files: lib/Test/Harness.pm
-
- Title: "Patches for lib/Math/Complex.pm and t/lib/complex.t"
- From: Jarkko Hietaniemi <jhi@anna.in-berlin.de>
- Msg-ID: <199709102009.WAA27428@anna.in-berlin.de>
- Files: lib/Math/Complex.pm t/lib/complex.t
-
- Title: "Win32: Install.pm not correctly comparing binary files."
- From: Jeff Urlwin <jurlwin@access.digex.net>
- Msg-ID: <01BCBFAA.E325C4A0.jurlwin@access.digex.net>
- Files: lib/ExtUtils/Install.pm
-
- Title: "Document that File::Find doesn't follow symlinks"
- From: Greg Ward <greg@bic.mni.mcgill.ca>
- Msg-ID: <199708191853.OAA07111@bottom.bic.mni.mcgill.ca>
- Files: lib/File/Find.pm
-
- Title: "fix subroutines called in a void context in perl5db.pl"
- From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
- Msg-ID: <E0x6Gsa-0004VR-00@ursa.cus.cam.ac.uk>
- Files: lib/perl5db.pl
-
- Title: "xsubpp fix to allow #ifdef's around entire XSubs"
- From: John Tobey <jtobey@user1.channel1.com>
- Msg-ID: <199709070034.AAA16457@remote119>
- Files: lib/ExtUtils/xsubpp
-
- Title: "Banishing eval from getopt.pl and Getopt/Std.pm"
- From: "John L. Allen" <allen@gateway.grumman.com>
- Msg-ID: <Pine.SOL.3.91.970920154720.3683A@gateway>
- Files: lib/getopt.pl lib/Getopt/Std.pm
-
- Title: "further complex number patches"
- From: Jarkko Hietaniemi <jhi@iki.fi>, d-lewart@uiuc.edu (Daniel S. Lewart)
- Msg-ID: <199709221009.FAA21216@staff2.cso.uiuc.edu>,
- <199709221216.PAA15130@alpha.hut.fi>
- Files: lib/Math/Complex.pm t/lib/complex.t
-
- Title: "Trap Time::Local infinite loop"
- From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
- Msg-ID: <199710030030.BAA17372@crypt.compulink.co.uk>
- Files: lib/Time/Local.pm
-
- Title: "Cosmetic Test::Harness patch"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199710032226.SAA15354@monk.mps.ohio-state.edu>
- Files: lib/Test/Harness.pm
-
- Title: "ExtUtil::Install sub my_cmp needs to binmode its files"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>, Stephen Potter
- <spp@psa.pencom.com>
- Msg-ID: <199710010617.BAA02037@psisa.psa.pencom.com>,
- <199710011819.OAA03288@aatma.engin.umich.edu>
- Files: lib/ExtUtils/Install.pm
-
- Title: "Enable make test "TEST_FILES=t/*.t.were_failing""
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199710032231.SAA15364@monk.mps.ohio-state.edu>
- Files: lib/ExtUtils/MM_Unix.pm
-
- Title: "Fix for autouse.pm"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199710071734.NAA19462@monk.mps.ohio-state.edu>
- Files: lib/autouse.pm
-
- Title: "Math::Complex fixes - fixes problems on m68-linux"
- From: Jarkko Hietaniemi <jarkko.hietaniemi@research.nokia.com>
- Msg-ID: <199709301422.HAA24368@koah.research.nokia.com>
- Files: lib/Math/Complex.pm
-
- Title: "Updated CPAN.pm for 5.004_04"
- From: koenig@anna.mind.de (Andreas J. Koenig)
- Msg-ID: <sfcpvpv8teo.fsf@anna.in-berlin.de>
- Files: lib/CPAN.pm lib/CPAN/FirstTime.pm
-
- Title: "debugger bug with 'c subname'"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199709232331.TAA04546@monk.mps.ohio-state.edu>
- Files: lib/perl5db.pl
-
- Title: "Fix atan2 & restrict $t to (-pi,pi] instead of to [-pi,pi]"
- From: Daniel S. Lewart, Jarkko Hietaniemi
- <jarkko.hietaniemi@research.nokia.com>
- Msg-ID: <199710010939.CAA00964@koah.research.nokia.com>
- Files: lib/Math/Complex.pm
-
- Title: "Cwd::fastcwd needs changes to work with tainting"
- From: Hugo van der Sanden <hv@crypt.compulink.co.uk>, Ulrich Pfeifer
- <pfeifer@wait.de>, Tim Bunce
- Msg-ID: <yfmwwk6y0bc.ulp@gretchen.informatik.uni-dortmund.de>
- Files: lib/Cwd.pm
-
- Title: "use autouse: requires prototype now"
- From: user@agate.berkeley.edu
- Msg-ID: <9709220450.AA0380@tuzik.HIP.Berkeley.EDU>
- Files: lib/autouse.pm
-
- Title: ""use base qw(Foo Bar);" to set @ISA at compile time"
- From: Gisle Aas <gisle@aas.no>, Graham Barr <gbarr@pobox.com>, Graham Barr
- <gbarr@ti.com>, Tim Bunce <Tim.Bunce@ig.co.uk>,
- jan.dubois@ibm.net (Jan Dubois), larry@wall.org (Larry
- Wall)
- Msg-ID: <199710022151.WAA21250@toad.ig.co.uk>,
- <199710031613.JAA11286@wall.org>,
- <199710040829.KAA16739@furu.g.aas.no>,
- <3434E4C6.AE24135E@ti.com>, <343C2278.7DC1ADC6@pobox.com>,
- <343ec306.50394803@smtp-gw01.ny.us.ibm.net>
- Files: lib/base.pm
-
- Title: "Further Math/Complex.pm enhancements"
- From: Jarkko Hietaniemi <jhi@iki.fi>
- Msg-ID: <199710132055.XAA02086@alpha.hut.fi>
- Files: lib/Math/Complex.pm t/lib/complex.t
-
- Title: "Further Math::Complex fixes"
- From: Jarkko Hietaniemi <jhi@iki.fi>
- Msg-ID: <199710120933.MAA01165@alpha.hut.fi>
- Files: lib/Math/Complex.pm
-
- ------ OTHER CHANGES ------
-
- Title: "POD patches w.r.t. $^S"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199710030001.UAA14241@monk.mps.ohio-state.edu>
- Files: ../pod/perlfunc.pod ../pod/perlvar.pod
-
- Title: "libperl.sl on HP-UX 10.20"
- From: "Darren/Torin/Who Ever..." <torin@daft.com>, Hugo van der Sanden
- <hv@crypt.compulink.co.uk>
- Msg-ID: <199709250003.BAA18085@crypt.compulink.co.uk>,
- <873emkbpit.fsf@perv.daft.com>
- Files:
-
- Title: "myconfig / perl -V: remove randbits and add prototype"
- From: Tim Bunce <Tim.Bunce@ig.co.uk>
- Msg-ID: <199709290857.JAA07706@toad.ig.co.uk>
- Files: myconfig
-
- Title: "Emacs CPerl update for 5.004_04"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199710140835.EAA26825@monk.mps.ohio-state.edu>
- Files: emacs/cperl-mode.el
+ Larry Wall <larry@wall.org>
- Title: "Enhance perly.fixer to help porters."
- From: Tim Bunce
- Files: perly.fixer
- ------ PORTABILITY - WIN32 ------
-
- Title: "Fix win32/Makefile for perl95"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Files: win32/Makefile win32/makefile.mk
-
- Title: "Win32 archnames"
- From: Bill Middleton <wmiddlet@Adobe.COM>, Gurusamy Sarathy
- <gsar@engin.umich.edu>, Peter Prymmer <pvhp@forte.com>, Tim
- Bunce <Tim.Bunce@ig.co.uk>
- Msg-ID: <199709111929.PAA22488@aatma.engin.umich.edu>,
- <341719E4.4923@forte.com>,
- <Pine.GSO.3.95.970905123145.12361B-100000@ducks>
- Files: win32/config_H.bc win32/config_H.vc
-
- Title: "pl2bat.bat -> pl2bat.pl change in win32/pod.mak"
- From: jan.dubois@ibm.net (Jan Dubois)
- Msg-ID: <3411ee6f.9143607@smtp-gw01.ny.us.ibm.net>
- Files: win32/pod.mak
-
- Title: "Add test-notty target to Win32 Makefile"
- From: jan.dubois@ibm.net (Jan Dubois)
- Msg-ID: <343f5106.12461608@smtp2.ibm.net>
- Files: win32/Makefile
-
- Title: "Bug in Win32::GetShortPathName"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199710092229.SAA21556@aatma.engin.umich.edu>
- Files: win32/win32.c
-
- Title: "Fix NT handles leak."
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199710111319.JAA10918@aatma.engin.umich.edu>
- Files: win32/win32io.c win32/win32sck.c
-
- Title: "fix socket init duality on win32"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199710111523.LAA12407@aatma.engin.umich.edu>
- Files: win32/win32sck.c
-
- ------ PORTABILITY - GENERAL ------
-
- Title: "Tweak to hints/machten.sh: stop t/lib/complex.t from failing"
- From: Dominic Dunlop <domo@tcp.ip.lu>
- Msg-ID: <v03110700b06a30bdfc42@[194.51.248.80]>
- Files: hints/machten.sh
-
- Title: "Irix 6.2 build problem - so_locations"
- From: "Billinghurst, David" <David.Billinghurst@riotinto.com.au>
- Msg-ID: <D54B1932FFB4CF11B5C80000F8018BD2907E31@CRCMAIL>
- Files: hints/irix_6.sh
-
- Title: "Porting/pumpkin.pod version 1.13"
- From: Andy Dougherty <doughera@newton.phys.lafayette.edu>
- Msg-ID: <Pine.SUN.3.96.970828142011.27416A-100000@newton.phys>
- Files: Porting/pumpkin.pod
-
- Title: "lib/timelocal.t fails test 1 for VMS 7.1"
- From: Dan Sugalski <sugalsd@lbcc.cc.or.us>
- Msg-ID: <3.0.3.32.19970908112449.0087bc90@stargate.lbcc.cc.or.us>
- Files: vms/vmsish.h vms/vms.c
-
- Title: "Patches to updated README.VMS for Perl 5.004_04"
- From: Dan Sugalski <sugalsd@stargate.lbcc.cc.or.us>
- Msg-ID: <3.0.3.32.19970918100648.008b1c60@stargate.lbcc.cc.or.us>
- Files: README.vms
-
- Title: "Fix perl build on Digital UNIX after JDK installs libnet.so"
- From: Spider Boardman <spider@orb.nashua.nh.us>
- Msg-ID: <199709191826.OAA18040@Orb.Nashua.NH.US>
- Files: hints/dec_osf.sh
-
- Title: "Updated README.VMS for Perl 5.004_04"
- From: Dan Sugalski <sugalsd@stargate.lbcc.cc.or.us>
- Msg-ID: <3.0.3.32.19970912091524.008a3620@stargate.lbcc.cc.or.us>
- Files: README.vms
-
- Title: "Dynixptx hints"
- From: bruce@aps.org ("Bruce P. Schuck")
- Msg-ID: <Pine.PTX.3.95.971002104651.12112G-200000@lancelot.aps.org>
- Files: hints/dynixptx.sh
-
- Title: "Minor OS/2 patch for 4_03"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199710032224.SAA15345@monk.mps.ohio-state.edu>
- Files: os2/os2.c
-
- Title: "OS2::REXX improvements"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199709272214.SAA08638@monk.mps.ohio-state.edu>
- Files: os2/Changes os2/OS2/REXX/Makefile.PL os2/OS2/REXX/REXX.pm
-
- Title: "hints/qnx.sh update"
- From: Norton Allen <allen@huarp.harvard.edu>
- Msg-ID: <199709261508.LAA07889@dolores.harvard.edu>
- Files: hints/qnx.sh
-
- Title: "New hints file for IBM OS/390 OpenEdition (MVS)"
- From: pvhp@forte.com (Peter Prymmer)
- Msg-ID: <9709240106.AA26484@forte.com>
- Files: hints/os390.sh
-
- Title: "OS/2 Hints"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199710130631.CAA25426@monk.mps.ohio-state.edu>
- Files: hints/os2.sh
-
- ------ TESTS ------
-
- Title: "op/glob.t test failure under Win32 with CVS"
- From: Warren Jones <wjones@tc.fluke.com>
- Msg-ID: <97Aug26.091048pdt.35761-1@gateway.fluke.com>
- Files: t/op/glob.t
-
- Title: "tests fail if localhost/loopback address not defined"
- From: David McLean <David McLean<davem@icc.gsfc.nasa.gov>>, David McLean
- <davem@icc.gsfc.nasa.gov>
- Msg-ID: <34048947.2944@icc.gsfc.nasa.gov>
- Files: t/lib/io_sock.t t/lib/io_udp.t
-
- Title: "Improve pragma/locale test 102 - and don't fail, just warn"
- From: Jarkko Hietaniemi <jhi@anna.in-berlin.de>
- Files: t/pragma/locale.t
-
- Title: "Invalid test output in t/op/taint.t in trial 1"
- From: Dan Sugalski <sugalsd@lbcc.cc.or.us>
- Msg-ID: <3.0.3.32.19970919160918.00857a50@stargate.lbcc.cc.or.us>
- Files: t/op/taint.t
-
- Title: "Identify t/*/*.t test failing because of file permissions"
- From: koenig@anna.mind.de (Andreas J. Koenig)
- Msg-ID: <sfcraah0xvy.fsf@anna.in-berlin.de>
- Files: t/TEST
-
- Title: "fix poor t/op/runlevel.t test"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>, Hugo van der Sanden
- <hv@crypt.compulink.co.uk>, Norton Allen
- <allen@huarp.harvard.edu>
- Msg-ID: <199709261458.KAA28611@dolores.harvard.edu>
- Files: t/op/runlevel.t
-
- ------ UTILITIES ------
-
- Title: "Missing 'require' in auto-generated .pm by h2xs"
- From: davidk@tor.securecomputing.com (David Kerry)
- Msg-ID: <97Aug27.131618edt.11650@janus.tor.securecomputing.com>
- Files: utils/h2xs.PL
-
- Title: "Perldoc tiny patch to avoid $0"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199709122141.RAA16846@monk.mps.ohio-state.edu>
- Files: utils/perldoc.PL
-
- Title: "h2ph broken in 5.004_02"
- From: David Mazieres <dm@reeducation-labor.lcs.mit.edu>,
- kstar@www.chapin.edu (Kurt D. Starsinic)
- Msg-ID: <199708201454.KAA05122@reeducation-labor.lcs.mit.edu>,
- <199708201700.KAA02621@www.chapin.edu>
- Files: utils/h2ph.PL
-
- Title: "add key_t caddr_t to h2ph", "eg/sysvipc/ipcsem bug", "update
- hints/bsdos.sh"
- From: Tony Sanders <sanders@bsdi.com>
- Msg-ID: <199708272301.RAA12803@austin.bsdi.com>
- Files: eg/sysvipc/ipcsem utils/h2ph.PL
-
- Title: "perldoc search ., lib and blib/* if -f 'Makefile.PL'"
- From: Tim Bunce
- Msg-ID: <199708251732.KAA19299@gadget.cscaper.com>
- Files: utils/perldoc.PL
-
- Title: "5.004m4t1: perlbug: NIS domainname gets into wrong places"
- From: koenig@anna.mind.de (Andreas J. Koenig)
- Msg-ID: <sfcg1qy38as.fsf@anna.in-berlin.de>
- Files: utils/perlbug.PL
-
- Title: "add better local patch info to perlbug", "perlbug checks perl
- build/run version changes"
- From: Tim.Bunce@ig.co.uk
- Files: utils/perlbug.PL
-
- Title: "perldoc - suggest modules if requested module not found"
- From: Anthony David <adavid@netinfo.com.au>
- Msg-ID: <3439CD83.6969@netinfo.com.au>
- Files: utils/perldoc.PL
-
- Title: "perldoc mail::foo tries to read binary /usr/ucb/mail"
- From: "Joseph Moof-in' Hall" <joseph@cscaper.com>, Tim Bunce
- Msg-ID: <199710082014.NAA00808@gadget.cscaper.com>
- Files: utils/perldoc.PL
-
- Title: "perldoc -f setpwent (for example) returns no descriptive text"
- From: Tim Bunce
- Files: utils/perldoc.PL
-
- Title: "perldoc diffs: don't search auto - much faster"
- From: "Joseph N. Hall" <joseph@5sigma.com>
- Msg-ID: <MailDrop1.2d7dPPC.971012211957@screechy.cscaper.com>
- Files: utils/perldoc.PL
+NOTE: Each change entry shows the change number; who checked it into the
+repository; when; description of the change; which branch the change
+happened in; and the affected files. The file lists have a short symbolic
+indicator:
+ ! modified
+ + added
+ - deleted
+ +> branched (from elsewhere)
+ !> merged changes (from elsewhere)
----------------
-Version 5.004_03 Maintenance release 3 for 5.004
+Version 5.005_03 Third maintenance release of 5.005
----------------
-"To err is human, to forgive divine."
- -- Alexander Pope
-
-
- HEADLINES FOR THIS MAINTENANCE RELEASE
-
- Fixed 5.004_02 compilation failure on VMS.
- Fixed Configure (non)errors being displayed to user.
- Better support for Windows 95.
- Assorted documentation and hint file improvements.
- perl --foo no longer silently ignored.
-
-
- ------ BUILD PROCESS ------
-
- Title: "Show Configure failure reason even with -s"
- From: Andy Dougherty <doughera@newton.phys.lafayette.edu>
- Msg-ID: <Pine.SUN.3.96.970812141623.14256K-100000@newton.phys>
- Files: Configure
-
- Title: "Configure can stop without fully explaining itself"
- From: Jim Anderson <jander@ml.com>
- Msg-ID: <199708111328.JAA28976@nsd15.ny-swaps-develop.ml.com>,
- <199708111952.PAA29346@nsd15.ny-swaps-develop.ml.com>
- Files: Configure
-
- ------ CORE LANGUAGE ------
-
- Title: "typos in perl -h output"
- From: "Richard A. Wells" <Rwells@uhs.harvard.edu>
- Msg-ID: <6D0BF914BC@gateuhs.harvard.edu>
- Files: perl.c
-
- Title: "Some perldb -> PERLDB_* macro changes were missed"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199708100323.XAA27155@monk.mps.ohio-state.edu>
- Files: pp_ctl.c
-
- Title: "Further fix to lseek's in lockf_emulate_flock"
- From: Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
- Msg-ID: <199708060031.CAA07387@bombur2.uio.no>,
- <199708102225.AAA16970@bombur2.uio.no>
- Files: pp_sys.c
-
- Title: "GNU style perl --version (or any other --foo) ignored"
- From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Kenneth Albanowski
- <kjahds@kjahds.com>, Stephen McCamant <alias@mcs.com>
- Msg-ID: <E0wx8MO-0007BS-00@ursa.cus.cam.ac.uk>,
- <Pine.LNX.3.93.970813122557.9443C-100000@kjahds.com>,
- <m0wy8nl-000EYgC@alias-2.pr.mcs.net>
- Files: pod/perldiag.pod perl.c
-
- Title: "seen_dot declaration in perl.c needed for VMS"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199708072033.QAA09167@aatma.engin.umich.edu>
- Files: perl.c
-
- ------ DOCUMENTATION ------
-
- Title: "[PATCH] -D info in perlrun", "[PATCH] Re: -D info in perlrun"
- From: Stephen McCamant <alias@mcs.com>, ilya@math.ohio-state.edu (Ilya
- Zakharevich)
- Msg-ID: <1997Aug10.195832.2224477@hmivax.humgen.upenn.edu>,
- <m0wxNNL-000EYgC@alias-2.pr.mcs.net>,
- <m0wxz6l-000EYgC@alias-2.pr.mcs.net>
- Files: pod/perlrun.pod
-
- Title: "perlop pod inconsistent in presentation of regexp options"
- From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Hans Mulder <hansm@icgned.nl>,
- jmr@whirlwind.fmr.com
- Msg-ID: <199708061404.KAA06717@whirlwind.fmr.com>,
- <199708081505.LAA09810@whirlwind.fmr.com>,
- <1997Aug7.160530.2196011@hmivax.humgen.upenn.edu>,
- <E0wwnqc-00057s-00@ursa.cus.cam.ac.uk>,
- <E0wwswg-00017x-00@ursa.cus.cam.ac.uk>
- Files: pod/perlop.pod
-
- Title: "pod2man generated .IX lines upset whatis on Solaris"
- From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, jmr@whirlwind.fmr.com (John
- Redford)
- Msg-ID: <E0wxoUZ-0006Ee-00@ursa.cus.cam.ac.uk>
- Files: pod/pod2man.PL
-
- Title: "The description of the \Q metacharacter is confusing to novices"
- From: aml@world.std.com (Andrew M. Langmead)
- Msg-ID: <199708101946.AA06339@world.std.com>
- Files: pod/perlre.pod
-
- Title: "doc patch for pack("p",undef) packing a NULL pointer"
- From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
- Msg-ID: <9708102159.AA11726@claudius.bfsec.bt.co.uk>
- Files: pod/perldelta.pod pod/perlfunc.pod
-
- Title: "perlfunc.pod error"
- From: Tom Christiansen <tchrist@jhereg.perl.com>
- Msg-ID: <199708102235.QAA18420@jhereg.perl.com>
- Files: pod/perlfunc.pod
-
- ------ LIBRARY AND EXTENSIONS ------
-
- Title: "patch for documentation error in FileCache.pm"
- From: Mike Stok <mike@stok.co.uk>, mikebo@tellabs.com
- Msg-ID: <Pine.LNX.3.95.970810143321.437C-100000@stok.co.uk>
- Files: lib/FileCache.pm
-
- Title: "[PATCH] 5.004_02: Complex/Trig: update"
- From: Jarkko Hietaniemi <jhi@iki.fi>
- Msg-ID: <199708081842.VAA31214@alpha.hut.fi>
- Files: lib/Math/Complex.pm lib/Math/Trig.pm t/lib/complex.t
-
- Title: "CPAN Use of uninitialized value in newest perl"
- From: tom@amber.ssd.hcsc.com (Tom Horsley)
- Msg-ID: <9708091738.AA16435@amber.ssd.hcsc.com>
- Files: lib/CPAN.pm
-
- ------ PORTABILITY - WIN32 ------
-
- Title: "[PATCH] /x is not a valid shell switch on Win95"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199708121720.NAA14760@aatma.engin.umich.edu>
- Files: win32/win32.c
-
- Title: "[PATCH] Win95-proofing pl2bat"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199708121733.NAA14888@aatma.engin.umich.edu>
- Files: MANIFEST win32/Makefile win32/makefile.mk win32/bin/pl2bat.pl
- win32/bin/runperl.pl win32/bin/search.pl
- win32/bin/webget.pl
-
- Title: "[PATCH] [OK] Perl5.004_02 on Alpha NT"
- From: wmiddlet@adobe.com (William Middleton)
- Msg-ID: <199708072100.OAA13141@ducks>
- Files: win32/win32.c
-
- ------ PORTABILITY - OTHER ------
-
- Title: "Improve dual-universe comments in hints/sunos_4_1.sh"
- From: Andy Dougherty <doughera@newton.phys.lafayette.edu>
- Msg-ID: <Pine.SUN.3.96.970812170358.14488E-100000@newton.phys>
- Files: hints/sunos_4_1.sh
-
- Title: "Dynamic Loading on MkLinux (osname=linux,archname=ppc-linux)"
- From: Chris Nandor <pudge@pobox.com>, Shimpei Yamashita
- <shimpei@socrates.patnet.caltech.edu>
- Msg-ID: <33EF1634.B36B6500@pobox.com>
- Files: hints/linux.sh
-
- Title: "5.004_02 Configure - worrying but normal errors displayed to user"
- From: Paul Marquess <pmarquess@bfsec.bt.co.uk>, pmarquess@bfsec.bt.co.uk
- (Paul Marquess)
- Msg-ID: <01BCA3DE.E257BFC0.pmarquess@bfsec.bt.co.uk>,
- <9708102159.AA11726@claudius.bfsec.bt.co.uk>
- Files: Configure os2/diff.configure
-
- Title: "Minor glitch with Perl 5.004_01 on SunOS 4.1.3 (groupstype)"
- From: thad@thadlabs.com (Thad Floryan)
- Msg-ID: <9708111415.AA03808@thadlabs.com>
- Files: hints/sunos_4_1.sh
-
- Title: "SCO Openserver 5.0.4 - add comment to hint file re compiler bug"
- From: Bill Glicker <billg@burrelles.com>
- Msg-ID: <Pine.SCO.3.96.970811153021.18457A-100000@laura.burrelles.com>
- Files: hints/sco.sh
-
- ------ UTILITIES ------
-
- Title: "perlbug -d non-interactive (with patch)"
- From: Ted Ashton <ashted@southern.edu>
- Msg-ID: <199708071418.KAA15711@ns.southern.edu>
- Files: utils/perlbug.PL
-
-
+____________________________________________________________________________
+[ 3198] By: gbarr on 1999/03/28 22:21:49
+ Log: redo #3193 which #3195 undid
+ Branch: maint-5.005/perl
+ ! pod/perlhist.pod
+____________________________________________________________________________
+[ 3197] By: gbarr on 1999/03/28 21:04:04
+ Log: Updated CPAN.pm to 1.48
+ Branch: maint-5.005/perl
+ ! lib/CPAN.pm lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm
+____________________________________________________________________________
+[ 3196] By: gbarr on 1999/03/28 17:21:27
+ Log: AIX hints update from Jarkko
+ Branch: maint-5.005/perl
+ ! hints/aix.sh
+____________________________________________________________________________
+[ 3195] By: jhi on 1999/03/28 16:42:54
+ Log: Update perlhist on 5_03.
+ Branch: maint-5.005/perl
+ ! pod/perlhist.pod
+____________________________________________________________________________
+[ 3193] By: gsar on 1999/03/28 09:46:29
+ Log: =end needs matching =begin (or installhtml will croak)
+ Branch: maint-5.005/perl
+ ! pod/perlhist.pod
+____________________________________________________________________________
+[ 3192] By: gsar on 1999/03/28 09:10:15
+ Log: update pod/Makefile
+ Branch: maint-5.005/perl
+ ! pod/Makefile
+____________________________________________________________________________
+[ 3191] By: gsar on 1999/03/28 08:43:47
+ Log: integrate change#3180 from mainline
+
+ fix bogus OPf_REF context for the BLOCK in C<grep BLOCK @foo>
+ (sometimes caused bizarreness in the BLOCK)
+ Branch: maint-5.005/perl
+ +> t/op/grep.t
+ !> MANIFEST op.c
+____________________________________________________________________________
+[ 3190] By: gsar on 1999/03/28 08:29:51
+ Log: integrate change#3147 from mainline
+
+ warn about newfangled vfork() caveats
+ Branch: maint-5.005/perl
+ ! Configure
+____________________________________________________________________________
+[ 3189] By: gsar on 1999/03/28 08:22:00
+ Log: various pod niggles
+ Branch: maint-5.005/perl
+ ! pod/perl.pod pod/perldebug.pod pod/perldiag.pod
+ ! pod/perlfunc.pod pod/perlhist.pod
+____________________________________________________________________________
+[ 3188] By: gsar on 1999/03/28 07:37:43
+ Log: integrate binary compatible variant of change#3098 from mainline
+ Branch: maint-5.005/perl
+ ! op.c perl.h t/base/lex.t toke.c
+____________________________________________________________________________
+[ 3187] By: gsar on 1999/03/28 07:31:16
+ Log: regularize CAPI declarations (CAPI extensions now build under
+ the Borland compiler)
+ Branch: maint-5.005/perl
+ ! win32/GenCAPI.pl
+____________________________________________________________________________
+[ 3186] By: gsar on 1999/03/28 07:26:33
+ Log: ensure XS_LOCKS stuff happens *before* XSUB is entered under
+ -DPERL_CAPI
+ Branch: maint-5.005/perl
+ ! XSlock.h win32/GenCAPI.pl win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 3185] By: gbarr on 1999/03/28 06:37:41
+ Log: integrate change #2846 from mainline
+
+ a modified version of suggested patch for pack template 'Z'; added docs
+ From: "Valeriy E. Ushakov" <uwe@ptc.spbu.ru>
+ Date: Mon, 16 Jun 1997 03:00:31 +0400 (MSD)
+ Message-ID: <%lOHpzIuGV@snark.ptc.spbu.ru>
+ Subject: lack of pack/unpack letter with useful symmetry for C null delimited strings
+ Branch: maint-5.005/perl
+ ! pod/perldelta.pod pod/perlfunc.pod pp.c
+ !> t/op/pack.t
+____________________________________________________________________________
+[ 3184] By: gbarr on 1999/03/28 06:35:50
+ Log: integrate change # 3160 from mainline
+
+ better description of OP_UNSTACK (s/unstack/iteration finalizer/)
+ Branch: maint-5.005/perl
+ ! opcode.h opcode.pl
+____________________________________________________________________________
+[ 3182] By: gbarr on 1999/03/28 03:40:28
+ Log: Integrate changes #3067 and #3106 from mainline
+
+ exempt $foo::a,$foo::b from warnings only if sort() was seen in package foo
+ From: Graham Barr <gbarr@ti.com>
+ Date: Wed, 3 Mar 1999 17:23:56 -0600
+ Message-ID: <19990303172356.F7442@dal.asp.ti.com>
+ Subject: Re: 'use strict' doesn't work for one-letter variables
+
+ change#3067 failed package.t due to needless creation of $a and $b;
+ fixed to do that only for C<sort BLOCK|CODE @foo>, not C<sort(@foo)>
+ Branch: maint-5.005/perl
+ ! gv.c op.c t/pragma/warn-1global
+____________________________________________________________________________
+[ 3179] By: gsar on 1999/03/28 02:14:04
+ Log: fix thread segfault when passing large number of arguments to child
+ a la C<Thread->new($foo, 1..1000)>
+ Branch: maint-5.005/perl
+ ! ext/Thread/Thread.xs t/lib/thread.t
+____________________________________________________________________________
+[ 3178] By: gbarr on 1999/03/28 01:39:23
+ Log: fix $Config{'usethreads'} typo in perlthrtut
+
+ From: Ian Maloney <szhmf9@wsblob.ubs.com>
+ Date: Thu, 25 Mar 1999 16:40:14 +0100 (MET)
+ Message-Id: <199903251540.QAA02439@wsblob.>
+ Subject: perlthrtut documentation error
+ Branch: maint-5.005/perl
+ ! pod/perlthrtut.pod
+____________________________________________________________________________
+[ 3177] By: gbarr on 1999/03/28 01:09:59
+ Log: Integrate #2910 from mainline
+
+ slurping an empty file should return '' rather than undef, with
+ commensurate effects on ARGV processing
+ Branch: maint-5.005/perl
+ ! pod/perldelta.pod pp_hot.c sv.h
+ !> t/io/argv.t
+____________________________________________________________________________
+[ 3176] By: gbarr on 1999/03/28 00:00:30
+ Log: Integrate relevant doc changes from mainline
+ Branch: maint-5.005/perl
+ !> (integrate 34 files)
+____________________________________________________________________________
+[ 3175] By: gbarr on 1999/03/27 19:20:32
+ Log: Integrated #2352 and #2397 from mainline
+
+ Implement $^C to allow perl access to -c flag - I think this
+ was agreed once...
+
+ Update docs and English.pm for $^C
+ Branch: maint-5.005/perl
+ ! gv.c mg.c
+ !> lib/English.pm
+____________________________________________________________________________
+[ 3174] By: gbarr on 1999/03/27 18:21:01
+ Log: Update Copyright year
+ Branch: maint-5.005/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.h 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 util.c
+ ! util.h
+____________________________________________________________________________
+[ 3173] By: gbarr on 1999/03/27 18:19:47
+ Log: Update Test.pm to VERSION 1.122 from CPAN
+ Branch: maint-5.005/perl
+ ! lib/Test.pm
+____________________________________________________________________________
+[ 3154] By: jhi on 1999/03/24 21:40:51
+ Log: Reword the shared library search path (LD_LIBRARY_PATH) info
+ based on suggestions from Andy Dougherty.
+ Branch: maint-5.005/perl
+ ! INSTALL
+____________________________________________________________________________
+[ 3146] By: jhi on 1999/03/24 09:20:14
+ Log: Bring in changes #2808 and #2812 (from mainline perl)
+ that enhance the perlbug checklist.
+ Branch: maint-5.005/perl
+ ! utils/perlbug.PL
+____________________________________________________________________________
+[ 3130] By: jhi on 1999/03/23 22:02:23
+ Log: Don't use config.msg to remind about the
+ LD_LIBRARY_PATH because Makefile.SH takes
+ care of that.
+
+ Use shrplib in DEC O^W^Digital U^W^WTru64 UNIX.
+ This used to be the default but in some MT or another it
+ was dropped because of some transient error or another.
+ Branch: maint-5.005/perl
+ ! Configure hints/dec_osf.sh
+____________________________________________________________________________
+[ 3122] By: jhi on 1999/03/19 21:12:14
+ Log: Describe the new Benchmark feature in more detail.
+ Branch: cfgperl
+ ! pod/perldelta.pod
+ Branch: maint-5.005/perl
+ ! pod/perldelta.pod
+____________________________________________________________________________
+[ 3121] By: jhi on 1999/03/19 08:16:12
+ Log: AVAILABILITY tuning.
+ Branch: cfgperl
+ ! pod/perl.pod
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+____________________________________________________________________________
+[ 3119] By: jhi on 1999/03/17 14:33:43
+ Log: More Apollo fixes.
+ Branch: maint-5.005/perl
+ ! README.apollo hints/apollo.sh t/lib/io_udp.t
+____________________________________________________________________________
+[ 3118] By: jhi on 1999/03/16 17:23:39
+ Log: Nada.
+ Branch: maint-5.005/perl
+ ! README.apollo
+____________________________________________________________________________
+[ 3117] By: jhi on 1999/03/16 17:18:49
+ Log: Apollo DomainOS AVAILABILITY.
+ Branch: cfgperl
+ ! pod/perl.pod
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+____________________________________________________________________________
+[ 3116] By: jhi on 1999/03/16 17:14:00
+ Log: Apollo DomainOS patch
+ From: Johann Klasek <jk@auto.tuwien.ac.at>
+ Subject: Re: DomainPerl
+ Date: Tue, 16 Mar 1999 17:46:32 +0100
+ Message-ID: <19990316174632.A19759@euklid.auto.tuwien.ac.at>
+ Branch: maint-5.005/perl
+ + README.apollo apollo/netinet/in.h
+ ! MANIFEST hints/apollo.sh
+____________________________________________________________________________
+[ 3115] By: jhi on 1999/03/16 14:23:54
+ Log: From: Paul Marquess <pmarquess@bfsec.bt.co.uk>
+ To: Gurusamy Sarathy <gsar@activestate.com>,
+ Graham Barr <gbarr@pobox.com>
+ Cc: Perl5 Porters <perl5-porters@perl.org>,
+ "Paul.Marquess" <Paul.Marquess@btinternet.com>
+ Subject: [PATCH 5.005_56 & 5.005_03_T6] Upgrade DB_File to version 1.65
+ Date: Sun, 14 Mar 1999 14:43:57 -0000
+ Message-Id: <199903141841.NAA17040@defender.perl.org>
+ Branch: maint-5.005/perl
+ ! ext/DB_File/Changes ext/DB_File/DB_File.pm
+ ! ext/DB_File/DB_File.xs ext/DB_File/typemap
+____________________________________________________________________________
+[ 3114] By: jhi on 1999/03/16 12:42:20
+ Log: Mention Rhapsody in 5.005_5X perldelta,
+ and in Rhapsody and Netware in 5.005_0X and 5.005_5X
+ *planned* AVAILABILITY.
+ Branch: cfgperl
+ ! pod/perl.pod pod/perldelta.pod
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+____________________________________________________________________________
+[ 3113] By: jhi on 1999/03/16 10:38:53
+ Log: perldelta niggling.
+ Branch: cfgperl
+ ! pod/perldelta.pod
+ Branch: maint-5.005/perl
+ ! pod/perldelta.pod
+____________________________________________________________________________
+[ 3111] By: jhi on 1999/03/16 10:28:10
+ Log: AVAILABILITY update: still mention PowerUX,
+ Novell Netware now has sources available.
+ Branch: cfgperl
+ ! pod/perl.pod
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+____________________________________________________________________________
+[ 3105] By: jhi on 1999/03/12 15:54:57
+ Log: Recognize the NetBSD packages collection.
+ Branch: maint-5.005/perl
+ ! hints/netbsd.sh
+____________________________________________________________________________
+[ 3104] By: jhi on 1999/03/12 09:07:04
+ Log: From: pvhp@forte.com (Peter Prymmer)
+ To: jhi@iki.fi, perl-mvs@perl.org, perlbug@perl.com
+ Subject: [PATCH MT6,_56] was Re: Not OK: perl 5.00503 +MAINT_TRIAL_6 on os390 06.00 (UNINSTALLED)
+ Date: Thu, 11 Mar 99 14:24:54 PST
+ Message-Id: <9903112224.AA24346@forte.com>
+ Branch: maint-5.005/perl
+ ! README.os390 t/lib/posix.t
+____________________________________________________________________________
+[ 3102] By: jhi on 1999/03/10 11:01:20
+ Log: From: pvhp@forte.com (Peter Prymmer)
+ To: perl5-porters@perl.org
+ Subject: [5.005_03-MT6]Patch: time passes
+ Date: Tue, 9 Mar 99 18:42:17 PST
+ Message-Id: <9903100242.AA29057@forte.com>
+ Branch: maint-5.005/perl
+ ! perl.c
+____________________________________________________________________________
+[ 3101] By: jhi on 1999/03/10 10:30:15
+ Log: From: Mark-Jason Dominus <mjd@plover.com>
+ To: perl5-porters@perl.com
+ Subject: Minor fix to perlfunc.pod
+ Date: Mon, 08 Mar 1999 20:05:53 -0500
+ Message-ID: <19990309010553.13757.qmail@plover.com>
+ Branch: maint-5.005/perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 3094] By: jhi on 1999/03/06 16:16:15
+ Log: From: Mark Kettenis <kettenis@wins.uva.nl>
+ To: jhi@iki.fi
+ Subject: Oops
+ Date: Sat, 6 Mar 1999 17:15:35 +0100 (CET)
+ Message-Id: <199903061615.RAA00207@delius.kettenis.nl>
+ Branch: maint-5.005/perl
+ ! README.hurd
+____________________________________________________________________________
+[ 3093] By: jhi on 1999/03/06 15:59:46
+ Log: From: Mark Kettenis <kettenis@wins.uva.nl>
+ To: jhi@iki.fi
+ Subject: New Hurd README
+ Date: Sat, 6 Mar 1999 16:46:12 +0100 (CET)
+ Message-Id: <199903061601.RAA00185@delius.kettenis.nl>
+ Branch: maint-5.005/perl
+ ! README.hurd
+____________________________________________________________________________
+[ 3092] By: jhi on 1999/03/06 12:52:06
+ Log: From: Paul_Green@stratus.com
+ To: perl5-porters@perl.org
+ Cc: jhi@iki.fi, Paul_Green@stratus.com
+ Subject: [PATCH 5.005_03-MAINT_TRIAL_6]: platform: vos -- updates to VOS port of Perl5
+ Date: Fri, 5 Mar 1999 18:08:49 -0500
+ Message-ID: <1D1A4EF7AD4DD211A80D00A0C9D7DB665A035A@exna1.stratus.com>
+ Branch: maint-5.005/perl
+ ! vos/config.h vos/config_h.SH_orig
+____________________________________________________________________________
+[ 3091] By: jhi on 1999/03/06 12:42:21
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ To: perl5-porters@perl.org, vmsperl@perl.org
+ Subject: [PATCH 5.005_03-MT6]VMS build patch
+ Date: Fri, 05 Mar 1999 12:36:19 -0800
+ Message-Id: <3.0.6.32.19990305123619.02d326a0@ous.edu>
+ Branch: maint-5.005/perl
+ ! vms/subconfigure.com
+____________________________________________________________________________
+[ 3090] By: gsar on 1999/03/06 04:40:03
+ Log: integrate change#3089 from mainline
+
+ tolerate CRs after options
+ Branch: maint-5.005/perl
+ !> perl.c
+____________________________________________________________________________
+[ 3086] By: gbarr on 1999/03/05 01:48:05
+ Log: #3085 was a bit premature, this is MT6 as 2 files were
+ missing from MANIFEST
+ Branch: maint-5.005/perl
+ ! MANIFEST
+____________________________________________________________________________
+[ 3085] By: gbarr on 1999/03/05 01:41:06
+ Log: Trial release 6
+ Branch: maint-5.005/perl
+ ! Changes
+____________________________________________________________________________
+[ 3084] By: gbarr on 1999/03/05 01:34:07
+ Log: Don't process - as a file in Errno_pm.PL
+
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Thu, 4 Mar 1999 13:29:23 +0200 (EET)
+ Message-ID: <14046.28307.561693.849859@alpha.hut.fi>
+ Subject: Re: maint-5.005
+ Branch: maint-5.005/perl
+ ! ext/Errno/Errno_pm.PL
+____________________________________________________________________________
+[ 3081] By: gsar on 1999/03/05 00:14:33
+ Log: protect against doubled backslashes
+ Branch: maint-5.005/perl
+ ! ext/Errno/Errno_pm.PL
+____________________________________________________________________________
+[ 3080] By: gsar on 1999/03/04 23:37:20
+ Log: pick up AIX hints from mainline
+ Branch: maint-5.005/perl
+ !> hints/aix.sh
+____________________________________________________________________________
+[ 3079] By: gsar on 1999/03/04 21:09:43
+ Log: tweak cast and crew
+ Branch: maint-5.005/perl
+ ! Changes
+____________________________________________________________________________
+[ 3078] By: gsar on 1999/03/04 21:03:04
+ Log: update patchlevel, Changes
+ Branch: maint-5.005/perl
+ ! Changes README.win32 patchlevel.h
+ !> pod/perlhist.pod
+____________________________________________________________________________
+[ 3075] By: gsar on 1999/03/04 07:36:53
+ Log: integrate changes#3037,3041 from mainline
+
+ fix longstanding bug: searches for lexicals originating within eval''
+ weren't stopping at the subroutine boundary correctly
+ --
+ fix subtle bug in eval'' testsuite
+ Branch: maint-5.005/perl
+ !> op.c proto.h t/op/eval.t
+____________________________________________________________________________
+[ 3074] By: gsar on 1999/03/04 07:32:15
+ Log: integrate change#3048 from mainline
+
+ updated HP-UX notes from Jeff Okamoto <okamoto@xfiles.intercon.hp.com>
+ Branch: maint-5.005/perl
+ !> MANIFEST README.hpux
+____________________________________________________________________________
+[ 3073] By: gsar on 1999/03/04 07:29:43
+ Log: integrate changes#3014,3015,3021,3032,3034,3045 from mainline
+
+ more "correct" utbuf for utime()
+ --
+ avoid modifying readonly values from qw()
+ --
+ ansify perlio.c, fix PerlIO-ish typos
+ --
+ add README.hpux
+ --
+ s/print STDERR/warn/ suggested by abigail@fnx.com; add $VERSION
+ --
+ destroy PL_svref_mutex in perl_destruct()
+ Branch: maint-5.005/perl
+ +> README.hpux
+ !> MANIFEST doio.c ext/DynaLoader/dl_beos.xs
+ !> ext/DynaLoader/dl_cygwin32.xs iperlsys.h
+ !> lib/ExtUtils/MM_Unix.pm lib/Getopt/Std.pm perl.c perlio.c
+____________________________________________________________________________
+[ 3072] By: gsar on 1999/03/04 07:12:15
+ Log: integrate changes#2978,2979 from mainline
+
+ bring '*' prototype closer to how it behaves internally
+ --
+ doc for change#2978
+ Branch: maint-5.005/perl
+ +> t/lib/fatal.t
+ !> MANIFEST lib/Fatal.pm op.c pod/perlsub.pod t/comp/proto.t
+____________________________________________________________________________
+[ 3071] By: gsar on 1999/03/04 07:05:50
+ Log: integrate changes#2919,2920,2921,2928,2932,2933 from mainline
+
+ applied suggested patch, with several language/readability tweaks
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Fri, 29 Jan 1999 00:25:02 -0500
+ Message-ID: <19990129002502.C2898@monk.mps.ohio-state.edu>
+ Subject: Re: [PATCH 5.005_*] Better parsing docs
+ --
+ tweak READ() docs to mention $buffer must be altered by reference
+ --
+ use New() et al., rather than safemalloc() et al.
+ From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Fri, 29 Jan 1999 23:27:22 +0100
+ Message-ID: <36bd33f2.51029616@smtp1.ibm.net>
+ Subject: [PATCH _03-MT5] POSIX.xs memory API
+ --
+ allow the Carp routines to pass through exception objects
+ --
+ clarify what a "line" is
+ --
+ From: "J. van Krieken" <John.van.Krieken@ATComputing.nl>
+ Date: Thu, 4 Feb 1999 17:25:25 +0100 (MET)
+ Message-Id: <199902041625.RAA14489@atcmpg.ATComputing.nl>
+ Subject: s2p incorrectly handles hold space commands
+ Branch: maint-5.005/perl
+ !> ext/POSIX/POSIX.xs lib/Carp.pm pod/perlfunc.pod pod/perlop.pod
+ !> pod/perltie.pod pod/perlvar.pod x2p/s2p.PL
+____________________________________________________________________________
+[ 3070] By: gsar on 1999/03/04 06:43:57
+ Log: integrate changes#2748,2753,2754,2819,2824,2855,2866,2867,2869,2885,2888,2889
+ from mainline
+
+ From: "Jonathan I. Kamens" <jik@kamens.brookline.ma.us>
+ Date: Thu, 3 Dec 1998 15:10:17 -0500
+ Message-Id: <199812032010.PAA09692@jik.shore.net>
+ Subject: sample checksum code in "perlfunc" man page is wrong
+ --
+ Todo tweaks
+ --
+ Todo updates from Andy Dougherty <doughera@lafayette.edu>
+ --
+ avoid garbage in db->dirbuf
+ From: Masahiro KAJIURA <masahiro.kajiura@toshiba.co.jp>
+ Date: Sat, 05 Dec 1998 14:14:54 +0900
+ Message-Id: <199812050514.OAA23268@toshiba.co.jp>
+ Subject: SDBM bug
+ --
+ tweak doc on bitwise ops
+ --
+ applied suggested patch; added tests
+ From: Adam Krolnik <adamk@gypsy.cyrix.com>
+ Date: Sat, 12 Dec 98 15:30:18 -0600
+ Message-Id: <9812122130.AA03717@gypsy.eng.cyrix.com>
+ Subject: Range operation doesn't handle IV_MAX
+ --
+ display full pathname of unreadable files
+ --
+ av_extend() doc tweak from Jan Dubois
+ --
+ update win32/pod.mak
+ --
+ note how to find REG_INFTY limit
+ --
+ add note about test-notty target
+ --
+ tweak PERL_STRICT_CR notes
+ Branch: maint-5.005/perl
+ !> Porting/pumpkin.pod README.win32 Todo Todo-5.005
+ !> ext/SDBM_File/sdbm/sdbm.c pod/perldelta.pod pod/perlfunc.pod
+ !> pod/perlguts.pod pod/perlop.pod pod/perlre.pod pp_ctl.c
+ !> t/op/range.t utils/perldoc.PL win32/pod.mak
+____________________________________________________________________________
+[ 3069] By: gsar on 1999/03/04 06:02:29
+ Log: integrate change#2747 from mainline
+
+ typos in Pod/Text.pm
+ Branch: maint-5.005/perl
+ !> lib/Pod/Text.pm
+____________________________________________________________________________
+[ 3059] By: jhi on 1999/03/03 22:46:43
+ Log: Document HP-UX 11 Y2K patch effect, based on
+
+ From: "Richard L. England" <richard_england@mentorg.com>
+ To: perlbug@perl.com
+ CC: "England, Richard" <richard_england@mentorg.com>
+ Subject: test io/fs.t number 18 fails on HPUX 11.0 when Y2K patch installed.
+ Date: Fri, 26 Feb 1999 15:35:49 -0800
+ Message-ID: <36D72FD4.4136C84F@mentorg.com>
+ Branch: maint-5.005/perl
+ ! INSTALL
+____________________________________________________________________________
+[ 3057] By: jhi on 1999/03/03 21:42:22
+ Log: The *symbols patch (for Kurt's h2ph fixes) haunted us in AIX.
+ Branch: maint-5.005/perl
+ ! Configure
+____________________________________________________________________________
+[ 3056] By: jhi on 1999/03/03 21:21:46
+ Log: Fixed the pthreads_created_joinable test messed up
+ by the Mach cthreads change.
+ Branch: maint-5.005/perl
+ ! Configure
+____________________________________________________________________________
+[ 3055] By: jhi on 1999/03/03 18:17:55
+ Log: Configure and make gotchas.
+ Branch: maint-5.005/perl
+ ! INSTALL
+____________________________________________________________________________
+[ 3051] By: jhi on 1999/03/02 08:24:52
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ To: perl5-porters@perl.org, vmsperl@perl.org
+ Subject: [PATCH 5.005_0x and 5.005_5x]Minor update to README.VMS
+ Date: Mon, 01 Mar 1999 16:10:57 -0800
+ Message-Id: <3.0.6.32.19990301161057.03b1fc00@ous.edu>
+ Branch: cfgperl
+ ! README.vms
+ Branch: maint-5.005/perl
+ ! README.vms
+____________________________________________________________________________
+[ 3049] By: jhi on 1999/03/02 07:34:21
+ Log: From: Spider Boardman <spider@leggy.zk3.dec.com>
+ To: perl5-porters@perl.org
+ Subject: [PATCH] Eliminate (valid) warning in byterun.c
+ Date: Mon, 01 Mar 1999 17:27:59 -0500
+ Message-Id: <199903012227.RAA00181@leggy.zk3.dec.com>
+ Branch: cfgperl
+ ! bytecode.h
+ Branch: maint-5.005/perl
+ ! bytecode.h
+____________________________________________________________________________
+[ 3028] By: jhi on 1999/02/26 14:40:00
+ Log: HP-UX 11 threads.
+
+ From: Jeff Okamoto <okamoto@xfiles.intercon.hp.com>
+ To: perl5-porters@perl.org
+ Cc: jhi@cc.hut.fi
+ Subject: Maint 5 and _54 with threading on HP-UX 11.00
+ Date: Wed, 3 Feb 1999 12:57:18 -0800 (PST)
+ Message-Id: <199902032057.MAA10218@xfiles.intercon.hp.com>
+
+ NOTE from jhi: the hpux hints could still be more robust by
+ disabling gdbm when necessary.
+
+ Currently if there's a libgdbm.sl (gdbm 1.7.3) which is pre-11,
+ linking -lgdbm -lpthread creates an executable that instantly
+ core dumps on a pthreads internal panic:
+
+ ./gdpt
+
+ Pthread internal error: message: __libc_reinit() failed, file: ../pthreads/pthread.c, line: 1096
+ Return Pointer is 0xc082bf33
+ 17639 quit (core dumped) ./gdpt
+
+ You don't have to *use* either gdbm or pthreads in the executable,
+ just linking them together is enough. Workaround is to recompile
+ the GDBM under HP-UX 11, that makes the problem to go away.
+ Branch: maint-5.005/perl
+ ! hints/hpux.sh thread.h
+____________________________________________________________________________
+[ 3027] By: jhi on 1999/02/26 09:04:29
+ Log: From: abigail@fnx.com
+ To: perl5-porters@perl.org (Perl Porters)
+ Subject: [PATCH 5.005_02 Getopt::Std] warn() instead of print STDERR.
+ Date: Thu, 25 Feb 1999 22:08:41 -0500 (EST)
+ Message-ID: <19990226030841.5985.qmail@alexandra.wayne.fnx.com>
+ Branch: maint-5.005/perl
+ ! lib/Getopt/Std.pm
+____________________________________________________________________________
+[ 3026] By: jhi on 1999/02/26 08:18:26
+ Log: full_ar wasn't propagated.
+ Branch: maint-5.005/perl
+ ! Configure
+____________________________________________________________________________
+[ 3013] By: jhi on 1999/02/22 19:27:44
+ Log: Fix MacPerl version, change PowerUX to PowerMAX.
+
+ From: Chris Nandor <pudge@pobox.com>
+ To: jhi@iki.fi
+ Cc: perl5-porters@perl.org
+ Subject: Re: perl current availability as documented by perl.pod
+ Date: Sun, 21 Feb 1999 11:06:03 -0500
+ Message-Id: <v04020a07b2f5df60c9e3@[192.168.0.77]>
+
+ From: Tom Horsley <Tom.Horsley@mail.ccur.com>
+ To: jhi@iki.fi
+ Cc: perl5-porters@perl.org
+ Subject: Re: perl current availability as documented by perl.pod
+ Date: Mon, 22 Feb 1999 13:08:30 GMT
+ Message-Id: <199902221308.NAA19971@cleo.ccur.com>
+ Branch: cfgperl
+ ! pod/perl.pod
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+____________________________________________________________________________
+[ 3010] By: jhi on 1999/02/22 10:21:55
+ Log: From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ To: gbarr@pobox.com (Graham Barr)
+ Cc: perl5-porters@perl.org
+ Subject: [PATCH 5.005_03-MT5] DB_File 1.64 patch
+ Date: Mon, 22 Feb 1999 10:12:34 +0000 (GMT)
+ Message-Id: <9902221012.AA17784@claudius.bfsec.bt.co.uk>
+ Branch: maint-5.005/perl
+ ! ext/DB_File/Changes ext/DB_File/DB_File.pm
+ ! ext/DB_File/DB_File.xs ext/DB_File/typemap t/lib/db-recno.t
+____________________________________________________________________________
+[ 3005] By: jhi on 1999/02/22 08:35:30
+ Log: Configure/Perl knew how to look for use Mach cthreads
+ but Configure didn't let them to be used ($osname 'next').
+ Branch: cfgperl
+ ! Configure config_h.SH
+ Branch: maint-5.005/perl
+ ! Configure
+____________________________________________________________________________
+[ 3004] By: jhi on 1999/02/21 15:46:02
+ Log: Update Acorn AVAILABILITY.
+ Branch: cfgperl
+ ! pod/perl.pod
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+____________________________________________________________________________
+[ 3003] By: jhi on 1999/02/21 14:50:42
+ Log: From: rjk@linguist.dartmouth.edu (Ronald J. Kimball)
+ To: perl5-porters@perl.org (Perl 5 Porters)
+ Subject: PATCH: perlref.pod - symbolic ref example
+ Date: Sat, 20 Feb 1999 17:32:11 -0500 (EST)
+ Message-Id: <199902202232.RAA62306@linguist.dartmouth.edu>
+ Branch: cfgperl
+ ! pod/perlref.pod
+ Branch: maint-5.005/perl
+ ! pod/perlref.pod
+____________________________________________________________________________
+[ 3000] By: jhi on 1999/02/21 14:15:31
+ Log: pack s/l for negative numbers was broken on platforms
+ where sizeof(short) != 2 or sizeof(long) != 4 (Alpha, Cray).
+ pack v was broken for sizeof(short) == 8 big-endian platforms
+ (Cray), only zeros were produced.
+ Branch: maint-5.005/perl
+ ! perl.h pod/perlfunc.pod pp.c t/op/pack.t
+____________________________________________________________________________
+[ 2997] By: jhi on 1999/02/20 14:00:26
+ Log: Glossary update.
+ Branch: maint-5.005/perl
+ ! Porting/Glossary
+____________________________________________________________________________
+[ 2995] By: jhi on 1999/02/20 12:25:10
+ Log: Document #2893, Mach cthreads support.
+ Branch: maint-5.005/perl
+ ! pod/perldelta.pod
+____________________________________________________________________________
+[ 2986] By: jhi on 1999/02/19 23:26:34
+ Log: Remove the unnecessary osf1 -D__LANGUAGE_C__.
+ Branch: maint-5.005/perl
+ ! Configure
+____________________________________________________________________________
+[ 2983] By: jhi on 1999/02/19 20:35:51
+ Log: Mach cthreads:
+ From: brie@corp.home.net (Brian Harrison)
+ Subject: perl5.005_02 patch for mthreads
+ To: perl5-porters@perl.org
+ Date: Fri, 23 Oct 1998 14:20:57 -0700 (PDT)
+ Message-ID: <Pine.GSO.4.04.9810231410220.11111-200000@sulaco.eos.home.net>
+ Branch: maint-5.005/perl
+ ! Configure Porting/Glossary config_h.SH malloc.c perl.h
+ ! thread.h
+____________________________________________________________________________
+[ 2981] By: jhi on 1999/02/19 19:49:03
+ Log: From: "Kurt D. Starsinic" <kstar@chapin.edu>
+ To: Chaim Frenkel <chaimf@pobox.com>,
+ Russ Allbery <rra@stanford.edu>,
+ Jarkko Hietaniemi <jhi@iki.fi>,
+ Gurusamy Sarathy <gsar@activestate.com>,
+ Graham Barr <gbarr@pobox.com>
+ Cc: bdensch@ameritech.net, perlbug@perl.com
+ Subject: [PATCH] Re: Solaris 7 for Intel
+ Message-ID: <19990219124404.A30182@O2.chapin.edu>
+
+ and Glossary update.
+ Branch: maint-5.005/perl
+ ! Configure Makefile.SH Porting/Glossary
+____________________________________________________________________________
+[ 2980] By: gbarr on 1999/02/19 16:06:53
+ Log: Make result of h2xs work when user adds C<use strict>
+ Branch: maint-5.005/perl
+ ! utils/h2xs.PL
+____________________________________________________________________________
+[ 2976] By: gsar on 1999/02/18 21:54:09
+ Log: integrate change#2975 from mainline
+
+ distinguish eval'' from BEGIN|INIT|END CVs (fixes buggy propagation
+ of lexical searches in BEGIN|INIT|END)
+ Branch: maint-5.005/perl
+ !> cop.h cv.h op.c perly.c perly.y pp_ctl.c t/op/misc.t
+ !> vms/perly_c.vms
+____________________________________________________________________________
+[ 2971] By: jhi on 1999/02/18 11:14:24
+ Log: AIX syscalls.exp scan missed explicitly 32/64-bit syscalls.
+
+ From: Joe Buehler <jhpb@hekimian.com>
+ To: perl5-porters@perl.org
+ Subject: setsid not detected by perl 5.005_02 configure under AIX 4.3
+ Date: 12 Feb 1999 11:25:21 -0500
+ Message-ID: <yd3lni3613i.fsf@ganymede.hekimian.com>
+ Branch: maint-5.005/perl
+ ! Configure
+____________________________________________________________________________
+[ 2967] By: jhi on 1999/02/17 23:12:59
+ Log: Make SCO/Unixware scan to work in Unixware, too.
+
+ From: Tom Hughes <thh@cyberscience.com>
+ To: perlbug@perl.com
+ Subject: Not OK: perl 5.00555 on i386-svr4 [actually Unixware 2.1] (UNINSTALLED)
+ Date: 17 Feb 1999 15:34:15 +0000
+ Message-ID: <yekg185nix4.fsf@elva.cyberscience.com>
+ Branch: maint-5.005/perl
+ ! Configure
+____________________________________________________________________________
+[ 2956] By: jhi on 1999/02/15 21:03:28
+ Log: OpenBSD sparc SHMLBA (like change #2945).
+ Branch: maint-5.005/perl
+ ! ext/IPC/SysV/SysV.xs
+____________________________________________________________________________
+[ 2950] By: jhi on 1999/02/15 13:37:28
+ Log: AVAILABILITY sync.
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+____________________________________________________________________________
+[ 2906] By: jhi on 1999/02/13 14:55:47
+ Log: AVAILABILITY sync.
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+____________________________________________________________________________
+[ 2905] By: gsar on 1999/02/13 00:12:53
+ Log: integrate change#2898 from mainline
+
+ support win32_putenv()
+ Branch: maint-5.005/perl
+ !> mg.c util.c win32/GenCAPI.pl win32/makedef.pl win32/perlhost.h
+ !> win32/win32.c win32/win32iop.h
+____________________________________________________________________________
+[ 2904] By: jhi on 1999/02/12 21:23:30
+ Log: Add README.hurd, from Mark Kettenis <kettenis@wins.uva.nl>.
+ Branch: maint-5.005/perl
+ + README.hurd
+ ! MANIFEST
+____________________________________________________________________________
+[ 2900] By: jhi on 1999/02/12 12:07:28
+ Log: SCO ODT/OSR release scanning.
+ Branch: maint-5.005/perl
+ ! Configure
+____________________________________________________________________________
+[ 2897] By: jhi on 1999/02/12 11:24:25
+ Log: Undo a big bad paste from change #2884.
+ Branch: maint-5.005/perl
+ ! hints/openbsd.sh
+____________________________________________________________________________
+[ 2896] By: jhi on 1999/02/12 11:19:52
+ Log: Update the error message of db-recno.t to DB version 1.86
+ and the URL to www.sleepycat.com instead of www.bostic.com.
+ Branch: maint-5.005/perl
+ ! t/lib/db-recno.t
+____________________________________________________________________________
+[ 2895] By: gsar on 1999/02/12 11:18:59
+ Log: integrate change#2854 from mainline
+
+ compatibility fix: magic non-propagation in foreach implicit localization
+ Branch: maint-5.005/perl
+ !> pp_ctl.c t/op/local.t
+____________________________________________________________________________
+[ 2884] By: jhi on 1999/02/12 08:36:14
+ Log: OpenBSD pthreads awareness, thanks to
+ David Leonard <david.leonard@csee.uq.edu.au>
+ Branch: maint-5.005/perl
+ ! Configure hints/openbsd.sh
+____________________________________________________________________________
+[ 2883] By: jhi on 1999/02/12 08:29:51
+ Log: AVAILABILITY sync.
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+____________________________________________________________________________
+[ 2878] By: jhi on 1999/02/11 22:00:50
+ Log: Replace changes #2783, #2784, #2785, with a single tested
+ patch from Francois Desarmenien <desar@club-internet.fr>.
+ Branch: maint-5.005/perl
+ ! MANIFEST ext/GDBM_File/hints/sco.pl ext/IPC/SysV/SysV.xs
+ ! hints/sco.sh
+____________________________________________________________________________
+[ 2876] By: jhi on 1999/02/11 20:43:17
+ Log: From: Chris Nandor <pudge@pobox.com>
+ To: perl5-porters@perl.org
+ Subject: [PATCH] perlport.pod 1.39
+ Date: Thu, 11 Feb 1999 12:28:35 -0500
+ Message-Id: <v04020a2db2e8c3177123@[192.168.0.77]>
+ Branch: maint-5.005/perl
+ ! pod/perlport.pod
+____________________________________________________________________________
+[ 2875] By: jhi on 1999/02/11 20:35:08
+ Log: The fpsetmask() really is SCO5 only.
+ Branch: maint-5.005/perl
+ ! unixish.h
+____________________________________________________________________________
+[ 2874] By: jhi on 1999/02/11 20:32:06
+ Log: Change #2783 missed these.
+ Branch: maint-5.005/perl
+ ! ext/IPC/SysV/SysV.xs unixish.h
+____________________________________________________________________________
+[ 2873] By: jhi on 1999/02/11 20:27:45
+ Log: Import the change #2810 from cfgperl.
+ Branch: maint-5.005/perl
+ + ext/GDBM_File/hints/sco.pl
+ ! MANIFEST hints/sco.sh unixish.h
+____________________________________________________________________________
+[ 2872] By: jhi on 1999/02/11 19:57:37
+ Log: Sync the current AVAILABILITY.
+ Branch: maint-5.005/perl
+ ! pod/perl.pod pod/perldelta.pod
+____________________________________________________________________________
+[ 2871] By: jhi on 1999/02/11 19:42:54
+ Log: Copied the GNU/Hurd hints file over from cfgperl
+ because it works well enough (there are still some
+ rough edges in Hurd), verified via private
+ email from Mark Kettenis <kettenis@wins.uva.nl>
+ Branch: maint-5.005/perl
+ + hints/gnu.sh
+____________________________________________________________________________
+[ 2864] By: jhi on 1999/02/11 08:45:00
+ Log: From: Spider Boardman <spider@zk3.dec.com>
+ To: perlbug@perl.com
+ Subject: Not OK: perl 5.00503 +MAINT_TRIAL_5 on RISC-ultrix 4.4 (UNINSTALLED)
+ Date: Wed, 10 Feb 1999 23:33:31 -0500
+ Message-Id: <9902110433.AA12816@abyss.zk3.dec.com>
+ Branch: maint-5.005/perl
+ ! doio.c ext/IPC/SysV/SysV.xs hints/ultrix_4.sh
+____________________________________________________________________________
+[ 2863] By: jhi on 1999/02/11 08:35:35
+ Log: AVAILABILITY.
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+____________________________________________________________________________
+[ 2858] By: gsar on 1999/02/11 07:10:59
+ Log: remove dup hunk
+ Branch: maint-5.005/perl
+ ! pod/perldelta.pod
+____________________________________________________________________________
+[ 2857] By: gsar on 1999/02/11 07:09:20
+ Log: sync with parent version of perldelta.pod
+ Branch: maint-5.005/perl
+ !> pod/perldelta.pod
+____________________________________________________________________________
+[ 2853] By: gsar on 1999/02/11 00:33:06
+ Log: integrate change#2816 from mainline
+
+ minor bug in dumping blessed subrefs
+ Branch: maint-5.005/perl
+ !> ext/Data/Dumper/Dumper.pm
+____________________________________________________________________________
+[ 2852] By: gsar on 1999/02/10 23:17:49
+ Log: fair warning about -Dusethreads
+ Branch: maint-5.005/perl
+ ! Configure INSTALL README.threads
+____________________________________________________________________________
+[ 2851] By: jhi on 1999/02/10 23:00:39
+ Log: Snapshot of the ongoing AVAILABILITY discussion.
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+____________________________________________________________________________
+[ 2850] By: jhi on 1999/02/10 16:07:32
+ Log: OS390 and Windows AVAILABILITY entries enhanced.
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+____________________________________________________________________________
+[ 2849] By: jhi on 1999/02/10 12:39:46
+ Log: AS/400 and Mac were not described right.
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+____________________________________________________________________________
+[ 2848] By: jhi on 1999/02/10 09:13:49
+ Log: Added AVAILABILITY section.
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+____________________________________________________________________________
+[ 2837] By: jhi on 1999/02/08 14:51:39
+ Log: Fix typo introduced in change #2836.
+ Branch: maint-5.005/perl
+ ! Configure
+____________________________________________________________________________
+[ 2836] By: jhi on 1999/02/08 14:44:31
+ Log: Augment change #2809, the h2ph-*symbols patch.
+ Branch: maint-5.005/perl
+ ! Configure t/lib/h2ph.pht
+____________________________________________________________________________
+[ 2815] By: gsar on 1999/02/05 03:44:50
+ Log: integrate change#2242 from mainline
+
+ fix skipspace() to properly account for newlines in eval''-ed
+ strings (caused bogus line numbers in diagnostics and debugger)
+ Branch: maint-5.005/perl
+ !> toke.c
+____________________________________________________________________________
+[ 2814] By: jhi on 1999/02/04 21:21:39
+ Log: Stratus perlport update.
+ Branch: maint-5.005/perl
+ ! pod/perlport.pod
+____________________________________________________________________________
+[ 2813] By: jhi on 1999/02/04 21:16:54
+ Log: Stratus VOS update.
+
+ From: Paul_Green@stratus.com
+ To: jhi@iki.fi
+ Subject: RE: VOS changes for Perl5.005_03 are ready!
+ Date: Thu, 4 Feb 1999 14:51:07 -0500
+ Message-ID: <1D1A4EF7AD4DD211A80D00A0C9D7DB665A0168@exna1.stratus.com>
+ Branch: maint-5.005/perl
+ + vos/vos_accept.c
+ ! MANIFEST README.vos perl.c pod/perlport.pod vos/Changes
+ ! vos/build.cm vos/compile_perl.cm vos/config.h
+ ! vos/config_h.SH_orig vos/perl.bind vos/test_vos_dummies.c
+ ! vos/vos_dummies.c vos/vosish.h
+____________________________________________________________________________
+[ 2809] By: jhi on 1999/02/03 19:54:16
+ Log: h2ph fixes + Configure patch to support them.
+
+ From: "Kurt D. Starsinic" <kstar@chapin.edu>
+ To: Graham Barr <gbarr@pobox.com>, Jarkko Hietaniemi <jhi@iki.fi>,
+ Gurusamy Sarathy <gsar@engin.umich.edu>
+ Cc: perl5-porters@perl.org
+ Subject: [PATCH 5.00503_MT5] h2ph.PL
+ Date: Tue, 2 Feb 1999 19:48:06 -0500
+ Message-ID: <19990202194806.E10647@O2.chapin.edu>
+ Branch: maint-5.005/perl
+ ! Configure utils/h2ph.PL
+____________________________________________________________________________
+[ 2802] By: jhi on 1999/02/02 17:41:23
+ Log: From: John Bley <jbb6@acpub.duke.edu>
+ To: perlbug@perl.org
+ Subject: [PATCH]5.005_54 (DOC) fix minor typos
+ Date: Tue, 2 Feb 1999 07:52:52 -0500 (EST)
+ Message-ID: <Pine.SOL.3.91.990202075115.23589A-100000@soc11.acpub.duke.edu>
+ Branch: maint-5.005/perl
+ ! pod/perlre.pod
+____________________________________________________________________________
+[ 2790] By: jhi on 1999/02/02 16:51:45
+ Log: Re-introduce the typo corrections (update to CGI 2.46
+ overran them).
+ Branch: maint-5.005/perl
+ ! lib/CGI.pm
+____________________________________________________________________________
+[ 2781] By: jhi on 1999/02/02 14:27:01
+ Log: Update the MkLinux note.
+ Branch: maint-5.005/perl
+ ! hints/linux.sh
+____________________________________________________________________________
+[ 2775] By: jhi on 1999/02/02 13:13:24
+ Log: Mention lib/Dumpvalue.pm.
+ Branch: maint-5.005/perl
+ ! pod/roffitall
+____________________________________________________________________________
+[ 2767] By: jhi on 1999/02/02 12:29:57
+ Log: Demangle spaces to tab+space.
+ Branch: maint-5.005/perl
+ ! hints/freebsd.sh
+____________________________________________________________________________
+[ 2758] By: jhi on 1999/02/02 10:51:26
+ Log: Detypo.
+ Branch: maint-5.005/perl
+ ! lib/Math/Trig.pm
+____________________________________________________________________________
+[ 2755] By: jhi on 1999/02/02 09:07:51
+ Log: Make FreeBSD 2.2.7 work with -Duseshrplib -ders.
+ Branch: maint-5.005/perl
+ ! hints/freebsd.sh
+____________________________________________________________________________
+[ 2752] By: jhi on 1999/02/01 22:15:12
+ Log: Add perlthrtut.pod.
+
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ To: perl5-porters@perl.org
+ Subject: perlthrtut.pod
+ Date: Mon, 01 Feb 1999 10:57:11 -0800
+ Message-Id: <3.0.6.32.19990201105711.02e62540@ous.edu>
+ Branch: maint-5.005/perl
+ + pod/perlthrtut.pod
+ ! MANIFEST pod/Makefile pod/buildtoc pod/perldelta.pod
+ ! pod/roffitall
+____________________________________________________________________________
+[ 2741] By: gbarr on 1999/02/01 03:00:42
+ Log: Fix typecasts in #2728
+
+ From: "G. Del Merritt" <del@intranetics.com>
+ Date: Fri, 29 Jan 1999 11:47:25 -0700
+ Message-Id: <199901291847.LAA04828@jhereg.perl.com>
+ Subject: Not OK: perl 5.00503 +MAINT_TRIAL_5 on MSWin32-x86-object 4.0 (PATCH included)
+ Branch: maint-5.005/perl
+ ! ext/POSIX/POSIX.xs
+____________________________________________________________________________
+[ 2740] By: gsar on 1999/02/01 02:43:07
+ Log: CAPI inheritance tweak and doc
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/MakeMaker.pm
+____________________________________________________________________________
+[ 2739] By: jhi on 1999/01/31 18:31:54
+ Log: Undo changes #2730 and #2731 and replace them
+ with an extensively tested patch from
+ Anton Berezin <tobez@plab.ku.dk> (via private email).
+ Branch: maint-5.005/perl
+ ! Makefile.SH hints/freebsd.sh
+____________________________________________________________________________
+[ 2738] By: gsar on 1999/01/31 05:04:32
+ Log: fix bogus CAPI inheritance from change#2541
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/MakeMaker.pm
+____________________________________________________________________________
+[ 2737] By: gsar on 1999/01/31 04:55:06
+ Log: remove the big ugly thing jhi sneezed into INSTALL :-)
+ Branch: maint-5.005/perl
+ ! INSTALL
+____________________________________________________________________________
+[ 2736] By: jhi on 1999/01/30 12:57:06
+ Log: From: pvhp@forte.com (Peter Prymmer)
+ To: perl-mvs@perl.org, perlbug@perl.com
+ Subject: Not OK: perl 5.00503 +MAINT_TRIAL_5 on os390 05.00 (UNINSTALLED)
+ Date: Fri, 29 Jan 99 19:22:31 PST
+ Message-Id: <9901300322.AA19136@forte.com>
+
+ (slighty edited at the end)
+ Branch: maint-5.005/perl
+ ! README.os390
+____________________________________________________________________________
+[ 2735] By: jhi on 1999/01/30 11:49:54
+ Log: Undo 5.005-devel random, srandom mention.
+ Branch: maint-5.005/perl
+ ! INSTALL
+____________________________________________________________________________
+[ 2734] By: jhi on 1999/01/29 22:22:00
+ Log: Add perlreftut.
+ Branch: maint-5.005/perl
+ + pod/perlreftut.pod
+ ! MANIFEST pod/perl.pod pod/perldelta.pod pod/roffitall
+____________________________________________________________________________
+[ 2732] By: gsar on 1999/01/29 20:09:44
+ Log: integrate change#2720 from mainline
+
+ missing space while munging CCFLAGS for PERL_CAPI
+ Branch: maint-5.005/perl
+ !> lib/ExtUtils/MM_Unix.pm
+____________________________________________________________________________
+[ 2731] By: jhi on 1999/01/29 14:33:12
+ Log: FreeBSD version numbers can be like "2.2.8-release".
+ Branch: maint-5.005/perl
+ ! hints/freebsd.sh
+____________________________________________________________________________
+[ 2730] By: jhi on 1999/01/29 12:40:38
+ Log: FreeBSD hints iteration (hopefully convergent).
+ usethreads: require at least FreeBSD 2.2.8.
+ signal type: mirror change #2429 in cfgperl.
+ Branch: maint-5.005/perl
+ ! hints/freebsd.sh
+____________________________________________________________________________
+[ 2729] By: gbarr on 1999/01/29 05:06:32
+ Log: Trial release 5
+ Branch: maint-5.005/perl
+ ! Changes patchlevel.h pod/perlhist.pod
+____________________________________________________________________________
+[ 2728] By: gbarr on 1999/01/29 04:10:37
+ Log: From: Ted Law <tedlaw@cibcwg.com>
+ Date: Wed, 27 Jan 1999 14:54:03 -0500 (EST)
+ Message-Id: <199901271954.OAA07391@dcm2.cibcwg.com>
+ Subject: POSIX::strftime buffer overflow problem
+ Branch: maint-5.005/perl
+ ! ext/POSIX/POSIX.xs
+____________________________________________________________________________
+[ 2728] By: gbarr on 1999/01/29 04:10:37
+ Log: From: Ted Law <tedlaw@cibcwg.com>
+ Date: Wed, 27 Jan 1999 14:54:03 -0500 (EST)
+ Message-Id: <199901271954.OAA07391@dcm2.cibcwg.com>
+ Subject: POSIX::strftime buffer overflow problem
+ Branch: maint-5.005/perl
+ ! ext/POSIX/POSIX.xs
+____________________________________________________________________________
+[ 2727] By: gbarr on 1999/01/29 04:09:57
+ Log: From: Tom Spindler <dogcow@isi.net>
+ Date: Thu, 28 Jan 1999 17:15:11 -0800
+ Message-ID: <19990128171510.A11778@isi.net>
+ Subject: [PATCH] BeOS dynamic loading support for perl5.005_03_MT4
+ Branch: maint-5.005/perl
+ + ext/DynaLoader/dl_beos.xs
+ ! Configure MANIFEST Makefile.SH README.beos hints/beos.sh
+ ! lib/ExtUtils/MM_Unix.pm
+____________________________________________________________________________
+[ 2726] By: gbarr on 1999/01/29 03:30:51
+ Log: Remove use of File::Slurp in t/lib/textfill.t
+ Branch: maint-5.005/perl
+ ! t/lib/textfill.t
+____________________________________________________________________________
+[ 2725] By: gbarr on 1999/01/29 03:11:41
+ Log: From: Gurusamy Sarathy <gsar@ActiveState.com>
+ Date: Wed, 27 Jan 1999 23:14:33 -0800
+ Message-Id: <199901280714.XAA10176@activestate.com>
+ Subject: Re: NOT OK: "@INC contains: ." after make install - MAINT_TRIAL_4 - 5.005_03 maintenance trial 4 MSWin32-x86-object
+ Branch: maint-5.005/perl
+ ! win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 2724] By: jhi on 1999/01/28 19:27:15
+ Log: Change jhi@iki.fi to perlbug@perl.com.
+ Cosmetic change in semctl probing messages.
+ Branch: maint-5.005/perl
+ ! Configure hints/freebsd.sh
+____________________________________________________________________________
+[ 2723] By: jhi on 1999/01/28 17:27:49
+ Log: Yet another typo in a test program.
+ Branch: maint-5.005/perl
+ ! Configure
+____________________________________________________________________________
+[ 2722] By: jhi on 1999/01/28 17:13:52
+ Log: The pthreads_created_joinable test had a typo,
+ by blind luck the default value works almost anywhere.
+ Branch: maint-5.005/perl
+ ! Configure
+____________________________________________________________________________
+[ 2721] By: jhi on 1999/01/28 13:04:23
+ Log: MinT support, adapted from change #2594.
+ Branch: maint-5.005/perl
+ + README.mint ext/POSIX/hints/mint.pl hints/mint.sh
+ + mint/Makefile mint/README mint/errno.h mint/pwd.c mint/stdio.h
+ + mint/sys/time.h mint/time.h
+ ! MANIFEST doio.c malloc.c miniperlmain.c perl.c
+ ! pod/perldelta.pod t/io/fs.t t/lib/safe2.t t/op/groups.t
+ ! t/op/mkdir.t t/op/taint.t
+____________________________________________________________________________
+[ 2719] By: jhi on 1999/01/27 19:49:49
+ Log: From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ To: perl5-porters@perl.org
+ Subject: Re: [PATCH] perl5.005_03-MAINT_TRIAL_3: clarify Sv[INU]V versus Sv[INU]VX in perlguts
+ Date: Tue, 26 Jan 1999 22:25:07 +0000
+ Message-Id: <E105Gux-0000Ac-00@taurus.cus.cam.ac.uk>
+ Branch: maint-5.005/perl
+ ! pod/perlguts.pod
+____________________________________________________________________________
+[ 2718] By: jhi on 1999/01/27 19:46:04
+ Log: io/fs.t fails test #18 (sense of tests appears to have been
+ changed incompletely; this patch just skips the test attached,
+ a la test #17 preceding it).
+
+ From: "G. Del Merritt" <del@intranetics.com>
+ To: perlbug@perl.com
+ Subject: NOT OK: perl 5.00503 +MAINT_TRIAL_4 on MSWin32-x86-object (PATCHES included)
+ Date: Tue, 26 Jan 1999 12:09:09 -0700
+ Message-Id: <199901261909.MAA25525@jhereg.perl.com>
+ Branch: maint-5.005/perl
+ ! t/io/fs.t
+____________________________________________________________________________
+[ 2717] By: jhi on 1999/01/27 19:44:46
+ Log: Miniperl fails to build (pp_sys.c was changed and iperlsys.h wasn't)
+
+ From: "G. Del Merritt" <del@intranetics.com>
+ To: perlbug@perl.com
+ Subject: NOT OK: perl 5.00503 +MAINT_TRIAL_4 on MSWin32-x86-object (PATCHES included)
+ Date: Tue, 26 Jan 1999 12:09:09 -0700
+ Message-Id: <199901261909.MAA25525@jhereg.perl.com>
+ Branch: maint-5.005/perl
+ ! iperlsys.h
+____________________________________________________________________________
+[ 2716] By: jhi on 1999/01/27 19:38:36
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ To: perlbug@perl.com, vmsperl@perl.org
+ Subject: NOT OK: perl 5.00503 +MAINT_TRIAL_4 on VMSAXP (Patch included, of course)
+ Date: Tue, 26 Jan 1999 14:40:38 -0800
+ Message-Id: <3.0.6.32.19990126144038.02e5d650@ous.edu>
+
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ To: perl5-porters@perl.org, vmsperl@perl.org
+ Subject: [PATCH 5.005_03-MAILT_TRIAL_4]VMS test patches
+ Date: Tue, 26 Jan 1999 14:55:29 -0800
+ Message-Id: <3.0.6.32.19990126145529.02f22280@ous.edu>
+ Branch: maint-5.005/perl
+ ! t/lib/textfill.t t/lib/textwrap.t vms/ext/Stdio/test.pl
+ ! vms/subconfigure.com
+____________________________________________________________________________
+[ 2715] By: jhi on 1999/01/27 19:34:28
+ Log: From: Mark Bixby <markb@spock.dis.cccd.edu>
+ To: perl5-porters@perl.org
+ Subject: [PATCH perl5.005_03-MAINT_TRIAL_4] MPE port tweaks
+ Date: Tue, 26 Jan 1999 16:32:18 -0800 (PST)
+ Message-Id: <199901270032.QAA13395@spock.dis.cccd.edu>
+ Branch: maint-5.005/perl
+ ! hints/mpeix.sh mpeix/relink
+____________________________________________________________________________
+[ 2714] By: jhi on 1999/01/27 19:32:41
+ Log: NetBSD does not do setruid, setrgid.
+ Branch: maint-5.005/perl
+ ! hints/netbsd.sh
+____________________________________________________________________________
+[ 2713] By: jhi on 1999/01/27 19:28:53
+ Log: FreeBSD usethreads, based on private email with
+ Anton Berezin <tobez@plab.ku.dk>.
+ Branch: maint-5.005/perl
+ ! hints/freebsd.sh
+____________________________________________________________________________
+[ 2712] By: jhi on 1999/01/27 19:26:17
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ To: Mailing list Perl5 <perl5-porters@perl.org>
+ Subject: [PATCH 5.005_*] OS/2 threads
+ Date: Tue, 26 Jan 1999 13:39:46 -0500
+ Message-ID: <19990126133946.A11594@monk.mps.ohio-state.edu>
+ Branch: maint-5.005/perl
+ ! os2/os2ish.h
+____________________________________________________________________________
+[ 2711] By: jhi on 1999/01/27 19:24:28
+ Log: "make ok", "make okfile", and "make nok" were broken
+ with -Duseshrplib, because of a shared typo.
+
+ From: Spider Boardman <spider@web.zk3.dec.com>
+ To: perlbug@perl.com
+ Subject: Not OK: perl 5.00503 +MAINT_TRIAL_4 on alpha-dec_osf-thread 5.0 (UNINSTALLED)
+ Date: Wed, 27 Jan 1999 12:27:15 -0500
+ Message-Id: <199901271727.MAA233455@web.zk3.dec.com>
+ Branch: maint-5.005/perl
+ ! Makefile.SH
+____________________________________________________________________________
+[ 2710] By: jhi on 1999/01/27 19:22:23
+ Log: Errno fixes:
+
+ From: Spider Boardman <spider@web.zk3.dec.com>
+ To: perlbug@perl.com
+ Subject: Not OK: perl 5.00503 +MAINT_TRIAL_4 on alpha-dec_osf-thread 5.0 (UNINSTALLED)
+ Date: Wed, 27 Jan 1999 12:27:15 -0500
+ Message-Id: <199901271727.MAA233455@web.zk3.dec.com>
+
+ From: Spider Boardman <spider@web.zk3.dec.com>
+ To: perlbug@perl.com
+ Subject: Not OK: perl 5.00503 +MAINT_TRIAL_4 on alpha-dec_osf-thread 5.0 (UNINSTALLED)
+ Date: Wed, 27 Jan 1999 13:31:16 -0500
+ Message-Id: <199901271831.NAA241001@web.zk3.dec.com>
+ Branch: maint-5.005/perl
+ ! Configure ext/Errno/Errno_pm.PL
+____________________________________________________________________________
+[ 2709] By: jhi on 1999/01/27 19:17:35
+ Log: Fix Configure installusrbinperl:
+
+ From: Spider Boardman <spider@web.zk3.dec.com>
+ To: jhi@iki.fi
+ cc: perl5-porters@perl.org
+ Subject: Re: Not OK: perl 5.00503 +MAINT_TRIAL_4 on alpha-dec_osf-thread 5.0 (UNINSTALLED)
+ Date: Wed, 27 Jan 1999 13:03:35 -0500
+ Message-Id: <199901271803.NAA238257@web.zk3.dec.com>
+ Branch: maint-5.005/perl
+ ! Configure
+____________________________________________________________________________
+[ 2708] By: gbarr on 1999/01/26 04:14:42
+ Log: Trial release 4
+ Branch: maint-5.005/perl
+ ! Changes patchlevel.h pod/perlhist.pod
+____________________________________________________________________________
+[ 2707] By: gbarr on 1999/01/26 02:06:17
+ Log: Add redef IO::Handle::* for setv?buf()
+ Branch: maint-5.005/perl
+ ! ext/POSIX/POSIX.pm
+____________________________________________________________________________
+[ 2706] By: jhi on 1999/01/24 22:26:12
+ Log: Better AIX libc nm scan.
+ Branch: maint-5.005/perl
+ ! Configure
+____________________________________________________________________________
+[ 2703] By: jhi on 1999/01/24 14:26:18
+ Log: Minor Configure adjustments.
+ Branch: maint-5.005/perl
+ ! Configure
+____________________________________________________________________________
+[ 2702] By: jhi on 1999/01/24 13:57:33
+ Log: Use usethreads.cbu consistently.
+ Branch: maint-5.005/perl
+ ! Configure hints/aix.sh hints/dec_osf.sh hints/dos_djgpp.sh
+ ! hints/freebsd.sh hints/hpux.sh hints/irix_4.sh hints/irix_5.sh
+ ! hints/irix_6.sh hints/irix_6_0.sh hints/irix_6_1.sh
+ ! hints/linux.sh hints/os2.sh hints/solaris_2.sh
+____________________________________________________________________________
+[ 2701] By: jhi on 1999/01/24 13:55:43
+ Log: Mention year-1900 and month 0..11 also here.
+ Branch: maint-5.005/perl
+ ! lib/Time/Local.pm
+____________________________________________________________________________
+[ 2700] By: jhi on 1999/01/24 13:52:36
+ Log: Document Configure -Uinstallusrbinperl.
+ Branch: maint-5.005/perl
+ ! INSTALL pod/perldelta.pod
+____________________________________________________________________________
+[ 2699] By: jhi on 1999/01/24 13:01:57
+ Log: perlopentut was missing.
+ Branch: maint-5.005/perl
+ + pod/perlopentut.pod
+ ! MANIFEST pod/perldelta.pod
+____________________________________________________________________________
+[ 2697] By: jhi on 1999/01/24 12:31:33
+ Log: Remove t/op/grent.t (t/op/pwent.t was removed by #2685).
+ Branch: maint-5.005/perl
+ - t/op/grent.t
+ ! MANIFEST
+____________________________________________________________________________
+[ 2696] By: gsar on 1999/01/24 11:39:39
+ Log: integrate changes#2255,2694 from mainline
+
+ another win32 portability fix: make sysread() and syswrite()
+ work on sockets
+
+ better notes on 'make' on win32
+ Branch: maint-5.005/perl
+ ! README.win32 pp_sys.c win32/win32.h
+____________________________________________________________________________
+[ 2693] By: gbarr on 1999/01/24 00:53:31
+ Log: Integrate changes #2646,2647 from cfgperl
+
+ Show LANGUAGE env var when needed. (Augment change #2645).
+
+ SHMLBA strikes back in NetBSD/sparc.
+
+ From: Dave Nelson <David.Nelson@bellcow.com>
+ To: jhi@iki.fi
+ Subject: perl5.005_02 + IPC::SysV + NetBSD/Sparc
+ Date: Mon, 18 Jan 1999 22:07:56 -0600
+ Message-Id: <199901190407.WAA02543@longhorn.bellcow.com>
+ Branch: maint-5.005/perl
+ ! util.c utils/perlbug.PL
+ !> ext/IPC/SysV/SysV.xs
+____________________________________________________________________________
+[ 2692] By: gbarr on 1999/01/24 00:28:52
+ Log: Integrate #2630 from mainline and an errno save fix
+ Branch: maint-5.005/perl
+ !> doio.c
+____________________________________________________________________________
+[ 2691] By: gbarr on 1999/01/24 00:28:37
+ Log: Update CGI modules to 2.46 and Getopt::Long to 2.19
+ Branch: maint-5.005/perl
+ ! lib/CGI.pm lib/CGI/Carp.pm lib/CGI/Cookie.pm lib/CGI/Fast.pm
+ ! lib/CGI/Push.pm lib/Getopt/Long.pm t/lib/cgi-html.t
+____________________________________________________________________________
+[ 2690] By: gbarr on 1999/01/23 23:35:39
+ Log: Integrate #2681 from cfgperl
+
+ Better (I hope) LANGUAGE documentation.
+ Branch: maint-5.005/perl
+ !> pod/perllocale.pod
+____________________________________________________________________________
+[ 2689] By: gbarr on 1999/01/23 23:31:59
+ Log: More nosuid patches
+
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Fri, 22 Jan 1999 12:12:45 +0200 (EET)
+ Message-ID: <13992.20253.269284.841300@alpha.hut.fi>
+ Subject: Re: [PATCH] 5.005*: the "nosuid" problem: v2
+ Branch: maint-5.005/perl
+ ! Configure config_h.SH perl.c perl.h pod/perldelta.pod
+ ! pod/perldiag.pod
+____________________________________________________________________________
+[ 2688] By: gbarr on 1999/01/23 23:03:39
+ Log: From: Anton Berezin <tobez@plab.ku.dk>
+ Date: 21 Jan 1999 17:07:28 +0100
+ Message-ID: <86emood2yn.fsf@lion.plab.ku.dk>
+ Subject: [PATCH 5.005_54] hints/freebsd.sh - reflect the birth of version 4.0
+ Branch: maint-5.005/perl
+ ! hints/freebsd.sh
+____________________________________________________________________________
+[ 2687] By: gbarr on 1999/01/23 22:52:58
+ Log: overload syntax is no longer experimental
+ Branch: maint-5.005/perl
+ ! lib/overload.pm
+____________________________________________________________________________
+[ 2685] By: gbarr on 1999/01/23 22:15:46
+ Log: Remove t/op/pwent.t added from cfgperl, but is not robust.
+ Branch: maint-5.005/perl
+ - t/op/pwent.t
+ ! MANIFEST
+____________________________________________________________________________
+[ 2684] By: gbarr on 1999/01/23 22:13:07
+ Log: More doc typos from Abigail, and undo some in lib/diagnostics.pm
+ from change #2672
+
+ From: abigail@fnx.com
+ Date: Tue, 19 Jan 1999 19:32:42 -0500 (EST)
+ Message-Id: <19990120003242.19938.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/CGI.pm] Typos
+
+ From: abigail@fnx.com
+ Date: Tue, 19 Jan 1999 19:40:41 -0500 (EST)
+ Message-Id: <19990120004041.20052.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/CPAN.pm] Typos
+ Branch: maint-5.005/perl
+ ! lib/CGI.pm lib/CPAN.pm lib/diagnostics.pm
+____________________________________________________________________________
+[ 2677] By: gbarr on 1999/01/22 03:38:07
+ Log: Integrate #2645, #2648 and update patching.pod
+
+ Document the GNU LANGUAGE env var.
+
+ Mention /usr/share/locale.
+
+ From: Daniel Grisinger <dgris@moiraine.dimensional.com>
+ Date: 21 Jan 1999 00:17:35 -0700
+ Message-Id: <m31zkpqels.fsf_-_@moiraine.dimensional.com>
+ Subject: [PATCH] patching.pod, misc fixes (was Re: Which ? What ? Why ? When ?)
+ Branch: maint-5.005/perl
+ ! Porting/patching.pod
+ !> pod/perllocale.pod
+____________________________________________________________________________
+[ 2676] By: gbarr on 1999/01/22 01:54:02
+ Log: Fixup FindBin to use File::Spec
+
+ Message-Id: <19990120185157.D24479@west-tip.transeda.com>
+ Date: Wed, 20 Jan 1999 18:51:57 +0000
+ From: Paul Johnson <pjcj@transeda.com>
+ Subject: Re: [PATCH] 5005_54 Make FindBin work with UNC paths
+ Branch: maint-5.005/perl
+ ! lib/FindBin.pm
+____________________________________________________________________________
+[ 2675] By: gbarr on 1999/01/22 01:38:31
+ Log: Add new config values added for nosuid fix into VMS configure
+
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Date: Wed, 20 Jan 1999 12:05:18 -0800
+ Message-Id: <3.0.6.32.19990120120518.00a98470@ous.edu>
+ Subject: [PATCH 5.005_03MT3]VMS configure tweak
+ Branch: maint-5.005/perl
+ ! vms/subconfigure.com
+____________________________________________________________________________
+[ 2674] By: gbarr on 1999/01/22 01:36:35
+ Log: Fix for buggy compiler optimization on dec for pack("I",...)
+
+ From: Achim Bohnet <ach@mpe.mpg.de>
+ Date: Wed, 20 Jan 1999 20:25:53 +0100
+ Message-Id: <199901201925.UAA16940@o06.xray.mpe.mpg.de>
+ Subject: [PATCH] Not OK: perl 5.00503 +MAINT_TRIAL_3 on alpha-dec_osf 4.0
+ Branch: maint-5.005/perl
+ ! pp.c
+____________________________________________________________________________
+[ 2673] By: gbarr on 1999/01/22 01:29:37
+ Log: OS/2 patches from Ilya
+
+ Date: Thu, 21 Jan 1999 02:08:27 -0500
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Subject: [PATCH 5.00*] makedepend
+ Message-Id: <19990121020827.A25509@monk.mps.ohio-state.edu>
+
+ Date: Thu, 21 Jan 1999 02:46:34 -0500
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Subject: [PATCH 5.005_*] Errno.pm suffers from \\ too
+ Message-Id: <19990121024634.A25600@monk.mps.ohio-state.edu>
+
+ Date: Thu, 21 Jan 1999 02:50:16 -0500
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Subject: [PATCH 5.005_03] Resend of OS/2 patch
+ Message-Id: <19990121025016.A25612@monk.mps.ohio-state.edu>
+
+ Date: Thu, 21 Jan 1999 03:58:29 -0500
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Subject: [PATCH 5.005_*] OS2::PrfDB was exploiting a bug in U32 XSUBs
+ Message-Id: <19990121035829.A25822@monk.mps.ohio-state.edu>
+ Branch: maint-5.005/perl
+ ! ext/Errno/Errno_pm.PL makedepend.SH os2/Changes
+ ! os2/Makefile.SHs os2/OS2/PrfDB/PrfDB.xs os2/os2.c
+____________________________________________________________________________
+[ 2672] By: gbarr on 1999/01/22 01:05:45
+ Log: More doc typo patches from Abigail
+
+ From: abigail@fnx.com
+ Message-Id: <19990120001410.19645.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL 3 lib/AutoLoader.pm] Typos
+ Date: Tue, 19 Jan 1999 19:14:10 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120004312.20152.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/Carp.pm] Typo
+ Date: Tue, 19 Jan 1999 19:43:12 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120004429.20190.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/Cwd.pm] Typo
+ Date: Tue, 19 Jan 1999 19:44:29 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120005241.20693.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/Safe.pm] Typo
+ Date: Tue, 19 Jan 1999 19:52:41 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120005525.20788.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/SelfLoader.pm] Typos
+ Date: Tue, 19 Jan 1999 19:55:25 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120005821.20926.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/Symbol.pm] Typo
+ Date: Tue, 19 Jan 1999 19:58:21 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120010002.20973.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/Test.pm] Typo
+ Date: Tue, 19 Jan 1999 20:00:02 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120013823.23015.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/diagnostics.pm] Typos (ignore
+ Date: Tue, 19 Jan 1999 20:38:23 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120013909.23085.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/ops.pm] Typo
+ Date: Tue, 19 Jan 1999 20:39:09 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120015817.24306.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/overload.pm] Typos
+ Date: Tue, 19 Jan 1999 20:58:16 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120020326.24373.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/re.pm] Typos
+ Date: Tue, 19 Jan 1999 21:03:26 -0500 (EST)
+ Branch: maint-5.005/perl
+ ! ext/Opcode/Safe.pm ext/Opcode/ops.pm ext/re/re.pm
+ ! lib/AutoLoader.pm lib/Carp.pm lib/Cwd.pm lib/SelfLoader.pm
+ ! lib/Symbol.pm lib/Test.pm lib/diagnostics.pm lib/overload.pm
+____________________________________________________________________________
+[ 2671] By: gbarr on 1999/01/22 00:40:13
+ Log: Fix win32 for Borland compiler and spaces in paths
+
+ From: Gurusamy Sarathy <gsar@activestate.com>
+ Date: Mon, 18 Jan 1999 20:33:17 -0800
+ Message-Id: <199901190433.UAA03656@activestate.com>
+ Subject: [PATCH] 5.005_03-trial3 win32 issues
+ Branch: maint-5.005/perl
+ ! README.win32 win32/Makefile win32/config_sh.PL
+ ! win32/makefile.mk win32/runperl.c
+____________________________________________________________________________
+[ 2637] By: gbarr on 1999/01/18 02:52:18
+ Log: Update DB_File to 1.63
+
+ From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ Date: Tue, 29 Dec 1998 16:23:54 +0000 (GMT)
+ Message-Id: <9812291623.AA20884@claudius.bfsec.bt.co.uk>
+ Subject: PATCH DB_File 1.63 for 5.005_54 & 5.005_03
+ Branch: maint-5.005/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
+____________________________________________________________________________
+[ 2636] By: gbarr on 1999/01/17 18:03:31
+ Log: Trial release 3
+ Branch: maint-5.005/perl
+ ! Changes patchlevel.h
+____________________________________________________________________________
+[ 2635] By: gbarr on 1999/01/17 17:32:01
+ Log: Update to CPAN-1.44
+
+ From: Mark-Jason Dominus <mjd@plover.com>
+ Date: Sat, 16 Jan 1999 17:22:06 -0500
+ Message-ID: <19990116222206.3674.qmail@plover.com>
+ Subject: Re: DOC PATCH (5.005_54 perlsub.pod)
+ Branch: maint-5.005/perl
+ ! lib/CPAN.pm lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm
+ ! pod/perlsub.pod
+____________________________________________________________________________
+[ 2634] By: gbarr on 1999/01/17 17:27:12
+ Log: Fix for suidperl when script is on a nosuid filesystem
+
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Sun, 17 Jan 1999 16:27:06 +0200 (EET)
+ Message-ID: <13985.62266.324824.292401@alpha.hut.fi>
+ Subject: [PATCH] 5.005*: the "nosuid" problem: v2
+ Branch: maint-5.005/perl
+ ! Configure config_h.SH perl.c perl.h pod/perldiag.pod
+____________________________________________________________________________
+[ 2618] By: gbarr on 1999/01/16 19:18:26
+ Log: Added Dumpvalue.pm
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Mon, 7 Dec 1998 02:44:25 -0500 (EST)
+ Message-Id: <199812070744.CAA18949@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_*] Dumpvar.pm
+ Branch: maint-5.005/perl
+ + lib/Dumpvalue.pm
+ ! MANIFEST pod/perldelta.pod
+____________________________________________________________________________
+[ 2617] By: gbarr on 1999/01/16 19:09:36
+ Log: Minor change to perlxstut and added perlopentut.pod
+
+ From: Nathan Torkington <gnat@frii.com>
+ Date: Sat, 26 Dec 1998 14:28:21 +1300 (NZDT)
+ Message-ID: <13956.15285.933914.320849@localhost.frii.com>
+ Subject: [PATCH] perlxstut.pod fix
+
+ From: Tom Christiansen <tchrist@jhereg.perl.com>
+ Date: Sat, 09 Jan 1999 08:13:18 -0700
+ Message-Id: <199901091513.IAA17512@jhereg.perl.com>
+ Subject: perlopentut.pod
+ Branch: maint-5.005/perl
+ ! MANIFEST pod/perl.pod pod/perldelta.pod pod/perlxstut.pod
+ ! pod/roffitall
+____________________________________________________________________________
+[ 2616] By: gbarr on 1999/01/16 18:59:55
+ Log: Win32 changes from Jan
+
+ From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Fri, 15 Jan 1999 23:38:35 +0100
+ Message-ID: <36a7c10d.16311905@smtp1.ibm.net>
+ Subject: [PATCH 5.005_03m2] Win32 Makefile patches
+
+ From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Sat, 16 Jan 1999 13:02:45 +0100
+ Message-ID: <36a07da6.10722337@smtp1.ibm.net>
+ Subject: [PATCH 5.005_03m2] minor tweaks to README.win32
+ Branch: maint-5.005/perl
+ ! README.win32 win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 2615] By: gbarr on 1999/01/16 18:48:48
+ Log: Jumbo patch from Sarathy for PERL_OBJECT & USE_THREADS
+
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Date: Thu, 07 Jan 1999 00:12:00 -0500
+ Message-Id: <199901070512.AAA23568@aatma.engin.umich.edu>
+ Subject: Re: [PATCH 5.005_03-MAINT_TRIAL2] fixes for PERL_OBJECT and USE_THREADS builds
+
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Date: Thu, 14 Jan 1999 19:21:46 -0500
+ Message-Id: <199901150021.TAA01886@aatma.engin.umich.edu>
+ Subject: Re: [PATCH 5.005_03-MAINT_TRIAL2] fixes for PERL_OBJECT and USE_THREADS builds
+ Branch: maint-5.005/perl
+ ! embed.h global.sym lib/ExtUtils/MM_Unix.pm objXSUB.h objpp.h
+ ! op.c perl.c perl.h perly.c perly.y perly_c.diff pp.c proto.h
+ ! sv.c t/io/fs.t toke.c win32/GenCAPI.pl win32/config.bc
+ ! win32/makedef.pl win32/runperl.c win32/win32.c
+____________________________________________________________________________
+[ 2614] By: gbarr on 1999/01/16 16:48:38
+ Log: From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Fri, 15 Jan 1999 17:28:34 +0200 (EET)
+ Message-Id: <199901151528.RAA08785@alpha.hut.fi>
+ Subject: [PATCH] 5.005_03-MAINT_TRIAL_2: NetBSD patches
+
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Fri, 15 Jan 1999 18:44:19 +0200 (EET)
+ Message-Id: <199901151644.SAA08184@alpha.hut.fi>
+ Subject: [PATCH] 5.005_03-MAINT_TRIAL_2: allow skipping the "install also as /usr/bin/perl" question of installperl
+
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Fri, 15 Jan 1999 18:52:29 +0200 (EET)
+ Message-Id: <199901151652.SAA11259@alpha.hut.fi>
+ Subject: the promised "installusrbinperl + NetBSD" fix
+ Branch: maint-5.005/perl
+ ! Configure Makefile.SH hints/netbsd.sh installperl
+ ! makedepend.SH unixish.h
+____________________________________________________________________________
+[ 2613] By: gbarr on 1999/01/16 16:28:40
+ Log: From: Laszlo Molnar <ml1050@freemail.c3.hu>
+ Date: Thu, 14 Jan 1999 22:37:26 +0100
+ Message-ID: <19990114223726.A177@beeblebrox>
+ Subject: [PATCH for 5.005_03-MAINT_TRIAL_2] dos-djgpp update
+ Branch: maint-5.005/perl
+ ! djgpp/config.over djgpp/djgpp.c
+____________________________________________________________________________
+[ 2612] By: gbarr on 1999/01/16 16:27:25
+ Log: Hints for sco.sh to automatically support dynamic linking
+
+ From: Peter Wolfe <wolfe@teloseng.com>
+ Date: Mon, 11 Jan 1999 11:50:20 -0800 (PST)
+ Message-Id: <199901111950.LAA01703@titan.teloseng.com>
+ Subject: SCO 3.2v5 patch for perl5.005_03-MAINT_TRIAL_1
+ Branch: maint-5.005/perl
+ ! hints/sco.sh
+____________________________________________________________________________
+[ 2610] By: gbarr on 1999/01/14 03:07:33
+ Log: Fix login in installperl for pods
+
+ From: Robin Barker <rmb1@cise.npl.co.uk>
+ Date: Mon, 4 Jan 1999 13:50:10 GMT
+ Message-Id: <199901041350.NAA19665@cyclone.cise.npl.co.uk>
+ Subject: PATCH to installperl
+ Branch: maint-5.005/perl
+ ! installperl
+____________________________________________________________________________
+[ 2609] By: gbarr on 1999/01/14 03:04:37
+ Log: Fix incorrect "used only once" warnings
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Fri, 8 Jan 1999 04:37:10 -0500
+ Message-ID: <19990108043710.A14390@monk.mps.ohio-state.edu>
+ Subject: Re: change#965 flakiness
+ Branch: maint-5.005/perl
+ ! gv.c
+____________________________________________________________________________
+[ 2608] By: gbarr on 1999/01/14 02:56:46
+ Log: Fixed double GLOB de-reference
+
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Date: Sat, 09 Jan 1999 23:40:24 -0500
+ Message-Id: <199901100440.XAA12360@aatma.engin.umich.edu>
+ Subject: Re: IO::Pipe with perl -d (on HPUX)
+ Branch: maint-5.005/perl
+ ! ext/IO/lib/IO/Pipe.pm
+____________________________________________________________________________
+[ 2607] By: gbarr on 1999/01/14 02:53:40
+ Log: Added Carp::cluck to perldelta.pod
+ Branch: maint-5.005/perl
+ ! pod/perldelta.pod
+____________________________________________________________________________
+[ 2606] By: gbarr on 1999/01/14 02:44:04
+ Log: New perlfaq*.pod from Tom (private mail)
+ Branch: maint-5.005/perl
+ ! pod/perlfaq.pod pod/perlfaq1.pod pod/perlfaq2.pod
+ ! pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod
+ ! pod/perlfaq6.pod pod/perlfaq7.pod pod/perlfaq8.pod
+ ! pod/perlfaq9.pod
+____________________________________________________________________________
+[ 2584] By: gbarr on 1999/01/08 04:50:56
+ Log: implemented Ilya's suggested fix, and added a testcase
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Tue, 5 Jan 1999 00:56:01 -0500 (EST)
+ Message-Id: <199901050556.AAA02597@monk.mps.ohio-state.edu>
+ Subject: Re: Text::ParseWords: regex fix
+ Branch: maint-5.005/perl
+ ! lib/Text/ParseWords.pm t/lib/parsewords.t
+____________________________________________________________________________
+[ 2583] By: gbarr on 1999/01/08 04:50:03
+ Log: From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Thu, 7 Jan 1999 12:47:38 +0200 (EET)
+ Message-Id: <199901071047.MAA24100@alpha.hut.fi>
+ Subject: [PATCH] 5.005_03-MAINT_TRIAL_2: ext/Errno_pm.PL: understand wrapper cppstdins
+ Branch: maint-5.005/perl
+ ! ext/Errno/Errno_pm.PL
+____________________________________________________________________________
+[ 2582] By: gbarr on 1999/01/08 03:37:55
+ Log: More doc changes from Abigail, and included change #2575 from cfgperl
+
+ From: abigail@fnx.com
+ Message-ID: <19990107041434.22326.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/Time/gmtime.pm] Typo fix
+ Date: Wed, 6 Jan 1999 23:14:34 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107041746.22376.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/Time/localtime.pm] Typo fix
+ Date: Wed, 6 Jan 1999 23:17:46 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107042105.22527.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/User/grent.pm] Typo fix
+ Date: Wed, 6 Jan 1999 23:21:05 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107042254.22624.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/User/pwent.pw] Typo fix
+ Date: Wed, 6 Jan 1999 23:22:54 -0500 (EST)
+ Branch: maint-5.005/perl
+ ! lib/Math/Trig.pm lib/Time/gmtime.pm lib/Time/localtime.pm
+ ! lib/User/grent.pm lib/User/pwent.pm
+____________________________________________________________________________
+[ 2578] By: gbarr on 1999/01/07 04:30:26
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ Date: Wed, 06 Jan 1999 13:47:34 -0800
+ Message-Id: <3.0.6.32.19990106134734.0334d260@ous.edu>
+ Subject: [PATCH 5.005_02-MT2, 5.005_5x]VMS.C tweak for occasional system() error
+ Branch: maint-5.005/perl
+ ! vms/vms.c
+____________________________________________________________________________
+[ 2577] By: gbarr on 1999/01/07 04:26:28
+ Log: Another set of doc patches from Abigail
+
+ From: abigail@fnx.com
+ Message-ID: <19990107032132.20124.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRAIL2 lib/Net/hostent.pm] Typo fix
+ Date: Wed, 6 Jan 1999 22:21:32 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107032445.20178.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/Net/netent.pm] Typo fix
+ Date: Wed, 6 Jan 1999 22:24:45 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107032834.20362.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRAIL2 lib/Term/Complete.pm] Typo fix
+ Date: Wed, 6 Jan 1999 22:28:34 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107033136.20440.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRAIL2 lib/Term/ReadLine.pm] Typo fix
+ Date: Wed, 6 Jan 1999 22:31:36 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107033351.20540.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/CGI/Apache.pm] Typo fix
+ Date: Wed, 6 Jan 1999 22:33:51 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107033933.20707.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/CGI/Push.pm] Typo fix
+ Date: Wed, 6 Jan 1999 22:39:33 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107034548.20936.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/File/Copy.pm] Typo fixes
+ Date: Wed, 6 Jan 1999 22:45:48 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107034856.21056.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/File/Spec.pm] Typo fix
+ Date: Wed, 6 Jan 1999 22:48:56 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107035113.21174.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/File/Spec/Mac.pm] Typo fixes
+ Date: Wed, 6 Jan 1999 22:51:13 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107035612.21522.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/Math/BigFloat.pm] Typo fix
+ Date: Wed, 6 Jan 1999 22:56:12 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107035842.21585.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/Math/BigInt.pm] Typo fixes
+ Date: Wed, 6 Jan 1999 22:58:41 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107040644.22009.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/Text/Wrap.pm] Typo fixes
+ Date: Wed, 6 Jan 1999 23:06:44 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107040955.22087.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/Tie/Array.pm] Typo fixes
+ Date: Wed, 6 Jan 1999 23:09:55 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107041136.22174.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/Tie/Hash.pm] Typo fix
+ Date: Wed, 6 Jan 1999 23:11:36 -0500 (EST)
+ Branch: maint-5.005/perl
+ ! lib/CGI/Apache.pm lib/CGI/Push.pm lib/File/Copy.pm
+ ! lib/File/Spec.pm lib/File/Spec/Mac.pm lib/Math/BigFloat.pm
+ ! lib/Math/BigInt.pm lib/Net/hostent.pm lib/Net/netent.pm
+ ! lib/Term/Complete.pm lib/Term/ReadLine.pm lib/Text/Wrap.pm
+ ! lib/Tie/Array.pm lib/Tie/Hash.pm
+____________________________________________________________________________
+[ 2568] By: gbarr on 1999/01/06 03:13:15
+ Log: From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Wed, 06 Jan 1999 01:24:09 +0100
+ Message-ID: <3696aa85.18259325@smtp1.ibm.net>
+ Subject: [PATCH 5.005_03-MAINT_TRIAL2] fixes for PERL_OBJECT and USE_THREADS builds
+ Branch: maint-5.005/perl
+ ! embed.h global.sym objXSUB.h objpp.h perl.c proto.h
+ ! win32/GenCAPI.pl win32/makedef.pl
+____________________________________________________________________________
+[ 2567] By: gbarr on 1999/01/06 02:31:28
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ Date: Tue, 05 Jan 1999 16:47:31 -0800
+ Message-Id: <3.0.6.32.19990105164731.00b5b2d0@ous.edu>
+ Subject: [PATCH 5.005_03-MAINT_TRIAL_2]taint.c fix for VMS
+ Branch: maint-5.005/perl
+ ! taint.c
+____________________________________________________________________________
+[ 2566] By: gbarr on 1999/01/06 02:29:05
+ Log: From: "W. Phillip Moore" <wpm@ms.com>
+ Date: Tue, 5 Jan 1999 12:40:27 -0500 (EST)
+ Message-ID: <13970.20107.190314.549471@zappa>
+ Subject: [PATCH] POSIX getpgrp is not -w clean
+ Branch: maint-5.005/perl
+ ! ext/POSIX/POSIX.pm
+____________________________________________________________________________
+[ 2565] By: gbarr on 1999/01/06 02:19:00
+ Log: From: Slaven Rezic <eserte@cs.tu-berlin.de>
+ Date: Mon, 4 Jan 1999 23:01:46 +0100 (CET)
+ Message-Id: <199901042201.XAA01875@cabulja.herceg.de>
+ Subject: FindBin.pm on Win32 systems
+ Branch: maint-5.005/perl
+ ! lib/FindBin.pm
+____________________________________________________________________________
+[ 2564] By: gbarr on 1999/01/06 02:13:23
+ Log: From: Mark Bixby <markb@spock.dis.cccd.edu>
+ Date: Mon, 4 Jan 1999 13:34:58 -0800 (PST)
+ Message-Id: <199901042134.NAA18852@spock.dis.cccd.edu>
+ Subject: [PATCH 5.005_03-MAINT_TRIAL_2] t/op/sysio.t for MPE/iX
+ Branch: maint-5.005/perl
+ ! t/op/sysio.t
+____________________________________________________________________________
+[ 2563] By: gbarr on 1999/01/06 02:03:44
+ Log: From: Jarkko Hietaniemi <jhi@cc.hut.fi>
+ Date: Mon, 4 Jan 1999 19:25:03 +0200 (EET)
+ Message-Id: <199901041725.TAA30462@alpha.hut.fi>
+ Subject: [PATCH] 5.005_03-MAINT_TRIAL_2: undo untrue HP-UX 64-bitness (mostly harmless but misleading)
+ Branch: maint-5.005/perl
+ ! hints/hpux.sh
+____________________________________________________________________________
+[ 2562] By: gbarr on 1999/01/06 02:02:18
+ Log: Jumbo doc patch from Abigail
+
+ From: abigail@fnx.com
+ Message-ID: <19990105170142.4889.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03-TRIAL2 lib/ExtUtils/Liblist.pm] pod fixes
+ Date: Tue, 5 Jan 1999 12:01:42 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990105172855.5115.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 MAINT2 lib/ExtUtils/Commands.pm] Typo fix.
+ Date: Tue, 5 Jan 1999 12:28:55 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990105173808.5260.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH perl5.005_03 MAINT3 lib/ExtUtils/Embed.pm] Typo fix
+ Date: Tue, 5 Jan 1999 12:38:08 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990105174859.5533.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 MAINT2 lib/ExtUtils/Install.pm] Typo fix
+ Date: Tue, 5 Jan 1999 12:48:59 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990105174947.5547.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 lib/ExtUtils/MM_Unix.pm] Typo fixes
+ Date: Tue, 5 Jan 1999 12:49:46 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990105182301.5966.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 lib/ExtUtils/MakeMaker.pm] Typos fixes.
+ Date: Tue, 5 Jan 1999 13:23:00 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990105183344.6065.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/ExtUtils/Manifest.pm] Typo fixes
+ Date: Tue, 5 Jan 1999 13:33:44 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990105184028.6220.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/ExtUtils/Mksymlists.pm] Typo fix
+ Date: Tue, 5 Jan 1999 13:40:28 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990106012015.9451.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/IO/Pipe.pm] Typo fixes.
+ Date: Tue, 5 Jan 1999 20:20:15 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990106012047.9459.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRAIL2 lib/IO/Seekable.pm] Typo fixes
+ Date: Tue, 5 Jan 1999 20:20:47 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990106012338.9536.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/IO/Socket.pm] Typo fix
+ Date: Tue, 5 Jan 1999 20:23:38 -0500 (EST)
+ Branch: maint-5.005/perl
+ ! ext/IO/lib/IO/Pipe.pm ext/IO/lib/IO/Seekable.pm
+ ! ext/IO/lib/IO/Socket.pm lib/ExtUtils/Command.pm
+ ! lib/ExtUtils/Embed.pm lib/ExtUtils/Install.pm
+ ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Unix.pm
+ ! lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Manifest.pm
+ ! lib/ExtUtils/Mksymlists.pm
+____________________________________________________________________________
+[ 2560] By: gbarr on 1999/01/03 16:59:01
+ Log: Trial release 2
+ Branch: maint-5.005/perl
+ ! Changes patchlevel.h
+____________________________________________________________________________
+[ 2559] By: gbarr on 1999/01/02 15:37:35
+ Log: From: Blair Zajac <bzajac@geostaff.com>
+ Date: Wed, 23 Dec 1998 17:13:32 -0800
+ Message-ID: <3681953C.8B6A90AA@geostaff.com>
+ Subject: Tie::SubstrHash patch
+ Branch: maint-5.005/perl
+ ! lib/Tie/SubstrHash.pm
+____________________________________________________________________________
+[ 2558] By: gbarr on 1999/01/02 15:30:01
+ Log: integrate change #2544
+
+ From: Tim Bunce <Tim.Bunce@ig.co.uk>
+ Subject: bug in pod2man search for perl binary [5.005_5x]
+ Date: Sat, 12 Dec 1998 23:08:51 +0000
+ Message-ID: <19981212230851.A20578@ig.co.uk>
+ Branch: maint-5.005/perl
+ !> pod/pod2man.PL
+____________________________________________________________________________
+[ 2557] By: gbarr on 1999/01/02 15:20:42
+ Log: integrate change #2548
+
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ To: perl5-porters@perl.org
+ cc: hv@crypt0.demon.co.uk
+ Subject: [bug 5.004_54] duplicate error message
+ Date: Thu, 31 Dec 1998 04:05:25 +0000
+ Message-Id: <199812310405.EAA00386@crypt.compulink.co.uk>
+
+ Message-ID: <13963.60672.134591.383377@alias-2.pr.mcs.net>
+ From: Stephen McCamant <smccam@uclink4.berkeley.edu>
+ To: hv@crypt0.demon.co.uk
+ Cc: perl5-porters@perl.org
+ Subject: [PATCH _54] Re: duplicate error message
+ Date: Thu, 31 Dec 1998 16:10:13 -0600 (CST)
+
+ Message-Id: <199901010732.HAA02926@crypt.compulink.co.uk>
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ To: Stephen McCamant <smccam@uclink4.berkeley.edu>
+ cc: hv@crypt0.demon.co.uk, perl5-porters@perl.org
+ Subject: [TEST PATCH _54] Re: duplicate error message
+ Date: Fri, 01 Jan 1999 07:32:14 +0000
+ Branch: maint-5.005/perl
+ ! op.c t/pragma/warn-1global taint.c
+____________________________________________________________________________
+[ 2556] By: gbarr on 1999/01/02 15:18:58
+ Log: From: abigail@fnx.com
+ Date: Mon, 28 Dec 1998 14:16:12 -0500 (EST)
+ Message-ID: <19981228191612.8380.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_02; lib/fields.pm] Typos in pod.
+ Branch: maint-5.005/perl
+ ! lib/fields.pm
+____________________________________________________________________________
+[ 2555] By: gbarr on 1999/01/02 15:11:45
+ Log: intregrate change #2547
+
+ From: Chris Nandor <pudge@pobox.com>
+ Subject: Re: [PATCH] perlport.pod 1.38
+ Date: Thu, 31 Dec 1998 09:06:48 -0500
+ Message-Id: <v04020a1db2b1352ec92a@[192.168.0.77]>
+ Branch: maint-5.005/perl
+ !> pod/perlport.pod
+____________________________________________________________________________
+[ 2543] By: gbarr on 1998/12/31 06:17:13
+ Log: integrated relevant parts og changes #2385 & #2387 from mainline
+
+ various fixes for race conditions under threads: mutex locks based
+ on PL_threadnum were seriously flawed, since it means more than one
+ thread could enter the critical region; PL_na was global instead of
+ thread-local; child thread could finish and free thr structures
+ before Thread->new() got around to creating the Thread object;
+ cv_clone() needed locking, as it mucks with PL_comppad and other
+ global data; new_struct_thread() needed to lock template-thread's
+ mutex while copying its data
+
+ another threads reliability fix: serialize writes to thr->threadsv
+ avoid most uses of PL_na (which is much more inefficient than a
+ simple local); update docs to suit; PL_na now being thr->Tna may
+ be a minor compatibility issue for extensions--will require dTHR
+ outside of XSUBs (those get automatic dTHR)
+ Branch: maint-5.005/perl
+ ! XSUB.h djgpp/djgpp.c doio.c doop.c dump.c embedvar.h
+ ! ext/DynaLoader/dl_next.xs ext/IO/IO.xs ext/Opcode/Opcode.xs
+ ! ext/POSIX/POSIX.xs ext/Thread/Thread.xs ext/attrs/attrs.xs
+ ! gv.c malloc.c mg.c objXSUB.h op.c os2/OS2/REXX/REXX.xs
+ ! os2/os2.c perl.c perlvars.h perly.c perly.y pod/perlcall.pod
+ ! pod/perlembed.pod pod/perlguts.pod pod/perlxs.pod pp.c pp.h
+ ! pp_ctl.c pp_hot.c pp_sys.c run.c sv.c taint.c thread.h toke.c
+ ! universal.c util.c vms/ext/Stdio/Stdio.xs vms/perly_c.vms
+ ! vms/vms.c win32/win32.c win32/win32thread.c
+____________________________________________________________________________
+[ 2542] By: gbarr on 1998/12/30 14:46:40
+ Log: doc updates
+
+ From: abigail@fnx.com
+ Date: Wed, 23 Dec 1998 22:32:07 -0500 (EST)
+ Message-ID: <19981224033207.16751.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_02] Typo in documentation of pod2html.
+
+ From: abigail@fnx.com
+ Date: Wed, 23 Dec 1998 22:59:59 -0500 (EST)
+ Message-ID: <19981224035959.16994.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_02] Re: m// doc is buggy (was Re: m'$foo' is undocumented)
+
+ pod/perldelta.pod from:
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Thu, 17 Dec 1998 16:13:34 +0200 (EET)
+ Message-ID: <13945.4494.140163.973953@alpha.hut.fi>
+ Subject: Re: important UNDOC issues for 5.005_54
+ Branch: maint-5.005/perl
+ ! pod/perldelta.pod pod/perlop.pod pod/pod2html.PL
+____________________________________________________________________________
+[ 2541] By: gbarr on 1998/12/30 14:37:14
+ Log: From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Wed, 23 Dec 1998 21:26:38 +0100
+ Message-ID: <36895086.8849224@smtp1.ibm.net>
+ Subject: [PATCH 5.005_03m1] subdirectory Makefiles should inherit CAPI setting from command line
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/MakeMaker.pm
+____________________________________________________________________________
+[ 2538] By: gbarr on 1998/12/29 14:41:29
+ Log: From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Tue, 22 Dec 1998 10:57:48 +0200 (EET)
+ Message-ID: <13951.24332.932827.831376@alpha.hut.fi>
+ Subject: Re: x operator broken in DEC Alpha for 8-bit characters (Re: Digest-MD5-2.00 test fails on DEC Alpha - a patch)
+ Branch: maint-5.005/perl
+ ! t/op/repeat.t util.c
+____________________________________________________________________________
+[ 2535] By: gbarr on 1998/12/29 14:27:56
+ Log: From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Fri, 18 Dec 1998 16:39:27 +0200 (EET)
+ Message-ID: <13946.26911.140905.387070@alpha.hut.fi>
+ Subject: Math::Trig, Math::Complex, Fcntl, addressed (Re: Undocumentation Issues for 5.005)
+ Branch: maint-5.005/perl
+ ! pod/perldelta.pod
+____________________________________________________________________________
+[ 2534] By: gbarr on 1998/12/29 14:23:02
+ Log: From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Tue, 15 Dec 1998 17:52:32 +0200 (EET)
+ Message-ID: <13942.34240.66558.169330@alpha.hut.fi>
+ Subject: some doc link fixes
+ Branch: maint-5.005/perl
+ ! pod/perlcall.pod pod/perldata.pod pod/perldiag.pod
+ ! pod/perlfaq5.pod pod/perlfaq7.pod pod/perlfunc.pod
+ ! pod/perlguts.pod pod/perllocale.pod pod/perlobj.pod
+ ! pod/perlsub.pod pod/perlvar.pod
+____________________________________________________________________________
+[ 2533] By: gbarr on 1998/12/29 14:23:00
+ Log: From: Chris Nandor <pudge@pobox.com>
+ Date: Sat, 19 Dec 1998 12:54:34 -0500
+ Message-Id: <v04020a03b2a194aaa676@[192.168.0.77]>
+ Subject: [PATCH] perlport.pod v1.37
+ Branch: maint-5.005/perl
+ ! pod/perlport.pod
+____________________________________________________________________________
+[ 2531] By: gbarr on 1998/12/29 14:12:25
+ Log: change in_pod pattern to /^=\w/ from /^=/
+ From: Frank Ridderbusch <Frank.Ridderbusch@pdb.siemens.de>
+ Date: Tue, 15 Dec 1998 16:23:12 +0100 (MET)
+ Message-ID: <13942.32480.700000.640927@utensil>
+ Subject: Minor Bug in AutoSplit.qm in 5.005 and 5.004
+ Branch: maint-5.005/perl
+ ! lib/AutoSplit.pm
+____________________________________________________________________________
+[ 2530] By: gbarr on 1998/12/29 14:09:51
+ Log: undo the "perlsyn intrusion" into perlfunc
+ Branch: maint-5.005/perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 2529] By: gbarr on 1998/12/29 14:04:35
+ Log: From: Jarkko Hietaniemi <hietanie@koah.research.nokia.com>
+ Date: Sun, 13 Dec 1998 14:54:56 +0200 (EET)
+ Message-Id: <199812131254.OAA24494@koah.research.nokia.com>
+ Subject: ignore_versioned_libs isn't used anywhere (it became ignore_versioned_solibs)
+ Branch: maint-5.005/perl
+ ! hints/linux.sh
+____________________________________________________________________________
+[ 2528] By: gbarr on 1998/12/29 13:59:49
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Wed, 28 Oct 1998 01:20:33 -0500 (EST)
+ Message-Id: <199810280620.BAA06893@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.00552] Make sort respect overloading
+ Branch: maint-5.005/perl
+ ! pp_ctl.c t/pragma/overload.t
+____________________________________________________________________________
+[ 2527] By: gbarr on 1998/12/29 13:58:56
+ Log: doc update, quads only work on 64-but platforms
+ Branch: maint-5.005/perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 2526] By: gbarr on 1998/12/29 13:49:55
+ Log: From: Andy Dougherty <doughera@lafayette.edu>
+ Date: Tue, 1 Dec 1998 12:50:27 -0500 (EST)
+ Message-Id: <Pine.SUN.3.96.981201124929.4288H-100000@newton.phys>
+ Subject: [PATCH 5.005_xx] erroneous 'none' in lddlflags
+ Branch: maint-5.005/perl
+ ! Configure
+____________________________________________________________________________
+[ 2512] By: gbarr on 1998/12/28 14:56:36
+ Log: change t/op/pwent.t to ignore NIS includes
+ From: achampio@lehman.com (Alan Champion)
+ Date: Tue, 1 Dec 1998 15:18:03 GMT
+ Message-Id: <9812011518.AA00005@lonhpov1.lehman.com>
+ Subject: Not OK: perl 5.00503 +MAINT_TRIAL_1 on sun4-solaris 2.3 (UNINSTALLED)
+
+ From: pvhp@forte.com (Peter Prymmer)
+ Date: Fri, 4 Dec 98 17:11:41 PST
+ Message-Id: <9812050111.AA16778@forte.com>
+ Subject: [PATCH 5.005_03-MAINT_TRIAL_1 && 5.005_54]dumper and searchdict ebcdic style
+ Branch: maint-5.005/perl
+ ! t/lib/dumper.t t/lib/searchdict.t t/op/pwent.t
+____________________________________________________________________________
+[ 2511] By: gbarr on 1998/12/28 14:55:28
+ Log: From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Tue, 01 Dec 1998 00:07:33 +0100
+ Message-ID: <366921b5.14512598@smtp1.ibm.net>
+ Subject: Re: 5.005_03-MAINT-TRIAL1, [PATCH] to compile on Win32
+
+ From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Wed, 02 Dec 1998 00:24:54 +0100
+ Message-ID: <366a77bb.19498126@smtp1.ibm.net>
+ Subject: Re: 5.005_03-MAINT-TRIAL1, [PATCH] spaces in filenames support
+ Branch: maint-5.005/perl
+ ! perl.h proto.h taint.c win32/GenCAPI.pl win32/Makefile
+ ! win32/config.bc win32/config.gc win32/config.vc
+ ! win32/config_sh.PL win32/makedef.pl
+____________________________________________________________________________
+[ 2510] By: gbarr on 1998/12/28 14:37:35
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Tue, 1 Dec 1998 00:34:08 -0500 (EST)
+ Message-Id: <199812010534.AAA21371@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_*] Debugger 'v' command
+ Branch: maint-5.005/perl
+ ! lib/perl5db.pl
+____________________________________________________________________________
+[ 2478] By: gbarr on 1998/12/13 16:02:24
+ Log: From: pvhp@forte.com (Peter Prymmer)
+ Date: Mon, 30 Nov 98 21:08:36 PST
+ Message-Id: <9812010508.AA07791@forte.com>
+ Subject: [PATCH 5.005_03t1 && 5.005_54]dll linkage side decks for OS/390
+ Branch: maint-5.005/perl
+ ! hints/os390.sh
+____________________________________________________________________________
+[ 2477] By: gbarr on 1998/12/13 16:00:23
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ Date: Mon, 30 Nov 1998 17:08:12 -0800
+ Message-Id: <3.0.6.32.19981130170812.00b12b70@ous.edu>
+ Subject: [PATCH 5.005_03]Minor VMS patches needed to build
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/MM_VMS.pm vms/subconfigure.com
+____________________________________________________________________________
+[ 2476] By: gbarr on 1998/12/13 15:30:58
+ Log: From: pvhp@forte.com (Peter Prymmer)
+ Date: Fri, 4 Dec 98 00:37:32 PST
+ Message-Id: <9812040837.AA10908@forte.com>
+ Subject: Re: [PATCH 5.005_03-MAINT-TRIAL1] some tweaks to the build process for OS/390
+ Branch: maint-5.005/perl
+ ! Makefile.SH regcomp.c
+____________________________________________________________________________
+[ 2472] By: gbarr on 1998/12/12 17:12:28
+ Log: undo changes to Exporter.pm from #2312
+ Branch: maint-5.005/perl
+ ! lib/Exporter.pm
+____________________________________________________________________________
+[ 2471] By: gbarr on 1998/12/12 17:09:39
+ Log: integrate change#2459 from cfgperl
+
+ enclose case want_vtbl_collxfrm with #ifdef USE_LOCALE_COLLATE
+
+ From: hansm@icgroup.nl
+ Subject: Not OK: perl 5.00503 +MAINT_TRIAL_1 on OPENSTEP-Mach 4_1 (UNINSTALLED)
+ Date: Sun, 6 Dec 98 22:19:54 +0100
+ Message-Id: <9812062116.AA26445@icgned.icgroup.nl>
+ Branch: maint-5.005/perl
+ ! util.c
+____________________________________________________________________________
+[ 2470] By: gbarr on 1998/12/12 16:46:03
+ Log: re-sync'd Text::Wrap with new version from CPAN
+ Branch: maint-5.005/perl
+ +> t/lib/textfill.t
+ ! MANIFEST
+ !> lib/Text/Wrap.pm t/lib/textwrap.t
+____________________________________________________________________________
+[ 2469] By: gbarr on 1998/12/12 15:58:43
+ Log: integrate changes#2435,2436 from cfgperl
+
+ Pod::Html and Pod::Text were not locale-savvy:
+ for example in =head1 all non-ASCII-\w-runs were
+ turned into underscores in NAME tags. This could
+ result in several NAME tags becoming identical.
+ Reported by:
+
+ From: Fyodor Krasnov <fyodor@aha.ru>
+ Subject: pod2html vs Russian Characters
+ To: Tom.Christiansen@snn.aha.ru, tchrist@perl.com
+ Date: Tue, 24 Nov 1998 19:00:36 +0300 (MSK)
+ Message-Id: <199811241600.TAA05149@stat.aha.ru>
+
+ One paste too many in #2435.
+ Branch: maint-5.005/perl
+ !> lib/Pod/Html.pm lib/Pod/Text.pm
+____________________________________________________________________________
+[ 2468] By: gbarr on 1998/12/12 15:01:58
+ Log: redirect trail program to error msg file in Configure
+
+ From: Andy Dougherty <doughera@lafayette.edu>
+ Date: Tue, 1 Dec 1998 13:40:12 -0500 (EST)
+ Message-Id: <Pine.SUN.3.96.981201133546.4288K-100000@newton.phys>
+ Subject: [PATCH 5.005_xx] Missing redirection of simple test program
+ Branch: maint-5.005/perl
+ ! Configure
+____________________________________________________________________________
+[ 2467] By: gbarr on 1998/12/12 14:52:24
+ Log: Change reall_srchlen back to an int from a #define
+
+ From: Graham Barr <gbarr@ti.com>
+ Date: Mon, 30 Nov 1998 14:29:14 -0600
+ Message-ID: <19981130142914.X1504@asic.sc.ti.com>
+ Subject: [PATCH 5.005_03-MT!] Re: one compilation warning from 5_03-MT1
+ Branch: maint-5.005/perl
+ ! malloc.c
+____________________________________________________________________________
+[ 2466] By: gbarr on 1998/12/12 14:40:56
+ Log: s/SCM_CREDENTIALSS/SCM_CREDENTIALs/ in Socket.xs
+
+ From: Andy Dougherty <doughera@lafayette.edu>
+ Date: Thu, 3 Dec 1998 11:26:25 -0500 (EST)
+ Message-Id: <Pine.SUN.3.96.981203112330.8800H-100000@newton.phys>
+ Subject: [PATCH 5.005_03-MAINT_TRIAL_1] Trivial grammar patch
+ Branch: maint-5.005/perl
+ ! Porting/Glossary
+ !> ext/Socket/Socket.xs
+____________________________________________________________________________
+[ 2456] By: gsar on 1998/12/06 13:49:02
+ Log: branch perldelta.pod
+ Branch: maint-5.005/perl
+ +> pod/perldelta.pod
+____________________________________________________________________________
+[ 2455] By: gsar on 1998/12/06 13:47:21
+ Log: clobber perldelta.pod to reestablish branch from perl5005delta.pod
+ Branch: maint-5.005/perl
+ - pod/perldelta.pod
+____________________________________________________________________________
+[ 2415] By: gbarr on 1998/11/30 02:31:15
+ Log: Chnages,patchlevel.h etc...
+ Branch: maint-5.005/perl
+ ! Changes MANIFEST patchlevel.h t/op/tr.t win32/Makefile
+ ! win32/config_H.bc win32/config_H.gc win32/config_H.vc
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 2411] By: gbarr on 1998/11/30 01:31:22
+ Log: integrated changes#2323,2353,2369
+
+ From: maeda@src.ricoh.co.jp
+ Date: Tue, 24 Nov 1998 10:37:45 +0900
+ Message-Id: <199811240137.KAA05867@luna.src.ricoh.co.jp>
+ Subject: format "..." bug
+
+ Locale collation, ctype, and numeric, were initialized wrong
+ (if LC_ALL or LANG were unset, so were the collation/ctype/numeric),
+ as reported by
+
+ From: Ilya.Sandler@etak.com (Ilya Sandler)
+ Subject: a bug in locale handling: LC_COLLATE ignored sometimes
+ Date: 25 Nov 1998 04:53:52 +0200
+ Message-ID: <MLIST_199811250226.SAA12590@axi001.etak.sw>
+
+ allow final period in a file (not followed by a newline) to
+ terminate format spec
+ Branch: maint-5.005/perl
+ ! pp_ctl.c toke.c util.c
+ !> t/op/write.t
+____________________________________________________________________________
+[ 2408] By: gbarr on 1998/11/30 01:29:19
+ Log: integrated ext/B/... changes from mainline
+ Branch: maint-5.005/perl
+ !> ext/B/B.pm ext/B/B.xs ext/B/B/Assembler.pm ext/B/B/C.pm
+ !> ext/B/B/Disassembler.pm
+____________________________________________________________________________
+[ 2404] By: gbarr on 1998/11/30 00:26:36
+ Log: integrate some of change#2318 from mainline
+ Branch: maint-5.005/perl
+ +> t/op/grent.t t/op/pwent.t
+ !> ext/DB_File/Changes ext/DB_File/DB_File.pm
+ !> ext/DB_File/DB_File.xs ext/POSIX/hints/dynixptx.pl
+ !> ext/Socket/Socket.pm ext/Socket/Socket.xs lib/Benchmark.pm
+ !> pod/perldata.pod t/op/sort.t
+____________________________________________________________________________
+[ 2398] By: gbarr on 1998/11/29 22:11:16
+ Log: integrate changes#2254,2259,2335,2345,2348,2361,2368,2380 from mainline
+
+ win32_recvfrom() compatibility fix
+
+ From: "Kurt D. Starsinic" <kstar@chapin.edu>
+ Subject: Re: [PATCH] Re: pod2man bug in date generated line
+ To: Albert Dvornik <bert@genscan.com>, "Larry W. Virden" <lvirden@cas.org>
+ Cc: perlbug@perl.com
+ Date: 20 Nov 1998 21:30:17 +0200
+ Message-ID: <MLIST_19981120131523.A464@O2.chapin.edu>
+
+ make $1 et al readonly under threads; make C<undef $1> fail like
+ C<$1 = undef> does
+
+ fix typo in pp_defined() causing C<defined %tied> to fail
+
+ more conservative version of changes#2345,2346,2347; those break
+ C<defined(@{"foo::ISA"})> which seems to be extensively used in
+ the libs :-(
+
+ fix uninitialized warnings
+ From: Brian Callaghan <callagh@itginc.com>
+ Date: Thu, 19 Nov 1998 17:49:10 -0800
+ Message-Id: <3654CA96.B64FCAEB@itginc.com>
+ Subject: Complete.pm patch (version 1.1)
+
+ Liblist tweak suggested by Swen Thuemmler <Swen.Thuemmler@paderlinx.de>;
+ add C<$Config{installarchlib}/CORE> to the default locations searched
+ on win32
+
+ prefer IO::Handle for IO if FileHandle:: is empty (as suggested by
+ Tim Bunce)
+ Branch: maint-5.005/perl
+ ! gv.c op.c pp.c
+ !> lib/ExtUtils/Liblist.pm lib/Term/Complete.pm pod/perlfaq4.pod
+ !> pod/pod2man.PL t/op/undef.t win32/win32sck.c
+____________________________________________________________________________
+[ 2315] By: gbarr on 1998/11/27 05:16:50
+ Log: integrate change#2246 from mainline, while still allowing
+ C<sort $globref @foo>
+
+ allow C<sort $coderef @foo>
+ Branch: maint-5.005/perl
+ ! op.c sv.c
+ !> t/op/sort.t
+____________________________________________________________________________
+[ 2314] By: gbarr on 1998/11/27 04:03:58
+ Log: integrate change#2159 from mainline
+
+ Data::Dumper update
+ Branch: maint-5.005/perl
+ !> ext/Data/Dumper/Changes ext/Data/Dumper/Dumper.pm
+ !> ext/Data/Dumper/Dumper.xs ext/Data/Dumper/Todo t/lib/dumper.t
+____________________________________________________________________________
+[ 2313] By: gbarr on 1998/11/27 03:04:21
+ Log: Fix typo in change#2312
+ Branch: maint-5.005/perl
+ ! ext/Thread/Thread.xs
+____________________________________________________________________________
+[ 2312] By: gbarr on 1998/11/27 03:03:03
+ Log: integrate change#1837,1967,1986,2060,2068,2146,2214,2224,2300,2301 from mainline
+
+ (via private mail)
+ From: Charles Bailey <BAILEY@newman.upenn.edu>
+ Date: Sat, 05 Sep 1998 01:23:58 -0400 (EDT)
+ Message-id: <01J1FH7R43NS002F14@cor.newman.upenn.edu>
+ Subject: [Patch 5.005_02] Miscellaneous VMS cleanup
+
+ correct bugs exposed in MM_Unix.pm by commenting out Selfloader
+ (MAN3PODS cannot be set to ' '; stray stricture violation)
+
+ qualify names of builtins
+
+ handle '::' in section names properly
+ From: Graham Barr <gbarr@pobox.com>
+ Date: Sat, 17 Oct 1998 12:57:54 -0500
+ Message-ID: <19981017125754.C510@pobox.com>
+ Subject: Re: pod2html
+
+ From: Zachary Miller <zcmiller@simon.er.usgs.gov>
+ Date: Tue, 20 Oct 1998 20:52:20 -0500
+ Message-Id: <199810210152.UAA07792@simon.er.usgs.gov>
+ Subject: Exporter.pm's export_to_level() argument handling buggy
+
+ hand-apply whitespace-mutiliated patch
+ From: "vishal bhatia" <vishalb@hotmail.com>
+ Date: Wed, 28 Oct 1998 23:45:32 PST
+ Message-ID: <19981029074534.2334.qmail@hotmail.com>
+ Subject: [PATCH 5.005_52]Compiling modules,more bugfixes for B
+
+ typo in newHVhv()
+
+ avoid endless loops in Text::Wrap (from a suggestion by Lupe
+ Christoph <lupe@alanya.m.isar.de>)
+
+ properly free temporaries created by threads
+
+ fix PL_defoutgv leak under threads
+ Branch: maint-5.005/perl
+ !> (integrate 31 files)
+____________________________________________________________________________
+[ 2311] By: gbarr on 1998/11/27 01:31:36
+ Log: integrate change#2210 from mainline
+
+ fix AvREALISH bogusness
+ Branch: maint-5.005/perl
+ ! av.c
+ !> t/op/array.t
+____________________________________________________________________________
+[ 2310] By: gbarr on 1998/11/27 00:20:21
+ Log: integrate changes#2235,2299,2300 from mainline
+
+ catch a neophyte trap: open(<FH>), close(<FH>) etc.
+
+ fix C<if (...) { package Foo; ... }> misoptimization that fails
+ to set the package for the block properly
+
+ properly free temporaries created by threads
+ Branch: maint-5.005/perl
+ ! ext/Thread/Thread.xs op.c perl.h util.c
+ !> t/comp/package.t
+____________________________________________________________________________
+[ 2309] By: gbarr on 1998/11/27 00:16:36
+ Log: integrate change#2298 from mainline
+ Branch: maint-5.005/perl
+ !> universal.c
+____________________________________________________________________________
+[ 2308] By: gbarr on 1998/11/27 00:11:44
+ Log: Updates for MPE/iX DynaLoader and installperl, via private mail
+ forwarded by Jarkko Hietaniemi from Mark Bixby
+ Branch: maint-5.005/perl
+ ! ext/DynaLoader/dl_mpeix.xs installperl
+____________________________________________________________________________
+[ 2307] By: gbarr on 1998/11/27 00:07:27
+ Log: Remove docs for feature not in _0*
+ Branch: maint-5.005/perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 2306] By: gbarr on 1998/11/26 23:44:47
+ Log: Allow PL_FILES to have multiple targets from one source by allowing
+ an array ref as the value in the hash
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_VMS.pm
+ ! lib/ExtUtils/MakeMaker.pm
+____________________________________________________________________________
+[ 2305] By: gbarr on 1998/11/26 23:38:06
+ Log: fix unsigned variables to use SvUV and sv_setuv
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/typemap
+____________________________________________________________________________
+[ 2304] By: gbarr on 1998/11/26 23:36:17
+ Log: Fix embeded \n in ABSTRACT and <> in AUTHOR
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/MM_Unix.pm
+____________________________________________________________________________
+[ 2302] By: gbarr on 1998/11/26 15:27:03
+ Log: integrate changes#2177,2189,2228,2229 from cfgperl
+
+ 0**0 = 1, from
+
+ From: d-lewart@uiuc.edu (Daniel S. Lewart)
+ Subject: Math::Complex 0**0 patches
+ Date: Sun, 1 Nov 1998 19:21:48 -0600 (CST)
+ Message-Id: <199811020121.TAA28310@staff2.cso.uiuc.edu>
+
+ sysio.t failure: fix undefined order of evaluation, from
+
+ From: Spider Boardman <spider@web.zk3.dec.com>
+ Subject: Not OK: perl 5.00553 on alpha-thread 5.0 [PATCH]
+ Date: 4 Nov 1998 01:22:30 +0200
+ Message-ID: <MLIST_199811032227.RAA143892@web.zk3.dec.com>
+
+ From: "Martin J. Bligh" <mbligh@sequent.com>
+ Message-ID: <187803647.910720870@w-186d219.rhe.sequent.com>
+ Subject: Re: Making Perl work on DYNIX/ptx
+ Date: Tue, 10 Nov 1998 18:01:10 -0800
+
+ From: "Martin J. Bligh" <mbligh@sequent.com>
+ Subject: Re: Making Perl work on DYNIX/ptx
+ Date: Tue, 10 Nov 1998 16:24:26 -0800
+ Message-ID: <181999655.910715066@w-186d219.rhe.sequent.com>
+ Branch: maint-5.005/perl
+ +> ext/DB_File/hints/dynixptx.pl ext/POSIX/hints/dynixptx.pl
+ ! pp_sys.c
+ !> hints/dynixptx.sh lib/Math/Complex.pm t/lib/complex.t
+____________________________________________________________________________
+[ 2297] By: gbarr on 1998/11/24 02:32:38
+ Log: integrate change#2266 from cfgperl
+ From: John Tobey <jtobey@channel1.com>
+ Subject: [PATCH] perlfaq typos
+ To: perl5-porters@perl.com
+ Date: 22 Nov 1998 04:25:15 +0200
+ Message-ID: <MLIST_m0zhPeF-000FOgC@feynman.localnet>
+ Branch: maint-5.005/perl
+ !> pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod
+ !> pod/perlfaq7.pod pod/perlfaq8.pod
+____________________________________________________________________________
+[ 2296] By: gbarr on 1998/11/24 01:39:18
+ Log: integrated changes#2011,2092,2106,2108,2143 from cfgperl
+
+ More robust yacc/bison failure output handling.
+
+ More robustness.
+
+ Bison says 'parse error', not 'parser error'.
+
+ The "parse error" must be converted to "syntax error",
+ just matching it aint' enough.
+
+ There can be multiple yacc/bison errors.
+ Branch: maint-5.005/perl
+ !> t/comp/require.t t/op/misc.t t/pragma/subs.t
+ !> t/pragma/warning.t
+____________________________________________________________________________
+[ 2295] By: gbarr on 1998/11/24 00:49:28
+ Log: integrate change#1823 from mainline
+ From: Joe Buehler <jhpb@hekimian.com>
+ Date: 29 Aug 1998 17:13:28 -0400
+ Message-ID: <yd37lzro5jb.fsf@pandora.hekimian.com>
+ Subject: patches for perl 5.005_51 under U/WIN
+ Branch: maint-5.005/perl
+ +> hints/uwin.sh
+ ! Configure
+ !> installman makedepend.SH t/lib/posix.t
+____________________________________________________________________________
+[ 2258] By: gbarr on 1998/11/21 20:48:02
+ Log: Another Configure patch from Jarkko
+ Branch: maint-5.005/perl
+ ! Configure
+____________________________________________________________________________
+[ 2257] By: gbarr on 1998/11/21 17:23:13
+ Log: Big Configure patch from Jarkko Hietaniemi <jhi@iki.fi> via
+ private mail
+ Branch: maint-5.005/perl
+ ! Configure Makefile.SH config_h.SH hints/dec_osf.sh
+ ! hints/freebsd.sh hints/irix_6.sh hints/linux.sh
+ ! hints/next_3.sh hints/os390.sh pp_sys.c
+____________________________________________________________________________
+[ 2239] By: gbarr on 1998/11/14 03:59:58
+ Log: more doc changes from mainline
+ Branch: maint-5.005/perl
+ ! pod/perldiag.pod pod/perlfunc.pod pod/perlre.pod
+ !> INSTALL README.vms vms/ext/Stdio/Stdio.pm
+____________________________________________________________________________
+[ 2238] By: gbarr on 1998/11/14 02:51:51
+ Log: integrate doc changes from mainline, including
+ changes#1796,1811,1830,1831,1844,1846,1876,1905,2149,2152
+ Branch: maint-5.005/perl
+ !> README.os390 pod/perl.pod pod/perldelta.pod pod/perlfaq1.pod
+ !> pod/perlform.pod pod/perlfunc.pod pod/perlguts.pod
+ !> pod/perlipc.pod pod/perllocale.pod pod/perlport.pod
+ !> pod/perlref.pod pod/perlrun.pod pod/perlvar.pod pod/perlxs.pod
+ !> pod/pod2man.PL
+____________________________________________________________________________
+[ 2237] By: gbarr on 1998/11/14 02:51:49
+ Log: integrate change#1847 from mainline
+ From: Roderick Schertler <roderick@argon.org>
+ Date: Wed, 09 Sep 1998 23:52:48 -0400
+ Message-ID: <20567.905399568@eeyore.ibcinc.com>
+ Subject: seed srand from /dev/urandom when possible
+ Branch: maint-5.005/perl
+ ! pp.c
+____________________________________________________________________________
+[ 2232] By: gbarr on 1998/11/13 03:12:37
+ Log: integrate change#2215 from mainline
+ set close-on-exec bit on pipe() FDs
+ Branch: maint-5.005/perl
+ ! pod/perlfunc.pod pod/perlvar.pod pp_sys.c
+____________________________________________________________________________
+[ 2231] By: gbarr on 1998/11/13 02:16:03
+ Log: integrate change#2188 from mainline
+ fix return value of win32_pclose()
+ Branch: maint-5.005/perl
+ !> win32/win32.c
+____________________________________________________________________________
+[ 2218] By: gbarr on 1998/11/08 16:48:44
+ Log: From: Graham Barr <gbarr@ti.com>
+ Date: Mon, 2 Nov 1998 07:38:52 -0600
+ Message-ID: <19981102073852.A12751@asic.sc.ti.com>
+ Subject: [PATCH 5.005_*] Re: IPC::Msg 1.03
+ Branch: maint-5.005/perl
+ ! ext/IPC/SysV/Msg.pm
+____________________________________________________________________________
+[ 2217] By: gbarr on 1998/11/08 05:22:39
+ Log: fix changes in 2213 not to break binary compat
+ Branch: maint-5.005/perl
+ ! pp_ctl.c proto.h
+____________________________________________________________________________
+[ 2216] By: gbarr on 1998/11/08 04:21:01
+ Log: integrate change#2192 from mainline
+ indeterminate order-of-evaluation fixes
+ Branch: maint-5.005/perl
+ ! mg.c
+____________________________________________________________________________
+[ 2213] By: gbarr on 1998/11/08 00:39:44
+ Log: integrate change#2051 from mainline
+ properly restore PL_rsfp_filters after require
+ Branch: maint-5.005/perl
+ ! embed.h global.sym objXSUB.h objpp.h pp_ctl.c proto.h scope.c
+ ! scope.h
+____________________________________________________________________________
+[ 2212] By: gbarr on 1998/11/07 23:13:29
+ Log: integrate changes#1914,1925,1926,1945,1956,1987 from mainline
+
+ normalize tm struct passed to strftime() with mktime()
+ From: Spider Boardman <spider@orb.nashua.nh.us>
+ Date: Wed, 30 Sep 1998 15:12:09 -0400
+ Message-Id: <199809301912.PAA26119@Orb.Nashua.NH.US>
+ Subject: [PATCH 5.005_52] Re: POSIX::strftime returns incorrect date
+
+ disable USE_THREADS when PERL_OBJECT is enabled
+
+ From: Mark-Jason Dominus <mjd@plover.com>
+ Date: Sun, 04 Oct 1998 14:48:11 -0400
+ Message-ID: <19981004184811.16048.qmail@plover.com>
+ Subject: PATCH: perldoc -f does not locate -e, -r, -x, etc.
+
+ defer "deep recursion" warnings until CXt_SUB context is properly
+ set up
+
+ Mutexen should be initialized only once.
+
+ perldoc pod update
+ From: Daniel Grisinger <dgris@perrin.dimensional.com>
+ Date: 06 Oct 1998 23:56:51 -0600
+ Message-ID: <m3g1d0kj8c.fsf@perrin.dimensional.com>
+ Subject: [PATCH _02 and _52] perldoc
+ Branch: maint-5.005/perl
+ ! gv.c op.c pp_hot.c
+ !> ext/POSIX/POSIX.pod ext/POSIX/POSIX.xs utils/perldoc.PL
+ !> win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 2207] By: gbarr on 1998/11/06 01:36:17
+ Log: integrate changes#1912,1948 from mainline
+ change warning about glob process failure
+ Branch: maint-5.005/perl
+ ! pod/perldiag.pod pp_hot.c
+____________________________________________________________________________
+[ 2200] By: gbarr on 1998/11/05 04:26:26
+ Log: integrate changes#1840,1855,1860,1882,1884,1891,1900,1907 from mainline
+ pl2bat tweak from Tye McQueen <tye@metronet.com>
+
+ reset errno after C<require> search (as suggested by Larry)
+
+ upgrade to CPAN-1.40
+
+ missing file in last submit (1881)
+
+ temporarily disable perl malloc for a2p until we clean up
+ conflicting malloc() declarations everywhere
+
+ Fixed apostrophe problem from Mark Knutsen.
+
+ use SETERRNO() to reset errno (suggested by Charles Bailey)
+
+ applied patches, but retained old behavior for win32 (where compilers
+ can't read from stdin at all)
+ From: Graham Barr <gbarr@ti.com>
+ Date: Mon, 28 Sep 1998 09:41:49 -0500
+ Message-ID: <19980928094149.B26576@asic.sc.ti.com>
+ Subject: Re: 5.005_51 Errno invokes cpprun incorrectly
+ --
+ Date: Tue, 29 Sep 1998 12:35:43 -0500
+ Message-ID: <19980929123543.Z26576@asic.sc.ti.com>
+ Subject: Re: 5.005_51 Errno invokes cpprun incorrectly
+
+ and ext/Errno/Errno_pm.PL from change#2050
+ Branch: maint-5.005/perl
+ ! perl.h pp_ctl.c proto.h sv.h
+ !> ext/Errno/Errno_pm.PL lib/CPAN.pm lib/CPAN/FirstTime.pm
+ !> win32/bin/pl2bat.pl x2p/Makefile.SH
+____________________________________________________________________________
+[ 2199] By: gbarr on 1998/11/05 03:35:00
+ Log: integrate changes#1817,1856,1869,1909 from mainline
+ updated usethreads hints for hpux 10.X
+ From: Matthew T Harden <mthard@mthard1.monsanto.com>
+ Date: Fri, 28 Aug 1998 14:10:42 GMT
+ Message-Id: <199808281410.AA11058@mthard1.monsanto.com>
+ Subject: Re: OK: perl 5.00502 on PA-RISC1.1-thread 10.20 (UNINSTALLED)
+
+ update hints for OPENSTEP 4.2 on i386
+ From: Gerben Wierda <Gerben_Wierda@RnA.nl>
+ Date: Sun, 20 Sep 1998 01:03:18 +0200
+ Message-Id: <9809192303.AA29190@Spike>
+ Subject: Perl 5.005_02 compilation problems
+
+ use STRICT_ALIGNMENT on IRIX to allow usemymalloc=y again
+ From: Scott Henry <scotth@sgi.com>
+ Date: 13 Aug 1998 09:52:15 PDT
+ Message-Id: <yd8pve46czk.fsf@hoshi.engr.sgi.com>
+ Subject: [PATCH] Irix USE_LONG_LONG/malloc.c incompatibility (was...)
+
+ update SCO hints for dynamic loading
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Mon, 28 Sep 1998 16:50:38 -0400 (EDT)
+ Message-Id: <Pine.SUN.3.96.980928164648.8130E-100000@newton.phys>
+ Subject: [PATCH 5.004_04-MAINT_TRIAL_5 and 5.005_xx] Re: Perl on SCO_SV
+ --
+ Date: Tue, 29 Sep 1998 16:48:55 -0400 (EDT)
+ Message-Id: <Pine.SUN.3.96.980929164612.8634A-100000@newton.phys>
+ Subject: Re: [PATCH 5.004_04-MAINT_TRIAL_5 and 5.005_xx] Re: Perl on SCO_SV
+ Branch: maint-5.005/perl
+ !> hints/hpux.sh hints/irix_6.sh hints/next_4.sh hints/sco.sh
+____________________________________________________________________________
+[ 2198] By: gbarr on 1998/11/05 03:00:51
+ Log: integrate OS2 changes from mainline, change#1836,1930,1996,2063
+ and os2/os2,c from #2145
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Sat, 5 Sep 1998 00:14:51 -0400 (EDT)
+ Message-Id: <199809050414.AAA19801@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_*] OS/2 spawning typos
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199810050637.CAA07781@monk.mps.ohio-state.edu>
+ Date: Mon, 5 Oct 1998 02:37:43 -0400 (EDT)
+ Subject: [PATCH 5.005_52] Cumulative OS/2-related patch
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Tue, 13 Oct 1998 04:46:00 -0400 (EDT)
+ Message-Id: <199810130846.EAA00769@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_52] Memory overrun in os2.c
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Sun, 18 Oct 1998 23:20:57 -0400 (EDT)
+ Message-Id: <199810190320.XAA28249@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_*] Improve sbrk() on OS/2
+
+ remaining PL_foo stragglers
+ Branch: maint-5.005/perl
+ ! mg.c perl_exp.SH util.c
+ !> hints/os2.sh os2/Changes os2/Makefile.SHs os2/os2.c
+____________________________________________________________________________
+[ 2197] By: gbarr on 1998/11/05 02:15:53
+ Log: integrate changes#1826,1862 from mainline
+
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Wed, 12 Aug 1998 22:41:37 +0300 (EET DST)
+ Message-Id: <199808121941.WAA06263@alpha.hut.fi>
+ Subject: [PATCH] 5.004_50 or 5.005_02: get rid of interp.sym because not even AIX needs it
+
+ remove bogus warn()
+ Branch: maint-5.005/perl
+ - interp.sym
+ ! MANIFEST Makefile.SH embed.pl perl_exp.SH
+____________________________________________________________________________
+[ 2194] By: gbarr on 1998/11/05 01:26:46
+ Log: integarte malloc.c changes from mainline change#1807,2112,2133
+ Branch: maint-5.005/perl
+ !> malloc.c
+____________________________________________________________________________
+[ 2193] By: gbarr on 1998/11/05 01:25:31
+ Log: integrate changes#1763,1778,1801,1804 from mainline
+
+ From: Stephen McCamant <alias@mcs.com>
+ Date: Sun, 2 Aug 1998 16:33:18 -0500 (CDT)
+ Message-ID: <13764.55116.921952.837027@alias-2.pr.mcs.net>
+ Subject: [PATCH] Eliminate superfluous RV2p[AH]Vs in oops[AH]V()
+
+ Implicit require during compile reset line numbering
+
+ silence redefined warning for XS(INIT) {}
+
+ From: Laszlo Molnar <molnarl@cdata.tvnet.hu>
+ Date: Sun, 9 Aug 1998 22:38:23 +0200
+ Message-ID: <19980809223823.A215@cdata.tvnet.hu>
+ Subject: [PATCH 5.5002] dos-djgpp update
+ Branch: maint-5.005/perl
+ ! op.c pp_ctl.c
+ !> t/io/fs.t
+____________________________________________________________________________
+[ 2176] By: gbarr on 1998/11/02 04:51:48
+ Log: integrate change#2030 from mainline
+
+ fix handling of mayhaps-extended @_ in goto &sub
+ Branch: maint-5.005/perl
+ ! av.c pp_ctl.c
+ !> t/op/goto.t
+____________________________________________________________________________
+[ 2175] By: gbarr on 1998/11/02 04:32:02
+ Log: integrate chnage#1934,1935 from mainline
+ fix USE_THREADS coredump due to uninitialized PL_hv_fetch_ent_mh
+ add test for previous fix
+ Branch: maint-5.005/perl
+ ! util.c
+ !> ext/Thread/create.t
+____________________________________________________________________________
+[ 2174] By: gbarr on 1998/11/02 04:22:20
+ Log: integrate change#1863,1881 from mainline
+
+ provide locked access to string table for USE_THREADS
+
+ serial access to PL_x[inpr]v_root for USE_THREADS
+ Branch: maint-5.005/perl
+ ! embedvar.h objXSUB.h perl.c proto.h sv.c
+ !> hv.c intrpvar.h thread.h
+____________________________________________________________________________
+[ 2173] By: gbarr on 1998/11/02 04:10:46
+ Log: integrate change#1990 from mainline
+
+ provide option to enable optimization with VC (suggested by Jan
+ Dubois)
+ Branch: maint-5.005/perl
+ !> win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 2172] By: gbarr on 1998/11/02 02:52:29
+ Log: integrate changes#1944,1948,1966 from mainline
+
+ change#1614 merely disabled earlier fix (doh!); undo it and properly
+ fixup the cop_seq value that must be seen by lexical lookups that
+ emanate within eval''
+
+ tweak to make fix in change#1944 behave correctly for closures
+ created within eval''
+ Branch: maint-5.005/perl
+ ! op.c pp_ctl.c pp_hot.c scope.c
+ !> cop.h t/op/eval.t
+____________________________________________________________________________
+[ 2171] By: gbarr on 1998/11/01 03:59:39
+ Log: integrate changes 1835,2003,2067 and File::Find change in 1938
+ warn on C<my($foo,$foo)>
+
+ silence -w noises (suggested by Greg Bacon) Term::Complete
+
+ From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Wed, 21 Oct 1998 00:55:51 +0200
+ Message-ID: <36380269.55370608@smtp1.ibm.net>
+ Subject: Make _really_ sure Dynaloader.xs code is initialized only once
+ Branch: maint-5.005/perl
+ ! op.c pod/perldiag.pod
+ !> ext/DynaLoader/DynaLoader_pm.PL lib/File/Find.pm
+ !> lib/Term/Complete.pm
+____________________________________________________________________________
+[ 2170] By: gbarr on 1998/11/01 03:48:38
+ Log: integrate change 1992 from mainline
+
+ applied suggested patch with small doc tweak
+ From: Gisle Aas <gisle@aas.no>
+ Date: 11 Oct 1998 12:53:13 +0200
+ Message-ID: <m3u31bfjza.fsf@furu.g.aas.no>
+ Subject: Re: [PATCH 5.005_52] Optional syswrite LENGTH argument
+ Branch: maint-5.005/perl
+ ! pod/perlfunc.pod pp_sys.c
+ !> opcode.h opcode.pl t/op/sysio.t t/op/tiehandle.t
+____________________________________________________________________________
+[ 2168] By: gbarr on 1998/11/01 01:58:58
+ Log: From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Fri, 09 Oct 1998 23:28:31 +0200
+ Message-ID: <36217b7f.3193091@smtp1.ibm.net>
+ Subject: [PATCH 5.005_02] Allow XS access to vtbl_*s when compiled with PERL_OBJECT
+ Branch: maint-5.005/perl
+ ! XSUB.h
+____________________________________________________________________________
+[ 2167] By: gbarr on 1998/11/01 01:22:41
+ Log: integrate change#2029 from mainline
+ restore sanity to "constant" references
+ Branch: maint-5.005/perl
+ ! op.c pod/perldiag.pod
+ !> lib/constant.pm t/pragma/constant.t
+____________________________________________________________________________
+[ 2166] By: gbarr on 1998/11/01 01:04:24
+ Log: integrate changes#1895,1896,2066,2147,2148 from mainline
+ fix win32_stat() to do the right thing for share names
+
+ small tweak on last change
+
+ recognize '%' as a shell metachar for win32
+ From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Tue, 20 Oct 1998 21:57:35 +0200
+ Message-ID: <3636ea31.49170453@smtp1.ibm.net>
+ Subject: [PATCH 5.005_02, Win32] Re: %ENV% not expanded in backquotes?
+
+ tweaked version of suggested patch
+ From: Anton Berezin <tobez@plab.ku.dk>
+ Date: 29 Oct 1998 14:48:54 +0100
+ Message-ID: <86yapzv5q1.fsf@lion.plab.ku.dk>
+ Subject: [PATCH 5.005_52] One more problem with win32_stat and MSVC
+
+ From: Anton Berezin <tobez@plab.ku.dk>
+ Date: 29 Oct 1998 17:06:25 +0100
+ Message-ID: <86pvbbuzcu.fsf@lion.plab.ku.dk>
+ Subject: [PATCH 5.005_52] win32_opendir() fails on empty drives
+ Branch: maint-5.005/perl
+ !> win32/win32.c
+____________________________________________________________________________
+[ 2165] By: gbarr on 1998/11/01 00:10:15
+ Log: integrated changes#1941,1942,1943,1975,2061,2111,2151 from mainline
+
+ don't longjmp() in pp_goto() (regressive bug from old single-stack
+ implementation)
+
+ force copy of substrings when matching against temporaries
+
+ ensure recursive attempts to findlex()icals know enough about where
+ the last eval'' context was encountered
+
+ propagate typeness of lexicals while cloning them
+
+ From: Graham Barr <gbarr@pobox.com>
+ Date: Sat, 17 Oct 1998 22:22:02 -0500
+ Message-ID: <19981017222202.J510@pobox.com>
+ Subject: Re: '*' prototype does not allow bareword with strict
+
+ smarter C<$SIG{FOO} = BAREWORD;> warning
+
+ From: Mark-Jason Dominus <mjd@plover.com>
+ Date: Fri, 30 Oct 1998 14:24:23 EST
+ Message-Id: <19981030192423.27276.qmail@plover.com>
+ Subject: PATCH: (5.005_02) a2p should use `chomp' instead of `chop'
+ Branch: maint-5.005/perl
+ ! op.c pp_ctl.c pp_hot.c t/op/pat.t toke.c
+ !> t/op/eval.t t/op/runlevel.t x2p/walk.c
+____________________________________________________________________________
+[ 2158] By: gbarr on 1998/10/31 05:03:02
+ Log: integrate changes#1821 & 1857 from mainline
+
+ s/runops/CALLRUNOPS/
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Tue, 22 Sep 1998 17:30:16 -0400 (EDT)
+ Message-Id: <199809222130.RAA17034@monk.mps.ohio-state.edu>
+ Subject: More verbose Test::Harness [PATCH]
+ Branch: maint-5.005/perl
+ !> cc_runtime.h lib/Test/Harness.pm
+____________________________________________________________________________
+[ 2157] By: gbarr on 1998/10/31 02:35:07
+ Log: integrate change#1839 from mainline
+ From: Drago Goricanec <drago@raptor.otsd.ts.fujitsu.co.jp>
+ Date: Mon, 7 Sep 1998 17:36:09 +0900
+ Message-Id: <199809070836.RAA14631@raptor.otsd.ts.fujitsu.co.jp>
+ Subject: Thread::cond_wait bug in 5.005.51 causes deadlock
+ Branch: maint-5.005/perl
+ ! ext/Thread/Thread.xs
+____________________________________________________________________________
+[ 2156] By: gbarr on 1998/10/31 02:22:11
+ Log: integrate change#1829 from mainline
+ fix problematic typecast in filter_del()
+ From: Mark P Lutz <tecmpl1@triton.ca.boeing.com>
+ Date: Mon, 31 Aug 1998 21:13:11 GMT
+ Message-Id: <199808312113.VAA53356@triton.ca.boeing.com>
+ Subject: perl5.005_02 does not build on Cray T90
+ Branch: maint-5.005/perl
+ ! toke.c
+____________________________________________________________________________
+[ 2155] By: gbarr on 1998/10/31 01:59:08
+ Log: integrate chnages#1824,2118 from mainline
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Sat, 29 Aug 1998 17:38:30 -0400 (EDT)
+ Message-Id: <199808292138.RAA18359@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_*] Protect debugger from nonlocal exits
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Wed, 28 Oct 1998 01:23:27 -0500 (EST)
+ Message-Id: <199810280623.BAA06968@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.00552] Minor debugger tweaks
+ Branch: maint-5.005/perl
+ !> lib/perl5db.pl
+____________________________________________________________________________
+[ 2154] By: gbarr on 1998/10/31 01:06:35
+ Log: integrate all lib/ExtUtils/... changes from mainline
+ Branch: maint-5.005/perl
+ !> lib/ExtUtils/MM_OS2.pm lib/ExtUtils/MM_Unix.pm
+ !> lib/ExtUtils/MM_VMS.pm lib/ExtUtils/MM_Win32.pm
+ !> lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mkbootstrap.pm
+ !> lib/ExtUtils/Mksymlists.pm lib/ExtUtils/xsubpp
+____________________________________________________________________________
+[ 2139] By: gbarr on 1998/10/30 04:17:53
+ Log: apply chnage#2071 from mainline
+ From: Graham Barr <gbarr@pobox.com>
+ Date: Sat, 17 Oct 1998 20:42:41 -0500
+ Message-ID: <19981017204241.G510@pobox.com>
+ Subject: Re: taint checking for: use lib "$ENV{'EVIL'}"
+ Branch: maint-5.005/perl
+ ! pp_ctl.c
+____________________________________________________________________________
+[ 2138] By: gbarr on 1998/10/30 04:14:35
+ Log: apply change#2077 from mainline
+ From: Graham Barr <gbarr@pobox.com>
+ Date: Sat, 24 Oct 1998 21:45:50 -0500
+ Message-ID: <19981024214550.C508@pobox.com>
+ Subject: Re: die with a reference should use overload "" operator
+ Branch: maint-5.005/perl
+ ! pp_ctl.c
+____________________________________________________________________________
+[ 2137] By: gbarr on 1998/10/30 04:01:06
+ Log: integrate change#1937 from mainline
+ fix $/ init for USE_THREADS
+ Branch: maint-5.005/perl
+ ! perl.c
+____________________________________________________________________________
+[ 2136] By: gbarr on 1998/10/30 03:40:55
+ Log: apply change#2076 from mainline
+ From: Graham Barr <gbarr@pobox.com>
+ Date: Sat, 24 Oct 1998 12:45:21 -0500
+ Message-ID: <19981024124521.C512@pobox.com>
+ Subject: [PATCH 5.005_02] Re: Auto-incrementing tied scalar causes SEGV
+ Branch: maint-5.005/perl
+ ! sv.c
+____________________________________________________________________________
+[ 2135] By: gbarr on 1998/10/30 03:28:29
+ Log: integrate change#1873 from mainline
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Tue, 25 Aug 1998 04:29:49 -0400 (EDT)
+ Message-Id: <199808250829.EAA02470@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_*] Extraneous warning for (?()A|B)
+ Branch: maint-5.005/perl
+ ! regcomp.c
+____________________________________________________________________________
+[ 2134] By: gbarr on 1998/10/30 03:15:12
+ Log: integrate change#1816 from mainline
+ don't create empty directories in installperl
+ From: Robin Barker <rmb1@cise.npl.co.uk>
+ Date: Fri, 21 Aug 1998 11:29:24 +0100 (BST)
+ Message-Id: <199808211029.LAA00551@cyclone.cise.npl.co.uk>
+ Subject: [PATCH 5.005_02] install: empty dirs
+ Branch: maint-5.005/perl
+ !> installperl
+____________________________________________________________________________
+[ 2132] By: gbarr on 1998/10/30 01:39:00
+ Log: integrate changes#1815 & 1828 from mainline
+ make behavior of /(a{3})+/ like /(aaa)+/ w.r.t where it matches
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Fri, 21 Aug 1998 05:41:02 -0400 (EDT)
+ Message-Id: <199808210941.FAA16467@monk.mps.ohio-state.edu>
+ Subject: Re: your mail
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Mon, 31 Aug 1998 14:52:10 -0400 (EDT)
+ Message-Id: <199808311852.OAA24676@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_5*] (?>) broken in RE
+ Branch: maint-5.005/perl
+ ! regexec.c
+ !> t/op/re_tests
+____________________________________________________________________________
+[ 2131] By: gbarr on 1998/10/30 01:09:19
+ Log: integrate change#1947 from mainline
+ let docatch() pass the buck when restartop turns out to be null,
+ making exceptions in BEGIN{} propagate as expected
+ Branch: maint-5.005/perl
+ ! pp_ctl.c
+ !> t/op/misc.t
+____________________________________________________________________________
+[ 2129] By: gbarr on 1998/10/29 14:53:11
+ Log: integrate change#1810 from mainline
+ fix bogus integerization of pop()'s return value
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Date: Sat, 15 Aug 1998 23:27:54 -0400
+ Message-Id: <199808160327.XAA05186@aatma.engin.umich.edu>
+ Subject: Re: Complex expression does integer arithmetic
+ Branch: maint-5.005/perl
+ !> opcode.h opcode.pl
+____________________________________________________________________________
+[ 2128] By: gbarr on 1998/10/29 14:28:13
+ Log: integrate change#1870 from mainline
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Date: Fri, 14 Aug 1998 09:20:16 PDT
+ Message-Id: <3.0.5.32.19980814092016.00b37dc0@ous.edu>
+ Subject: [PATCH 5.005_02] (and _5x I expect) VMS config procedure patch
+ Branch: maint-5.005/perl
+ !> configure.com
+____________________________________________________________________________
+[ 2127] By: gbarr on 1998/10/29 13:36:29
+ Log: Integrate change#1789 from mainline
+ delay freeing itervar so C<for $i (@a) { return($i) }> works
+ Branch: maint-5.005/perl
+ !> cop.h t/cmd/for.t
+____________________________________________________________________________
+[ 2123] By: gbarr on 1998/10/29 02:43:01
+ Log: Apply change#2075 from mainline
+ fix C<print $n += 5;> etc.
+ Branch: maint-5.005/perl
+ ! toke.c
+____________________________________________________________________________
+[ 2122] By: gbarr on 1998/10/29 02:40:31
+ Log: Apply change#2070 from mainline
+ avoid bogus line number in XSUB redefined warnings
+ Branch: maint-5.005/perl
+ ! op.c
+____________________________________________________________________________
+[ 2121] By: gbarr on 1998/10/29 02:38:59
+ Log: Apply change#2052 from mainline
+ avoid the circular refcnt logic in magic_mutexfree()
+ Branch: maint-5.005/perl
+ ! mg.c pp.c pp_hot.c
+____________________________________________________________________________
+[ 2120] By: gbarr on 1998/10/29 02:36:23
+ Log: Remove "5.005" hard-coded and expose vtbl_* from the perl DLL
+ From: "Douglas Lankshear" <dougl@ActiveState.com>
+ Date: Mon, 28 Sep 1998 08:49:13 -0700
+ Message-ID: <000001bdeaf7$8a189350$a32fa8c0@tau.Active>
+ Subject: PATCH [5.005_02] update
+ Branch: maint-5.005/perl
+ ! embed.h global.sym objXSUB.h objpp.h perl.h proto.h util.c
+ ! win32/win32.c
+____________________________________________________________________________
+[ 2084] By: gbarr on 1998/10/25 19:09:11
+ Log: Integrate change#2069 from mainline
+ From: Martijn Koster <mak@excitecorp.com>
+ Date: Wed, 21 Oct 1998 13:12:03 +0100
+ Message-ID: <19981021131203.A15661@excitecorp.com>
+ Subject: File::Path::mkpath reports the wrong error
+ Branch: maint-5.005/perl
+ !> lib/File/Path.pm
+____________________________________________________________________________
+[ 2083] By: gbarr on 1998/10/25 18:48:39
+ Log: Integrate change#1965 from mainline
+ use better numbers for exitstatus test
+ Branch: maint-5.005/perl
+ !> t/op/die_exit.t
+____________________________________________________________________________
+[ 2082] By: gbarr on 1998/10/25 18:22:54
+ Log: Apply change 2054 from mainline
+ disallow 'x' in hex numbers (except leading '0x')
+ From: Gisle Aas <gisle@aas.no>
+ Date: 16 Oct 1998 16:33:12 +0200
+ Message-ID: <m3n26wtw47.fsf@furu.g.aas.no>
+ Subject: Re: [PATCH 5.005_52] 'x' is not a legal hex digit
+ Branch: maint-5.005/perl
+ ! perlvars.h util.c
+ !> t/op/oct.t
+____________________________________________________________________________
+[ 2081] By: gbarr on 1998/10/25 17:58:04
+ Log: Apply change #1998 from mainline
+ skip readonly vars and unref references when doing a reset()
+ Branch: maint-5.005/perl
+ ! sv.c
+____________________________________________________________________________
+[ 2080] By: gbarr on 1998/10/25 16:06:35
+ Log: Integrate changes #2072 & #1993 from mainline
+ fix bug in B::CC::pp_sassign()
+ From: "vishal bhatia" <vishalb@hotmail.com>
+ Date: Sun, 11 Oct 1998 18:41:38 PDT
+ Message-ID: <19981012014139.19614.qmail@hotmail.com>
+ Subject: B::CC problems with pp_sassign routine
+ implement C<goto &func> and other fixes (via private mail)
+ From: "vishal bhatia" <vishalb@hotmail.com>
+ Date: Wed, 21 Oct 1998 22:59:03 PDT
+ Message-Id: <19981022055904.20083.qmail@hotmail.com>
+ Subject: [PATCH 5.005_52] More fixes for B
+ Branch: maint-5.005/perl
+ !> ext/B/B.pm ext/B/B.xs ext/B/B/C.pm ext/B/B/CC.pm
+____________________________________________________________________________
+[ 2079] By: gbarr on 1998/10/25 14:08:00
+ Log: integrate from mainline more FSF address changes
+ Branch: maint-5.005/perl
+ !> Copying ext/B/README lib/Getopt/Long.pm
+____________________________________________________________________________
+[ 2053] By: gbarr on 1998/10/25 04:56:47
+ Log: From: Graham Barr <gbarr@pobox.com>
+ Date: Sat, 17 Oct 1998 23:05:18 -0500
+ Message-ID: <19981017230518.K510@pobox.com>
+ Subject: Re: redo LOOP not restoring $` $' $&
+ Branch: maint-5.005/perl
+ ! cop.h t/cmd/while.t
+____________________________________________________________________________
+[ 2048] By: gbarr on 1998/10/24 04:20:10
+ Log: Change Free Software Foundation address in README
+ Branch: maint-5.005/perl
+ !> README
+____________________________________________________________________________
+[ 2047] By: gbarr on 1998/10/24 04:02:20
+ Log: Remove #ifdef DEBUGGING around SvTEMP_off
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Date: Mon, 28 Sep 1998 15:23:39 -0400
+ Message-Id: <199809281923.PAA10303@aatma.engin.umich.edu>
+ Subject: Re: [PATCH] Re: 5.005_52: the miniperl coredump: touch magic and you're toast
+ Branch: maint-5.005/perl
+ ! scope.c
+____________________________________________________________________________
+[ 2046] By: gbarr on 1998/10/24 04:00:54
+ Log: use cpp symbols instead of hardwired constants
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Date: Mon, 05 Oct 1998 09:23:33 +0100
+ Message-Id: <199810050823.JAA00891@crypt.compulink.co.uk>
+ Subject: [PATCH 5.005_52] By the numbers (resend)
+ Branch: maint-5.005/perl
+ ! op.c
+____________________________________________________________________________
+[ 2045] By: gbarr on 1998/10/24 03:50:25
+ Log: squelch undef warnings
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Date: Fri, 02 Oct 1998 11:01:14 +0100
+ Message-Id: <199810021001.LAA19214@crypt.compulink.co.uk>
+ Subject: [PATCH] Re: Apparent bug in Math::BigInt
+ Branch: maint-5.005/perl
+ !> lib/Math/BigInt.pm
+____________________________________________________________________________
+[ 2044] By: gbarr on 1998/10/24 03:47:24
+ Log: Add note to INSTALL about ANSI C
+ Branch: maint-5.005/perl
+ ! INSTALL
+____________________________________________________________________________
+[ 2043] By: gbarr on 1998/10/24 02:38:12
+ Log: make C<goto &sub> AUTOLOAD-aware (autouse now works for modules
+ that are autoloaded)
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Date: Thu, 24 Sep 1998 03:01:01 -0400
+ Message-Id: <199809240701.DAA16223@aatma.engin.umich.edu>
+ Subject: Re: autouse and Getopt::Long don't work together anymore
+ Branch: maint-5.005/perl
+ ! pp_ctl.c t/op/goto.t
+____________________________________________________________________________
+[ 2042] By: gbarr on 1998/10/24 02:16:26
+ Log: From: jarkko.hietaniemi@research.nokia.com (Jarkko Hietaniemi)
+ Date: Wed, 12 Aug 1998 15:42:35 +0300
+ Message-Id: <199808121242.PAA29761@comanche.spices>
+ Subject: [PATCH] 5.004_02 or 5.005_51: fix regexp and tr character ranges in non-ASCII lands
+ Branch: maint-5.005/perl
+ + t/op/tr.t
+ ! MANIFEST perl.h pod/perllocale.pod pod/perlop.pod
+ ! pod/perlre.pod regcomp.c t/pragma/locale.t toke.c
+____________________________________________________________________________
+[ 2021] By: gbarr on 1998/10/20 01:25:23
+ Log: From: Chip Salzenberg <chip@perlsupport.com>
+ Date: Tue, 6 Oct 1998 13:33:05 -0400
+ Message-ID: <19981006133305.A2348@perlsupport.com>
+ Subject: [PATCH] 5.005_02: Eliminate leak on self-ties
+ Branch: maint-5.005/perl
+ ! av.c doop.c hv.c mg.c mg.h pp.c pp_hot.c pp_sys.c scope.c
+ ! t/op/tie.t
+____________________________________________________________________________
+[ 2015] By: gbarr on 1998/10/17 21:49:56
+ Log: make h2xs generate ANSI prototypes
+ Branch: maint-5.005/perl
+ !> utils/h2xs.PL
+____________________________________________________________________________
+[ 2014] By: gbarr on 1998/10/17 20:31:42
+ Log: Fix POSIX::sigprocmask not to check type of $old parameter
+ as it is output only
+ Branch: maint-5.005/perl
+ ! ext/POSIX/POSIX.xs
+____________________________________________________________________________
+[ 2013] By: gbarr on 1998/10/17 17:51:16
+ Log: From: "Kurt D. Starsinic" <kstar@chapin.edu>
+ Date: Thu, 20 Aug 1998 20:59:03 -0400
+ Message-ID: <19980820205903.A12908@O2.chapin.edu>
+ Subject: [PATCH] h2ph misquotes #error directives
+
+ fix h2ph handling of C<#error "foo">
+ From: SAKAI Kiyotaka <ksakai@netwk.ntt-at.co.jp>
+ Date: Thu, 10 Sep 1998 09:59:33 +0900
+ Message-Id: <19980910095933N.ksakai@netwk.ntt-at.co.jp>
+ Subject: [5.005_02] h2ph problem
+ Branch: maint-5.005/perl
+ !> t/lib/h2ph.pht utils/h2ph.PL
+____________________________________________________________________________
+[ 1985] By: gbarr on 1998/10/17 00:41:40
+ Log: s/last/first/ typo in append_list()
+ Branch: maint-5.005/perl
+ ! op.c
+____________________________________________________________________________
+[ 1984] By: gbarr on 1998/10/17 00:36:51
+ Log: From: "Green, Paul" <pgreen@seussnt.stratus.com>
+ Date: Thu, 10 Sep 1998 00:02:07 -0400
+ Message-ID: <646CD0392810D211B04A00A024BF26FB1022EB@terminator.sw.stratus.com>
+ Subject: RE: [PATCH] 5.005_02 and 5.005_51: Stratus VOS port
+ Branch: maint-5.005/perl
+ + README.vos vos/Changes vos/build.cm vos/compile_perl.cm
+ + vos/config.h vos/config_h.SH_orig vos/perl.bind
+ + vos/test_vos_dummies.c vos/vos_dummies.c vos/vosish.h
+ ! MANIFEST perl.c perl.h pod/perlport.pod
+____________________________________________________________________________
+[ 1983] By: gbarr on 1998/10/17 00:23:31
+ Log: define PUT_svindex(), PUT_opindex()
+ Branch: maint-5.005/perl
+ !> ext/B/B/Assembler.pm
+____________________________________________________________________________
+[ 1982] By: gbarr on 1998/10/17 00:20:57
+ Log: From: Jochen Wiedmann <joe@ispsoft.de>
+ Date: Thu, 17 Sep 1998 17:16:06 +0200
+ Message-ID: <360127B6.E44564A@ispsoft.de>
+ Subject: [PATCH] ExtUtils::MakeMaker::prompt cannot return 0
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/MakeMaker.pm
+____________________________________________________________________________
+[ 1981] By: gbarr on 1998/10/16 02:58:10
+ Log: better CR-handling on shebang line and in formats (fixed variant of
+ patch suggested by Igor Sysoev <igor@nitek.ru>)
+ Branch: maint-5.005/perl
+ ! perl.c toke.c
+____________________________________________________________________________
+[ 1980] By: gbarr on 1998/10/16 02:21:57
+ Log: From: Roderick Schertler <roderick@argon.org>
+ Date: 11 Sep 1998 16:19:21 -0400
+ Message-ID: <pzyarqpfli.fsf@eeyore.ibcinc.com>
+ Subject: Re: Open2 and memory leaks
+ Branch: maint-5.005/perl
+ !> lib/IPC/Open3.pm
+____________________________________________________________________________
+[ 1979] By: gbarr on 1998/10/16 02:15:54
+ Log: integrate change #1908 from mainline
+ Branch: maint-5.005/perl
+ !> lib/File/Find.pm
+____________________________________________________________________________
+[ 1977] By: gbarr on 1998/10/16 01:52:46
+ Log: tests missing from change #1794
+ Branch: maint-5.005/perl
+ ! t/op/re_tests
+____________________________________________________________________________
+[ 1794] By: gbarr on 1998/09/20 15:59:20
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Tue, 11 Aug 1998 18:43:29 -0400 (EDT)
+ Message-Id: <199808112243.SAA14243@monk.mps.ohio-state.edu>
+ Subject: Re: Segmentation fault for /a*abc?xyz+pqr{3}ab{2,}xy{4,5}pq{0,6}AB{0,}zz/
+ Branch: maint-5.005/perl
+ ! regcomp.c t/op/re_tests
+____________________________________________________________________________
+[ 1793] By: gbarr on 1998/09/20 15:39:41
+ Log: From: Peter Prymmer <pvhp@forte.com>
+ Date: Mon, 10 Aug 98 16:58:22 PDT
+ Message-Id: <9808102358.AA10616@forte.com>
+ Subject: fix for unpack('u') failures on OS/390
+ Branch: maint-5.005/perl
+ ! pp.c
+____________________________________________________________________________
+[ 1792] By: gbarr on 1998/09/20 15:11:33
+ Log: From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Date: Sun, 9 Aug 1998 15:51:48 +0100
+ Message-Id: <E0z5Wp2-00071p-00@taurus.cus.cam.ac.uk>
+ Subject: Fix typo, change "an array" to "a hash"
+ Branch: maint-5.005/perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 1791] By: gbarr on 1998/09/20 14:49:26
+ Log: From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Date: Wed, 16 Sep 1998 22:13:17 -0400
+ Message-Id: <199809170213.WAA10546@aatma.engin.umich.edu>
+ Subject: fill gaps in sig_* entries in win32/config.?c
+ and resync win32/config.?c with Porting/config.sh to pick up apiversion
+ Branch: maint-5.005/perl
+ ! win32/config.bc win32/config.gc win32/config.vc
+____________________________________________________________________________
+[ 1790] By: gbarr on 1998/09/20 14:40:56
+ Log: From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Date: Sun, 06 Sep 1998 15:35:11 -0400
+ Message-Id: <199809061935.PAA21531@aatma.engin.umich.edu>
+ Subject: suppress bogus warning on C<sub x {} x()>
+ Branch: maint-5.005/perl
+ ! toke.c
+____________________________________________________________________________
+[ 1784] By: nick on 1998/09/12 09:53:36
+ Log: Two tweaks to allow quiet compile qith egcs-1.1
+ Branch: maint-5.005/perl
+ ! win32/win32.h
+____________________________________________________________________________
+[ 1783] By: gbarr on 1998/09/07 20:33:11
+ Log: Subject: index() applied BM optimization to wrong argument
+ From: larry@wall.org (Larry Wall)
+ Date: Thu, 3 Sep 1998 12:49:13 -0700
+ Message-Id: <199809031949.MAA29566@wall.org>, <199809060004.RAA23792@wall.org>
+ Branch: maint-5.005/perl
+ ! op.c util.c
+____________________________________________________________________________
+[ 1782] By: gbarr on 1998/09/07 18:54:49
+ Log: From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Date: Fri, 28 Aug 1998 00:33:15 -0400
+ Mssage-Id: <199808280433.AAA06767@aatma.engin.umich.edu>
+ Subject: socket problems on NT
+ Branch: maint-5.005/perl
+ ! objXSUB.h
+____________________________________________________________________________
+[ 1759] By: gsar on 1998/08/08 20:57:47
+ Log: pending submit of 5.005_02
+ Branch: maint-5.005/perl
+ ! Changes
----------------
-Version 5.004_02 Maintenance release 2 for 5.004
+Version 5.005_02 Second maintenance release of 5.005
----------------
-"When you work you are a flute through whose
- heart the whispering of the hours turns to music."
- -- from The Prophet by Kahlil Gibran
-
-
- HEADLINES FOR THIS MAINTENANCE RELEASE
-
- Major memory growth bug fixed.
- Object destruction is more timely and orderly.
- Further major enhancements to Win32 support, including:
- Win32 binary compatibility between Visual C++ and Borland C++.
- The -S option is now more useful on dos/Win32 (see perlrun).
- Implicit -p print now checks for write errors.
- DB_File now sub-classable (and other fixes).
- Memory usage stats available with perl's malloc (see perldelta).
- 'use UNIVERSAL;' deprecated (see perldelta).
- Internal integer to string conversions are faster.
- Carp can be forced to give stack traces (see perldoc Carp).
- Many other bug fixes and enhancements.
-
-
- ------ BUILD PROCESS ------
-
- Title: "[PATCH] m2t3: Configure: cf_time always in C locale"
- From: Jarkko Hietaniemi <jhi@iki.fi>
- Msg-ID: <199708061827.VAA09623@alpha.hut.fi>
- Files: Configure
-
- Title: "Configure can't find open3 on NeXTstep"
- From: Andy Dougherty <doughera@newton.phys.lafayette.edu>, hans@icgned.nl
- (Hans Mulder)
- Msg-ID: <9706271816.AA10551@ icgned.icgned.nl >
- Files: Configure
-
- Title: "Don't use undef value in Config::myconfig"
- From: "Andreas J. Koenig" <k@sissy.in-berlin.de>, Chip Salzenberg
- <salzench@nielsenmedia.com>
- Msg-ID: <199706271525.RAA13517@sissy.in-berlin.de>
- Files: configpm
-
- Title: "make Configure recognize powerux hint (perl5.004_01)"
- From: tom@amber.ssd.hcsc.com (Tom Horsley)
- Msg-ID: <9707301938.AA08352@amber.ssd.hcsc.com>
- Files: Configure
-
- Title: "[PATCH]: HP-UX 10 w/o transition links"
- From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com>
- Msg-ID: <199706181851.AA093329906@hpcc123.corp.hp.com>,
- <199706231650.AA070364627@hpcc123.corp.hp.com>
- Files: Configure
-
- Title: "INSTALL updates for GNU ld and __inet_* errors"
- From: Andy Dougherty <doughera@newton.phys.lafayette.edu>
- Files: INSTALL
-
- ------ CORE LANGUAGE ------
-
- Title: "[PATCH] Additional patch for "Can't execute ...""
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199707191651.MAA04897@monk.mps.ohio-state.edu>
- Files: pod/perldiag.pod perl.c
-
- Title: "[PATCH] Band-aid fix for local([@%]$x)"
- From: Stephen McCamant <alias@mcs.com>
- Msg-ID: <m0wsb7J-000EYPC@alias-2.pr.mcs.net>
- Files: pod/perldiag.pod op.c pp_hot.c t/op/local.t
-
- Title: "[PATCH] Re: Bug in Regular Expressions when using colon as
- delimiter"
- From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
- Msg-ID: <E0wtbhv-0005Mm-00@ursa.cus.cam.ac.uk>
- Files: pod/perldiag.pod regcomp.c t/op/re_tests t/op/regexp.t
-
- Title: "[PATCH] Re: Can't pack literals as pointers"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199708012250.SAA20278@aatma.engin.umich.edu>
- Files: pod/perldiag.pod pod/perlfunc.pod pp.c t/op/pack.t
-
- Title: "[PATCH] Do not constant-fold ops that depend on locale if C<use
- locale>"
- From: Chip Salzenberg <salzench@nielsenmedia.com>
- Msg-ID: <199707210519.BAA13785@nielsenmedia.com>
- Files: op.c
-
- Title: "Eval fails in certain situations (eval "{'...")"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199707211753.NAA14940@aatma.engin.umich.edu>
- Files: t/comp/term.t toke.c
-
- Title: "Fix memory leak on eval 'sub {}'"
- From: Chip Salzenberg <chip@rio.atlantic.net>
- Files: pp_ctl.c
-
- Title: "stringify looses integerness"
- From: Gisle Aas <aas@bergen.sn.no>
- Msg-ID: <hbu4l96z2.fsf@bergen.sn.no>
- Files: sv.c
-
- Title: "Fix intolerance of a space between "print" and opening paren"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199707011421.KAA15836@aatma.engin.umich.edu>
- Files: toke.c
-
- Title: "[PATCH] Re: Calling Perl from within C from within Perl"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199706301842.OAA05569@aatma.engin.umich.edu>
- Files: perl.c
-
- Title: "UNIVERSAL.pm and import methods (tests)"
- From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
- Msg-ID: <E0whfHh-0007bW-00@ursa.cus.cam.ac.uk>
- Files: t/op/universal.t universal.c
-
- Title: "Avoid core dump on some paren'd regexp matches", "One-liner regex
- causes SEGV on 5.003 under HP-UX and Linux"
- From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
- Msg-ID: <199706261236.NAA03472@crypt.compulink.co.uk>,
- <199707061144.MAA04443@crypt.compulink.co.uk>
- Files: regexec.c t/op/re_tests
-
- Title: "Forbid negative splice offset beyond array start"
- From: "John L. Allen" <allen@gateway.grumman.com>, Chip Salzenberg
- <chip@rio.atlantic.net>
- Msg-ID: <Pine.SOL.3.91.970625111744.19300A-100000@gateway>
- Files: pp.c
-
- Title: "Forbid "goto" into middle of foreach loop"
- From: Chip Salzenberg <chip@rio.atlantic.net>
- Files: pod/perldiag.pod pp_ctl.c
-
- Title: "Fix C<qq #hi#>"
- From: Chip Salzenberg <chip@rio.atlantic.net>
- Files: toke.c
-
- Title: "bless file handles as FileHandle if loaded else IO::Handle"
- From: Gisle Aas <aas@bergen.sn.no>
- Msg-ID: <hyb80drrz.fsf@bergen.sn.no>
- Files: gv.c lib/FileHandle.pm
-
- Title: "infinite recursion in malloc() with some compile flags"
- From: Hans Mulder <hansmu@xs4all.nl>
- Msg-ID: <199706240050.CAA10550@xs2.xs4all.nl>
- Files: malloc.c
-
- Title: "sv_vcatpvfn hogs memory [Patch included]"
- From: Matthias Neeracher <neeri@iis.ee.ethz.ch>
- Msg-ID: <199706211521.RAA12778@solar.ethz.ch>
- Files: sv.c
-
- Title: "Fix '-' flag on sprintf() of floats"
- From: Chip Salzenberg <chip@rio.atlantic.net>, Jarkko Hietaniemi
- <jhi@iki.fi>
- Msg-ID: <199705270646.JAA02510@alpha.hut.fi>
- Files: sv.c
-
- Title: "Free temps before calling END blocks", "Too late destruction"
- From: Chip Salzenberg <chip@rio.atlantic.net>
- Msg-ID: <m33erfv5hx.fsf@chany-p100.emwp.com>
- Files: perl.c
-
- Title: "Fix C<print $foo x 2> parsing"
- From: "Chuck D. Phillips (NON-HP Employee)" <cdp@hpescdp.fc.hp.com>, Chip
- Salzenberg <chip@rio.atlantic.net>
- Msg-ID: <199706121737.KAA00503@palrel3.hp.com>
- Files: toke.c
-
- Title: "Fix lockf_emulate_flock() positioning"
- From: Chip Salzenberg <chip@rio.atlantic.net>, gen@atd.rdc.ricoh.co.jp
- Msg-ID: <199706091132.UAA00895@wampa.atd.rdc.ricoh.co.jp>
- Files: pp_sys.c
-
- Title: "Don't use atol() for unsigned values", "signedness problem in
- pack("N", "value");"
- From: Chip Salzenberg <chip@rio.atlantic.net>, Roger Espel Llima
- <espel@llaic.univ-bpclermont.fr>
- Msg-ID: <19970531200007.40218@llaic.univ-bpclermont.fr>
- Files: sv.c
-
- Title: "Don't warn about "${foo}" in string, even if &foo exists"
- From: Chip Salzenberg <chip@rio.atlantic.net>
- Files: toke.c
-
- Title: "[PATCH] -p does not check for failure of implicit print"
- From: Dominic Dunlop <domo@slipper.ip.lu>
- Msg-ID: <v0311070aafea3fa83061@[194.51.248.75]>
- Files: pod/perldiag.pod pod/perlrun.pod toke.c
-
- Title: "Fix double form() in XS version check"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199707150010.UAA00816@monk.mps.ohio-state.edu>
- Files: XSUB.h
-
- Title: "Constant-fold sprintf()"
- From: Chip Salzenberg <salzench@nielsenmedia.com>
- Files: opcode.pl
-
- Title: "[PATCH] Fix double form() in XS version check"
- From: Chip Salzenberg <salzench@nielsenmedia.com>
- Msg-ID: <199707210518.BAA13771@nielsenmedia.com>
- Files: XSUB.h
-
- Title: "[PATCH] Make DEBUGGING_MSTATS info consistent"
- From: Andy Dougherty <doughera@newton.phys.lafayette.edu>
- Msg-ID: <Pine.SUN.3.96.970731131529.3740A-100000@newton.phys>
- Files: INSTALL pod/perldelta.pod perl.h
-
- Title: "Minor Win32 glitch with -S flag"
- From: Warren Jones <wjones@tc.fluke.com>
- Msg-ID: <97Jun19.150511pdt.35717-2@gateway.fluke.com>
- Files: perl.c
-
- Title: "Slightly safer signals"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Files: mg.c perl.c
-
- Title: "Time::Local patch (plus perl.c and filehand.t)"
- From: ilya@math.ohio-state.edu (Ilya Zakharevich)
- Files: lib/Time/Local.pm perl.c t/lib/filehand.t
-
- Title: "[PATCH] Weirdness in sv_peek()"
- From: Stephen McCamant <alias@mcs.com>
- Msg-ID: <m0wsEMU-000EYLC@alias-2.pr.mcs.net>,
- <m0wsf7Y-000EYPC@alias-2.pr.mcs.net>
- Files: sv.c
-
- Title: "Win32 UNC path causes autoload to fail"
- From: Warren Jones <wjones@tc.fluke.com>
- Msg-ID: <97Jun18.163826pdt.35714-1@gateway.fluke.com>
- Files: pp_ctl.c
-
- Title: "[PATCH]: reduced malloc patch"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199707150829.EAA01291@monk.mps.ohio-state.edu>
- Files: av.c
-
- Title: "[PATCH] $\1 and serious bug in evalling"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199707262127.RAA12883@monk.mps.ohio-state.edu>
- Files: pp_ctl.c
-
- Title: "Faster int to string conversion", "[PATCH} Re: memory leak in buffer
- safety code"
- From: Chip Salzenberg <chip@rio.atlantic.net>, Hugo van der Sanden
- <hv@crypt.compulink.co.uk>, Tim Bunce <Tim.Bunce@ig.co.uk>
- Msg-ID: <199707140912.KAA09935@crypt.compulink.co.uk>,
- <199707142050.QAA20976@rio.atlantic.net>,
- <199707182035.VAA20990@crypt.compulink.co.uk>,
- <9707151040.AA02883@toad.ig.co.uk>
- Files: global.sym sv.c
-
- Title: "object never destructs"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199707131955.PAA29655@aatma.engin.umich.edu>
- Files: scope.c t/op/ref.t
-
- Title: "[PATCH] -S flag fixes for DOSISH platforms", "[RESEND] [PATCH] -S
- flag fixes for DOSISH platforms"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199707250043.UAA02385@aatma.engin.umich.edu>,
- <199707301828.OAA19508@aatma.engin.umich.edu>
- Files: pod/perldiag.pod pod/perlrun.pod perl.c
-
- Title: "Perldb internal flag rehaul"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Files: pod/perldebug.pod pod/perlvar.pod perl.h gv.c mg.c op.c perl.c
- pp_ctl.c pp_hot.c pp_sys.c sv.c toke.c
-
- Title: "[PATCH] Re: q and escaping paired delimiters"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>, Kenneth Albanowski
- <kjahds@kjahds.com>
- Msg-ID: <199707280516.BAA14055@aatma.engin.umich.edu>,
- <Pine.LNX.3.93.970727172201.350K-100000@kjahds.com>,
- <Pine.LNX.3.93.970728013540.350U-100000@kjahds.com>
- Files: t/base/lex.t toke.c
-
- Title: "Enable PERL_DEBUG_MSTATS without -DDEBUGGING_MSTATS"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199707150829.EAA01291@monk.mps.ohio-state.edu>
- Files: malloc.c perl.c
-
- Title: "semctl broken under Linux"
- From: Andreas Schwab <schwab@LS5.informatik.uni-dortmund.de>, Andreas
- Schwab <schwab@issan.informatik.uni-dortmund.de>, Graham
- Barr <gbarr@ti.com>, Tim Bunce <Tim.Bunce@ig.co.uk>
- Msg-ID: <33C38291.2D9302DA@ti.com>,
- <9707040912.AA03470@issan.informatik.uni-dortmund.de>,
- <9707041538.AA08946@toad.ig.co.uk>,
- <9707070924.AA11774@issan.informatik.uni-dortmund.de>,
- <9707090933.AA19012@issan.informatik.uni-dortmund.de>
- Files: doio.c
-
- Title: "[PATCH] m2t2: problem in NetBSD 1.2D with sfio"
- From: Jarkko Hietaniemi <jhi@iki.fi>
- Files: perl.h
-
- Title: "fix substr fix (tests 27 etc)", "perl5.004_02 trial 1 available
- (with substr bug and still some"
- From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Hugo van der Sanden
- <hv@crypt.compulink.co.uk>, Jarkko Hietaniemi <jhi@iki.fi>
- Msg-ID: <199707301759.SAA02899@crypt.compulink.co.uk>,
- <199707302228.BAA18032@alpha.hut.fi>,
- <199707310929.KAA06515@crypt.compulink.co.uk>,
- <E0wtruH-0002JM-00@ursa.cus.cam.ac.uk>
- Files: pp.c
-
- Title: "Fwd: substr("foo", -1000)", "substr: warn if substring doesn't
- intersect original at all"
- From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Jarkko Hietaniemi <jhi@iki.fi>
- Msg-ID: <199707100655.JAA14924@alpha.hut.fi>,
- <E0wm1JG-0000UY-00@taurus.cus.cam.ac.uk>
- Files: pod/perlfunc.pod pp.c t/op/substr.t
-
- Title: "[PATCH] work around compiler bug on CX/UX (perl5.004_01)"
- From: tom@amber.ssd.hcsc.com (Tom Horsley)
- Msg-ID: <9707301934.AA18594@amber.ssd.hcsc.com>
- Files: hints/cxux.sh pp.c
-
- ------ DOCUMENTATION ------
-
- Title: "Duplicates in perlguts.pod"
- From: hans@icgned.nl (Hans Mulder)
- Msg-ID: <9707082346.AA13231@ icgned.icgned.nl >
- Files: pod/perlguts.pod
-
- Title: "Better "Can't locate auto/%s.al in @INC" error documentation"
- From: ilya@math.ohio-state.edu (Ilya Zakharevich)
- Msg-ID: <1997Jun24.195847.2091744@hmivax.humgen.upenn.edu>
- Files: pod/perldiag.pod
-
- Title: "new perlembed.pod:match.c"
- From: Doug MacEachern <dougm@opengroup.org>
- Msg-ID: <199707170355.XAA21370@postman.opengroup.org>
- Files: pod/perlembed.pod
-
- Title: "Document bug fix in localization of $1 etc."
- From: Chip Salzenberg <salzench@nielsenmedia.com>
- Files: pod/perldelta.pod
-
- Title: "[PATCH] Major goof in XS Tutorial regarding subdirs"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199707260920.FAA12453@monk.mps.ohio-state.edu>
- Files: pod/perlxstut.pod
-
- Title: "[PATCH] Magic info in perlguts, take 2"
- From: Stephen McCamant <alias@mcs.com>
- Msg-ID: <m0wr6P8-000EYLC@alias-2.pr.mcs.net>
- Files: pod/perlguts.pod
-
- Title: "[BUG:PATCH] Missing semicolon message wrong in perldiag"
- From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
- Msg-ID: <E0welEn-0002vT-00@taurus.cus.cam.ac.uk>,
- <E0wfRJU-0006Aw-00@taurus.cus.cam.ac.uk>
- Files: pod/perldiag.pod
-
- Title: "[PATCH] Updates to perlguts (repost)"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199707152223.SAA00776@monk.mps.ohio-state.edu>
- Files: pod/perlguts.pod
-
- Title: "[BUG:47:LOG] Dropped "and" in pod2man"
- From: hans@icgned.nl (Hans Mulder)
- Msg-ID: <9707082355.AA13254@ icgned.icgned.nl >
- Files: pod/pod2man.PL
-
- Title: "[BUG] perlembed.pod:power.c example"
- From: Doug MacEachern <dougm@opengroup.org>
- Msg-ID: <199707181344.JAA10565@postman.opengroup.org>
- Files: pod/perlembed.pod
-
- Title: "[PATCH] arguments swapped in perlapio.pod"
- From: Hans Mulder <hansmu@xs4all.nl>
- Msg-ID: <199706240049.CAA10534@xs2.xs4all.nl>
- Files: pod/perlapio.pod
-
- Title: "[PATCH] cool quote for perldebug"
- From: Greg Bacon <gbacon@adtrn-srv4.adtran.com>
- Msg-ID: <199707292140.QAA28579@adtrn-srv4.adtran.com>
- Files: pod/perldebug.pod
-
- Title: "[PATCH] multiline commands in qx//"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199707212350.TAA18496@aatma.engin.umich.edu>
- Files: pod/perlfunc.pod pod/perlop.pod
-
- Title: "patch to 5.004_01 perltrap.pod"
- From: jmm@revenge.elegant.com (John Macdonald)
- Msg-ID: <9706231525.AA22790@revenge.elegant.com>
- Files: pod/perltrap.pod
-
- Title: "perl4 to perl5.004 converion with debugger problem"
- From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
- Msg-ID: <E0wdKJY-00010w-00@taurus.cus.cam.ac.uk>
- Files: pod/perltrap.pod
-
- Title: "done3/perlbook.pod"
- From: Randal Schwartz <merlyn@gadget.cscaper.com>
- Files: pod/perlbook.pod
-
- Title: "[PATCH] readline and readpipe are undocumented"
- From: Hans Mulder <hansmu@xs4all.nl>
- Files: pod/perlfunc.pod
-
- Title: "Document use of - in a regex char class."
- From: Dominic Dunlop <domo@slipper.ip.lu>
- Msg-ID: <v03102804afd578bcef2c@[194.51.248.88]>
- Files: pod/perlre.pod
-
- Title: "[PATCH] splitpod broken in 5.004_01"
- From: Hans Mulder <hansmu@xs4all.nl>, Tim Bunce <Tim.Bunce@ig.co.uk>
- Msg-ID: <199706240048.CAA10515@xs2.xs4all.nl>,
- <9706241612.AA09119@toad.ig.co.uk>
- Files: pod/splitpod
-
- ------ LIBRARY AND EXTENSIONS ------
-
- Title: "Carp::cluck() and -MCarp=verbose"
- From: Tim.Bunce@ig.co.uk, epeschko@elmer.tci.com (Ed Peschko)
- Msg-ID: <199708060607.AAA16681@den-mdev1.tci.com>,
- <199708062105.PAA09878@den-mdev1.tci.com>
- Files: lib/Carp.pm
-
- Title: "Warning from calls using "use Shell""
- From: Andrew Pimlott <pimlott@abel.math.harvard.edu>
- Msg-ID: <Pine.SOL.3.91.970806173903.7320H-100000@abel>
- Files: lib/Shell.pm
-
- Title: "confessing a carp"
- From: Chip Salzenberg <chip@rio.atlantic.net>, Hugo van der Sanden
- <hv@crypt.compulink.co.uk>, Nick Ing-Simmons
- <nick@ni-s.u-net.com>, Tim Bunce <Tim.Bunce@ig.co.uk>
- Msg-ID: <199708052155.WAA25393@crypt.compulink.co.uk>,
- <199708060721.IAA30894@crypt.compulink.co.uk>,
- <199708061533.LAA01313@rio.atlantic.net>,
- <33E79BE2.4E6F@ni-s.u-net.com>,
- <33E8E3C5.62C@ni-s.u-net.com>,
- <9708051619.AA13764@toad.ig.co.uk>
- Files: lib/Carp.pm
-
- Title: "[BUG:PATCH] dumpvar.pl parses some references incorrectly"
- From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
- Msg-ID: <E0wwAjQ-0004l6-00@ursa.cus.cam.ac.uk>
- Files: lib/dumpvar.pl
-
- Title: "[PATCH] m2t3: minor doc patch (to obsolete I18N::Collate)"
- From: Jarkko Hietaniemi <jhi@iki.fi>
- Msg-ID: <199708060732.KAA02675@alpha.hut.fi>
- Files: lib/I18N/Collate.pm
-
- Title: "[PATCH] Binary installers for Perl modules"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199707210006.UAA06165@monk.mps.ohio-state.edu>
- Files: lib/ExtUtils/Install.pm
-
- Title: "m2t2 broke CPAN.pm :-("
- From: a.koenig@kulturbox.de (Andreas J. Koenig)
- Files: lib/CPAN.pm lib/Bundle/CPAN.pm lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm
-
- Title: "[PATCH] CPAN.pm on OS/2"
- From: "Andreas J. Koenig" <k@anna.in-berlin.de>, Ilya Zakharevich
- <ilya@math.ohio-state.edu>
- Msg-ID: <199707180415.AAA03180@monk.mps.ohio-state.edu>,
- <199707181407.QAA12920@anna.in-berlin.de>
- Files: lib/CPAN.pm
-
- Title: "Docs of IO::Handle [PATCH]"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199707222307.TAA08380@monk.mps.ohio-state.edu>
- Files: ext/IO/lib/IO/Handle.pm
-
- Title: "Exporter errors give wrong location"
- From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
- Msg-ID: <E0wdJra-0000n8-00@taurus.cus.cam.ac.uk>
- Files: lib/Exporter.pm
-
- Title: "[PATCH] Exporter new export_to_level method"
- From: epeschko@elmer.tci.com (Ed Peschko)
- Files: lib/Exporter.pm
-
- Title: "DB_File produces spurious output when trapping __DIE__"
- From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
- Msg-ID: <9706302125.AA28254@claudius.bfsec.bt.co.uk>
- Files: ext/DB_File/DB_File.pm
-
- Title: "Remove 'use UNIVERSAL;', switch to UNIVERSAL::isa()"
- From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
- Msg-ID: <E0whaZJ-0007BA-00@ursa.cus.cam.ac.uk>
- Files: lib/Class/Struct.pm lib/File/Compare.pm lib/File/Copy.pm
-
- Title: "perl5.004 Time::Local still broken"
- From: Mathias Koerber <mathias@dnssec1.singnet.com.sg>
- Msg-ID: <199706260452.MAA22647@dnssec1.singnet.com.sg>
- Files: lib/Time/Local.pm
-
- Title: "Sys::Hostname should localize $SIG{__DIE__}"
- From: Ken Shan <ken@digitas.harvard.edu>
- Msg-ID: <199707070357.XAA18065@digitas.harvard.edu>
- Files: lib/Sys/Hostname.pm
-
- Title: "xsubpp patch"
- From: John Tobey <jtobey@user1.channel1.com>
- Msg-ID: <199707010221.CAA01234@remote133>
- Files: lib/ExtUtils/xsubpp
-
- Title: "DB_File 1.15 patch"
- From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
- Msg-ID: <9707192117.AA01973@claudius.bfsec.bt.co.uk>
- Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs ext/DB_File/typemap
- t/lib/db-btree.t t/lib/db-hash.t t/lib/db-recno.t
-
- Title: "Problems with setvbuf"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199707250040.UAA11000@monk.mps.ohio-state.edu>
- Files: ext/IO/IO.xs
-
- Title: "[PATCH] Repost of fork() debugger patch"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199707252101.RAA11846@monk.mps.ohio-state.edu>
- Files: lib/perl5db.pl lib/Term/ReadLine.pm
-
- Title: "IO::File and DB_File pollutes namespace with Fcntl constants"
- From: Gisle Aas <aas@bergen.sn.no>
- Msg-ID: <h205qyijy.fsf@bergen.sn.no>
- Files: ext/IO/lib/IO/File.pm
-
- Title: "[MM] [PATCH] Re: Liblist problems for MSWin32"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199706182152.RAA20273@aatma.engin.umich.edu>
- Files: lib/ExtUtils/Liblist.pm
-
- Title: "Net::hostent documentation error"
- From: gnat@frii.com
- Msg-ID: <199707082222.QAA24728@elara.frii.com>
- Files: lib/Net/hostent.pm
-
- Title: "PATCH: make DBM*_File modules sub-classable"
- From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
- Msg-ID: <9707121854.AA19472@claudius.bfsec.bt.co.uk>
- Files: ext/GDBM_File/typemap ext/NDBM_File/typemap
- ext/ODBM_File/ODBM_File.xs ext/SDBM_File/typemap
- t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t t/lib/sdbm.t
-
- Title: "Sys::Syslog patch to allow unix domain sockets"
- From: Sean Robinson <robinson_s@sc.maricopa.edu>
- Msg-ID: <33B31342.7EB16A44@sc.maricopa.edu>
- Files: lib/Sys/Syslog.pm
-
- Title: "'use UNIVERSAL;' deprecated, do C<UNIVERSAL::isa()> instead",
- "UNIVERSAL.pm and import methods"
- From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Gisle Aas <aas@bergen.sn.no>,
- Graham Barr <gbarr@ti.com>, Gurusamy Sarathy
- <gsar@engin.umich.edu>, Hugo van der Sanden
- <hv@crypt.compulink.co.uk>
- Msg-ID: <199706271701.NAA25664@aatma.engin.umich.edu>,
- <199706271904.UAA00120@crypt.compulink.co.uk>,
- <199706272054.QAA28913@aatma.engin.umich.edu>,
- <199706301554.LAA03763@aatma.engin.umich.edu>,
- <33B22248.7D7C1985@ti.com>,
- <E0wf5TN-0006ps-00@taurus.cus.cam.ac.uk>,
- <E0wguTR-0005bs-00@ursa.cus.cam.ac.uk>,
- <E0whaZJ-0007BA-00@ursa.cus.cam.ac.uk>,
- <E0whfHh-0007bW-00@ursa.cus.cam.ac.uk>,
- <E0wiyUG-00073j-00@taurus.cus.cam.ac.uk>,
- <hiuyv6q9k.fsf@bergen.sn.no>
- Files: lib/Class/Struct.pm lib/File/Compare.pm lib/File/Copy.pm
- t/op/universal.t universal.c
-
- Title: "[MM] Small patch to MakeMaker, new release"
- From: "Andreas J. Koenig" <k@anna.in-berlin.de>
- Msg-ID: <199706281603.SAA10869@anna.in-berlin.de>
- Files: lib/ExtUtils/Command.pm lib/ExtUtils/Install.pm
- lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Unix.pm
- lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm
-
- Title: "ExtUtils-Embed upgrade"
- From: Doug MacEachern <dougm@opengroup.org>
- Files: lib/ExtUtils/Embed.pm
-
- Title: "[PATCH] icmp tweak for IO::Socket"
- From: Nick.Ing-Simmons@tiuk.ti.com
- Msg-ID: <199707041240.NAA21484@pluto.tiuk.ti.com>
- Files: ext/IO/lib/IO/Socket.pm
-
- Title: "Allow concurrent mkdir in File::Path::mkpath"
- From: schattev@imb-jena.de (Ruben Schattevoy)
- Msg-ID: <199707300943.LAA21574@kant.imb-jena.de>
- Files: lib/File/Path.pm
-
- Title: "CPAN.pm, $VERSION and nested (bundled) modules."
- From: a.koenig@kulturbox.de (Andreas J. Koenig)
- Files: lib/ExtUtils/Install.pm lib/ExtUtils/Liblist.pm
- lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm
- lib/ExtUtils/Mksymlists.pm
-
- Title: "[PATCH] perl debugger, win32, and emacs"
- From: Jay Rogers <jay@rgrs.com>
- Msg-ID: <199707311759.NAA13276@crooked-i.mitre.org>
- Files: lib/perl5db.pl
-
- Title: "[PATCH] pod2html mangles C<&foo(42);>"
- From: Hans Mulder <hansmu@xs4all.nl>
- Msg-ID: <199706250057.CAA10162@xs1.xs4all.nl>
- Files: lib/Pod/Html.pm
-
- Title: "[PATCH] posix.xs broken on VMS 7.1"
- From: Dan Sugalski <sugalsd@lbcc.cc.or.us>
- Msg-ID: <3.0.2.32.19970718095755.00875ba0@stargate.lbcc.cc.or.us>
- Files: ext/POSIX/POSIX.xs
-
- Title: "MM_Unix.pm nits for Win32 DMAKE"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199708032051.QAA14248@aatma.engin.umich.edu>
- Files: lib/ExtUtils/MM_Unix.pm
-
- Title: "Sys::Hostname -w unclean in trial 2"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199708032055.QAA14278@aatma.engin.umich.edu>
- Files: lib/Sys/Hostname.pm
-
- Title: "(3) File::Find::find()/finddepth() bugs with toplevel paths"
- From: "Conrad E. Kimball" <cek@tblv021.ca.boeing.com>
- Msg-ID: <199707040045.RAA24459@mailgate2.boeing.com>
- Files: lib/File/Find.pm
-
- ------ OTHER CHANGES ------
-
- Title: "EMERGENCY_SBRK or PERL_EMERGENCY_SBRK ?"
- From: Andy Dougherty <doughera@newton.phys.lafayette.edu>,
- ilya@math.ohio-state.edu (Ilya Zakharevich)
- Msg-ID: <1997Aug1.191631.2167470@hmivax.humgen.upenn.edu>,
- <Pine.SUN.3.96.970801134400.4393F-100000@newton.phys>
- Files:
- Files:
-
- ------ PORTABILITY - WIN32 ------
-
- Title: "[PATCH] Embedding threaded apps in perl.dll"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199707261518.LAA24346@aatma.engin.umich.edu>,
- <199707301833.OAA19570@aatma.engin.umich.edu>
- Files: win32/win32.c
-
- Title: "Minor fix for pl2bat.bat", "[PATCH] Re: Minor fix for pl2bat.bat"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>, Warren Jones
- <wjones@tc.fluke.com>
- Msg-ID: <199707061843.OAA23874@aatma.engin.umich.edu>,
- <97Jun24.115804pdt.35752-2@gateway.fluke.com>
- Files: win32/bin/pl2bat.bat
-
- Title: "WIN32 Build - pod2xxx.bat Missing?", "[PATCH] Re: WIN32 Build -
- pod2xxx.bat Missing?"
- From: Chris Williams <chrisw@netinfo.com.au>, Gurusamy Sarathy
- <gsar@engin.umich.edu>
- Msg-ID: <199707011423.KAA15855@aatma.engin.umich.edu>,
- <33B8B962.D96FA1F5@netinfo.com.au>
- Files: win32/Makefile win32/makefile.mk
-
- Title: "[PATCH] Win32 sitelib intuition from DLL location"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199706231647.MAA23260@aatma.engin.umich.edu>
- Files: win32/win32.h win32/config_h.PL win32/win32.c
-
- Title: "[PATCH] binary coexistence on win32", "[RESEND] [PATCH] binary
- coexistence on win32"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199707250109.VAA02666@aatma.engin.umich.edu>,
- <199707301829.OAA19516@aatma.engin.umich.edu>
- Files: lib/ExtUtils/Mksymlists.pm win32/win32.h win32/win32io.h
- win32/win32iop.h win32/makedef.pl win32/win32.c
- win32/win32io.c
-
- Title: "[PATCH] docs for win32 utilities"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199707250045.UAA02510@aatma.engin.umich.edu>
- Files: win32/bin/pl2bat.bat win32/bin/runperl.bat
-
- Title: "[PATCH] exec() fixed on win32"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199706241525.LAA06554@aatma.engin.umich.edu>
- Files: win32/win32.h win32/win32io.h win32/win32iop.h README.win32 doio.c
- win32/config_H.bc win32/config_H.vc win32/makedef.pl
- win32/win32.c win32/win32io.c
-
- Title: "[PATCH] getenv() after my_setenv() gets old entry on Win32"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199706231700.NAA23400@aatma.engin.umich.edu>
- Files: win32/win32.h win32/win32.c
-
- Title: "[PATCH] getservby*() calls fail on Windows NT"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199706231654.MAA23276@aatma.engin.umich.edu>
- Files: win32/win32sck.c
-
- Title: "[PATCH] minor win32 scribbles"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>, Hugo van der Sanden
- <hv@crypt.compulink.co.uk>
- Msg-ID: <199707262307.TAA28410@aatma.engin.umich.edu>,
- <199707270832.JAA19399@crypt.compulink.co.uk>
- Files: pod/perldelta.pod README.win32 win32/Makefile win32/config.bc
- win32/config.vc win32/makefile.mk
-
- Title: "[PATCH] trial2: some batch files won't run"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199708040226.WAA17301@aatma.engin.umich.edu>
- Files: win32/bin/pl2bat.bat win32/bin/runperl.bat
-
- Title: "[PATCH] win32 docs and runperl.bat"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199707070446.AAA29560@aatma.engin.umich.edu>
- Files: MANIFEST README.win32 win32/bin/pl2bat.bat win32/bin/runperl.bat
-
- Title: "[PATCH] win32 extras and embedding"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199707250232.WAA03421@aatma.engin.umich.edu>,
- <199707301831.OAA19528@aatma.engin.umich.edu>
- Files: dosish.h win32/win32.h perl.c win32/config.bc win32/config_H.bc
- win32/makedef.pl win32/perllib.c win32/win32.c
-
- Title: "[PATCH] win32 tweaks"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199707042150.RAA01065@aatma.engin.umich.edu>
- Files: win32/win32.h win32/win32.c
-
- Title: "[PATCH] win32_stat() fixes (2nd try)"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199708040137.VAA16810@aatma.engin.umich.edu>
- Files: t/op/stat.t win32/win32iop.h win32/win32.c
-
- ------ PORTABILITY - OTHER ------
-
- Title: "Additional OS/2 patches"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>, Ilya Zakharevich
- <ilya@math.ohio-state.edu>
- Msg-ID: <199708020823.EAA19521@monk.mps.ohio-state.edu>,
- <199708021424.KAA28561@aatma.engin.umich.edu>,
- <199708042108.RAA27671@aatma.engin.umich.edu>
- Files: README.os2 os2/Changes perl.c
-
- Title: "Additional patch is needed for os2/diff.configure"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199708020745.DAA19483@monk.mps.ohio-state.edu>
- Files: os2/diff.configure
-
- Title: "Assorted OS/2 fixes"
- From: ilya@math.ohio-state.edu (Ilya Zakharevich)
- Msg-ID: <1997Jun16.163234.2091727@hmivax.humgen.upenn.edu>
- Files: hints/os2.sh os2/diff.configure os2/os2ish.h README.os2 os2/Changes
- os2/Makefile.SHs os2/os2.c util.c
-
- Title: "[PATCH] Changes for VMS 7.1 support"
- From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>, Dan Sugalski
- <sugalsd@lbcc.cc.or.us>
- Msg-ID: <01ILDXUH0J1W00026U@hmivax.humgen.upenn.edu>,
- <3.0.2.32.19970718095935.0087a2d0@stargate.lbcc.cc.or.us>
- Files: vms/sockadapt.h vms/config.vms vms/sockadapt.c
-
- Title: "[PATCH] Easier TCP stack selection for VMS"
- From: Dan Sugalski <sugalsd@lbcc.cc.or.us>
- Msg-ID: <3.0.1.32.19970624151939.00994490@stargate.lbcc.cc.or.us>
- Files: vms/descrip.mms
-
- Title: "Minor VMS patches"
- From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
- Msg-ID: <01ILCUO6XXTE000WFK@hmivax.humgen.upenn.edu>
- Files: lib/ExtUtils/MM_VMS.pm vms/vmsish.h vms/descrip.mms vms/test.com
- vms/vms.c vms/ext/filespec.t
-
- Title: "[PATCH] Two un-disabled tests for VMS"
- From: Dan Sugalski <sugalsd@lbcc.cc.or.us>
- Msg-ID: <3.0.2.32.19970718095842.00879220@stargate.lbcc.cc.or.us>
- Files: vms/test.com
-
- Title: "fixes for hints/svr4 for UnixWare >= 2.1.1"
- From: John Hughes <john@titanic.atlantech.com>
- Msg-ID: <199707021230.OAA24230@titanic.AtlanTech.COM>
- Files: hints/svr4.sh
-
- Title: "make depend loop fix and minor OS/2 improvements to build process"
- From: ilya@math.ohio-state.edu (Ilya Zakharevich)
- Files: Makefile.SH hints/os2.sh os2/Makefile.SHs
-
- ------ TESTS ------
-
- Title: "Add xor tests to test suite"
- From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
- Msg-ID: <199706250730.IAA06097@crypt.compulink.co.uk>
- Files: t/comp/cmdopt.t
-
- Title: "[PATCH] enable some tests on Win32"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199707250029.UAA02351@aatma.engin.umich.edu>
- Files: t/op/magic.t
-
- Title: "Fix up problems with *DBM tests"
- From: Paul Marquess <pmarquess@bfsec.bt.co.uk>
- Files: t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t t/lib/sdbm.t
-
- ------ UTILITIES ------
-
- Title: "[PATCH] m2t3: utils/perlbug.PL: -ok report is not a bug"
- From: Jarkko Hietaniemi <jhi@iki.fi>
- Msg-ID: <199708071022.NAA13008@alpha.hut.fi>
- Files: utils/perlbug.PL
-
- Title: "perlbug - check sendmail and fix win32 tmp path"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199708060349.XAA15895@aatma.engin.umich.edu>
- Files: utils/perlbug.PL
-
- Title: "OK: perl <some_version> on <some_system> (corrected)", "enhancements
- to perlbug -ok"
- From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Stephen McCamant <alias@mcs.com>
- Msg-ID: <E0wukVt-0006Da-00@ursa.cus.cam.ac.uk>,
- <E0wvMQl-00055y-00@ursa.cus.cam.ac.uk>,
- <m0wv81x-000EYPC@alias-2.pr.mcs.net>
- Files: utils/Makefile utils/perlbug.PL
-
- Title: "perlbug -ok [PATCH]"
- From: "Charles F. Randall" <crandall@free.click-n-call.com>
- Msg-ID: <199706181824.MAA04082@free.click-n-call.com>
- Files: utils/perlbug.PL
-
- Title: "perlbug broken"
- From: Andreas Schwab <schwab@issan.informatik.uni-dortmund.de>
- Msg-ID: <9707040912.AA03466@issan.informatik.uni-dortmund.de>
- Files: utils/perlbug.PL
-
- Title: "[PATCH] perlbug under OS/2"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199707180333.XAA03102@monk.mps.ohio-state.edu>
- Files: utils/perlbug.PL
-
- Title: "perldoc doesn't grok Win32 UNC paths"
- From: Warren Jones <wjones@tc.fluke.com>
- Msg-ID: <97Jun17.184420pdt.35728-1@gateway.fluke.com>,
- <97Jun18.165618pdt.35713-1@gateway.fluke.com>
- Files: utils/perldoc.PL
-
- Title: "[PATCH] perldoc under OS/2"
- From: Ilya Zakharevich <ilya@math.ohio-state.edu>
- Msg-ID: <199707180340.XAA03114@monk.mps.ohio-state.edu>
- Files: utils/perldoc.PL
-
- Title: "h2ph corrections to avoid redefined sub warnings"
- From: wdconsta <wdconsta@cs.adelaide.edu.au>
- Msg-ID: <Pine.SV4.3.93.970708143446.23808A-100000@florence.teaching.cs.adelaide.edu.au>
- Files: utils/h2ph.PL
-
-
+____________________________________________________________________________
+[ 1758] By: gsar on 1998/08/08 03:45:04
+ Log: set patchlevel.h, other minor tweaks
+ Branch: maint-5.005/perl
+ ! Changes patchlevel.h pod/perlhist.pod pod/perlport.pod
+____________________________________________________________________________
+[ 1757] By: gsar on 1998/08/08 03:33:33
+ Log: prevent lexical leaks from Benchmark into target code (inspired by
+ an attempt by John Allen)
+ Branch: maint-5.005/perl
+ ! lib/Benchmark.pm
+____________________________________________________________________________
+[ 1755] By: gsar on 1998/08/07 23:58:33
+ Log: temporary opcode.pl workaround for ebcdic (suggested by
+ David J. Fiander <davidf@mks.com> and M.J.T. Guy)
+ Branch: maint-5.005/perl
+ ! opcode.pl
+____________________________________________________________________________
+[ 1754] By: gsar on 1998/08/07 22:21:10
+ Log: From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ Date: Fri, 7 Aug 1998 09:56:01 +0100 (BST)
+ Message-Id: <9808070856.AA28065@claudius.bfsec.bt.co.uk>
+ Subject: [PATCH 5.005_50 & 5.005_02] Fix for command line use of source filters
+ Branch: maint-5.005/perl
+ ! perl.c
+____________________________________________________________________________
+[ 1753] By: gsar on 1998/08/07 22:19:42
+ Log: perlport.pod notes from Jarkko Hietaniemi; utime() note for Win32
+ Branch: maint-5.005/perl
+ ! pod/perlport.pod
+____________________________________________________________________________
+[ 1752] By: gsar on 1998/08/07 22:08:29
+ Log: perlport.pod v1.33 from Chris Nandor <pudge@pobox.com>
+ Branch: maint-5.005/perl
+ ! pod/perlport.pod
+____________________________________________________________________________
+[ 1751] By: gsar on 1998/08/07 22:01:04
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Thu, 6 Aug 1998 19:44:16 -0400 (EDT)
+ Message-Id: <199808062344.TAA09505@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_*] Minor cleanup of RE tests and docs
+ Branch: maint-5.005/perl
+ ! pod/perlre.pod t/op/regexp.t
+____________________________________________________________________________
+[ 1750] By: gsar on 1998/08/07 21:51:52
+ Log: allow more compatible interpretation of spaces File::DosGlob::glob()
+ patterns
+ Branch: maint-5.005/perl
+ ! lib/File/DosGlob.pm
+____________________________________________________________________________
+[ 1749] By: gsar on 1998/08/07 21:36:04
+ Log: don't use © in Test.pm (suggested by M.J.T. Guy)
+ Branch: maint-5.005/perl
+ ! lib/Test.pm
+____________________________________________________________________________
+[ 1748] By: gsar on 1998/08/07 21:31:46
+ Log: From: Dominic Dunlop <domo@computer.org>
+ Date: Thu, 6 Aug 1998 12:38:07 +0000
+ Message-Id: <v03110702b1ef5274635a@[195.95.102.104]>
+ Subject: [Patch perl5.005_02-TRIAL2] Update hints, Configure for MachTen 4.1.1
+ Branch: maint-5.005/perl
+ ! Configure hints/machten.sh
+____________________________________________________________________________
+[ 1746] By: gsar on 1998/08/05 22:55:59
+ Log: MM_Win32.pm and Liblist.pm tweaks
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Win32.pm
+____________________________________________________________________________
+[ 1745] By: gsar on 1998/08/05 21:57:00
+ Log: pod/perlfaq* update from Tom Christiansen <tchrist@perl.com>
+ Branch: maint-5.005/perl
+ ! pod/perlfaq.pod pod/perlfaq1.pod pod/perlfaq2.pod
+ ! pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq8.pod
+____________________________________________________________________________
+[ 1744] By: gsar on 1998/08/05 21:53:30
+ Log: From: Chris Nandor <pudge@pobox.com>
+ Date: Wed, 5 Aug 1998 15:38:48 -0400
+ Message-Id: <v04011701b1ee58b86c63@[192.168.0.3]>
+ Subject: [PATCH] perlport 1.32
+ Branch: maint-5.005/perl
+ ! pod/perlport.pod
+____________________________________________________________________________
+[ 1743] By: gsar on 1998/08/05 21:52:05
+ Log: README.os2 update
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Wed, 5 Aug 1998 05:44:46 -0400 (EDT)
+ Message-Id: <199808050944.FAA09053@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_*] Additional OS/2 tweaks: docs, tests
+ Branch: maint-5.005/perl
+ ! README.os2 t/lib/posix.t t/op/exec.t
+____________________________________________________________________________
+[ 1742] By: gsar on 1998/08/05 21:50:07
+ Log: additional INSTALL notes from Jarkko Hietaniemi <jhi@cc.hut.fi>
+ on semget failure in t/lib/ipc_sysv.t
+ Branch: maint-5.005/perl
+ ! INSTALL
+____________________________________________________________________________
+[ 1741] By: gsar on 1998/08/05 21:46:13
+ Log: correct URL for perlcrt.dll
+ Branch: maint-5.005/perl
+ ! Changes win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 1740] By: gsar on 1998/08/05 10:05:46
+ Log: update Changes, patchlevel, tweak Liblist.pm
+ Branch: maint-5.005/perl
+ ! Changes lib/ExtUtils/Liblist.pm patchlevel.h
+____________________________________________________________________________
+[ 1739] By: gsar on 1998/08/05 09:10:45
+ Log: newer cperl-mode.el
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Wed, 5 Aug 1998 03:50:16 -0400 (EDT)
+ Message-Id: <199808050750.DAA07240@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_*] CPerl update
+ Branch: maint-5.005/perl
+ ! emacs/cperl-mode.el
+____________________________________________________________________________
+[ 1738] By: gsar on 1998/08/05 09:08:33
+ Log: support :nosearch in ExtUtils::Liblist for win32, and make -lfoo
+ processing (somewhat) compiler-specific
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Win32.pm
+____________________________________________________________________________
+[ 1737] By: gsar on 1998/08/05 03:20:03
+ Log: add index entries for -X
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Sun, 02 Aug 1998 16:33:18 EDT
+ Message-Id: <199808022033.QAA18778@monk.mps.ohio-state.edu>
+ Subject: [PATCH] A missing docu patch
+ Branch: maint-5.005/perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 1736] By: gsar on 1998/08/05 03:09:58
+ Log: make Test::Harness optionally check for stray files when running tests
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Sun, 2 Aug 1998 18:12:48 -0400 (EDT)
+ Message-Id: <199808022212.SAA20126@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_*] File leaked from test suite
+ Branch: maint-5.005/perl
+ ! lib/Test/Harness.pm
+____________________________________________________________________________
+[ 1735] By: gsar on 1998/08/05 02:29:46
+ Log: back out change#1703 that break bincompat with PERL_OBJECT and
+ MULTIPLICITY
+ Branch: maint-5.005/perl
+ ! ext/re/re.pm regcomp.c regexec.c thrdvar.h
+____________________________________________________________________________
+[ 1734] By: gsar on 1998/08/05 02:23:47
+ Log: fixes to enable ISC to build IPC/SysV
+ From: Jarkko Hietaniemi <jhi@cc.hut.fi>
+ Date: 05 Aug 1998 00:59:13 +0300
+ Message-ID: <oee3ebce7da.fsf@alpha.hut.fi>
+ Subject: [PATCH] 5.005_02-TRIAL1: (Re: Bug in pp_rename and ISC hint)
+ Branch: maint-5.005/perl
+ ! ext/IPC/SysV/SysV.xs hints/isc.sh hints/isc_2.sh
+____________________________________________________________________________
+[ 1733] By: gsar on 1998/08/05 01:20:29
+ Log: let some 'tr' be '$tr' for occult reasons
+ From: Jeff Okamoto <okamoto@xfiles.intercon.hp.com>
+ Date: Mon, 3 Aug 1998 11:04:30 -0700 (PDT)
+ Message-Id: <199808031804.LAA25595@xfiles.intercon.hp.com>
+ Subject: PATCH: Configure uses tr, not $tr
+ Branch: maint-5.005/perl
+ ! Configure
+____________________________________________________________________________
+[ 1732] By: gsar on 1998/08/05 01:16:40
+ Log: perlre.pod tweak suggested by Mike Wescott <mike.wescott@columbiasc.ncr.com>
+ Branch: maint-5.005/perl
+ ! pod/perlre.pod
+____________________________________________________________________________
+[ 1731] By: gsar on 1998/08/05 01:10:41
+ Log: explain caveat about use of numeric constants in podoc for sysopen()
+ From: "David J. Fiander" <davidf@mks.com>
+ Date: Tue, 4 Aug 1998 13:09:58 -0400
+ Message-Id: <199808041709.NAA01750@mks.com>
+ Subject: Re: [PATCH] 5.005_01: OE MVS
+ Branch: maint-5.005/perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 1730] By: gsar on 1998/08/05 00:46:53
+ Log: end pod processing when source file is closed (prevents it carrying
+ over into require()d files)
+ Branch: maint-5.005/perl
+ ! t/comp/require.t toke.c
+____________________________________________________________________________
+[ 1729] By: gsar on 1998/08/04 23:03:23
+ Log: correct prototype for des_fcrypt(), explain how to add it in more
+ detail, and supply a patch for libdes-3.06
+ Branch: maint-5.005/perl
+ + win32/des_fcrypt.patch
+ ! MANIFEST README.win32 win32/Makefile win32/makefile.mk
+ ! win32/win32.c
+____________________________________________________________________________
+[ 1728] By: gsar on 1998/08/04 21:50:40
+ Log: tweak to avoid ambiguity warnings
+ Branch: maint-5.005/perl
+ ! pp.c
+____________________________________________________________________________
+[ 1727] By: gsar on 1998/08/04 20:31:04
+ Log: remove useless 'rcsid' (extension of a suggestion by
+ Stephen McCamant)
+ Branch: maint-5.005/perl
+ ! embed.h ext/SDBM_File/sdbm/pair.c ext/SDBM_File/sdbm/sdbm.c
+ ! global.sym gv.c perl.c vms/gen_shrfls.pl
+____________________________________________________________________________
+[ 1726] By: gsar on 1998/08/04 19:52:43
+ Log: correct Pod::Html's notion of email addresses
+ From: abigail@fnx.com
+ Date: Mon, 3 Aug 1998 20:22:49 -0400 (EDT)
+ Message-ID: <19980804002249.2011.qmail@betelgeuse.wayne.fnx.com>
+ Subject: [PATCH 5.005_01] lib/Pod/Html.pm
+ Branch: maint-5.005/perl
+ ! lib/Pod/Html.pm
+____________________________________________________________________________
+[ 1725] By: gsar on 1998/08/04 19:50:06
+ Log: perlport.pod additions from Peter Prymmer <pvhp@forte.com>
+ Date: Mon, 3 Aug 98 15:31:35 PDT
+ Message-Id: <9808032231.AA22324@forte.com>
+ --
+ Date: Tue, 4 Aug 98 12:44:20 PDT
+ Message-Id: <9808041944.AA04815@forte.com>
+ Branch: maint-5.005/perl
+ ! pod/perlport.pod
+____________________________________________________________________________
+[ 1724] By: gsar on 1998/08/04 18:08:07
+ Log: From: Chris Nandor <pudge@pobox.com>
+ Date: Mon, 3 Aug 1998 13:35:25 -0400
+ Message-Id: <v04011711b1eba46d0827@[192.168.0.3]>
+ Subject: [PATCH] perlport 1.30
+ Branch: maint-5.005/perl
+ ! pod/perlport.pod
+____________________________________________________________________________
+[ 1723] By: gsar on 1998/08/04 18:06:13
+ Log: update postscript generator
+ From: Tom Christiansen <tchrist@chthon.perl.com>
+ Date: Mon, 3 Aug 1998 05:29:25 -0600
+ Message-Id: <199808031129.FAA24985@chthon.perl.com>
+ Subject: PATCH: pod/roffitall (5.005_02)
+ Branch: maint-5.005/perl
+ ! pod/roffitall
+____________________________________________________________________________
+[ 1722] By: gsar on 1998/08/03 17:01:12
+ Log: applied suggested patch, slightly tweaked
+ From: Jarkko Hietaniemi <jhi@cc.hut.fi>
+ Date: Mon, 3 Aug 1998 11:52:30 +0300 (EET DST)
+ Message-Id: <199808030852.LAA14153@alpha.hut.fi>
+ Subject: [PATCH] perl5.005_02-TRIAL1: pod/perlhist.pod
+ Branch: maint-5.005/perl
+ ! pod/perlhist.pod
+____________________________________________________________________________
+[ 1721] By: gsar on 1998/08/03 16:30:20
+ Log: fix segfault when threadsv is used as foreach itervar
+ From: Stephen McCamant <alias@mcs.com>
+ Date: Sun, 02 Aug 1998 21:44:34 CDT
+ Message-Id: <13765.8641.997452.14516@alias-2.pr.mcs.net>
+ Subject: [PATCH] threadsv index in enteriter targ in op_free()
+ Branch: maint-5.005/perl
+ ! op.c
+____________________________________________________________________________
+[ 1720] By: gsar on 1998/08/02 23:33:42
+ Log: close() open files before unlink()
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Sun, 2 Aug 1998 18:14:22 -0400 (EDT)
+ Message-Id: <199808022214.SAA20135@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_*] File leaked from test suite - tests
+ Branch: maint-5.005/perl
+ ! t/base/rs.t t/op/defins.t
+____________________________________________________________________________
+[ 1719] By: gsar on 1998/08/02 23:31:51
+ Log: more pack() tests
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Mon, 3 Aug 1998 00:59:41 +0300 (EET DST)
+ Message-Id: <199808022159.AAA17160@alpha.hut.fi>
+ Subject: Re: uudecode 'u' problem
+ Branch: maint-5.005/perl
+ ! t/op/pack.t
+____________________________________________________________________________
+[ 1718] By: gsar on 1998/08/02 23:26:51
+ Log: t/TEST aesthetic tweak suggested by Jarkko
+ Branch: maint-5.005/perl
+ ! t/TEST
+____________________________________________________________________________
+[ 1717] By: gsar on 1998/08/02 23:23:43
+ Log: add Digital Unix 3.x notes to README.threads (as suggested by
+ Phoenix <awrobel@jedi.cis.temple.edu>)
+ Branch: maint-5.005/perl
+ ! README.threads
+____________________________________________________________________________
+[ 1716] By: gsar on 1998/08/02 23:15:00
+ Log: allow *FOO{BAR}[0] etc. (without intervening arrow)
+ From: Stephen McCamant <alias@mcs.com>
+ Date: Sun, 2 Aug 1998 16:16:50 -0500 (CDT)
+ Message-ID: <13764.54929.60137.104838@alias-2.pr.mcs.net>
+ Subject: [PATCH] Re: Minor nit in glob notation
+ Branch: maint-5.005/perl
+ ! Changes op.c
+____________________________________________________________________________
+[ 1715] By: gsar on 1998/08/02 22:49:53
+ Log: fix unpack('u',...) problem with spaces in input
+ Branch: maint-5.005/perl
+ ! pp.c t/op/pack.t
+____________________________________________________________________________
+[ 1714] By: gsar on 1998/08/02 21:27:19
+ Log: update location of perlcrt.dll for win32 builds
+ Branch: maint-5.005/perl
+ ! win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 1713] By: gsar on 1998/08/02 09:28:32
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Sun, 2 Aug 1998 04:35:11 -0400 (EDT)
+ Message-Id: <199808020835.EAA09367@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_*] Better debugging output from malloc.c
+ Branch: maint-5.005/perl
+ ! malloc.c
+____________________________________________________________________________
+[ 1712] By: gsar on 1998/08/02 09:16:55
+ Log: fix longstanding bug in pack('u',...) (reads garbage beyond the end
+ of the input string)
+ Branch: maint-5.005/perl
+ ! pp.c
+____________________________________________________________________________
+[ 1711] By: gsar on 1998/08/02 08:14:25
+ Log: update Changes, tweak Porting/makerel
+ Branch: maint-5.005/perl
+ ! Changes Porting/makerel
+____________________________________________________________________________
+[ 1710] By: gsar on 1998/08/02 07:31:37
+ Log: remove CRs from djgpp/configure.bat (Porting/makerel adds them)
+ Branch: maint-5.005/perl
+ ! djgpp/configure.bat
+____________________________________________________________________________
+[ 1709] By: gsar on 1998/08/02 07:27:34
+ Log: Porting/makerel tweaks
+ Branch: maint-5.005/perl
+ ! Porting/makerel
+____________________________________________________________________________
+[ 1708] By: gsar on 1998/08/02 07:09:35
+ Log: fixes for pod noises
+ Branch: maint-5.005/perl
+ ! ext/B/B/Bytecode.pm ext/Thread/Thread/Specific.pm
+ ! pod/perlembed.pod pod/perlfaq.pod
+____________________________________________________________________________
+[ 1707] By: gsar on 1998/08/02 06:59:47
+ Log: malloc.c tweaks
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Sat, 01 Aug 1998 18:46:32 EDT
+ Message-Id: <199808012246.SAA00699@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_*] Better malloc.c
+ Branch: maint-5.005/perl
+ ! malloc.c
+____________________________________________________________________________
+[ 1706] By: gsar on 1998/08/02 06:56:37
+ Log: fix quoting of keys with embedded nulls
+ From: Slaven Rezic <eserte@cs.tu-berlin.de>
+ Date: Sat, 01 Aug 1998 13:38:03 +0200
+ Message-Id: <199808011138.NAA05189@mail.cs.tu-berlin.de>
+ Subject: Data::Dumper 2.09, patch
+ Branch: maint-5.005/perl
+ ! ext/Data/Dumper/Dumper.xs
+____________________________________________________________________________
+[ 1705] By: gsar on 1998/08/02 06:50:07
+ Log: From: pvhp@forte.com (Peter Prymmer)
+ Date: Fri, 31 Jul 1998 14:50:41 PDT
+ Message-Id: <9807312150.AA08867@forte.com>
+ Subject: Re: \Q doesn't work in interpolated regular expressions
+ Branch: maint-5.005/perl
+ ! pod/perlre.pod
+____________________________________________________________________________
+[ 1704] By: gsar on 1998/08/02 06:37:06
+ Log: add test for magic autovivification
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Date: Thu, 30 Jul 1998 12:18:15 +0100
+ Message-Id: <E0z1qit-0003O5-00@taurus.cus.cam.ac.uk>
+ Subject: Re: Perl5.005_01 failing to autovivify subroutine args
+ Branch: maint-5.005/perl
+ ! pod/perldiag.pod t/cmd/subval.t
+____________________________________________________________________________
+[ 1703] By: gsar on 1998/08/02 06:26:57
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Tue, 21 Jul 1998 23:58:53 -0400 (EDT)
+ Message-Id: <199807220358.XAA19811@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_76] better RE colors
+ Branch: maint-5.005/perl
+ ! ext/re/re.pm regcomp.c regexec.c thrdvar.h
+____________________________________________________________________________
+[ 1702] By: gsar on 1998/08/02 06:22:15
+ Log: mark link type of exported functions for OS/2
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Sun, 26 Jul 1998 21:03:03 -0400 (EDT)
+ Message-Id: <199807270103.VAA04977@monk.mps.ohio-state.edu>
+ Subject: Re: Compiler linkage's types [PATCH 5.005]
+ Branch: maint-5.005/perl
+ ! os2/os2ish.h proto.h
+____________________________________________________________________________
+[ 1701] By: gsar on 1998/08/02 06:16:03
+ Log: tweaked version of suggested patch
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Mon, 20 Jul 1998 21:40:00 -0400 (EDT)
+ Message-Id: <199807210140.VAA17186@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_75] Enable -DS
+ Branch: maint-5.005/perl
+ ! README.threads ext/Thread/Thread.xs ext/Thread/typemap mg.c
+ ! op.c perl.c perl.h pod/perlrun.pod pp.c pp_hot.c scope.c
+ ! thread.h util.c win32/win32thread.c
+____________________________________________________________________________
+[ 1700] By: gsar on 1998/08/02 05:54:00
+ Log: up patchlevel to 5.005_02
+ Branch: maint-5.005/perl
+ ! Changes patchlevel.h win32/Makefile win32/config_H.bc
+ ! win32/config_H.gc win32/config_H.vc win32/makefile.mk
+____________________________________________________________________________
+[ 1699] By: gsar on 1998/08/02 05:50:01
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199807180809.EAA09379@monk.mps.ohio-state.edu>
+ Date: Sat, 18 Jul 1998 04:09:26 -0400 (EDT)
+ Subject: [PATCH 5.004_72] Make tests succeed on OS/2
+ Branch: maint-5.005/perl
+ ! t/io/fs.t t/lib/io_pipe.t t/lib/io_sock.t t/op/stat.t
+____________________________________________________________________________
+[ 1698] By: gsar on 1998/08/02 05:41:41
+ Log: use I32_MAX as the limit when U16_MAX > I32_MAX (for CRAY)
+ Branch: maint-5.005/perl
+ ! regcomp.c
+____________________________________________________________________________
+[ 1697] By: gsar on 1998/08/02 05:20:12
+ Log: support OE/MVS
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Message-Id: <199808010903.MAA09371@alpha.hut.fi>
+ Date: Sat, 1 Aug 1998 12:03:02 +0300 (EET DST)
+ Subject: [PATCH] 5.005_01: OE MVS
+ Branch: maint-5.005/perl
+ + README.os390 ebcdic.c
+ ! Configure MANIFEST doio.c ext/Errno/Errno_pm.PL gv.c handy.h
+ ! hints/os390.sh lib/bigint.pl mg.c patchlevel.h perl.c perl.h
+ ! perly.c perly.h perly.y perly_c.diff pod/perldelta.pod
+ ! pod/perlport.pod pp.c pp_ctl.c pp_hot.c pp_sys.c sv.c
+ ! t/base/term.t t/comp/package.t t/comp/require.t
+ ! t/lib/bigintpm.t t/lib/cgi-html.t t/lib/filehand.t t/lib/ph.t
+ ! t/op/auto.t t/op/bop.t t/op/each.t t/op/magic.t t/op/misc.t
+ ! t/op/ord.t t/op/pack.t t/op/quotemeta.t t/op/re_tests
+ ! t/op/regexp.t t/op/sort.t t/op/sprintf.t t/op/subst.t
+ ! t/op/taint.t t/op/universal.t t/pragma/constant.t
+ ! t/pragma/overload.t t/pragma/subs.t toke.c x2p/a2p.h
+ ! x2p/a2py.c
+____________________________________________________________________________
+[ 1696] By: gsar on 1998/08/02 05:03:09
+ Log: VMS patches
+ From: pvhp@forte.com (Peter Prymmer)
+ Message-Id: <9807290017.AA01833@forte.com>
+ Date: Tue, 28 Jul 98 17:17:33 PDT
+ Subject: Re: Not OK: perl 5.00501 on VMS_AXP-thread I7.2
+ --
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Message-Id: <3.0.5.32.19980729125623.00b562b0@ous.edu>
+ Date: Wed, 29 Jul 1998 12:56:23 -0700
+ Subject: [PATCH 5.005_01]Typo in CONFIGURE.COM (vms)
+ --
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Date: Thu, 30 Jul 1998 09:02:24 -0700
+ Message-Id: <3.0.5.32.19980730090224.00b70eb0@ous.edu>
+ Subject: [PATCH 5.005_01]VMS config SOCKETSHR typo patch and fcntl check
+ Branch: maint-5.005/perl
+ ! configure.com vms/subconfigure.com
+____________________________________________________________________________
+[ 1695] By: gsar on 1998/08/02 04:49:32
+ Log: rename duplicate warning in regexec.c
+ Branch: maint-5.005/perl
+ ! regexec.c
+____________________________________________________________________________
+[ 1694] By: gsar on 1998/08/02 04:44:20
+ Log: beware egcs' ld on Solaris
+ From: Tom Spindler <dogcow@home.merit.edu>
+ Message-ID: <19980801212158.A2934@home.merit.edu>
+ Date: Sat, 1 Aug 1998 21:21:58 -0400
+ Subject: Re: [PATCH perl5.005_01] hints/solaris_2.sh, egcs, and ld
+ Branch: maint-5.005/perl
+ ! hints/solaris_2.sh
+____________________________________________________________________________
+[ 1693] By: gsar on 1998/08/02 04:41:43
+ Log: de-utf-ized variation of Ilya's patch
+ From: Jan-Pieter Cornet <johnpc@xs4all.net>
+ Date: 31 Jul 1998 12:44:57 +0200
+ Message-ID: <6ps779$hmj$1@xs1.xs4all.nl>
+ Subject: Re: s/\s*$//g in majordomo causes segfault under 5.005_01
+ Branch: maint-5.005/perl
+ ! regexec.c
+____________________________________________________________________________
+[ 1692] By: gsar on 1998/08/02 04:39:14
+ Log: better validation of SysV IPC availability
+ From: Jarkko Hietaniemi <jarkko.hietaniemi@research.nokia.com>
+ Date: Fri, 31 Jul 1998 13:13:57 +0300 (EEST)
+ Message-Id: <199807311013.NAA28887@koah.research.nokia.com>
+ Subject: Re: lib/ipc_sysv.t fails under FreeBSD 2.2.1
+ Branch: maint-5.005/perl
+ ! Configure INSTALL ext/IPC/SysV/SysV.xs pod/perldiag.pod
+ ! t/lib/ipc_sysv.t
+____________________________________________________________________________
+[ 1691] By: gsar on 1998/08/02 04:32:30
+ Log: fix bug in display of watched expressions
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Thu, 30 Jul 1998 20:02:04 -0400 (EDT)
+ Message-Id: <199807310002.UAA21681@monk.mps.ohio-state.edu>
+ Subject: Re: Bug? in perl5db.pl [PATCH]
+ Branch: maint-5.005/perl
+ ! lib/perl5db.pl
+____________________________________________________________________________
+[ 1690] By: gsar on 1998/08/02 04:29:08
+ Log: applied all but one hunk
+ From: Horst von Brand <vonbrand@sleipnir.valparaiso.cl>
+ Date: Thu, 30 Jul 1998 17:19:42 -0400
+ Message-Id: <199807302119.RAA06852@sleipnir.valparaiso.cl>
+ Subject: Some typos in perldelta.pod
+ Branch: maint-5.005/perl
+ ! pod/perldelta.pod
+____________________________________________________________________________
+[ 1689] By: gsar on 1998/08/02 04:27:02
+ Log: From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Thu, 30 Jul 1998 10:22:36 -0400 (EDT)
+ Message-Id: <Pine.SUN.3.96.980730101627.17514B-100000@newton.phys>
+ Subject: [PATCH 5.005_05] Remove redundant dTHR
+ Branch: maint-5.005/perl
+ ! mg.c sv.c
+____________________________________________________________________________
+[ 1688] By: gsar on 1998/08/02 04:25:49
+ Log: From: Tom Hughes <thh@cyberscience.com>
+ Date: 30 Jul 1998 09:47:31 +0100
+ Message-ID: <yek1zr3vi70.fsf@elva.cyberscience.com>
+ Subject: Class::Struct has an incomplete tied array package
+ Branch: maint-5.005/perl
+ ! lib/Class/Struct.pm
+____________________________________________________________________________
+[ 1687] By: gsar on 1998/08/02 04:21:48
+ Log: ensure implicit close on local(*FH) doesn't affect $! and thence $?
+ Branch: maint-5.005/perl
+ ! sv.c t/op/die_exit.t
+____________________________________________________________________________
+[ 1686] By: gsar on 1998/08/02 03:57:28
+ Log: From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Thu, 30 Jul 1998 00:39:30 +0300 (EET DST)
+ Message-Id: <199807292139.AAA01795@alpha.hut.fi>
+ Subject: Re: [PATCH] 5.004_05-MAINT_TRIAL_5: three locale fixes
+ Branch: maint-5.005/perl
+ ! ext/POSIX/POSIX.xs pod/perllocale.pod
+____________________________________________________________________________
+[ 1685] By: gsar on 1998/08/02 03:54:15
+ Log: PERL_OBJECT bincompat fixes from Douglas Lankshear <dougl@ActiveState.com>
+ Date: Wed, 29 Jul 1998 10:45:31 -0700
+ Message-ID: <000101bdbb18$ae767550$a32fa8c0@tau.Active>
+ Subject: [PATCH 5.005_01] Fixes binary compatibility for PERL_OBJECT
+ --
+ Date: Sat, 1 Aug 1998 09:33:19 -0700
+ Message-ID: <000701bdbd6a$17ada180$a32fa8c0@tau.Active>
+ Subject: [PATCH 5.005_01]
+ Branch: maint-5.005/perl
+ ! perl.h proto.h
+____________________________________________________________________________
+[ 1684] By: gsar on 1998/08/02 03:49:33
+ Log: hand-apply whitespace-mutiliated patch
+ From: Nicholas Clark <nick@flirble.org>
+ Date: Tue, 28 Jul 1998 16:40:42 +0100 (BST)
+ Message-Id: <199807281540.QAA04640@flirble.org>
+ Subject: [PATCH] POSIX::ELOOP
+ Branch: maint-5.005/perl
+ ! ext/POSIX/POSIX.pm ext/POSIX/POSIX.xs
+____________________________________________________________________________
+[ 1683] By: gsar on 1998/08/02 03:45:26
+ Log: document return values of do() better
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Date: Tue, 28 Jul 1998 12:44:36 +0100
+ Message-Id: <E0z18BI-0003cH-00@taurus.cus.cam.ac.uk>
+ Subject: [PATCH] Re: Obscurity of lexicals with do ""
+ Branch: maint-5.005/perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 1682] By: gsar on 1998/08/02 03:42:26
+ Log: avoid reusing foreach itervar if magic got tacked onto it
+ From: Stephen McCamant <alias@mcs.com>
+ Date: Tue, 28 Jul 1998 22:18:25 -0500 (CDT)
+ Message-ID: <13758.36756.215424.719750@alias-2.pr.mcs.net>
+ Subject: [PATCH] Re: pos() resetting changed with 5.005?
+ Branch: maint-5.005/perl
+ ! pp_hot.c
+____________________________________________________________________________
+[ 1681] By: gsar on 1998/08/02 03:39:27
+ Log: From: Nick Ing-Simmons <nik@tiuk.ti.com>
+ Date: Wed, 29 Jul 1998 13:28:14 +0100
+ Message-Id: <199807291228.NAA20055@tiuk.ti.com>
+ Subject: [Patch] Math::Complex - Ambiguous call resolved as CORE::foo()
+ Branch: maint-5.005/perl
+ + Porting/fixCORE
+ ! MANIFEST lib/Math/Complex.pm
+____________________________________________________________________________
+[ 1680] By: gsar on 1998/08/02 03:33:07
+ Log: From: h.sanden@elsevier.nl (Hugo van der Sanden)
+ Date: Mon, 27 Jul 1998 13:34:45 +0200
+ Message-Id: <199807271134.NAA24475@dorlas.elsevier.nl>
+ Subject: perlcall.pod
+ Branch: maint-5.005/perl
+ ! pod/perlcall.pod
+____________________________________________________________________________
+[ 1679] By: gsar on 1998/08/02 03:29:41
+ Log: MM_Win32::maybe_command() case-insesitivity tweak
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/MM_Win32.pm
+____________________________________________________________________________
+[ 1678] By: gsar on 1998/08/02 03:24:29
+ Log: fix MM_Win32::maybe_command()
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/MM_Win32.pm
+____________________________________________________________________________
+[ 1677] By: gsar on 1998/08/01 19:52:19
+ Log: fixes for overloading bugs and docs, tweaked some
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Sat, 25 Jul 1998 21:28:16 -0400 (EDT)
+ Message-Id: <199807260128.VAA10543@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_76] better overloading
+ Branch: maint-5.005/perl
+ ! Changes gv.c lib/dumpvar.pl lib/overload.pm lib/perl5db.pl
+ ! t/pragma/overload.t
+____________________________________________________________________________
+[ 1676] By: gsar on 1998/08/01 19:37:13
+ Log: stray s/foo/PL_foo/
+ From: win@in.rhein-main.de (Winfried Koenig)
+ Date: Mon, 27 Jul 98 21:13 MET
+ Message-Id: <m0z0teW-00019aC@incom.rhein-main.de>
+ Subject: Bug in pp_rename and ISC hint
+ Branch: maint-5.005/perl
+ ! pp_sys.c
+____________________________________________________________________________
+[ 1675] By: gsar on 1998/08/01 19:22:13
+ Log: newer Porting/patchls from maint-5.004
+ Branch: maint-5.005/perl
+ ! Porting/patchls
+____________________________________________________________________________
+[ 1674] By: gsar on 1998/08/01 17:50:44
+ Log: fix buggy detection of failed glob()
+ Branch: maint-5.005/perl
+ ! pp_hot.c
+____________________________________________________________________________
+[ 1673] By: gsar on 1998/07/29 18:14:32
+ Log: fix typo in change#1489 that prevented magic-autovivification
+ Branch: maint-5.005/perl
+ ! mg.c
----------------
-Version 5.004_01 Maintenance release 1 for 5.004
+Version 5.005_01 First maintenance release of 5.005
----------------
-"Practice random kindness and senseless acts of beauty"
- -- Anne Herbert
-
- HEADLINES FOR THIS MAINTENANCE RELEASE
-
- (..., undef, ...) = split(...) bug fixed.
- Win32 support greatly improved, now very strong.
- Memory leak using Tied hashes and arrays fixed.
- Documentation updates.
- Many other bug fixes and enhancements.
-
- CORE LANGUAGE
-
- Title: "[PATCH] first true value returned by scalar C<...> is wrong"
- From: hansm@euronet.nl
- Files: pp_ctl.c t/op/flip.t
-
- Title: "Regex Bug in 5.003_26 thru 003_99a"
- From: Andreas Karrer <karrer@ife.ee.ethz.ch>, Chip Salzenberg
- <chip@atlantic.net>
- Msg-ID: <199705152303.BAA08890@kuru.ee.ethz.ch>,
- <199705161915.PAA18721@rio.atlantic.net>
- Files: regcomp.h regcomp.c regexec.c
-
- Title: "[PATCH] -w interacts badly with -Dt"
- From: Spider Boardman <spider@Orb.Nashua.NH.US>
- Files: sv.c
-
- Title: "No DESTROY on untie. Tie memory leak fixed."
- From: Gurusamy Sarathy <gsar@engin.umich.edu>, Jay Rogers <jay@rgrs.com>,
- pmarquess@bfsec.bt.co.uk (Paul Marquess)
- Msg-ID: <199705170235.WAA00267@fluffy.rgrs.com>,
- <199705172156.RAA20561@aatma.engin.umich.edu>,
- <9705171506.AA04491@claudius.bfsec.bt.co.uk>
- Files: pp_hot.c
-
- Title: "magic_clear_all_env proto should match svt_clear"
- From: Nick Ing-Simmons <nik@tiuk.ti.com>
- Files: proto.h mg.c
-
- Title: "[PATCH] ENV leaks on win32 (was Re: Comments on ENV patch sought)",
- "[PATCH] for NETaa13787: %ENV=(); doesn't clear the environment"
- From: hansm@euronet.nl, pvhp@forte.com (Peter Prymmer)
- Msg-ID: <199705292240.AAA01135@mail.euronet.nl>
- Files: embed.h perl.h proto.h global.sym mg.c t/op/magic.t
-
- Title: "Patch to show @INC when require dies"
- From: avera@hal.com (Jim Avera)
- Msg-ID: <9705230121.AA27872@membrane.hal.com>
- Files: pp_ctl.c
-
- Title: "[PATCH] bug with m// nested inside s///e"
- From: hansm@euro.net
- Files: op.c t/op/subst.t
-
- DOCUMENTATION
-
- Title: "[PATCH] perlembed Win32 update"
- From: Doug MacEachern <dougm@opengroup.org>
- Files: pod/perlembed.pod
-
- Title: "perldiag.pod patch - "(W) substr outside string" is "(S)evere" if
- used as lvalue."
- From: John Hughes <john@AtlanTech.COM>
- Files: pod/perldiag.pod
-
- Title: "local(%ENV) looses magic - document behaviour"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Files: pod/perlsub.pod
-
- Title: "[PATCH] perlguts caveats", "perlguts additions"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>, ilya@math.ohio-state.edu
- (Ilya Zakharevich)
- Msg-ID: <199705180052.UAA22066@aatma.engin.umich.edu>,
- <199705180202.WAA22826@aatma.engin.umich.edu>,
- <199705301341.JAA05204@aatma.engin.umich.edu>,
- <1997May17.235722.2033087@hmivax.humgen.upenn.edu>
- Files: pod/perlguts.pod
-
- Title: "pod2man produces broken pages", "weird condition in perldelta breaks
- nroff"
- From: Davin Milun <milun@cs.Buffalo.EDU>, Hans Mulder <hansm@icgned.nl>
- Msg-ID: <199705310447.AAA15721@obelix.cs.Buffalo.EDU>,
- <1997May25.192350.2055977@hmivax.humgen.upenn.edu>
- Files: pod/pod2man.PL
-
- Title: "Perl 5 pod2man fix", "perlguts man page corrupted"
- From: chen@adi.com (Franklin Chen), gnat@frii.com, lvirden@cas.org, tom
- (Tom Dinger on Feste), tom@edc.com (Tom Dinger on Feste)
- Msg-ID: <199705210013.UAA09599@menhaden.adi.com>,
- <199706011305.JAA18271@cas.org>,
- <199706012116.PAA14102@elara.frii.com>,
- <9504250959.AA23419@feste.edc.com>,
- <9504251700.AA23823@feste.edc.com>
- Files: pod/pod2man.PL
-
- Title: "[PATCH] reference form chomp to chop in perlfunc"
- From: hansm@euronet.nl
- Files: pod/perlfunc.pod
-
- Title: "pod2man gags if "=pod" is before "=head1 NAME""
- From: whyde@pezz.sps.mot.com (Warren Hyde)
- Msg-ID: <9705212115.AA21730@pezz.sps.mot.com>
- Files: pod/pod2man.PL
-
- Title: "perlfunc.pod unclear about return value range of rand"
- From: "Tuomas J. Lukka" <tjl@lukka.student.harvard.edu>
- Msg-ID: <m0wSMiC-000C9xC@lukka.student.harvard.edu>
- Files: pod/perlfunc.pod
-
- Title: "Error in perllol manpage", "Error in perllol manpage (fwd)"
- From: Chris Wick <cwick@lmc.com>
- Files: pod/perllol.pod
-
- Title: "5.004 removed deprecated %OVERLOAD support silently"
- From: jon@sems.com (Jonathan Biggar)
- Msg-ID: <199705232319.QAA28388@clamp.netlabs.com>
- Files: pod/perldelta.pod
-
- Title: "[PATCH] Documentation bugs"
- From: Stephen Potter <spp@psa.pencom.com>
- Files: pod/perldata.pod pod/perldiag.pod pod/perlfaq8.pod pod/perlfaq9.pod
- pod/perlop.pod pod/perlsub.pod pod/perltoot.pod
-
- Title: "5.004 POD stuff", "make html - any takers?", "make html --> unusable
- xref links", "pod/*.html -- all hyperlinks are invalid"
- From: "Darren/Torin/Who Ever..." <torin@daft.com>, "Paul D. Smith"
- <psmith@BayNetworks.COM>, Gurusamy Sarathy
- <gsar@engin.umich.edu>, Jarkko Hietaniemi <jhi@iki.fi>,
- Michael R Cook <mcook@cognex.com>, avera@hal.com (Jim
- Avera), lvirden@cas.org
- Msg-ID: <199705162008.XAA06906@alpha.hut.fi>,
- <199705171830.OAA15652@erawan.cognex.com>,
- <199706081749.NAA04552@aatma.engin.umich.edu>,
- <1997May16.191039.2033079@hmivax.humgen.upenn.edu>,
- <87hgg2y1h4.fsf@perv.daft.com>,
- <9705161931.AA01075@membrane.hal.com>,
- <9705191839.AA28702@lemming.engeast>
- Files: INSTALL pod/perldiag.pod installhtml
-
- Title: "checkpods- forget blank line status when starting a new file"
- From: Larry Parmelee <parmelee@CS.Cornell.EDU>
- Files: pod/checkpods.PL
-
- Title: "installhtml: Fix 'no title' & 'unexpected ...' warnings. Double speed."
- From: Tim Bunce
- Files: installhtml lib/Pod/Html.pm pod/splitpod
-
- LIBRARY AND EXTENSIONS
-
- Title: "sdbm can fail if a config.h exists in system directories"
- From: Tim Bunce
- Files: ext/SDBM_File/sdbm/Makefile.PL
-
- Title: "LWP and SIG __DIE__ traps not playing well together!"
- From: Gisle Aas <aas@bergen.sn.no>
- Files: lib/AutoLoader.pm
-
- Title: "Memory Consumption of autosplit_lib_modules/sv_gets (workaround)"
- From: Matthias Neeracher <neeri@iis.ee.ethz.ch>
- Files: lib/AutoSplit.pm
-
- Title: "Comments of this Sys::Syslog patch", "Unusual Sys::Syslog behaviour
- with FQDN ? [Even in 5.004 - a bug?]"
- From: Jarkko Hietaniemi <jhi@iki.fi>, Russ Allbery <rra@stanford.edu>,
- alansz@mellers1.psych.berkeley.edu (Alan Schwartz)
- Msg-ID: <199705231621.TAA16790@alpha.hut.fi>, <5m4fjr$rhs@agate.berkeley.edu>
- Files: lib/Sys/Syslog.pm
-
- Title: "Patch to CPAN.pm (perl5.004) for ncftp"
- From: "Richard L. Maus, Jr." <rmaus@monmouth.com>
- Msg-ID: <337FBAC8.167EB0E7@monmouth.com>
- Files: lib/CPAN.pm
-
- Title: "[PATCH] Harness.pm bug w/perl5.004 & VMS"
- From: Dan Sugalski <sugalsd@lbcc.cc.or.us>
- Msg-ID: <3.0.1.32.19970530102300.008a2730@stargate.lbcc.cc.or.us>
- Files: lib/Test/Harness.pm
-
- Title: "more Fcntl constants [PATCH]"
- From: Jarkko Hietaniemi <jhi@iki.fi>
- Files: ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs
-
- Title: "5.004 breaks ftp.pl due to missing (although obsolete) chat2.pl"
- From: Tim Bunce
- Files: lib/chat2.pl
-
- BUILD PROCESS
-
- Title: "make test && ... doesn't work"
- From: Tim Bunce
- Files: Makefile.SH
-
- Title: "[PATCH] INSTALL-1.18"
- From: Andy Dougherty <doughera@fractal.phys.lafayette.edu>
- Msg-ID: <Pine.SOL.3.95q.970529142739.662D-100000@fractal.lafayette.edu>
- Files: INSTALL
-
- Title: "improved gnuwin32 Configure support"
- From: Chris Faylor <cgf@bbc.com>
- Msg-ID: <199706070318.XAA09214@hardy.bbc.com>
- Files: Configure
-
- Title: "installhtml problems finding splitpod"
- From: lvirden@cas.org
- Files: installhtml INSTALL
-
- Title: "perl 5.004 (and 01) man pages not generated and installed"
- From: lvirden@cas.org (Larry W. Virden)
- Files: installman
-
- Title: "oddity in Configure"
- From: Mike Stok <mike@stok.co.uk>
- Files: Configure
-
- Title: "perl5.004 on AIX: Patches", "perl5.004 on FreeBSD and AIX"
- From: Peter van Heusden <pvh@junior.uwc.ac.za>
- Msg-ID: <Pine.A32.3.93.970519142625.22442B-100000@junior.uwc.ac.za>,
- <Pine.A32.3.93.970519163700.25188A-100000@junior.uwc.ac.za>
- Files: Makefile.SH perl_exp.SH ext/DynaLoader/dl_aix.xs perlio.sym
-
- Title: "Compiling perl5.004 on NEWS-OS 4.x"
- From: Makoto MATSUSHITA (=?ISO-2022-JP?B?GyRCJF4kRCQ3JD8kXiQzJEgbKEI=?=)
- <matusita@ics.es.osaka-u.ac.jp>
- Msg-ID: <19970521132814F.matusita@ics.es.osaka-u.ac.jp>
- Files: Configure hints/newsos4.sh
-
- PORTABILITY
-
- Title: "win32: additional default libraries"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199705291332.JAA21560@aatma.engin.umich.edu>
- Files: lib/ExtUtils/MM_Win32.pm
-
- Title: "[PATCH] win32 minor fixes"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Files: lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_Win32.pm win32/config.bc
-
- Title: "[PATCH] clean up perlocal.pod output on VMS"
- From: pvhp@forte.com (Peter Prymmer)
- Files: lib/ExtUtils/MM_VMS.pm
-
- Title: "[PATCH] Re: Term::ReadKey on Win32: set console"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Files: lib/Term/ReadLine.pm
-
- Title: "[PATCH] Pod::Text nit for Win32"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Files: lib/Pod/Text.pm
-
- Title: "pathname bug in xsubpp on win32"
- From: jon@sems.com (Jonathan Biggar)
- Msg-ID: <199705230126.SAA23401@clamp.netlabs.com>
- Files: lib/ExtUtils/xsubpp
-
- Title: "MakeMaker stumbles on Win32 UNC paths"
- From: Warren Jones <wjones@TC.FLUKE.COM>
- Files: lib/ExtUtils/MM_Win32.pm
-
- Title: "build problem on SGI R10000 PowerChallenge (IRIX 6.2) lseek proto"
- From: Jarkko Hietaniemi <jhi@iki.fi>
- Files: doio.c
-
- Title: "Perl 5.004 + Linux 2.0.30 & semctl()"
- From: Andy Dougherty <doughera@fractal.phys.lafayette.edu>, Jordan
- Mendelson <jordy@snappy.wserv.com>
- Files: doio.c
-
- Title: "lib/io_udp.t fails on VMS"
- From: Jonathan.Hudson@jrhudson.demon.co.uk
- Msg-ID: <XFMail.970522181042.Jonathan.Hudson@jrhudson.demon.co.uk>
- Files: pp_sys.c
-
- Title: "Compilation of mg.c from perl5.004m1t2 fails on OpenVMS/AXP"
- From: Henrik Tougaard <ht.000@foa.dk>
- Files: mg.c t/op/taint.t
-
- Title: "[PATCH] (NEXT|OPEN)STEP hints"
- From: Gerd Knops <gerti@BITart.com>
- Files: hints/next_3.sh hints/next_4.sh
-
- Title: "win32: user defined shell"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199705291339.JAA21682@aatma.engin.umich.edu>
- Files: pod/perlrun.pod win32/win32.c
-
- Title: "misc perl5.004 doc fixes, especially vms"
- From: lvirden@cas.org (Larry W. Virden)
- Msg-ID: <199705160419.AAA16317@cas.org>
- Files: pod/perlfaq4.pod vms/perlvms.pod lib/Pod/Html.pm pod/roffitall
- vms/ext/DCLsym/DCLsym.pm vms/ext/Stdio/Stdio.pm
-
- Title: "[PATCH] gen_shrfls.pl too picky for Dec C 5.6 preprocessor output"
- From: Dan Sugalski <sugalsd@lbcc.cc.or.us>
- Files: vms/gen_shrfls.pl
-
- Title: "[PATCH] win32: Configure cf_email"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199705301335.JAA05079@aatma.engin.umich.edu>
- Files: win32/Makefile win32/config.bc win32/config.vc win32/config_sh.PL
- win32/makefile.mk
-
- Title: "[PATCH] README.win32 nits"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Files: README.win32
-
- Title: "Document cause and remedy for op/taint.t failure"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Files: README.win32
-
- Title: "SVR4 hints for DDE SMES Supermax Enterprise Server"
- From: Jarkko Hietaniemi <jhi@iki.fi>
- Files: hints/svr4.sh
-
- Title: "porting.help"
- From: Tim Bunce
- Files: Porting/pumpkin.pod Porting/preprel
-
- Title: "Major 5.004 Win32 update (Borland win32 support, and other patches)",
- "($a,undef,$b) = qw(a b c) and ties delaying DESTROY fixes"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Files: MANIFEST pod/perlguts.pod win32/include/sys/socket.h EXTERN.h
- opcode.h perl.h regcomp.h ext/Fcntl/Fcntl.pm
- ext/SDBM_File/Makefile.PL lib/ExtUtils/Install.pm
- lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_Win32.pm
- lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm
- lib/File/DosGlob.pm t/op/mkdir.t t/op/stat.t win32/win32.h
- win32/win32io.h win32/win32iop.h README.win32 doio.c gv.c
- mg.c op.c perlio.c pp.c pp_ctl.c pp_hot.c pp_sys.c util.c
- win32/Makefile win32/config.bc win32/config.vc
- win32/config_H.bc win32/config_H.vc win32/makedef.pl
- win32/makefile.mk win32/makeperldef.pl win32/perlglob.c
- win32/perllib.c win32/win32.c win32/win32io.c
- win32/win32sck.c
-
- Title: "[PATCH] Re: Maintenance release (remove PERL_DUMMY_SIZE)"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Files: opcode.h perl.h regcomp.h win32/win32.h gv.c
-
- Title: "[PATCH] ENV leaks on win32 (was Re: Comments on ENV patch sought)"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Files: win32/win32.h win32/win32io.h win32/win32iop.h global.sym mg.c perl.c
- t/op/magic.t util.c win32/makedef.pl win32/win32.c
- win32/win32io.c
-
- Title: "[PATCH] win32: ExtUtils::Liblist support"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Files: lib/ExtUtils/Liblist.pm win32/Makefile win32/config.bc
- win32/makefile.mk
-
- Title: "[PATCH] Re: borland C++Perl embedding failures re __declspec()"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Files: win32/win32.c
-
- Title: "No need to use `pwd` in t/op/magic.t test for amigaos"
- From: Norbert Pueschel <pueschel@imsdd.meb.uni-bonn.de>
- Files: t/op/magic.t
-
- TESTS
-
- Title: "Tests depend on locale"
- From: "Jan D." <jan.djarv@mbox200.swipnet.se>, Jarkko Hietaniemi
- <jhi@iki.fi>
- Msg-ID: <199705191127.NAA08148@ostrich.gaia.swipnet.se>,
- <199705191230.PAA21070@alpha.hut.fi>
- Files: t/lib/safe2.t t/op/mkdir.t
-
- Title: "op/groups test fails on Linux (groups in /bin)"
- From: "Jan D." <jan.djarv@mbox200.swipnet.se>
- Msg-ID: <199705191120.NAA08130@ostrich.gaia.swipnet.se>
- Files: t/op/groups.t
-
- Title: "More simple regexp tests and test docs"
- From: Hans Mulder <hansm@euronet.nl>
- Files: t/op/re_tests t/op/regexp.t
-
- Title: "[PATCH] Re: Using undef to ignore values returned from split"
- From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
- Files: t/op/split.t
-
- UTILITIES
-
- Title: "bad test of -A flag in h2xs"
- From: "Jeffrey S. Haemer" <jsh@woodcock.boulder.qms.com>
- Files: utils/h2xs.PL
-
- Title: "[PATCH] h2xs missing from utils/Makefile"
- From: hansm@euronet.nl
- Files: utils/Makefile
-
- Title: "PATCH: bug in perlbug w.r.t. environment variables", "bug in perlbug
- w.r.t. environment variables"
- From: "Jan D." <jan.djarv@mbox200.swipnet.se>, Jarkko Hietaniemi
- <jhi@iki.fi>
- Msg-ID: <199705191841.UAA00969@ostrich.gaia.swipnet.se>,
- <199705191857.VAA09154@alpha.hut.fi>
- Files: utils/perlbug.PL
-
- Title: "[PATCH] final newline missing in MANIFEST generated by h2xs"
- From: hansm@euronet.nl
- Files: utils/h2xs.PL
-
+____________________________________________________________________________
+[ 1669] By: gsar on 1998/07/26 23:19:02
+ Log: update Changes; add sv_*_mg() entries in win32/GenCAPI.pl
+ Branch: maint-5.005/perl
+ ! Changes proto.h win32/GenCAPI.pl
+____________________________________________________________________________
+[ 1668] By: gsar on 1998/07/26 21:12:11
+ Log: s/TMP_CRLF_PATCH/PERL_STRICT_CR/ with sense reversed, so they
+ can disable it from config.sh if they want; up patchlevel to 5_01;
+ little tweaks to pods
+ Branch: maint-5.005/perl
+ ! README.win32 patchlevel.h pod/perldelta.pod toke.c
+ ! win32/Makefile win32/config_H.bc win32/config_H.gc
+ ! win32/config_H.vc win32/makefile.mk win32/win32.c
+____________________________________________________________________________
+[ 1662] By: gsar on 1998/07/26 05:01:52
+ Log: add missing sv_*_mg() prototypes in proto.h, update perlhist.pod
+ Branch: maint-5.005/perl
+ ! pod/perlhist.pod proto.h
+____________________________________________________________________________
+[ 1658] By: gsar on 1998/07/26 02:23:46
+ Log: VMS patches from Dan Sugalski <sugalskd@osshe.edu>
+ Date: Fri, 24 Jul 1998 11:38:25 -0700
+ Message-Id: <3.0.5.32.19980724113825.00a067b0@ous.edu>
+ Subject: [PATCH 5.005] version number problem with VMS (Corrected)
+ --
+ Date: Fri, 24 Jul 1998 12:30:36 -0700
+ Message-Id: <3.0.5.32.19980724123036.009f0390@ous.edu>
+ Subject: [PATCH 5.005]Tweaks to README.vms
+ --
+ Date: Sat, 25 Jul 1998 17:56:55 -0700 (PDT)
+ Message-ID: <Pine.GSO.3.96.980725175626.15740D-100000@netserve.ous.edu>
+ Subject: [PATCH 5.005] Final build cleanup patch
+ Branch: maint-5.005/perl
+ ! README.vms vms/descrip_mms.template vms/subconfigure.com
+____________________________________________________________________________
+[ 1657] By: gsar on 1998/07/26 02:19:50
+ Log: another platform where pp_sselect() needs a whole fd_set buffer
+ From: Lupe Christoph <lupe@alanya.m.isar.de>
+ Date: Sat, 25 Jul 1998 19:49:33 +0200 (MET DST)
+ Message-Id: <199807251749.TAA22347@alanya.m.isar.de>
+ Subject: Patch for Not OK: perl 5.005 on i86pc-solaris-thread 2.6
+ Branch: maint-5.005/perl
+ ! pp_sys.c
+____________________________________________________________________________
+[ 1656] By: gsar on 1998/07/26 02:12:46
+ Log: fix problem building modules on dos-djgpp
+ From: Laszlo Molnar <molnarl@cdata.tvnet.hu>
+ Date: Sat, 25 Jul 1998 00:53:39 +0200
+ Message-ID: <19980725005339.C222@cdata.tvnet.hu>
+ Subject: [PATCH 5.005] dos-djgpp and modules problem
+ Branch: maint-5.005/perl
+ ! djgpp/fixpmain
+____________________________________________________________________________
+[ 1655] By: gsar on 1998/07/26 02:11:09
+ Log: From: Tom Spindler <dogcow@home.merit.edu>
+ Date: Wed, 22 Jul 1998 16:11:07 -0400
+ Message-ID: <19980722161107.A16813@home.merit.edu>
+ Subject: [PATCH 5.005] BeOS tweak
+ Branch: maint-5.005/perl
+ ! hints/beos.sh
+____________________________________________________________________________
+[ 1654] By: gsar on 1998/07/26 02:09:29
+ Log: various pod tweaks
+ Branch: maint-5.005/perl
+ ! Changes pod/perldelta.pod pod/perlmodinstall.pod
+ ! pod/perltoc.pod
+____________________________________________________________________________
+[ 1653] By: gsar on 1998/07/26 02:05:46
+ Log: fix emacs/ptags for PL_* changes
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Fri, 24 Jul 1998 03:12:35 -0400 (EDT)
+ Message-Id: <199807240712.DAA04204@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_76] Yet better ptags
+ Branch: maint-5.005/perl
+ ! emacs/ptags
+____________________________________________________________________________
+[ 1652] By: gsar on 1998/07/26 02:03:01
+ Log: fix behavior of <=> on bigints
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Message-Id: <E0yzlfF-0004kz-00@taurus.cus.cam.ac.uk>
+ Date: Fri, 24 Jul 1998 18:29:53 +0100
+ Subject: [PATCH] Re: Math::BigInt <=> op is not correct.
+ Branch: maint-5.005/perl
+ ! lib/Math/BigInt.pm t/lib/bigintpm.t
+____________________________________________________________________________
+[ 1649] By: gsar on 1998/07/24 03:56:56
+ Log: create maint-5.005 branch
+ Branch: maint-5.005/perl
+ +> (branch 1079 files)
+____________________________________________________________________________
+[ 1648] By: gsar on 1998/07/24 03:36:35
+ Log: un-checked-in 5.005 Changes (this is 5.005 *exactly*)
+ Branch: perl
+ ! Changes
-------------
-Version 5.004
+Version 5.005 Production release
-------------
-"Hey, Rocky! Watch me pull a release out of my hat!"
-"Aww, that trick never works..."
-
- CORE LANGUAGE CHANGES
-
- Title: "Make C<m//g> reset pos on failure; make C<m//gc> not reset"
- From: Chip Salzenberg
- Files: dump.c op.c op.h pod/perldelta.pod pod/perlfaq6.pod
- pod/perlop.pod pod/perlre.pod pp_ctl.c pp_hot.c regcomp.c
- t/op/pat.t toke.c
-
- Title: "SECURITY: Forbid exec() if $ENV{BASH_ENV} is tainted"
- From: Chip Salzenberg
- Files: pod/perldelta.pod pod/perlrun.pod pod/perlsec.pod t/op/taint.t
- taint.c
-
- Title: "Allow exec() if $ENV{TERM} is tainted but innocuous"
- From: Chip Salzenberg
- Files: pod/perldelta.pod pod/perlrun.pod pod/perlsec.pod t/op/taint.t
- taint.c
-
- Title: "Allow globbing when tainted under VMS (no external program)"
- From: Chip Salzenberg
- Files: pp_sys.c t/op/taint.t
-
- CORE PORTABILITY
-
- Title: "Make Irix hints adapt when n32 libm.so is missing"
- From: Chip Salzenberg
- Files: hints/irix_6.sh
-
- Title: "Fix default HP-UX installation path"
- From: Jeff Okamoto
- Msg-ID: <199705132228.AA227042483@hpcc123.corp.hp.com>
- Date: Tue, 13 May 1997 15:28:04 -0700
- Files: hints/hpux.sh
-
- Title: "VMS update, including socket support (four patches)"
- From: Jonathan Hudson <Jonathan.Hudson@jrhudson.demon.co.uk>,
- Peter Prymmer <pvhp@forte.com>,
- Dan Sugalski <sugalsd@lbcc.cc.or.us>
- Files: vms/config.vms vms/descrip.mms vms/sockadapt.h vms/vms.c
- vms/vmsish.h
-
- Title: "Win32 update (three patches)"
- From: Gurusamy Sarathy
- Files: README.win32 perl.c win32/Makefile win32/config.H
- win32/config_h.PL win32/config_sh.PL win32/makedef.pl
- win32/win32.c win32/win32.h win32/win32io.c win32/win32io.h
- win32/win32iop.h
-
- Title: "Don't require executable bit on perl -S if DOSISH"
- From: Danny Sadinoff <sadinoff@olf.com>
- Msg-ID: <337351CE.79B28DE3@olf.com>
- Date: Fri, 09 May 1997 12:33:18 -0400
- Files: perl.c
-
- OTHER CORE CHANGES
-
- Title: "In C<eval &func>, always call &func in scalar context"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Fix recursive substitution"
- From: Chip Salzenberg; test from Tim Bunce
- Files: cop.h global.sym pp_ctl.c proto.h scope.c t/op/subst.t
-
- Title: "Make read with <> from a TTY notice EOF"
- From: Jonathan I. Kamens <jik@kamens.brookline.ma.us>
- Msg-ID: <199705121147.HAA03845@jik.saturn.net>
- Date: Mon, 12 May 1997 07:47:13 -0400
- Files: sv.c
-
- Title: "Fix core dump from get*() functions returning no alias array"
- From: Chip Salzenberg
- Files: pp_sys.c
-
- Title: "Fix typo"
- From: Mark K Trettin <mkt@lucent.com>
- Msg-ID: <199705102228.RAA11163@gv18c.ih.lucent.com>
- Date: Sat, 10 May 1997 17:28:35 -0500
- Files: pp_sys.c
-
- BUILD PROCESS
-
- Title: "Don't use 'unset' in Configure"
- From: Chip Salzenberg
- Files: Configure
-
- Title: "Protect against having no such command as 'cc'"
- From: Hans Mulder <hansm@icgned.nl>
- Msg-ID: <1997May12.163534.2006434@hmivax.humgen.upenn.edu>
- Date: Mon, 12 May 1997 16:35:34 -0400 (EDT)
- Files: Configure
-
- Title: "minor wording enhancement for Configure"
- From: Jarkko Hietaniemi
- Msg-ID: <199705101038.NAA00471@alpha.hut.fi>
- Date: Sat, 10 May 1997 13:38:31 +0300 (EET DST)
- Files: Configure
-
- LIBRARY AND EXTENSIONS
-
- Title: "Refresh CGI.pm to 2.36"
- From: Lincoln Stein <lstein@genome.wi.mit.edu>
- Files: eg/cgi/frameset.cgi eg/cgi/javascript.cgi lib/CGI.pm
-
- Title: "In IO::File::open, prepend './' less often (for Win32 et al)"
- From: Chip Salzenberg
- Files: ext/IO/lib/IO/File.pm
-
- Title: "Fix core dump on IO::Seekable::setpos($fh, undef)"
- From: Chip Salzenberg
- Files: ext/IO/IO.xs t/lib/io_xs.t
-
- TESTS
-
- Title: "Make rand.t vanishingly unlikely to give false failure"
- From: Tom Phoenix
- Msg-ID: <Pine.GSO.3.96.970510190846.23340K-100000@kelly.teleport.com>
- Date: Sat, 10 May 1997 19:57:30 -0700 (PDT)
- Files: t/op/rand.t
-
- Title: "Fix sleep test: sleep(N) is defined to allow sleeping N-1"
- From: Chuck D. Phillips <cdp@hpescdp.fc.hp.com>
- Msg-ID: <199705151735.KAA01143@palrel1.hp.com>
- Date: Thu, 15 May 1997 11:35:41 -0600
- Files: t/op/sleep.t
-
- UTILITIES
-
- Title: "h2xs and @EXPORT_OK"
- From: Jeff Okamoto
- Msg-ID: <199705092348.AA057881699@hpcc123.corp.hp.com>
- Date: Fri, 9 May 1997 16:48:20 -0700
- Files: utils/h2xs.PL
-
- DOCUMENTATION
-
- Title: "Tweaks for perldelta"
- From: hansm@euronet.nl
- Msg-ID: <199705102346.BAA17300@mail.euronet.nl>
- Date: Sun, 11 May 97 01:46:00 +0200
- Files: pod/perldelta.pod
-
- Title: "Mention perlfaq.pod and perlmodlib.pod in perldelta.pod"
- From: Chip Salzenberg
- Files: pod/perldelta.pod
-
- Title: "Fix example of use of lexicals with formats"
- From: Chip Salzenberg
- Files: pod/perldelta.pod
-
- Title: "Explain that destruction order is not defined"
- From: Gurusamy Sarathy <gsar@engin.umich.edu>
- Msg-ID: <199705150600.CAA13550@aatma.engin.umich.edu>
- Date: Thu, 15 May 1997 02:00:23 -0400
- Files: pod/perltoot.pod
-
- Title: "Note that DATA filehandle is unavailable during BEGIN {}"
- From: neilb@cre.canon.co.uk (Neil Bowers)
- Msg-ID: <199705121227.NAA29718@tardis.cre.canon.co.uk>
- Date: Mon, 12 May 1997 13:27:43 +0100
- Files: pod/perldata.pod
-
- Title: "More detailed IO::Socket documentation"
- From: Tom Christiansen
- Msg-ID: <199705141456.IAA19061@jhereg.perl.com>
- Date: Wed, 14 May 1997 08:56:30 -0600
- Files: pod/perlipc.pod
-
-
------------------
-Version 5.003_99a
------------------
-
-Herein we find the fruits of the gamma.
-
- CORE LANGUAGE CHANGES
-
- Title: "SECURITY: Forbid glob() when tainting (-T or setuid)"
- From: Chip Salzenberg
- Files: pod/perlrun.pod pod/perlsec.pod pp_sys.c
-
- Title: "SECURITY: Forbid exec() if $ENV{TERM} or $ENV{ENV} is tainted"
- From: Chip Salzenberg
- Files: pod/perlrun.pod pod/perlsec.pod t/op/taint.t taint.c
-
- CORE PORTABILITY
-
- Title: "(NeXT|Open)Step update"
- From: Gerd Knops <gerti@BITart.com>
- Msg-ID: <9705072247.AA18882@BITart.com>
- Date: Wed, 7 May 97 17:47:02 -0500
- Files: Configure MANIFEST config_h.SH hints/next_3.sh hints/next_4.sh
-
- Title: "NetBSD hint update"
- From: Giles Lean <giles@nemeton.com.au>
- Msg-ID: <199705051346.XAA13584@topaz.nemeton.com.au>
- Date: Mon, 5 May 1997 23:46:37 +1000 (EST)
- Files: hints/netbsd.sh
-
- Title: "Irix hint update"
- From: Scott Henry <scotth@sgi.com>
- Msg-ID: <yd83es0fp57.fsf@hoshi.engr.sgi.com>
- Date: 06 May 1997 11:09:56 -0700
- Files: hints/irix_6.sh
-
- Title: "HPUX: patch for ext/DynaLoader/dl_hpux.xs"
- From: Chuck D. Phillips <cdp@hpescdp.fc.hp.com>
- Msg-ID: <199705050548.WAA21260@palrel1.hp.com>
- Date: Sun, 4 May 1997 23:48:39 -0600
- Files: ext/DynaLoader/dl_hpux.xs
-
- Title: "Win32 update (consolidated patch plus three followups)"
- From: Gurusamy Sarathy
- Files: EXTERN.h README.win32 lib/Sys/Hostname.pm pod/perldelta.pod
- win32/config.H win32/config.w32 win32/config_sh.PL win32/perllib.c
- win32/win32.c win32/win32.h win32/include/sys/socket.h
-
- Title: "Win32 boot_DynaLoader problem in 99"
- From: Gary Clark <GaryC@mail.jeld-wen.com>
- Msg-ID: <1997May05.105000.1708.84476@mail.jeld-wen.com>
- Date: Mon, 05 May 1997 10:49:03 -0700
- Files: win32/makedef.pl
-
- OTHER CORE CHANGES
-
- Title: "Fix wantarray() in sort subs [fixes metaconfig]"
- From: Chip Salzenberg
- Files: pp_ctl.c
-
- Title: "Fix for redefined sort subs nastiness"
- From: Gurusamy Sarathy
- Msg-ID: <199705090004.UAA15032@aatma.engin.umich.edu>
- Date: Thu, 08 May 1997 20:04:18 -0400
- Files: op.c pod/perldelta.pod pod/perldiag.pod sv.c t/op/sort.t
-
- BUILD PROCESS
-
- Title: "AFS patches"
- From: Chip Salzenberg, Larry Schwimmer <rosebud@cyclone.Stanford.EDU>
- Files: Configure installperl
-
- LIBRARY AND EXTENSIONS
-
- Title: "Another blank line patch to Pod::Text"
- From: Russ Allbery <rra@stanford.edu>
- Msg-ID: <m3afm5g6ar.fsf@windlord.Stanford.EDU>
- Date: 08 May 1997 11:36:12 -0700
- Files: lib/Pod/Text.pm
-
- TESTS
-
- (no other changes)
-
- UTILITIES
-
- Title: "Three bugs in pod2html"
- From: hansm@euronet.nl
- Msg-ID: <199705052228.AAA25351@mail.euronet.nl>
- Date: Tue, 6 May 97 00:28:06 +0200
- Files: lib/Pod/Html.pm
-
- Title: "Trivial bugfix for pod of xsubpp"
- From: Ralf S. Engelschall <rse@engelschall.com>
- Msg-ID: <199705051447.QAA09995@en1.engelschall.com>
- Date: Mon, 5 May 1997 16:47:03 +0200
- Files: lib/ExtUtils/xsubpp
-
- Title: "Newer CPerl mode"
- From: Ilya Zakharevich
- Msg-ID: <199705080032.UAA22532@monk.mps.ohio-state.edu>
- Date: Wed, 7 May 1997 20:32:46 -0400 (EDT)
- Files: emacs/cperl-mode.el
-
- DOCUMENTATION
-
- Title: "Updates to perldelta"
- From: Chip Salzenberg and Dominic Dunlop
- Files: pod/perldelta.pod
-
- Title: "More explicit Solaris instructions"
- From: Andy Dougherty
- Msg-ID: <Pine.SOL.3.95q.970508171206.438A-100000@fractal.lafayette.ed
- Date: Thu, 08 May 1997 17:14:54 -0400 (EDT)
- Files: INSTALL hints/solaris_2.sh
-
- Title: "Document 'Possible attempt to separate words with commas'"
- From: Gisle Aas
- Msg-ID: <hyb9snvdw.fsf@bergen.sn.no>
- Date: 06 May 1997 23:27:55 +0200
- Files: pod/perlop.pod
-
- Title: "perlfaq9, hostname"
- From: John D Groenveld <groenvel@cse.psu.edu>
- Msg-ID: <199705061741.NAA22777@cse.psu.edu>
- Date: Tue, 06 May 1997 13:41:12 EDT
- Files: pod/perlfaq9.pod
-
- Title: "Debugger docs patch"
- From: Ilya Zakharevich
- Msg-ID: <199705080107.VAA24317@monk.mps.ohio-state.edu>
- Date: Wed, 7 May 1997 21:07:14 -0400 (EDT)
- Files: pod/perldebug.pod
-
- Title: "Document that C<m?x?> is just like C<?x?>"
- From: Chip Salzenberg
- Files: pod/perlop.pod
-
- Title: "Refresh description of sprintf()"
- From: Chip Salzenberg
- Files: pod/perl.pod pod/perlfunc.pod
-
- Title: "Mention the Regular Expressions book"
- From: Stephen Potter <spp@psa.pencom.com>
- Msg-ID: <199705071737.MAA18799@psa.pencom.com>
- Date: Wed, 07 May 1997 12:37:37 -0500
- Files: pod/perlbook.pod pod/perlre.pod
-
- Title: "OS/2 doc patch for _99"
- From: Ilya Zakharevich
- Msg-ID: <199705080046.UAA23466@monk.mps.ohio-state.edu>
- Date: Wed, 7 May 1997 20:46:45 -0400 (EDT)
- Files: README.os2
-
-
-----------------
-Version 5.003_99
-----------------
-
-"Oops." Now this _has_ to be the gamma; we're out of numbers.
-
- CORE LANGUAGE CHANGES
-
- (no changes)
-
- CORE PORTABILITY
-
- Title: "NeXT hints update"
- From: hansm@euronet.nl
- Msg-ID: <199704302229.AAA02690@mail.euronet.nl>
- Date: Thu, 1 May 97 00:28:41 +0200
- Files: Configure Makefile.SH hints/next_4.sh
-
- Title: "Support shared libperl on AIX"
- From: Eric Bartley <bartley@icd.cc.purdue.edu>
- Msg-ID: <199704270131.UAA51426@icd.cc.purdue.edu>
- Date: Sat, 26 Apr 1997 20:31:37 -0500
- Files: Configure Makefile.SH hints/aix.sh
-
- OTHER CORE CHANGES
-
- Title: "Fix NUL-termination bug in delimcpy()"
- From: Chip Salzenberg
- Files: util.c
-
- Title: "Forget prototype of subroutine after C<undef &subr>"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Handle tainted values in lists returned from subs, evals"
- From: Chip Salzenberg
- Files: pp_ctl.c pp_hot.c t/op/taint.t
-
- Title: "Fix sysread() on tied handle"
- From: Spider Boardman
- Msg-ID: <199705010601.CAA04926@Orb.Nashua.NH.US>
- Date: Thu, 1 May 1997 02:01:20 -0400
- Files: pp_sys.c
-
- Title: "Fix OS/2-specific buffer overflow"
- From: Ilya Zakharevich
- Msg-ID: <199704301920.PAA09681@monk.mps.ohio-state.edu>
- Date: Wed, 30 Apr 1997 15:20:01 -0400 (EDT)
- Files: os2/os2.c
-
- BUILD PROCESS
-
- Title: "Add new globals to perl.exp"
- From: Chip Salzenberg
- Files: perl_exp.SH
-
- LIBRARY AND EXTENSIONS
-
- Title: "Refresh DB_File to 1.14"
- From: Paul Marquess
- Msg-ID: <9704302045.AA05484@claudius.bfsec.bt.co.uk>
- Date: Wed, 30 Apr 1997 21:45:09 +0100 (BST)
- Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs t/lib/db-btree.t
- t/lib/db-hash.t t/lib/db-recno.t
-
- TESTS
-
- Title: "Disable op/pipe.t test under Machten"
- From: Dominic Dunlop <domo@slipper.ip.lu>
- Msg-ID: <v03102801af8e160d3879@[194.51.248.68]>
- Date: Thu, 1 May 1997 12:48:26 +0200
- Files: t/io/pipe.t
-
- UTILITIES
-
- Title: "typo fixes to installhtml"
- From: lvirden@cas.org (Larry W. Virden)
- Msg-ID: <199705011114.HAA26968@cas.org>
- Date: Thu, 1 May 1997 07:14:31 -0400
- Files: installhtml
-
- DOCUMENTATION
-
- Title: "Fix description of av_undef() in perlguts"
- From: Gisle Aas
- Msg-ID: <199705011042.MAA09897@bergen.sn.no>
- Date: Thu, 1 May 1997 12:42:46 +0200
- Files: pod/perlguts.pod
-
- Title: "Fix typo in perldelta"
- From: Chip Salzenberg
- Files: pod/perldelta.pod
-
-
-----------------
-Version 5.003_98
-----------------
-
-Here it is, the second public beta (a.k.a gamma).
-
- CORE LANGUAGE CHANGES
-
- Title: "Support C< $coderef->($x,$y) >"
- From: Chip Salzenberg
- Files: perly.c perly.c.diff perly.y pod/perldelta.pod pod/perldsc.pod
- pod/perlref.pod t/op/ref.t vms/perly_c.vms
-
- CORE PORTABILITY
-
- (no changes)
-
- OTHER CORE CHANGES
-
- Title: "Fix C< hex('80') * 0x1000000 >"
- From: Chip Salzenberg
- Files: opcode.pl
-
- Title: "Reset errno after failed piped close"
- From: Roderick Schertler
- Msg-ID: <28152.862264940@eeyore.ibcinc.com>
- Date: Mon, 28 Apr 1997 18:02:20 -0400
- Files: lib/Time/gmtime.pm lib/Time/localtime.pm pod/perlfunc.pod
- t/io/pipe.t util.c
-
- Title: "Fix warning wrt return value of PerlIO_getname()"
- From: Spider Boardman
- Msg-ID: <199704300448.AAA24174@Orb.Nashua.NH.US>
- Date: Wed, 30 Apr 1997 00:48:13 -0400
- Files: perlio.c
-
- BUILD PROCESS
-
- (no changes)
-
- LIBRARY AND EXTENSIONS
-
- (no changes)
-
- TESTS
-
- (no other changes)
-
- UTILITIES
-
- (no changes)
-
- DOCUMENTATION
-
- Title: "Describe Math::Trig in perlmodlib"
- From: Chip Salzenberg
- Files: pod/perlmodlib.pod
-
- Title: "Add new diagnostics to perldelta"
- From: Chip Salzenberg
- Files: pod/perldelta.pod pod/perldiag.pod
-
-
------------------
-Version 5.003_97j
------------------
-
-This patch should be _98, unless it's egregiously broken somehow.
-
- CORE LANGUAGE CHANGES
-
- (no changes)
-
- CORE PORTABILITY
-
- Title: "Return to favoring memset(,0,) over bzero()"
- From: Chip Salzenberg
- Files: perl.h
-
- Title: "NetBSD hint update"
- From: matthew green <mrg@splode.eterna.com.au>
- Msg-ID: <199704251021.EAA22570@jhereg.perl.com>
- Date: Fri, 25 Apr 1997 20:18:02 +1000
- Files: hints/netbsd.sh
-
- Title: "HP-UX hint update"
- From: Chuck D. Phillips <cdp@hpescdp.fc.hp.com>
- Msg-ID: <199704280535.WAA22441@palrel1.hp.com>
- Date: Sun, 27 Apr 1997 23:35:07 -0600
- Files: hints/hpux.sh
-
- Title: "Win32 update (three patches)"
- From: Gurusamy Sarathy and Nick Ing-Simmons
- Files: win32/makedef.pl win32/perllib.c win32/win32.c
-
- OTHER CORE CHANGES
-
- Title: "Update sprintf: '%hn'; '%s',NULL; panic on frexp() failure"
- From: Chip Salzenberg
- Files: perl.h pod/perldiag.pod sv.c
-
- Title: "Fix lingering '%S' in XS_VERSION_BOOTCHECK"
- From: Chip Salzenberg
- Files: XSUB.h
-
- Title: "Eliminate Alpha warnings"
- From: Hallvard B Furuseth and Chip Salzenberg
- Files: perlsdio.h pp_sys.c
-
- Title: "Fix typo in NeXT dynaloader"
- From: Chip Salzenberg
- Files: ext/DynaLoader/dl_next.xs
-
- Title: "Fix possible buffer overflow under VMS"
- From: Chip Salzenberg
- Files: taint.c
-
- BUILD PROCESS
-
- (no changes)
-
- LIBRARY AND EXTENSIONS
-
- Title: "Refresh CGI.pm to 2.35"
- From: Lincoln Stein <lstein@genome.wi.mit.edu>
- Files: lib/CGI.pm
-
- Title: "Refresh DB_File to 1.13"
- From: Paul Marquess
- Msg-ID: <9704271413.AA08876@claudius.bfsec.bt.co.uk>
- Date: Sun, 27 Apr 1997 15:12:59 +0100 (BST)
- Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs
-
- Title: "SelfLoader: fix prototype pattern, rename intrusive lexical"
- From: Jesse Glick <jesse@ginger> and Chip Salzenberg
- Files: lib/SelfLoader.pm
-
- TESTS
-
- (no changes)
-
- UTILITIES
-
- (no changes)
-
- DOCUMENTATION
-
- Title: "Split perlmod"
- From: Tom Christiansen
- Msg-ID: <199704260050.RAA02468@toy.perl.com>
- Date: Fri, 25 Apr 1997 20:50:09 -0400
- Files: MANIFEST pod/Makefile pod/buildtoc pod/perl.pod
- pod/perldsc.pod pod/perlfaq3.pod pod/perlipc.pod
- pod/perlmod.pod pod/perlmodlib.pod pod/perlobj.pod
- pod/perltie.pod pod/roffitall
-
- Title: "Describe __PACKAGE__ in perldelta"
- From: Chip Salzenberg
- Files: pod/perldelta.pod
-
- Title: "Doc fix for close of pipe handle"
- From: Chip Salzenberg
- Files: pod/perlfunc.pod
-
-
------------------
-Version 5.003_97i
------------------
-
-This patch eliminates all known sources of buffer overflow! (And the
-crowd goes wild. (Yeah.)) Showstoppers only between here and _98.
-
- CORE LANGUAGE CHANGES
-
- (no changes)
-
- CORE PORTABILITY
-
- Title: "Provide memset() if it's missing"
- From: Chip Salzenberg
- Files: global.sym perl.h proto.h util.c
-
- Title: "Don't tell GCC that warn(), croak(), and die() are printf-lik
- From: Chip Salzenberg
- Files: proto.h
-
- OTHER CORE CHANGES
-
- Title: "Misc. sv_vcatpvfn() fixes"
- From: Hugo, Dale, Nick, Hallvard, Chip
- Files: gv.c mg.c op.c perl.c pp.c pp_ctl.c sv.c toke.c util.c
-
- Title: "Enforce order of sprintf() elements"
- From: Chip Salzenberg
- Files: sv.c
-
- Title: "Guard against long numbers, <<LONG_DELIM, and <long glob>"
- From: Chip Salzenberg
- Files: global.sym mg.c perl.c pod/perldiag.pod proto.h toke.c util.c
-
- Title: "Guard against C<goto> to deeply nested label"
- From: Chip Salzenberg
- Files: pod/perldiag.pod pp_ctl.c
-
- Title: "Guard against overflow in dup2() emulation"
- From: Chip Salzenberg
- Files: util.c
-
- Title: "Win32: Guard against long function names"
- From: Chip Salzenberg
- Files: win32/win32sck.c
-
- Title: "Make mess() always work, by using a non-arena SV"
- From: Chip Salzenberg, from idea by Gurusamy Sarathy
- Files: perl.c util.c
-
- Title: "Fix scalar leak in pp_prtf()"
- From: Doug MacEachern
- Msg-ID: <199704241706.NAA19140@postman.osf.org>
- Date: Thu, 24 Apr 1997 13:06:21 -0400
- Files: pp_sys.c
-
- Title: "When copying a format line, take only its string value"
- From: Chip Salzenberg
- Files: sv.c
-
- Title: "Undo private patch"
- From: Chip Salzenberg
- Files: installperl lib/ExtUtils/Install.pm
-
- Title: "Fix LEAKTEST numbers"
- From: Chip Salzenberg
- Files: ext/DynaLoader/dl_vms.xs handy.h os2/os2.c util.c vms/vms.c
- win32/win32.c win32/win32sck.c
-
- BUILD PROCESS
-
- Title: "Cope with a <db.h> that isn't related to DB"
- From: Jarkko Hietaniemi
- Msg-ID: <199704241728.UAA09951@alpha.hut.fi>
- Date: Thu, 24 Apr 1997 20:28:39 +0300 (EET DST)
- Files: Configure
-
- LIBRARY AND EXTENSIONS
-
- Title: "Always NUL-terminate opsets"
- From: Chip Salzenberg
- Files: ext/Opcode/Opcode.xs
-
- Title: "Don't core dump if my_inet_aton() get a NULL"
- From: Chip Salzenberg
- Files: ext/Socket/Socket.xs
-
- Title: "Handle symlinks, high permission bits in File::Path"
- From: Chip Salzenberg
- Files: lib/File/Path.pm
-
- Title: "Math::{Complex,Trig} update"
- From: Jarkko Hietaniemi
- Msg-ID: <199704242221.BAA30363@alpha.hut.fi>
- Date: Fri, 25 Apr 1997 01:21:44 +0300 (EET DST)
- Files: lib/Math/Complex.pm lib/Math/Trig.pm pod/roffitall
- t/lib/complex.t t/lib/trig.t
-
- TESTS
-
- (no other changes)
-
- UTILITIES
-
- Title: "Fix buffer overflow in a2p"
- From: Chip Salzenberg
- Files: x2p/a2py.c
-
- DOCUMENTATION
-
- Title: "FAQ udpate (24-apr-97)"
- From: Nathan Torkington <gnat@prometheus.frii.com>
- Msg-ID: <199704242247.QAA07010@prometheus.frii.com>
- Date: Thu, 24 Apr 1997 16:47:23 -0600 (MDT)
- Files: pod/perlfaq*.pod
-
- Title: "Document new {,s}printf() behavior"
- From: Chip Salzenberg
- Files: pod/perldelta.pod pod/perlfunc.pod
-
-
------------------
-Version 5.003_97h
------------------
-
-This patch eliminates almost all possible sources of buffer overflow;
-in particular, there are no more sprintf() bugs. (!!) This patch
-also has a few other fixes. With these changes in place, I can sleep
-at night. (Because I've stopped hacking. :-))
-
- CORE LANGUAGE CHANGES
-
- Title: "Support PRINTF for tied handles"
- From: Doug MacEachern
- Msg-ID: <199704202226.SAA08032@postman.osf.org>
- Date: Sun, 20 Apr 1997 18:26:13 -0400
- Files: pod/perldelta.pod pod/perltie.pod pp_sys.c t/op/misc.t
-
- CORE PORTABILITY
-
- Title: "Fix bitwise shifts and pack('w') on Crays"
- From: Chip Salzenberg
- Files: pp.c
-
- Title: "Win32 update (two patches)"
- From: Gurusamy Sarathy
- Files: lib/AutoSplit.pm lib/ExtUtils/MM_Unix.pm win32/config.w32
- win32/makedef.pl
-
- OTHER CORE CHANGES
-
- Title: "Mondo Cool patch for buffer safety and convenience"
- From: Chip Salzenberg
- Files: XSUB.h doop.c dump.c ext/DynaLoader/dl_dlopen.xs
- ext/DynaLoader/dl_hpux.xs ext/DynaLoader/dl_next.xs
- ext/DynaLoader/dlutils.c ext/ODBM_File/ODBM_File.xs
- global.sym gv.c interp.sym mg.c op.c perl.c perl.h
- pod/perlguts.pod pp.c pp_ctl.c pp_hot.c pp_sys.c proto.h
- regcomp.c regexec.c sv.c toke.c util.c
-
- Title: "Problems with glob"
- From: Ilya Zakharevich
- Msg-ID: <1997Apr20.024432.1941365@hmivax.humgen.upenn.edu>
- Date: Sun, 20 Apr 1997 02:44:32 -0400 (EDT)
- Files: op.c
-
- Title: "Fix scalar leak in closures"
- From: Chip Salzenberg
- Files: op.c scope.c
-
- Title: "Refine error messages re: anon subs' prototypes"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Outermost scope is void, not scalar"
- From: Chip Salzenberg
- Files: pp_ctl.c
-
- BUILD PROCESS
-
- Title: "Fix up Linux hints for tcsh, and Configure patch"
- From: Andy Dougherty
- Msg-ID: <Pine.SOL.3.95q.970422101051.2506C-100000@fractal.lafayette.e
- Date: Tue, 22 Apr 1997 11:02:27 -0400 (EDT)
- Files: Configure hints/linux.sh
-
- Title: "There is no standard answer to 'Use suidperl?'"
- From: Chip Salzenberg
- Files: hints/bsdos.sh hints/freebsd.sh hints/linux.sh
- hints/machten_2.sh
-
- LIBRARY AND EXTENSIONS
-
- Title: "Math::Complex update"
- From: Jarkko Hietaniemi
- Files: lib/Math/Complex.pm t/lib/complex.t
-
- Title: "Croak on C<use autouse> without module name"
- From: Chip Salzenberg
- Files: lib/autouse.pm
-
- Title: "Silence warnings on simple C<use ops>"
- From: Roderick Schertler
- Msg-ID: <pzybafum6k.fsf@eeyore.ibcinc.com>
- Date: 19 Apr 1997 10:22:43 -0400
- Files: ext/Opcode/ops.pm
-
- TESTS
-
- Title: "Don't put leading newline on numeric strings"
- From: Andreas Koenig
- Msg-ID: <199704230847.KAA22752@anna.in-berlin.de>
- Date: Wed, 23 Apr 1997 10:47:00 +0200
- Files: t/pragma/constant.t
-
- UTILITIES
-
- (no changes)
-
- DOCUMENTATION
-
- Title: "FAQ udpate (23-apr-97)"
- From: Nathan Torkington <gnat@prometheus.frii.com>
- Msg-ID: <199704231822.MAA05074@prometheus.frii.com>
- Date: Wed, 23 Apr 1997 12:22:55 -0600 (MDT)
- Files: pod/perlfaq*.pod
-
- Title: "Two doublewords less"
- From: Jarkko Hietaniemi
- Msg-ID: <199704201938.WAA07722@alpha.hut.fi>
- Date: Sun, 20 Apr 1997 22:38:13 +0300 (EET DST)
- Files: pod/perlrun.pod vms/perlvms.pod
-
-
------------------
-Version 5.003_97g
------------------
-
-This one has two security bug fixes for buffer overflows. Perl has
-not yet been searched to see if more fixes are needed.
-
- CORE LANGUAGE CHANGES
-
- Title: "Improve sysseek(), remove systell(), fix Opcode"
- From: Chip Salzenberg
- Files: doio.c ext/Opcode/Makefile.PL ext/Opcode/Opcode.pm
- ext/Opcode/Opcode.xs global.sym keywords.pl opcode.pl
- pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod pp_sys.c
- proto.h t/op/sysio.t toke.c
-
- Title: "Fix (and test) spaces in {,un}pack()"
- From: Chip Salzenberg
- Files: pp.c t/op/pack.t
-
- CORE PORTABILITY
-
- Title: "Irix update"
- From: Scott Henry <scotth@sgi.com>
- Msg-ID: <yd8d8rsi0ln.fsf@hoshi.engr.sgi.com>
- Date: 18 Apr 1997 12:37:24 -0700
- Files: MANIFEST hints/irix_6.sh hints/irix_6_0.sh hints/irix_6_1.sh
-
- Title: "ExtUtils/Miniperl.pm not built on Win32"
- From: Nick Ing-Simmons
- Msg-ID: <199704181742.SAA08407@ni-s.u-net.com>
- Date: Fri, 18 Apr 1997 18:42:32 +0100
- Files: win32/Makefile
-
- OTHER CORE CHANGES
-
- Title: "SECURITY FIX: 'Identifier too long'"
- From: Chip Salzenberg
- Files: pod/perldelta.pod pod/perldiag.pod toke.c
-
- Title: "SECURITY FIX: Buffer overflow in gv_fetchfile()"
- From: Chip Salzenberg
- Files: gv.c
-
- Title: "Remove pp_method() inefficiency from last patch"
- From: Chip Salzenberg
- Files: pp_hot.c
-
- BUILD PROCESS
-
- Title: "Fix unnecessary re-linking"
- From: Chip Salzenberg
- Files: lib/ExtUtils/MM_Unix.pm
-
- Title: "Fix tcsh hack in Configure"
- From: Chip Salzenberg
- Files: Configure
-
- Title: "Minor, optional patch to Makefile.SH"
- From: "Randy J. Ray" <rjray@uswest.com>
- Msg-ID: <rjray-9703180132.AA00374040@snakepit.ecte.uswc.uswest.com>
- Date: Thu, 17 Apr 1997 19:32:17 -0600
- Files: Makefile.SH
-
- LIBRARY AND EXTENSIONS
-
- Title: "Patch to Getopt::Long"
- From: Johan Vromans <jvromans@squirrel.nl>
- Msg-ID: <m0wIKCO-00081IC@phoenix.squirrel.nl>
- Date: Fri, 18 Apr 97 22:24 MET DST
- Files: lib/Getopt/Long.pm
-
- Title: "Fix NAME in SDBM_File build"
- From: Chip Salzenberg
- Files: ext/SDBM_File/sdbm/Makefile.PL
-
- TESTS
-
- (no other changes)
-
- UTILITIES
-
- Title: "Make h2ph generate constant subs"
- From: Roderick Schertler
- Msg-ID: <pz2088w5ot.fsf@eeyore.ibcinc.com>
- Date: 18 Apr 1997 14:23:46 -0400
- Files: utils/h2ph.PL
-
- DOCUMENTATION
-
- Title: "Document {,un}pack changes"
- From: Paul Marquess
- Msg-ID: <9704181249.AA11733@claudius.bfsec.bt.co.uk>
- Date: Fri, 18 Apr 97 13:49:39 BST
- Files: pod/perldelta.pod pod/perldiag.pod
-
-
------------------
-Version 5.003_97f
------------------
-
-This is it before _98. No more last-minute features. Really, I mean
-it this time. No kidding.
-
- CORE LANGUAGE CHANGES
-
- Title: "New operator systell()"
- From: Chip Salzenberg
- Files: doio.c ext/Opcode/Opcode.pm keywords.pl opcode.pl
- pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod pp_sys.c
- t/op/sysio.t toke.c
-
- Title: "Allow constant sub to be optimized when called with parens"
- From: Chip Salzenberg
- Files: toke.c
-
- Title: "Make {,un}pack fail on invalid pack types"
- From: Chip Salzenberg
- Files: pod/perldiag.pod pp.c
-
- CORE PORTABILITY
-
- Title: "Fix bitwise ops and {,un}pack() on Cray CPUs"
- From: Chip Salzenberg
- Files: pp.c
-
- Title: "VMS update"
- From: Charles Bailey
- Files: lib/Cwd.pm lib/File/Path.pm lib/FindBin.pm vms/perly_c.vms
- vms/vms.c vms/writemain.pl
-
- Title: "Win32 update (three patches)"
- From: Gurusamy Sarathy and Nick Ing-Simmons
- Files: lib/Cwd.pm lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_Win32.pm
- lib/File/Basename.pm win32/Makefile win32/makedef.pl
- win32/perllib.c win32/win32.c win32/win32iop.h
-
- OTHER CORE CHANGES
-
- Title: "Fix error messages on method lookup failure"
- From: Chip Salzenberg
- Files: pp_hot.c
-
- Title: "Fix use of var before init in util.c"
- From: Gurusamy Sarathy
- Msg-ID: <199704162342.TAA20773@aatma.engin.umich.edu>
- Date: Wed, 16 Apr 1997 19:42:41 -0400
- Files: util.c
-
- BUILD PROCESS
-
- Title: "Linux hints: Allow build w/o suidperl, prefer tcsh to csh"
- From: Michael De La Rue <mikedlr@tardis.ed.ac.uk>
- Files: Configure hints/linux.sh
-
- LIBRARY AND EXTENSIONS
-
- Title: "Fix bug in Opcode when (maxo & 15) > 8"
- From: Chip Salzenberg
- Files: ext/Opcode/Makefile.PL ext/Opcode/Opcode.pm
- ext/Opcode/Opcode.xs
-
- Title: "CGI.pm broke again"
- From: Andreas Koenig
- Msg-ID: <199704171136.NAA24859@anna.in-berlin.de>
- Date: Thu, 17 Apr 1997 13:36:28 +0200
- Files: lib/CGI.pm
-
- Title: "Revise quotewords()"
- From: Shishir Gundavaram <shishir@ruby.ora.com>
- Files: lib/Text/ParseWords.pm
-
- TESTS
-
- (no other changes)
-
- UTILITIES
-
- (no changes)
-
- DOCUMENTATION
-
- Title: "Doc updates: INSTALL-1.13, pumpkin.pod-1.9"
- From: Andy Dougherty
- Files: INSTALL Porting/pumpkin.pod
-
- Title: "Document size restrictions for packed integers"
- From: Jarkko Hietaniemi
- Files: pod/perlfunc.pod
-
-
------------------
-Version 5.003_97e
------------------
-
-Y'know, I've heard of this "beta" thing, but it's been so long since
-I've seen one, I'm not sure it really exists...
-
- CORE LANGUAGE CHANGES
-
- Title: "New operator: sysseek()"
- From: Chip Salzenberg
- Files: doio.c ext/Opcode/Makefile.PL ext/Opcode/Opcode.pm global.sym
- keywords.pl opcode.pl pod/perldelta.pod pod/perlfunc.pod
- pp_sys.c t/op/sysio.t toke.c
-
- Title: "Allow recursive substitution again"
- From: Chip Salzenberg
- Files: pod/perldelta.pod pod/perldiag.pod pp_hot.c
-
- CORE PORTABILITY
-
- Title: "Use size_t for socket size parameters of GNU libc"
- From: Chip Salzenberg
- Files: doio.c pp_sys.c
-
- Title: "Fix STMT_{START,END} under g++"
- From: Steven Parkes <parkes@sierravista.com>
- Msg-ID: <199704141935.MAA11240@monterey.sierravista.com>
- Date: Mon, 14 Apr 1997 12:35:34 -0700
- Files: perl.h
-
- Title: "Win32 update (four patches)"
- From: Gurusamy Sarathy and Nick Ing-Simmons
- Files: MANIFEST README.win32 dosish.h ext/SDBM_File/Makefile.PL
- ext/SDBM_File/sdbm/Makefile.PL ext/SDBM_File/sdbm/sdbm.c
- ext/SDBM_File/sdbm/sdbm.h lib/ExtUtils/MM_Unix.pm perl.c
- utils/perlbug.PL utils/perldoc.PL win32/Makefile win32/TEST
- win32/config.H win32/config.w32 win32/config_h.PL
- win32/config_sh.PL win32/perllib.c win32/runperl.c
- win32/win32.c win32/win32io.c win32/win32sck.c
-
- OTHER CORE CHANGES
-
- Title: "New API function: perl_eval_pv()"
- From: Doug MacEachern
- Msg-ID: <199704142113.RAA06823@postman.osf.org>
- Date: Mon, 14 Apr 1997 17:13:41 -0400
- Files: perl.c pod/perlcall.pod pod/perldelta.pod pod/perlembed.pod
- pod/perlguts.pod proto.h
-
- Title: "Fix C< s//whatever/ >, which reuses old pattern"
- From: Chip Salzenberg
- Files: pp_hot.c regexec.c
-
- Title: "Return a value from PerlIO_{,un}getc"
- From: Hallvard B Furuseth
- Msg-ID: <199704131228.OAA05695@bombur2.uio.no>
- Date: Sun, 13 Apr 1997 14:28:14 +0200 (MET DST)
- Files: perlio.c
-
- Title: "Fix for environment leak"
- From: skimo@breughel.ufsia.ac.be (Sven Verdoolaege)
- Msg-ID: <19970415103246.NN46698@breughel.ufsia.ac.be>
- Date: Tue, 15 Apr 1997 10:32:46 +0200
- Files: util.c
-
- Title: "Fix comments in seed()"
- From: Hallvard B Furuseth
- Msg-ID: <199704141758.TAA06895@bombur2.uio.no>
- Date: Mon, 14 Apr 1997 19:58:38 +0200 (MET DST)
- Files: pp.c
-
- BUILD PROCESS
-
- Title: "Put extensions' autoload files in $archlib"
- From: Chip Salzenberg
- Files: installperl
-
- Title: "Use '-fPIC' for debugging compiles under Solaris with gcc"
- From: Hallvard B Furuseth
- Files: Configure
-
- LIBRARY AND EXTENSIONS
-
- Title: "Refresh CGI to 2.34"
- From: Chip Salzenberg
- Files: eg/cgi/customize.cgi eg/cgi/tryit.cgi lib/CGI.pm
- lib/CGI/Apache.pm
-
- Title: "Debugger update"
- From: Ilya Zakharevich
- Msg-ID: <199704142115.RAA09923@monk.mps.ohio-state.edu>
- Date: Mon, 14 Apr 1997 17:15:27 -0400 (EDT)
- Files: lib/perl5db.pl
-
- Title: "diagnostics: $/ gotcha"
- From: Andreas Koenig
- Msg-ID: <199704151814.UAA03404@anna.in-berlin.de>
- Date: Tue, 15 Apr 1997 20:14:01 +0200
- Files: lib/diagnostics.pm
-
- Title: "Update File::Path"
- From: Andreas Koenig
- Msg-ID: <199704151401.QAA02556@anna.in-berlin.de>
- Date: Tue, 15 Apr 1997 16:01:07 +0200
- Files: lib/File/Path.pm t/lib/filepath.t
-
- Title: "User::pwent.pm: g{,e}cos"
- From: Tom Christiansen
- Msg-ID: <199704130135.TAA23274@jhereg.perl.com>
- Date: Sat, 12 Apr 1997 19:35:54 -0600
- Files: lib/User/pwent.pm
-
- Title: "Sys::Syslog: hyphens in hostnames"
- From: Jarkko Hietaniemi
- Msg-ID: <199704151421.RAA19693@alpha.hut.fi>
- Date: Tue, 15 Apr 1997 17:21:53 +0300 (EET DST)
- Files: lib/Sys/Syslog.pm
-
- Title: "Clean up format of dlopen() debug info"
- From: Hallvard B Furuseth
- Files: ext/DynaLoader/dl_dlopen.xs
-
- TESTS
-
- (no changes)
-
- UTILITIES
-
- Title: "xsubpp incorrectly handles 'class::newthing()'"
- From: "John Q. Linux" <jql@jql.accessone.com>
- Msg-ID: <199704122201.PAA01780@jql.accessone.com>
- Date: Sat, 12 Apr 1997 15:01:33 -0700
- Files: lib/ExtUtils/xsubpp
-
- DOCUMENTATION
-
- Title: "Add CGI to perldelta.pod and improve its description in MANIFEST"
- From: Chip Salzenberg
- Files: MANIFEST pod/perldelta.pod
-
- Title: "Describe probs with majordomo 1.94.1"
- From: Chip Salzenberg
- Files: pod/perldelta.pod
-
- Title: "Fix description of /\G/g"
- From: Chip Salzenberg
- Files: pod/perlop.pod
-
- Title: "Mention '...' operator in precedence table"
- From: Tom Christiansen
- Msg-ID: <199704131724.LAA23120@jhereg.perl.com>
- Date: Sun, 13 Apr 1997 11:24:16 -0600
- Files: pod/perlop.pod
-
-
------------------
-Version 5.003_97d
------------------
-
-Any minute now... second public beta... no, really...
-
- CORE LANGUAGE CHANGES
-
- Title: "Fix for incorrect overloaded assignment"
- From: Ilya Zakharevich
- Msg-ID: <199704112225.SAA03482@monk.mps.ohio-state.edu>
- Date: Fri, 11 Apr 1997 18:25:33 -0400 (EDT)
- Files: gv.c
-
- Title: "Fix C< $x=''; pos($x)=0; $x=~/\G$/ >"
- From: Chip Salzenberg
- Files: pp_hot.c
-
- Title: "Fix label on C<for(;;)> statement"
- From: Chip Salzenberg
- Files: perly.c perly.y
-
- CORE PORTABILITY
-
- Title: "update to 5.003_97b/hint/irix_6_2.sh"
- From: Scott Henry <scotth@sgi.com>
- Msg-ID: <yd8hghdjbk0.fsf@hoshi.engr.sgi.com>
- Date: 11 Apr 1997 18:05:03 -0700
- Files: hints/irix_6_2.sh
-
- OTHER CORE CHANGES
-
- Title: "Before 'BEGIN not safe', explain why"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "New error msg for low-key failure of C<require>"
- From: Chip Salzenberg
- Files: pod/perldiag.pod pp_ctl.c t/pragma/strict-subs
- t/pragma/strict-vars
-
- Title: "Put "dXSUB_SYS" last in declarations"
- From: Chip Salzenberg
- Files: win32/perllib.c
-
- Title: "Minor type cleanup"
- From: Chip Salzenberg
- Files: proto.h toke.c
-
- BUILD PROCESS
-
- (no changes)
-
- LIBRARY AND EXTENSIONS
-
- Title: "win32: perl5db patch"
- From: Gurusamy Sarathy
- Msg-ID: <199704102142.RAA27396@aatma.engin.umich.edu>
- Date: Thu, 10 Apr 1997 17:42:13 -0400
- Files: lib/perl5db.pl
-
- Title: "Enhancements to debugger, Term::ReadLine, Term::Cap"
- From: Ilya Zakharevich
- Msg-ID: <199704101948.PAA01841@monk.mps.ohio-state.edu>
- Date: Thu, 10 Apr 1997 15:48:07 -0400 (EDT)
- Files: lib/Term/Cap.pm lib/Term/ReadLine.pm lib/perl5db.pl
-
- Title: "MM_Unix patch for use under CVS"
- From: Ulrich Pfeifer
- Msg-ID: <yfmd8s1vhpn.fsf@ls6.informatik.uni-dortmund.de>
- Date: 11 Apr 1997 14:59:00 +0200
- Files: lib/ExtUtils/MM_Unix.pm
-
- Title: "Complex update (five patches)"
- From: Jarkko Hietaniemi
- Files: lib/Math/Complex.pm t/lib/complex.t
-
- Title: "Fix undef warning in Math::BigInt"
- From: Chip Salzenberg
- Files: lib/Math/BigInt.pm
-
- TESTS
-
- (no other changes)
-
- UTILITIES
-
- Title: "Add B<-o> option to a2p, for old awk; make new the default"
- From: Chip Salzenberg
- Files: x2p/a2p.h x2p/a2p.pod x2p/a2py.c x2p/walk.c
-
- DOCUMENTATION
-
- Title: "typo in lib/diagnostics.pm"
- From: barnett@grymoire.crd.ge.com (Bruce Barnett)
- Msg-ID: <199704111800.OAA27297@grymoire.crd.ge.com>
- Date: Fri, 11 Apr 1997 14:00:54 -0400
- Files: lib/diagnostics.pm
-
- Title: "Use B<> for options in Class::Struct pod"
- From: Hugo van der Sanden <hv@iii.co.uk>
- Msg-ID: <334D2E7B.67F0@iii.co.uk>
- Date: Thu, 10 Apr 1997 19:16:27 +0100
- Files: lib/Class/Struct.pm
-
- Title: "Explain //g and \G issues"
- From: Gurusamy Sarathy
- Msg-ID: <199704122048.QAA25060@aatma.engin.umich.edu>
- Date: Sat, 12 Apr 1997 16:48:41 -0400
- Files: pod/perldelta.pod pod/perlop.pod pod/perlre.pod
-
- Title: "more (err, less) doubled words"
- From: Jarkko Hietaniemi
- Msg-ID: <199704111931.WAA24460@alpha.hut.fi>
- Date: Fri, 11 Apr 1997 22:31:25 +0300 (EET DST)
- Files: ext/DB_File/DB_File.pm ext/DynaLoader/DynaLoader.pm
- ext/IO/lib/IO/Pipe.pm lib/CGI.pm lib/Exporter.pm
- lib/ExtUtils/MakeMaker.pm lib/IPC/Open2.pm lib/IPC/Open3.pm
- lib/vars.pm pod/perlcall.pod pod/perldiag.pod
- pod/perlfaq1.pod pod/perlfaq3.pod pod/perlfaq5.pod
- pod/perlfaq7.pod pod/perlfaq8.pod pod/perlipc.pod
-
- Title: "Freudian slip error in perlsub.pod"
- From: barnett@grymoire.crd.ge.com (Bruce Barnett)
- Msg-ID: <199704111755.NAA27200@grymoire.crd.ge.com>
- Date: Fri, 11 Apr 1997 13:55:07 -0400
- Files: pod/perlsub.pod
-
- Title: "Little patch for perl5.003_97c/pod/perlpod.pod"
- From: rse@engelschall.com (Ralf S. Engelschall)
- Msg-ID: <199704112048.WAA08733@en1.engelschall.com>
- Date: Fri, 11 Apr 1997 22:48:37 +0200
- Files: pod/perlpod.pod
-
-
------------------
-Version 5.003_97c
------------------
-
-That second public beta will be Real Soon Now...
-
- CORE LANGUAGE CHANGES
-
- Title: "Refine setgroups() behavior of C<$)>"
- From: Chip Salzenberg
- Files: mg.c pod/perldelta.pod pod/perlvar.pod
-
- Title: "Forbid -[Mm] on #! line"
- From: Chip Salzenberg
- Files: pod/perldelta.pod pod/perldiag.pod toke.c
-
- CORE PORTABILITY
-
- Title: "Fix dynamic loading (and argv[0]) under AmigaOS"
- From: Norbert Pueschel
- Msg-ID: <77724842@Armageddon.meb.uni-bonn.de>
- Date: Tue, 08 Apr 1997 22:01:45 +0200
- Files: hints/amigaos.sh
-
- Title: "Special mkdir() for VMS"
- From: Charles Bailey
- Msg-ID: <01IHGOXN6MZM0004K3@hmivax.humgen.upenn.edu>
- Date: Tue, 08 Apr 1997 12:33:56 -0400 (EDT)
- Files: dosish.h lib/ExtUtils/MM_Unix.pm lib/File/Path.pm os2/os2ish.h
- plan9/plan9ish.h pp_sys.c unixish.h vms/vms.c vms/vmsish.h
-
- OTHER CORE CHANGES
-
- Title: "Fix assignment from magic SV that becomes a glob"
- From: Chip Salzenberg
- Files: sv.c
-
- BUILD PROCESS
-
- Title: "Fix syntax error in Configure comment(!)"
- From: Chip Salzenberg
- Files: Configure
-
- Title: "For Solaris, if -DDEBUGGING, default to '-KPIC', not '-Kpic'"
- From: Chip Salzenberg
- Files: Configure
-
- Title: "Fix usage of dXSUB_SYS, esp. in ExtUtils::Miniperl"
- From: Chip Salzenberg
- Files: dosish.h minimod.pl os2/os2ish.h plan9/plan9ish.h vms/vmsish.h
-
- LIBRARY AND EXTENSIONS
-
- Title: "Replace Class::Template with improved Class::Struct"
- From: Jim Miner <jfm@winternet.com>
- Files: MANIFEST lib/Class/Struct.pm lib/Class/Template.pm
- lib/File/stat.pm lib/Net/hostent.pm lib/Net/netent.pm
- lib/Net/protoent.pm lib/Net/servent.pm lib/Time/gmtime.pm
- lib/Time/localtime.pm lib/Time/tm.pm lib/User/grent.pm
- lib/User/pwent.pm pod/perldelta.pod pod/perlfaq7.pod
- pod/perlmod.pod pod/perltoot.pod
-
- Title: "MakeMaker pathname patch"
- From: Nick Ing-Simmons
- Msg-ID: <199704091908.UAA00877@ni-s.u-net.com>
- Date: Wed, 9 Apr 1997 20:08:23 +0100
- Files: lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm
-
- Title: "Fix configuration of new socket"
- From: Chip Salzenberg
- Files: ext/IO/lib/IO/Socket.pm
-
- Title: "Improve IO::Handle docs; don't export _open_mode_string"
- From: Chip Salzenberg
- Files: ext/IO/lib/IO/File.pm ext/IO/lib/IO/Handle.pm
-
- Title: "Complex.pm: 0**0 sanity"
- From: Jarkko Hietaniemi
- Msg-ID: <199704091804.VAA13930@alpha.hut.fi>
- Date: Wed, 9 Apr 1997 21:04:23 +0300 (EET DST)
- Files: lib/Math/Complex.pm
-
- Title: "Fix typos in Math::Trig"
- From: Jarkko Hietaniemi
- Files: lib/Math/Trig.pm
-
- TESTS
-
- Title: "Accommodate CodeBuilder variant of Machten 4.0.3"
- From: Dominic Dunlop <domo@slipper.ip.lu>
- Msg-ID: <v03020902af704d320f27@[194.51.248.88]>
- Date: Tue, 8 Apr 1997 22:15:15 +0200
- Files: t/io/fs.t t/op/stat.t
-
- UTILITIES
-
- (no changes)
-
- DOCUMENTATION
-
- Title: "IO::Socket doc fix"
- From: Roderick Schertler
- Msg-ID: <28383.860527843@eeyore.ibcinc.com>
- Date: Tue, 08 Apr 1997 15:30:43 -0400
- Files: ext/IO/lib/IO/Socket.pm
-
-
------------------
-Version 5.003_97b
------------------
-
-Working on the second public beta...
-
- CORE LANGUAGE CHANGES
-
- Title: "Make assignment to C<$)> call setgroups()"
- From: Chip Salzenberg
- Files: Configure config_H config_h.SH mg.c plan9/config.plan9
- pod/perldelta.pod vms/config.vms win32/config.H
- win32/config.w32
-
- Title: "Grandfather "$$<digit>" in strings"
- From: Chip Salzenberg
- Files: pod/perldiag.pod toke.c
-
- Title: "Disconnect warn and die hooks _after_ object destruction"
- From: Chip Salzenberg
- Files: perl.c
-
- Title: "Forbid recursive substitutions"
- From: Chip Salzenberg
- Files: cop.h pod/perldelta.pod pod/perldiag.pod pp_ctl.c pp_hot.c
-
- CORE PORTABILITY
-
- Title: "Use SSize_t for values of PerlIO_{read,write}"
- From: Chip Salzenberg
- Files: perlio.c perlio.h perlsdio.h pp_sys.c
-
- Title: "perlwin-97a_4: win32 environ fix"
- From: Gurusamy Sarathy
- Msg-ID: <199704060431.XAA23400@aatma.engin.umich.edu>
- Date: Sat, 05 Apr 1997 23:31:11 -0500
- Files: win32/win32.c win32/win32io.c win32/win32io.h win32/win32iop.h
-
- OTHER CORE CHANGES
-
- Title: "length($') isn't"
- From: Gurusamy Sarathy
- Msg-ID: <199704070730.DAA07310@aatma.engin.umich.edu>
- Date: Mon, 07 Apr 1997 03:30:44 -0400
- Files: mg.c
-
- Title: "Fix obscure regex bug related to leading C<.*>"
- From: Chip Salzenberg
- Files: toke.c
-
- Title: "Add warning for glob failure"
- From: Chip Salzenberg
- Files: pod/perldelta.pod pod/perldiag.pod pp_hot.c
-
- Title: "Fix C<perl -V> in presence of local patches"
- From: Chip Salzenberg
- Files: perl.c
-
- BUILD PROCESS
-
- Title: "Don't suggest 'Configure -der' in config.sh comments"
- From: Chip Salzenberg
- Files: Configure
-
- LIBRARY AND EXTENSIONS
-
- Title: "CGI->redirect patch"
- From: Doug MacEachern
- Msg-ID: <199704051527.KAA11280@postman.osf.org>
- Date: Sat, 05 Apr 1997 10:27:52 -0500
- Files: lib/CGI.pm
-
- Title: "Updates to Math::Complex and Math::Trig"
- From: Jarkko Hietaniemi
- Files: lib/Math/Complex.pm lib/Math/Trig.pm pod/perldelta.pod
- t/lib/complex.t
-
- Title: "Fix FindBin under Win32, and document success"
- From: Nick Ing-Simmons and Gurusamy Sarathy
- Msg-ID: <199704051504.QAA09507@ni-s.u-net.com>
- Date: Sat, 5 Apr 1997 16:04:52 +0100
- Files: README.win32 lib/Cwd.pm lib/FindBin.pm
-
- TESTS
-
- (no other changes)
-
- UTILITIES
-
- Title: "Patch for 'perldoc -f'"
- From: Gisle Aas
- Msg-ID: <199704061732.TAA00353@bergen.sn.no>
- Date: Sun, 6 Apr 1997 19:32:04 +0200
- Files: utils/perldoc.PL
-
- DOCUMENTATION
-
- Title: "Document required module versions"
- From: Chip Salzenberg
- Files: pod/perldelta.pod
-
- Title: "Document sample function perl_eval()"
- From: Doug MacEachern
- Msg-ID: <199704051524.KAA06090@postman.osf.org>
- Date: Sat, 05 Apr 1997 10:24:43 -0500
- Files: pod/perlcall.pod pod/perlembed.pod
-
- Title: "Make L<perltrap> refer to L<perldelta>"
- From: Chip Salzenberg
- Files: pod/perltrap.pod
-
-
------------------
-Version 5.003_97a
------------------
-
-This release gets a letter instead of a full subversion because I'm
-planning on making 5.003_98 the second public beta.
-
- CORE LANGUAGE CHANGES
-
- Title: "Fix AUTOLOAD, or kill me"
- From: Chip Salzenberg
- Files: gv.c pp.c t/op/method.t
-
- CORE PORTABILITY
-
- Title: "Add support for Cygwin32 (GNU-Win32) -- very low impact"
- From: John Cerney <j-cerney1@ti.com>
- Msg-ID: <199704030821.JAA08762@pluto.tiuk.ti.com>
- Date: Thu, 3 Apr 1997 09:21:17 +0100
- Files: MANIFEST README.cygwin32 cygwin32/cw32imp.h cygwin32/gcc2
- cygwin32/ld2 cygwin32/perlgcc cygwin32/perlld
- ext/DynaLoader/dl_cygwin32.xs hints/cygwin32.sh perl.h
- pp_sys.c
-
- Title: "Win32 update (six patches)"
- From: Gurusamy Sarathy
- Files: MANIFEST README.win32 dosish.h t/io/fs.t t/io/tell.t
- t/lib/io_tell.t t/op/magic.t t/op/mkdir.t t/op/runlevel.t
- t/op/stat.t t/op/taint.t win32/Makefile win32/VC-2.0/pod.mak
- win32/makedef.pl win32/pod.mak win32/win32.c win32/win32.h
- win32/win32io.c win32/win32io.h win32/win32iop.h
-
- Title: "AmigaOS update"
- From: Norbert Pueschel
- Msg-ID: <77724828@Armageddon.meb.uni-bonn.de>
- Date: Thu, 03 Apr 1997 16:16:51 +0200
- Files: README.amiga hints/amigaos.sh
-
- OTHER CORE CHANGES
-
- Title: "Fix const-sub-related panic on C<sub foo { my $x; 0 } foo>"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Fix warning for useless C<1..2>"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Minor cleanups"
- From: Gurusamy Sarathy
- Msg-ID: <199704040056.TAA22253@aatma.engin.umich.edu>
- Date: Thu, 03 Apr 1997 19:56:57 -0500
- Files: mg.c mg.h perl.c
-
- Title: "Eliminate unreliable warning with %SIG and strict refs"
- From: Chip Salzenberg
- Files: mg.c
-
- Title: "Fix impossible test in vivification"
- From: Chip Salzenberg
- Files: mg.c
-
- Title: "runlevel is I32, not int"
- From: Roderick Schertler
- Msg-ID: <2848.860109823@eeyore.ibcinc.com>
- Date: Thu, 03 Apr 1997 18:23:43 -0500
- Files: pp_ctl.c util.c
-
- BUILD PROCESS
-
- Title: "Re: shared lib compilation problem with miniperl5.003_97"
- From: Andy Dougherty
- Msg-ID: <Pine.SOL.3.95q.970404124326.647K-100000@fractal.lafayette.ed
- Date: Fri, 04 Apr 1997 13:02:23 -0500 (EST)
- Files: Makefile.SH
-
- LIBRARY AND EXTENSIONS
-
- Title: "Math::Trig, based on (and from an author of) Math::Complex"
- From: Chip Salzenberg
- Files: MANIFEST lib/Math/Complex.pm lib/Math/Trig.pm
- pod/perldelta.pod t/lib/complex.t t/lib/trig.t
-
- Title: "Update AutoLoader and docs; support C<use AutoLoader 'AUTOLOAD'>"
- From: Chip Salzenberg and Tim Bunce
- Files: lib/AutoLoader.pm
-
- Title: "CPAN & TRL-Gnu"
- From: Achim Bohnet <ach@rosat.mpe-garching.mpg.de>
- Msg-ID: <9704040809.AA26143@o09.rosat.mpe-garching.mpg.de>
- Date: Fri, 04 Apr 1997 10:09:03 +0200
- Files: lib/CPAN.pm
-
- Title: "Limit @ISA to actual DBM in AnyDBM"
- From: Chip Salzenberg
- Files: lib/AnyDBM_File.pm
-
- Title: "Don't use $4 when it might be undef"
- From: Chip Salzenberg
- Files: lib/bigfloat.pl
-
- TESTS
-
- Title: "Make *dbm tests work with Win32"
- From: Chip Salzenberg
- Files: t/lib/anydbm.t t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t
- t/lib/sdbm.t
-
- UTILITIES
-
- (no changes)
-
- DOCUMENTATION
-
- Title: "Update INSTALL"
- From: Andy Dougherty
- Files: INSTALL
-
- Title: "Pod style"
- From: Nathan Torkington <gnat@prometheus.frii.com>
- Files: pod/perlcall.pod pod/perldata.pod pod/perldebug.pod
- pod/perldiag.pod pod/perlform.pod pod/perlfunc.pod
- pod/perlipc.pod pod/perllocale.pod pod/perlmod.pod
- pod/perlop.pod pod/perlre.pod pod/perlrun.pod
- pod/perlstyle.pod pod/perltoc.pod pod/perlvar.pod
-
-
-----------------
-Version 5.003_97
-----------------
-
- CORE LANGUAGE CHANGES
-
- Title: "Reenable but deprecate inherited AUTOLOAD for plain funcs"
- From: Chip Salzenberg
- Files: ext/DynaLoader/DynaLoader.pm gv.c lib/Text/ParseWords.pm
- pod/perldelta.pod pod/perldiag.pod t/op/method.t
-
- CORE PORTABILITY
-
- Title: "Don't use setjmp() and longjmp() in complex exprs"
- From: Chip Salzenberg
- Files: perl.c pp_ctl.c scope.h
-
- Title: "Improve definition of Sock_size_t"
- From: Chip Salzenberg
- Files: doio.c pp_sys.c
-
- Title: "Don't use a completely empty macro parameter"
- From: Chip Salzenberg
- Files: sv.h
-
- Title: "Win32 update"
- From: Gurusamy Sarathy
- Msg-ID: <199704020608.BAA29538@aatma.engin.umich.edu>
- Date: Wed, 02 Apr 1997 01:08:09 -0500
- Files: win32/VC-2.0/modules.mak win32/VC-2.0/perl.mak win32/VC-
- 2.0/perldll.mak win32/perl.mak
-
- OTHER CORE CHANGES
-
- Title: "Introduce and use gv_fetchmethod_autoload()"
- From: Chip Salzenberg
- Files: global.sym gv.c pod/perlguts.pod proto.h universal.c
-
- Title: "Reduce memory footprint of literal strings"
- From: ilya@math.ohio-state.edu (Ilya Zakharevich)
- Msg-ID: <1997Apr1.113438.1913905@hmivax.humgen.upenn.edu>
- Date: Tue, 01 Apr 1997 11:34:37 -0500 (EST)
- Files: toke.c
-
- BUILD PROCESS
-
- Title: "Remove target before link() of perldiag.pod"
- From: Chip Salzenberg
- Files: installperl
-
- LIBRARY AND EXTENSIONS
-
- Title: "Refresh CPAN to 1.24"
- From: Andreas Koenig
- Files: lib/CPAN.pm lib/CPAN/FirstTime.pm
-
- Title: "Refresh ExtUtils::Manifest to 1.33"
- From: Andreas Koenig
- Files: lib/ExtUtils/Manifest.pm
-
- Title: "Update $VERSION of ExtUtils::Embed to reflect reality"
- From: Chip Salzenberg
- Files: lib/ExtUtils/Embed.pm
-
- Title: "Fix POSIX::raise()"
- From: "Jens T. Berger Thielemann" <jensthi@ifi.uio.no>
- Msg-ID: <Pine.SUN.3.91.970401153125.8053A-100000@holmenkollen.ifi.uio
- Date: Tue, 1 Apr 1997 15:34:47 +0200 (MET DST)
- Files: ext/POSIX/POSIX.pm
-
- Title: "Eliminate warnings in File::Basename"
- From: Robin Barker <rmb1@cise.npl.co.uk>
- Msg-ID: <11173.9704011111@tempest.cise.npl.co.uk>
- Date: Tue, 1 Apr 97 12:11:43 BST
- Files: lib/File/Basename.pm t/lib/basename.t
-
- Title: "Eliminate warning in CGI.pm"
- From: Chip Salzenberg
- Files: lib/CGI.pm
-
- Title: "Tweaks to constant.pm"
- From: Tom Phoenix
- Msg-ID: <Pine.GSO.3.96.970331205519.16684I-100000@kelly.teleport.com>
- Date: Mon, 31 Mar 1997 21:10:14 -0800 (PST)
- Files: lib/constant.pm
-
- Title: "Document eval vs. sub in Benchmark"
- From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
- Msg-ID: <199704012231.XAA00225@crypt.compulink.co.uk>
- Date: Tue, 01 Apr 1997 23:31:55 +0100
- Files: lib/Benchmark.pm
-
- TESTS
-
- (no other changes)
-
- UTILITIES
-
- Title: "Improve heuristics for pod2man titles"
- From: Roderick Schertler
- Msg-ID: <pzn2ri9gto.fsf@eeyore.ibcinc.com>
- Date: 01 Apr 1997 23:41:55 -0500
- Files: pod/pod2man.PL
-
- DOCUMENTATION
-
- Title: "Clean up some poddities, and make C<make html> work again"
- From: Chip Salzenberg
- Files: pod/Makefile pod/perldelta.pod pod/perldiag.pod
- pod/perlfaq8.pod pod/perlfunc.pod pod/perlop.pod
- pod/perltrap.pod
-
- Title: "Fix MM doc's use of "SUPER::""
- From: avera@hal.com (Jim Avera)
- Msg-ID: <9704012235.AA07841@membrane.hal.com>
- Date: Tue, 1 Apr 1997 14:35:26 -0800 (PST)
- Files: lib/ExtUtils/MakeMaker.pm
-
- Title: "Eliminate pod warnings in libs"
- From: Chip Salzenberg
- Files: lib/CGI.pm lib/ExtUtils/Command.pm
-
-
-----------------
-Version 5.003_96
-----------------
-
- CORE LANGUAGE CHANGES
-
- Title: "Support $ENV{PERL5OPT}"
- From: Chip Salzenberg
- Files: perl.c pod/perldiag.pod pod/perldelta.pod pod/perlrun.pod
-
- Title: "Implement void context, in which C<wantarray> is undef"
- From: Chip Salzenberg
- Files: cop.h doop.c dump.c global.sym gv.c op.c op.h perl.c
- pod/perlcall.pod pod/perldelta.pod pod/perlfunc.pod
- pod/perlguts.pod pod/perlsub.pod pp.c pp_ctl.c pp_hot.c
- pp_sys.c proto.h
-
- Title: "Don't look up &AUTOLOAD in @ISA when calling plain function"
- From: Chip Salzenberg
- Files: global.sym gv.c lib/Text/ParseWords.pm pod/perldelta.pod
- pp_hot.c proto.h t/op/method.t
-
- Title: "Allow closures to be constant subroutines"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Make C<scalar(reverse)> mean C<scalar(reverse $_)>"
- From: Chip Salzenberg
- Files: pp.c
-
- Title: "Fix lexical suicide from C<my $x = $x> in sub"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Make "Unrecog. char." fatal, and update its doc"
- From: Chip Salzenberg
- Files: pod/perldiag.pod toke.c
-
- Title: "Die on patterns that will match empty string forever"
- From: Stephen Potter <spp@psa.pencom.com>
- Msg-ID: <199703282138.PAA28311@psa.pencom.com>
- Date: Fri, 28 Mar 1997 15:38:30 -0600
- Files: regcomp.c
-
- CORE PORTABILITY
-
- Title: "safefree() mismatch"
- From: Roderick Schertler
- Msg-ID: <21338.859653381@eeyore.ibcinc.com>
- Date: Sat, 29 Mar 1997 11:36:21 -0500
- Files: util.c
-
- Title: "FreeBSD update"
- From: Slaven Rezic <eserte@cs.tu-berlin.de>
- Msg-ID: <199703311417.QAA04162@cabulja.herceg.de>
- Date: Mon, 31 Mar 1997 16:17:42 +0200 (MET DST)
- Files: hints/freebsd.sh
-
- Title: "Win32 update (seven patches)"
- From: Gurusamy Sarathy and Nick Ing-Simmons
- Files: EXTERN.h MANIFEST win32/Makefile win32/perl.mak
- win32/perl.rc win32/perldll.mak win32/makedef.pl
- win32/modules.mak win32/win32io.c win32/bin/pl2bat.bat
-
- OTHER CORE CHANGES
-
- Title: "Report PERL* environment variables in -V and perlbug"
- From: Chip Salzenberg
- Files: perl.c utils/perlbug.PL
-
- Title: "Typo in perl.c: Printing NO_EMBED for perl -V"
- From: Gisle Aas
- Msg-ID: <199703301922.VAA13509@furubotn.sn.no>
- Date: Sun, 30 Mar 1997 21:22:11 +0200
- Files: perl.c
-
- Title: "Don't let C<$var = $var> untaint $var"
- From: Chip Salzenberg
- Files: pp_hot.c pp_sys.c sv.h t/op/taint.t
-
- Title: "Fix autoviv bug in C<my $x; ++$x->{KEY}>"
- From: Chip Salzenberg
- Files: pp_hot.c
-
- Title: "Re: 5.004's new srand() default seed"
- From: Hallvard B Furuseth
- Msg-ID: <199703302219.AAA20998@bombur2.uio.no>
- Date: Mon, 31 Mar 1997 00:19:13 +0200 (MET DST)
- Files: pp.c
-
- Title: "Re: embedded perl and top_env problem "
- From: Gurusamy Sarathy
- Msg-ID: <199703280031.TAA05711@aatma.engin.umich.edu>
- Date: Thu, 27 Mar 1997 19:31:42 -0500
- Files: gv.c interp.sym perl.c perl.h pp_ctl.c pp_sys.c scope.h util.c
-
- Title: "Define and use new macro: boolSV()"
- From: Tim Bunce
- Files: gv.c lib/ExtUtils/typemap os2/os2.c pp.c pp_hot.c pp_sys.c
- sv.c sv.h universal.c vms/vms.c
-
- Title: "Re: strict @F"
- From: Hallvard B Furuseth
- Msg-ID: <199703252110.WAA16038@bombur2.uio.no>
- Date: Tue, 25 Mar 1997 22:10:33 +0100 (MET)
- Files: toke.c
-
- Title: "Try harder to identify errors at EOF"
- From: Chip Salzenberg
- Files: toke.c
-
- Title: "Minor string change in toke.c: 'bareword'"
- From: lvirden@cas.org
- Msg-ID: <1997Mar27.130247.1911552@hmivax.humgen.upenn.edu>
- Date: Thu, 27 Mar 1997 13:02:46 -0500 (EST)
- Files: toke.c
-
- Title: "Improve diagnostic on \r in program text"
- From: Chip Salzenberg
- Files: pod/perldiag.pod toke.c
-
- Title: "Make Sock_size_t typedef work right"
- From: Chip Salzenberg
- Files: perl.h pp_sys.c
-
- Title: "Eliminate unused dummy variable"
- From: Doug MacEachern
- Msg-ID: <199703270123.UAA25454@postman.osf.org>
- Date: Wed, 26 Mar 1997 20:23:14 -0500
- Files: lib/ExtUtils/Embed.pm unixish.h writemain.SH
-
- BUILD PROCESS
-
- Title: "Allow for coexistence of various versions of perldiag.pod"
- From: Chip Salzenberg
- Files: installperl lib/diagnostics.pm
-
- LIBRARY AND EXTENSIONS
-
- Title: "New module constant.pm"
- From: Tom Phoenix
- Files: MANIFEST lib/constant.pm op.c pp.c t/pragma/constant.t
-
- Title: "Remove chat2"
- From: Chip Salzenberg
- Files: MANIFEST lib/chat2.inter lib/chat2.pl
-
- Title: "Include CGI.pm 2.32"
- From: Chip Salzenberg
- Files: MANIFEST eg/cgi/* lib/CGI.pm lib/CGI/Apache.pm
- lib/CGI/Carp.pm lib/CGI/Fast.pm lib/CGI/Push.pm
- lib/CGI/Switch.pm
-
- Title: "Fix C<print $_> in debugger"
- From: Ilya Zakharevich
- Msg-ID: <199703312355.SAA01068@monk.mps.ohio-state.edu>
- Date: Mon, 31 Mar 1997 18:55:55 -0500 (EST)
- Files: lib/perl5db.pl
-
- Title: "Re: Pod problems & fixes"
- From: Hallvard B Furuseth
- Msg-ID: <199703261829.TAA17015@bombur2.uio.no>
- Date: Wed, 26 Mar 1997 19:29:14 +0100 (MET)
- Files: lib/Pod/Text.pm
-
- Title: "Re: $whoami calculation in Sys::Syslog.pm should not be greedy"
- From: Roderick Schertler
- Msg-ID: <pz4tdu7j57.fsf@eeyore.ibcinc.com>
- Date: 29 Mar 1997 11:33:24 -0500
- Files: lib/Sys/Syslog.pm
-
- Title: "C<new SelectSaver $fh> doesn't always restore"
- From: Spider Boardman
- Msg-ID: <199703291906.OAA07232@Orb.Nashua.NH.US>
- Date: Sat, 29 Mar 1997 14:06:37 -0500
- Files: lib/SelectSaver.pm
-
- Title: "Patch for Benchmark.pm"
- From: Hugo van der Sanden <hv@crypt.compulink.co.uk> w/Tim Bunce
- Msg-ID: <199703291504.PAA01596@crypt.compulink.co.uk>
- Date: Sat, 29 Mar 1997 15:04:32 +0000
- Files: lib/Benchmark.pm
-
- Title: "Tiny doc fix for AutoSplit.pm"
- From: "Randy J. Ray" <rjray@uswest.com>
- Msg-ID: <rjray-9702272117.AA001223633@snakepit.ecte.uswc.uswest.com>
- Date: Thu, 27 Mar 1997 14:17:38 -0700
- Files: lib/AutoSplit.pm
-
- TESTS
-
- (no other changes)
-
- UTILITIES
-
- Title: "Tom C's Pod::Html and html tools, as of 30 March 97"
- From: Chip Salzenberg
- Files: MANIFEST installhtml lib/Pod/Html.pm pod/pod2html.PL
-
- Title: "Fix path bugs in installhtml"
- From: Robin Barker <rmb1@cise.npl.co.uk>
- Msg-ID: <3180.9703270906@tempest.cise.npl.co.uk>
- Date: Thu, 27 Mar 97 09:06:14 GMT
- Files: installhtml
-
- Title: "Make perlbug say that it's only for core Perl bugs"
- From: Chip Salzenberg
- Files: utils/perlbug.PL
-
- DOCUMENTATION
-
- Title: "INSTALL-1.11"
- From: Andy Dougherty
- Msg-ID: <Pine.SOL.3.95q.970326140905.10178A-100000@fractal.lafayette.
- Date: Wed, 26 Mar 1997 14:27:52 -0500 (EST)
- Files: INSTALL
-
- Title: "Patch for perl.pod"
- From: wmiddlet@Adobe.COM (William Middleton)
- Msg-ID: <199703262305.PAA13121@ducks>
- Date: Wed, 26 Mar 1997 15:05:39 -0800 (PST)
- Files: pod/perl.pod
-
- Title: "Document autouse and constant; update diagnostics"
- From: Chip Salzenberg
- Files: pod/perldelta.pod
-
- Title: "Suggest to upgraders that they try '-w' again"
- From: Hallvard B Furuseth
- Msg-ID: <199703251901.UAA15982@bombur2.uio.no>
- Date: Tue, 25 Mar 1997 20:01:26 +0100 (MET)
- Files: pod/perldelta.pod
-
- Title: "Improve and update documentation of constant subs"
- From: Tom Phoenix
- Msg-ID: <Pine.GSO.3.96.970331122546.14185C-100000@kelly.teleport.com>
- Date: Mon, 31 Mar 1997 13:05:54 -0800 (PST)
- Files: pod/perlsub.pod
-
- Title: "Improve documentation of C<return>"
- From: Chip Salzenberg
- Files: pod/perlfunc.pod pod/perlsub.pod
-
- Title: "perlfunc.pod patch"
- From: Gisle Aas
- Msg-ID: <199703262159.WAA17531@furubotn.sn.no>
- Date: Wed, 26 Mar 1997 22:59:23 +0100
- Files: pod/perlfunc.pod
-
- Title: "Use 'while (defined($x = <>)) {}', per <gnat@frii.com>"
- From: Chip Salzenberg
- Files: configpm lib/Term/Cap.pm perlsh pod/perlipc.pod pod/perlop.pod
- pod/perlsub.pod pod/perlsyn.pod pod/perltrap.pod
- pod/perlvar.pod win32/bin/search.bat
-
- Title: "Document and test C<%> behavior with negative operands"
- From: Chip Salzenberg
- Files: pod/perlop.pod t/op/arith.t
-
- Title: "Update docs on $]"
- From: Chip Salzenberg
- Files: pod/perlvar.pod
-
- Title: "perlvar.pod patch"
- From: Gisle Aas
- Msg-ID: <199703261254.NAA10237@bergen.sn.no>
- Date: Wed, 26 Mar 1997 13:54:00 +0100
- Files: pod/perlvar.pod
-
- Title: "Fix example of C<or> vs. C<||>"
- From: Chip Salzenberg
- Files: pod/perlsyn.pod
-
- Title: "Pod usage and spelling patch"
- From: Larry W. Virden
- Files: pod/*.pod
-
- Title: "Pod updates"
- From: "Cary D. Renzema" <caryr@mxim.com>
- Msg-ID: <199703262353.PAA01819@macs.mxim.com>
- Date: Wed, 26 Mar 1997 15:53:22 -0800 (PST)
- Files: pod/*.pod
-
+____________________________________________________________________________
+[ 1647] By: gsar on 1998/07/22 21:11:29
+ Log: sneak in hints/irix_6.sh update
+ Branch: perl
+ ! Changes hints/irix_6.sh
+____________________________________________________________________________
+[ 1646] By: gsar on 1998/07/22 21:00:44
+ Log: Update perldelta and Changes; refresh perltoc; newer perlembed.pod
+ from Jon Orwant <orwant@media.mit.edu>; update guts documentation
+ to reflect PL_* changes; is this *it* for 5.005?
+ Branch: perl
+ ! Changes README.win32 patchlevel.h pod/perlcall.pod
+ ! pod/perldelta.pod pod/perlembed.pod pod/perlguts.pod
+ ! pod/perltoc.pod pod/perlxs.pod
+____________________________________________________________________________
+[ 1645] By: gsar on 1998/07/22 19:37:41
+ Log: don't use qualify() in class methods
+ From: Albert Dvornik <bert@genscan.com>
+ Date: 22 Jul 1998 15:14:46 EDT
+ Message-Id: <tqbtqhlmu1.fsf_-_@puma.genscan.com>
+ Subject: [PATCH 5.005-MAYBE] Bug in IO::Handle->input_record_separator
+ Branch: perl
+ ! ext/IO/lib/IO/Handle.pm
+____________________________________________________________________________
+[ 1644] By: gsar on 1998/07/22 18:13:31
+ Log: newer perlembed.pod
+ Branch: perl
+ ! pod/perlembed.pod
+____________________________________________________________________________
+[ 1643] By: gsar on 1998/07/22 18:03:42
+ Log: From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Wed, 22 Jul 1998 13:42:20 EDT
+ Message-Id: <Pine.SUN.3.96.980722134049.10073C-100000@newton.phys>
+ Subject: Re: 5.005 - a sneak preview
+ Branch: perl
+ ! Porting/pumpkin.pod
+____________________________________________________________________________
+[ 1642] By: gsar on 1998/07/22 17:58:42
+ Log: add perlmodinstall, regen perltoc
+ Branch: perl
+ + pod/perlmodinstall.pod
+ ! MANIFEST pod/Makefile pod/buildtoc pod/perl.pod
+ ! pod/perltoc.pod win32/pod.mak
+____________________________________________________________________________
+[ 1641] By: gsar on 1998/07/22 17:11:55
+ Log: support optional crypt() with PERL_OBJECT
+ From: "Douglas Lankshear" <dougl@ActiveState.com>
+ Date: Wed, 22 Jul 1998 08:21:10 PDT
+ Message-Id: <000701bdb584$5b57c070$a32fa8c0@tau.Active>
+ Subject: [PATCH 5.005 maybe] for crypt with PERL_OBJECT
+ Branch: perl
+ ! iperlsys.h pp.c win32/Makefile win32/makefile.mk
+ ! win32/perlhost.h win32/win32.c win32/win32iop.h
+____________________________________________________________________________
+[ 1640] By: gsar on 1998/07/22 17:09:11
+ Log: win32 tweaks
+ Date: Wed, 22 Jul 1998 07:09:09 PDT
+ Message-Id: <000001bdb57a$4bc9dd00$a32fa8c0@tau.Active>
+ From: "Douglas Lankshear" <dougl@ActiveState.com>
+ Branch: perl
+ ! win32/Makefile win32/makefile.mk win32/win32.h
+____________________________________________________________________________
+[ 1639] By: gsar on 1998/07/22 17:00:30
+ Log: From: d-lewart@uiuc.edu (Daniel S. Lewart)
+ Date: Wed, 22 Jul 1998 06:20:08 CDT
+ Message-Id: <199807221120.GAA07962@staff2.cso.uiuc.edu>
+ Subject: [PATCH] lib/Sys/Syslog.pm doc
+ Branch: perl
+ ! Changes lib/Sys/Syslog.pm
+____________________________________________________________________________
+[ 1638] By: gsar on 1998/07/22 09:12:26
+ Log: up patchlevel etc (only doc patching from now on, testing in progress)
+ Branch: perl
+ ! Changes patchlevel.h win32/Makefile win32/config_H.bc
+ ! win32/config_H.gc win32/config_H.vc win32/makefile.mk
+____________________________________________________________________________
+[ 1637] By: gsar on 1998/07/22 08:27:09
+ Log: VMS patches from Dan Sugalski <sugalskd@osshe.edu>
+ Date: Tue, 21 Jul 1998 16:04:40 PDT
+ Message-Id: <3.0.5.32.19980721160440.00a916f0@ous.edu>
+ Subject: [PATCH 5.004_76]Document Vax C's death for VMS
+ --
+ Date: Tue, 21 Jul 1998 16:08:57 PDT
+ Message-Id: <3.0.5.32.19980721160857.00a6d250@ous.edu>
+ Subject: [PATCH 5.004_76]fix clean/realclean targets of VMS' makefile
+ --
+ Date: Tue, 21 Jul 1998 16:05:56 PDT
+ Message-Id: <3.0.5.32.19980721160556.00a1a100@ous.edu>
+ Subject: [PATCH 5.004_76]Note the record-read capabilities of $/ in perldelta.pod
+ Branch: perl
+ ! README.vms pod/perldelta.pod vms/descrip_mms.template
+____________________________________________________________________________
+[ 1636] By: gsar on 1998/07/22 08:04:37
+ Log: fix quoting in t/io/inplace.t
+ Branch: perl
+ ! t/io/inplace.t
+____________________________________________________________________________
+[ 1635] By: gsar on 1998/07/22 07:59:30
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ Date: Tue, 21 Jul 1998 13:06:44 PDT
+ Message-Id: <3.0.5.32.19980721130644.00ac5100@ous.edu>
+ Subject: [PATCH 5.004_76]t/io/inplace.t enabled for VMS
+ Branch: perl
+ ! t/io/inplace.t vms/test.com
+____________________________________________________________________________
+[ 1634] By: gsar on 1998/07/22 07:55:35
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ Date: Tue, 21 Jul 1998 12:42:20 PDT
+ Message-Id: <3.0.5.32.19980721124220.00a82a20@ous.edu>
+ Subject: [PATCH 5.004_76]Fix inplace editing for VMS
+ Branch: perl
+ ! doio.c
+____________________________________________________________________________
+[ 1633] By: gsar on 1998/07/22 07:53:53
+ Log: fix AIX hints for PL_* changes
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Tue, 21 Jul 1998 22:53:54 +0300
+ Message-Id: <199807211953.WAA55724@vipunen.hut.fi>
+ Subject: Re: _76 fails to link B extension on AIX 414
+ Branch: perl
+ ! perl_exp.SH
+____________________________________________________________________________
+[ 1632] By: gsar on 1998/07/22 07:51:56
+ Log: From: Anton Berezin <tobez@plab.ku.dk>
+ Date: Tue, 21 Jul 1998 21:46:45 +0200
+ Message-Id: <199807211946.VAA01301@lion.plab.ku.dk>
+ Subject: [PATCH _76] t/op/eval.t test for eval & scoping of lexicals
+ Branch: perl
+ ! t/op/eval.t
+____________________________________________________________________________
+[ 1631] By: gsar on 1998/07/22 07:48:20
+ Log: applied patch, with tweak suggested by Michael Parker
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Tue, 21 Jul 1998 14:30:05 EDT
+ Message-Id: <Pine.SUN.3.96.980721142928.8231Q-100000@newton.phys>
+ Subject: Re: Not OK: _76 on IP22-irix6.2 fails tests
+ Branch: perl
+ ! hints/irix_6.sh
+____________________________________________________________________________
+[ 1630] By: gsar on 1998/07/22 07:40:25
+ Log: better diagnostic on errno.t failure
+ From: Graham Barr <gbarr@ti.com>
+ Date: Tue, 21 Jul 1998 13:07:29 CDT
+ Message-Id: <19980721130729.K4337@asic.sc.ti.com>
+ Branch: perl
+ ! t/lib/errno.t
+____________________________________________________________________________
+[ 1629] By: gsar on 1998/07/22 07:36:38
+ Log: win32 tweaks: disable XSLOCKS in perl.c, correct typo, search
+ the registry for anything that begins with "PERL", not "PERL5"
+ From: "Douglas Lankshear" <dougl@ActiveState.com>
+ Date: Tue, 21 Jul 1998 11:08:00 PDT
+ Message-Id: <000601bdb4d2$7ee74720$a32fa8c0@tau.Active>
+ Branch: perl
+ ! perl.c win32/perlhost.h win32/win32.c
+____________________________________________________________________________
+[ 1628] By: gsar on 1998/07/22 07:28:35
+ Log: suppress redefined warnings on C<INIT {} INIT {}>
+ Branch: perl
+ ! op.c
+____________________________________________________________________________
+[ 1627] By: gsar on 1998/07/22 07:15:19
+ Log: remove spurious $VERSION line that confuses CPAN
+ From: Johan Vromans <jvromans@squirrel.nl>
+ Date: Tue, 21 Jul 1998 20:01:36 +0200
+ Message-Id: <13748.55168.397720.564438@phoenix.squirrel.nl>
+ Subject: Re: 5.004_76 missing version numbers
+ Branch: perl
+ ! lib/Getopt/Long.pm
+____________________________________________________________________________
+[ 1626] By: gsar on 1998/07/22 06:57:56
+ Log: From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Tue, 21 Jul 1998 10:20:13 EDT
+ Message-Id: <Pine.SUN.3.96.980721101922.8078A-100000@newton.phys>
+ Subject: [PATCH] Porting/config* updates for 5.005
+ Branch: perl
+ ! Changes Porting/config.sh Porting/config_H
+____________________________________________________________________________
+[ 1625] By: gsar on 1998/07/22 06:46:38
+ Log: add a few more globals with old names #defined
+ Branch: perl
+ ! embed.pl embedvar.h
+____________________________________________________________________________
+[ 1624] By: gsar on 1998/07/22 06:39:22
+ Log: allow extensions to be specified as paths
+ From: Paul Johnson <pjcj@transeda.com>
+ Date: Tue, 21 Jul 1998 12:04:27 BST
+ Message-Id: <19980721120427.F903@west-tip.transeda.com>
+ Subject: [PATCH] 5.004_75 Embed and static extensions
+ Branch: perl
+ ! lib/ExtUtils/Embed.pm
+____________________________________________________________________________
+[ 1623] By: gsar on 1998/07/22 06:12:50
+ Log: make $ prototype to accept THREADSVs
+ Branch: perl
+ ! op.c
+____________________________________________________________________________
+[ 1622] By: gsar on 1998/07/22 06:04:25
+ Log: fix Liblist.pm to find entries that are plain pathnames on win32
+ Branch: perl
+ ! lib/ExtUtils/Liblist.pm
+____________________________________________________________________________
+[ 1621] By: gsar on 1998/07/22 05:10:53
+ Log: perlfaq update from From Tom Christiansen and Nathan Torkington
+ (removes all mention of training courses from perlfaq*.pod)
+ Branch: perl
+ ! pod/perlfaq.pod pod/perlfaq2.pod pod/perlfaq3.pod
+ ! pod/perlfaq4.pod pod/perlfaq6.pod pod/perlfaq7.pod
+ ! pod/perlfaq8.pod pod/perlfaq9.pod
+____________________________________________________________________________
+[ 1620] By: gsar on 1998/07/22 02:51:13
+ Log: applied patch, modulo parts already added to perldelta
+ From: Stephen McCamant <alias@mcs.com>
+ Date: Tue, 21 Jul 1998 17:06:23 CDT
+ Message-Id: <13749.3106.995764.413053@alias-2.pr.mcs.net>
+ Subject: [PATCH] Re: Beta2 is available
+ Branch: perl
+ ! pod/perldelta.pod
+____________________________________________________________________________
+[ 1619] By: gsar on 1998/07/22 02:45:55
+ Log: applied patch, add new message to perldeta
+ From: Stephen McCamant <alias@mcs.com>
+ Date: Tue, 21 Jul 1998 16:12:25 CDT
+ Message-Id: <13749.910.83378.949909@alias-2.pr.mcs.net>
+ Subject: [PATCH] Band-aid patch for local($avhv->{a})
+ Branch: perl
+ ! pod/perldelta.pod pod/perldiag.pod pp.c pp_hot.c
+____________________________________________________________________________
+[ 1618] By: gsar on 1998/07/22 02:08:00
+ Log: fix up B modules for PL_* changes
+ Branch: perl
+ ! ext/B/B/C.pm ext/B/B/CC.pm ext/B/B/Stackobj.pm
+____________________________________________________________________________
+[ 1617] By: gsar on 1998/07/22 01:42:14
+ Log: From: Malcolm Beattie <mbeattie@sable.ox.ac.uk>
+ Date: Tue, 21 Jul 1998 18:13:16 BST
+ Message-Id: <199807211713.SAA20735@sable.ox.ac.uk>
+ Subject: Compiler docs for 5.005
+ Branch: perl
+ ! ext/B/B.pm ext/B/B/Bytecode.pm ext/B/B/C.pm ext/B/B/CC.pm
+ ! ext/B/O.pm
+____________________________________________________________________________
+[ 1616] By: gsar on 1998/07/22 01:29:09
+ Log: s/PL_sv/PL_bytecode_sv/ etc., so we have unique, case-insensitive
+ names
+ Branch: perl
+ ! bytecode.h bytecode.pl byterun.c embedvar.h interp.sym
+ ! intrpvar.h
+____________________________________________________________________________
+[ 1615] By: nick on 1998/07/21 22:26:34
+ Log: Mingw32 PERL_OBJECT tweaks
+ Branch: perl
+ ! ext/Fcntl/Fcntl.xs ext/IO/IO.xs ext/POSIX/POSIX.xs
+____________________________________________________________________________
+[ 1614] By: gsar on 1998/07/21 19:43:32
+ Log: fix off-by-one in change#623 that broke lexical lookups in eval''
+ Branch: perl
+ ! pp_ctl.c
----------------
-Version 5.003_95
+Version 5.004_76 5.005 Public Beta, Issue 2
----------------
- CORE LANGUAGE CHANGES
-
- Title: "Don't compile scalar mods of aggregates, like C<@a =~ s/a/b/>"
- From: Chip Salzenberg
- Files: op.c t/op/misc.t
-
- Title: "Automatically flush on C< $| = 1 >"
- From: Chip Salzenberg
- Files: mg.c
-
- Title: "Refine modulus ("%") per suggestion of Tim Goodwin"
- From: Chip Salzenberg
- Files: pp.c
-
- Title: "If C<perl -a>, do equivalent of C<use vars '@F'>"
- From: Chip Salzenberg
- Files: toke.c
-
- Title: "Warn about undef magic values just like non-magic"
- From: Chip Salzenberg
- Files: ext/Opcode/Safe.pm sv.c t/lib/db-btree.t t/lib/db-hash.t
- t/lib/db-recno.t t/pragma/locale.t
-
- CORE PORTABILITY
-
- Title: "Remove redundant patch to hints/bsdos.sh"
- From: Shigeya Suzuki <shigeya@foretune.co.jp>
- Msg-ID: <19970322222244K.shigeya@foretune.co.jp>
- Date: Sat, 22 Mar 1997 22:22:44 +0900
- Files: hints/bsdos.sh
-
- Title: "Another MachTen Patch"
- From: Tom Phoenix
- Msg-ID: <Pine.GSO.3.96.970324152150.20610P-100000@kelly.teleport.com>
- Date: Mon, 24 Mar 1997 15:26:48 -0800 (PST)
- Files: hints/machten_2.sh
-
- Title: "Win32 update (five patches)"
- From: Gurusamy Sarathy and Nick Ing-Simmons
- Files: MANIFEST README.win32 doio.c dosish.h pp_sys.c
- lib/ExtUtils/Command.pm t/comp/multiline.t t/op/magic.t
- t/op/mkdir.t t/op/runlevel.t t/op/stat.t t/op/write.t
- win32/Makefile win32/config.H win32/config.w32 win32/win32.c
- win32/win32.h win32/win32aux.c win32/*.mak win32/VC-2.0/*.mak
-
- OTHER CORE CHANGES
-
- Title: "Fix botch with G_NOARGS; PUSHMARK *is* required"
- From: Chip Salzenberg
- Files: perl.c
-
- Title: "Improve 'prototype mismatch' warning"
- From: Chip Salzenberg
- Files: global.sym op.c pod/perldiag.pod proto.h sv.c t/comp/redef.t
-
- Title: "In perlio, fix vprintf() definition and define vfprintf()"
- From: Chip Salzenberg
- Files: perlio.c
-
- BUILD PROCESS
-
- (no other changes)
-
- LIBRARY AND EXTENSIONS
-
- Title: "Fix C<require> in Getopt::Long to work with 5.003"
- From: Chip Salzenberg
- Files: lib/Getopt/Long.pm
-
- Title: "Extraneous blank lines from Pod::Text"
- From: Russ Allbery <rra@stanford.edu>
- Msg-ID: <qumend4qq08.fsf@cyclone.stanford.edu>
- Date: 25 Mar 1997 01:28:55 -0800
- Files: lib/Pod/Text.pm
-
- Title: "Exporting UNIVERSAL::can"
- From: "M.J.T. Guy"
- Msg-ID: <E0w9DwX-0000Zr-00@taurus.cus.cam.ac.uk>
- Date: Mon, 24 Mar 1997 17:54:01 +0000
- Files: lib/UNIVERSAL.pm
-
- Title: "Term::Readline patch for AmigaOS"
- From: Norbert Pueschel
- Msg-ID: <77724797@Armageddon.meb.uni-bonn.de>
- Date: Sun, 23 Mar 1997 18:57:22 +0100
- Files: lib/Term/ReadLine.pm
-
- TESTS
-
- Title: "Reduce memory footprint of complex.t"
- From: Dominic Dunlop <domo@slipper.ip.lu>
- Msg-ID: <v03020902af5d8e03c5ab@[194.51.248.84]>
- Date: Tue, 25 Mar 1997 15:39:26 +0100
- Files: t/lib/complex.t
-
- UTILITIES
-
- Title: "Improve pod2man diagnostic when NAME is invalid"
- From: Chip Salzenberg
- Files: pod/pod2man.PL
-
- DOCUMENTATION
-
- Title: "INSTALL-1.8 to INSTALL-1.9 updates"
- From: Andy Dougherty
- Msg-ID: <Pine.SOL.3.95q.970325135138.3374A-100000@fractal.lafayette.e
- Date: Tue, 25 Mar 1997 13:52:53 -0500 (EST)
- Files: INSTALL
-
- Title: "Document possible problems with -Mdiagnostics after upgrade"
- From: Chip Salzenberg
- Files: INSTALL
-
- Title: "Mention perldelta in INSTALL"
- From: Chip Salzenberg
- Files: INSTALL
-
- Title: "Describe pod format at top of INSTALL"
- From: Chip Salzenberg
- Files: INSTALL
-
- Title: "Document C</a *b/x> fix"
- From: Chip Salzenberg
- Files: pod/perldelta.pod
-
- Title: "pods for subroutine argument autovivication"
- From: "M.J.T. Guy"
- Msg-ID: <E0w9489-0005YT-00@ursa.cus.cam.ac.uk>
- Date: Mon, 24 Mar 1997 07:25:21 +0000
- Files: pod/perldelta.pod pod/perlsub.pod
-
- Title: "Missing item in perldiag"
- From: "M.J.T. Guy"
- Msg-ID: <E0w8jVZ-0005va-00@ursa.cus.cam.ac.uk>
- Date: Sun, 23 Mar 1997 09:24:09 +0000
- Files: pod/perldiag.pod
-
- Title: "Mention and discourage use of term 'soft reference'"
- From: Chip Salzenberg
- Files: pod/perlref.pod
-
- Title: "Pod problems & fixes"
- From: Hallvard B Furuseth
- Msg-ID: <199703242031.VAA14997@bombur2.uio.no>
- Date: Mon, 24 Mar 1997 21:31:51 +0100 (MET)
- Files: INSTALL lib/Term/Complete.pm lib/subs.pm pod/perlcall.pod
- pod/perldata.pod pod/perldiag.pod pod/perlembed.pod
- pod/perlguts.pod pod/perlmod.pod pod/perlop.pod
- pod/perlpod.pod pod/pod2html.PL
-
- Title: "DB_File documentation fix"
- From: Paul Marquess
- Msg-ID: <9703240854.AA08401@claudius.bfsec.bt.co.uk>
- Date: Mon, 24 Mar 97 08:54:16 GMT
- Files: ext/DB_File/DB_File.pm
-
- Title: "FAQ update"
- From: Nathan Torkington <gnat@prometheus.frii.com>
- Files: pod/perlfaq*.pod
-
+____________________________________________________________________________
+[ 1613] By: gsar on 1998/07/21 10:26:01
+ Log: final tweaks before beta2
+ Branch: perl
+ + Porting/findvars
+ +> Porting/fixvars
+ - fixvars
+ ! Changes MANIFEST intrpvar.h iperlsys.h
+ ! lib/ExtUtils/MM_Win32.pm win32/perlhost.h
+____________________________________________________________________________
+[ 1612] By: gsar on 1998/07/21 07:15:54
+ Log: fixes to enable PERL_OBJECT build with mingw32/egcs-1.0.2
+ Branch: perl
+ ! ext/Opcode/Opcode.xs proto.h win32/makedef.pl
+ ! win32/makefile.mk win32/perlhost.h win32/win32.c win32/win32.h
+ ! win32/win32sck.c
+____________________________________________________________________________
+[ 1611] By: gsar on 1998/07/21 07:12:00
+ Log: fix bytecode.pl with moved var names
+ Branch: perl
+ ! bytecode.pl byterun.c byterun.h ext/B/B/Asmdata.pm
+____________________________________________________________________________
+[ 1610] By: gsar on 1998/07/21 05:51:10
+ Log: tweak toke.c
+ Branch: perl
+ ! toke.c
+____________________________________________________________________________
+[ 1609] By: gsar on 1998/07/21 05:46:59
+ Log: change case of PERL_OBJECT filenames, consistent with the rest
+ Branch: perl
+ + XSlock.h objXSUB.h
+ - ObjXSub.h XSLock.h
+ ! MANIFEST XSUB.h lib/ExtUtils/MM_Win32.pm perl.h
+ ! win32/GenCAPI.pl win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 1608] By: gsar on 1998/07/21 05:31:13
+ Log: part 2 of PERL_OBJECT fixes (globals in bytecode.h moved to intrpvar.h)
+ Branch: perl
+ ! bytecode.h byterun.c embedvar.h interp.sym intrpvar.h
+____________________________________________________________________________
+[ 1607] By: gsar on 1998/07/21 05:29:10
+ Log: part 1 of PERL_OBJECT fixes for new var names
+ Branch: perl
+ ! ObjXSub.h bytecode.h globals.c iperlsys.h perl.h pp_ctl.c
+ ! run.c win32/GenCAPI.pl
+____________________________________________________________________________
+[ 1606] By: gsar on 1998/07/21 05:17:26
+ Log: From: Stephen McCamant <alias@mcs.com>
+ Date: Mon, 20 Jul 1998 23:53:32 CDT
+ Message-Id: <13748.6947.311341.657005@alias-2.pr.mcs.net>
+ Subject: [PATCH] redundant RV2GVs in ck_fun()
+ Branch: perl
+ ! op.c
+____________________________________________________________________________
+[ 1605] By: gsar on 1998/07/21 05:13:28
+ Log: From: Stephen McCamant <alias@mcs.com>
+ Date: Mon, 20 Jul 1998 23:32:42 CDT
+ Message-Id: <13748.6392.921893.643238@alias-2.pr.mcs.net>
+ Subject: B::Deparse 0.56 (first testsuite fixes; big)
+ Branch: perl
+ ! ext/B/B/Deparse.pm
+____________________________________________________________________________
+[ 1604] By: gsar on 1998/07/21 05:07:29
+ Log: applied a slightly tweaked version of suggested patch
+ From: Colin Kuskie <ckuskie@cadence.com>
+ Date: Mon, 20 Jul 1998 15:58:31 -0700 (PDT)
+ Message-ID: <Pine.GSO.3.96.980720154841.6188M-100000@pdxmail.cadence.com>
+ Subject: [PATCH _75] More documentation for -i prefix
+ Branch: perl
+ ! pod/perlrun.pod
+____________________________________________________________________________
+[ 1603] By: gsar on 1998/07/21 04:59:19
+ Log: disable malloced_size() feedback with -DLEAKTEST
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Mon, 20 Jul 1998 21:20:21 -0400 (EDT)
+ Message-Id: <199807210120.VAA15031@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_75] -DLEAKTEST broken
+ Branch: perl
+ ! av.c sv.c
+____________________________________________________________________________
+[ 1602] By: gsar on 1998/07/21 04:57:43
+ Log: fix hints/hpux.sh for cpp recognition
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Mon, 20 Jul 1998 12:46:33 -0400 (EDT)
+ Message-Id: <Pine.SUN.3.96.980720124202.6585B-100000@newton.phys>
+ Subject: RE: Configure misses preprocessor on HP-UX
+ Branch: perl
+ ! hints/hpux.sh
+____________________________________________________________________________
+[ 1601] By: gsar on 1998/07/21 04:55:51
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Sun, 19 Jul 1998 18:16:38 -0400 (EDT)
+ Message-Id: <199807192216.SAA10482@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_72] Compile (?{}) into a correct package
+ Branch: perl
+ ! pp_ctl.c t/op/pat.t
+____________________________________________________________________________
+[ 1600] By: gsar on 1998/07/21 04:48:32
+ Log: allocate a whole fd_set for pp_sselect() on more platforms
+ From: Jarkko Hietaniemi <jhi@cc.hut.fi>
+ Date: 20 Jul 1998 00:14:18 +0300
+ Message-ID: <oeen2a5y251.fsf@alpha.hut.fi>
+ Subject: Re: Not OK: perl 5.00475 +DEVEL_BETA_ISSUE_1 on OPENSTEP-Mach 4_1 (UNINSTALLED)
+ Branch: perl
+ ! pp_sys.c
+____________________________________________________________________________
+[ 1599] By: gsar on 1998/07/21 04:44:04
+ Log: add tests to check if context propagation works
+ From: Francois Desarmenien <desar@club-internet.fr>
+ Date: Sun, 19 Jul 1998 12:28:33 +0200
+ Message-ID: <35B1CA51.A606AD27@club-internet.fr>
+ Subject: Re: m//g strange behaviour in 5.004
+ Branch: perl
+ + t/op/context.t
+ ! MANIFEST
+____________________________________________________________________________
+[ 1598] By: gsar on 1998/07/21 04:37:49
+ Log: applied RE doc patches, with tweaks to the prose
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Sat, 18 Jul 1998 23:11:13 -0400 (EDT)
+ Message-Id: <199807190311.XAA25080@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_72] Document irregular zero-length matches
+ --
+ Date: Sun, 19 Jul 1998 00:38:44 -0400 (EDT)
+ Message-Id: <199807190438.AAA26226@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_72] Another irregularity of expressions documented
+ Branch: perl
+ ! pod/perlre.pod
+____________________________________________________________________________
+[ 1597] By: gsar on 1998/07/21 04:16:51
+ Log: pod tweak suggested by Ilya
+ Branch: perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 1596] By: gsar on 1998/07/21 04:12:39
+ Log: enable color output with -Mre=debugcolor with -DDEBUGGING
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Sat, 18 Jul 1998 17:34:00 -0400 (EDT)
+ Message-Id: <199807182134.RAA20644@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_72] Better -Mre=colordb
+ Branch: perl
+ ! ext/re/re.xs
+____________________________________________________________________________
+[ 1595] By: gsar on 1998/07/21 04:07:44
+ Log: From: "John L. Allen" <allen@grumman.com>
+ Date: Thu, 16 Jul 1998 11:43:54 -0400 (EDT)
+ Message-ID: <Pine.SOL.3.91.980716113018.14617A-100000@gateway.grumman.com>
+ Subject: [PATCH _75 & _05] perlbug does not report usage on invalid flags
+ Branch: perl
+ ! utils/perlbug.PL
+____________________________________________________________________________
+[ 1594] By: gsar on 1998/07/21 04:06:06
+ Log: don't use SelectSaver on IO::Handle->input_*() methods
+ From: Robin Barker <rmb1@cise.npl.co.uk>
+ Date: Thu, 16 Jul 1998 15:00:39 +0100 (BST)
+ Message-Id: <199807161400.PAA25532@tempest.cise.npl.co.uk>
+ Subject: Re: Bug in IO::Handle->input_record_separator
+ Branch: perl
+ ! ext/IO/lib/IO/Handle.pm
+____________________________________________________________________________
+[ 1593] By: gsar on 1998/07/21 04:03:46
+ Log: applied a tweaked version of suggested patch
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Wed, 15 Jul 1998 17:02:48 -0400 (EDT)
+ Message-Id: <199807152102.RAA19952@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_72] Enable/document colors in re.pm
+ Branch: perl
+ ! ext/re/re.pm
+____________________________________________________________________________
+[ 1592] By: gsar on 1998/07/21 03:49:55
+ Log: remove compat3.sym and rename perld4.pod
+ Branch: perl
+ +> pod/perl5004delta.pod
+ - compat3.sym pod/perld4.pod
+ ! MANIFEST
+____________________________________________________________________________
+[ 1591] By: gsar on 1998/07/21 03:38:16
+ Log: update patchlevel, Changes
+ Branch: perl
+ ! Changes patchlevel.h win32/Makefile win32/config_H.bc
+ ! win32/config_H.gc win32/config_H.vc win32/makefile.mk
+____________________________________________________________________________
+[ 1590] By: gsar on 1998/07/21 03:06:04
+ Log: documentation tweaks from Abigail <abigail@fnx.com>
+ Date: Fri, 17 Jul 1998 20:52:36 -0400 (EDT)
+ Message-ID: <19980718005236.5154.qmail@betelgeuse.wayne.fnx.com>
+ Subject: Re: [PATCH 5.00475] pod/perlsyn.pod
+ --
+ Date: Thu, 16 Jul 1998 17:00:49 -0400 (EDT)
+ Message-ID: <19980716210049.16156.qmail@betelgeuse.wayne.fnx.com>
+ Subject: [PATCH 5.00475] pod/perlguts.pod
+ --
+ Date: Thu, 16 Jul 1998 16:52:05 -0400 (EDT)
+ Message-ID: <19980716205205.15949.qmail@betelgeuse.wayne.fnx.com>
+ Subject: [PATCH 5.00475] Tweaking pod/perlfunc.pod
+ --
+ Date: Fri, 17 Jul 1998 22:58:05 -0400 (EDT)
+ Message-ID: <19980718025805.7135.qmail@betelgeuse.wayne.fnx.com>
+ Subject: [PATCH, 5.00475], pod/perlsub.pod
+ --
+ Date: Sat, 18 Jul 1998 04:02:00 -0400 (EDT)
+ Message-ID: <19980718080200.9927.qmail@betelgeuse.wayne.fnx.com>
+ Subject: [PATCH 5.00475] pod/perlfunc.pod
+ Branch: perl
+ ! pod/perlfunc.pod pod/perlguts.pod pod/perlsub.pod
+ ! pod/perlsyn.pod
+____________________________________________________________________________
+[ 1589] By: gsar on 1998/07/21 02:44:25
+ Log: VMS patches from Dan Sugalski <sugalskd@osshe.edu>
+ Date: Wed, 15 Jul 1998 09:38:12 -0700
+ Message-Id: <3.0.5.32.19980715093812.00a42a50@ous.edu>
+ Subject: [PATCH 5.005-beta1]Quick VMS config update
+ --
+ Date: Wed, 15 Jul 1998 12:53:52 -0700
+ Message-Id: <3.0.5.32.19980715125352.00a25cb0@ous.edu>
+ Subject: Re: $ebcdic has broken VMS in _75 (Now with doc patch!)
+ --
+ Date: Thu, 16 Jul 1998 11:15:44 -0700
+ Message-Id: <3.0.5.32.19980716111544.00b78770@ous.edu>
+ Subject: [PATCH 5.004_75]Another VMS tweak for the Vax C compiler
+ --
+ Date: Thu, 16 Jul 1998 11:21:55 -0700
+ Message-Id: <3.0.5.32.19980716112155.00a66c50@ous.edu>
+ Subject: [PATCH 5.004_75]Get archname correct for thread build on VMS
+ --
+ Date: Thu, 16 Jul 1998 11:25:04 -0700
+ Message-Id: <3.0.5.32.19980716112504.00ae0d50@ous.edu>
+ Subject: [PATCH 5.004_75]Thread build tweaks for VMS 6.2 and older
+ --
+ Date: Fri, 17 Jul 1998 15:29:13 -0700
+ Message-Id: <3.0.5.32.19980717152913.00a469b0@ous.edu>
+ Subject: [PATCH 5.004_75]Missed a header file in VMS build procedure
+ --
+ Date: Mon, 20 Jul 1998 10:20:49 -0700
+ Message-Id: <3.0.5.32.19980720102049.00a05100@ous.edu>
+ Subject: [PATCH 5.004_75]Tweaks to Thread.XS for OLD_PTHREADS_API build
+ --
+ Date: Mon, 20 Jul 1998 10:13:03 -0700
+ Message-Id: <3.0.5.32.19980720101303.00a17100@ous.edu>
+ Subject: [PATCH 5.004_75]Explicitly specify extensions during VMS config process
+ --
+ From: Brad Hughes <brad@tgsmc.com>
+ Date: Mon, 20 Jul 1998 15:51:22 -0700
+ Message-Id: <3.0.5.32.19980720155122.00a41950@ous.edu>
+ Subject: patch for readme.vms
+ Branch: perl
+ ! README.vms ext/Thread/Thread.xs vms/descrip_mms.template
+ ! vms/gen_shrfls.pl vms/subconfigure.com
+____________________________________________________________________________
+[ 1588] By: gsar on 1998/07/21 01:26:20
+ Log: change#1481 didn't go through at all, redo it
+ Branch: perl
+ ! t/base/rs.t
+____________________________________________________________________________
+[ 1587] By: gsar on 1998/07/21 01:21:41
+ Log: workaround C<"foo" "bar"> catenation-intolerant compilers
+ Branch: perl
+ ! regexec.c toke.c
+____________________________________________________________________________
+[ 1586] By: gsar on 1998/07/21 01:05:49
+ Log: do not override PERL_DESTRUCT_LEVEL if use has it set
+ Branch: perl
+ ! t/TEST
+____________________________________________________________________________
+[ 1585] By: gsar on 1998/07/21 00:39:17
+ Log: fix small memory leak when mess_sv happens to be touched by magic
+ Branch: perl
+ ! perl.c t/lib/thread.t t/op/local.t t/op/pat.t t/op/regexp.t
+____________________________________________________________________________
+[ 1584] By: gsar on 1998/07/21 00:37:32
+ Log: fix memory leak in C<local(*foo) = 'bar'>
+ Branch: perl
+ ! scope.c
+____________________________________________________________________________
+[ 1583] By: TimBunce on 1998/07/20 22:14:11
+ Log: Update Changes and patchlevel.h for release. At last.
+ Branch: maint-5.004/perl
+ ! Changes patchlevel.h
+____________________________________________________________________________
+[ 1582] By: gsar on 1998/07/20 21:28:43
+ Log: add rsfp_filters and perldb to pollutants list
+ Branch: perl
+ ! embed.pl
+____________________________________________________________________________
+[ 1581] By: nick on 1998/07/20 19:22:37
+ Log: Integrate mainline pre-beta2 - just in case
+ Branch: ansiperl
+ !> (integrate 66 files)
+____________________________________________________________________________
+[ 1580] By: TimBunce on 1998/07/20 17:16:38
+ Log: Assorted patches:
+
+ Title: "Clean up hash array allocation"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199807201052.GAA13336@aatma.engin.umich.edu>
+ Files: hv.c
+
+ Title: "Further fixes for cppstdin on HP-UX 11"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980720124202.6585B-100000@newton.phys>
+ Files: hints/hpux.sh
+ Branch: maint-5.004/perl
+ ! hints/hpux.sh hv.c
+____________________________________________________________________________
+[ 1579] By: TimBunce on 1998/07/20 09:46:14
+ Log: Assorted patches:
+
+ Title: "Fix C<$1 .. $2> coredump under debugger"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199807200042.UAA23288@aatma.engin.umich.edu>
+ Files: pp_ctl.c
+
+ Title: "Fix lvalue leaks stemming from failure to free LvTARG(sv)"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199807191829.OAA12433@aatma.engin.umich.edu>
+ Files: embed.h perl.h proto.h global.sym mg.c sv.c t/op/substr.t t/op/vec.t
+
+ Title: "fix major bug (from 5.003_96); void contexts were using the context
+ of the enclosing sub!"
+ From: Francois Desarmenien <desar@club-internet.fr>, Gurusamy Sarathy
+ <gsar@engin.umich.edu>
+ Msg-ID: <199807180927.FAA08032@aatma.engin.umich.edu>,
+ <35B1CA51.A606AD27@club-internet.fr>
+ Files: op.h
+
+ Title: "Update lib/Getopt/Long.pm (from perl5.005 beta 1)"
+ From: Johan Vromans <jvromans@squirrel.nl>
+ Msg-ID: <13745.47704.943964.34613@phoenix.squirrel.nl>
+ Files: lib/Getopt/Long.pm
+
+ Title: "Add Porting/p4d2p utility for converting perforce diffs"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199807200002.UAA21398@aatma.engin.umich.edu>
+ Files: MANIFEST Porting/p4d2p
+ Branch: maint-5.004/perl
+ + Porting/p4d2p
+ ! MANIFEST embed.h global.sym lib/Getopt/Long.pm mg.c op.h
+ ! perl.h pp_ctl.c proto.h sv.c t/op/substr.t t/op/vec.t
+____________________________________________________________________________
+[ 1578] By: gsar on 1998/07/20 09:38:39
+ Log: complete s/foo/PL_foo/ changes (all escaped cases identified with
+ brute force search script). Result builds and passes all tests on
+ Solaris. win32 and PERL_OBJECT are still untested.
+ Branch: perl
+ ! XSLock.h XSUB.h bytecode.h bytecode.pl byterun.c cc_runtime.h
+ ! djgpp/djgpp.c embed.pl ext/B/B.xs ext/B/B/Asmdata.pm
+ ! ext/B/byteperl.c ext/DB_File/DB_File.xs ext/DB_File/typemap
+ ! ext/DynaLoader/dl_dld.xs ext/DynaLoader/dl_next.xs
+ ! ext/DynaLoader/dl_vms.xs ext/GDBM_File/typemap ext/IO/IO.xs
+ ! ext/IPC/SysV/SysV.xs ext/NDBM_File/typemap
+ ! ext/ODBM_File/ODBM_File.xs ext/ODBM_File/typemap
+ ! ext/Opcode/Opcode.xs ext/POSIX/POSIX.xs ext/SDBM_File/typemap
+ ! ext/Thread/Thread.xs ext/attrs/attrs.xs fakethr.h gv.c hv.c
+ ! lib/ExtUtils/typemap malloc.c mg.c op.c os2/OS2/PrfDB/PrfDB.xs
+ ! os2/OS2/PrfDB/typemap os2/OS2/REXX/REXX.xs os2/os2.c
+ ! os2/os2ish.h perl.c perl.h pp.c pp_ctl.c pp_hot.c pp_sys.c
+ ! regcomp.c regcomp.h regexec.c scope.c scope.h sv.h taint.c
+ ! toke.c util.c vms/ext/DCLsym/DCLsym.xs vms/ext/Stdio/Stdio.xs
+ ! vms/vms.c vms/vmsish.h win32/win32.c win32/win32thread.c
+____________________________________________________________________________
+[ 1577] By: TimBunce on 1998/07/20 08:28:17
+ Log: Title: "Make failed matches return empty list in list context"
+ From: "Paul E. Maisano" <pem@aaii.oz.au>, Gurusamy Sarathy
+ <gsar@engin.umich.edu>, Paul Maisano <pem@aaii.oz.au>
+ Msg-ID: <199807200002.UAA21398@aatma.engin.umich.edu>,
+ <199807200027.KAA27815@ironbark-ridge.aaii.oz.au>,
+ <35B156FB.504E66E@aaii.oz.au>
+ Files: pod/perlop.pod pp_hot.c t/op/pat.t
+ Branch: maint-5.004/perl
+ ! pod/perlop.pod pp_hot.c t/op/pat.t
+____________________________________________________________________________
+[ 1576] By: TimBunce on 1998/07/20 08:11:37
+ Log: Title: "win32 update from 5.005 beta 2 for 5.004_05"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199807192332.TAA20905@aatma.engin.umich.edu>
+ Files: win32/include/dirent.h win32/include/sys/socket.h proto.h
+ lib/ExtUtils/Liblist.pm lib/ExtUtils/Mksymlists.pm
+ win32/win32.h win32/win32iop.h README.win32 installperl
+ pp_ctl.c win32/Makefile win32/config.bc win32/config.vc
+ win32/config_H.bc win32/config_H.vc win32/config_h.PL
+ win32/config_sh.PL win32/dl_win32.xs win32/makedef.pl
+ win32/makefile.mk win32/pod.mak win32/win32.c
+ win32/win32sck.c win32/bin/pl2bat.pl
+ Branch: maint-5.004/perl
+ ! README.win32 installperl lib/ExtUtils/Liblist.pm
+ ! lib/ExtUtils/Mksymlists.pm pp_ctl.c proto.h win32/Makefile
+ ! win32/bin/pl2bat.pl win32/config.bc win32/config.vc
+ ! win32/config_H.bc win32/config_H.vc win32/config_h.PL
+ ! win32/config_sh.PL win32/dl_win32.xs win32/include/dirent.h
+ ! win32/include/sys/socket.h win32/makedef.pl win32/makefile.mk
+ ! win32/pod.mak win32/win32.c win32/win32.h win32/win32iop.h
+ ! win32/win32sck.c
+____________________________________________________________________________
+[ 1575] By: gsar on 1998/07/20 01:27:14
+ Log: integrate ansi branch to get s/foo/PL_foo/ changes
+ Branch: perl
+ +> fixvars
+ !> (integrate 537 files)
+____________________________________________________________________________
+[ 1574] By: gsar on 1998/07/20 00:33:43
+ Log: fix C<$1 .. $2> coredump under debugger
+ Branch: perl
+ ! pp_ctl.c
+____________________________________________________________________________
+[ 1573] By: gsar on 1998/07/20 00:28:27
+ Log: misc win32 config tweaks
+ Branch: perl
+ ! win32/Makefile win32/config.bc win32/config.gc win32/config.vc
+ ! win32/config_h.PL win32/makefile.mk
+____________________________________________________________________________
+[ 1572] By: nick on 1998/07/19 19:04:58
+ Log: Missed file that had changed
+ Branch: ansiperl
+ ! embedvar.h
+____________________________________________________________________________
+[ 1571] By: nick on 1998/07/19 18:57:35
+ Log: Another threaded, perl malloc issue, x2p's Makefile.SH has a
+ pattern match...
+ Branch: ansiperl
+ ! x2p/Makefile.SH
+____________________________________________________________________________
+[ 1570] By: nick on 1998/07/19 18:16:20
+ Log: Drat! - threaded perl-malloc has mutex that needs PL_
+ Branch: ansiperl
+ ! malloc.c perl.h
+____________________________________________________________________________
+[ 1569] By: nick on 1998/07/19 17:55:22
+ Log: PL_ for perl's malloc
+ Branch: ansiperl
+ ! hv.c malloc.c
+____________________________________________________________________________
+[ 1568] By: nick on 1998/07/19 16:23:30
+ Log: PL_ minir tidy up
+ Branch: ansiperl
+ ! embed.pl ext/Thread/Thread.xs util.c
+____________________________________________________________________________
+[ 1567] By: nick on 1998/07/19 13:21:07
+ Log: Add PL_ to merged file
+ Branch: ansiperl
+ ! pp_hot.c
+____________________________________________________________________________
+[ 1566] By: nick on 1998/07/19 12:38:30
+ Log: Merge Mainline
+ Branch: ansiperl
+ + fixvars
+ !> (integrate 29 files)
+____________________________________________________________________________
+[ 1565] By: gsar on 1998/07/19 07:06:54
+ Log: tweak pod in MakeMaker.pm
+ From: Paul Johnson <pjcj@transeda.com>
+ Date: Sat, 18 Jul 1998 15:58:48 +0100
+ Message-ID: <19980718155847.D903@west-tip.transeda.com>
+ Subject: [PATCH]5.004_75 (DOC) MakeMaker.pm
+ Branch: perl
+ ! lib/ExtUtils/MakeMaker.pm
+____________________________________________________________________________
+[ 1564] By: gsar on 1998/07/19 07:04:45
+ Log: From: Gisle Aas <gisle@aas.no>
+ Date: 17 Jul 1998 22:49:32 +0200
+ Message-ID: <m390lsb3tv.fsf@furu.g.aas.no>
+ Subject: [PATCH _75] sv_gets() did not NUL-terminate SV when reading records
+ Branch: perl
+ ! sv.c
+____________________________________________________________________________
+[ 1563] By: gsar on 1998/07/19 07:03:32
+ Log: update freebsd hints
+ From: Mik Firestone <fireston@lexmark.com>
+ Date: Fri, 17 Jul 1998 15:24:26 -0400 (EDT)
+ Message-Id: <199807171924.AA05297@interlock2.lexmark.com>
+ Subject: [PATCH 5.005b1] hints/freebsd.sh
+ Branch: perl
+ ! hints/freebsd.sh
+____________________________________________________________________________
+[ 1562] By: gsar on 1998/07/19 07:01:33
+ Log: From: Mark Bixby <markb@spock.dis.cccd.edu>
+ Date: Fri, 17 Jul 1998 10:37:49 -0700 (PDT)
+ Message-Id: <199807171737.KAA06967@spock.dis.cccd.edu>
+ Subject: [PATCH 5.005b1] MPE/iX hints and readme tweaks
+ Branch: perl
+ ! README.mpeix hints/mpeix.sh
+____________________________________________________________________________
+[ 1561] By: gsar on 1998/07/19 07:00:19
+ Log: From: Norton Allen <allen@huarp.harvard.edu>
+ Date: Fri, 17 Jul 1998 12:37:27 -0400 (edt)
+ Message-Id: <199807171637.MAA24830@bottesini.harvard.edu>
+ Subject: [PATCH: 75] make install fails
+ Branch: perl
+ ! Makefile.SH
+____________________________________________________________________________
+[ 1560] By: gsar on 1998/07/19 06:58:55
+ Log: fix flawed substitution-loop detection on zero-length matches
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Fri, 17 Jul 1998 13:55:38 -0400 (EDT)
+ Message-Id: <199807171755.NAA27720@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_72] Substitution loop in devel branch
+ Branch: perl
+ ! pp_hot.c t/op/subst.t
+____________________________________________________________________________
+[ 1559] By: gsar on 1998/07/19 06:56:19
+ Log: add perltrap entry about "${#a}", as suggested by
+ andy barfoot <abarfoot@eng.auburn.edu>
+ Branch: perl
+ ! pod/perltrap.pod
+____________________________________________________________________________
+[ 1558] By: gsar on 1998/07/19 06:43:53
+ Log: From: Anton Berezin <tobez@plab.ku.dk>
+ Date: Fri, 17 Jul 1998 11:49:30 +0200 (CEST)
+ Message-Id: <199807170949.LAA18099@lion.plab.ku.dk>
+ Subject: [PATCH 5.005b1] perlcall.pod SAVETMPS/FREETMPS bracket
+ Branch: perl
+ ! pod/perlcall.pod
+____________________________________________________________________________
+[ 1557] By: gsar on 1998/07/19 06:40:33
+ Log: From: "Art Green" <Art_Green@mercmarine.com>
+ Date: Thu, 16 Jul 1998 21:37:05 -0500
+ Message-ID: <86256644.000E61D4.00@FDLTest1.mercmarine.com>
+ Subject: [PATCH]:_75 - Update hints/aix.sh for c_r library
+ Branch: perl
+ ! hints/aix.sh
+____________________________________________________________________________
+[ 1556] By: gsar on 1998/07/19 06:38:17
+ Log: update README.threads
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Thu, 16 Jul 1998 11:10:33 -0400 (EDT)
+ Message-Id: <Pine.SUN.3.96.980716110949.2651J-100000@newton.phys>
+ Subject: Re: Sort of OK: 5.005-beta1 and threads on ppc-powerux-threads
+ Branch: perl
+ ! README.threads
+____________________________________________________________________________
+[ 1555] By: gsar on 1998/07/19 06:36:32
+ Log: From: Scott Henry <scotth@sgi.com>
+ Date: 15 Jul 1998 20:23:02 -0700
+ Message-ID: <yd890lu1nu1.fsf@hoshi.engr.sgi.com>
+ Subject: [PATCH 5.005-beta1] update hints/irix_6.sh
+ Branch: perl
+ ! hints/irix_6.sh
+____________________________________________________________________________
+[ 1554] By: gsar on 1998/07/19 06:35:10
+ Log: From: Spider Boardman <spider@web.zk3.dec.com>
+ Date: Wed, 15 Jul 1998 16:56:48 -0400
+ Message-Id: <199807152056.QAA369057@web.zk3.dec.com>
+ Subject: [PATCH _75] dec_osf hints still wrong
+ Branch: perl
+ ! hints/dec_osf.sh
+____________________________________________________________________________
+[ 1553] By: gsar on 1998/07/19 06:33:29
+ Log: tweak hpux hints in vain attempt to get cppstdin set properly
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Wed, 15 Jul 1998 16:11:43 -0400 (EDT)
+ Subject: Re: HP-UX 11, perl 5.004_04, Oracle 7.3.3.4, DBI 0.93
+ Message-Id: <Pine.SUN.3.96.980715161018.1560D-100000@newton.phys>
+ --
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Thu, 16 Jul 1998 11:37:58 -0400 (EDT)
+ Subject: Re: Configure misses preprocessor on HP-UX
+ Message-Id: <Pine.SUN.3.96.980716113128.2651N-100000@newton.phys>
+ Branch: perl
+ ! hints/hpux.sh
+____________________________________________________________________________
+[ 1552] By: gsar on 1998/07/19 06:26:24
+ Log: From: Tye McQueen <tye@metronet.com>
+ Date: Wed, 15 Jul 1998 13:46:44 -0500 (CDT)
+ Message-Id: <199807151846.AA12653@metronet.com>
+ Subject: Minor debugger fix
+ Branch: perl
+ ! lib/perl5db.pl
+____________________________________________________________________________
+[ 1551] By: gsar on 1998/07/19 06:25:05
+ Log: From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Wed, 15 Jul 1998 14:23:39 -0400 (EDT)
+ Message-Id: <Pine.SUN.3.96.980715135257.1310F-100000@newton.phys>
+ Subject: Re: Configure s?rand support [PATCH 5.004_75] -- better patch
+ Branch: perl
+ ! INSTALL pp.c
+____________________________________________________________________________
+[ 1550] By: gsar on 1998/07/19 06:23:10
+ Log: minor re.pm cleanup
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Date: Wed, 15 Jul 1998 12:41:14 +0100
+ Message-Id: <E0ywPvu-0003V7-00@ursa.cus.cam.ac.uk>
+ Subject: Re: [PATCH 5.004_74]Don't use tainted REs in Basename.pm when building perl
+ Branch: perl
+ ! ext/re/re.pm pod/perldiag.pod
+____________________________________________________________________________
+[ 1549] By: gsar on 1998/07/19 06:20:49
+ Log: export additional symbols on OS/2
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Wed, 15 Jul 1998 06:13:07 -0400 (EDT)
+ Message-Id: <199807151013.GAA11279@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_72] Export more symbols from Perl DLL
+ Branch: perl
+ ! os2/os2.sym
+____________________________________________________________________________
+[ 1548] By: gsar on 1998/07/19 06:18:58
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Wed, 15 Jul 1998 06:10:36 -0400 (EDT)
+ Message-Id: <199807151010.GAA11270@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_72] Minor improvements to perlcc
+ Branch: perl
+ ! utils/perlcc.PL
+____________________________________________________________________________
+[ 1547] By: gsar on 1998/07/19 06:17:22
+ Log: applied slightly tweaked version of patch
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Thu, 16 Jul 1998 15:49:15 -0400 (EDT)
+ Message-Id: <199807161949.PAA08214@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_72] Updated patch to Test::Harness
+ Branch: perl
+ ! lib/Test/Harness.pm
+____________________________________________________________________________
+[ 1546] By: gsar on 1998/07/19 06:11:03
+ Log: improve 'frame' handling in debugger
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Wed, 15 Jul 1998 00:52:10 -0400 (EDT)
+ Message-Id: <199807150452.AAA06685@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_72] Better debugger trace
+ Branch: perl
+ ! lib/perl5db.pl
+____________________________________________________________________________
+[ 1545] By: gsar on 1998/07/19 06:07:51
+ Log: fix and test handling of literal newlines in heredocs
+ From: Gisle Aas <gisle@aas.no>
+ Date: 17 Jul 1998 14:58:25 +0200
+ Message-ID: <m3iukw63da.fsf@furu.g.aas.no>
+ Subject: Re: [PATCH _71] CRs et al
+ --
+ From: larry@wall.org (Larry Wall)
+ Date: Fri, 17 Jul 1998 09:32:35 -0700
+ Message-Id: <199807171632.JAA12959@wall.org>
+ Subject: Re: [PATCH _71] CRs et al
+ Branch: perl
+ ! t/comp/multiline.t toke.c
+____________________________________________________________________________
+[ 1544] By: gsar on 1998/07/19 06:00:12
+ Log: remove possibly unwritable lib/re.pm before overwrite
+ From: larry@wall.org (Larry Wall)
+ Date: Wed, 15 Jul 1998 14:26:03 -0700
+ Message-Id: <199807152126.OAA04623@wall.org>
+ Subject: Re: bug encountered building perl5.005beta1
+ Branch: perl
+ ! Makefile.SH
+____________________________________________________________________________
+[ 1543] By: gsar on 1998/07/19 05:56:18
+ Log: unsubmitted Changes tweak
+ Branch: perl
+ ! Changes cygwin32/ld2
+____________________________________________________________________________
+[ 1542] By: gsar on 1998/07/19 01:21:22
+ Log: make failed matches return empty list in list context
+ Branch: perl
+ ! pod/perlop.pod pp_hot.c t/op/pat.t
+____________________________________________________________________________
+[ 1541] By: gsar on 1998/07/18 22:27:59
+ Log: remove obsolete perltrap about m//g's pos() reset behavior
+ Branch: perl
+ ! pod/perltrap.pod
+____________________________________________________________________________
+[ 1540] By: nick on 1998/07/18 22:16:26
+ Log: PL_ stuff passes non-threaded on Mingw32
+ (Why did it compile without this fix?)
+ Branch: ansiperl
+ ! pp_sys.c
+____________________________________________________________________________
+[ 1539] By: TimBunce on 1998/07/18 22:04:58
+ Log: Assorted patches:
+
+ Title: "Minor fixes to MakeMaker docs re ExtUtils::Embed"
+ From: Paul Johnson <pjcj@transeda.com>
+ Msg-ID: <19980718155847.D903@west-tip.transeda.com>
+ Files: lib/ExtUtils/MakeMaker.pm
+
+ Title: "Update t/op/array.t (from 5.005 beta 1)"
+ Files: t/op/array.t
+ Branch: maint-5.004/perl
+ ! lib/ExtUtils/MakeMaker.pm t/op/array.t
+____________________________________________________________________________
+[ 1538] By: TimBunce on 1998/07/18 21:57:50
+ Log: Title: "Remove flawed '// with parens or $&' performance patch (Change 662)"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Tim Bunce <Tim.Bunce@ig.co.uk>,
+ larry@wall.org (Larry Wall)
+ Msg-ID: <19980717015308.E6244@ig.co.uk>, <199807171819.LAA13771@wall.org>,
+ <E0yvtzn-0002F9-00@ursa.cus.cam.ac.uk>
+ Files: cop.h embed.h perl.h proto.h regexp.h gv.c interp.sym perl.c pp.c
+ pp_ctl.c pp_hot.c regexec.c scope.c
+ Branch: maint-5.004/perl
+ ! cop.h embed.h gv.c interp.sym perl.c perl.h pp.c pp_ctl.c
+ ! pp_hot.c proto.h regexec.c regexp.h scope.c
+____________________________________________________________________________
+[ 1537] By: nick on 1998/07/18 20:56:58
+ Log: PL_ scheme Builds under Minw32 - some SEGFAULT snags
+ Branch: ansiperl
+ ! doio.c mg.c perl.c pp_hot.c pp_sys.c util.c win32/perllib.c
+ ! win32/win32.c win32/win32.h
+____________________________________________________________________________
+[ 1536] By: nick on 1998/07/18 20:50:26
+ Log: Merge latest mainline
+ Branch: ansiperl
+ ! patchlevel.h
+ !> ext/Thread/Thread.xs op.h util.c
+____________________________________________________________________________
+[ 1535] By: nick on 1998/07/18 16:45:29
+ Log: Edited "behind my back" ...
+ Branch: ansiperl
+ ! vms/perly_c.vms
+____________________________________________________________________________
+[ 1534] By: nick on 1998/07/18 16:38:27
+ Log: PL_ stuff for threads
+ Branch: ansiperl
+ ! byterun.c cop.h deb.c doio.c doop.c embed.pl embedvar.h
+ ! ext/B/B.xs ext/Thread/Thread.xs gv.c intrpvar.h mg.c
+ ! miniperlmain.c op.c op.h perl.c perl.h perly.y pp.c pp.h
+ ! pp_ctl.c pp_hot.c pp_sys.c regexec.c run.c scope.c sv.c sv.h
+ ! thread.h toke.c util.c win32/perllib.c
+____________________________________________________________________________
+[ 1533] By: nick on 1998/07/18 14:30:54
+ Log: Builds and passes tests with -DMULTIPLICITY and -DCRIPPLED_CC
+ (still with PERL_GLOBAL_STRUCT) - to cover more #if branches
+ Branch: ansiperl
+ ! embed.pl intrpvar.h perl.c toke.c
+____________________________________________________________________________
+[ 1532] By: nick on 1998/07/18 13:53:03
+ Log: PL_ prefix to all perlvars, part1
+ Builds and passes all tests at one limit i.e. -DPERL_GLOBAL_STRUCT
+ Branch: ansiperl
+ ! XSUB.h av.c bytecode.h byterun.c byterun.h cop.h deb.c doio.c
+ ! doop.c dump.c embed.h embed.pl embedvar.h ext/B/B.xs
+ ! ext/Data/Dumper/Dumper.xs ext/DynaLoader/dl_next.xs
+ ! ext/ODBM_File/ODBM_File.xs ext/Opcode/Opcode.xs
+ ! ext/POSIX/POSIX.xs ext/Socket/Socket.xs ext/attrs/attrs.xs
+ ! ext/re/re.xs gv.c hv.c hv.h lib/ExtUtils/typemap
+ ! lib/ExtUtils/xsubpp mg.c miniperlmain.c op.c perl.c perl.h
+ ! perly.c perly.y pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c regcomp.c
+ ! regcomp.h regexec.c run.c scope.c scope.h sv.c sv.h taint.c
+ ! thrdvar.h toke.c universal.c util.c
+____________________________________________________________________________
+[ 1531] By: gsar on 1998/07/18 08:48:13
+ Log: fix yet another USE_THREADS leak due to failure to free stacks
+ Branch: perl
+ ! ext/Thread/Thread.xs util.c
+____________________________________________________________________________
+[ 1530] By: gsar on 1998/07/18 08:46:58
+ Log: fix major bug in GIMME (introduced in 5.003_96); void contexts were
+ using the context of the enclosing sub!
+ Branch: perl
+ ! op.h
+____________________________________________________________________________
+[ 1529] By: nick on 1998/07/18 08:18:03
+ Log: Integrate post-beta tweaks to ansiperl
+ Branch: ansiperl
+ !> ObjXSub.h embed.h ext/Thread/Thread.xs global.sym gv.c mg.c
+ !> objpp.h op.c perl.c perl.h pp_sys.c proto.h sv.c t/op/substr.t
+ !> t/op/vec.t toke.c util.c
+____________________________________________________________________________
+[ 1528] By: gsar on 1998/07/18 04:23:12
+ Log: fix lvalue leaks stemming from failure to free LvTARG(sv)
+ Branch: perl
+ ! ObjXSub.h embed.h global.sym mg.c objpp.h perl.h proto.h sv.c
+ ! t/op/substr.t t/op/vec.t
+____________________________________________________________________________
+[ 1527] By: gsar on 1998/07/18 02:16:40
+ Log: check ferror() only if read() returned 0
+ Branch: perl
+ ! pp_sys.c
+____________________________________________________________________________
+[ 1526] By: gsar on 1998/07/18 02:08:01
+ Log: fix another CvMUTEXP() leak
+ Branch: perl
+ ! gv.c
+____________________________________________________________________________
+[ 1525] By: TimBunce on 1998/07/18 01:51:52
+ Log: Assorted patches:
+
+ Title: "Fix @a=@a=qw(...) properly"
+ From: Stephen McCamant <alias@mcs.com>
+ Msg-ID: <13742.49404.367751.437966@alias-2.pr.mcs.net>
+ Files: opcode.h
+
+ Title: "Larry's patch to support CR LF in scripts (updated)"
+ From: Gisle Aas <gisle@aas.no>, larry@wall.org (Larry Wall)
+ Msg-ID: <199807120054.RAA19550@wall.org>, <m3iukw63da.fsf@furu.g.aas.no>
+ Files: t/comp/multiline.t toke.c
+
+ Title: "Change getc() docs to match behaviour. Make read() return undef on
+ error."
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199807052257.SAA10004@aatma.engin.umich.edu>
+ Files: pod/perlfunc.pod pp_sys.c
+
+ Title: "Update patchls utility"
+ Files: Porting/patchls
+ Branch: maint-5.004/perl
+ ! Porting/patchls opcode.h pod/perlfunc.pod pp_sys.c
+ ! t/comp/multiline.t toke.c
+____________________________________________________________________________
+[ 1524] By: gsar on 1998/07/18 01:22:35
+ Log: fix CvMUTEXP() leaks with -Dusethreads
+ Branch: perl
+ ! op.c toke.c
+____________________________________________________________________________
+[ 1523] By: gsar on 1998/07/18 01:17:28
+ Log: fix $/ init for multiple interpreters/threads
+ Branch: perl
+ ! ext/Thread/Thread.xs perl.c util.c
+____________________________________________________________________________
+[ 1522] By: gsar on 1998/07/18 01:11:07
+ Log: fix missing init that caused RE alternations to fail under
+ -Dusethreads
+ Branch: perl
+ ! util.c
+____________________________________________________________________________
+[ 1521] By: TimBunce on 1998/07/16 22:23:25
+ Log: Assorted patches:
+
+ Title: "Allow $SIG{CHLD}='IGNORE' to work (reap zombies) on Solaris"
+ From: Albert Dvornik <bert@genscan.com>, Chip Salzenberg <chip@perl.org>
+ Msg-ID: <19980708181055.A8005@perlsupport.com>,
+ <tqn2adkvge.fsf@puma.genscan.com>
+ Files: util.c
+
+ Title: "Document perltrap on precedence of keys/values/each"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199807151857.OAA04704@aatma.engin.umich.edu>
+ Files: pod/perltrap.pod
+
+ Title: "perlbook.pod patch"
+ From: Tom Christiansen <tchrist@chthon.perl.com>
+ Msg-ID: <199807140037.SAA04556@chthon.perl.com>
+ Files: pod/perlbook.pod
+
+ Title: "perlmod.pod patch"
+ From: Tom Christiansen <tchrist@chthon.perl.com>
+ Msg-ID: <199807140109.TAA04678@chthon.perl.com>
+ Files: pod/perlmod.pod
+
+ Title: "Fix bug in IO::Handle->input_record_separator"
+ From: Robin Barker <rmb1@cise.npl.co.uk>, Swen Thuemmler
+ <Swen.Thuemmler@paderlinx.de>
+ Msg-ID: <199807161400.PAA25532@tempest.cise.npl.co.uk>,
+ <Pine.GSO.4.00.9807161649380.6537-100000@rmail>
+ Files: ext/IO/lib/IO/Handle.pm
+
+ Title: "update h2ph, Math::Complex and Math::Trig (from 5.005 beta 1)"
+ Files: lib/Math/Complex.pm lib/Math/Trig.pm t/lib/complex.t t/lib/h2ph.t
+ t/lib/trig.t utils/h2ph.PL
+
+ Title: "Update hints/irix_6.sh"
+ From: Scott Henry <scotth@sgi.com>
+ Msg-ID: <yd890lu1nu1.fsf@hoshi.engr.sgi.com>
+ Files: hints/irix_6.sh
+
+ Title: "Configure misses preprocessor on HP-UX (further fix)"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980716113128.2651N-100000@newton.phys>
+ Files: hints/hpux.sh
+
+ Title: "update perlbug to v1.26 (from 5.005 beta 1)"
+ Files: utils/perlbug.PL
+ Branch: maint-5.004/perl
+ ! ext/IO/lib/IO/Handle.pm hints/hpux.sh hints/irix_6.sh
+ ! lib/Math/Complex.pm lib/Math/Trig.pm pod/perlbook.pod
+ ! pod/perlmod.pod pod/perltrap.pod t/lib/complex.t t/lib/h2ph.t
+ ! t/lib/trig.t util.c utils/h2ph.PL utils/perlbug.PL
+____________________________________________________________________________
+[ 1520] By: TimBunce on 1998/07/15 21:24:12
+ Log: Assorted patches:
+
+ Title: "Add stub attrs.pm"
+ From: Graham Barr <gbarr@ti.com>, Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <19980713163312.A18222@asic.sc.ti.com>,
+ <199807132140.RAA09583@aatma.engin.umich.edu>
+ Files: MANIFEST lib/attrs.pm
+
+ Title: "Fix @a=@a=qw(...)"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>, Stephen McCamant
+ <alias@mcs.com>
+ Msg-ID: <13737.12300.950886.821143@alias-2.pr.mcs.net>,
+ <199807122351.TAA05649@aatma.engin.umich.edu>
+ Files: op.c opcode.pl t/op/array.t
+
+ Title: "Fix 'PERL_DESTRUCT_LEVEL=2 ./perl -DD -e 1' loop"
+ From: Gisle Aas <gisle@aas.no>, Stephen McCamant <alias@mcs.com>
+ Msg-ID: <13739.55551.205810.338648@alias-2.pr.mcs.net>,
+ <m33ec4jdwn.fsf@furu.g.aas.no>
+ Files: sv.c
+
+ Title: "Make Power MachTen use vfork() and system malloc()"
+ From: Dominic Dunlop <domo@computer.org>, Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <v03110700b1c95b010820@[195.95.102.91]>
+ Files: hints/machten.sh malloc.c
+
+ Title: "Use REG_INFTY in place of hardwired constant"
+ From: Dominic Dunlop <domo@computer.org>
+ Msg-ID: <v03110703b1ca662c44f8@[195.95.102.91]>
+ Files: regcomp.h regcomp.c regexec.c
+
+ Title: "Minor debugger fix (history adds an extra newline)"
+ From: Tye McQueen <tye@metronet.com>
+ Msg-ID: <199807151846.AA12653@metronet.com>
+ Files: lib/perl5db.pl
+
+ Title: "Protect Term::ReadLine against non-default $/ value"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>,
+ kstar@chapin.edu@ig.co.uk ()
+ Msg-ID: <19980713151749.G8596@O2.chapin.edu>,
+ <199807132139.RAA11270@monk.mps.ohio-state.edu>
+ Files: lib/Term/ReadLine.pm
+
+ Title: "Fix HP-UX 11 build (cppstdin)"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980715161018.1560D-100000@newton.phys>
+ Files: Configure hints/hpux.sh
+
+ Title: "VMS filetest operator fixup (SS$_ACCONFLICT)"
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Msg-ID: <3.0.5.32.19980702135255.00a6ad90@ous.edu>
+ Files: vms/vms.c
+ Branch: maint-5.004/perl
+ + lib/attrs.pm
+ ! Configure MANIFEST hints/hpux.sh hints/machten.sh
+ ! lib/Term/ReadLine.pm lib/perl5db.pl malloc.c op.c opcode.pl
+ ! regcomp.c regcomp.h regexec.c sv.c t/op/array.t vms/vms.c
+____________________________________________________________________________
+[ 1519] By: nick on 1998/07/15 18:56:17
+ Log: Integrate mainline at beta1
+ Branch: ansiperl
+ +> Porting/p4d2p README.mpeix Todo-5.005
+ +> ext/DynaLoader/dl_mpeix.xs ext/re/hints/mpeix.pl
+ +> mpeix/mpeixish.h mpeix/nm mpeix/relink perly_c.diff
+ +> pod/perld4.pod pod/perlport.pod t/lib/ipc_sysv.t
+ - Todo.5.005 lib/Bundle/CPAN.pm perly.c.diff pod/perldelta4.pod
+ - t/op/ipcmsg.t t/op/ipcsem.t
+ !> (integrate 167 files)
----------------
-Version 5.003_94
+Version 5.004_75 5.005 Public Beta, Issue 1
----------------
- CORE LANGUAGE CHANGES
-
- Title: "Defer creation of array and hash elements as parameters"
- From: Chip Salzenberg
- Files: dump.c global.sym mg.c op.c op.h perl.h pp.c pp_hot.c proto.h
- sv.c
-
- Title: "New special literal: __PACKAGE__"
- From: Chip Salzenberg
- Files: keywords.pl pod/perldata.pod toke.c
-
- Title: "Ignore whitespace before +*? in //x"
- From: Chip Salzenberg
- Files: regcomp.c
-
- Title: "Abort compilation at C<BEGIN{}> or C<use> after errors"
- From: Chip Salzenberg
- Files: op.c pod/perldiag.pod t/pragma/subs.t
-
- Title: "allow C<substr 'hello', -10>"
- From: David Dyck <dcd@tc.fluke.com>
- Msg-ID: <97Mar10.155517pst.35716-2@gateway.fluke.com>
- Date: Mon, 10 Mar 1997 15:55:44 -0800
- Files: pp.c
-
- Title: "Regularize C<x % y>, esp. when y is negative"
- From: Chip Salzenberg
- Files: pp.c
-
- Title: "Flush before C<flock(FOO, LOCK_UN)>"
- From: Chip Salzenberg
- Files: pod/perldelta.pod pod/perlfunc.pod pp_sys.c
-
- Title: "Close loopholes in prototype mismatch warning"
- From: Chip Salzenberg
- Files: op.c sv.c toke.c
-
- Title: "Warn on C<while ($x = each %y) {}>"
- From: Chip Salzenberg
- Files: op.c pod/perldiag.pod
-
- Title: "Don't warn on C<print $fh func()>"
- From: Chip Salzenberg
- Files: toke.c
-
- CORE PORTABILITY
-
- Title: "Don't say 'static var = 1'"
- From: Jarkko Hietaniemi
- Msg-ID: <199703091319.PAA24714@alpha.hut.fi>
- Date: Sun, 9 Mar 1997 15:19:57 +0200 (EET)
- Files: malloc.c
-
- Title: "BSD/OS 3.0 hints"
- From: Christopher Davis <ckd@loiosh.kei.com>
- Msg-ID: <w47mjakw5t.fsf@loiosh.kei.com>
- Date: 14 Mar 1997 16:20:46 -0500
- Files: hints/bsdos.sh
-
- Title: "More MachTen hints"
- From: Tom Phoenix
- Msg-ID: <Pine.GSO.3.95q.970316133852.27997A-100000@kelly.teleport.com
- Date: Sun, 16 Mar 1997 13:40:35 -0800 (PST)
- Files: hints/machten_2.sh
-
- Title: "HP/UX hint comments"
- From: Andy Dougherty
- Msg-ID: <Pine.SOL.3.95q.970321153918.28770B-100000@fractal.lafayette.
- Date: Fri, 21 Mar 1997 15:43:07 -0500 (EST)
- Files: hints/hpux.sh
-
- Title: "VMS update"
- From: Charles Bailey
- Msg-ID: <1997Mar11.220056.1873182@hmivax.humgen.upenn.edu>
- Date: Tue, 11 Mar 1997 22:00:55 -0500 (EST)
- Files: lib/ExtUtils/MM_VMS.pm lib/Test/Harness.pm t/op/taint.t
- utils/perlbug.PL vms/descrip.mms
-
- Title: "vmsish.t and related patches"
- From: Charles Bailey
- Msg-ID: <01IGQW3IP1KK005VFB@hmivax.humgen.upenn.edu>
- Date: Fri, 21 Mar 1997 01:32:47 -0500 (EST)
- Files: MANIFEST perl.h vms/descrip.mms vms/ext/vmsish.t vms/vms.c
-
- Title: "Win32 update (four patches)"
- From: Gurusamy Sarathy and Nick Ing-Simmons
- Files: MANIFEST README.win32 lib/AutoSplit.pm lib/Cwd.pm
- lib/ExtUtils/Command.pm lib/ExtUtils/Install.pm
- lib/ExtUtils/MM_OS2.pm lib/ExtUtils/MM_Unix.pm
- lib/ExtUtils/MM_Win32.pm lib/ExtUtils/MakeMaker.pm
- lib/ExtUtils/Mksymlists.pm lib/File/Basename.pm
- lib/File/Path.pm mg.c t/comp/cpp.t t/comp/script.t t/harness
- t/io/argv.t t/io/dup.t t/io/fs.t t/io/inplace.t
- t/lib/filehand.t t/lib/io_dup.t t/lib/io_sel.t
- t/lib/io_taint.t t/op/closure.t t/op/exec.t t/op/glob.t
- t/op/goto.t t/op/magic.t t/op/misc.t t/op/rand.t
- t/op/split.t t/op/stat.t t/op/sysio.t t/op/taint.t
- t/pragma/strict.t t/pragma/subs.t t/pragma/warning.t util.c
- win32/*
-
- OTHER CORE CHANGES
-
- Title: "Guard against buffer overflow in yyerror() and related funcs"
- From: Chip Salzenberg
- Files: toke.c
-
- Title: "For bin compat, rename calllist() and he_{,delay}free"
- From: Chip Salzenberg
- Files: global.sym hv.c op.c perl.c pod/perlguts.pod proto.h
-
- Title: "Fix C<print> on tied default handle"
- From: Chip Salzenberg
- Files: pp_hot.c
-
- Title: "Fix C<local($a, undef, $b) = (1,2,3)>"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Improve diagnostic on C<@a++>, C<--%a>, @a =~ s/a/b/"
- From: Chip Salzenberg
- Files: pp.c pp_hot.c
-
- Title: "Don't warn on C<$x{y} .= "z"> when %x is tied"
- From: Chip Salzenberg
- Files: pp_hot.c
-
- Title: "Eliminate 'unreachable code' warnings"
- From: Chip Salzenberg
- Files: ext/POSIX/POSIX.xs mg.c pp_ctl.c toke.c
-
- Title: "printf format corrections for -DDEBUGGING"
- From: Roderick Schertler
- Msg-ID: <26592.858793370@eeyore.ibcinc.com>
- Date: Wed, 19 Mar 1997 12:42:50 -0500
- Files: doop.c malloc.c op.c pp_ctl.c regexec.c sv.c x2p/str.c
- x2p/util.c
-
- Title: "Warn about missing -DMULTIPLICITY if likely a problem"
- From: Doug MacEachern
- Msg-ID: <199703192345.SAA15070@postman.osf.org>
- Date: Wed, 19 Mar 1997 18:45:53 -0500
- Files: perl.c
-
- BUILD PROCESS
-
- Title: "Don't use $(LIBS) when creating shared libperl"
- From: Chip Salzenberg
- Files: Makefile.SH
-
- Title: "Don't use db 2.x, we're not yet ready for it"
- From: Paul Marquess and Andy Dougherty
- Files: Configure
-
- Title: "Warn if #! command is longer than 32 chars"
- From: Chip Salzenberg
- Files: Configure
-
- Title: "patches re perl -wc install{perl,man}"
- From: Robin Barker <rmb1@cise.npl.co.uk>
- Msg-ID: <21544.9703111313@tempest.cise.npl.co.uk>
- Date: Tue, 11 Mar 97 13:13:16 GMT
- Files: installman installperl
-
- Title: "3_93 doesn't install pods"
- From: Spider Boardman
- Msg-ID: <199703160721.CAA08339@Orb.Nashua.NH.US>
- Date: Sun, 16 Mar 1997 02:21:35 -0500
- Files: installperl
-
- Title: "When installing, use File::Copy instead of `cp`"
- From: Chip Salzenberg
- Files: installperl
-
- Title: "Make hint files' warnings more visible"
- From: Hallvard B Furuseth
- Msg-ID: <199703202218.XAA09041@bombur2.uio.no>
- Date: Thu, 20 Mar 1997 23:18:03 +0100 (MET)
- Files: hints/3b1.sh hints/apollo.sh hints/cxux.sh hints/dcosx.sh
- hints/dgux.sh hints/esix4.sh hints/freebsd.sh hints/hpux.sh
- hints/irix_4.sh hints/mips.sh hints/next_3_0.sh hints/os2.sh
- hints/qnx.sh hints/sco_2_3_3.sh hints/sco_2_3_4.sh
- hints/solaris_2.sh hints/ultrix_4.sh hints/utekv.sh
-
- LIBRARY AND EXTENSIONS
-
- Title: "New module: autouse.pm"
- From: Ilya Zakharevich
- Msg-ID: <199703210034.TAA13469@monk.mps.ohio-state.edu>
- Date: Thu, 20 Mar 1997 19:34:30 -0500 (EST)
- Files: MANIFEST lib/autouse.pm
-
- Title: "Math::Complex update"
- From: Jarkko Hietaniemi
- Files: lib/Math/Complex.pm t/lib/complex.t
-
- Title: "Refresh DB_File to 1.12"
- From: Paul Marquess
- Msg-ID: <9703121551.AA07435@claudius.bfsec.bt.co.uk>
- Date: Wed, 12 Mar 97 15:51:14 GMT
- Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs
-
- Title: "New subroutine Symbol::qualify_to_ref()"
- From: Roderick Schertler
- Msg-ID: <pzlo7ut03b.fsf@eeyore.ibcinc.com>
- Date: 11 Mar 1997 19:39:36 -0500
- Files: lib/Symbol.pm
-
- Title: "In debugger, don't reference %{$f{$g}} if $f{$g} doesn't exist"
- From: Chip Salzenberg
- Files: lib/perl5db.pl
-
- Title: "In File::Path, some systems can't remove read-only files"
- From: Chip Salzenberg
- Files: lib/File/Path.pm
-
- Title: "Fix typo in -l*perl* pattern"
- From: Doug MacEachern
- Msg-ID: <199703110414.XAA12884@berlin.atlantic.net>
- Date: Mon, 10 Mar 1997 22:58:38 -0500
- Files: lib/ExtUtils/Embed.pm
-
- Title: "Fix bugs revealed by prototype warnings"
- From: Chip Salzenberg
- Files: ext/Opcode/Opcode.pm lib/ExtUtils/MakeMaker.pm
- lib/Getopt/Long.pm
-
- Title: "Problems with SKIP in makemaker"
- From: Ilya Zakharevich
- Msg-ID: <199703210413.XAA21601@monk.mps.ohio-state.edu>
- Date: Thu, 20 Mar 1997 23:13:31 -0500 (EST)
- Files: lib/ExtUtils/MM_Unix.pm
-
- Title: "In Exporter, don't C<require Carp> at file scope"
- From: Chip Salzenberg
- Files: lib/Exporter.pm
-
- Title: "fix for Exporter's $SIG{__WARN__} handler"
- From: Roderick Schertler
- Msg-ID: <2282.858296451@eeyore.ibcinc.com>
- Date: Thu, 13 Mar 1997 18:40:51 -0500
- Files: lib/Exporter.pm
-
- Title: "Don't try to substr() refs in Carp"
- From: Chip Salzenberg
- Files: lib/Carp.pm
-
- Title: "Re: NUL in die and other messages"
- From: "M.J.T. Guy"
- Msg-ID: <E0w815V-0005xs-00@ursa.cus.cam.ac.uk>
- Date: Fri, 21 Mar 1997 09:58:17 +0000
- Files: lib/Carp.pm
-
- Title: "Add entry for prototype() in Pod::Functions"
- From: Chip Salzenberg
- Files: lib/Pod/Functions.pm
-
- Title: "Fix typos in IO::Socket documentation"
- From: "M.J.T. Guy"
- Msg-ID: <E0w75po-0003yh-00@taurus.cus.cam.ac.uk>
- Date: Tue, 18 Mar 1997 20:50:16 +0000
- Files: ext/IO/lib/IO/Socket.pm
-
- TESTS
-
- (no other changes)
-
- UTILITIES
-
- Title: "Re: bug in pod2man (5.00326): section=3 for .pm modules"
- From: Roderick Schertler
- Msg-ID: <pzn2sat1hg.fsf@eeyore.ibcinc.com>
- Date: 11 Mar 1997 19:09:31 -0500
- Files: pod/pod2man.PL
-
- DOCUMENTATION
-
- Title: "perlfaq.pod"
- From: Tom Christiansen
- Msg-ID: <199703172301.QAA12566@jhereg.perl.com>
- Date: Mon, 17 Mar 1997 16:01:40 -0700
- Files: MANIFEST pod/Makefile pod/buildtoc pod/perl.pod
- pod/perlfaq*.pod pod/roffitall
-
- Title: "*.pod changes based on the FAQ"
- From: gnat@frii.com
- Msg-ID: <199703171650.JAA02655@elara.frii.com>
- Date: Mon, 17 Mar 1997 09:50:14 -0700 (MST)
- Files: pod/perldata.pod pod/perlfunc.pod pod/perlipc.pod
- pod/perlop.pod pod/perlre.pod pod/perlrun.pod
- pod/perlsec.pod pod/perlvar.pod
-
- Title: "INSTALL: How to enable debugging"
- From: Andy Dougherty
- Msg-ID: <Pine.SOL.3.95q.970321112326.1414A-100000@fractal.lafayette.e
- Date: Fri, 21 Mar 1997 11:25:32 -0500 (EST)
- Files: INSTALL
-
- Title: "Document that $. is not reset on implicit open"
- From: Chip Salzenberg
- Files: pod/perldelta.pod
-
- Title: "Re: Embedding success with _93 "
- From: Doug MacEachern
- Msg-ID: <199703112255.RAA22775@postman.osf.org>
- Date: Tue, 11 Mar 1997 17:55:05 -0500
- Files: pod/perldelta.pod
-
- Title: "Update site list"
- From: lvirden@cas.org (Larry W. Virden, x2487)
- Msg-ID: <9703111053.AA20051@cas.org>
- Date: Tue, 11 Mar 1997 10:53:49 -0500
- Files: pod/perlmod.pod
-
- Title: "Patch to document illegal characters"
- From: Tom Phoenix
- Msg-ID: <Pine.GSO.3.96.970314090558.15346J-100000@kelly.teleport.com>
- Date: Fri, 14 Mar 1997 09:08:10 -0800 (PST)
- Files: pod/perldiag.pod pod/perltrap.pod
-
- Title: "Document trap with //o and closures"
- From: Charles Bailey
- Msg-ID: <01IGCHWRNSEU00661G@hmivax.humgen.upenn.edu>
- Date: Mon, 10 Mar 1997 18:08:08 -0500 (EST)
- Files: pod/perltrap.pod
-
- Title: "Re: Inline PI function"
- From: Tom Phoenix
- Msg-ID: <Pine.GSO.3.95q.970310143125.22489V-100000@kelly.teleport.com
- Date: Mon, 10 Mar 1997 14:33:20 -0800 (PST)
- Files: pod/perlsub.pod
-
- Title: "Illegal character in input"
- From: Tom Phoenix
- Msg-ID: <Pine.GSO.3.95q.970310151512.22489a-100000@kelly.teleport.com
- Date: Mon, 10 Mar 1997 15:21:21 -0800 (PST)
- Files: pod/perldiag.pod
-
- Title: "Patch for docs Re: Lost backslash"
- From: Tom Phoenix
- Msg-ID: <Pine.GSO.3.96.970319071438.24834G-100000@kelly.teleport.com>
- Date: Wed, 19 Mar 1997 07:28:57 -0800 (PST)
- Files: pod/perlop.pod
-
- Title: "XSUB's doc fix"
- From: Roderick Schertler
- Msg-ID: <28804.858012126@eeyore.ibcinc.com>
- Date: Mon, 10 Mar 1997 11:42:06 -0500
- Files: pod/perlcall.pod pod/perlguts.pod pod/perlxstut.pod
-
- Title: "Document return from do FILE"
- From: "M.J.T. Guy"
- Msg-ID: <E0w70DK-0001yJ-00@ursa.cus.cam.ac.uk>
- Date: Tue, 18 Mar 1997 14:50:10 +0000
- Files: pod/perlfunc.pod
-
- Title: "Document $^M in perlvar"
- From: Robin Barker <rmb1@cise.npl.co.uk>
- Msg-ID: <6153.9703202108@tempest.cise.npl.co.uk>
- Date: Thu, 20 Mar 97 21:08:33 GMT
- Files: pod/perlvar.pod
-
- Title: "typos in pods of 5.003_93"
- From: Jim Meyering <meyering@asic.sc.ti.com>
- Msg-ID: <wpgendbzvhx.fsf@asic.sc.ti.com>
- Date: 19 Mar 1997 10:39:38 -0600
- Files: pod/perlfunc.pod pod/perlguts.pod pod/perlre.pod
- pod/perltoot.pod pod/perlxs.pod
-
- Title: "Re: Updates to pod punctuations"
- From: lvirden@cas.org (Larry W. Virden, x2487)
- Msg-ID: <9703141700.AA22911@cas.org>
- Date: Fri, 14 Mar 1997 17:00:12 -0500
- Files: pod/*.pod
-
- Title: "clarify example in perlfunc"
- From: Jarkko Hietaniemi
- Msg-ID: <199703201746.TAA25195@alpha.hut.fi>
- Date: Thu, 20 Mar 1997 19:46:01 +0200 (EET)
- Files: pod/perlfunc.pod
-
- Title: "Regularize headings in DB_File documentation"
- From: Chip Salzenberg
- Files: ext/DB_File/DB_File.pm
-
+____________________________________________________________________________
+[ 1518] By: gsar on 1998/07/15 10:01:41
+ Log: add stub docs for ext/B, other minor tweaks
+ Branch: perl
+ ! Changes Porting/config_H config_h.SH ext/B/B.pm
+ ! ext/B/B/Asmdata.pm ext/B/B/Assembler.pm ext/B/B/Bblock.pm
+ ! ext/B/B/Bytecode.pm ext/B/B/C.pm ext/B/B/CC.pm
+ ! ext/B/B/Debug.pm ext/B/B/Disassembler.pm ext/B/B/Showlex.pm
+ ! ext/B/B/Stackobj.pm ext/B/B/Terse.pm ext/B/O.pm sv.c
+____________________________________________________________________________
+[ 1517] By: gsar on 1998/07/15 08:27:15
+ Log: up patchlevel to 75 (Beta, Issue 1), add podpatch
+ From: abigail@fnx.com
+ Date: Wed, 15 Jul 1998 04:03:44 -0400 (EDT)
+ Message-ID: <19980715080344.21975.qmail@betelgeuse.wayne.fnx.com>
+ Subject: [PATCH 5.004_74] pod/perlop.pod
+ Branch: perl
+ ! Changes patchlevel.h pod/perlop.pod win32/Makefile
+ ! win32/config_H.bc win32/config_H.gc win32/config_H.vc
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 1516] By: gsar on 1998/07/15 08:04:24
+ Log: From: abigail@fnx.com
+ Date: Wed, 15 Jul 1998 03:47:56 EDT
+ Message-Id: <19980715074756.21868.qmail@betelgeuse.wayne.fnx.com>
+ Subject: [PATCH 5.004_74] pod/pod2man.PL Fix use of < inside C<>
+ Branch: perl
+ ! pod/pod2man.PL
+____________________________________________________________________________
+[ 1515] By: gsar on 1998/07/15 08:02:14
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Wed, 15 Jul 1998 03:49:24 EDT
+ Message-Id: <199807150749.DAA09177@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_72] Additional targets for OS/2 build
+ Branch: perl
+ ! os2/Makefile.SHs
+____________________________________________________________________________
+[ 1514] By: gsar on 1998/07/15 07:58:29
+ Log: rename some long file names to be 8.3 truncation-safe
+ Branch: perl
+ +> Todo-5.005 perly_c.diff pod/perld4.pod
+ - Todo.5.005 perly.c.diff pod/perldelta4.pod
+ ! MANIFEST Porting/pumpkin.pod perly.fixer
+____________________________________________________________________________
+[ 1513] By: gsar on 1998/07/15 07:35:29
+ Log: minor tweaks to docs on qr//
+ Branch: perl
+ ! ext/re/re.pm pod/perldelta.pod pod/perlop.pod pod/perlre.pod
+____________________________________________________________________________
+[ 1512] By: gsar on 1998/07/15 07:06:02
+ Log: applied patch, with tab tweak suggest by Peter Prymmer
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Date: Tue, 14 Jul 1998 16:41:14 -0700
+ Message-Id: <3.0.5.32.19980714164114.00a3e2a0@ous.edu>
+ Subject: [PATCH 5.004_74]VMS build cleanups
+ Branch: perl
+ ! vms/descrip_mms.template
+____________________________________________________________________________
+[ 1511] By: gsar on 1998/07/15 07:03:33
+ Log: allow perlbug -ok when STDIN it not a tty
+ From: Hugo van der Sanden <hv@crypt0.demon.co.uk>
+ Date: Wed, 15 Jul 1998 03:24:56 +0200
+ Message-Id: <l03130302b1d1b1e7c2a0@[194.222.64.89]>
+ Subject: Re: [NOT OK] 5.004_74: "make ok" not ok in IRIX 6.2
+ Branch: perl
+ ! utils/perlbug.PL
+____________________________________________________________________________
+[ 1510] By: gsar on 1998/07/15 06:59:43
+ Log: From: "Art Green" <Art_Green@mercmarine.com>
+ Date: Tue, 14 Jul 1998 20:53:48 -0500
+ Message-ID: <86256642.0004D7AB.00@FDLTest1.mercmarine.com>
+ Subject: [PATCH]:_74 - Allow Configure to recognize _AIX41 & _POWER compiler defines
+ Branch: perl
+ ! Configure
+____________________________________________________________________________
+[ 1509] By: gsar on 1998/07/15 06:57:50
+ Log: typecast long vs. IV compares in pp_flip/pp_flop
+ Branch: perl
+ ! pp_ctl.c
+____________________________________________________________________________
+[ 1508] By: gsar on 1998/07/15 06:50:49
+ Log: don't copy foreach itervar when no external refs exist
+ From: Gisle Aas <gisle@aas.no>
+ Date: 15 Jul 1998 03:35:25 +0200
+ Message-ID: <m33ec3nbfm.fsf@furu.g.aas.no>
+ Subject: Re: Testcase for 1..n closure change
+ Branch: perl
+ ! pp_hot.c
+____________________________________________________________________________
+[ 1507] By: gsar on 1998/07/15 06:46:41
+ Log: applied patch, regen headers
+ From: Stephen McCamant <alias@mcs.com>
+ Date: Tue, 14 Jul 1998 19:56:47 -0500 (CDT)
+ Message-ID: <13739.64763.792570.626015@alias-2.pr.mcs.net>
+ Subject: B::Deparse update for qr// and regcreset
+ Branch: perl
+ ! ext/B/B/Deparse.pm opcode.h opcode.pl
+____________________________________________________________________________
+[ 1506] By: gsar on 1998/07/15 06:43:04
+ Log: make pregcomp et al VIRTUAL again for PERL_OBJECT
+ From: "Douglas Lankshear" <dougl@ActiveState.com>
+ Date: Tue, 14 Jul 1998 16:40:30 -0700
+ Message-ID: <000301bdaf80$c93d14a0$a32fa8c0@tau.Active>
+ Subject: [PATCH 5.004_74]
+ Branch: perl
+ ! proto.h
+____________________________________________________________________________
+[ 1505] By: gsar on 1998/07/15 06:41:43
+ Log: dont use sv_dump() in -DD diagnostic
+ From: Gisle Aas <gisle@aas.no>
+ Date: 14 Jul 1998 23:55:36 +0200
+ Message-ID: <m33ec4jdwn.fsf@furu.g.aas.no>
+ Subject: [PATCH] Fix 'PERL_DESTRUCT_LEVEL=2 ./perl -DD -e 1' loop
+ Branch: perl
+ ! sv.c
+____________________________________________________________________________
+[ 1504] By: gsar on 1998/07/15 06:39:37
+ Log: add a few more thread.t tests
+ Branch: perl
+ ! t/lib/thread.t
+____________________________________________________________________________
+[ 1503] By: gsar on 1998/07/15 06:31:33
+ Log: fix thread.t ('join $t' ne '$t->join' !)
+ Branch: perl
+ ! t/lib/thread.t
+____________________________________________________________________________
+[ 1502] By: gsar on 1998/07/15 06:26:00
+ Log: From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Wed, 15 Jul 1998 01:45:57 +0300 (EET DST)
+ Message-Id: <199807142245.BAA09651@alpha.hut.fi>
+ Subject: [PATCH] 5.004_74: MPE/iX final touches
+ Branch: perl
+ ! installperl lib/File/Copy.pm
+____________________________________________________________________________
+[ 1501] By: gsar on 1998/07/15 05:59:49
+ Log: apply (reversed) patch
+ From: Peter Wolfe <wolfe@titan.teloseng.com>
+ Date: Tue, 14 Jul 1998 13:01:58 -0700 (PDT)
+ Message-Id: <199807142001.NAA26550@titan.teloseng.com>
+ Subject: NOT_OK: perl 5.00474 on SCO 3.2v5.0.4
+ Branch: perl
+ ! ext/IPC/SysV/SysV.xs
+____________________________________________________________________________
+[ 1500] By: gsar on 1998/07/15 05:57:39
+ Log: From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Tue, 14 Jul 1998 14:14:59 -0400 (EDT)
+ Message-Id: <Pine.SUN.3.96.980714141346.29710D-100000@newton.phys>
+ Subject: [PATCH 5.004_74] Config_74-01
+ Branch: perl
+ ! Configure MANIFEST Porting/Glossary Porting/config.sh
+ ! Porting/config_H Porting/pumpkin.pod config_h.SH
+ ! vms/subconfigure.com win32/config.bc win32/config.gc
+ ! win32/config.vc
+____________________________________________________________________________
+[ 1499] By: gsar on 1998/07/15 05:48:38
+ Log: From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Tue, 14 Jul 1998 21:35:02 +0300 (EET DST)
+ Message-Id: <199807141835.VAA09030@alpha.hut.fi>
+ Subject: [PATCH] 5.004_74: trig.t: math inaccuracy fudge for unicos
+ Branch: perl
+ ! t/lib/trig.t
+____________________________________________________________________________
+[ 1498] By: gsar on 1998/07/15 05:47:33
+ Log: -w, strict clean perldoc (via PM)
+ From: Robin Barker <rmb1@cise.npl.co.uk>
+ Date: Tue, 14 Jul 98 17:22:01 BST
+ Message-Id: <18695.9807141622@tempest.cise.npl.co.uk>
+ Subject: [PATCH 5.004_74] perldoc.PL
+ Branch: perl
+ ! utils/perldoc.PL
+____________________________________________________________________________
+[ 1497] By: gsar on 1998/07/15 05:35:54
+ Log: add comment about cpprun etc., to hints/hpux.sh
+ Branch: perl
+ ! hints/hpux.sh
+____________________________________________________________________________
+[ 1496] By: gsar on 1998/07/15 05:15:16
+ Log: fix warning from CGI::Carp
+ Branch: perl
+ ! lib/CGI/Carp.pm
+____________________________________________________________________________
+[ 1495] By: gsar on 1998/07/14 23:47:18
+ Log: fix off-by-one in win32 registry handling
+ From: "Douglas Lankshear" <dougl@ActiveState.com>
+ Date: Tue, 14 Jul 1998 07:39:06 -0700
+ Message-ID: <000401bdaf35$27489e80$a32fa8c0@tau.Active>
+ Subject: [PATCH 5.004_73]
+ Branch: perl
+ ! win32/win32.c
+____________________________________________________________________________
+[ 1494] By: gsar on 1998/07/14 23:45:58
+ Log: doc patches from Gisle Aas <gisle@aas.no>
+ Date: 14 Jul 1998 16:18:31 +0200
+ Message-ID: <m33ec4cy88.fsf@furu.g.aas.no>
+ Subject: [PATCH] substr/splice changes for perldelta.pod
+ --
+ Date: 14 Jul 1998 20:31:27 +0200
+ Message-ID: <m3hg0kqo74.fsf@furu.g.aas.no>
+ Subject: [PATCH] Duplicate description of use integer %
+ Branch: perl
+ ! pod/perldelta.pod pod/perlop.pod
+____________________________________________________________________________
+[ 1493] By: gsar on 1998/07/14 23:39:31
+ Log: File/Spec.pm needs trailing newline
+ Branch: perl
+ ! lib/File/Spec.pm
+____________________________________________________________________________
+[ 1492] By: gsar on 1998/07/14 21:43:03
+ Log: unsubmitted _74 tweaks
+ Branch: perl
+ ! Changes mpeix/nm mpeix/relink pod/perldelta.pod
+ ! pod/perldiag.pod
----------------
-Version 5.003_93
+Version 5.004_74
----------------
-Me, last time:
- "This release will be the public beta of 5.004,
- or my name isn't Larson T. Pettifogger."
-Me, now:
- "Gone like *that*, a fortune in letterhead."
-
- CORE LANGUAGE CHANGES
-
- Title: "Don't autovivify array and hash elements in sub parameters"
- From: Gurusamy Sarathy
- Msg-ID: <199703061912.OAA20606@aatma.engin.umich.edu>
- Date: Thu, 06 Mar 1997 14:12:09 -0500
- Files: op.c pod/perldelta.pod pod/perlsub.pod pod/perltrap.pod
-
- Title: "Support READ and GETC for tied handles"
- From: Doug MacEachern
- Msg-ID: <199703090019.TAA32591@postman.osf.org>
- Date: Sat, 08 Mar 1997 19:19:38 -0500
- Files: pod/perldelta.pod pod/perltie.pod pp_sys.c t/op/misc.t
-
- Title: "Warn on C<@x =~ /a/> and C<%x =~ s/a/b/>"
- From: Chip Salzenberg
- Files: op.c pod/perldiag.pod
-
- Title: "Warn on %{+undef} and @{+undef}"
- From: Chip Salzenberg
- Files: pp.c pp_hot.c
-
- CORE PORTABILITY
-
- Title: "VMS update"
- From: Charles Bailey
- Msg-ID: <01IG8KN5R28M00661G@hmivax.humgen.upenn.edu>
- Date: Fri, 07 Mar 1997 22:49:46 -0500 (EST)
- Files: lib/ExtUtils/MM_VMS.pm vms/descrip.mms vms/gen_shrfls.pl
- vms/sockadapt.h
-
- Title: "AmigaOS hint patch"
- From: Norbert Pueschel
- Msg-ID: <77724767@Armageddon.meb.uni-bonn.de>
- Date: Sat, 08 Mar 1997 12:50:15 +0100
- Files: hints/amigaos.sh
-
- OTHER CORE CHANGES
-
- Title: "Make conversion of @_ to real array work right after C<shift>"
- From: Chip Salzenberg
- Files: av.c
-
- Title: "Fix imbalanced ENTER/LEAVE from C<BEGIN{die}>"
- From: Chip Salzenberg
- Files: op.c perl.c proto.h
-
- Title: "perl -P path patch"
- From: Andy Dougherty
- Msg-ID: <Pine.SOL.3.95q.970308120242.23766D-100000@fractal.lafayette.
- Date: Sat, 08 Mar 1997 12:45:08 -0500 (EST)
- Files: config_H config_h.SH perl.c plan9/config.plan9 t/comp/cpp.t
- vms/config.vms win32/config.H
-
- BUILD PROCESS
-
- Title: "Fix for Unisys UNIX and libperl.so"
- From: aburlison@cix.compulink.co.uk (Alan Burlison)
- Msg-ID: <memo.147328@cix.compulink.co.uk>
- Date: Thu, 6 Mar 97 16:28 GMT0
- Files: Configure
-
- Title: "Allow './Configure -Uoptimize'"
- From: Andy Dougherty
- Msg-ID: <Pine.SOL.3.95q.970306110532.11070A-100000@fractal.lafayette.
- Date: Thu, 06 Mar 1997 11:15:47 -0500 (EST)
- Files: Configure
-
- Title: "Use 'test -f', not 'test -x'"
- From: Spider Boardman
- Msg-ID: <199703080053.TAA13943@web.zk3.dec.com>
- Date: Fri, 7 Mar 1997 19:53:00 -0500
- Files: Configure
-
- Title: "Don't count on 'trap 0' inside () in shell script"
- From: aburlison@cix.compulink.co.uk (Alan Burlison)
- Msg-ID: <memo.147326@cix.compulink.co.uk>
- Date: Thu, 6 Mar 97 16:28 GMT0
- Files: perl_exp.SH
-
- LIBRARY AND EXTENSIONS
-
- Title: "Carp with multiple arguments"
- From: "M.J.T. Guy"
- Msg-ID: <E0w3STZ-0007RW-00@taurus.cus.cam.ac.uk>
- Date: Sat, 8 Mar 1997 20:12:17 +0000
- Files: lib/Carp.pm
-
- Title: "@EXPORT_FAIL fix for Exporter.pm"
- From: Roderick Schertler
- Msg-ID: <24884.857841724@eeyore.ibcinc.com>
- Date: Sat, 08 Mar 1997 12:22:04 -0500
- Files: lib/Exporter.pm
-
- Title: "Open[23] autoflush docs"
- From: Roderick Schertler
- Msg-ID: <7939.857693947@eeyore.ibcinc.com>
- Date: Thu, 06 Mar 1997 19:19:07 -0500
- Files: lib/IPC/Open2.pm lib/IPC/Open3.pm
-
- TESTS
-
- Title: "Fix counts in output of TEST"
- From: Hugo van der Sanden <hv@iii.co.uk>
- Msg-ID: <331F1507.4BE8@iii.co.uk>
- Date: Thu, 06 Mar 1997 19:03:35 +0000
- Files: t/TEST
-
- Title: "Ignore backup files in strict.t and warning.t"
- From: Chip Salzenberg
- Files: t/pragma/strict.t t/pragma/warning.t
-
- UTILITIES
-
- Title: "Quote pathname before using as pattern"
- From: Chip Salzenberg
- Files: pod/pod2html.PL
-
- DOCUMENTATION
-
- Title: "Consolidated INSTALL updates since _92"
- From: Andy Dougherty
- Msg-ID: <Pine.SOL.3.95q.970308131806.23766F-100000@fractal.lafayette.
- Date: Sat, 08 Mar 1997 13:21:22 -0500 (EST)
-
- Title: "Fix more E-Mail addresses in pods"
- From: Chip Salzenberg
- Files: lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Manifest.pm
- lib/diagnostics.pm pod/buildtoc
-
- Title: "Warn about '.' terminating E-Mail"
- From: Chip Salzenberg
- Files: pod/perlform.pod
-
- Title: "OS/2 doc update"
- From: Ilya Zakharevich
- Msg-ID: <199703080537.AAA25157@monk.mps.ohio-state.edu>
- Date: Sat, 8 Mar 1997 00:37:30 -0500 (EST)
- Files: README.os2
-
- Title: "PODs corrections"
- From: Ilya Zakharevich
- Msg-ID: <199703080253.VAA24975@monk.mps.ohio-state.edu>
- Date: Fri, 7 Mar 1997 21:53:04 -0500 (EST)
- Files: ext/DB_File/DB_File.pm ext/Socket/Socket.pm
- lib/Class/Template.pm lib/ExtUtils/Embed.pm
- lib/ExtUtils/MM_VMS.pm lib/ExtUtils/Mksymlists.pm
- lib/File/Basename.pm lib/File/stat.pm lib/Time/gmtime.pm
- lib/Time/localtime.pm lib/Time/tm.pm lib/User/grent.pm
- lib/User/pwent.pm pod/perlcall.pod pod/perldebug.pod
- pod/perlfunc.pod pod/perlguts.pod pod/perllocale.pod
- pod/perlop.pod pod/perlsub.pod
-
+____________________________________________________________________________
+[ 1491] By: gsar on 1998/07/14 08:48:28
+ Log: up patchlevel to 74; introduce distinct archname for PERL_OBJECT
+ Branch: perl
+ ! Changes patchlevel.h pod/perlhist.pod win32/Makefile
+ ! win32/config_H.bc win32/config_H.gc win32/config_H.vc
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 1490] By: gsar on 1998/07/14 08:31:13
+ Log: From: Gisle Aas <gisle@aas.no>
+ Date: 14 Jul 1998 10:20:34 +0200
+ Message-Id: <m3hg0k973h.fsf@furu.g.aas.no>
+ Subject: [PATCH] Make -DP work (and readable)
+ Branch: perl
+ ! run.c
+____________________________________________________________________________
+[ 1489] By: gsar on 1998/07/14 08:23:46
+ Log: fix function parameter autovivification for pseudohashes
+ Branch: perl
+ ! mg.c t/op/avhv.t
+____________________________________________________________________________
+[ 1488] By: gsar on 1998/07/14 07:34:45
+ Log: merge changes#1423,1465 from maintbranch; checkin two missed files
+ from earlier changes#1461,1478
+ Branch: perl
+ ! pod/perldiag.pod pod/perlfunc.pod pod/perlop.pod pp_sys.c
+ ! t/TEST t/lib/thread.t t/op/local.t t/op/pat.t t/op/regexp.t
+ ! t/op/substr.t t/op/vec.t
+____________________________________________________________________________
+[ 1487] By: gsar on 1998/07/14 07:04:54
+ Log: tweak t/lib/thread.t
+ Branch: perl
+ ! t/lib/thread.t
+____________________________________________________________________________
+[ 1486] By: gsar on 1998/07/14 06:38:15
+ Log: applied patch, slightly tweaked
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Date: Mon, 13 Jul 1998 11:52:27 -0700
+ Message-Id: <3.0.5.32.19980713115227.00a73970@ous.edu>
+ Subject: [PATCH 5.004_73]Get re module working on VMS
+ Branch: perl
+ ! ext/re/Makefile.PL perl.h proto.h
+____________________________________________________________________________
+[ 1485] By: gsar on 1998/07/14 06:32:58
+ Log: add Porting/p4d2p
+ Branch: perl
+ + Porting/p4d2p
+ ! MANIFEST
+____________________________________________________________________________
+[ 1484] By: gsar on 1998/07/14 06:08:20
+ Log: doc patches from Tom Christiansen <tchrist@chthon.perl.com> (via PM)
+ Date: Mon, 13 Jul 1998 19:09:09 -0600
+ Message-Id: <199807140109.TAA04678@chthon.perl.com>
+ Subject: perlmod.pod patch
+ --
+ Date: Mon, 13 Jul 1998 18:37:07 -0600
+ Message-Id: <199807140037.SAA04556@chthon.perl.com>
+ Subject: perlbook.pod patch
+ Branch: perl
+ ! pod/perlbook.pod pod/perlmod.pod
+____________________________________________________________________________
+[ 1483] By: gsar on 1998/07/14 06:04:25
+ Log: OS/2 update
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199807132336.TAA12967@monk.mps.ohio-state.edu>
+ Date: Mon, 13 Jul 1998 19:36:05 -0400 (EDT)
+ Subject: [PATCH 5.004_72] OS/2 system() and friends additions
+ Branch: perl
+ ! README.os2 hints/os2.sh os2/Changes os2/os2.c t/op/magic.t
+____________________________________________________________________________
+[ 1482] By: gsar on 1998/07/14 06:01:12
+ Log: more VMS patches from Dan Sugalski <sugalskd@osshe.edu>
+ Date: Mon, 13 Jul 1998 16:37:49 -0700
+ Message-Id: <3.0.5.32.19980713163749.00af1c40@ous.edu>
+ Subject: [PATCH 5.004_73]t/io/iprefix.t patch for VMS
+ --
+ Date: Mon, 13 Jul 1998 15:51:09 -0700
+ Message-Id: <3.0.5.32.19980713155109.00a52c30@ous.edu>
+ Subject: [PATCH5.004_73]Tweak t/lib/cgi-html.t to work on VMS
+ Branch: perl
+ ! t/io/iprefix.t t/lib/cgi-html.t
+____________________________________________________________________________
+[ 1481] By: gsar on 1998/07/14 05:57:36
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ Date: Mon, 13 Jul 1998 15:41:53 -0700
+ Message-Id: <3.0.5.32.19980713154153.00a87be0@ous.edu>
+ Subject: [PATCH 5.004_73]Fix t/base/rs.t test failures on VMS
+ Branch: perl
+ ! t/base/rs.t
+____________________________________________________________________________
+[ 1480] By: gsar on 1998/07/14 05:56:14
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ Message-Id: <3.0.5.32.19980713150427.00b2a540@ous.edu>
+ Date: Mon, 13 Jul 1998 15:04:27 -0700
+ Subject: [PATCH 5.004_73]Thread tweak for VMS.C
+ Branch: perl
+ ! vms/vms.c
+____________________________________________________________________________
+[ 1479] By: gsar on 1998/07/14 05:55:13
+ Log: From: Laszlo Molnar <molnarl@cdata.tvnet.hu>
+ Date: Mon, 13 Jul 1998 23:13:43 +0200
+ Message-ID: <19980713231343.A178@cdata.tvnet.hu>
+ Subject: [PATCH _72] Configure problem on dos-djgpp
+ Branch: perl
+ ! Configure
+____________________________________________________________________________
+[ 1478] By: gsar on 1998/07/14 05:53:08
+ Log: add files and tweaks needed for MPE/iX port (via PM)
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Tue, 14 Jul 1998 00:07:30 +0300 (EET DST)
+ Message-Id: <199807132107.AAA20603@alpha.hut.fi>
+ Subject: MPE/iX patches for _73
+ Branch: perl
+ + README.mpeix ext/DynaLoader/dl_mpeix.xs ext/re/hints/mpeix.pl
+ + mpeix/mpeixish.h mpeix/nm mpeix/relink
+ ! MANIFEST ext/Socket/Socket.xs hints/mpeix.sh installperl
+ ! lib/File/Copy.pm perl.c perl.h pod/perldelta.pod
+____________________________________________________________________________
+[ 1477] By: gsar on 1998/07/14 04:23:28
+ Log: added suggested patch (via PM), tweaked to implicitly specify -DDEBUGGING
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Mon, 13 Jul 1998 16:50:55 -0400 (EDT)
+ Message-Id: <Pine.SUN.3.96.980713164922.28314B-100000@newton.phys>
+ Subject: Re: _70 and Devel::RE
+ Branch: perl
+ ! ext/re/Makefile.PL ext/re/re.xs regcomp.c regexec.c
+____________________________________________________________________________
+[ 1476] By: gsar on 1998/07/14 04:06:25
+ Log: minor Configure nits
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Mon, 13 Jul 1998 23:25:27 +0300 (EET DST)
+ Message-Id: <199807132025.XAA10771@alpha.hut.fi>
+ Subject: Configure patches for MVS (and one x2p/Makefile.SH)
+ Branch: perl
+ ! Configure x2p/Makefile.SH
+____________________________________________________________________________
+[ 1475] By: gsar on 1998/07/14 03:59:56
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ Date: Mon, 13 Jul 1998 12:54:19 -0700
+ Message-Id: <3.0.5.32.19980713125419.009e0100@ous.edu>
+ Subject: [PATCH 5.004_73] Fixes to the VMS configuration system
+ Branch: perl
+ ! vms/munchconfig.c vms/subconfigure.com
+____________________________________________________________________________
+[ 1474] By: gsar on 1998/07/14 03:58:13
+ Log: make Term::Readline::get_line() independent of caller's $/
+ From: kstar@chapin.edu
+ Date: Mon, 13 Jul 1998 15:17:49 -0400
+ Message-ID: <19980713151749.G8596@O2.chapin.edu>
+ Subject: [PATCH] Was: CPAN.pm still fails
+ Branch: perl
+ ! lib/Term/ReadLine.pm
+____________________________________________________________________________
+[ 1473] By: gsar on 1998/07/14 03:55:29
+ Log: fix $trnl interpolation in here-docs (via PM)
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Mon, 13 Jul 1998 15:49:00 -0400 (EDT)
+ Message-Id: <Pine.SUN.3.96.980713151243.28129F-100000@newton.phys>
+ Subject: Re: [PATCH] 5.004_73: Re: Configure/trnl craziness
+ Branch: perl
+ ! Configure
+____________________________________________________________________________
+[ 1472] By: gsar on 1998/07/14 03:50:18
+ Log: From: Dominic Dunlop <domo@ppp52.vo.lu>
+ Date: Mon, 13 Jul 1998 15:55:09 +0100 (WET DST)
+ Message-Id: <199807131455.PAA23621@ppp52.vo.lu>
+ Subject: Not OK: perl 5.00473 on powerpc-machten 4.1 [PATCH 5.004_73]
+ Branch: perl
+ ! hints/machten.sh
+____________________________________________________________________________
+[ 1471] By: gsar on 1998/07/14 03:49:07
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ Message-Id: <3.0.5.32.19980713123005.00b6be50@ous.edu>
+ Date: Mon, 13 Jul 1998 12:30:05 -0700
+ Subject: [PATCH 5.004_73] Add Data::Dumper and re modules to VMS config stuff
+ Branch: perl
+ ! configure.com vms/descrip_mms.template
+____________________________________________________________________________
+[ 1470] By: gsar on 1998/07/14 03:40:14
+ Log: consistently refer to functions as C<foo()>
+ From: abigail@fnx.com
+ Date: Mon, 13 Jul 1998 03:04:24 -0400 (EDT)
+ Message-ID: <19980713070424.19841.qmail@betelgeuse.wayne.fnx.com>
+ Subject: Re: [PATCH 5.004_71] pod/perlfunc.pod
+ Branch: perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 1469] By: gsar on 1998/07/14 03:35:06
+ Log: From: Tom Hughes <thh@cyberscience.com>
+ Date: 13 Jul 1998 09:34:16 +0100
+ Message-ID: <yekk95i175j.fsf@elva.cyberscience.com>
+ Subject: [PATCH 5.004_72] Fix d_Gconvert definition in hints/svr4.sh
+ Branch: perl
+ ! hints/svr4.sh
+____________________________________________________________________________
+[ 1468] By: gsar on 1998/07/14 03:34:03
+ Log: From: andreas.koenig@kulturbox.de (Andreas J. Koenig)
+ Date: 13 Jul 1998 11:16:27 +0200
+ Message-ID: <sfc90lyqff8.fsf@dubravka.in-berlin.de>
+ Subject: Parallel Makefiles
+ Branch: perl
+ ! lib/ExtUtils/MM_Unix.pm
+____________________________________________________________________________
+[ 1467] By: gsar on 1998/07/14 03:31:39
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Mon, 13 Jul 1998 00:12:19 -0400 (EDT)
+ Message-Id: <199807130412.AAA27128@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_72] t/io/pipe.t - completely broken?
+ Branch: perl
+ ! t/io/pipe.t
+____________________________________________________________________________
+[ 1466] By: gsar on 1998/07/14 03:29:25
+ Log: minor tweaks to perldelta and README.win32
+ Branch: perl
+ ! Changes README.win32 pod/perldelta.pod
+____________________________________________________________________________
+[ 1465] By: TimBunce on 1998/07/13 21:33:45
+ Log: Assorted patches:
+
+ Title: "Fix string substitution returncode problem"
+ From: Dominic Dunlop <domo@vo.lu>, Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199805271236.IAA28213@aatma.engin.umich.edu>,
+ <v03110700b191a557f041@[195.95.102.114]>
+ Files: pp_hot.c
+
+ Title: "umask EXPR is fatal only if (EXPR & 0700) > 0"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199807111656.MAA03310@aatma.engin.umich.edu>
+ Files: pod/perldiag.pod pp_sys.c
+
+ Title: "Remove reference to qsort from perlfunc.pod"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199807111923.PAA05124@aatma.engin.umich.edu>
+ Files: pod/perlfunc.pod
+
+ Title: "Deprecate AvFILL in favor of av_len()"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199807111945.PAA05489@aatma.engin.umich.edu>
+ Files: pod/perlguts.pod
+
+ Title: "Further clarify effects of using quotes with m operator"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199806201921.PAA03829@aatma.engin.umich.edu>
+ Files: pod/perlop.pod
+
+ Title: "Add PERL_DESTRUCT_LEVEL=2 to test suite"
+ From: Tim Bunce
+ Files: t/TEST t/op/local.t t/op/pat.t t/op/regexp.t t/op/substr.t t/op/vec.t
+ Branch: maint-5.004/perl
+ ! pod/perldiag.pod pod/perlfunc.pod pod/perlguts.pod
+ ! pod/perlop.pod pp_hot.c pp_sys.c t/TEST t/op/local.t
+ ! t/op/pat.t t/op/regexp.t t/op/substr.t t/op/vec.t toke.c
----------------
-Version 5.003_92
+Version 5.004_73
----------------
-This release will be the public beta of 5.004, or my name isn't
-Larson T. Pettifogger.
-
- CORE LANGUAGE CHANGES
-
- Title: "Strictly follow lexical context of C<eval ''> and nested subs"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Make ::SUPER and UNIVERSAL work together"
- From: Chip Salzenberg
- Files: gv.c pod/perlguts.pod
-
- CORE PORTABILITY
-
- Title: "HP-UX hint update"
- From: Raphael Manfredi <Raphael_Manfredi@grenoble.hp.com>
- Msg-ID: <1479.857653838@lyon.grenoble.hp.com>
- Date: Thu, 06 Mar 97 14:10:38 +0100
- Files: hints/hpux.sh
-
- Title: "Re: The continuing MachTen saga"
- From: Tom Phoenix
- Msg-ID: <Pine.GSO.3.95q.970305091611.3572E-100000@kelly.teleport.com>
- Date: Wed, 5 Mar 1997 09:47:22 -0800 (PST)
- Files: hints/machten_2.sh
-
- Title: "OS/2 patches"
- From: Ilya Zakharevich
- Msg-ID: <199703060308.WAA22211@monk.mps.ohio-state.edu>
- Date: Wed, 5 Mar 1997 22:08:43 -0500 (EST)
- Files: hints/os2.sh lib/ExtUtils/MakeMaker.pm t/op/taint.t
-
- Title: "VMS patches"
- From: Charles Bailey
- Msg-ID: <01IG5SQE4A6U00661G@hmivax.humgen.upenn.edu>
- Date: Wed, 05 Mar 1997 23:10:24 -0500 (EST)
- Files: lib/ExtUtils/MM_VMS.pm lib/ExtUtils/Manifest.pm perlsdio.h
- t/op/runlevel.t t/op/taint.t vms/descrip.mms vms/perly_c.vms
- vms/sockadapt.c vms/sockadapt.h vms/vms_yfix.pl
-
- OTHER CORE CHANGES
-
- Title: "Make sure $^X is tainted when ARG_ZERO_IS_SCRIPT"
- From: Chip Salzenberg
- Files: toke.c
-
- Title: "Clarify '-T too late' error"
- From: Chip Salzenberg
- Files: perl.c pod/perldiag.pod
-
- Title: "Warn when redefining or undefining a constant sub"
- From: Chip Salzenberg
- Files: pod/perldiag.pod pp.c sv.c
-
- Title: "Don't generate spurious 'not imported' warning"
- From: Chip Salzenberg
- Files: gv.c t/pragma/strict-vars pod/perldiag.pod
-
- Title: "Clarify message re: @host in string"
- From: Chip Salzenberg
- Files: pod/perldiag.pod pod/perltrap.pod toke.c
-
- Title: "Disconnect refs that are targets of pp_readline"
- From: Chip Salzenberg
- Files: pp_hot.c
-
- Title: "Fix typo in test of HvFILL()"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Allow for pad name array to be shorter than pad array"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Eliminate format-string type warnings"
- From: Hallvard B Furuseth
- Msg-ID: <199703030915.KAA11634@bombur2.uio.no>
- Date: Mon, 3 Mar 1997 10:15:11 +0100 (MET)
- Files: doio.c ext/POSIX/POSIX.xs gv.c hints/dec_osf.sh pp.c pp_ctl.c
- pp_hot.c run.c sv.c x2p/a2py.c
-
- Title: "Update copyright dates"
- From: Chip Salzenberg
- Files: *.[hc] x2p/*.[hc] win32/EXTERN.h vms/vmsish.h vms/vms.c
-
- BUILD PROCESS
-
- Title: "near-harmless bug in _91's Configure"
- From: Roderick Schertler
- Msg-ID: <pzg1yfuiza.fsf@eeyore.ibcinc.com>
- Date: 01 Mar 1997 21:26:49 -0500
- Files: Configure
-
- Title: "Change 'continuing anyway' to 'probably harmless'"
- From: Chip Salzenberg
- Files: INSTALL lib/ExtUtils/Liblist.pm
-
- LIBRARY AND EXTENSIONS
-
- Title: "Newer ReadLine"
- From: Ilya Zakharevich
- Msg-ID: <199703040634.BAA19919@monk.mps.ohio-state.edu>
- Date: Tue, 4 Mar 1997 01:34:28 -0500 (EST)
- Files: lib/Term/ReadLine.pm lib/perl5db.pl
-
- Title: "Refresh Getopt::Long to 2.9"
- From: Johan Vromans <jvromans@squirrel.nl>
- Files: lib/Getopt/Long.pm
-
- Title: "Benchmark: using code refs"
- From: Hugo van der Sanden <hv@iii.co.uk>
- Msg-ID: <199703041132.LAA07613@tyree.iii.co.uk>
- Date: Tue, 04 Mar 1997 11:32:11 +0000
- Files: lib/Benchmark.pm
-
- Title: "Fix quotewords"
- From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
- Msg-ID: <199703060755.HAA15060@crypt.compulink.co.uk>
- Date: Thu, 06 Mar 1997 07:55:25 +0000
- Files: lib/Text/ParseWords.pm
-
- Title: "Use IV instead of double for tms structure members"
- From: Chip Salzenberg
- Files: ext/POSIX/POSIX.xs
-
- Title: "Document IO::File::new_tmpfile"
- From: Chip Salzenberg
- Files: ext/IO/lib/IO/File.pm
-
- TESTS
-
- Title: "Make op/TEST silent under -w"
- From: d-lewart@uiuc.edu (Daniel S. Lewart)
- Msg-ID: <199703011821.NAA13037@sinistar.idle.com>
- Date: Sat, 1 Mar 97 12:04:09 CST
- Files: t/TEST
-
- Title: "Smarter t/op/taint.t"
- From: Tom Phoenix
- Msg-ID: <Pine.GSO.3.95q.970303103047.24000A-100000@kelly.teleport.com
- Date: Mon, 3 Mar 1997 10:31:54 -0800 (PST)
- Files: t/op/taint.t
-
- Title: "Fix taint test for systems without csh"
- From: Chip Salzenberg
- Files: t/op/taint.t
-
- Title: "Don't test locales if there is no setlocale()"
- From: Chip Salzenberg
- Files: t/pragma/locale.t
-
- UTILITIES
-
- Title: "Update pod2html"
- From: wmiddlet@Adobe.COM (William Middleton)
- Msg-ID: <199703030025.QAA08106@ducks>
- Date: Sun, 2 Mar 1997 16:25:03 -0800 (PST)
- Files: pod/pod2html.PL
-
- Title: "Support 'long long' in h2ph"
- From: (name lost)
- Files: utils/h2ph.PL
-
- DOCUMENTATION
-
- Title: "Add taint checks and srand to perldelta"
- From: Tom Phoenix
- Msg-ID: <Pine.GSO.3.95q.970302115355.23058D-100000@kelly.teleport.com
- Date: Sun, 2 Mar 1997 11:56:08 -0800 (PST)
- Files: pod/perldelta.pod
-
- Title: "Don't call FileHandle 'deprecated'"
- From: Chip Salzenberg
- Files: pod/perldelta.pod
-
- Title: "Improve sample module header"
- From: Tom Christiansen and Graham Barr
- Msg-ID: <199703011732.KAA14693@jhereg.perl.com>
- Date: Sat, 01 Mar 1997 10:32:31 -0700
- Files: pod/perlmod.pod
-
- Title: "Clarify C<crypt> documentation"
- From: Tom Phoenix
- Msg-ID: <Pine.GSO.3.95q.970228131112.12357D-100000@kelly.teleport.com
- Date: Fri, 28 Feb 1997 13:18:25 -0800 (PST)
- Files: pod/perlfunc.pod
-
- Title: "Update list of CPAN sites"
- From: Jarkko Hietaniemi
- Msg-ID: <199703021454.QAA07446@alpha.hut.fi>
- Date: Sun, 2 Mar 1997 16:54:22 +0200 (EET)
- Files: pod/perlmod.pod
-
- Title: "Enhance description of 'server error'"
- From: Jarkko Hietaniemi
- Msg-ID: <199702041903.VAA16070@alpha.hut.fi>
- Date: Tue, 4 Feb 1997 21:03:23 +0200 (EET)
- Files: pod/perldiag.pod
-
- Title: "Regularize format of E-Mail addresses in *.pod"
- From: Chip Salzenberg
- Files: pod/*.pod
-
+____________________________________________________________________________
+[ 1464] By: gsar on 1998/07/13 04:41:07
+ Log: up patchlevel to 73, update Changes &c.
+ Branch: perl
+ ! Changes patchlevel.h pod/perlhist.pod t/op/array.t
+ ! win32/Makefile win32/config_H.bc win32/config_H.gc
+ ! win32/config_H.vc win32/makefile.mk
+____________________________________________________________________________
+[ 1463] By: gsar on 1998/07/13 02:58:51
+ Log: avoid empty rm -f in MM_Unix.pm
+ Branch: perl
+ ! lib/ExtUtils/MM_Unix.pm
+____________________________________________________________________________
+[ 1462] By: gsar on 1998/07/13 02:54:52
+ Log: update perldelta
+ Branch: perl
+ ! pod/perldelta.pod
+____________________________________________________________________________
+[ 1461] By: gsar on 1998/07/13 02:44:30
+ Log: added patch, tweaked PERL_OBJECT things
+ From: Graham Barr <gbarr@pobox.com>
+ Date: Sun, 12 Jul 1998 19:57:47 CDT
+ Message-Id: <19980712195747.C493@pobox.com>
+ Subject: [ PATCH perl5.004_72] patch to add qr//
+ Branch: perl
+ ! dump.c embed.h ext/Opcode/Opcode.pm global.sym globals.c
+ ! keywords.h keywords.pl op.c op.h opcode.h opcode.pl
+ ! pod/perlfunc.pod pp.c pp_hot.c pp_proto.h proto.h regcomp.c
+ ! regexp.h sv.c t/op/pat.t toke.c
+____________________________________________________________________________
+[ 1460] By: gsar on 1998/07/13 01:25:07
+ Log: add a few more PURIFY guards
+ Branch: perl
+ ! av.c sv.c
+____________________________________________________________________________
+[ 1459] By: gsar on 1998/07/12 23:38:31
+ Log: add tests for change#1458 and then some
+ Branch: perl
+ ! t/op/array.t
+____________________________________________________________________________
+[ 1458] By: gsar on 1998/07/12 22:42:47
+ Log: apply patch for smarter AASSIGN_COMMON detection; regen headers
+ From: Stephen McCamant <alias@mcs.com>
+ Date: Sun, 12 Jul 1998 17:17:00 CDT
+ Message-Id: <13737.12300.950886.821143@alias-2.pr.mcs.net>
+ Subject: [PATCH] @a=@a=qw(1) not working, both 5.004_04 and 5.004_71
+ Branch: perl
+ ! op.c opcode.h opcode.pl
+____________________________________________________________________________
+[ 1457] By: gsar on 1998/07/12 22:06:05
+ Log: small tweaks from Jarkko Hietaniemi <jhi@cc.hut.fi>
+ Branch: perl
+ ! Configure Makefile.SH ext/Socket/Socket.xs perl.c
+____________________________________________________________________________
+[ 1456] By: gsar on 1998/07/12 21:56:39
+ Log: From: Doug MacEachern <dougm@pobox.com>
+ Date: Sun, 12 Jul 1998 14:29:29 -0400
+ Message-Id: <199807121829.OAA00525@postman.opengroup.org>
+ Subject: [PATCH 5.004_72] Embed.pm support for PERL_OBJECT
+ Branch: perl
+ ! lib/ExtUtils/Embed.pm
+____________________________________________________________________________
+[ 1455] By: gsar on 1998/07/12 21:54:02
+ Log: applied installperl patch, corrected other little nits
+ From: andreas.koenig@kulturbox.de (Andreas J. Koenig)
+ Date: 12 Jul 1998 16:27:21 +0200
+ Message-ID: <sfcn2afrvp2.fsf@dubravka.in-berlin.de>
+ Subject: [5.004_72] installperl tweak
+ Branch: perl
+ ! Changes Configure README.win32 installperl win32/makefile.mk
+____________________________________________________________________________
+[ 1454] By: gsar on 1998/07/12 10:14:24
+ Log: update MANIFEST, Changes
+ Branch: perl
+ - lib/Bundle/CPAN.pm
+ ! Changes MANIFEST
----------------
-Version 5.003_91
+Version 5.004_72
----------------
-This is (should be? must be!) the public beta of 5.004.
-
- CORE LANGUAGE CHANGES
-
- Title: "Fix perl_call_*() when !G_EVAL"
- From: Gurusamy Sarathy
- Msg-ID: <199702250725.CAA09192@aatma.engin.umich.edu>,
- <199702251925.OAA15498@aatma.engin.umich.edu>,
- <199702252200.RAA16853@aatma.engin.umich.edu>
- Date: Tue, 25 Feb 1997 02:25:56 -0500
- Files: MANIFEST gv.c interp.sym perl.c perl.h pp_ctl.c pp_sys.c
- t/op/runlevel.t
-
- Title: "Fix taint tests for writeable dirs in $ENV{PATH}"
- From: Chip Salzenberg
- Files: mg.c mg.h pod/perlsec.pod taint.c
-
- Title: "Forbid tainted parameters for truncate()"
- From: Chip Salzenberg
- Files: pp_sys.c
-
- Title: "Don't taint magic hash keys unnecessarily"
- From: Charles Bailey
- Msg-ID: <01IFXL9TY74Y00661G@hmivax.humgen.upenn.edu>
- Date: Fri, 28 Feb 1997 02:11:26 -0500 (EST)
- Files: hv.c
-
- CORE PORTABILITY
-
- Title: "VMS patches post _90"
- From: Charles Bailey
- Msg-ID: <01IFYDE5ZT7O005A53@hmivax.humgen.upenn.edu>
- Date: Fri, 28 Feb 1997 15:26:33 -0500 (EST)
- Files: doio.c mg.c perl.h pp_hot.c t/op/rand.t t/op/taint.t taint.c
- vms/descrip.mms vms/vms.c
-
- Title: "Fix taint check in system() and exec() under VMS and OS/2"
- From: Chip Salzenberg
- Files: pp_sys.c
-
- Title: "If _XOPEN_VERSION >= 4, socket length parameters are size_t"
- From: Michael H. Moran <mhm@austin.ibm.com>
- Files: perl.h pp_sys.c
-
- Title: "Make dooneliner() compile again"
- From: Chip Salzenberg
- Files: pp_sys.c
-
- OTHER CORE CHANGES
-
- Title: "Short-circuit duplicate study() calls"
- From: Chip Salzenberg
- Files: pp.c
-
- Title: "Call sv_set[iu]v() with [IU]V parameter, not [IU]32"
- From: Chip Salzenberg
- Files: perl.c pp.c pp_sys.c toke.c util.c
-
- Title: "Clean up and document API for hashes"
- From: Gurusamy Sarathy
- Msg-ID: <199702251824.NAA14859@aatma.engin.umich.edu>
- Date: Tue, 25 Feb 1997 13:24:02 -0500
- Files: hv.c hv.h pod/perldelta.pod pod/perlguts.pod
-
- Title: "pp_undef was not always freeing memory"
- From: Ilya Zakharevich
- Msg-ID: <199702270653.BAA13949@monk.mps.ohio-state.edu>
- Date: Thu, 27 Feb 1997 01:53:51 -0500 (EST)
- Files: pp.c
-
- Title: "Fix SEGV when debugging with foreach() lvalue patch"
- From: Ilya Zakharevich
- Msg-ID: <199702271924.OAA14557@monk.mps.ohio-state.edu>
- Date: Thu, 27 Feb 1997 14:24:36 -0500 (EST)
- Files: sv.c
-
- Title: "Don't examine rx->exec_tainted if pregexec() fails"
- From: Chip Salzenberg
- Files: pp_hot.c
-
- Title: "Silence bogus typo warning on $DB::postponed"
- From: Gurusamy Sarathy
- Msg-ID: <199702271802.NAA12505@aatma.engin.umich.edu>
- Date: Thu, 27 Feb 1997 13:02:30 -0500
- Files: op.c
-
- BUILD PROCESS
-
- Title: "Sanity check linking with $libs"
- From: Andy Dougherty
- Msg-ID: <Pine.SOL.3.95q.970225221634.2486A-100000@fractal.lafayette.edu>
- Date: Tue, 25 Feb 1997 14:13:45 -0500 (EST)
- Files: Configure
-
- Title: "Flush stdout when printing $randbits guess"
- From: Chip Salzenberg
- Files: Configure
-
- Title: "Configure changes for Irix nm"
- From: Helmut Jarausch and Fabien Tassin
- Files: Configure
-
- Title: "Update OS/2 Configure diff"
- From: Ilya Zakharevich
- Msg-ID: <199702251906.OAA10608@monk.mps.ohio-state.edu>
- Date: Tue, 25 Feb 1997 14:06:23 -0500 (EST)
- Files: os2/diff.configure
-
- LIBRARY AND EXTENSIONS
-
- Title: "Don't require() in a signal handler"
- From: Chip Salzenberg
- Files: lib/perl5db.pl
-
- Title: "Make IPC::Open3 work without fork()"
- From: Ilya Zakharevich
- Msg-ID: <199702251937.OAA10718@monk.mps.ohio-state.edu>
- Date: Tue, 25 Feb 1997 14:37:07 -0500 (EST)
- Files: lib/IPC/Open3.pm
-
- Title: "Follow up on elimination of $` $& $' in libraries"
- From: "M.J.T. Guy"
- Msg-ID: <E0w0Sqc-00046E-00@ursa.cus.cam.ac.uk>
- Date: Fri, 28 Feb 1997 13:59:42 +0000
- Files: lib/Getopt/Long.pm lib/diagnostics.pm
-
- Title: "Don't warn on use of CCFLAGS"
- From: Andreas Koenig
- Msg-ID: <199702251038.LAA13123@anna.in-berlin.de>
- Date: Tue, 25 Feb 1997 11:38:43 +0100
- Files: lib/ExtUtils/MakeMaker.pm
-
- Title: "Allow explicit '-lperl' in link arguments"
- From: Doug MacEachern
- Msg-ID: <199702271625.LAA25402@postman.osf.org>
- Date: Thu, 27 Feb 1997 11:25:04 -0500
- Files: lib/ExtUtils/Embed.pm
-
- TESTS
-
- Title: "New test op/taint.t"
- From: Tom Phoenix
- Msg-ID: <Pine.GSO.3.95q.970225101328.18288M-100000@kelly.teleport.com
- Date: Tue, 25 Feb 1997 11:36:53 -0800 (PST)
- Files: MANIFEST t/op/taint.t
-
- Title: "Patch to t/op/rand.t"
- From: Tom Phoenix
- Msg-ID: <Pine.GSO.3.95q.970225181321.13796Q-100000@kelly.teleport.com
- Date: Tue, 25 Feb 1997 18:19:34 -0800 (PST)
- Files: t/op/rand.t
-
- UTILITIES
-
- Title: "Add --lax option to pod2man; use it in perldoc"
- From: Nat <gnat@frii.com>, Chip Salzenberg
- Files: pod/pod2man.PL utils/perldoc.PL
-
- Title: "Eliminate dead code in pod2man"
- From: Chip Salzenberg
- Files: pod/pod2man.PL
-
- DOCUMENTATION
-
- Title: "Warn about intrusive sfio behavior"
- From: Andy Dougherty
- Msg-ID: <Pine.SOL.3.95q.970228112136.24038G-100000@fractal.lafayette.
- Date: Fri, 28 Feb 1997 11:35:49 -0500 (EST)
- Files: INSTALL
-
- Title: "Updates to perlfunc.pod"
- From: Tom Phoenix (with help from M.J.T. Guy and Tom C.)
- Files: pod/perlfunc.pod
-
- Title: "Move ENVIRONMENT from perl.pod to perlrun.pod"
- From: Chip Salzenberg
- Files: pod/perl.pod pod/perlrun.pod
-
- Title: "Describe PERL_DEBUG_MSTATS in perlrun.pod"
- From: Nat <gnat@frii.com>
- Files: pod/perlrun.pod
-
- Title: "Fix references to perlbug"
- From: Chip Salzenberg
- Files: pod/perl.pod pod/perldelta.pod pod/perllocale.pod
- pod/perltoc.pod
-
+____________________________________________________________________________
+[ 1453] By: gsar on 1998/07/12 10:04:33
+ Log: merge changes 1424, 1428 from maintbranch
+ Branch: perl
+ ! Porting/makerel ext/re/re.pm lib/Sys/Syslog.pm
+____________________________________________________________________________
+[ 1452] By: gsar on 1998/07/12 09:46:40
+ Log: patchlevel up to 72, update Changes, minor tweaks to win32/config*
+ and README.win32
+ Branch: perl
+ ! Changes README.win32 patchlevel.h win32/Makefile
+ ! win32/config_H.bc win32/config_H.gc win32/config_H.vc
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 1451] By: gsar on 1998/07/12 07:01:26
+ Log: generic Configure mods and HAS_GROUP additions to help MiNT/MPEix/MVS
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Sat, 11 Jul 1998 17:51:07 +0300 (EET DST)
+ Message-Id: <199807111451.RAA27010@alpha.hut.fi>
+ Subject: M3 "generic" parts
+ Branch: perl
+ ! Configure Makefile.SH config_h.SH ext/POSIX/POSIX.xs
+ ! ext/SDBM_File/sdbm/sdbm.h lib/ExtUtils/MM_Unix.pm
+ ! makedepend.SH mv-if-diff perl.h plan9/plan9ish.h pp_sys.c
+ ! unixish.h vms/subconfigure.com vms/vmsish.h win32/config_H.bc
+ ! win32/config_H.gc x2p/Makefile.SH
+____________________________________________________________________________
+[ 1450] By: gsar on 1998/07/12 06:38:27
+ Log: various tweaks for PERL_OBJECT build & test
+ Branch: perl
+ ! globals.c iperlsys.h win32/GenCAPI.pl win32/Makefile
+ ! win32/makefile.mk win32/win32.c win32/win32iop.h
+____________________________________________________________________________
+[ 1449] By: gsar on 1998/07/12 06:29:23
+ Log: From: andreas.koenig@kulturbox.de (Andreas J. Koenig)
+ Date: 12 Jul 1998 08:22:16 +0200
+ Message-Id: <sfck95jtwpz.fsf@dubravka.in-berlin.de>
+ Subject: [5.004_71] Patch: let CPAN.pm work with threaded perl
+ Branch: perl
+ ! lib/CPAN.pm lib/SelfLoader.pm
+____________________________________________________________________________
+[ 1448] By: gsar on 1998/07/12 05:10:50
+ Log: make RE engine threadsafe; -Dusethreads builds, tests on Solaris,
+ and runs regexes in 1000s of threads without crashing; also fixed
+ statcache not being thread-local
+ Branch: perl
+ ! embed.h embedvar.h ext/Thread/Thread.xs ext/re/re.xs
+ ! intrpvar.h op.c perl.c pp_ctl.c regcomp.c regexec.c sv.c
+ ! t/lib/thread.t thrdvar.h util.c
+____________________________________________________________________________
+[ 1447] By: gsar on 1998/07/12 02:40:45
+ Log: From: Hugo van der Sanden <hv@crypt0.demon.co.uk>
+ Date: Sun, 12 Jul 1998 03:23:04 +0200
+ Message-Id: <l03130300b1cdbff87621@[194.222.64.89]>
+ Subject: Re: perlbug doesn't check that save succeeded
+ Branch: perl
+ ! utils/perlbug.PL
+____________________________________________________________________________
+[ 1446] By: gsar on 1998/07/12 02:39:24
+ Log: be generous about CRs
+ From: larry@wall.org (Larry Wall)
+ Date: Sat, 11 Jul 1998 17:54:21 PDT
+ Message-Id: <199807120054.RAA19550@wall.org>
+ Subject: [PATCH _71] CRs et al
+ Branch: perl
+ ! toke.c
+____________________________________________________________________________
+[ 1445] By: gsar on 1998/07/12 02:11:16
+ Log: fix pp_caller() to fully traverse stacklevels
+ Branch: perl
+ ! objpp.h pp_ctl.c proto.h t/op/runlevel.t
+____________________________________________________________________________
+[ 1444] By: gsar on 1998/07/11 23:43:37
+ Log: add patch, along with all the missing bits, and doc tweaks
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Thu, 9 Jul 1998 18:47:25 -0400 (EDT)
+ Message-Id: <199807092247.SAA06314@monk.mps.ohio-state.edu>
+ Subject: Re: [PATCH 5.004_71] Secure RE update
+ Branch: perl
+ ! ObjXSub.h embed.h embedvar.h ext/Opcode/Opcode.pm ext/re/re.pm
+ ! global.sym globals.c interp.sym intrpvar.h op.c opcode.h
+ ! opcode.pl pp_ctl.c pp_proto.h regcomp.c sv.c t/op/misc.t
+ ! t/op/pat.t t/op/subst.t
+____________________________________________________________________________
+[ 1443] By: gsar on 1998/07/11 23:08:14
+ Log: tweak to get BSDI to build IPC/SysV
+ From: Jarkko Hietaniemi <jhi@cc.hut.fi>
+ Date: 11 Jul 1998 16:26:44 +0300
+ Message-ID: <oeeww9kecx7.fsf@alpha.hut.fi>
+ Subject: Re: NOT OK: perl5.004_71 on BSDI 3.1
+ Branch: perl
+ ! ext/IPC/SysV/SysV.xs
+____________________________________________________________________________
+[ 1442] By: gsar on 1998/07/11 23:03:39
+ Log: fix closures in optimized C<for (1..5)> (only the tests are in this
+ change, the pp_hot.c fix accidentally went in change#1441)
+ Branch: perl
+ ! t/op/closure.t
+____________________________________________________________________________
+[ 1441] By: gsar on 1998/07/11 22:35:40
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Sat, 11 Jul 1998 18:21:21 -0400 (EDT)
+ Message-Id: <199807112221.SAA03221@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_71] Update os2's OS2::Process
+ Branch: perl
+ ! os2/OS2/Process/Makefile.PL os2/OS2/Process/Process.pm
+ ! os2/OS2/Process/Process.xs pp_hot.c
+____________________________________________________________________________
+[ 1440] By: gsar on 1998/07/11 19:41:59
+ Log: From: andreas.koenig@kulturbox.de (Andreas J. Koenig)
+ Date: 11 Jul 1998 17:00:21 +0200
+ Message-ID: <sfc1zrsxwje.fsf@dubravka.in-berlin.de>
+ Subject: [perl5.004_71] Patch: change MakeMaker default compress --> gzip
+ Branch: perl
+ ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm
+____________________________________________________________________________
+[ 1439] By: gsar on 1998/07/11 19:36:58
+ Log: export newRV_noinc on win32, deprecate AvFILL in favor of av_len()
+ Branch: perl
+ ! pod/perlguts.pod win32/makedef.pl
+____________________________________________________________________________
+[ 1438] By: gsar on 1998/07/11 19:14:21
+ Log: applied patch for perlfunc tweaks, removed reference to system qsort()
+ From: abigail@fnx.com
+ Date: Sat, 11 Jul 1998 04:20:54 -0400 (EDT)
+ Message-ID: <19980711082054.2184.qmail@betelgeuse.wayne.fnx.com>
+ Subject: [PATCH 5.004_71] pod/perlfunc.pod
+ Branch: perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 1437] By: gsar on 1998/07/11 19:05:00
+ Log: From: abigail@fnx.com
+ Date: Sat, 11 Jul 1998 04:09:57 -0400 (EDT)
+ Message-ID: <19980711080957.2106.qmail@betelgeuse.wayne.fnx.com>
+ Subject: [PATCH 5.004_71] pod/pod2man.PL
+ Branch: perl
+ ! pod/pod2man.PL
+____________________________________________________________________________
+[ 1436] By: gsar on 1998/07/11 18:58:03
+ Log: more complete version of change#1421
+ From: Stephen McCamant <alias@mcs.com>
+ Date: Fri, 10 Jul 1998 23:46:46 -0500 (CDT)
+ Message-ID: <13734.58994.735473.859218@alias-2.pr.mcs.net>
+ Subject: [PATCH] Re: B::Deparse for(1..100000)
+ Branch: perl
+ ! ext/B/B/Deparse.pm
+____________________________________________________________________________
+[ 1435] By: gsar on 1998/07/11 18:54:42
+ Log: win32 fixes for VC 6.0 nits
+ Branch: perl
+ ! ext/Data/Dumper/Dumper.xs win32/Makefile win32/makefile.mk
+ ! win32/win32.h
+____________________________________________________________________________
+[ 1434] By: gsar on 1998/07/11 18:45:32
+ Log: s/AVHV/pseudo-hash/ (via PM)
+ From: Gisle Aas <gisle@aas.no>
+ Date: 11 Jul 1998 00:16:53 +0200
+ Message-ID: <m3hg0pbbca.fsf@furu.g.aas.no>
+ Subject: [PATCH] trivial fields.pm doc patch
+ Branch: perl
+ ! lib/fields.pm
+____________________________________________________________________________
+[ 1433] By: gsar on 1998/07/11 18:43:11
+ Log: From: Laszlo Molnar <molnarl@cdata.tvnet.hu>
+ Date: Fri, 10 Jul 1998 23:12:11 +0200
+ Message-ID: <19980710231211.A161@cdata.tvnet.hu>
+ Subject: [PATCH _71] dos-djgpp update
+ Branch: perl
+ ! Configure djgpp/config.over djgpp/djgppsed.sh djgpp/fixpmain
+____________________________________________________________________________
+[ 1432] By: gsar on 1998/07/11 18:41:00
+ Log: applied patch, reformatted long lines in places
+ From: Dominic Dunlop <domo@computer.org>
+ Date: Fri, 10 Jul 1998 23:11:30 +0000
+ Message-Id: <v03110703b1cc32a02438@[195.95.102.91]>
+ Subject: [PATCH 5.004_71] Re: Document "count exceeded" regular expression
+ warning
+ Branch: perl
+ ! pod/perldiag.pod regexec.c
+____________________________________________________________________________
+[ 1431] By: gsar on 1998/07/11 18:29:18
+ Log: From: "John L. Allen" <allen@grumman.com>
+ Date: Fri, 10 Jul 1998 13:57:01 -0400 (EDT)
+ Message-ID: <Pine.SOL.3.91.980710134236.15717A-100000@gateway.grumman.com>
+ Subject: [PATCH]: _71 & _04 - Make AIX hints preserve ccflags as per docs
+ Branch: perl
+ ! hints/aix.sh
+____________________________________________________________________________
+[ 1430] By: TimBunce on 1998/07/11 18:15:09
+ Log: Title: "Fix string substitution returncode problem"
+ From: Dominic Dunlop <domo@vo.lu>, Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199805271236.IAA28213@aatma.engin.umich.edu>,
+ <v03110700b191a557f041@[195.95.102.114]>
+ Files: pp_hot.c
+ Branch: maint-5.004/perl
+ ! pp_hot.c
+____________________________________________________________________________
+[ 1429] By: gsar on 1998/07/11 18:07:52
+ Log: applied patch, tweaked doc and code that does labels/indentation
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Thu, 9 Jul 1998 21:39:40 -0400 (EDT)
+ Message-Id: <199807100139.VAA08617@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_71] perldebug.pod and RE
+ Branch: perl
+ ! pod/perldebug.pod regcomp.c regexec.c
+____________________________________________________________________________
+[ 1428] By: TimBunce on 1998/07/11 17:45:56
+ Log: Assorted patches:
+
+ Title: "makerel now reads local patch list from patchlevel.h"
+ Files: patchlevel.h Porting/makerel
+
+ Title: "pod/pod2man.PL"
+ From: abigail@fnx.com
+ Msg-ID: <19980711080957.2106.qmail@betelgeuse.wayne.fnx.com>
+ Files: pod/pod2man.PL
+
+ Title: "Clarify taint example in re.pm"
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID: <Pine.GSO.3.96.980623155803.3227X-100000@user2.teleport.com>
+ Files: lib/re.pm
+
+ Title: "Anohter ptags improvement"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199807070059.UAA28815@monk.mps.ohio-state.edu>
+ Files: emacs/ptags
+
+ Title: "_71 & _04 - Make AIX hints preserve ccflags as per docs"
+ From: "John L. Allen" <allen@grumman.com>
+ Msg-ID: <Pine.SOL.3.91.980710134236.15717A-100000@gateway.grumman.com>
+ Files: hints/aix.sh
+ Branch: maint-5.004/perl
+ ! Porting/makerel emacs/ptags hints/aix.sh lib/re.pm
+ ! patchlevel.h pod/pod2man.PL
+____________________________________________________________________________
+[ 1427] By: gsar on 1998/07/11 17:04:47
+ Log: make Liblist return consistently backslashed paths
+ Branch: perl
+ ! lib/ExtUtils/Liblist.pm
+____________________________________________________________________________
+[ 1426] By: gsar on 1998/07/11 16:53:56
+ Log: don't 'touch a2p.c', it might readonly (via PM)
+ From: Robin Barker <rmb1@cise.npl.co.uk>
+ Date: Fri, 10 Jul 98 17:19:54 BST
+ Message-Id: <20430.9807101619@tempest.cise.npl.co.uk>
+ Branch: perl
+ ! x2p/Makefile.SH
+____________________________________________________________________________
+[ 1425] By: TimBunce on 1998/07/11 16:42:26
+ Log: Title: "Add newCONSTSUB (from 5.005_70)"
+ Files: embed.h proto.h global.sym op.c
+ Branch: maint-5.004/perl
+ ! embed.h global.sym op.c proto.h
+____________________________________________________________________________
+[ 1424] By: TimBunce on 1998/07/11 16:20:21
+ Log: Title: "Assorted fixes for Sys::Syslog.pm"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Sean Robinson
+ <ROBINSON_S@sc.maricopa.edu>, Tim.Bunce@ig.co.uk
+ Msg-ID: <01IXGLISWJ7Q0001B6@sc.maricopa.edu>,
+ <199805270939.KAA08453@toad.ig.co.uk>,
+ <E0yeHPI-00047D-00@taurus.cus.cam.ac.uk>
+ Files: lib/Sys/Syslog.pm
+ Branch: maint-5.004/perl
+ ! lib/Sys/Syslog.pm
+____________________________________________________________________________
+[ 1423] By: TimBunce on 1998/07/11 15:53:37
+ Log: Assorted patches:
+
+ Title: "umask: die if EXPR & 0700 else return undef"
+ From: Chip Salzenberg <chip@perl.org>, Jarkko Hietaniemi <jhi@cc.hut.fi>,
+ Jarkko Hietaniemi <jhi@iki.fi>, Malcolm Beattie
+ <mbeattie@sable.ox.ac.uk>, Tim.Bunce@ig.co.uk (Tim Bunce),
+ kstar@chapin.ed, kstar@chapin.edu@ig.co.uk ()
+ Msg-ID: <199805291520.QAA01615@sable.ox.ac.uk>,
+ <199805291549.SAA01439@alpha.hut.fi>,
+ <199805291608.RAA29283@toad.ig.co.uk>,
+ <19980530105129.A24006@O2.chapin.edu>,
+ <19980608133037.A8793@perlsupport.com>
+ Files: pod/perldiag.pod pod/perlfunc.pod pp_sys.c
+
+ Title: "File name DynaLoader.pm.PL is 8.3 unfriendly"
+ From: Laszlo Molnar <molnarl@cdata.tvnet.hu>
+ Msg-ID: <19980610005417.G162@cdata.tvnet.hu>
+ Files: MANIFEST ext/DynaLoader/Makefile.PL
+ Branch: maint-5.004/perl
+ +> ext/DynaLoader/DynaLoader_pm.PL
+ - ext/DynaLoader/DynaLoader.pm.PL
+ ! MANIFEST ext/DynaLoader/Makefile.PL pod/perldiag.pod
+ ! pod/perlfunc.pod pp_sys.c
+____________________________________________________________________________
+[ 1421] By: gsar on 1998/07/11 02:54:02
+ Log: From: Gisle Aas <gisle@aas.no>
+ Subject: [PATCH] B::Deparse for(1..100000)
+ Date: 10 Jul 1998 14:04:44 +0200
+ Message-ID: <m3n2ahx677.fsf@furu.g.aas.no>
+ Branch: perl
+ ! ext/B/B/Deparse.pm
+____________________________________________________________________________
+[ 1420] By: gsar on 1998/07/11 02:28:18
+ Log: add 'clean' target for ext/re
+ Branch: perl
+ ! ext/re/Makefile.PL
+____________________________________________________________________________
+[ 1419] By: gsar on 1998/07/11 02:20:32
+ Log: From: Tom Hughes <thh@cyberscience.com>
+ Date: 10 Jul 1998 10:25:18 +0100
+ Message-ID: <yekn2ai5a81.fsf@elva.cyberscience.com>
+ Subject: [5.004_71] Patch: svr4 hints updates for Unixware
+ Branch: perl
+ ! hints/svr4.sh
+____________________________________________________________________________
+[ 1418] By: gsar on 1998/07/11 02:19:12
+ Log: move op/ipc{msg,sem}.t into lib/ipc_sysv.t
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Fri, 10 Jul 1998 13:08:08 +0300 (EET DST)
+ Message-Id: <199807101008.NAA10817@alpha.hut.fi>
+ Subject: Re: make minitest does not work out of the box - test subset
+ needs pruning
+ Branch: perl
+ + t/lib/ipc_sysv.t
+ - t/op/ipcmsg.t t/op/ipcsem.t
+ ! MANIFEST
+____________________________________________________________________________
+[ 1417] By: gsar on 1998/07/11 02:14:16
+ Log: disable CR croaking (via #define, default off) in lieu of more
+ complete fix
+ Branch: perl
+ ! toke.c
+____________________________________________________________________________
+[ 1416] By: gsar on 1998/07/11 02:06:11
+ Log: added patch, made linking with setargv a build option
+ From: "Douglas Lankshear" <dougl@ActiveState.com>
+ Date: Thu, 9 Jul 1998 09:51:42 -0700
+ Message-ID: <000101bdab59$d9602dc0$a32fa8c0@tau.Active>
+ Subject: [PATCH 5.004_71]
+ Branch: perl
+ ! perl.c pp_sys.c win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 1415] By: gsar on 1998/07/11 01:47:19
+ Log: From: Tom Hughes <thh@cyberscience.com>
+ Date: 10 Jul 1998 09:01:12 +0100
+ Message-ID: <yekr9zu5e47.fsf@elva.cyberscience.com>
+ Subject: [5.004_71] Patch: Fix perl_exp.SH for Unixware
+ Branch: perl
+ ! perl_exp.SH
+____________________________________________________________________________
+[ 1414] By: gsar on 1998/07/11 01:45:45
+ Log: make lib/re.pm a prereq for minitest
+ Branch: perl
+ ! Makefile.SH
+____________________________________________________________________________
+[ 1413] By: gsar on 1998/07/11 01:40:56
+ Log: add patch (via PM)
+ From: Stephen McCamant <alias@mcs.com>
+ Date: Fri, 10 Jul 1998 01:14:11 -0500 (CDT)
+ Message-ID: <13733.45251.47363.431138@alias-2.pr.mcs.net>
+ Subject: Big B::Deparse update
+ Branch: perl
+ ! ext/B/B/Deparse.pm
+____________________________________________________________________________
+[ 1412] By: gsar on 1998/07/11 00:25:17
+ Log: add perlport.pod v1.23 from Chris Nandor <pudge@pobox.com>
+ Branch: perl
+ + pod/perlport.pod
+ ! pod/perl.pod
+____________________________________________________________________________
+[ 1411] By: gsar on 1998/07/10 21:53:06
+ Log: make binmode(STDIN) not whine
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Date: Thu, 09 Jul 1998 16:51:27 -0700
+ Message-Id: <3.0.5.32.19980709165127.00a692e0@ous.edu>
+ Subject: [PATCH 5.004_70] Fix up binmode() for VMS
+ Branch: perl
+ ! vms/vms.c
+____________________________________________________________________________
+[ 1410] By: gsar on 1998/07/10 21:50:57
+ Log: CPAN-1.39 update
+ From: koenig@kulturbox.de (Andreas J. Koenig)
+ Date: 10 Jul 1998 00:45:36 +0200
+ Message-ID: <sfcbtqytzhr.fsf@dubravka.in-berlin.de>
+ Subject: Re: perl5.004_71 hit the stands this morn
+ Branch: perl
+ ! MANIFEST lib/CPAN.pm lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm
+____________________________________________________________________________
+[ 1409] By: gsar on 1998/07/10 21:45:10
+ Log: manually apply patch with conflicts
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Date: Thu, 09 Jul 1998 12:08:33 -0700
+ Message-Id: <3.0.5.32.19980709120833.009eb100@ous.edu>
+ Subject: [PATCH 5.004_70] Updated duble-quotes in config.h/config.pm patch
+ Branch: perl
+ ! configpm
+____________________________________________________________________________
+[ 1408] By: gsar on 1998/07/10 21:36:54
+ Log: From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Thu, 9 Jul 1998 11:58:30 -0400 (EDT)
+ Message-Id: <Pine.SUN.3.96.980709115556.24236D-100000@newton.phys>
+ Subject: Re: perldelta.pod [PATCH]
+ Branch: perl
+ ! pod/perldelta.pod
+____________________________________________________________________________
+[ 1407] By: gsar on 1998/07/10 21:35:13
+ Log: From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Thu, 9 Jul 1998 11:26:03 -0400 (EDT)
+ Subject: [PATCH 5.004_71] Allow static build of IPC::SysV
+ Message-Id: <Pine.SUN.3.96.980709112507.24236B-100000@newton.phys>
+ Branch: perl
+ ! ext/IPC/SysV/Makefile.PL
+____________________________________________________________________________
+[ 1406] By: gsar on 1998/07/10 21:33:30
+ Log: manually apply patch with conflicts
+ From: kstar@chapin.edu
+ Message-ID: <19980709093621.B7857@O2.chapin.edu>
+ Date: Thu, 9 Jul 1998 09:36:21 -0400
+ Subject: Re: [PATCH] 5.004_70 installperl and docs
+ Branch: perl
+ ! installperl
+____________________________________________________________________________
+[ 1405] By: gsar on 1998/07/10 21:28:29
+ Log: misc tweaks to docs and qsortsv() warning
+ Branch: perl
+ ! Changes pod/perldelta.pod pod/perlsub.pod pp_ctl.c
+____________________________________________________________________________
+[ 1404] By: gsar on 1998/07/10 21:23:53
+ Log: add more correct version of change#1350 (as yet untested)
+ From: joshua.pritikin@db.com
+ Date: Thu, 9 Jul 1998 09:22:46 -0400
+ Message-Id: <H00000e50008f277@MHS>
+ Subject: Re: [PATCH _70] cache missing methods
+ Branch: perl
+ ! embedvar.h gv.c interp.sym intrpvar.h perlvars.h
+____________________________________________________________________________
+[ 1403] By: gsar on 1998/07/10 20:46:12
+ Log: add win32_rename() that does what docs say
+ Branch: perl
+ ! win32/GenCAPI.pl win32/makedef.pl win32/perlhost.h
+ ! win32/win32.c win32/win32iop.h
+____________________________________________________________________________
+[ 1402] By: gsar on 1998/07/10 20:19:18
+ Log: inet_aton() should do DNS lookup only if arg isn't a dotted-quad
+ (suggested by Philippe.Simonet@swisscom.com)
+ Branch: perl
+ ! ext/Socket/Socket.xs
+____________________________________________________________________________
+[ 1401] By: gsar on 1998/07/10 03:24:45
+ Log: undo change#1379 (order of tests *is* significant)
+ Branch: perl
+ ! t/lib/posix.t
+____________________________________________________________________________
+[ 1400] By: nick on 1998/07/09 17:43:14
+ Log: Integrate mainline (_071-ish)
+ Branch: ansiperl
+ +> ext/Data/Dumper/Changes ext/Data/Dumper/Dumper.pm
+ +> ext/Data/Dumper/Dumper.xs ext/Data/Dumper/Makefile.PL
+ +> ext/Data/Dumper/Todo ext/IPC/SysV/ChangeLog
+ +> ext/IPC/SysV/MANIFEST ext/IPC/SysV/Makefile.PL
+ +> ext/IPC/SysV/Msg.pm ext/IPC/SysV/README
+ +> ext/IPC/SysV/Semaphore.pm ext/IPC/SysV/SysV.pm
+ +> ext/IPC/SysV/SysV.xs ext/IPC/SysV/t/msg.t ext/IPC/SysV/t/sem.t
+ +> ext/re/Makefile.PL ext/re/re.pm ext/re/re.xs pp_proto.h
+ +> t/io/iprefix.t t/lib/dumper-ovl.t t/lib/dumper.t
+ !> (integrate 145 files)
----------------
-Version 5.003_90
+Version 5.004_71
----------------
-At last, a mil[le]stone: The first beta of Perl 5.004.
-
- CORE LANGUAGE CHANGES
-
- Title: "Automatically call srand() before rand() if user didn't"
- From: Chip Salzenberg
- Files: pod/perlfunc.pod pp.c
-
- CORE PORTABILITY
-
- Title: "Ultrix hints"
- From: Spider Boardman
- Msg-ID: <199702220951.EAA08156@Orb.Nashua.NH.US>
- Date: Sat, 22 Feb 1997 04:51:48 -0500
- Files: hints/ultrix_4.sh
-
- Title: "Digital UNIX and 3_28"
- From: Jarkko Hietaniemi
- Msg-ID: <199702231427.QAA13807@alpha.hut.fi>
- Date: Sun, 23 Feb 1997 16:27:19 +0200 (EET)
- Files: Configure MANIFEST ext/NDBM_File/hints/dec_osf.pl
- ext/ODBM_File/hints/dec_osf.pl hints/dec_osf.sh
-
- Title: "AmigaOS patches to 5.003_28"
- From: Norbert Pueschel
- Msg-ID: <77724759@Armageddon.meb.uni-bonn.de>
- Date: Sat, 22 Feb 1997 18:08:02 +0100
- Files: README.amiga hints/amigaos.sh t/io/fs.t t/lib/anydbm.t
- t/lib/db-btree.t t/lib/db-hash.t t/lib/db-recno.t
- t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t t/lib/sdbm.t
- t/op/magic.t t/op/stat.t
-
- Title: "Hints for DC/OSx"
- From: Stephen Zander <srz@loopback>
- Msg-ID: <199702242124.NAA03796@wsuse5.mckesson.com>
- Date: Mon, 24 Feb 1997 13:24:54 -0800
- Files: hints/dcosx.sh
-
- Title: "Update VMS version"
- From: Chip Salzenberg
- Files: vms/config.vms vms/descrip.mms
-
- OTHER CORE CHANGES
-
- Title: "Don't assume that sizeof(int) >= sizeof(void*)"
- From: Chip Salzenberg
- Files: doio.c malloc.c regexec.c
-
- BUILD PROCESS
-
- Title: "Re: ccdlflags don't quite work"
- From: Andy Dougherty
- Msg-ID: <Pine.SOL.3.95q.970224160630.5700E-100000@fractal.lafayette.e
- Date: Mon, 24 Feb 1997 16:07:07 -0500 (EST)
- Files: Configure
-
- Title: "Use $ccflags, $ldflags, $libs when determining $randbits"
- From: Chip Salzenberg
- Files: Configure
-
- Title: "'installperl -v' doesn't do enough"
- From: Spider Boardman
- Msg-ID: <199702241342.IAA25945@Orb.Nashua.NH.US>
- Date: Mon, 24 Feb 1997 08:42:59 -0500
- Files: installperl
-
- Title: "installperl breaks running system (for a while)"
- From: Spider Boardman
- Msg-ID: <199702241412.JAA11829@Orb.Nashua.NH.US>
- Date: Mon, 24 Feb 1997 09:12:11 -0500
- Files: installperl
-
- LIBRARY AND EXTENSIONS
-
- Title: "Don't clobber $1 et al in debugger's DB::sub()"
- From: Ilya Zakharevich
- Files: lib/perl5db.pl
-
- Title: "Fix fd leak in IO::Pipe"
- From: Roderick Schertler
- Msg-ID: <pzn2sv722y.fsf@eeyore.ibcinc.com>
- Date: 23 Feb 1997 14:29:57 -0500
- Files: ext/IO/lib/IO/Pipe.pm
-
- Title: "Pod::Text fixes"
- From: Roderick Schertler
- Msg-ID: <350.856634588@eeyore.ibcinc.com>
- Date: Sat, 22 Feb 1997 13:03:08 -0500
- Files: lib/Pod/Text.pm
-
- Title: "Trivial patch to make ExtUtils::Install more -w clean"
- From: Tim Bunce
- Msg-ID: <9702241605.AA17436@toad.ig.co.uk>
- Date: Mon, 24 Feb 1997 16:05:17 +0000
- Files: lib/ExtUtils/Install.pm
-
- Title: "C<use vars> didn't work until 5.002"
- From: Chip Salzenberg
- Files: lib/vars.pm
-
- TESTS
-
- Title: "More thoroughly test rand() and srand()"
- From: Tom Phoenix
- Files: t/op/rand.t
-
- Title: "Don't use <*> where readdir() will do"
- From: Chip Salzenberg
- Files: t/op/stat.t
-
- Title: "Allow for $^X to be 'miniperl'"
- From: Dominic Dunlop <domo@slipper.ip.lu>
- Msg-ID: <v03020903af360f31aced@[194.51.248.65]>
- Date: Sun, 23 Feb 1997 16:22:45 +0100
- Files: t/op/magic.t
-
- UTILITIES
-
- Title: "Post-28 INSTALL updates"
- From: Andy Dougherty
- Msg-ID: <Pine.SOL.3.95q.970224170713.5700H-100000@fractal.lafayette.e
- Date: Mon, 24 Feb 1997 17:09:09 -0500 (EST)
- Files: INSTALL
-
- Title: "Re: Hash key created by subroutine call? (fwd) "
- From: Gurusamy Sarathy
- Msg-ID: <199702242229.RAA04395@aatma.engin.umich.edu>
- Date: Mon, 24 Feb 1997 17:29:30 -0500
- Files: pod/perlsub.pod pod/perltrap.pod
-
- Title: "Add documentation and '-h' option to perlbug"
- From: Gurusamy Sarathy
- Msg-ID: <199702240854.DAA27128@aatma.engin.umich.edu>
- and <199702242009.PAA02849@aatma.engin.umich.edu>
- Date: Mon, 24 Feb 1997
- Files: pod/perl.pod pod/perldelta.pod installman
- utils/perlbug.PL
-
- Title: "pumpkin-1.9.pod"
- From: Andy Dougherty
- Msg-ID: <Pine.SOL.3.95q.970224155702.5700D-100000@fractal.lafayette.e
- Date: Mon, 24 Feb 1997 16:06:02 -0500 (EST)
- Files: Porting/pumpkin.pod
-
- DOCUMENTATION
-
- Title: "Fix typo in 'Tolkien quotation typo' fix"
- From: Jarkko Hietaniemi
- Files: Changes
-
- Title: "Document one-argument limitation with #! line"
- From: Tom Phoenix
- Msg-ID: <Pine.GSO.3.95q.970223182745.15989A-100000@kelly.teleport.com
- Date: Sun, 23 Feb 1997 18:41:02 -0800 (PST)
- Files: pod/perldiag.pod pod/perlsec.pod
-
+____________________________________________________________________________
+[ 1399] By: gsar on 1998/07/09 12:15:12
+ Log: update Changes, perlhist.pod, beginnings of perldelta.pod
+ Branch: perl
+ ! Changes pod/perldelta.pod pod/perlhist.pod
+____________________________________________________________________________
+[ 1397] By: gsar on 1998/07/09 08:35:39
+ Log: merge changes from maintbranch (1354, and relevant part of 1356); all
+ maintenance changes upto 1356 merged
+ Branch: perl
+ ! pod/perldiag.pod pp_hot.c t/op/misc.t
+____________________________________________________________________________
+[ 1396] By: gsar on 1998/07/09 08:02:52
+ Log: add Data-Dumper, up patchlevel to 71, various misc tweaks to
+ make all configs build on Solaris and win32
+ Branch: perl
+ + ext/Data/Dumper/Changes ext/Data/Dumper/Dumper.pm
+ + ext/Data/Dumper/Dumper.xs ext/Data/Dumper/Makefile.PL
+ + ext/Data/Dumper/Todo t/lib/dumper-ovl.t t/lib/dumper.t
+ ! MANIFEST Todo patchlevel.h win32/Makefile win32/config_H.bc
+ ! win32/config_H.gc win32/config_H.vc win32/makefile.mk
+____________________________________________________________________________
+[ 1395] By: gsar on 1998/07/09 05:39:48
+ Log: From: Stephen McCamant <alias@mcs.com>
+ Date: Wed, 08 Jul 1998 23:16:49 CDT
+ Message-Id: <13732.16626.904108.608743@alias-2.pr.mcs.net>
+ Subject: [PATCH] UNOP opclass test in B.xs
+ Branch: perl
+ ! ext/B/B.xs
+____________________________________________________________________________
+[ 1394] By: gsar on 1998/07/09 05:37:48
+ Log: get it building again on win32
+ Branch: perl
+ ! bytecode.h embed.h ext/re/Makefile.PL global.sym intrpvar.h
+ ! op.c opcode.pl perl.h pp.c pp_ctl.c pp_hot.c pp_proto.h
+ ! pp_sys.c proto.h win32/Makefile win32/makedef.pl
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 1393] By: gsar on 1998/07/09 05:20:31
+ Log: applied patch from Ilya, tweaked some to get clean static build of
+ the ext/re stuff (untested on win32)
+ Branch: perl
+ ! regcomp.c regexec.c
+____________________________________________________________________________
+[ 1392] By: gsar on 1998/07/09 03:56:45
+ Log: fix installperl typo
+ From: kstar@chapin.edu
+ Date: Wed, 08 Jul 1998 23:51:57 EDT
+ Message-Id: <19980708235157.D1380@O2.chapin.edu>
+ Subject: Re: [PATCH] 5.004_70 installperl and docs
+ Branch: perl
+ ! installperl
+____________________________________________________________________________
+[ 1391] By: gsar on 1998/07/09 01:48:16
+ Log: From: Chip Salzenberg <chip@perl.org>
+ Date: Wed, 8 Jul 1998 18:10:55 -0400
+ Message-ID: <19980708181055.A8005@perlsupport.com>
+ Subject: [PATCH _70] Allow $SIG{CHLD}='IGNORE' to work on Solaris
+ Branch: perl
+ ! util.c
+____________________________________________________________________________
+[ 1390] By: gsar on 1998/07/09 01:45:16
+ Log: added patch, tweaked per Ilya's suggestion
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Date: Wed, 8 Jul 1998 13:34:42 +0100
+ Message-Id: <E0yttQo-0002aH-00@taurus.cus.cam.ac.uk>
+ Subject: [PATCH] perl5db.pl complains about non-integer condition
+ Branch: perl
+ ! lib/perl5db.pl
+____________________________________________________________________________
+[ 1389] By: gsar on 1998/07/09 01:42:13
+ Log: reenable misaligned memory checks, cast to UV & check alignment
+ From: Dominic Dunlop <domo@computer.org>
+ Date: Wed, 8 Jul 1998 11:21:48 +0000
+ Message-Id: <v03110703b1c8ffdb68ed@[195.95.102.91]>
+ Subject: Re: [PATCH 5.00469] corrupt malloc ptr on NeXT
+ Branch: perl
+ ! malloc.c
+____________________________________________________________________________
+[ 1388] By: gsar on 1998/07/09 01:36:22
+ Log: From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Wed, 8 Jul 1998 13:32:07 -0400 (EDT)
+ Message-Id: <Pine.SUN.3.96.980708133010.23053F-100000@newton.phys>
+ Subject: [PATCH 5.004_70] more on finding metaconfig units.
+ Branch: perl
+ ! Porting/pumpkin.pod
+____________________________________________________________________________
+[ 1387] By: gsar on 1998/07/09 01:35:23
+ Log: From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Wed, 8 Jul 1998 13:29:34 -0400 (EDT)
+ Message-Id: <Pine.SUN.3.96.980708132743.23053E-100000@newton.phys>
+ Subject: Configure indentation patch
+ Branch: perl
+ ! Configure
+____________________________________________________________________________
+[ 1386] By: gsar on 1998/07/09 01:33:31
+ Log: don't try to hardlink perldiag.pod; that is no longer not needed
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Wed, 8 Jul 1998 12:18:32 -0400 (EDT)
+ Message-Id: <Pine.SUN.3.96.980708120844.23053D-100000@newton.phys>
+ Subject: Re: pelr installation attempts hard links between file systems
+ Branch: perl
+ ! installperl
+____________________________________________________________________________
+[ 1385] By: gsar on 1998/07/09 01:28:05
+ Log: win32/makefile.mk =~ s|gcc -pipe|gcc|
+ Branch: perl
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 1384] By: gsar on 1998/07/09 01:26:19
+ Log: make t/TEST run 'perl $switches ./foo/test.t' everywhere
+ Branch: perl
+ ! t/TEST
+____________________________________________________________________________
+[ 1383] By: gsar on 1998/07/09 01:06:47
+ Log: manually apply patch with a dependency on unapplied patch
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Wed, 8 Jul 1998 07:03:51 -0400 (EDT)
+ Message-Id: <199807081103.HAA25145@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_70] make quoted RE embeddable
+ Branch: perl
+ ! sv.c t/op/pat.t
+____________________________________________________________________________
+[ 1382] By: gsar on 1998/07/09 01:02:23
+ Log: change order of libs for extensions
+ From: Laszlo Molnar <molnarl@cdata.tvnet.hu>
+ Date: Tue, 7 Jul 1998 23:48:05 +0200
+ Message-ID: <19980707234805.C180@cdata.tvnet.hu>
+ Subject: [PATCH _70] linking problem with modules
+ Branch: perl
+ ! lib/ExtUtils/MM_Unix.pm
+____________________________________________________________________________
+[ 1381] By: gsar on 1998/07/09 00:56:12
+ Log: patch for more flexible initialization of xsub parameters
+ From: Tye McQueen <tye@metronet.com>
+ Date: Mon, 6 Jul 1998 19:04:27 -0500 (CDT)
+ Message-Id: <199807070004.AA16454@metronet.com>
+ Subject: Enhanced arg inits for xsubpp
+ Branch: perl
+ ! lib/ExtUtils/xsubpp pod/perlxs.pod
+____________________________________________________________________________
+[ 1380] By: gsar on 1998/07/09 00:44:01
+ Log: From: Tye McQueen <tye@metronet.com>
+ Date: Mon, 6 Jul 1998 17:34:54 -0500 (CDT)
+ Message-Id: <16619-17073@lyris.activestate.com>
+ Subject: New pl2bat.pl
+ Branch: perl
+ ! win32/bin/pl2bat.pl
+____________________________________________________________________________
+[ 1379] By: gsar on 1998/07/09 00:30:58
+ Log: remove ordering dependency in posix.t
+ Branch: perl
+ ! t/lib/posix.t
+____________________________________________________________________________
+[ 1378] By: gsar on 1998/07/08 20:17:43
+ Log: make -i'*suffix' work too
+ Branch: perl
+ ! doio.c
+____________________________________________________________________________
+[ 1377] By: gsar on 1998/07/08 08:56:28
+ Log: regen headers; result builds & tests on Solaris again (threaded)
+ Branch: perl
+ ! embedvar.h
+____________________________________________________________________________
+[ 1376] By: gsar on 1998/07/08 08:55:03
+ Log: change#1350 breaks things, back it out
+ Branch: perl
+ ! embedvar.h gv.c interp.sym intrpvar.h perlvars.h
+____________________________________________________________________________
+[ 1375] By: gsar on 1998/07/08 07:47:00
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Wed, 8 Jul 1998 01:30:15 -0400 (EDT)
+ Message-Id: <199807080530.BAA14072@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_70] Switch modifiers in RE off
+ Branch: perl
+ ! pod/perlre.pod regcomp.c t/op/re_tests
+____________________________________________________________________________
+[ 1374] By: gsar on 1998/07/08 07:41:06
+ Log: From: Gisle Aas <gisle@aas.no>
+ Date: 07 Jul 1998 23:08:59 +0200
+ Message-ID: <m3vhp9z7v8.fsf@furu.g.aas.no>
+ Subject: [PATCH] Faster copying from SvIV/SvNVs in sv_setsv()
+ Branch: perl
+ ! sv.c
+____________________________________________________________________________
+[ 1373] By: gsar on 1998/07/08 07:36:01
+ Log: From: Laszlo Molnar <molnarl@cdata.tvnet.hu>
+ Date: Tue, 7 Jul 1998 23:47:50 +0200
+ Message-ID: <19980707234750.A180@cdata.tvnet.hu>
+ Subject: [PATCH _70] dos-djgpp update
+ Branch: perl
+ ! djgpp/config.over djgpp/djgppsed.sh
+____________________________________________________________________________
+[ 1372] By: gsar on 1998/07/08 07:12:47
+ Log: add extension to support SysV IPC
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Tue, 7 Jul 1998 02:32:53 +0300 (EET DST)
+ Message-Id: <199807062332.CAA25792@alpha.hut.fi>
+ Subject: [PATCH] 5.004_70: IPC::SysV
+ Branch: perl
+ + ext/IPC/SysV/ChangeLog ext/IPC/SysV/MANIFEST
+ + ext/IPC/SysV/Makefile.PL ext/IPC/SysV/Msg.pm
+ + ext/IPC/SysV/README ext/IPC/SysV/Semaphore.pm
+ + ext/IPC/SysV/SysV.pm ext/IPC/SysV/SysV.xs ext/IPC/SysV/t/msg.t
+ + ext/IPC/SysV/t/sem.t
+ ! Configure MANIFEST pod/perlfunc.pod pod/perlipc.pod
+ ! t/op/ipcmsg.t t/op/ipcsem.t
+____________________________________________________________________________
+[ 1371] By: gsar on 1998/07/08 05:12:07
+ Log: add patch for C<use re 'debug'>
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Mon, 6 Jul 1998 22:24:33 -0400 (EDT)
+ Message-Id: <199807070224.WAA10318@monk.mps.ohio-state.edu>
+ Subject: Re: _70 and Devel::RE
+ Branch: perl
+ + ext/re/Makefile.PL ext/re/re.pm ext/re/re.xs
+ - lib/re.pm
+ ! MANIFEST Makefile.SH global.sym interp.sym intrpvar.h op.c
+ ! perl.h pp.c pp_ctl.c pp_hot.c regcomp.c regexec.c
+____________________________________________________________________________
+[ 1370] By: gsar on 1998/07/08 04:27:27
+ Log: added patch to generate PPDEF(pp_foo)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Mon, 6 Jul 1998 20:43:54 -0400 (EDT)
+ Message-Id: <199807070043.UAA28572@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_70] Autogenerate declarations for opcodes
+ Branch: perl
+ + pp_proto.h
+ ! MANIFEST Makefile.SH opcode.pl proto.h
+____________________________________________________________________________
+[ 1369] By: gsar on 1998/07/08 04:19:49
+ Log: suggest 'make test' after make
+ Branch: perl
+ ! Makefile.SH
+____________________________________________________________________________
+[ 1368] By: gsar on 1998/07/08 03:58:19
+ Log: added patch for -i'foo*bar', made code somewhat simpler, tweaked doc
+ From: Colin Kuskie <ckuskie@cadence.com>
+ Date: Tue, 7 Jul 1998 09:44:33 -0700 (PDT)
+ Message-ID: <Pine.GSO.3.96.980707093457.28681A-100000@pdxue150.cadence.com>
+ Subject: Corrected -i prefix patch
+ Branch: perl
+ + t/io/iprefix.t
+ ! MANIFEST doio.c pod/perlrun.pod
+____________________________________________________________________________
+[ 1366] By: gsar on 1998/07/08 02:28:30
+ Log: From: Gisle Aas <gisle@aas.no>
+ Date: 07 Jul 1998 17:48:36 +0200
+ Message-ID: <m3vhp94q7f.fsf@furu.g.aas.no>
+ Subject: [PATCH] Remove some rendundant SvOOK_on tests
+ Branch: perl
+ ! sv.c sv.h
+____________________________________________________________________________
+[ 1365] By: gsar on 1998/07/08 02:25:17
+ Log: applied patch to clarify m//g
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Date: Tue, 7 Jul 1998 15:59:03 +0100
+ Message-Id: <E0ytZCx-0006Bi-00@taurus.cus.cam.ac.uk>
+ Subject: [PATCH] Re: m//g in perlop.pod
+ Branch: perl
+ ! pod/perlop.pod
+____________________________________________________________________________
+[ 1364] By: gsar on 1998/07/08 02:13:07
+ Log: From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Subject: [PATCH] 5.004_70 bug in perlfaq.pod
+ Message-Id: <E0ytVTJ-0002kb-00@taurus.cus.cam.ac.uk>
+ Date: Tue, 7 Jul 1998 11:59:41 +0100
+ Branch: perl
+ ! pod/perlfaq.pod
+____________________________________________________________________________
+[ 1363] By: gsar on 1998/07/08 02:11:11
+ Log: applied tweak (via private mail)
+ From: Jarkko Hietaniemi <jhi@cc.hut.fi>
+ Date: Tue, 7 Jul 1998 13:27:47 +0300 (EET DST)
+ Message-Id: <199807071027.NAA20829@alpha.hut.fi>
+ Subject: tiny perllocale.pod patch for 5.004_70
+ Branch: perl
+ ! pod/perllocale.pod
+____________________________________________________________________________
+[ 1362] By: gsar on 1998/07/08 02:07:48
+ Log: applied patch, various tweaks to pander to pod2man tantrums
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Mon, 6 Jul 1998 22:47:30 -0400 (EDT)
+ Message-Id: <199807070247.WAA10677@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_70] CONFIGPM
+ Branch: perl
+ ! Porting/Glossary configpm
+____________________________________________________________________________
+[ 1361] By: gsar on 1998/07/07 22:13:11
+ Log: From: Stephen McCamant <alias@mcs.com>
+ Date: Mon, 6 Jul 1998 21:22:17 -0500 (CDT)
+ Message-ID: <13729.33816.311236.995647@alias-2.pr.mcs.net>
+ Subject: Re: Inconsistent arithmetics on refs
+ Branch: perl
+ ! sv.c
+____________________________________________________________________________
+[ 1360] By: gsar on 1998/07/07 22:11:11
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Mon, 6 Jul 1998 20:59:10 -0400 (EDT)
+ Message-Id: <199807070059.UAA28815@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_70] Anohter ptags improvement
+ Branch: perl
+ ! emacs/ptags
+____________________________________________________________________________
+[ 1359] By: gsar on 1998/07/07 22:08:48
+ Log: fix accidental RE-de-optimization
+ From: larry@wall.org (Larry Wall)
+ Date: Mon, 6 Jul 1998 17:49:31 -0700
+ Message-Id: <199807070049.RAA23475@wall.org>
+ Subject: Re: before you deluge us with patches
+ --
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Tue, 7 Jul 1998 03:10:56 -0400 (EDT)
+ Message-Id: <199807070710.DAA25399@monk.mps.ohio-state.edu>
+ Subject: Re: before you deluge us with patches
+ Branch: perl
+ ! pp_hot.c regexec.c
+____________________________________________________________________________
+[ 1358] By: gsar on 1998/07/07 21:36:29
+ Log: From: Gisle Aas <gisle@aas.no>
+ Subject: [PATCH] Evaluation of AVHVs in scalar context
+ Date: 06 Jul 1998 21:41:14 +0200
+ Message-ID: <m33ecedaxx.fsf@furu.g.aas.no>
+ Branch: perl
+ ! pp_hot.c t/op/avhv.t
+____________________________________________________________________________
+[ 1357] By: gsar on 1998/07/07 21:29:46
+ Log: doc tweaks suggested by Abigail, M.J.T. Guy, and Larry Wall
+ Branch: perl
+ ! lib/Math/Trig.pm lib/fields.pm thread.sym
+____________________________________________________________________________
+[ 1356] By: TimBunce on 1998/07/07 17:19:42
+ Log: Assorted patches:
+
+ ------ BUILD PROCESS ------
+
+ Title: "Add Test.pm (from perl 5.004_70)"
+ Files: MANIFEST lib/Test.pm
+
+ ------ EXTENSIONS ------
+
+ Title: "Add CR LF CRLF to Socket.pm"
+ From: Chris Nandor <pudge@pobox.com>
+ Msg-ID: <v04003a46b1b6067832a1@[24.48.28.52]>
+ Files: ext/Socket/Socket.pm
+
+ ------ LIBRARY ------
+
+ Title: "AutoSplit upgrade (AutoSplit 1.0302 from 5.004_70)"
+ Files: lib/AutoSplit.pm
+
+ Title: "Upgrade base.pm (from perl 5.004_70)"
+ Files: lib/base.pm
+
+ Title: "Add File::Spec modules (from 5.004_70)"
+ Files: lib/File/Spec.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
+
+ ------ TESTS ------
+
+ Title: "fixup test for method call on undefined value"
+ Files: t/op/misc.t
+
+ ------ UTILITIES ------
+
+ Title: "perlbug upgrade (from 5.004_70)"
+ Files: utils/perlbug.PL
+
+ Title: "Upgrade perldoc (from 5.004_70)"
+ Files: utils/perldoc.PL
+ Branch: maint-5.004/perl
+ + lib/File/Spec.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 lib/Test.pm
+ ! MANIFEST ext/Socket/Socket.pm lib/AutoSplit.pm lib/base.pm
+ ! t/op/misc.t utils/perlbug.PL utils/perldoc.PL
+____________________________________________________________________________
+[ 1355] By: TimBunce on 1998/07/07 14:39:51
+ Log: Title: "Fix memory leak in Safe module"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199806290544.BAA18463@aatma.engin.umich.edu>
+ Files: ext/Opcode/Opcode.xs ext/Opcode/Safe.pm
+ Branch: maint-5.004/perl
+ ! ext/Opcode/Opcode.xs ext/Opcode/Safe.pm
+____________________________________________________________________________
+[ 1354] By: TimBunce on 1998/07/07 14:35:25
+ Log: Title: "Better error message for $undef->method call"
+ From: Tim Bunce <Tim.Bunce@ig.co.uk>, Graham Barr <gbarr@ti.com>,
+ joshua.pritikin@db.com
+ Msg-ID: <19980615171027.U4120@asic.sc.ti.com>, <H00000e500073a20@MHS>
+ Files: pod/perldiag.pod pp_hot.c
+ Branch: maint-5.004/perl
+ ! pod/perldiag.pod pp_hot.c
+____________________________________________________________________________
+[ 1353] By: gsar on 1998/07/06 23:33:38
+ Log: From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Mon, 6 Jul 1998 16:59:06 -0400 (EDT)
+ Message-Id: <Pine.SUN.3.96.980706165659.21068B-100000@newton.phys>
+ Subject: [PATCH 5.004_70] Update metaconfig info
+ Branch: perl
+ ! Porting/pumpkin.pod
+____________________________________________________________________________
+[ 1352] By: gsar on 1998/07/06 23:30:54
+ Log: From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Mon, 6 Jul 1998 13:14:37 -0400 (EDT)
+ Message-Id: <Pine.SUN.3.96.980706130959.20719A-100000@newton.phys>
+ Subject: [PATCH 5.004_70] Config_70-01: Remove default "/share"
+ Branch: perl
+ ! Configure INSTALL Policy_sh.SH Porting/Glossary
+ ! Porting/config.sh Porting/config_H
+____________________________________________________________________________
+[ 1351] By: gsar on 1998/07/06 23:24:47
+ Log: try harder to run non-executable tests
+ Branch: perl
+ ! t/TEST
+____________________________________________________________________________
+[ 1350] By: gsar on 1998/07/06 23:12:17
+ Log: add patch to improve method caching, regen headers
+ From: joshua.pritikin@db.com
+ Date: Mon, 6 Jul 1998 09:19:29 -0400
+ Message-Id: <H00000e50008a518@MHS>
+ Subject: [PATCH _70] cache missing methods
+ Branch: perl
+ ! embedvar.h gv.c interp.sym intrpvar.h perlvars.h
+____________________________________________________________________________
+[ 1349] By: TimBunce on 1998/07/06 23:03:16
+ Log: Assorted patches:
+
+ ------ BUILD PROCESS ------
+
+ Title: "Configure: Workaround bash CDPATH oddity"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980608121159.13706C-100000@newton.phys>
+ Files: Configure
+
+ Title: "Don't suppress display of Makefile recipes that invoke perl"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199806252213.SAA08545@aatma.engin.umich.edu>
+ Files: Makefile.SH
+
+ ------ CORE LANGUAGE ------
+
+ Title: "one more^Wless quad unpack bug"
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199806301132.OAA27353@alpha.hut.fi>
+ Files: pp.c
+
+ Title: "minor fixups to bring maint closer to devel for patching"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199805200046.UAA19284@aatma.engin.umich.edu>
+ Files: pod/perldiag.pod deb.c dump.c t/op/ref.t t/op/split.t taint.c util.c
+
+ Title: "-Pw switches used together report bogus error"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199806252331.TAA10160@aatma.engin.umich.edu>
+ Files: perl.c
+
+ Title: "Add doc and perl home page info to -v output"
+ From: Tom Christiansen <tchrist@jhereg.perl.com>
+ Msg-ID: <199802172229.PAA29309@jhereg.perl.com>
+ Files: perl.c
+
+ Title: "Fix C<@a = (%a = 1)> bizarreness"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>, Tom Christiansen
+ <tchrist@jhereg.perl.com>
+ Msg-ID: <199807012026.OAA31507@jhereg.perl.com>,
+ <199807012339.TAA26024@aatma.engin.umich.edu>
+ Files: pp_hot.c
+
+ Title: "make find_script() return saved string, reenable missing
+ diagnostics"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199806262224.SAA00422@aatma.engin.umich.edu>
+ Files: perl.c util.c
+
+ Title: "minor e_script optimization"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199807060704.DAA25988@aatma.engin.umich.edu>
+ Files: perl.c
+
+ ------ DOCUMENTATION ------
+
+ Title: "Insecure $ENV{} message out of step with perldiag"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0yooQA-0003za-00@taurus.cus.cam.ac.uk>
+ Files: pod/perldiag.pod pod/perlsec.pod
+
+ Title: "documenting close without arguments"
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID: <Pine.GSO.3.96.980623084413.24075V-100000@user2.teleport.com>
+ Files: pod/perlfunc.pod
+
+ Title: "pod for scalar .. op"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0yqyN8-0006gv-00@taurus.cus.cam.ac.uk>
+ Files: pod/perlop.pod
+
+ ------ EXTENSIONS ------
+
+ Title: "Fcntl: add few constants, enhance maintainability"
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199806221558.SAA18626@alpha.hut.fi>
+ Files: ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs
+
+ ------ LIBRARY ------
+
+ Title: "Fix undef warnings in Text::Parsewords"
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199806300842.LAA26409@alpha.hut.fi>
+ Files: lib/Text/ParseWords.pm
+
+ Title: "Add Symbol::delete_package()"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199807060702.DAA25976@aatma.engin.umich.edu>
+ Files: pod/perlembed.pod lib/Symbol.pm
+ Branch: maint-5.004/perl
+ ! Configure Makefile.SH deb.c dump.c ext/Fcntl/Fcntl.pm
+ ! ext/Fcntl/Fcntl.xs lib/Symbol.pm lib/Text/ParseWords.pm perl.c
+ ! pod/perldiag.pod pod/perlembed.pod pod/perlfunc.pod
+ ! pod/perlop.pod pod/perlsec.pod pp.c pp_hot.c t/op/ref.t
+ ! t/op/split.t taint.c util.c
+____________________________________________________________________________
+[ 1348] By: gsar on 1998/07/06 22:55:56
+ Log: remove #! line from Errno_pm.PL
+ Branch: perl
+ ! ext/Errno/Errno_pm.PL
+____________________________________________________________________________
+[ 1347] By: gsar on 1998/07/06 22:51:34
+ Log: added patch to fix Cwd.pm warnings, fixed a couple more places
+ From: Gisle Aas <gisle@aas.no>
+ Date: 06 Jul 1998 13:08:53 +0200
+ Message-ID: <m3af6nfd8a.fsf@furu.g.aas.no>
+ Subject: [PATCH] 5.004_70 Cwd.pm now give warnings
+ Branch: perl
+ ! lib/Cwd.pm
+____________________________________________________________________________
+[ 1346] By: gsar on 1998/07/06 22:20:29
+ Log: much simpler fix to typecheck read/sysread/recv, as suggested by
+ Stephen McCamant
+ Branch: perl
+ ! op.c
+____________________________________________________________________________
+[ 1345] By: gsar on 1998/07/06 21:58:52
+ Log: undo ck_sysread() changes#1319,1337 in preparation for a much
+ simpler fix
+ Branch: perl
+ ! ObjXSub.h embed.h global.sym globals.c objpp.h op.c opcode.h
+ ! opcode.pl proto.h
+____________________________________________________________________________
+[ 1344] By: TimBunce on 1998/07/06 21:51:05
+ Log: Title: "Fix for broken goto &xsub"
+ From: Albert Dvornik <bert@genscan.com>,
+ Msg-ID: <tq4sxawf2h.fsf@puma.genscan.com>
+ Files: MANIFEST pp_ctl.c t/op/goto_xs.t
+ Branch: maint-5.004/perl
+ + t/op/goto_xs.t
+ ! MANIFEST pp_ctl.c
+____________________________________________________________________________
+[ 1343] By: TimBunce on 1998/07/06 21:40:14
+ Log: Title: "Undo sub stub optimization and add comments on GV_FOO constants"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199807050841.EAA25114@aatma.engin.umich.edu>
+ Files: gv.h gv.c op.c toke.c
+ Branch: maint-5.004/perl
+ ! gv.c gv.h op.c toke.c
+____________________________________________________________________________
+[ 1342] By: gsar on 1998/07/06 20:57:06
+ Log: From: Gisle Aas <gisle@aas.no>
+ Message-Id: <m3zpem4v0z.fsf@furu.g.aas.no>
+ Date: 06 Jul 1998 21:52:12 +0200
+ Subject: Keepers of the Patch Pumpkin
+ Branch: perl
+ ! Changes
+____________________________________________________________________________
+[ 1341] By: gsar on 1998/07/06 20:43:35
+ Log: remove dup entry in perldiag
+ Branch: perl
+ ! pod/perldiag.pod
+____________________________________________________________________________
+[ 1340] By: gsar on 1998/07/06 20:31:44
+ Log: more reasonable diagnostic on keyword vs. sub ambiguity
+ Branch: perl
+ ! pod/perldiag.pod toke.c
+____________________________________________________________________________
+[ 1339] By: gsar on 1998/07/06 19:23:06
+ Log: rename s/\bSI_/PERLSI_/ to avoid collisions with sysinfo headers
+ Branch: perl
+ ! av.c cop.h gv.c mg.c op.c perl.c pp_ctl.c pp_sys.c scope.c
+ ! sv.c toke.c util.c
+____________________________________________________________________________
+[ 1338] By: gsar on 1998/07/06 18:45:35
+ Log: per Larry suggestion, toss change#1327 and fix the documentation
+ to match behavior instead
+ Branch: perl
+ ! pod/perlfunc.pod pp_sys.c
+____________________________________________________________________________
+[ 1337] By: gsar on 1998/07/06 17:15:26
+ Log: allow read(FH,threadsv,...)
+ Branch: perl
+ ! op.c
----------------
-Version 5.003_28
+Version 5.004_70
----------------
-This release is beta candidate #6. If this isn't good enough to go beta,
-I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....)
-
- CORE LANGUAGE CHANGES
-
- Title: "Don't let C<sub foo;> undefine &foo"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Make code, doc agree on $ENV{PATH} and `cmd`"
- From: Chip Salzenberg
- Files: pod/perlsec.pod pp_sys.c
-
- Title: "Don't taint $x in C<$x = ($tainted =~ /(\w+)/)>"
- From: Chip Salzenberg
- Files: pp_ctl.c pp_hot.c
-
- Title: "Turn off 'expression tainted' flag at end of runops()"
- From: Chip Salzenberg
- Files: run.c
-
- Title: "When overloading, don't throw away nomethod's value"
- From: Ilya Zakharevich
- Files: gv.c
-
- Title: "Optimize keys() and values() in void context"
- From: Chip Salzenberg
- Files: doop.c op.c
-
- CORE PORTABILITY
-
- Title: "New hints for Digital UNIX"
- From: Jarkko Hietaniemi
- Files: hints/dec_osf.sh
-
- Title: "No version of AIX has working setre[ug]id()"
- From: neufeld@fast.pvi.org (Keith Neufeld)
- Files: hints/aix.sh
-
- Title: "VMS patches post _27"
- From: Charles Bailey
- Msg-ID: <01IFMEMPN1IU0057E2@hmivax.humgen.upenn.edu>
- Date: Thu, 20 Feb 1997 01:58:46 -0500 (EST)
- Files: MANIFEST dosish.h hv.c lib/ExtUtils/MM_VMS.pm
- lib/ExtUtils/xsubpp perl.c perlsdio.h pod/perldelta.pod
- pod/perlvar.pod t/op/closure.t unixish.h vms/Makefile
- vms/descrip.mms vms/ext/filespec.t vms/genconfig.pl
- vms/vms.c vms/vmsish.h
-
- Title: "Re: OS/2 patch for _27"
- From: Ilya Zakharevich
- Msg-ID: <199702210024.TAA03174@monk.mps.ohio-state.edu>
- Date: Thu, 20 Feb 1997 19:24:16 -0500 (EST)
- Files: INSTALL README.os2 lib/Test/Harness.pm os2/Changes
- os2/OS2/PrfDB/t/os2_prfdb.t os2/os2.c os2/os2ish.h
- os2/perl2cmd.pl perl.c pod/perldelta.pod t/TEST t/harness
- t/op/magic.t
-
- OTHER CORE CHANGES
-
- Title: "Fix a typo"
- From: Chip Salzenberg
- Files: pp_sys.c
-
- Title: "Undo signal patch -- it broke die() in signal"
- From: Chip Salzenberg
- Files: mg.c
-
- Title: "Fix perl_call_sv(..., G_NOARGS)"
- From: Chip Salzenberg
- Files: perl.c
-
- Title: "Fix SIGSEGV when cloning sub with complex expression"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Minor update to malloc.c"
- From: Ilya Zakharevich
- Msg-ID: <199702210244.VAA03676@monk.mps.ohio-state.edu>
- Date: Thu, 20 Feb 1997 21:44:13 -0500 (EST)
- Files: malloc.c
-
- Title: "Fix the Tolkien quotation"
- From: Chip Salzenberg
- Files: perly.y
-
- BUILD PROCESS
-
- (no changes)
-
- LIBRARY AND EXTENSIONS
-
- Title: "Debugger patch"
- From: Ilya Zakharevich
- Msg-ID: <199702210737.CAA03951@monk.mps.ohio-state.edu>
- Date: Fri, 21 Feb 1997 02:37:59 -0500 (EST)
- Files: lib/perl5db.pl
-
- Title: "Avoid $` $& $' in libraries"
- From: Ilya Zakharevich
- Msg-ID: <199702210207.VAA03560@monk.mps.ohio-state.edu>
- Date: Thu, 20 Feb 1997 21:07:30 -0500 (EST)
- Files: lib/Getopt/Long.pm lib/Pod/Text.pm lib/diagnostics.pm
- os2/OS2/REXX/REXX.pm
-
- Title: "Remove redundant clearerr() from IO::Seekable"
- From: Chip Salzenberg
- Files: ext/IO/lib/IO/Handle.pm ext/IO/lib/IO/Seekable.pm
-
- Title: "prototype error in File::stat"
- From: Graham.Barr@tiuk.ti.com
- Msg-ID: <199702180748.HAA14151@ultra-boy>
- Date: Tue, 18 Feb 1997 07:48:40 GMT
- Files: lib/File/stat.pm
-
- TESTS
-
- Title: "Include 'study' in regexp.t"
- From: Chip Salzenberg
- Files: t/op/regexp.t
-
- Title: "Don't run locale test if -DNO_LOCALE"
- From: Chip Salzenberg
- Files: t/pragma/locale.t
-
- Title: "Tweak tests to notice $dont_use_nlink"
- From: Chip Salzenberg
- Files: t/io/fs.t t/op/stat.t
-
- Title: "Add test for grep() and wantarray"
- From: Hugo van der Sanden <hv@iii.co.uk>
- Msg-ID: <199702181105.LAA17895@tyree.iii.co.uk>
- Date: Tue, 18 Feb 1997 11:05:59 +0000
- Files: t/op/misc.t
-
- UTILITIES
-
- (no changes)
-
- DOCUMENTATION
-
- Title: "INSTALL updates since _26"
- From: Andy Dougherty
- Msg-ID: <Pine.SOL.3.95q.970218155815.2014F-100000@fractal.lafayette.e
- Date: Tue, 18 Feb 1997 16:00:08 -0500 (EST)
- Files: INSTALL
-
- Title: "Document "$$0" change"
- From: Chip Salzenberg
- Files: pod/perldelta.pod
-
- Title: "Don't recommend impossible //o for C<$x =~ $y>"
- From: Chip Salzenberg
- Files: pod/perlop.pod
-
- Title: "Correct doc that claimed that <FH> was never false"
- From: Chip Salzenberg
- Files: pod/perldelta.pod pod/perlop.pod
-
- Title: "Document C<$?> vs. $SIG{CHLD}"
- From: Ulrich Pfeifer
- Files: pod/perlvar.pod
-
- Title: "Add pumpkin.pod"
- From: Chip Salzenberg
- Files: MANIFEST Porting/pumpkin.pod
-
- Title: "Don't say "associat*ve arr*y""
- From: Chip Salzenberg
- Files: MANIFEST gv.h hv.c lib/Env.pm lib/overload.pm opcode.pl
- pod/perl.pod pod/perldelta.pod pod/perldiag.pod
- pod/perlfunc.pod pod/perlguts.pod pod/perlmod.pod
- pod/perltie.pod pod/perltoc.pod pod/perltrap.pod x2p/a2p.pod
-
+____________________________________________________________________________
+[ 1336] By: gsar on 1998/07/06 09:06:33
+ Log: 5.004_70 tweaks
+ Branch: perl
+ ! Changes win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 1335] By: gsar on 1998/07/06 07:05:37
+ Log: update Changes
+ Branch: perl
+ ! Changes pod/perldiag.pod
+____________________________________________________________________________
+[ 1334] By: gsar on 1998/07/06 06:41:17
+ Log: allow eval-groups in patterns only if they C<use re 'eval';>
+ Branch: perl
+ ! lib/re.pm perl.h pod/perldiag.pod pod/perlre.pod regcomp.c
+ ! t/op/misc.t t/op/pat.t t/op/regexp.t t/op/subst.t
+____________________________________________________________________________
+[ 1333] By: gsar on 1998/07/06 03:22:52
+ Log: From: Hans Mulder <hansm@icgroup.nl>
+ Date: Mon, 6 Jul 98 02:11:32 +0200
+ Message-Id: <9807060021.AA29027@icgned.icgroup.nl>
+ Subject: [PATCH 5.00469] corrupt malloc ptr on NeXT
+ Branch: perl
+ ! malloc.c
+____________________________________________________________________________
+[ 1332] By: gsar on 1998/07/06 03:18:34
+ Log: added Errno-1.09 from CPAN
+ Branch: perl
+ ! ext/Errno/ChangeLog ext/Errno/Errno_pm.PL
+____________________________________________________________________________
+[ 1331] By: gsar on 1998/07/06 02:59:09
+ Log: fix small memleak on -e, don't try to find_script() when e_script
+ Branch: perl
+ ! perl.c
+____________________________________________________________________________
+[ 1330] By: gsar on 1998/07/06 00:40:24
+ Log: add Symbol::delete_package()
+ Branch: perl
+ ! lib/Symbol.pm pod/perlembed.pod
+____________________________________________________________________________
+[ 1329] By: gsar on 1998/07/05 23:05:40
+ Log: patch to remove assumptions about offset of IV being == sizeof(XPV)
+ From: Stephen McCamant <alias@mcs.com>
+ Date: Sun, 5 Jul 1998 17:36:14 -0500 (CDT)
+ Message-ID: <13727.63831.95324.696098@alias-2.pr.mcs.net>
+ Subject: [PATCH] alignment in X[IN]V allocation
+ Branch: perl
+ ! sv.c
+____________________________________________________________________________
+[ 1328] By: gsar on 1998/07/05 22:47:57
+ Log: make read() return undef on errors as documented, and clarify docs
+ Branch: perl
+ ! pod/perlfunc.pod pp_sys.c
+____________________________________________________________________________
+[ 1327] By: gsar on 1998/07/05 22:11:21
+ Log: fix getc() to return empty string instead of undef on eof, as it was
+ documented to behave; still returns undef on error
+ Branch: perl
+ ! pp_sys.c
+____________________________________________________________________________
+[ 1326] By: gsar on 1998/07/05 21:53:30
+ Log: patch whitespace-mutiliated; applied manually
+ From: Hans Mulder <hansm@icgroup.nl>
+ Date: Sun, 5 Jul 98 23:23:20 +0200
+ Message-Id: <9807052133.AA28626@icgned.icgroup.nl>
+ Subject: [PATCH 5.004_69] building Errno.pm still fails on NeXT
+ Branch: perl
+ ! ext/Errno/Errno_pm.PL
+____________________________________________________________________________
+[ 1325] By: gsar on 1998/07/05 21:38:39
+ Log: applied patch (via private mail), modulo retrohunks in pod/perlfaq2.pod
+ From: Tom Christiansen <tchrist@jhereg.perl.com>
+ Date: Sun, 05 Jul 1998 09:15:22 -0500
+ Subject: Re: docpatch
+ Message-Id: <199807051515.JAA03644@jhereg.perl.com>
+ Branch: perl
+ ! pod/perlfaq.pod pod/perlfaq1.pod pod/perlfaq2.pod
+ ! pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod
+ ! pod/perlfaq6.pod pod/perlfaq7.pod pod/perlfaq8.pod
+ ! pod/perlfaq9.pod pod/perlfunc.pod pod/perlipc.pod
+ ! pod/perlrun.pod
+____________________________________________________________________________
+[ 1324] By: gsar on 1998/07/05 21:06:56
+ Log: applied patch, and undid change#1302 which it made unnecessary
+ From: Billy <wdconsta@cs.adelaide.edu.au>
+ Date: Sun, 5 Jul 1998 23:05:52 +0930 (CST)
+ Subject: [PATCH] utils/h2ph.PL and t/lib/h2ph.t
+ Message-ID: <Pine.SV4.3.93.980705230337.27658A-100000@xenon.teaching.cs.adelaide.edu.au>
+ Branch: perl
+ ! t/lib/h2ph.t utils/h2ph.PL
+____________________________________________________________________________
+[ 1323] By: gsar on 1998/07/05 20:56:39
+ Log: fix t/lib/fields.t's @INC so make test runs
+ Branch: perl
+ ! t/lib/fields.t
+____________________________________________________________________________
+[ 1322] By: gsar on 1998/07/05 20:26:43
+ Log: add comments on GV_FOO constants, s/8/GV_ADDINEVAL/
+ Branch: perl
+ ! gv.c gv.h toke.c
+____________________________________________________________________________
+[ 1321] By: gsar on 1998/07/05 07:41:50
+ Log: sundry win32 config tweaks
+ Branch: perl
+ ! Todo.5.005 t/op/stat.t win32/Makefile 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 win32/makefile.mk
+____________________________________________________________________________
+[ 1320] By: gsar on 1998/07/05 06:30:35
+ Log: update Changes
+ Branch: perl
+ ! Changes
+____________________________________________________________________________
+[ 1319] By: gsar on 1998/07/05 06:27:37
+ Log: add ck_sysread() for better sysread/read/recv sanity
+ Branch: perl
+ ! ObjXSub.h embed.h global.sym globals.c objpp.h op.c opcode.h
+ ! opcode.pl proto.h
+____________________________________________________________________________
+[ 1318] By: gsar on 1998/07/05 04:34:05
+ Log: From: Stephen McCamant <alias@mcs.com>
+ Date: Sat, 4 Jul 1998 23:24:47 -0500 (CDT)
+ Subject: [PATCH] Document B::Deparse, add pp_threadsv
+ Message-ID: <13726.65230.19324.216849@alias-2.pr.mcs.net>
+ Branch: perl
+ ! ext/B/B/Deparse.pm
+____________________________________________________________________________
+[ 1317] By: gsar on 1998/07/05 04:15:25
+ Log: added patch with tweak to doc
+ From: Chip Salzenberg <chip@perl.org>
+ Message-ID: <19980704205136.A16319@perlsupport.com>
+ Date: Sat, 4 Jul 1998 20:51:36 -0400
+ Subject: [PATCH _69] Take 2: Warn on C<sub log; log($msg)>
+ Branch: perl
+ ! ext/IO/lib/IO/Handle.pm pod/perldiag.pod toke.c
+____________________________________________________________________________
+[ 1316] By: gsar on 1998/07/05 03:56:22
+ Log: Porting/Glossary goes podly into Config.pm
+ Branch: perl
+ ! Porting/Glossary configpm
+____________________________________________________________________________
+[ 1315] By: gsar on 1998/07/05 02:50:18
+ Log: add suggested tool as an example in ExtUtils::Packlist
+ From: Alan Burlison <Alan.Burlison@UK.Sun.com>
+ Message-Id: <199807031028.LAA10456@sale-wts>
+ Date: Fri, 3 Jul 1998 11:28:03 +0100 (BST)
+ Subject: Re: [make install] another horror story
+ Branch: perl
+ ! lib/ExtUtils/Installed.pm lib/ExtUtils/Packlist.pm
+____________________________________________________________________________
+[ 1314] By: gsar on 1998/07/05 02:28:04
+ Log: avoid race condition (storing ptr to SV before incrementing its
+ REFCNT) and warning in newRV()
+ Branch: perl
+ ! sv.c
+____________________________________________________________________________
+[ 1313] By: gsar on 1998/07/05 02:06:40
+ Log: applied suggested fix for xhv_array sizing, with portability tweaks
+ From: Gisle Aas <gisle@aas.no>
+ Subject: Re: [PATCH] Re: perl5.004_69 core dump
+ Date: 04 Jul 1998 10:20:35 +0200
+ Message-ID: <m3af6qowmk.fsf@furu.g.aas.no>
+ Branch: perl
+ ! hv.c
+____________________________________________________________________________
+[ 1312] By: gsar on 1998/07/05 01:36:45
+ Log: From: Gisle Aas <gisle@aas.no>
+ Subject: [PATCH] hv_max may be a few too many
+ Date: 04 Jul 1998 09:28:46 +0200
+ Message-ID: <m3d8bmoz0x.fsf@furu.g.aas.no>
+ Branch: perl
+ ! doop.c
+____________________________________________________________________________
+[ 1311] By: gsar on 1998/07/05 00:35:27
+ Log: patchlevel up to 5.004_70, various tweaks
+ * fix taint problems due to maintbranch regression
+ * PERL_OBJECT now builds again
+ * deal with C++ strong-typing problems in hv.c
+ * fix mismatch in "reserved word" diagnostic
+ Branch: perl
+ ! av.c hv.c objpp.h patchlevel.h pp_ctl.c pp_hot.c proto.h
+ ! regexec.c regexp.h toke.c win32/perlhost.h win32/win32.c
+____________________________________________________________________________
+[ 1310] By: TimBunce on 1998/07/04 11:35:25
+ Log: Remove old RE //t flag from scan_subst().
+ Branch: maint-5.004/perl
+ ! toke.c
+____________________________________________________________________________
+[ 1309] By: gsar on 1998/07/04 08:32:53
+ Log: various small tweaks (still fails a few taint tests in {taint,locale}.t)
+ Branch: perl
+ ! Todo.5.005 lib/re.pm sv.c t/lib/fields.t
+____________________________________________________________________________
+[ 1307] By: gsar on 1998/07/04 07:00:14
+ Log: fix C<local $tied{foo} = $tied{foo}>, add tests
+ Branch: perl
+ ! pp_hot.c t/op/local.t
+____________________________________________________________________________
+[ 1306] By: gsar on 1998/07/04 05:52:34
+ Log: fixes for mortalization bug in xsubpp, other efficiency tweaks
+ From: joshua.pritikin@db.com
+ Date: Wed, 1 Jul 1998 10:09:43 -0400
+ Message-Id: <H00000e500086fb3@MHS>
+ Subject: [PATCH _69] sv_2mortal fix
+ Branch: perl
+ ! lib/ExtUtils/xsubpp perl.c pp.c pp_hot.c proto.h sv.c sv.h
+____________________________________________________________________________
+[ 1305] By: gsar on 1998/07/04 05:46:42
+ Log: add patch preextend global string table, tweak for 512 entries
+ From: Gisle Aas <gisle@aas.no>
+ Date: 04 Jul 1998 01:04:08 +0200
+ Subject: Re: [PATCH] Re: perl5.004_69 core dump
+ Message-ID: <m3ra02v8nr.fsf@furu.g.aas.no>
+ Branch: perl
+ ! perl.c
+____________________________________________________________________________
+[ 1304] By: gsar on 1998/07/04 05:40:35
+ Log: simplify xhv_array sizing
+ From: Gisle Aas <gisle@aas.no>
+ Date: 04 Jul 1998 00:49:42 +0200
+ Subject: Re: [PATCH] Re: perl5.004_69 core dump
+ Message-ID: <m3yauav9bt.fsf@furu.g.aas.no>
+ Branch: perl
+ ! hv.c
+____________________________________________________________________________
+[ 1303] By: gsar on 1998/07/04 05:37:29
+ Log: make 4-arg win32_select() sleep more reasonably on false values
+ From: Blair Zajac <blair@gps.caltech.edu>
+ Message-Id: <199807020225.TAA18740@gobi.gps.caltech.edu>
+ Date: Wed, 1 Jul 1998 19:25:56 -0700 (PDT)
+ Subject: [PATCH 5.004_69] select dumps core on MSWin32-x86
+ --
+ Message-Id: <199807030107.SAA08595@gobi.gps.caltech.edu>
+ Date: Thu, 2 Jul 1998 18:07:19 -0700 (PDT)
+ Subject: [PATCH 5.004_69] select dumps core on MSWin32-x86
+ Branch: perl
+ ! win32/win32sck.c
+____________________________________________________________________________
+[ 1302] By: gsar on 1998/07/04 05:32:50
+ Log: adjust h2ph.t for dos-specific problem
+ From: Laszlo Molnar <molnarl@cdata.tvnet.hu>
+ Message-ID: <19980703234525.C208@cdata.tvnet.hu>
+ Date: Fri, 3 Jul 1998 23:45:25 +0200
+ Subject: Re: [PATCH _68] t/lib/h2ph.t problem
+ Branch: perl
+ ! t/lib/h2ph.t
+____________________________________________________________________________
+[ 1301] By: gsar on 1998/07/04 05:31:04
+ Log: fix CPAN.pm problem, OS2 tweaks
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199807030459.AAA00097@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_68] PAtch to CPAN first-time
+ Date: Fri, 3 Jul 1998 00:59:35 -0400 (EDT)
+ Branch: perl
+ ! lib/CPAN/FirstTime.pm lib/ExtUtils/MM_OS2.pm
+ ! lib/ExtUtils/MakeMaker.pm
+____________________________________________________________________________
+[ 1300] By: gsar on 1998/07/04 05:27:20
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199807030102.VAA26813@monk.mps.ohio-state.edu>
+ Date: Thu, 2 Jul 1998 21:02:59 -0400 (EDT)
+ Subject: [PATCH 5.004_68] Add elc target to to makefile
+ Branch: perl
+ ! Makefile.SH
+____________________________________________________________________________
+[ 1299] By: gsar on 1998/07/04 05:25:56
+ Log: newer emacs/cperl-mode.el (via private mail)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199807030104.VAA26825@monk.mps.ohio-state.edu>
+ Date: Thu, 2 Jul 1998 21:04:29 -0400 (EDT)
+ Subject: [PATCH 5.004_68] cperl-mode
+ Branch: perl
+ ! emacs/cperl-mode.el
+____________________________________________________________________________
+[ 1298] By: gsar on 1998/07/04 05:22:41
+ Log: From: Dominic Dunlop <domo@computer.org>
+ Message-Id: <v03110701b1c1603eae52@[195.95.102.68]>
+ Date: Thu, 2 Jul 1998 22:57:26 +0000
+ Subject: [PATCH 5.004_69] Make Power MachTen use vfork and perl's malloc
+ Branch: perl
+ ! hints/machten.sh malloc.c
+____________________________________________________________________________
+[ 1297] By: gsar on 1998/07/04 05:20:52
+ Log: allow a flags args to fbm_instr() for future needs
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199807020749.DAA12379@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_68] mORE FBM_ CHANGES FOR FUTURE
+ Date: Thu, 2 Jul 1998 03:49:32 -0400 (EDT)
+ Branch: perl
+ ! pod/perlguts.pod pp.c pp_hot.c proto.h regexec.c util.c
+____________________________________________________________________________
+[ 1296] By: gsar on 1998/07/04 05:16:15
+ Log: From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Thu, 2 Jul 1998 11:50:41 -0400 (EDT)
+ Message-Id: <Pine.SUN.3.96.980702114956.18246B-100000@newton.phys>
+ Subject: [PATCH 5.004_69] INSTALL-1.39
+ Branch: perl
+ ! INSTALL
+____________________________________________________________________________
+[ 1295] By: gsar on 1998/07/04 05:15:05
+ Log: Configure update
+ From: doughera@newton.phys.lafayette.edu (Andy Dougherty)
+ Date: Wed, 1 Jul 98 23:07:50 EDT
+ Message-Id: <9807020307.AA17848@newton.phys.lafayette.edu>
+ Subject: [PATCH 5.004_69] Config_69-01
+ Branch: perl
+ ! Configure INSTALL MANIFEST Policy_sh.SH Porting/Glossary
+ ! Porting/config.sh Porting/config_H Porting/pumpkin.pod
+ ! config_h.SH win32/config.bc win32/config.gc win32/config.vc
+____________________________________________________________________________
+[ 1294] By: gsar on 1998/07/04 05:10:25
+ Log: add perlbug -F switch to save message to file
+ From: Hugo van der Sanden <hv@crypt0.demon.co.uk>
+ Message-Id: <l03130301b1c03a649e45@[194.222.64.89]>
+ Date: Wed, 1 Jul 1998 21:14:22 +0200
+ Subject: Re: [PATCH 5.004_69] perlbug -fok
+ Branch: perl
+ ! Makefile.SH utils/perlbug.PL
+____________________________________________________________________________
+[ 1293] By: gsar on 1998/07/04 05:06:52
+ Log: catch nonexistent backrefs in REs
+ From: Hugo van der Sanden <hv@crypt0.demon.co.uk>
+ Message-Id: <l03130304b1c027e1df9e@[194.222.64.89]>
+ Date: Wed, 1 Jul 1998 20:14:05 +0200
+ Subject: Re: [PATCH _66] for bad backrefs
+ --
+ Message-Id: <l03130300b1c03425261c@[194.222.64.89]>
+ Date: Wed, 1 Jul 1998 20:47:16 +0200
+ Subject: Re: [PATCH _66] for bad backrefs
+ Branch: perl
+ ! regcomp.c t/op/re_tests util.c
+____________________________________________________________________________
+[ 1292] By: gsar on 1998/07/04 05:02:01
+ Log: fix perlcc to not rm output file, and other -w(arts)
+ Branch: perl
+ ! utils/perlcc.PL
+____________________________________________________________________________
+[ 1291] By: gsar on 1998/07/04 04:30:03
+ Log: ignore stash entries that are not GVs in dump.c
+ Branch: perl
+ ! dump.c
+____________________________________________________________________________
+[ 1290] By: gsar on 1998/07/04 03:55:10
+ Log: cleaner page headers from pod2man
+ Branch: perl
+ ! pod/pod2man.PL
+____________________________________________________________________________
+[ 1288] By: gsar on 1998/07/04 03:16:39
+ Log: tweaks to Getopt::Std
+ From: Robin Barker <rmb1@cise.npl.co.uk>
+ Date: Tue, 30 Jun 98 14:45:49 BST
+ Message-Id: <14103.9806301345@tempest.cise.npl.co.uk>
+ Subject: [PATCH perl5.004_69] lib/Getopt/Std.pm
+ --
+ Message-Id: <17918.9807021053@tempest.cise.npl.co.uk>
+ To: perl5-porters@perl.org
+ Subject: [PATCH perl5.004_69] second: lib/Getopt/Std.pm
+ Branch: perl
+ ! lib/Getopt/Std.pm
+____________________________________________________________________________
+[ 1287] By: gsar on 1998/07/04 03:13:02
+ Log: added patch, with tweaks
+ From: Gisle Aas <gisle@aas.no>
+ Date: 03 Jul 1998 00:50:15 +0200
+ Message-ID: <m3btr7n9zs.fsf@furu.g.aas.no>
+ Subject: [PATCH] Some AVHV documentation
+ Branch: perl
+ ! pod/perlref.pod
+____________________________________________________________________________
+[ 1286] By: gsar on 1998/07/04 02:53:26
+ Log: applied patch with tweaks to prose
+ From: Gisle Aas <gisle@aas.no>
+ Subject: [PATCH] Simplified AVHV support
+ Date: 30 Jun 1998 13:34:07 +0200
+ Message-ID: <m3k95z86og.fsf@furu.g.aas.no>
+ Branch: perl
+ ! ObjXSub.h av.c embed.h global.sym objpp.h pod/perldiag.pod
+ ! pp.c proto.h t/op/avhv.t
+____________________________________________________________________________
+[ 1285] By: gsar on 1998/07/04 02:30:48
+ Log: tweak doc for ".."
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Subject: [PATCH] pod for scalar ..
+ Message-Id: <E0yqyN8-0006gv-00@taurus.cus.cam.ac.uk>
+ Date: Tue, 30 Jun 1998 12:14:50 +0100
+ Branch: perl
+ ! pod/perlop.pod
+____________________________________________________________________________
+[ 1284] By: gsar on 1998/07/04 02:28:43
+ Log: fix use of uninitialized var in pp_unpack()
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Tue, 30 Jun 1998 14:32:17 +0300 (EET DST)
+ Message-Id: <199806301132.OAA27353@alpha.hut.fi>
+ Subject: [PATCH] 5.004_69 (also for 5.004_04) one more^Wless quad bug
+ Branch: perl
+ ! pp.c
+____________________________________________________________________________
+[ 1283] By: gsar on 1998/07/04 02:26:37
+ Log: From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Tue, 30 Jun 1998 11:40:22 +0300 (EET DST)
+ Message-Id: <199806300840.LAA04872@alpha.hut.fi>
+ Subject: [PATCH] 5.004_69: Parsewords.pm: avoid undefined warnings
+ Branch: perl
+ ! lib/Text/ParseWords.pm
+____________________________________________________________________________
+[ 1282] By: gsar on 1998/07/04 02:24:32
+ Log: VMS updates from Dan Sugalski <sugalskd@osshe.edu>
+ Message-Id: <3.0.5.32.19980629165356.00a20730@ous.edu>
+ Date: Mon, 29 Jun 1998 16:53:56 -0700
+ Subject: [PATCH 5.004_69]README.vms doc patch
+ --
+ Message-Id: <3.0.5.32.19980629165125.00a4e100@ous.edu>
+ Date: Mon, 29 Jun 1998 16:51:25 -0700
+ --
+ Message-Id: <3.0.5.32.19980702135357.00a5eb40@ous.edu>
+ Date: Thu, 02 Jul 1998 13:53:57 -0700
+ Subject: [PATCH 5.004_69]VMS filetest operator fixup
+ Branch: perl
+ ! README.vms vms/descrip_mms.template vms/vms.c
+____________________________________________________________________________
+[ 1281] By: gsar on 1998/07/04 02:17:48
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ Message-Id: <3.0.5.32.19980629164625.00a4d7c0@ous.edu>
+ Date: Mon, 29 Jun 1998 16:46:25 -0700
+ Subject: [PATCH 5.004_69]Tweaks to VMS configuration procedure
+ Branch: perl
+ ! vms/subconfigure.com
+____________________________________________________________________________
+[ 1280] By: gsar on 1998/07/04 02:16:03
+ Log: don't attempt to copy directories on VMS
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Message-Id: <3.0.5.32.19980629163129.00a82140@ous.edu>
+ Date: Mon, 29 Jun 1998 16:31:29 -0700
+ Subject: [PATCH 5.004_69]Tweak to installperl
+ Branch: perl
+ ! installperl
+____________________________________________________________________________
+[ 1279] By: gsar on 1998/07/04 02:09:26
+ Log: add 'installhtml*dir' to win32 config templates
+ From: "Douglas Lankshear" <dougl@ActiveState.com>
+ Subject: [PATCH 5.004_68] For Win32 config
+ Date: Mon, 29 Jun 1998 09:00:13 -0700
+ Message-ID: <000a01bda376$ffe8b0b0$a32fa8c0@tau.Active>
+ Branch: perl
+ ! win32/config.bc win32/config.gc win32/config.vc
+____________________________________________________________________________
+[ 1278] By: gsar on 1998/07/04 02:06:23
+ Log: implemented described fix for h2ph hanging on "enum"
+ From: Billy <wdconsta@cs.adelaide.edu.au>
+ Subject: Re: h2ph problem on Solaris 2.6/SPARC/Sun compiler
+ Message-ID: <Pine.SV4.3.93.980627010407.21715A-100000@xenon.teaching.cs.adelaide.edu.au>
+ Date: Sat, 27 Jun 1998 01:13:12 +0930 (CST)
+ Branch: perl
+ ! utils/h2ph.PL
+____________________________________________________________________________
+[ 1277] By: gsar on 1998/07/04 01:51:47
+ Log: merge changes#1210,1211,1270 from maintbranch
+ Branch: perl
+ + lib/re.pm
+ ! MANIFEST dump.c installperl lib/File/Basename.pm mg.c op.c
+ ! op.h perl.h pod/perlmodlib.pod pod/perlop.pod pp_ctl.c
+ ! pp_hot.c t/lib/basename.t t/op/taint.t toke.c
+____________________________________________________________________________
+[ 1276] By: gsar on 1998/07/04 00:33:37
+ Log: deprecate use of reserved word "our" (Larry's idea)
+ Date: Mon, 22 Jun 1998 08:55:09 -0700
+ From: larry@wall.org (Larry Wall)
+ Message-Id: <199806221555.IAA07212@wall.org>
+ Subject: Re: our
+ Branch: perl
+ ! pod/perldiag.pod toke.c
+____________________________________________________________________________
+[ 1275] By: nick on 1998/07/02 18:36:59
+ Log: Integrate mainline, just to keep up.
+ Branch: ansiperl
+ +> t/lib/fields.t
+ - lib/Math/Trig/Radial.pm
+ !> MANIFEST lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm
+ !> lib/Math/Trig.pm lib/base.pm lib/fields.pm mg.c
+ !> pod/perldiag.pod pod/perltrap.pod pp_hot.c scope.c scope.h
+ !> t/lib/trig.t t/op/array.t toke.c utils/perldoc.PL
+ !> win32/config.bc win32/config.gc win32/config.vc
+ !> win32/include/dirent.h win32/makedef.pl win32/win32.c
+ !> win32/win32iop.h
+____________________________________________________________________________
+[ 1274] By: gsar on 1998/07/02 16:47:20
+ Log: tweak win32/config.* variables
+ Branch: perl
+ ! win32/config.bc win32/config.gc win32/config.vc
+____________________________________________________________________________
+[ 1273] By: gsar on 1998/07/02 16:33:53
+ Log: export opendir() set of functions on win32
+ Branch: perl
+ ! win32/include/dirent.h win32/makedef.pl win32/win32.c
+ ! win32/win32iop.h
+____________________________________________________________________________
+[ 1272] By: gsar on 1998/07/01 23:21:49
+ Log: fix C<@a = (%a = 1)> bizarreness
+ Branch: perl
+ ! pp_hot.c
+____________________________________________________________________________
+[ 1271] By: gsar on 1998/06/30 22:49:39
+ Log: document perltrap on precedence of keys/values/each
+ Branch: perl
+ ! pod/perltrap.pod
+____________________________________________________________________________
+[ 1270] By: TimBunce on 1998/06/30 09:06:21
+ Log: Added lib/re.pm missing from change 1210
+ Branch: maint-5.004/perl
+ + lib/re.pm
+____________________________________________________________________________
+[ 1269] By: gsar on 1998/06/30 08:20:52
+ Log: From: Murray Nesbitt <murray@ActiveState.com>
+ Message-Id: <77180549BCE.AAA466A@mail.rdc1.bc.wave.home.com>
+ Date: Mon, 29 Jun 1998 14:30:59 PDT
+ Subject: Re: [PATCH 5.004_67] MakeMaker mods for PPD support
+ Branch: perl
+ ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm
+____________________________________________________________________________
+[ 1268] By: gsar on 1998/06/30 05:38:34
+ Log: From: Robin Barker <rmb1@cise.npl.co.uk>
+ Message-Id: <13254.9806291404@tempest.cise.npl.co.uk>
+ Date: Mon, 29 Jun 1998 15:04:57 -0000
+ Subject: [PATCH perl5.004_69] perldoc.PL
+ Branch: perl
+ ! utils/perldoc.PL
+____________________________________________________________________________
+[ 1267] By: gsar on 1998/06/30 05:34:06
+ Log: add patch to integrate Math::Trig::Radial into Math::Trig
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Mon, 29 Jun 1998 16:28:53 +0300 (EET DST)
+ Message-Id: <199806291328.QAA16916@alpha.hut.fi>
+ Subject: [PATCH] 5.004_68 (or 5.004_04): radial trig
+ Branch: perl
+ - lib/Math/Trig/Radial.pm
+ ! MANIFEST lib/Math/Trig.pm t/lib/trig.t
+____________________________________________________________________________
+[ 1266] By: gsar on 1998/06/30 05:17:33
+ Log: From: Gisle Aas <gisle@aas.no>
+ Message-Id: <m367hk4hra.fsf@furu.g.aas.no>
+ Date: 29 Jun 1998 12:36:09 +0200
+ Subject: Re: [PATCH] Simplified magic_setisa() and improved fields.pm
+ Branch: perl
+ + t/lib/fields.t
+ ! MANIFEST lib/base.pm lib/fields.pm mg.c pod/perldiag.pod
+ ! t/op/array.t
+____________________________________________________________________________
+[ 1265] By: gsar on 1998/06/30 05:12:57
+ Log: tweaks to overloaded constants (change#1259)
+ Branch: perl
+ ! scope.c scope.h toke.c
+____________________________________________________________________________
+[ 1264] By: nick on 1998/06/29 17:38:03
+ Log: Integrate mainline c. _69 to ansiperl
+ Branch: ansiperl
+ +> eg/cgi/caution.xbm eg/cgi/dna.small.gif.uu
+ +> eg/cgi/nph-multipart.cgi ext/Errno/ChangeLog
+ +> ext/Errno/Errno_pm.PL ext/Errno/Makefile.PL lib/CGI/Cookie.pm
+ +> lib/Math/Trig/Radial.pm perlio.h t/lib/cgi-form.t
+ +> t/lib/cgi-function.t t/lib/cgi-html.t t/lib/cgi-request.t
+ +> t/lib/errno.t t/op/goto_xs.t t/op/splice.t
+ !> (integrate 100 files)
----------------
-Version 5.003_27
+Version 5.004_69
----------------
-This release is beta candidate #5: Our last, best hope for a beta.
-
- CORE LANGUAGE CHANGES
-
- Title: "Better looks_like_number() function [sv.c]"
- From: Gisle Aas
- Msg-ID: <199702141708.SAA17546@bergen.sn.no>
- Date: Fri, 14 Feb 1997 18:08:52 +0100
- Files: sv.c
-
- Title: "Remove redundant functions UNIVERSAL::{class,is_instance}"
- From: Gisle Aas
- Msg-ID: <hwwsbpeq2.fsf@bergen.sn.no>
- Date: 14 Feb 1997 15:52:21 +0000
- Files: pod/perldelta.pod pod/perlobj.pod t/op/universal.t universal.c
-
- Title: "Allow C<setpgrp $$>"
- From: Roderick Schertler
- Msg-ID: <pzraigyshr.fsf@eeyore.ibcinc.com>
- Date: 16 Feb 1997 23:19:12 -0500
- Files: pp_sys.c
-
- Title: "Fix syntax error on C<&$1>"
- From: Chip Salzenberg
- Files: toke.c
-
- Title: "Fix sub call through magic var (e.g. C<&$1>)"
- From: Chip Salzenberg
- Files: pp_hot.c
-
- Title: "Fix grep() with refs in array context"
- From: Chip Salzenberg
- Files: pp.c
-
- CORE PORTABILITY
-
- Title: "Eliminate $^S; add C<use vmsish qw(status exit time)>"
- From: Charles Bailey
- Msg-ID: <01IFI9CFKL0S004R2V@hmivax.humgen.upenn.edu>
- Date: Mon, 17 Feb 1997 02:45:26 -0500 (EST)
- Files: MANIFEST gv.c lib/English.pm lib/ExtUtils/MM_VMS.pm
- lib/ExtUtils/Mksymlists.pm lib/ExtUtils/xsubpp mg.c op.c
- perl.c perl.h pod/perldelta.pod pod/perlmod.pod
- pod/perlvar.pod pp_ctl.c pp_sys.c utils/perldoc.PL
- vms/Makefile vms/config.vms vms/descrip.mms
- vms/ext/Stdio/Stdio.pm vms/ext/Stdio/Stdio.xs
- vms/ext/XSSymSet.pm vms/ext/vmsish.pm vms/vms.c vms/vmsish.h
- win32/makedef.pl
-
- Title: "Eliminate FP exceptions under SCO 5"
- From: Chip Salzenberg
- Files: hints/sco.sh unixish.h
-
- Title: "Digital UNIX hints"
- From: Jarkko Hietaniemi
- Msg-ID: <199702151906.VAA22999@alpha.hut.fi>
- Date: Sat, 15 Feb 1997 21:06:33 +0200 (EET)
- Files: hints/dec_osf.sh
-
- Title: "Irix6.4 (with 7.1 compilers)"
- From: John Stoffel <jfs@fluent.com>
- Msg-ID: <199702130238.VAA24468@jfs.Fluent.COM>
- Date: Wed, 12 Feb 1997 21:38:51 -0500 (EST)
- Files: hints/irix_6_2.sh hints/irix_6_4.sh
-
- Title: "Update Plan 9, Win32, VMS configs with $shortsize and $longsize"
- From: Chip Salzenberg
- Files: plan9/config.plan9 plan9/genconfig.pl
- vms/genconfig.pl win32/config.w32
-
- OTHER CORE CHANGES
-
- Title: "Fix core dump when embedding"
- From: Chip Salzenberg
- Files: perl.c
-
- Title: "Re: Fragile signals"
- From: Ilya Zakharevich
- Msg-ID: <199702130644.BAA07572@monk.mps.ohio-state.edu>
- Date: Thu, 13 Feb 1997 01:44:39 -0500 (EST)
- Files: mg.c
-
- Title: "Make format strings correspond exactly to parameters"
- From: Roderick Schertler
- Msg-ID: <pz7mkc1h0g.fsf@eeyore.ibcinc.com>
- Date: 13 Feb 1997 17:24:31 -0500
- Files: doio.c ext/DB_File/DB_File.xs ext/Opcode/Opcode.xs gv.c op.c
- perl.c pp_ctl.c pp_sys.c regcomp.c toke.c
-
- Title: "Don't try to attach 'o' magic to read-only values"
- From: Chip Salzenberg
- Files: sv.c
-
- Title: "Fix carriage-return message"
- From: Chip Salzenberg
- Files: toke.c
-
- Title: "In <=>, test for equality first"
- From: Chip Salzenberg
- Files: pp.c
-
- Title: "Don't mark sv_{true,false} PADTMP"
- From: Chip Salzenberg
- Files: op.c
-
- BUILD PROCESS
-
- Title: "Fix eval "" in Configure"
- From: allen@gateway.grumman.com (John L. Allen)
- Msg-ID: <9702141809.AA17001@gateway.grumman.com>
- Date: Fri, 14 Feb 1997 13:09:53 -0500
- Files: Configure
-
- Title: "Don't link with -lsfio if sfio is not requested"
- From: Chip Salzenberg
- Files: Configure
-
- Title: "perl5.003_26 Configure change "win" for AIX 4"
- From: Tim Mooney <mooney@dogbert.cc.ndsu.NoDak.edu>
- Msg-ID: <Pine.OSF.3.95.970214135751.32654A-100000@dogbert.cc.ndsu.NoD
- Date: Fri, 14 Feb 1997 13:59:02 -0600 (CST)
- Files: Configure
-
- Title: "Update os2/diff.configure"
- From: Chip Salzenberg
- Files: os2/diff.configure
-
- LIBRARY AND EXTENSIONS
-
- Title: "Remove Fatal.pm"
- From: Chip Salzenberg
- Files: MANIFEST lib/Fatal.pm pod/perldelta.pod pod/perlmod.pod
- pod/roffitall t/lib/fatal.t
-
- Title: "Refresh MakeMaker to 5.40"
- From: Andy Dougherty, Andreas Koenig, Tim Bunce
- Files: lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Unix.pm
- lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm
-
- Title: "Refresh CPAN.pm to 1.21"
- From: Andreas Koenig
- Files: lib/CPAN.pm lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm
-
- Title: "Refresh Test::Harness to 1.15"
- From: Andreas Koenig
- Files: lib/Test/Harness.pm
-
- TESTS
-
- Title: "Remove non-portable locale tests"
- From: Chip Salzenberg
- Files: t/pragma/locale.t
-
- UTILITIES
-
- Title: "pod2man: missing '-' in name section shouldn't be fatal"
- From: Ulrich Pfeifer
- Msg-ID: <yfmzpxcimsa.fsf@ls6.informatik.uni-dortmund.de>
- Date: 10 Feb 1997 18:38:45 +0100
- Files: pod/pod2man.PL
-
- DOCUMENTATION
-
- Title: "Update To-Do list"
- From: Tim Bunce
- Msg-ID: <9702101900.AA25293@toad.ig.co.uk>
- Date: Mon, 10 Feb 1997 19:00:59 +0000
- Files: Todo
-
- Title: "Fix formatting in perldiag"
- From: Chip Salzenberg
- Files: pod/perldiag.pod
-
+____________________________________________________________________________
+[ 1263] By: gsar on 1998/06/29 09:17:28
+ Log: update Changes and perlhist.pod
+ Branch: perl
+ ! Changes pod/perlhist.pod
+____________________________________________________________________________
+[ 1262] By: gsar on 1998/06/29 08:26:36
+ Log: bump patchlevel to 69, various little tweaks (tested on win32, Solaris
+ under several build configurations)
+ Branch: perl
+ ! Todo.5.005 op.c patchlevel.h t/lib/cgi-function.t
+ ! t/lib/cgi-request.t toke.c win32/Makefile win32/config_H.bc
+ ! win32/config_H.gc win32/config_H.vc win32/makefile.mk
+____________________________________________________________________________
+[ 1261] By: gsar on 1998/06/29 06:51:10
+ Log: add missing SSCHECK() to rectify faulty SSPUSH*() logic in change#1259
+ Branch: perl
+ ! scope.h
+____________________________________________________________________________
+[ 1260] By: gsar on 1998/06/29 06:46:12
+ Log: Message-Id: <199806290610.IAA19443@moulon.inra.fr>
+ Date: Mon, 29 Jun 1998 08:10:46 +0200
+ From: ts <decoux@moulon.inra.fr>
+ Subject: {perlembed.pod] Re: Memory leak in Perl 5.004 and the fix
+ Branch: perl
+ ! pod/perlembed.pod
+____________________________________________________________________________
+[ 1259] By: gsar on 1998/06/29 06:01:35
+ Log: added patch for overloading constants, made PERL_OBJECT-aware
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806270328.XAA21088@monk.mps.ohio-state.edu>
+ Date: Fri, 26 Jun 1998 23:28:41 -0400 (EDT)
+ Branch: perl
+ ! ObjXSub.h embed.h embedvar.h global.sym hv.c interp.sym
+ ! intrpvar.h lib/Math/BigInt.pm lib/overload.pm objpp.h op.c
+ ! perl.c perl.h pp_ctl.c proto.h scope.c scope.h
+ ! t/pragma/overload.t toke.c
+____________________________________________________________________________
+[ 1258] By: gsar on 1998/06/29 05:32:25
+ Log: fix Socket.pm typo from change#1240
+ Branch: perl
+ ! ext/Socket/Socket.pm
+____________________________________________________________________________
+[ 1257] By: gsar on 1998/06/29 05:09:24
+ Log: applied patch, tweak for threads awareness
+ From: Albert Dvornik <bert@genscan.com>
+ Subject: [PATCH]5.004_04-m4 (CORE) fix for broken "goto &xsub"
+ Date: 24 Jun 1998 19:33:09 -0400
+ Message-Id: <tq4sxawf2h.fsf@puma.genscan.com>
+ Branch: perl
+ + t/op/goto_xs.t
+ ! MANIFEST pp_ctl.c
+____________________________________________________________________________
+[ 1256] By: gsar on 1998/06/29 03:34:18
+ Log: applied patch, fixed one more leak, tweaked whitespace bugs
+ From: Guy Decoux <decoux@moulon.inra.fr>
+ (via)
+ Date: Fri, 26 Jun 1998 09:59:32 -0400
+ From: "Chunhui Teng" <cteng@nortel.ca>
+ Message-Id: <199806261359.JAA02393@bmers357.nortel.ca>
+ Subject: Memory leak in Perl 5.004 and the fix
+ Branch: perl
+ ! ext/Opcode/Opcode.xs ext/Opcode/Safe.pm
+____________________________________________________________________________
+[ 1255] By: gsar on 1998/06/29 02:50:37
+ Log: From: koenig@kulturbox.de (Andreas J. Koenig)
+ Subject: Permissions in MakeMaker (Was: patch to MM_Unix.pm)
+ Date: 28 Jun 1998 23:47:07 +0200
+ Message-ID: <sfc1zs9gpwk.fsf@dubravka.in-berlin.de>
+ Branch: perl
+ ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm
+____________________________________________________________________________
+[ 1254] By: gsar on 1998/06/28 21:35:02
+ Log: From: joshua.pritikin@db.com
+ Date: Fri, 26 Jun 1998 09:34:34 -0400
+ Message-Id: <H00000e500081d23@MHS>
+ Subject: [PATCH _68] PUSHSTACK renovation
+ Branch: perl
+ ! av.c cop.h gv.c mg.c perl.c pp_ctl.c pp_sys.c sv.c util.c
+____________________________________________________________________________
+[ 1253] By: gsar on 1998/06/28 21:21:22
+ Log: From: Stephen McCamant <alias@mcs.com>
+ Message-Id: <m0yq2fr-000EalC@alias-2.pr.mcs.net>
+ Date: Sat, 27 Jun 1998 16:38:19 -0500 (CDT)
+ Subject: IV changes for long long (was Re: 5.004_68 on its way to the CPAN)
+ Branch: perl
+ ! perlvars.h sv.c
+____________________________________________________________________________
+[ 1252] By: gsar on 1998/06/28 21:16:34
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806272359.TAA05436@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_68] Improve warning on zero-length chunks in RE
+ Date: Sat, 27 Jun 1998 19:59:13 -0400 (EDT)
+ Branch: perl
+ ! regcomp.c
+____________________________________________________________________________
+[ 1251] By: gsar on 1998/06/28 21:14:32
+ Log: add Math/Trig/Radial.pm, update MANIFEST
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Sat, 27 Jun 1998 17:28:14 +0300 (EET DST)
+ Message-Id: <199806271428.RAA05307@alpha.hut.fi>
+ Subject: Math::Trig::Radial ?
+ Branch: perl
+ + lib/Math/Trig/Radial.pm
+ ! MANIFEST
+____________________________________________________________________________
+[ 1250] By: gsar on 1998/06/28 21:09:48
+ Log: applied patch, tweaked doc, and regen regnodes.h
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806270655.CAA29144@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_68] \z in RE
+ Date: Sat, 27 Jun 1998 02:55:26 -0400 (EDT)
+ Branch: perl
+ ! pod/perlre.pod regcomp.c regcomp.sym regexec.c regnodes.h
+ ! t/op/re_tests t/op/regexp.t toke.c
+____________________________________________________________________________
+[ 1249] By: gsar on 1998/06/28 20:56:38
+ Log: From: mike@bill.iac.net
+ Message-ID: <19980627034913.A32220@bill.minivend.com>
+ Date: Sat, 27 Jun 1998 03:49:13 +0000
+ Subject: [ PATCH 5.004 68 ] Text::ParseWords, ^W fixed, version 3.1
+ Branch: perl
+ ! lib/Text/ParseWords.pm t/lib/parsewords.t
+____________________________________________________________________________
+[ 1248] By: gsar on 1998/06/28 20:54:43
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806270352.XAA21174@monk.mps.ohio-state.edu>
+ Subject: [PATCH] Fix ptags
+ Date: Fri, 26 Jun 1998 23:52:54 -0400 (EDT)
+ Branch: perl
+ ! emacs/ptags
+____________________________________________________________________________
+[ 1247] By: gsar on 1998/06/28 20:42:54
+ Log: apply patch sent via private mail
+ From: Stephen McCamant <alias@mcs.com>
+ Message-Id: <m0ypkmt-000EalC@alias-2.pr.mcs.net>
+ Date: Fri, 26 Jun 1998 21:32:23 -0500 (CDT)
+ Subject: Re: Enhanced B::Deparse
+ Branch: perl
+ ! ext/B/B/Deparse.pm
+____________________________________________________________________________
+[ 1246] By: gsar on 1998/06/28 20:38:24
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806270109.VAA14907@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_68] pat.t tests
+ Date: Fri, 26 Jun 1998 21:09:02 -0400 (EDT)
+ Branch: perl
+ ! t/op/pat.t
+____________________________________________________________________________
+[ 1245] By: gsar on 1998/06/28 20:36:08
+ Log: From: joshua.pritikin@db.com
+ Date: Fri, 26 Jun 1998 10:02:32 -0400
+ Message-Id: <H00000e500081d28@MHS>
+ Subject: [PATCH _68] improve recursive error messages!
+ Branch: perl
+ ! gv.c pod/perldiag.pod universal.c
+____________________________________________________________________________
+[ 1244] By: gsar on 1998/06/28 20:09:02
+ Log: From: Dominic Dunlop <domo@vo.lu>
+ Message-Id: <v03110701b1b83a06733a@[195.95.102.101]>
+ Date: Thu, 25 Jun 1998 17:46:55 +0000
+ Subject: [PATCH 5.004_68]: Move REG_INFTY-dependent tests from op/regexp.t
+ to op/pat.t; add tests for a few more regexp parse failures etc.
+ Branch: perl
+ ! t/op/pat.t t/op/re_tests t/op/regexp.t
+____________________________________________________________________________
+[ 1243] By: gsar on 1998/06/28 20:06:30
+ Log: specify *.sym files needed in perl_exp.SH instead of picking up all
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Thu, 25 Jun 1998 10:36:21 -0400 (EDT)
+ Subject: Re: Not OK: perl 5.00468 on aix-thread 4.1.4.0
+ Message-Id: <Pine.SUN.3.96.980625102459.11241F-100000@newton.phys>
+ Branch: perl
+ ! perl_exp.SH
+____________________________________________________________________________
+[ 1242] By: gsar on 1998/06/28 20:01:28
+ Log:
+ From: Gisle Aas <gisle@aas.no>
+ Subject: Re: [PATCH] 4-arg substr update for perl5.004_68
+ Date: 25 Jun 1998 10:32:43 +0200
+ Message-ID: <m3iulpubis.fsf@furu.g.aas.no>
+ Branch: perl
+ ! op.c pod/perlfunc.pod pp.c t/op/substr.t
+____________________________________________________________________________
+[ 1241] By: gsar on 1998/06/28 19:55:11
+ Log: applied patch, tweaked opcode.pl for PERL_OBJECT, and regen opcode.h
+ From: Stephen McCamant <alias@mcs.com>
+ Message-Id: <m0yp1Ue-000EP2C@alias-2.pr.mcs.net>
+ Date: Wed, 24 Jun 1998 21:10:32 -0500 (CDT)
+ Subject: [PATCH REPOST] refgen in opcode.pl
+ Branch: perl
+ ! opcode.h opcode.pl
+____________________________________________________________________________
+[ 1240] By: gsar on 1998/06/28 19:46:29
+ Log: From: Chris Nandor <pudge@pobox.com>
+ Message-Id: <v04011709b1b742cd7f0c@[24.48.29.192]>
+ Date: Wed, 24 Jun 1998 19:58:28 -0400
+ Subject: [PATCH 3d try] Add CR LF CRLF to Socket.pm
+ Branch: perl
+ ! ext/Socket/Socket.pm
+____________________________________________________________________________
+[ 1239] By: gsar on 1998/06/28 19:44:19
+ Log: From: Gisle Aas <gisle@aas.no>
+ Subject: [PATCH] Optimize foreach (1..1000000)
+ Date: 24 Jun 1998 20:26:48 +0200
+ Message-ID: <m3lnqmwt93.fsf@furu.g.aas.no>
+ Branch: perl
+ ! Todo cop.h op.c pod/perldiag.pod pod/perlop.pod pp_ctl.c
+ ! pp_hot.c t/op/range.t
+____________________________________________________________________________
+[ 1238] By: gsar on 1998/06/28 19:28:13
+ Log: avoid creation of %^R
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806241825.OAA06346@monk.mps.ohio-state.edu>
+ Subject: Re: [5.004_68] What is %^R ? [PATCH?]
+ Date: Wed, 24 Jun 1998 14:25:06 -0400 (EDT)
+ Branch: perl
+ ! perl.c t/op/splice.t
+____________________________________________________________________________
+[ 1237] By: gsar on 1998/06/28 19:23:40
+ Log: From: Gisle Aas <gisle@aas.no>
+ Subject: [PATCH] Negative LENGTH argument to splice
+ Date: 24 Jun 1998 15:11:35 +0200
+ Message-ID: <m3g1gvc5bs.fsf@furu.g.aas.no>
+ Branch: perl
+ + t/op/splice.t
+ ! MANIFEST pod/perlfunc.pod pp.c
+____________________________________________________________________________
+[ 1236] By: gsar on 1998/06/28 19:18:29
+ Log: From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Subject: [PATCH] Insecure $ENV{} message out of step with perldiag
+ Message-Id: <E0yooQA-0003za-00@taurus.cus.cam.ac.uk>
+ Date: Wed, 24 Jun 1998 13:13:02 +0100
+ Branch: perl
+ ! pod/perldiag.pod pod/perlsec.pod
+____________________________________________________________________________
+[ 1235] By: gsar on 1998/06/28 19:16:13
+ Log: Complex.pm update
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Wed, 24 Jun 1998 15:19:05 +0300 (EET DST)
+ Message-Id: <199806241219.PAA04061@alpha.hut.fi>
+ Subject: [PATCH] 5.004_68: Complex.pm, complex.t
+ Branch: perl
+ ! lib/Math/Complex.pm t/lib/complex.t
+____________________________________________________________________________
+[ 1234] By: gsar on 1998/06/28 19:13:05
+ Log: disable perl malloc on UNICOS for now
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Wed, 24 Jun 1998 12:37:14 +0300 (EET DST)
+ Message-Id: <199806240937.MAA01669@alpha.hut.fi>
+ Subject: [PATCH] 5.004_68: UNICOS hints
+ Branch: perl
+ ! hints/unicos.sh
+____________________________________________________________________________
+[ 1233] By: gsar on 1998/06/28 19:10:53
+ Log: fixes unpack("q"...), and semctl() tests for UNICOS
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Wed, 24 Jun 1998 11:55:09 +0300 (EET DST)
+ Message-Id: <199806240855.LAA16152@alpha.hut.fi>
+ Subject: [PATCH] 5.004_68: semctl() in UNICOS (was: pack/unpack)
+ Branch: perl
+ ! pp.c t/op/ipcsem.t t/op/pack.t
+____________________________________________________________________________
+[ 1232] By: gsar on 1998/06/28 19:01:23
+ Log: tweak various places for iperlsys.h awareness
+ Branch: perl
+ ! MANIFEST Makefile.SH lib/ExtUtils/MM_Unix.pm
+ ! lib/ExtUtils/MM_VMS.pm pod/perlapio.pod
+____________________________________________________________________________
+[ 1231] By: gsar on 1998/06/28 18:37:07
+ Log: add a perlio.h stub for compat (some extensions seem to #include it)
+ Branch: perl
+ + perlio.h
+____________________________________________________________________________
+[ 1230] By: gsar on 1998/06/28 18:35:23
+ Log: Message-ID: <19980624003701.C161@cdata.tvnet.hu>
+ Date: Wed, 24 Jun 1998 00:37:01 +0200
+ From: Laszlo Molnar <molnarl@cdata.tvnet.hu>
+ Subject: Re: [PATCH for _66] Makefile.SH problem on dos/djgpp
+ Branch: perl
+ ! pod/pod2text.PL
+____________________________________________________________________________
+[ 1229] By: gsar on 1998/06/28 18:33:42
+ Log: hand apply mutiliated patch
+ Message-Id: <3.0.5.32.19980623114100.00ab76e0@ous.edu>
+ Date: Tue, 23 Jun 1998 11:41:00 -0700
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Subject: [PATCH 5.004_68]Configure update for VMS
+ Branch: perl
+ ! configure.com vms/descrip_mms.template vms/subconfigure.com
+____________________________________________________________________________
+[ 1228] By: gsar on 1998/06/28 17:17:35
+ Log: hand apply whitespace mutiliated patch
+ Date: Tue, 23 Jun 98 16:38:06 BST
+ Message-Id: <5389.9806231538@tempest.cise.npl.co.uk>
+ From: Robin Barker <rmb1@cise.npl.co.uk>
+ Subject: PATCH [perl5.004_68] perlbug.PL; was Re: Error message for Errno_pm.PL
+ Branch: perl
+ ! utils/perlbug.PL
+____________________________________________________________________________
+[ 1227] By: gsar on 1998/06/28 17:14:34
+ Log: Date: Tue, 23 Jun 1998 08:51:00 -0700 (PDT)
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Subject: [PATCH] documenting close without arguments
+ Message-ID: <Pine.GSO.3.96.980623084413.24075V-100000@user2.teleport.com>
+ Branch: perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 1226] By: gsar on 1998/06/28 17:12:56
+ Log: Date: Tue, 23 Jun 1998 05:37:09 -0700 (PDT)
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Subject: Better diags for vars.pm
+ Message-ID: <Pine.GSO.3.96.980623052846.24075A-100000@user2.teleport.com>
+ Branch: perl
+ ! lib/vars.pm
+____________________________________________________________________________
+[ 1225] By: gsar on 1998/06/28 17:05:59
+ Log: hand apply whitespace mutiliated perldoc.PL patches
+ Date: Tue, 23 Jun 98 15:49:52 BST
+ Message-Id: <5302.9806231449@tempest.cise.npl.co.uk>
+ From: Robin Barker <rmb1@cise.npl.co.uk>
+ Subject: PATCH [5.004_68] perldoc.PL
+ --
+ Date: Fri, 26 Jun 98 17:50:05 BST
+ Message-Id: <6834.9806261650@tempest.cise.npl.co.uk>
+ From: Robin Barker <rmb1@cise.npl.co.uk>
+ Subject: [PATCH 5.004_68] perldoc.PL
+ Branch: perl
+ ! utils/perldoc.PL
+____________________________________________________________________________
+[ 1224] By: gsar on 1998/06/28 16:50:59
+ Log: integrate ansiperl to get makedef.pl tweak
+ Branch: perl
+ ! Porting/pumpkin.pod win32/makedef.pl
+____________________________________________________________________________
+[ 1223] By: gsar on 1998/06/28 16:33:32
+ Log: add CGI-2.42, its and testsuite
+ Branch: perl
+ + eg/cgi/caution.xbm eg/cgi/dna.small.gif.uu
+ + eg/cgi/nph-multipart.cgi lib/CGI/Cookie.pm t/lib/cgi-form.t
+ + t/lib/cgi-function.t t/lib/cgi-html.t t/lib/cgi-request.t
+ ! MANIFEST eg/cgi/RunMeFirst eg/cgi/file_upload.cgi
+ ! eg/cgi/index.html eg/cgi/monty.cgi eg/cgi/save_state.cgi
+ ! eg/cgi/wilogo.gif.uu lib/CGI.pm lib/CGI/Apache.pm
+ ! lib/CGI/Carp.pm lib/CGI/Fast.pm lib/CGI/Push.pm
+ ! lib/CGI/Switch.pm
+____________________________________________________________________________
+[ 1222] By: gsar on 1998/06/28 15:28:29
+ Log: enable Errno build on win32, add Errno-1.08 files to repository
+ Branch: perl
+ + ext/Errno/ChangeLog ext/Errno/Errno_pm.PL
+ + ext/Errno/Makefile.PL t/lib/errno.t
+ ! MANIFEST win32/Makefile win32/config.bc win32/config.gc
+ ! win32/config.vc win32/makefile.mk
+____________________________________________________________________________
+[ 1221] By: gsar on 1998/06/28 14:34:06
+ Log: tweak win32 config templates for cpp
+ Branch: perl
+ ! win32/config.bc win32/config.gc win32/config.vc
+____________________________________________________________________________
+[ 1220] By: nick on 1998/06/26 16:46:13
+ Log: Integrate mainline
+ Branch: ansiperl
+ !> Changes Makefile.SH ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod
+ !> ext/POSIX/POSIX.xs perl.c pod/perlre.pod pod/perlvar.pod sv.c
+ !> util.c win32/win32.h
+____________________________________________________________________________
+[ 1219] By: gsar on 1998/06/26 04:33:57
+ Log: make find_script() return saved string, reenable missing diagnostics
+ Branch: perl
+ ! perl.c util.c
+____________________________________________________________________________
+[ 1218] By: gsar on 1998/06/25 23:24:53
+ Log: avoid warning with -P switch
+ Branch: perl
+ ! perl.c
+____________________________________________________________________________
+[ 1217] By: gsar on 1998/06/25 22:06:58
+ Log: don't suppress display of Makefile recipes that invoke perl
+ Branch: perl
+ ! Makefile.SH
+____________________________________________________________________________
+[ 1216] By: gsar on 1998/06/25 21:32:06
+ Log: tweak order of destruction so OBJECTs in GLOBs are visited after those
+ in RVs
+ Branch: perl
+ ! sv.c
+____________________________________________________________________________
+[ 1215] By: gsar on 1998/06/25 18:56:59
+ Log: mknod() is not POSIX, so remove the POSIX pieces from change#1199
+ Branch: perl
+ ! ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod ext/POSIX/POSIX.xs
+____________________________________________________________________________
+[ 1214] By: gsar on 1998/06/25 18:11:22
+ Log: add FILE_SHARE_DELETE ifndef in win32.h
+ Branch: perl
+ ! win32/win32.h
+____________________________________________________________________________
+[ 1213] By: nick on 1998/06/24 17:18:59
+ Log: Correct perl malloc tweak to .def generation
+ Branch: ansiperl
+ ! win32/makedef.pl
+____________________________________________________________________________
+[ 1212] By: gsar on 1998/06/24 12:40:13
+ Log: check in what change#1182 didn't, and Changes
+ Branch: perl
+ ! Changes pod/perlre.pod pod/perlvar.pod
+____________________________________________________________________________
+[ 1211] By: TimBunce on 1998/06/23 23:09:37
+ Log: Update test count in t/lib/basename.t (see change 1210)
+ Branch: maint-5.004/perl
+ ! t/lib/basename.t
+____________________________________________________________________________
+[ 1210] By: TimBunce on 1998/06/23 22:58:18
+ Log: Title: "Add C<use re 'taint'> pragma to propagate tainting in m// and s///"
+ From: Chip Salzenberg <chip@perl.org>, Gurusamy Sarathy
+ <gsar@engin.umich.edu>, Tim.Bunce@ig.co.uk (Tim Bunce)
+ Msg-ID: <19980525155222.A18445@perlsupport.com>,
+ <199805261143.MAA04260@toad.ig.co.uk>,
+ <199805261235.IAA10371@aatma.engin.umich.edu>,
+ Files: MANIFEST pod/perlmodlib.pod pod/perlop.pod op.h perl.h dump.c
+ installperl lib/re.pm lib/File/Basename.pm mg.c op.c
+ pp_ctl.c pp_hot.c t/lib/basename.t t/op/taint.t toke.c
+ Branch: maint-5.004/perl
+ ! MANIFEST dump.c embed.h installperl lib/File/Basename.pm mg.c
+ ! op.c op.h perl.h pod/perlmodlib.pod pod/perlop.pod pp_ctl.c
+ ! pp_hot.c t/lib/basename.t t/op/taint.t toke.c
+____________________________________________________________________________
+[ 1209] By: nick on 1998/06/23 21:33:34
+ Log: Perl_malloced_size() only available with perl's malloc
+ Branch: ansiperl
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 1208] By: nick on 1998/06/23 18:15:23
+ Log: Integrate mainline c. 5.004_68 into ansiperl, mainly
+ so see what has changed...
+ Branch: ansiperl
+ +> Porting/genlog iperlsys.h lib/File/Spec.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 regcomp.pl regcomp.sym regnodes.h
+ +> t/lib/filespec.t win32/perlhost.h
+ - atomic.h ipdir.h ipenv.h iplio.h ipmem.h ipproc.h ipsock.h
+ - ipstdio.h perldir.h perlenv.h perlio.h perllio.h perlmem.h
+ - perlproc.h perlsock.h
+ !> (integrate 96 files)
----------------
-Version 5.003_26
+Version 5.004_68
----------------
-This release is beta candidate #4. "Once more, dear friends...."
-
- CORE LANGUAGE CHANGES
-
- Title: "Make \r in script an error (per Larry)"
- From: Chip Salzenberg
- Files: pod/perldiag.pod toke.c
-
- Title: "Support '%i' format and 'h' modifier in s?printf"
- From: Chip Salzenberg
- Files: doop.c pod/perldelta.pod
-
- CORE PORTABILITY
-
- Title: "Fix value of system() and $? for DEC UNIX, VMS, others"
- From: Chip Salzenberg
- Files: mg.c perl.h pp_sys.c
-
- Title: "VMS patches post _25"
- From: Charles Bailey
- Msg-ID: <01IF48W3P39W0050BD@hmivax.humgen.upenn.edu>
- Date: Fri, 07 Feb 1997 01:56:12 -0500 (EST)
- Files: Porting/Glossary lib/ExtUtils/Liblist.pm
- lib/ExtUtils/MM_VMS.pm lib/ExtUtils/xsubpp perl.c
- vms/Makefile vms/config.vms vms/descrip.mms vms/genconfig.pl
- vms/perlvms.pod vms/vms.c vms/vmsish.h x2p/a2p.c
-
- Title: "Hints for BSDOS"
- From: Christopher Davis <ckd@loiosh.kei.com>
- Msg-ID: <199702042011.PAA09206@loiosh.kei.com>
- Date: Tue, 4 Feb 1997 15:11:13 -0500 (EST)
- Files: hints/bsdos.sh
-
- Title: "On C<sysopen(..., O_APPEND)>, call C<fopen(..., "a")>"
- From: Chip Salzenberg
- Files: doio.c
-
- OTHER CORE CHANGES
-
- Title: "Fix (yet another) Tk closure problem"
- From: Chip Salzenberg
- Files: op.c perl.c pp_ctl.c
-
- Title: "Fix value of C<foreach>"
- From: Chip Salzenberg
- Files: cop.h pp_ctl.c
-
- Title: "Regexp optimizations"
- From: Ilya Zakharevich
- Msg-ID: <199702041102.GAA24805@monk.mps.ohio-state.edu>
- Date: Tue, 4 Feb 1997 06:02:10 -0500 (EST)
- Files: regcomp.c regexec.c
-
- Title: "Re: static buffer in not_a_number() [sv.c] might overflow"
- From: Gisle Aas
- Msg-ID: <hbu9uz1si.fsf@bergen.sn.no>
- Date: 09 Feb 1997 11:55:41 +0100
- Files: sv.c
-
- Title: "Refine 'runaway string' heuristic"
- From: Chip Salzenberg
- Files: toke.c
-
- Title: "Fix core dump on C<print "a", last> in eval"
- From: Chip Salzenberg
- Files: pp_ctl.c
-
- Title: "Catch C<use integer; $x % 0>"
- From: Chip Salzenberg
- Files: pp.c
-
- BUILD PROCESS
-
- Title: "Fix usage message in configure.gnu"
- From: Jarkko Hietaniemi
- Files: configure.gnu
-
- LIBRARY AND EXTENSIONS
-
- Title: "DB_File 1.11 patch"
- From: Paul Marquess
- Msg-ID: <9702061553.AA18147@claudius.bfsec.bt.co.uk>
- Date: Thu, 6 Feb 97 15:53:34 GMT
- Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs
-
- Title: "Faster File::Compare"
- From: Gisle Aas
- Msg-ID: <199702051342.OAA02753@bergen.sn.no>
- Date: Wed, 5 Feb 1997 14:42:49 +0100
- Files: lib/File/Compare.pm
-
- Title: "Make diagnostics module strip formatting directives"
- From: Chip Salzenberg
- Files: lib/diagnostics.pm pod/perldiag.pod
-
- Title: "Fix warning from missing POSIX::setvbuf()"
- From: Chip Salzenberg
- Files: ext/IO/IO.xs
-
- TESTS
-
- Title: "Fix closure.t for AmigaOS (again)"
- From: Norbert Pueschel
- Msg-ID: <77724742@Armageddon.meb.uni-bonn.de>
- Date: Wed, 05 Feb 1997 18:56:45 +0100
- Files: t/op/closure.t
-
- UTILITIES
-
- Title: "perldoc -f <perlfunc>"
- From: Gisle Aas
- Msg-ID: <199702051127.MAA02090@bergen.sn.no>
- Date: Wed, 5 Feb 1997 12:27:36 +0100
- Files: utils/perldoc.PL
-
- Title: "Fix pod2man's handling of quotes in =items"
- From: Jarkko Hietaniemi
- Msg-ID: <199702042023.WAA13143@alpha.hut.fi>
- Date: Tue, 4 Feb 1997 22:23:34 +0200 (EET)
- Files: pod/pod2man.PL
-
- DOCUMENTATION
-
- Title: "return *FH pod patch"
- From: allen@gateway.grumman.com (John L. Allen)
- Msg-ID: <9702061507.AA04474@gateway.grumman.com>
- Date: Thu, 6 Feb 1997 10:07:28 -0500
- Files: pod/perldata.pod pod/perlsub.pod
-
- Title: "Describe interation of untie and DESTROY"
- From: Paul Marquess and Chip Salzenberg
- Files: pod/perltie.pod
-
+____________________________________________________________________________
+[ 1207] By: gsar on 1998/06/23 10:55:05
+ Log: final touches to 5.004_68
+ Branch: perl
+ ! perl.c
+____________________________________________________________________________
+[ 1206] By: gsar on 1998/06/23 10:50:10
+ Log: more MULTIPLICITY tweaks
+ Branch: perl
+ ! objpp.h perl.c perl.h proto.h win32/GenCAPI.pl win32/config.bc
+ ! win32/config.gc win32/config.vc win32/config_H.bc
+ ! win32/config_H.gc win32/config_H.vc
+____________________________________________________________________________
+[ 1205] By: gsar on 1998/06/23 09:03:46
+ Log: partial MULTIPLICITY cleanup
+ Branch: perl
+ ! embedvar.h interp.sym intrpvar.h perl.c perlvars.h proto.h
+ ! thrdvar.h
+____________________________________________________________________________
+[ 1204] By: gsar on 1998/06/23 09:00:48
+ Log: tweak MANIFEST, add Dev_t to POSIX/typemap
+ Branch: perl
+ ! MANIFEST Porting/makerel README.win32 ext/POSIX/typemap
+____________________________________________________________________________
+[ 1203] By: gsar on 1998/06/23 07:08:02
+ Log: bump patchlevel to 68, Porting/makerel tweaks
+ Branch: perl
+ ! Porting/makerel patchlevel.h win32/Makefile win32/config_H.bc
+ ! win32/config_H.gc win32/config_H.vc win32/makefile.mk
+____________________________________________________________________________
+[ 1202] By: gsar on 1998/06/23 06:16:19
+ Log: remove atomic.h pending resolution of licensing issues,
+ EMULATE_ATOMIC_REFCOUNTS everywhere
+ Branch: perl
+ - atomic.h
+ ! MANIFEST perl.h sv.h
+____________________________________________________________________________
+[ 1201] By: gsar on 1998/06/23 06:06:23
+ Log: applied patch, regen headers
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806220819.EAA03295@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_67] Malloc size feedback
+ Date: Mon, 22 Jun 1998 04:19:45 -0400 (EDT)
+ Branch: perl
+ ! ObjXSub.h av.c embed.h global.sym hv.c malloc.c objpp.h perl.c
+ ! pp_sys.c proto.h sv.c toke.c
+____________________________________________________________________________
+[ 1200] By: gsar on 1998/06/23 05:59:09
+ Log: Message-Id: <m0yoIgR-000EP2C@alias-2.pr.mcs.net>
+ Date: Mon, 22 Jun 1998 21:19:43 -0500 (CDT)
+ From: Stephen McCamant <alias@mcs.com>
+ Subject: [PATCH] Inheritance of B:: classes
+ Branch: perl
+ ! ext/B/B.pm
+____________________________________________________________________________
+[ 1199] By: gsar on 1998/06/23 05:57:58
+ Log: applied patch, moved #define mkfifo ... from perl.h to POSIX.xs
+ Date: Tue, 23 Jun 1998 00:01:02 +0300 (EET DST)
+ Message-Id: <199806222101.AAA16456@alpha.hut.fi>
+ Subject: [PATCH] _67: somebody said POSIX::mknod?
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Branch: perl
+ ! Configure config_h.SH ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod
+ ! ext/POSIX/POSIX.xs perl.h
+____________________________________________________________________________
+[ 1198] By: gsar on 1998/06/23 05:48:56
+ Log: Date: Mon, 22 Jun 1998 14:10:46 -0600 (MDT)
+ From: Daniel Grisinger <dgris@perrin.dimensional.com>
+ Subject: PATCH [5.004_67] perldoc.PL
+ Message-ID: <Pine.LNX.3.96.980622135953.10412A-100000@perrin.dimensional.com>
+ Branch: perl
+ ! utils/perldoc.PL
+____________________________________________________________________________
+[ 1197] By: gsar on 1998/06/23 05:47:24
+ Log: Message-Id: <3.0.5.32.19980622092918.00aa46e0@ous.edu>
+ Date: Mon, 22 Jun 1998 09:29:18 -0700
+ From: Dan Sugalski <sugalskd@ous.edu>
+ Subject: [PATCH 5.004_67] Autosplit's not qite case-insensitive enough on VMS
+ Branch: perl
+ ! lib/AutoSplit.pm
+____________________________________________________________________________
+[ 1196] By: gsar on 1998/06/23 05:45:19
+ Log: Date: Mon, 22 Jun 1998 18:58:55 +0300 (EET DST)
+ Message-Id: <199806221558.SAA18626@alpha.hut.fi>
+ Subject: [PATCH] 5.004_67: Fcntl: add few constants, enhance maintainability
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Branch: perl
+ ! ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs
+____________________________________________________________________________
+[ 1195] By: gsar on 1998/06/23 05:43:32
+ Log: Message-Id: <v03110700b1b41e1760b2@[195.95.102.55]>
+ Date: Mon, 22 Jun 1998 15:22:24 +0000
+ From: Dominic Dunlop <domo@vo.lu>
+ Subject: [PATCH 5.004_67] Amend tests/regexp.t for variable REG_INFTY;
+ update machten.sh to vary REG_INFTY
+ Branch: perl
+ ! hints/machten.sh t/op/re_tests t/op/regexp.t
+____________________________________________________________________________
+[ 1194] By: gsar on 1998/06/23 05:38:36
+ Log: filter out array subscripts when generating symbols for AIX
+ Date: Mon, 22 Jun 1998 12:14:31 +0300 (EET DST)
+ Message-Id: <199806220914.MAA13631@alpha.hut.fi>
+ Subject: [PATCH] 5.004_67: perl.exp bug, AIX unhappy
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Branch: perl
+ ! perl_exp.SH
+____________________________________________________________________________
+[ 1193] By: gsar on 1998/06/23 05:32:52
+ Log: updated hints file to cope with buggy sigsetjmp() on Solaris-x86
+ Message-Id: <199806221102.NAA12106@alanya.m.isar.de>
+ Date: Mon, 22 Jun 1998 13:02:45 +0200 (MET DST)
+ From: Lupe Christoph <lupe@alanya.m.isar.de>
+ Subject: Re: Perl 5.004_67: Death is on vacation - miniperl can't die
+ Branch: perl
+ ! hints/solaris_2.sh
+____________________________________________________________________________
+[ 1192] By: gsar on 1998/06/23 05:27:13
+ Log: add detailed changelogs and 'genlog'--the script which generates them
+ Branch: perl
+ + Porting/genlog
+ ! Changes INSTALL
+____________________________________________________________________________
+[ 1191] By: gsar on 1998/06/22 15:56:27
+ Log: tweak win32 makefiles for PERL_OBJECT build
+ Branch: perl
+ ! win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 1190] By: gsar on 1998/06/22 04:06:02
+ Log: backout change#1178 as it was dependent on an unapplied patch,
+ fix filespec.t to know its @INC
+ Branch: perl
+ ! sv.c t/lib/filespec.t
+____________________________________________________________________________
+[ 1189] By: gsar on 1998/06/22 03:47:43
+ Log: eliminate use of tokenbuf in util.c
+ Branch: perl
+ ! util.c
+____________________________________________________________________________
+[ 1188] By: gsar on 1998/06/22 01:53:59
+ Log: add patch that generates regnodes.h via regcomp.pl
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806212038.QAA29797@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_67] regcomp.h regnodes cleanup
+ Date: Sun, 21 Jun 1998 16:38:21 -0400 (EDT)
+ Branch: perl
+ + regcomp.pl regcomp.sym regnodes.h
+ ! MANIFEST Makefile.SH regcomp.h
+____________________________________________________________________________
+[ 1187] By: gsar on 1998/06/22 01:42:21
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806210145.VAA21629@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_67] Avoid temporaries on recursion
+ Date: Sat, 20 Jun 1998 21:45:03 -0400 (EDT)
+ Branch: perl
+ ! pp_ctl.c pp_hot.c
+____________________________________________________________________________
+[ 1186] By: gsar on 1998/06/22 01:14:14
+ Log: merge relevant portions from maintbranch change#1155
+ Branch: perl
+ ! lib/Math/BigFloat.pm op.c pod/perlfunc.pod pod/perlop.pod
+ ! pod/perlrun.pod pp_hot.c
+____________________________________________________________________________
+[ 1185] By: gsar on 1998/06/22 00:59:28
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806210827.EAA26322@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_67] Zero-length matching bug
+ Date: Sun, 21 Jun 1998 04:27:16 -0400 (EDT)
+ Branch: perl
+ ! regexec.c t/op/pat.t
+____________________________________________________________________________
+[ 1184] By: gsar on 1998/06/22 00:57:27
+ Log: fix alignment issues in malloc.c on 64-bit platforms (via private mail)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806170844.EAA24584@monk.mps.ohio-state.edu>
+ Subject: Re: _67 not okay
+ Date: Wed, 17 Jun 1998 04:44:26 -0400 (EDT)
+ Branch: perl
+ ! malloc.c
+____________________________________________________________________________
+[ 1183] By: gsar on 1998/06/22 00:53:37
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806210727.DAA24072@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_67] Test study/re/
+ Date: Sun, 21 Jun 1998 03:27:13 -0400 (EDT)
+ Branch: perl
+ ! t/op/pat.t
+____________________________________________________________________________
+[ 1182] By: gsar on 1998/06/21 21:25:07
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806210430.AAA21818@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_67] $^R documented
+ Date: Sun, 21 Jun 1998 00:30:48 -0400 (EDT)
+ Branch: perl
+ ! pod/perlre.pod pod/perlvar.pod
+____________________________________________________________________________
+[ 1181] By: gsar on 1998/06/21 21:23:41
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806210111.VAA17752@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_67] Re docs
+ Date: Sat, 20 Jun 1998 21:11:37 -0400 (EDT)
+ Branch: perl
+ ! pod/perlop.pod pod/perlre.pod
+____________________________________________________________________________
+[ 1180] By: gsar on 1998/06/21 21:22:16
+ Log: adapted contents of message into comments in malloc.c and INSTALL
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806162240.SAA23597@monk.mps.ohio-state.edu>
+ Subject: [5.004_67] malloc.c -Defines
+ Date: Tue, 16 Jun 1998 18:40:41 -0400 (EDT)
+ Branch: perl
+ ! INSTALL malloc.c
+____________________________________________________________________________
+[ 1179] By: gsar on 1998/06/21 07:26:35
+ Log: applied patch, with edits to the prose
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806201936.PAA17499@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_67] Error variables compared
+ Date: Sat, 20 Jun 1998 15:36:14 -0400 (EDT)
+ Branch: perl
+ ! pod/perlvar.pod
+____________________________________________________________________________
+[ 1178] By: gsar on 1998/06/21 07:07:16
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806200104.VAA11343@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_67] print study /re/ broken
+ Date: Fri, 19 Jun 1998 21:04:54 -0400 (EDT)
+ Branch: perl
+ ! sv.c
+____________________________________________________________________________
+[ 1177] By: gsar on 1998/06/21 07:06:10
+ Log: applied patch, tweaked wording
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806200838.EAA13992@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_67] Documentation patch for malloc
+ Date: Sat, 20 Jun 1998 04:38:07 -0400 (EDT)
+ Branch: perl
+ ! malloc.c pod/perldiag.pod
+____________________________________________________________________________
+[ 1176] By: gsar on 1998/06/21 07:00:30
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806200829.EAA13974@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_67] Cosmetic malloc patch
+ Date: Sat, 20 Jun 1998 04:29:00 -0400 (EDT)
+ Branch: perl
+ ! malloc.c
+____________________________________________________________________________
+[ 1175] By: gsar on 1998/06/21 06:58:37
+ Log: Message-Id: <3.0.5.32.19980619160057.032e7480@ous.edu>
+ Date: Fri, 19 Jun 1998 16:00:57 -0700
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Subject: [PATCH 5.004_67] fixup patches for VMS
+ Branch: perl
+ ! ext/SDBM_File/sdbm/Makefile.PL t/lib/filecopy.t t/op/defins.t
+ ! t/op/taint.t vms/test.com vms/vms.c
+____________________________________________________________________________
+[ 1174] By: gsar on 1998/06/21 06:55:18
+ Log: applied VMS patch from Dan Sugalski
+ Date: Fri, 19 Jun 1998 15:36:34 -0700
+ From: SYSTEM@cedar.osshe.edu
+ Message-Id: <980619153634.2063ee12@cedar.osshe.edu>
+ Subject: [PATCH 5.004_67] Enhancements to the VMS configuration procedures
+ Branch: perl
+ ! configure.com lib/ExtUtils/MM_VMS.pm perl.h
+ ! vms/descrip_mms.template vms/gen_shrfls.pl
+ ! vms/subconfigure.com
+____________________________________________________________________________
+[ 1173] By: gsar on 1998/06/21 06:51:38
+ Log: applied patch, modified logic to avoid reentering lexer at compile-time
+ Message-ID: <19980619113104.S9711@asic.sc.ti.com>
+ Date: Fri, 19 Jun 1998 11:31:04 -0500
+ From: Graham Barr <gbarr@ti.com>
+ Subject: Re: [PATCH perl5.004_67] Add Errno in ext/
+ Branch: perl
+ ! Configure MANIFEST Makefile.SH ext/util/make_ext gv.c
+ ! lib/English.pm
+____________________________________________________________________________
+[ 1172] By: gsar on 1998/06/21 06:27:57
+ Log: applied patch, along with many changes:
+ - ipfoo.h headers have been coalesced along with perlfoo.h into
+ iperlsys.h
+ - win32/cp*.h have been combined in perlhost.h
+ - CPerlObj::PerlParse() takes an extra xsinit arg
+ - tweaks to get dl_win32.xs compiling again w/ PERL_OBJECT
+ From: "Douglas Lankshear" <dougl@ActiveState.com>
+ Message-Id: <000001bd9b8c$0417fe90$a32fa8c0@tau.Active>
+ Subject: RE: [PATCH 5.004_67] Fixes for broken MS compiler
+ Date: Fri, 19 Jun 1998 10:59:50 -0700
+ Branch: perl
+ + iperlsys.h win32/perlhost.h
+ - ipdir.h ipenv.h iplio.h ipmem.h ipproc.h ipsock.h ipstdio.h
+ - perldir.h perlenv.h perlio.h perllio.h perlmem.h perlproc.h
+ - perlsock.h
+ ! MANIFEST mg.h op.h perl.h perlio.c proto.h util.c
+ ! win32/Makefile win32/dl_win32.xs win32/makefile.mk
+ ! win32/runperl.c win32/win32.h
+____________________________________________________________________________
+[ 1171] By: gsar on 1998/06/21 00:44:42
+ Log: Date: Fri, 19 Jun 1998 07:55:19 -0600 (MDT)
+ From: Daniel Grisinger <dgris@perrin.dimensional.com>
+ Subject: Re: PATCH _67 (Doc) perlop.pod
+ Message-ID: <Pine.LNX.3.96.980619075203.13326A-100000@perrin.dimensional.com>
+ Branch: perl
+ ! pod/perlop.pod
+____________________________________________________________________________
+[ 1170] By: gsar on 1998/06/21 00:43:06
+ Log: a tweaked version of:
+ From: "Douglas Lankshear" <dougl@ActiveState.com>
+ Subject: [PATCH 5.004_67] Win32 using PerlCRT.dll
+ Date: Wed, 17 Jun 1998 20:25:51 -0700
+ Message-ID: <001b01bd9a68$cb752410$a32fa8c0@tau.Active>
+ Branch: perl
+ ! lib/ExtUtils/MM_Win32.pm win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 1169] By: gsar on 1998/06/21 00:10:18
+ Log: added patch, regen headers
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806190227.WAA07371@monk.mps.ohio-state.edu>
+ Subject: Re: Ilya's patches
+ Date: Thu, 18 Jun 1998 22:27:31 -0400 (EDT)
+ Branch: perl
+ ! ObjXSub.h embedvar.h interp.sym intrpvar.h toke.c
+____________________________________________________________________________
+[ 1168] By: gsar on 1998/06/21 00:05:01
+ Log: Date: Thu, 18 Jun 1998 23:37:32 -0700 (PDT)
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Subject: [PATCH] docs creating files via open
+ Message-ID: <Pine.GSO.3.96.980618231856.17544S-100000@user2.teleport.com>
+ Branch: perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 1167] By: gsar on 1998/06/21 00:03:34
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806172151.RAA28441@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_67] Better version of malloc improver
+ Date: Wed, 17 Jun 1998 17:51:54 -0400 (EDT)
+ Branch: perl
+ ! malloc.c
+____________________________________________________________________________
+[ 1166] By: gsar on 1998/06/20 23:59:23
+ Log: enhance perlre.pod to say C<)> can't appear in a (?#...) comment
+ Branch: perl
+ ! pod/perlre.pod
+____________________________________________________________________________
+[ 1165] By: gsar on 1998/06/20 23:47:09
+ Log: added patch, tweaked missed files, excised comment that doesn't really
+ belong in the sources
+ From: joshua.pritikin@db.com
+ Date: Mon, 15 Jun 1998 10:03:37 -0400
+ Message-Id: <H00000e500072c63@MHS>
+ Subject: [PATCH 5.004_57] tied hash slice & do_kv cleanup
+ Branch: perl
+ ! ObjXSub.h av.c doop.c embed.h global.sym objpp.h pp.c proto.h
+ ! t/op/avhv.t
+____________________________________________________________________________
+[ 1164] By: gsar on 1998/06/20 23:29:09
+ Log: add File-Spec-0.6 from CPAN
+ Branch: perl
+ + lib/File/Spec.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 t/lib/filespec.t
+ ! MANIFEST
+____________________________________________________________________________
+[ 1163] By: gsar on 1998/06/20 23:15:41
+ Log: tweaks to allow both mingw32{gcc-2.8.1,egcs-1.0.2} build and test
+ Branch: perl
+ ! ext/POSIX/POSIX.xs win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 1162] By: gsar on 1998/06/20 21:48:32
+ Log: manual integration of all outstanding ansi branch stuff into mainline
+ Branch: perl
+ ! ext/POSIX/POSIX.xs lib/ExtUtils/MM_Win32.pm t/op/ipcsem.t
+ ! win32/config.gc win32/dl_win32.xs win32/makefile.mk
+ ! win32/win32.h
+____________________________________________________________________________
+[ 1161] By: gsar on 1998/06/20 21:12:01
+ Log: undo goofed change 1157 (backed out the fix instead of keeping it)
+ Branch: perl
+ ! utils/perldoc.PL
+____________________________________________________________________________
+[ 1160] By: nick on 1998/06/20 21:05:51
+ Log: Patches to build with EGCS-1.0.2 Mingw32 port.
+ Branch: ansiperl
+ ! ext/POSIX/POSIX.xs win32/config.gc win32/config_H.gc
+ ! win32/dl_win32.xs win32/makefile.mk win32/win32.h
+____________________________________________________________________________
+[ 1159] By: gsar on 1998/06/20 02:51:35
+ Log: cleanup installation of utilities on win32
+ Branch: perl
+ ! installperl pod/Makefile win32/Makefile win32/makefile.mk
+ ! win32/pod.mak
+____________________________________________________________________________
+[ 1158] By: gsar on 1998/06/20 02:50:35
+ Log: intuit @INC pathnames from exe location only if dll location
+ is unknown (ensures that multiple executables will coexist)
+ Branch: perl
+ ! win32/win32.c
+____________________________________________________________________________
+[ 1157] By: gsar on 1998/06/20 02:48:34
+ Log: make perldoc ignore null files (it tried to open() them)
+ Branch: perl
+ ! utils/perldoc.PL
+____________________________________________________________________________
+[ 1156] By: gsar on 1998/06/19 21:18:47
+ Log: fix perldoc to ignore unfound null filenames
+ Branch: perl
+ ! utils/perldoc.PL
+____________________________________________________________________________
+[ 1155] By: TimBunce on 1998/06/19 18:47:57
+ Log: Assorted patches:
+
+ ------ BUILD PROCESS ------
+
+ Title: "Clarify varargs issues in INSTALL docs"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980603125427.8559C-100000@newton.phys>
+ Files: INSTALL
+
+ ------ CORE LANGUAGE ------
+
+ Title: "Further fixes for updated SysV IPC support"
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199805211644.TAA15139@alpha.hut.fi>
+ Files: Configure perl.h doio.c
+
+ Title: "Fixed SEGV caused by bug in pp_hot.c:pp_sassign()"
+ From: Andrew Bettison <andrewb@zip.com.au>
+ Msg-ID: <m0ykMQx-000OQCC@headroom.zip.com.au>
+ Files: pp_hot.c
+
+ Title: "Invalidate method cache on C<local *subname>"
+ From: Chip Salzenberg <chip@perl.org>
+ Msg-ID: <19980604134731.D24343@perlsupport.com>
+ Files: scope.c t/op/method.t
+
+ Title: "fix uninitialized cv variable in op.c"
+ From: joshua.pritikin@db.com
+ Msg-ID: <H00000e50005af05@MHS>
+ Files: op.c
+
+ Title: "fix for undef as last arg to setsockopt"
+ From: Graham Barr <gbarr@ti.com>
+ Msg-ID: <19980603112219.B7638@asic.sc.ti.com>
+ Files: pp_sys.c
+
+ Title: "Fix -i when @ARGV is empty"
+ From: Chip Salzenberg <chip@perl.org>, Gurusamy Sarathy
+ <gsar@engin.umich.edu>, Ilya Zakharevich
+ <ilya@math.ohio-state.edu>, Tim.Bunce@ig.co.uk (Tim Bunce)
+ Msg-ID: <19980606184942.A4583@perlsupport.com>,
+ <199806070029.UAA18709@monk.mps.ohio-state.edu>,
+ <199806071817.OAA28141@aatma.engin.umich.edu>,
+ <199806191549.QAA16376@toad.ig.co.uk>
+ Files: pp_hot.c
+
+ ------ DOCUMENTATION ------
+
+ Title: "Discrepancy between perlop.pod and m// operator docs"
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID: <Pine.GSO.3.96.980526092614.27437B-100000@user2.teleport.com>
+ Files: pod/perlop.pod
+
+ Title: "Doc addition for perlfunc entry for system()"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>, Mike Fletcher
+ <fletch@phydeaux.org>
+ Msg-ID: <199806011908.PAA31069@dewdrop2.mindspring.com>,
+ <199806012057.QAA26830@monk.mps.ohio-state.edu>
+ Files: pod/perlfunc.pod
+
+ Title: "Clarify effects of using quotes with m operator"
+ From: Daniel Grisinger <dgris@perrin.dimensional.com>
+ Msg-ID: <Pine.LNX.3.96.980617111641.25631B-100000@perrin.dimensional.com>
+ Files: pod/perlop.pod
+
+ Title: "Document -i with STDIN"
+ From: joshua.pritikin@db.com
+ Msg-ID: <H00000e50006a84a@MHS>
+ Files: pod/perlrun.pod
+
+ ------ EXTENSIONS ------
+
+ Title: "Fix Liblist.pm to tolerate backslashen in paths"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199806011954.PAA10900@aatma.engin.umich.edu>
+ Files: lib/ExtUtils/Liblist.pm
+
+ ------ LIBRARY ------
+
+ Title: "Typo fix for Math::BogFloat"
+ From: Mike Stok <mike@stok.co.uk>
+ Msg-ID: <Pine.LNX.3.96.980605101623.982F-100000@stok.co.uk>
+ Files: lib/Math/BigFloat.pm
+
+ ------ PORTABILITY - GENERAL ------
+
+ Title: "Add docs about types of diff to Porting/patching.pod"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199806090105.VAA20005@aatma.engin.umich.edu>
+ Files: Porting/patching.pod
+
+ Title: "Set dont_use_nlink for PowerMAX OS 4.2"
+ From: Tom Horsley <Tom.Horsley@mail.ccur.com>
+ Msg-ID: <199806161354.NAA21316@cleo.ssd.hcsc.com>
+ Files: hints/powerux.sh
+
+ Title: "Assorted improvements to hints/solaris_2.sh"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980527135845.26608K-100000@newton.phys>
+ Files: hints/solaris_2.sh
+ Branch: maint-5.004/perl
+ ! Configure INSTALL Porting/patching.pod doio.c hints/powerux.sh
+ ! hints/solaris_2.sh lib/ExtUtils/Liblist.pm
+ ! lib/Math/BigFloat.pm op.c perl.h pod/perlfunc.pod
+ ! pod/perlop.pod pod/perlrun.pod pp_hot.c pp_sys.c scope.c
+ ! t/op/method.t
+____________________________________________________________________________
+[ 1154] By: gsar on 1998/06/19 17:22:23
+ Log: update repository copy of Asmdata.pm after `perl bytecode.pl`
+ Branch: perl
+ ! ext/B/B/Asmdata.pm regcomp.c
+____________________________________________________________________________
+[ 1153] By: nick on 1998/06/19 17:21:21
+ Log: Use libxxx.a for -lxxx with GCC
+ Branch: ansiperl
+ ! lib/ExtUtils/MM_Win32.pm win32/config.gc win32/config_H.gc
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 1152] By: TimBunce on 1998/06/19 17:08:18
+ Log: Title: Tom's jumbo doc patch
+ From: Tom Christiansen <tchrist@chthon.perl.com>
+ Msg-Id: <199806140419.WAA20549@chthon.perl.com>
+ Files: pod/perl.pod pod/perlbook.pod pod/perldata.pod pod/perldsc.pod
+ pod/perlfaq.pod pod/perlfaq1.pod pod/perlfaq2.pod
+ pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod
+ pod/perlfaq6.pod pod/perlfaq7.pod pod/perlfaq8.pod
+ pod/perlfaq9.pod pod/perlform.pod pod/perlfunc.pod
+ pod/perlipc.pod pod/perllocale.pod pod/perllol.pod
+ pod/perlmod.pod pod/perlmodlib.pod pod/perlobj.pod
+ pod/perlop.pod pod/perlre.pod pod/perlref.pod
+ pod/perlrun.pod pod/perlsec.pod pod/perlsub.pod
+ pod/perlsyn.pod pod/perltie.pod pod/perltoot.pod
+ pod/perlvar.pod
+ Branch: maint-5.004/perl
+ ! pod/perl.pod pod/perlbook.pod pod/perldata.pod pod/perldsc.pod
+ ! pod/perlfaq.pod pod/perlfaq1.pod pod/perlfaq2.pod
+ ! pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod
+ ! pod/perlfaq6.pod pod/perlfaq7.pod pod/perlfaq8.pod
+ ! pod/perlfaq9.pod pod/perlform.pod pod/perlfunc.pod
+ ! pod/perlipc.pod pod/perllocale.pod pod/perllol.pod
+ ! pod/perlmod.pod pod/perlmodlib.pod pod/perlobj.pod
+ ! pod/perlop.pod pod/perlre.pod pod/perlref.pod pod/perlrun.pod
+ ! pod/perlsec.pod pod/perlsub.pod pod/perlsyn.pod
+ ! pod/perltie.pod pod/perltoot.pod pod/perlvar.pod
+____________________________________________________________________________
+[ 1151] By: nick on 1998/06/19 15:38:28
+ Log: Resolve latest
+ Branch: ansiperl
+ !> av.c embed.h embedvar.h ext/Socket/Socket.xs global.sym
+ !> hints/powerux.sh mg.c perl.h pod/perlsub.pod pp_ctl.c proto.h
+ !> sv.c t/TEST
+____________________________________________________________________________
+[ 1150] By: gsar on 1998/06/18 20:43:07
+ Log: Date: Tue, 16 Jun 1998 13:54:17 GMT
+ Message-Id: <199806161354.NAA21316@cleo.ssd.hcsc.com>
+ From: Tom Horsley <Tom.Horsley@mail.ccur.com>
+ Subject: [PATCH] perl5.004 hints file (maint and dev paths)
+ Branch: perl
+ ! hints/powerux.sh
+____________________________________________________________________________
+[ 1149] By: gsar on 1998/06/18 20:41:30
+ Log: hand apply whitespace-mutiliated patch
+ From: joshua.pritikin@db.com
+ Date: Mon, 15 Jun 1998 09:21:36 -0400
+ Message-Id: <H00000e50007289b@MHS>
+ Subject: [PATCH 5.004_67] SvREADONLY for av_clear
+ Branch: perl
+ ! av.c
+____________________________________________________________________________
+[ 1148] By: gsar on 1998/06/18 20:33:59
+ Log: hand apply whitespace-mutiliated and reversed patch
+ Date: Tue, 16 Jun 1998 16:31:40 -0400
+ From: Les Peters <lpeters@aol.net>
+ Message-Id: <199806162031.QAA08202@ds9>
+ Subject: [PATCH 5.004_67] Socket.xs tweak for IRIX 6.3
+ Branch: perl
+ ! ext/Socket/Socket.xs
+____________________________________________________________________________
+[ 1147] By: gsar on 1998/06/18 20:26:59
+ Log: close child pipe in t/TEST, other cosmetic tweaks
+ Branch: perl
+ ! t/TEST
+____________________________________________________________________________
+[ 1146] By: gsar on 1998/06/18 19:37:41
+ Log: back out problematic change#1105, tweak perlsub.pod
+ Branch: perl
+ ! embed.h embedvar.h global.sym mg.c perl.h pod/perlsub.pod
+ ! pp_ctl.c proto.h sv.c
+____________________________________________________________________________
+[ 1145] By: nick on 1998/06/18 19:31:07
+ Log: Integrate and resolve -at mainline to ansiperl prior to Ming32 hacking
+ Branch: ansiperl
+ +> configure.com ext/DB_File/dbinfo
+ +> ext/DynaLoader/DynaLoader_pm.PL t/base/rs.t
+ +> t/op/regexp_noamp.t vms/descrip_mms.template vms/munchconfig.c
+ +> vms/subconfigure.com
+ - ext/DynaLoader/DynaLoader.pm.PL vms/config.vms vms/descrip.mms
+ - vms/fndvers.com
+ !> (integrate 499 files)
+____________________________________________________________________________
+[ 1144] By: gsar on 1998/06/18 16:35:11
+ Log: fix spurious cxstack_max init that trampled memory
+ Branch: perl
+ ! perl.c
+____________________________________________________________________________
+[ 1143] By: gsar on 1998/06/18 16:33:01
+ Log: fix memory leaks and uninitialized memory accesses found by Purify
+ Branch: perl
+ ! doio.c perl.c regexec.c sv.c
+____________________________________________________________________________
+[ 1142] By: gsar on 1998/06/18 16:28:48
+ Log: fix off-by-one that trampled memory in re_croak2()
+ Branch: perl
+ ! regcomp.c
+____________________________________________________________________________
+[ 1141] By: gsar on 1998/06/18 16:26:59
+ Log: fix AutoLoader to do the right thing when there are relative paths
+ in @INC
+ Branch: perl
+ ! lib/AutoLoader.pm
+____________________________________________________________________________
+[ 1140] By: gsar on 1998/06/18 16:22:47
+ Log: fix Makefile.SH typo
+ Branch: perl
+ ! Makefile.SH
+____________________________________________________________________________
+[ 1139] By: gsar on 1998/06/17 18:06:16
+ Log: 5.004_67 niggles
+ Branch: perl
+ ! Makefile.SH op.c
----------------
-Version 5.003_25
+Version 5.004_67
----------------
-This release is beta candidate #3. Here's hoping...
-
- CORE LANGUAGE CHANGES
-
- Title: "Make $] read-only"
- From: Chip Salzenberg
- Files: gv.c
-
- Title: "New variable C<$^S> is a native version of C<$?>"
- From: Chip Salzenberg
- Files: doio.c global.sym gv.c interp.sym lib/English.pm mg.c perl.c
- perl.h pod/perldelta.pod pod/perlfunc.pod pod/perlvar.pod
- pp_ctl.c pp_sys.c proto.h util.c
-
- Title: "Make $^T work with undump, and don't taint it"
- From: Chip Salzenberg
- Files: perl.c
-
- CORE PORTABILITY
-
- Title: "VMS patches for _24"
- From: Charles Bailey
- Msg-ID: <01IEUIFP5038004GQP@hmivax.humgen.upenn.edu>
- Date: Fri, 31 Jan 1997 02:34:37 -0500 (EST)
- Files: ext/DynaLoader/DynaLoader.pm ext/DynaLoader/dl_vms.xs
- lib/AutoSplit.pm lib/ExtUtils/MM_VMS.pm
- lib/ExtUtils/MakeMaker.pm perl.h pp_hot.c t/lib/filehand.t
- t/op/closure.t vms/Makefile vms/config.vms vms/descrip.mms
- vms/ext/filespec.t vms/vms.c vms/vmsish.h
-
- Title: "hints/dec_osf.sh: polishing the comments"
- From: Jarkko Hietaniemi
- Msg-ID: <199701301958.VAA08992@alpha.hut.fi>
- Date: Thu, 30 Jan 1997 21:58:10 +0200 (EET)
- Files: hints/dec_osf.sh
-
- Title: "amigaos.sh"
- From: Norbert Pueschel
- Msg-ID: <77724724@Armageddon.meb.uni-bonn.de>
- Date: Wed, 29 Jan 1997 11:39:49 +0100
- Files: hints/amigaos.sh
-
- OTHER CORE CHANGES
-
- Title: "Require '-T' in argv[], not just on #! line"
- From: Chip Salzenberg
- Files: perl.c pod/perldiag.pod
-
- Title: "Fix C<return @_> and associated stack bugs"
- From: Chip Salzenberg
- Files: cop.h pp_ctl.c pp_hot.c t/op/misc.t
-
- Title: "Fix never-closing handle after C<select>"
- From: Chip Salzenberg
- Files: pp_sys.c
-
- Title: "Fix /\G/g with patterns that match empty string"
- From: Ilya Zakharevich
- Files: pp_hot.c
-
- Title: "Fix scalar leak in av_unshift"
- From: Chip Salzenberg
- Files: av.c
-
- Title: "Ignore refs to lexicals when making refs to lexicals"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Don't create AV, HV, IO when assigning glob"
- From: Chip Salzenberg
- Files: mg.c
-
- BUILD PROCESS
-
- Title: "Configure updates for intsize and ssizetype"
- From: Andy Dougherty
- Files: Configure MANIFEST config_H config_h.SH handy.h
-
- Title: "Ask about /usr/bin/perl iff STDIN and STDERR are terminals"
- From: Chip Salzenberg
- Files: installperl
-
- LIBRARY AND EXTENSIONS
-
- Title: "Refresh CPAN to 1.19"
- From: Andreas Koenig
- Files: lib/Bundle/CPAN.pm lib/CPAN.pm lib/CPAN/FirstTime.pm
-
- Title: "Debugger update"
- From: Ilya Zakharevich
- Msg-ID: <199702030406.XAA23029@monk.mps.ohio-state.edu>
- Date: Sun, 2 Feb 1997 23:06:34 -0500 (EST)
- Files: lib/perl5db.pl
-
- Title: "In Symbol::gensym, don't make glob fake by copying it"
- From: John Hughes <john@AtlanTech.COM>
- Files: lib/Symbol.pm
-
- Title: "Make POSIX::is*() eight-bit-clean"
- From: Chip Salzenberg
- Files: ext/POSIX/POSIX.xs
-
- Title: "Make IO::Handle::gets() an alias of getline"
- From: Gisle Aas
- Msg-ID: <199701301103.MAA11291@bergen.sn.no>
- Date: Thu, 30 Jan 1997 12:03:15 +0100
- Files: ext/IO/lib/IO/Handle.pm lib/IO/Handle.pm
-
- TESTS
-
- Title: "More Amiga test patches"
- From: Norbert Pueschel
- Msg-ID: <77724725@Armageddon.meb.uni-bonn.de>
- Date: Wed, 29 Jan 1997 16:07:33 +0100
- Files: README.amiga t/lib/safe2.t t/op/closure.t
-
- UTILITIES
-
- Title: "c2ph.PL fix"
- From: lvirden@cas.org (Larry W. Virden)
- Msg-ID: <199701301349.IAA16724@cas.org>
- Date: Thu, 30 Jan 1997 08:49:19 -0500
- Files: utils/c2ph.PL
-
- Title: "Make pod2man a little laxer for perltoc.pod"
- From: Chip Salzenberg
- Files: pod/pod2man.PL
-
- DOCUMENTATION
-
- Title: "Update to perl INSTALL file"
- From: lvirden@cas.org (Larry W. Virden)
- Msg-ID: <199701301338.IAA15878@cas.org>
- Date: Thu, 30 Jan 1997 08:38:23 -0500
- Files: INSTALL
-
- Title: "Update to perl.pod suggested"
- From: lvirden@cas.org (Larry W. Virden)
- Msg-ID: <199701301345.IAA16514@cas.org>
- Date: Thu, 30 Jan 1997 08:45:59 -0500
- Files: pod/perl.pod
-
- Title: "Document how extension pms go in $archlib"
- From: Chip Salzenberg
- Files: pod/perldelta.pod
-
- Title: "perlfunc.pod tweaks"
- From: Roderick Schertler
- Msg-ID: <20526.854659255@eeyore.ibcinc.com>
- Date: Thu, 30 Jan 1997 16:20:55 -0500
- Files: pod/perlfunc.pod
-
- Title: "new (Feb 1) perlembed.pod"
- From: Jon Orwant <orwant@media.mit.edu>
- Msg-ID: <9702012334.AA15747@fahrenheit-451.media.mit.edu>
- Date: Sat, 1 Feb 1997 18:34:59 -0500
- Files: pod/perlembed.pod
-
- Title: "Error lines must not have trialing periods"
- From: Chip Salzenberg
- Files: pod/perldiag.pod
-
+____________________________________________________________________________
+[ 1138] By: gsar on 1998/06/15 10:09:27
+ Log: up patchlevel.h to 67, other small tweaks
+ Branch: perl
+ ! patchlevel.h pod/perlhist.pod pod/perltoc.pod vms/perly_c.vms
+ ! win32/Makefile win32/config_H.bc win32/config_H.gc
+ ! win32/config_H.vc win32/makefile.mk
+____________________________________________________________________________
+[ 1137] By: gsar on 1998/06/15 09:08:57
+ Log: tweaks to get PERL_OBJECT building again; passes tests
+ Branch: perl
+ ! ObjXSub.h objpp.h proto.h
+____________________________________________________________________________
+[ 1136] By: gsar on 1998/06/15 08:51:54
+ Log: back out previous change (it breaks PERL_OBJECT)
+ Branch: perl
+ ! ObjXSub.h cc_runtime.h embed.h embedvar.h global.sym
+ ! interp.sym intrpvar.h objpp.h perl.c perl.h pod/perldiag.pod
+ ! pod/perlguts.pod pp_ctl.c proto.h scope.c scope.h util.c
+____________________________________________________________________________
+[ 1135] By: gsar on 1998/06/15 05:32:01
+ Log: added patch, fixed typo, reworked documentation
+ Message-Id: <H00000e500071aa3@MHS>
+ Date: Sun, 14 Jun 1998 14:03:15 EDT
+ From: joshua.pritikin@db.com
+ Subject: [PATCH 5.004_66] JMPENV!
+ Branch: perl
+ ! ObjXSub.h cc_runtime.h embed.h embedvar.h global.sym
+ ! interp.sym intrpvar.h objpp.h perl.c perl.h pod/perldiag.pod
+ ! pod/perlguts.pod pp_ctl.c proto.h scope.c scope.h util.c
+____________________________________________________________________________
+[ 1134] By: gsar on 1998/06/15 04:07:18
+ Log: various win32 odds and ends
+ - added support for waitpid(), open2/open3, and a bugfix for kill()
+ from Ronald Schmidt <RonaldWS@aol.com>
+ - tweak testsuite mods of above
+ - regenerate win32/config_H.?c
+ - change kill() to win32_kill() and export it
+ - coalesce common code in win32.c
+ - add PerlProc_waitpid() and export win32_waitpid()
+ result builds and passes on the three win32 compilers
+ Branch: perl
+ ! ipproc.h lib/IPC/Open3.pm perlproc.h t/lib/open2.t
+ ! t/lib/open3.t util.c win32/config.bc win32/config.gc
+ ! win32/config.vc win32/config_H.bc win32/config_H.gc
+ ! win32/config_H.vc win32/makedef.pl win32/runperl.c
+ ! win32/win32.c win32/win32iop.h
+____________________________________________________________________________
+[ 1133] By: gsar on 1998/06/15 01:39:13
+ Log: newer Getopt/Long.pm from public distribution cited in:
+ Message-Id: <m2n2bgm8en.fsf@phoenix.squirrel.nl>
+ Date: 14 Jun 1998 15:15:28 +0200
+ From: Johan Vromans <jvromans@squirrel.nl>
+ Subject: Getopt::Long version 2.17 released
+ Branch: perl
+ ! lib/Getopt/Long.pm
+____________________________________________________________________________
+[ 1132] By: gsar on 1998/06/15 01:37:12
+ Log: documentation update from tchrist
+ Message-Id: <199806140419.WAA20549@chthon.perl.com>
+ Date: Sat, 13 Jun 1998 22:19:32 MDT
+ From: Tom Christiansen <tchrist@chthon.perl.com>
+ Subject: doc patches
+ Branch: perl
+ ! pod/perl.pod pod/perlbook.pod pod/perldata.pod pod/perldsc.pod
+ ! pod/perlfaq.pod pod/perlfaq1.pod pod/perlfaq2.pod
+ ! pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod
+ ! pod/perlfaq6.pod pod/perlfaq7.pod pod/perlfaq8.pod
+ ! pod/perlfaq9.pod pod/perlform.pod pod/perlfunc.pod
+ ! pod/perlipc.pod pod/perllocale.pod pod/perllol.pod
+ ! pod/perlmod.pod pod/perlmodlib.pod pod/perlobj.pod
+ ! pod/perlop.pod pod/perlre.pod pod/perlref.pod pod/perlrun.pod
+ ! pod/perlsec.pod pod/perlsub.pod pod/perlsyn.pod
+ ! pod/perltie.pod pod/perltoot.pod pod/perlvar.pod
+____________________________________________________________________________
+[ 1131] By: gsar on 1998/06/14 19:33:36
+ Log: Message-ID: <pz3edaedog.fsf@eeyore.ibcinc.com>
+ From: Roderick Schertler <roderick@argon.org>
+ Subject: [PATCH] Re: Exceptions in IPC::Open2
+ Date: 12 Jun 1998 13:24:15 -0400
+ Branch: perl
+ ! lib/IPC/Open3.pm
+____________________________________________________________________________
+[ 1130] By: gsar on 1998/06/14 19:32:25
+ Log: fixup MANIFEST
+ Branch: perl
+ ! MANIFEST
+____________________________________________________________________________
+[ 1129] By: gsar on 1998/06/14 18:51:53
+ Log: various win32 fixes
+ - fixes that silence VC noises about dup exports, non-default libs, and
+ unsupported *.def file directives
+ - s/inplace/inplace_label/ malloc.c
+ - update Config{usemymalloc} based on d_mymalloc
+ - export Perl_*Vars
+ - fix makefiles to not build miniperl.exe twice, and to make it properly
+ when defaults are changed
+ Branch: perl
+ ! lib/ExtUtils/MM_Win32.pm lib/ExtUtils/Mksymlists.pm malloc.c
+ ! win32/Makefile win32/config_sh.PL win32/makedef.pl
+ ! win32/makefile.mk win32/perllib.c win32/win32.h
+____________________________________________________________________________
+[ 1128] By: gsar on 1998/06/14 01:38:39
+ Log: remove unused global `scrgv'
+ Branch: perl
+ ! ObjXSub.h cygwin32/cw32imp.h embedvar.h perlvars.h
+____________________________________________________________________________
+[ 1127] By: nick on 1998/06/13 08:39:07
+ Log: Move specialsv_list to embed.sym, regen embed*.h
+ Branch: win32/perl
+ ! embed.h embedvar.h global.sym interp.sym
+____________________________________________________________________________
+[ 1126] By: gsar on 1998/06/12 07:23:06
+ Log: From: jan.dubois@ibm.net (Jan Dubois)
+ Subject: Re: execv in toke.c [PATCH]: win32 wrapper for _66
+ Date: Thu, 11 Jun 1998 21:13:31 +0200
+ Message-ID: <35842ac5.7883075@smtp1.ibm.net>
+ Branch: perl
+ ! win32/makedef.pl win32/win32.c win32/win32iop.h
+____________________________________________________________________________
+[ 1125] By: gsar on 1998/06/12 07:21:29
+ Log: added patch, undo earlier workaround
+ From: jan.dubois@ibm.net (Jan Dubois)
+ Subject: Re: Why does saferealloc(NULL,size) croak? [PATCH] against _66
+ Date: Thu, 11 Jun 1998 20:28:36 +0200
+ Message-ID: <35831f69.4975644@smtp1.ibm.net>
+ Branch: perl
+ ! perl.c util.c
+____________________________________________________________________________
+[ 1124] By: gsar on 1998/06/12 07:16:12
+ Log: hand-applied patch with wrapped lines
+ From: "Douglas Lankshear" <dougl@ActiveState.com>
+ Subject: [PATCH 5.004_66] Win32::Reg... bloat in Win32
+ Date: Thu, 11 Jun 1998 11:06:33 -0700
+ Message-ID: <000101bd9563$aae0c4c0$a32fa8c0@tau.Active>
+ Branch: perl
+ ! win32/win32.c
+____________________________________________________________________________
+[ 1123] By: gsar on 1998/06/12 07:07:25
+ Log: Date: Thu, 11 Jun 1998 12:40:05 -0400 (EDT)
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Subject: [PATCH 5.004_66] Config_66-01-02.diff
+ Message-Id: <Pine.SUN.3.96.980611123857.18493K-100000@newton.phys>
+ Branch: perl
+ ! Configure
+____________________________________________________________________________
+[ 1122] By: gsar on 1998/06/12 07:06:02
+ Log: Message-Id: <Pine.SUN.3.96.980611122249.18493J-100000@newton.phys>
+ Date: Thu, 11 Jun 1998 12:27:15 -0400 (EDT)
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Subject: Re: [PATCH for _66] Makefile.SH problem on dos/djgpp
+ Branch: perl
+ ! pod/checkpods.PL pod/pod2html.PL pod/pod2latex.PL
+ ! pod/pod2man.PL utils/c2ph.PL utils/h2ph.PL utils/h2xs.PL
+ ! utils/perlbug.PL utils/perlcc.PL utils/perldoc.PL
+ ! utils/pl2pm.PL utils/splain.PL x2p/find2perl.PL x2p/s2p.PL
+____________________________________________________________________________
+[ 1121] By: gsar on 1998/06/12 07:01:20
+ Log: a tweaked version of:
+ Message-Id: <l03130300b1a6143078cd@[194.222.64.89]>
+ Date: Fri, 12 Jun 1998 01:26:53 +0200
+ From: Hugo van der Sanden <hv@crypt0.demon.co.uk>
+ Subject: Re: Misparsing s///x
+ Branch: perl
+ ! pod/perlre.pod
+____________________________________________________________________________
+[ 1120] By: gsar on 1998/06/12 06:51:08
+ Log: applied patch, with indentation tweaks
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806110803.EAA09149@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_66] Remove REG_ALIGN junk
+ Date: Thu, 11 Jun 1998 04:03:58 -0400 (EDT)
+ Branch: perl
+ ! regcomp.c regcomp.h regexec.c
+____________________________________________________________________________
+[ 1119] By: gsar on 1998/06/11 17:42:07
+ Log: make REG_INFTY default to something saner when sizeof(short) > 2
+ Message-Id: <Pine.SUN.3.96.980611114241.18493H-100000@newton.phys>
+ Date: Thu, 11 Jun 1998 11:50:07 EDT
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Subject: Re: [PATCH for tests] Regexp fails on long string
+ Branch: perl
+ ! regcomp.h
+____________________________________________________________________________
+[ 1118] By: gsar on 1998/06/11 07:09:06
+ Log: regen embedvar.h
+ Branch: perl
+ ! embedvar.h
+____________________________________________________________________________
+[ 1117] By: gsar on 1998/06/11 06:45:52
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806100751.DAA05441@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_66] Bugs with (?{}), $^R and many-to-many subst
+ Date: Wed, 10 Jun 1998 03:51:47 -0400 (EDT)
+ Branch: perl
+ ! interp.sym intrpvar.h op.c op.h perl.c regcomp.c regcomp.h
+ ! regexec.c regexp.h t/op/pat.t t/op/subst.t
+____________________________________________________________________________
+[ 1116] By: gsar on 1998/06/11 06:35:54
+ Log: misc win32 fixes
+ From: "Douglas Lankshear" <dougl@ActiveState.com>
+ Subject: [PATCH 5.004_66]
+ Date: Wed, 10 Jun 1998 11:28:27 -0700
+ Message-ID: <001a01bd949d$8fd18050$a32fa8c0@tau.Active>
+ Branch: perl
+ ! ObjXSub.h perl.c win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 1115] By: gsar on 1998/06/11 06:33:21
+ Log: Message-ID: <19980610005325.D162@cdata.tvnet.hu>
+ Date: Wed, 10 Jun 1998 00:53:25 +0200
+ From: Laszlo Molnar <molnarl@cdata.tvnet.hu>
+ Subject: [PATCH for _66] Makefile.SH problem on dos/djgpp
+ Branch: perl
+ ! Makefile.SH
+____________________________________________________________________________
+[ 1114] By: gsar on 1998/06/11 06:31:34
+ Log: back out change#1111 and add alternative patch:
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806101538.LAA07293@monk.mps.ohio-state.edu>
+ Subject: Re: PATCH for study/foo/
+ Date: Wed, 10 Jun 1998 11:38:58 -0400 (EDT)
+ Branch: perl
+ ! pp.c sv.c
+____________________________________________________________________________
+[ 1113] By: gsar on 1998/06/11 02:59:23
+ Log: fix outdated bytecode.pl
+ Branch: perl
+ ! bytecode.h bytecode.pl byterun.c byterun.h
+____________________________________________________________________________
+[ 1112] By: gsar on 1998/06/10 07:56:06
+ Log: Added patch, regenerated perly.c and perly.c.diff
+ Message-Id: <m0ygCL8-000Eb3C@alias-2.pr.mcs.net>
+ Date: Sun, 31 May 1998 12:56:14 -0500 (CDT)
+ From: Stephen McCamant <alias@mcs.com>
+ Subject: [PATCH] too many RV2GVs in *foo{THING}
+ Branch: perl
+ ! perly.c perly.c.diff perly.y t/op/gv.t
+____________________________________________________________________________
+[ 1111] By: gsar on 1998/06/10 07:40:30
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806100309.XAA04974@monk.mps.ohio-state.edu>
+ Subject: Re: PATCH for study/foo/
+ Date: Tue, 9 Jun 1998 23:09:55 -0400 (EDT)
+ Branch: perl
+ ! pp.c
+____________________________________________________________________________
+[ 1110] By: gsar on 1998/06/10 07:37:04
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806100219.WAA04865@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_66] -DL and PERL_DEBUG_MSTATS unravelled
+ Date: Tue, 9 Jun 1998 22:19:02 -0400 (EDT)
+ Branch: perl
+ ! pod/perldebug.pod
+____________________________________________________________________________
+[ 1109] By: gsar on 1998/06/10 07:35:29
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806100302.XAA04958@monk.mps.ohio-state.edu>
+ Subject: Re: [PATCH 5.004_66] REG_INFTY patch corrected
+ Date: Tue, 9 Jun 1998 23:02:52 -0400 (EDT)
+ Branch: perl
+ ! regcomp.h
+____________________________________________________________________________
+[ 1108] By: gsar on 1998/06/10 07:31:25
+ Log: Added patch, tweaked other places affected by name change
+ Message-ID: <19980610005417.G162@cdata.tvnet.hu>
+ Date: Wed, 10 Jun 1998 00:54:17 +0200
+ From: Laszlo Molnar <molnarl@cdata.tvnet.hu>
+ Subject: [PATCH] file name DynaLoader.pm.PL is 8.3 unfriendly
+ Branch: perl
+ +> ext/DynaLoader/DynaLoader_pm.PL
+ - ext/DynaLoader/DynaLoader.pm.PL
+ ! MANIFEST ext/DynaLoader/Makefile.PL win32/Makefile
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 1107] By: gsar on 1998/06/10 07:24:20
+ Log: Message-ID: <19980610005342.E162@cdata.tvnet.hu>
+ Date: Wed, 10 Jun 1998 00:53:42 +0200
+ From: Laszlo Molnar <molnarl@cdata.tvnet.hu>
+ Subject: [PATCH for _66] new version of README.dos
+ Branch: perl
+ ! README.dos
+____________________________________________________________________________
+[ 1106] By: gsar on 1998/06/10 07:22:31
+ Log: Message-ID: <19980610005404.F162@cdata.tvnet.hu>
+ Date: Wed, 10 Jun 1998 00:54:04 +0200
+ From: Laszlo Molnar <molnarl@cdata.tvnet.hu>
+ Subject: [PATCH for _66] op/taint.t problem on dos/djgpp
+ Branch: perl
+ ! t/op/taint.t
+____________________________________________________________________________
+[ 1105] By: gsar on 1998/06/10 07:21:21
+ Log: Applied patch, followed by tweaks to *.sym and `perl embed.pl`
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806090216.WAA02041@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_66] Resend of RE cache patch (modified)
+ Date: Mon, 8 Jun 1998 22:16:56 -0400 (EDT)
+ Branch: perl
+ ! embed.h embedvar.h global.sym intrpvar.h mg.c perl.h
+ ! perlvars.h pp_ctl.c proto.h sv.c
+____________________________________________________________________________
+[ 1104] By: gsar on 1998/06/10 07:06:01
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806090210.WAA02027@monk.mps.ohio-state.edu>
+ Subject: Lost chunk of RE jumbo patch
+ Date: Mon, 8 Jun 1998 22:10:52 -0400 (EDT)
+ Branch: perl
+ + t/op/regexp_noamp.t
+____________________________________________________________________________
+[ 1103] By: gsar on 1998/06/10 07:04:20
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199806090207.WAA02015@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.004_66] Combined OS/2 support
+ Date: Mon, 8 Jun 1998 22:07:48 -0400 (EDT)
+ Branch: perl
+ ! os2/Changes os2/diff.configure os2/os2.c
+____________________________________________________________________________
+[ 1102] By: gsar on 1998/06/10 07:00:08
+ Log: Message-Id: <199803140103.UAA04839@monk.mps.ohio-state.edu>
+ Date: Fri, 13 Mar 1998 20:03:52 EST
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Subject: [PATCH 5.004_62 5_004_04m1] pod2html again
+ Branch: perl
+ ! lib/Pod/Html.pm
+____________________________________________________________________________
+[ 1101] By: gsar on 1998/06/10 06:55:20
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Subject: Re: 5.004_65 uninitialized variable regexec.c (2)
+ Date: Thu, 28 May 1998 01:28:54 -0400 (EDT)
+ Branch: perl
+ ! regexec.c
+____________________________________________________________________________
+[ 1100] By: gsar on 1998/06/10 06:52:50
+ Log: updated MANIFEST for previous change
+ Branch: perl
+ ! MANIFEST
+____________________________________________________________________________
+[ 1099] By: gsar on 1998/06/10 06:51:08
+ Log: Mangled patch, needed hand-tweaks, along with binmode for rs.t:
+ Message-Id: <3.0.5.32.19980605110840.009e12b0@ous.edu>
+ Date: Fri, 05 Jun 1998 11:08:40 -0700
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Subject: Re: [PATCH 5.004_66]Add record read capability to <>
+ Branch: perl
+ + t/base/rs.t
+ ! perl.h pod/perlvar.pod sv.c
+____________________________________________________________________________
+[ 1098] By: gsar on 1998/06/10 06:36:59
+ Log: From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ Message-Id: <9806042022.AA10418@claudius.bfsec.bt.co.uk>
+ Subject: [PATCH fror 5.004_66] DB_File-1.60
+ Date: Thu, 4 Jun 1998 21:22:35 +0100 (BST)
+ Branch: perl
+ + ext/DB_File/dbinfo
+ ! MANIFEST ext/DB_File/Changes ext/DB_File/DB_File.pm
+ ! ext/DB_File/DB_File.xs ext/DB_File/typemap t/lib/db-btree.t
+ ! t/lib/db-hash.t t/lib/db-recno.t
+____________________________________________________________________________
+[ 1097] By: gsar on 1998/06/10 06:33:16
+ Log: Message-ID: <19980604134731.D24343@perlsupport.com>
+ Date: Thu, 4 Jun 1998 13:47:31 -0400
+ From: Chip Salzenberg <chip@perl.org>
+ Subject: [PATCH] Invalidate method cache on C<local *subname>
+ Branch: perl
+ ! scope.c t/op/method.t
+____________________________________________________________________________
+[ 1096] By: gsar on 1998/06/10 06:30:51
+ Log: From: Norton Allen <allen@huarp.harvard.edu>
+ Message-Id: <199806031908.PAA04183@bottesini.harvard.edu>
+ Subject: [PATCH] _66 MM_Unix.pm for QNX
+ Date: Wed, 3 Jun 1998 15:08:33 -0400 (edt)
+ Branch: perl
+ ! lib/ExtUtils/MM_Unix.pm
+____________________________________________________________________________
+[ 1095] By: gsar on 1998/06/10 06:29:21
+ Log: From: Norton Allen <allen@huarp.harvard.edu>
+ Message-Id: <199806031909.PAA04358@bottesini.harvard.edu>
+ Subject: [PATCH] _66 proto.h
+ Date: Wed, 3 Jun 1998 15:09:14 -0400 (edt)
+ Branch: perl
+ ! proto.h
+____________________________________________________________________________
+[ 1094] By: gsar on 1998/06/10 06:26:39
+ Log: Applied relevant parts of:
+ From: Paul Johnson <pjcj@transeda.com>
+ Date: Wed, 3 Jun 1998 19:07:55 +0100 (BST)
+ Message-Id: <199806031807.TAA04100@west-tip.transeda.com>
+ Subject: [PATCH] Enhancing xsubpp's support for C++
+ Branch: perl
+ ! lib/ExtUtils/xsubpp
+____________________________________________________________________________
+[ 1093] By: gsar on 1998/06/10 06:22:54
+ Log: Message-ID: <19980603112219.B7638@asic.sc.ti.com>
+ Date: Wed, 3 Jun 1998 11:22:19 -0500
+ From: Graham Barr <gbarr@ti.com>
+ Subject: [PATCH perl5.004_04-m4] fix for undef as last arg to setsockopt
+ Branch: perl
+ ! pp_sys.c
+____________________________________________________________________________
+[ 1092] By: gsar on 1998/06/10 06:20:44
+ Log: Message-Id: <199806030919.KAA03527@sale-wts>
+ Date: Wed, 3 Jun 1998 10:20:06 +0100 (BST)
+ From: Alan Burlison <Alan.Burlison@UK.Sun.com>
+ Subject: [PATCH 5.004_66] ExtUtils::Installed.pm and ExtUtils::Packlist.pm
+ Branch: perl
+ ! lib/ExtUtils/Installed.pm lib/ExtUtils/Packlist.pm
+____________________________________________________________________________
+[ 1091] By: gsar on 1998/06/10 06:18:42
+ Log: Message-Id: <3.0.5.32.19980601122229.00a58420@ous.edu>
+ Date: Mon, 01 Jun 1998 12:22:29 -0700
+ From: SYSTEM@cedar.osshe.edu (by way of Dan Sugalski <sugalskd@ous.edu>)
+ Subject: [PATCH 5.004_66] proto.h change to make byterun() visible to VMS
+ Branch: perl
+ ! proto.h
+____________________________________________________________________________
+[ 1090] By: gsar on 1998/06/10 06:14:24
+ Log: A tweaked version of:
+ Date: Mon, 1 Jun 1998 12:05:47 -0700
+ From: SYSTEM@cedar.osshe.edu
+ Message-Id: <980601120547.20617d54@cedar.osshe.edu>
+ Subject: [PATCH 5.004_66] Fix problem with SDBM makefile on VMS
+ Branch: perl
+ ! ext/SDBM_File/sdbm/Makefile.PL
+____________________________________________________________________________
+[ 1089] By: gsar on 1998/06/10 05:58:00
+ Log: Message-Id: <m0yfdd4-000Eb2C@alias-2.pr.mcs.net>
+ Date: Fri, 29 May 1998 23:52:26 -0500 (CDT)
+ From: Stephen McCamant <alias@mcs.com>
+ Subject: [PATCH] Re: Uninitialised error from -M()
+ Branch: perl
+ ! op.c t/op/stat.t
+____________________________________________________________________________
+[ 1088] By: gsar on 1998/06/10 05:55:24
+ Log: Date: Sat, 30 May 1998 08:07:01 -0400
+ From: lvirden@cas.org (Larry Virden)
+ Message-Id: <199805301207.IAA08856@cas.org>
+ Subject: PATCH for pod and warning notice
+ Branch: perl
+ ! pod/perlguts.pod
+____________________________________________________________________________
+[ 1087] By: gsar on 1998/06/10 05:52:05
+ Log: From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Mon, 8 Jun 1998 14:45:36 -0400 (EDT)
+ Message-Id: <Pine.SUN.3.96.980608144437.13972A-100000@newton.phys>
+ Subject: [PATCH 5.004_66] Config_66-01
+ Branch: perl
+ ! Configure MANIFEST Porting/Glossary Porting/config.sh
+ ! Porting/config_H config_h.SH
+____________________________________________________________________________
+[ 1086] By: gsar on 1998/06/10 05:46:38
+ Log: Message-Id: <3.0.5.32.19980608161314.00a0a880@ous.edu>
+ Date: Mon, 08 Jun 1998 16:13:14 -0700
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Subject: [PATCH 5.004_66] Documentation patch for Semaphore.pm
+ Branch: perl
+ ! ext/Thread/Thread/Semaphore.pm
+____________________________________________________________________________
+[ 1085] By: gsar on 1998/06/10 05:44:44
+ Log: Message-Id: <3.0.5.32.19980608161002.00a64a70@ous.edu>
+ Date: Mon, 08 Jun 1998 16:10:02 -0700
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Subject: [PATCH 5.004_66]Doc & feature patch for Thread::Queue
+ Branch: perl
+ - vms/descrip.mms
+ ! ext/Thread/Thread/Queue.pm
+____________________________________________________________________________
+[ 1084] By: gsar on 1998/06/10 05:38:11
+ Log: Message-Id: <3.0.5.32.19980608153828.00a81ea0@ous.edu>
+ Date: Mon, 08 Jun 1998 15:38:28 -0700
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Subject: [PATCH POINTER 5.004_66]A configuration system for VMS perl
+ Branch: perl
+ + configure.com vms/descrip_mms.template vms/munchconfig.c
+ + vms/subconfigure.com
+ - vms/config.vms vms/fndvers.com
+ ! MANIFEST README.vms lib/ExtUtils/MM_VMS.pm
+____________________________________________________________________________
+[ 1083] By: gsar on 1998/06/10 05:07:04
+ Log: xsubpp enhancements ($CPAN/authors/id/ILYAZ/patches/diff_xsubpp_65), a
+ variant of:
+ Message-Id: <199712131231.HAA04125@monk.mps.ohio-state.edu>
+ Date: Sat, 13 Dec 1997 07:31:02 EST
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Subject: 5.004_55: xsubpp: new keywords INTERFACE C_ARGS
+ Branch: perl
+ ! XSUB.h lib/ExtUtils/xsubpp pod/perlxs.pod
+____________________________________________________________________________
+[ 1082] By: gsar on 1998/06/10 04:52:26
+ Log: add newer malloc.c from Ilya Zakharevich <ilya@math.ohio-state.edu>
+ (from $CPAN/authors/id/ILYAZ/patches/diff_malloc_65)
+ Branch: perl
+ ! malloc.c
+____________________________________________________________________________
+[ 1081] By: gsar on 1998/06/10 03:45:10
+ Log: reverse integrate contents of win32 branch into mainline
+ Branch: perl
+ !> (integrate 44 files)
+____________________________________________________________________________
+[ 1080] By: gsar on 1998/06/09 17:37:55
+ Log: `p4 integrate -b ASPerl && p4 resolve -at`
+ Branch: asperl
+ !> (integrate 43 files)
+____________________________________________________________________________
+[ 1079] By: gsar on 1998/06/09 00:59:06
+ Log: add examples of diff(1) usage
+ Branch: win32/perl
+ ! Porting/patching.pod
+____________________________________________________________________________
+[ 1078] By: gsar on 1998/06/09 00:52:23
+ Log: undo change#1077
+ Branch: win32/perl
+ ! sv.c
+____________________________________________________________________________
+[ 1077] By: gsar on 1998/06/06 16:47:32
+ Log: make sv_setsv() treat freed SVs like SVt_NULL
+ Branch: win32/perl
+ ! sv.c
+____________________________________________________________________________
+[ 1076] By: gsar on 1998/06/05 19:03:14
+ Log: delete undiscussed AS changes for PPD (broke .packlist
+ mechanism)
+ Branch: win32/perl
+ ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm
+____________________________________________________________________________
+[ 1075] By: gsar on 1998/06/05 18:18:44
+ Log: add AS patch#26 (rename THIS to PERL_OBJEC_THIS to avoid clash
+ with the xsubpp-generated symbol)
+ Branch: win32/perl
+ ! ObjXSub.h perl.c perl.h pp_ctl.c pp_hot.c toke.c
+ ! win32/dl_win32.xs
+____________________________________________________________________________
+[ 1074] By: gsar on 1998/06/04 22:45:18
+ Log: add AS patch#25 (allow B build with -DPERL_OBJECT)
+ Branch: win32/perl
+ ! ObjXSub.h byterun.h embed.h embedvar.h ext/B/B.xs intrpvar.h
+ ! objpp.h proto.h util.c win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 1073] By: nick on 1998/06/04 17:18:14
+ Log: resolve -at win32 branch into ansiperl
+ Branch: ansiperl
+ +> ObjXSub.h XSLock.h ipdir.h ipenv.h iplio.h ipmem.h ipproc.h
+ +> ipsock.h ipstdio.h objpp.h t/lib/h2ph.h t/lib/h2ph.pht
+ +> t/lib/h2ph.t win32/GenCAPI.pl
+ !> (integrate 127 files)
+____________________________________________________________________________
+[ 1072] By: gsar on 1998/06/04 01:49:24
+ Log: document CORE::GLOBAL:: and global overriding, fix up
+ File::DosGlob, testsuited and all
+ Branch: win32/perl
+ ! lib/File/DosGlob.pm pod/perlsub.pod t/lib/dosglob.t
+____________________________________________________________________________
+[ 1071] By: gsar on 1998/06/03 22:12:55
+ Log: add AS patch#24, remove one other instance of error_no
+ that was missed (patch#23 was intentionally skipped)
+ Branch: win32/perl
+ ! embedvar.h globals.c perlvars.h win32/makedef.pl
+ ! win32/runperl.c
+____________________________________________________________________________
+[ 1070] By: gsar on 1998/06/01 19:42:06
+ Log: fix Liblist.pm to tolerate backslashen in paths
+ Branch: win32/perl
+ ! lib/ExtUtils/Liblist.pm
+____________________________________________________________________________
+[ 1069] By: gsar on 1998/06/01 07:43:02
+ Log: @INC construction on win32 cleaned up
+ - perl.dll location based paths should be much more reliable now
+ - registry stuff unchanged
+ - Config.pm now has all the installfoolib entries for MakeMaker et al
+ Branch: win32/perl
+ ! win32/Makefile 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 win32/makefile.mk
+ ! win32/runperl.c win32/win32.c win32/win32.h
+____________________________________________________________________________
+[ 1068] By: gsar on 1998/05/31 21:52:18
+ Log: semctl tweak
+ Message-Id: <199805312127.QAA06750@gbarr.connect.net>
+ Date: Sun, 31 May 1998 16:27:33 CDT
+ From: Graham Barr <gbarr@pobox.com>
+ Subject: Not OK: perl 5.00466 on i586-linux-thread 2.0.31
+ Branch: win32/perl
+ ! doio.c
+____________________________________________________________________________
+[ 1067] By: gsar on 1998/05/31 21:07:44
+ Log: minimal fix to enable compiling with -DMULTIPLICITY
+ (non-threadsafe regcomp.c globals need revisiting)
+ Branch: win32/perl
+ ! ObjXSub.h embedvar.h interp.sym intrpvar.h regcomp.c
+ ! win32/GenCAPI.pl win32/makedef.pl
+____________________________________________________________________________
+[ 1066] By: gsar on 1998/05/30 21:35:37
+ Log: integrate mainline changes (ASPerl branch is identical to
+ win32 branch as of this change)
+ Branch: asperl
+ !> MANIFEST Todo.5.005 embed.h ext/POSIX/POSIX.xs global.sym
+ !> lib/ExtUtils/Mksymlists.pm pod/perldelta.pod pp_sys.c
+ !> t/op/ipcmsg.t t/op/ipcsem.t win32/Makefile win32/config.bc
+ !> win32/config.gc win32/config.vc win32/config_H.bc
+ !> win32/config_H.gc win32/config_H.vc win32/makefile.mk
+____________________________________________________________________________
+[ 1065] By: gsar on 1998/05/30 21:13:06
+ Log: change#1060 was inexplicably missing some of the "ensure
+ AS stuff does no harm" fixes
+ Branch: win32/perl
+ ! embed.h global.sym win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 1064] By: gsar on 1998/05/30 21:10:27
+ Log: integrate mainline to pick up trivial changes
+ Branch: win32/perl
+ !> MANIFEST pp_sys.c
----------------
-Version 5.003_24
+Version 5.004_66
----------------
-This release is the second candidate for a public beta test.
-It's, well, bunches better than _23.
-
- CORE LANGUAGE CHANGES
-
- Title: "glob defaults to $_"
- From: Gurusamy Sarathy
- Msg-ID: <199701270809.DAA00934@aatma.engin.umich.edu>
- Date: Mon, 27 Jan 1997 03:09:13 -0500
- Files: op.c opcode.pl pod/perlfunc.pod t/op/glob.t
-
- Title: "Re: an overloading bug "
- From: Gurusamy Sarathy
- Msg-ID: <199701270007.TAA26525@aatma.engin.umich.edu>
- Date: Sun, 26 Jan 1997 19:07:45 -0500
- Files: pod/perldiag.pod pod/perlfunc.pod pp_ctl.c
-
- Title: "Don't warn on C<$\ = undef>"
- From: Chip Salzenberg
- Files: mg.c
-
- CORE PORTABILITY
-
- Title: "Win32 port"
- From: Gary Ng <71564.1743@compuserve.com>
- Files: MANIFEST win32/*
-
- Title: "Amiga files"
- From: Norbert Pueschel
- Msg-ID: <77724712@Armageddon.meb.uni-bonn.de>
- Date: Sun, 26 Jan 1997 17:42:15 +0100
- Files: MANIFEST README.amiga hints/amigaos.sh
-
- Title: "New dec_osf hints"
- From: Jarkko.Hietaniemi@cc.hut.fi
- Msg-ID: <199701271233.OAA21548@alpha.hut.fi>
- Date: Mon, 27 Jan 1997 14:33:01 +0200 (EET)
- Files: hints/dec_osf.sh
-
- OTHER CORE CHANGES
-
- Title: "Prevent premature death of @_ during leavesub"
- From: Chip Salzenberg
- Files: pp_hot.c t/op/misc.t
-
- Title: "Deref old stash when re-blessing"
- From: Chip Salzenberg
- Files: sv.c
-
- Title: "Don't abort when RCHECK and DEBUGGING"
- From: Tim Bunce
- Msg-ID: <9701272339.AA16537@toad.ig.co.uk>
- Date: Mon, 27 Jan 1997 23:39:48 +0000
- Files: malloc.c
-
- Title: "Fix overloading macro conflict with Digital 'cc -fast'"
- From: Jarkko Hietaniemi
- Msg-ID: <199701272216.AAA04557@alpha.hut.fi>
- Date: Tue, 28 Jan 1997 00:16:49 +0200 (EET)
- Files: perl.h
-
- Title: "global.sym: typo?"
- From: Jarkko Hietaniemi
- Msg-ID: <199701261937.VAA07556@alpha.hut.fi>
- Date: Sun, 26 Jan 1997 21:37:59 +0200 (EET)
- Files: global.sym
-
- BUILD PROCESS
-
- Title: "Put all extensions' modules in $archlib"
- From: Chip Salzenberg
- Files: installperl
-
- Title: "Configure fixes: set $archlib, omit _NO_PROTO"
- From: Chip Salzenberg
- Files: Configure
-
- Title: "Make configure{,.gnu} ignore --cache-file option"
- From: Norbert Pueschel
- Files: configure configure.gnu
-
- LIBRARY AND EXTENSIONS
-
- Title: "Version checking in XS bootstrap is optional"
- From: Chip Salzenberg
- Files: XSUB.h
-
- Title: "Update $VERSION of DynaLoader and POSIX"
- From: Chip Salzenberg
- Files: ext/DynaLoader/DynaLoader.pm ext/POSIX/POSIX.pm
-
- Title: "Refresh Text::Wrap to 97.011701"
- From: Chip Salzenberg
- Files: lib/Text/Wrap.pm
-
- Title: "Fcntl.xs: F_[GS]ETOWN were in wrong case branch"
- From: Jarkko Hietaniemi
- Msg-ID: <199701251510.RAA05142@alpha.hut.fi>
- Date: Sat, 25 Jan 1997 17:10:20 +0200 (EET)
- Files: ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs
-
- Title: "Fix $Is_VMS typo in Test::Harness"
- From: Chip Salzenberg
- Files: lib/Test/Harness.pm
-
- Title: "Allow for really big keys in Tie::SubstrHash"
- From: data-drift@so.uio.no
- Msg-ID: <199701282014.VAA12645@selters.uio.no>
- Date: Tue, 28 Jan 1997 21:14:34 +0100 (MET)
- Files: lib/Tie/SubstrHash.pm
-
- Title: "Avoid newRV_noinc() in IO, for compiling with old Perls"
- From: Chip Salzenberg
- Files: ext/IO/IO.xs
-
- TESTS
-
- Title: "New test op/closure.t"
- From: Tom Phoenix, Ulrich Pfeifer
- Files: MANIFEST t/op/closure.t
-
- UTILITIES
-
- Title: "xsubpp handing of void funcs breaks extensions using XST_m*()"
- From: Tim Bunce
- Msg-ID: <9701271659.AA15137@toad.ig.co.uk>
- Date: Mon, 27 Jan 1997 16:59:06 +0000
- Files: lib/ExtUtils/xsubpp
-
- DOCUMENTATION
-
- Title: "perldelta Fcntl enhancement"
- From: Jarkko Hietaniemi
- Msg-ID: <199701251505.RAA22159@alpha.hut.fi>
- Date: Sat, 25 Jan 1997 17:05:34 +0200 (EET)
- Files: pod/perldelta.pod
-
- Title: "Updates to perldelta re: Fcntl, DB_File, Net::Ping"
- From: Paul Marquess
- Files: pod/perldelta.pod
-
- Title: "Document restrictions on gv_fetchmethod() and perl_call_sv()"
- From: Chip Salzenberg
- Files: pod/perldelta.pod pod/perlguts.pod
-
- Title: "perldiag.pod: No comma allowed after %s"
- From: Jarkko.Hietaniemi@cc.hut.fi
- Msg-ID: <199701251541.RAA04120@alpha.hut.fi>
- Date: Sat, 25 Jan 1997 17:41:53 +0200 (EET)
- Files: pod/perldiag.pod
-
- Title: "perlfunc.pod: localtime"
- From: Jarkko Hietaniemi
- Msg-ID: <199701251629.SAA08114@alpha.hut.fi>
- Date: Sat, 25 Jan 1997 18:29:37 +0200 (EET)
- Files: pod/perlfunc.pod
-
- Title: "perlfunc diff: gmtime"
- From: Peter Haworth <pmh@edison.ioppublishing.com>
- Msg-ID: <32EE1298.7B90@edison.ioppublishing.com>
- Date: Tue, 28 Jan 1997 14:52:08 +0000
- Files: pod/perlfunc.pod
-
- Title: "Updates to guts"
- From: Ilya Zakharevich
- Msg-ID: <199701270034.TAA13177@monk.mps.ohio-state.edu>
- Date: Sun, 26 Jan 1997 19:34:18 -0500 (EST)
- Files: pod/perlguts.pod
-
- Title: "perltoot fixes"
- From: Tom Christiansen
- Msg-ID: <6807.854214205@jinete>
- Date: Sat, 25 Jan 1997 09:43:25 -0800
- Files: pod/perltoot.pod
-
- Title: "5.003_23: small typo in perlsyn.pod"
- From: Gurusamy Sarathy
- Msg-ID: <199701270824.DAA01169@aatma.engin.umich.edu>
- Date: Mon, 27 Jan 1997 03:24:25 -0500
- Files: pod/perlsyn.pod
-
-
-----------------
-Version 5.003_23
-----------------
-
-This release is our first candidate for a public beta test.
-
- CORE LANGUAGE CHANGES
-
- Title: "Disallow changing $_[0] in __DIE__ handlers"
- From: Chip Salzenberg
- Files: pod/perlfunc.pod util.c
-
- Title: "Fix overloading with inheritance and AUTOLOAD"
- From: Ilya Zakharevich
- Msg-ID: <199701202226.RAA05072@monk.mps.ohio-state.edu>
- Date: Mon, 20 Jan 1997 17:26:32 -0500 (EST)
- Files: gv.c lib/diagnostics.pm lib/overload.pm pod/perldebug.pod
- pod/perldiag.pod pod/perlfunc.pod pod/perlop.pod
- pod/perlre.pod pod/perltoc.pod pod/perlxs.pod
-
- Title: "Nested here-docs"
- From: larry@wall.org (Larry Wall)
- Msg-ID: <199701202313.PAA11693@wall.org>
- Date: Mon, 20 Jan 1997 15:13:42 -0800
- Files: toke.c
-
- Title: "Revert $^X to old behavior (plus HP-UX bug fix)"
- From: Chip Salzenberg
- Files: hints/hpux.sh toke.c
-
- Title: "Protect against '0' in 'stmt while <HANDLE>'"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Don't warn when closure uses var at file scope"
- From: Chip Salzenberg
- Files: op.c
-
- CORE PORTABILITY
-
- Title: "VMS patches for _22"
- From: Charles Bailey
- Msg-ID: <01IEGBJ2TMYS003PCL@hmivax.humgen.upenn.edu>
- Date: Mon, 20 Jan 1997 22:50:21 -0500 (EST)
- Files: ext/POSIX/POSIX.xs lib/ExtUtils/MM_VMS.pm lib/ExtUtils/xsubpp
- lib/Test/Harness.pm toke.c vms/Makefile vms/descrip.mms
- vms/genconfig.pl vms/perly_c.vms vms/vmsish.h x2p/a2p.h
- vms/Makefile vms/config.vms vms/descrip.mms vms/perly_c.vms
-
- Title: "Re: Perl 5.003_21: OS/2 patches"
- From: Ilya Zakharevich
- Msg-ID: <199701170446.XAA28939@monk.mps.ohio-state.edu>
- Date: Thu, 16 Jan 1997 23:46:40 -0500 (EST)
- Files: os2/Changes os2/os2.c
-
- Title: "Plan9 update"
- From: lutherh@stratcom.com (Luther Huffman)
- Files: plan9/config.plan9 plan9/mkfile
-
- Title: "Bugfixes for AmigaOS"
- From: Norbert Pueschel
- Msg-ID: <77724691@Armageddon.meb.uni-bonn.de>
- Date: Wed, 22 Jan 1997 00:13:54 +0100
- Files: hints/amigaos.sh lib/File/Basename.pm
-
- Title: "New dec_osf.sh hints file"
- From: Achim Bohnet <ach@rosat.mpe-garching.mpg.de>
- Msg-ID: <9701241058.AA29550@o09.rosat.mpe-garching.mpg.de>
- Date: Fri, 24 Jan 1997 11:58:24 +0100
- Files: hints/dec_osf.sh
-
- Title: "on NeXT: gdbm problem fixed"
- From: Andreas Koenig
- Msg-ID: <199701210201.DAA17794@anna.in-berlin.de>
- Date: Tue, 21 Jan 1997 03:01:32 +0100
- Files: hints/next_3.sh hints/next_3_0.sh
-
- Title: "patch for hints/powerux.sh"
- From: tom@amber.ssd.hcsc.com (Tom Horsley)
- Msg-ID: <9701181833.AA02602@amber.ssd.hcsc.com>
- Date: Sat, 18 Jan 97 13:33:26 -0500
- Files: hints/powerux.sh
-
- Title: "hints & Configure changes to build perl on DC/OSx"
- From: Stephen Zander <stephen.zander@interlock.mckesson.com>
- Msg-ID: <199701170043.QAA25985@wsbip1.mckesson.com>
- Date: Thu, 16 Jan 1997 16:43:52 -0800
- Files: Configure MANIFEST hints/dcosx.sh
-
- Title: "patch for hints/cxux.sh perl5.003_22"
- From: tom@amber.ssd.hcsc.com (Tom Horsley)
- Msg-ID: <9701192014.AA05722@amber.ssd.hcsc.com>
- Date: Sun, 19 Jan 97 15:14:04 -0500
- Files: hints/cxux.sh
-
- OTHER CORE CHANGES
-
- Title: "Make PERL5LIB and -I work like C<use lib>"
- From: Tim Bunce
- Msg-ID: <9701231523.AA26613@toad.ig.co.uk>
- Date: Thu, 23 Jan 1997 15:23:27 +0000
- Files: lib/lib.pm perl.c
-
- Title: "Fix /\G.a/"
- From: Chip Salzenberg
- Files: regcomp.c regcomp.h regexec.c regexp.h toke.c
-
- Title: "Extend stack in pp_undef (!)"
- From: Chip Salzenberg
- Files: pp.c
-
- Title: "Allow for sub to be redefined while executing"
- From: Chip Salzenberg
- Files: cop.h pp_hot.c t/op/misc.t
-
- Title: "Eliminate redundant flag CVf_FORMAT"
- From: Chip Salzenberg
- Files: cv.h op.c perl.c perly.c perly.y proto.h sv.c toke.c
-
- Title: "Generate IVs when possible in abs() and int()"
- From: Chip Salzenberg
- Files: pp.c
-
- Title: "Efficiency patchlet for pp_aassign()"
- From: Ilya Zakharevich
- Msg-ID: <199701210305.WAA05451@monk.mps.ohio-state.edu>
- Date: Mon, 20 Jan 1997 22:05:39 -0500 (EST)
- Files: pp_hot.c
-
- Title: "When sorting, promote to PVNV only for built-in comparison"
- From: Chip Salzenberg
- Files: pp_ctl.c
-
- Title: "Remove "suidperl security patch" message"
- From: Chip Salzenberg
- Files: perl.c
-
- BUILD PROCESS
-
- Title: "Make configure.gnu a copy of configure; make configure writea
- From: Chip Salzenberg
- Files: MANIFEST configure.gnu
-
- Title: "Regen Configure with metaconfig: +ARCHNAME, -FILE_filbuf"
- From: Chip Salzenberg and Charles Bailey
- Files: Configure config_H config_h.SH hints/lynxos.sh
- os2/diff.configure os2/os2ish.h plan9/config.plan9 sv.c
- utils/perlbug.PL vms/config.vms vms/fndvers.com
-
- Title: "Compile with optimization when testing memory functions"
- From: Chip Salzenberg
- Files: Configure
-
- Title: "Minor patch for Debian installation"
- From: Chip Salzenberg
- Files: installperl
-
- LIBRARY AND EXTENSIONS
-
- Title: "Debugger update"
- From: Ilya Zakharevich
- Msg-ID: <199701190455.XAA02579@monk.mps.ohio-state.edu>
- Date: Sat, 18 Jan 1997 23:54:59 -0500 (EST)
- Files: lib/perl5db.pl
-
- Title: "DynaLoader enhancement: support RTLD_GLOBAL"
- From: Nick Ing-Simmons
- Msg-ID: <199701240937.JAA11443@pluto.tiuk.ti.com>
- Date: Fri, 24 Jan 1997 09:37:18 GMT
- Files: ext/DynaLoader/DynaLoader.pm ext/DynaLoader/dl_aix.xs
- ext/DynaLoader/dl_dld.xs ext/DynaLoader/dl_dlopen.xs
- ext/DynaLoader/dl_hpux.xs ext/DynaLoader/dl_next.xs
- ext/DynaLoader/dl_vms.xs
-
- Title: "Fcntl: add more constants"
- From: Jarkko.Hietaniemi@cc.hut.fi
- Msg-ID: <199701191811.UAA16346@alpha.hut.fi>
- Date: Sun, 19 Jan 1997 20:11:22 +0200 (EET)
- Files: ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs
-
- Title: "Refresh IO to 1.15 (plus DESTROY and new_tmpfile fixes)"
- From: Chip Salzenberg
- Files: ext/IO/lib/IO/File.pm ext/IO/lib/IO/Handle.pm
- ext/IO/lib/IO/Pipe.pm ext/IO/lib/IO/Seekable.pm
- ext/IO/lib/IO/Socket.pm t/lib/io_pipe.t
-
- Title: "Allow IO.xs to remain at 1.15 while $VERSION is 1.1501"
- From: Chip Salzenberg
- Files: XSUB.h ext/IO/Makefile.PL ext/IO/lib/IO/Handle.pm
-
- Title: "Refresh CPAN to 1.15"
- From: Andreas Koenig
- Files: lib/CPAN.pm lib/CPAN/FirstTime.pm
-
- Title: "Add E* and SA_* constants"
- From: Roderick Schertler
- Msg-ID: <23338.853986967@eeyore.ibcinc.com>
- Date: Wed, 22 Jan 1997 21:36:07 -0500
- Files: ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod ext/POSIX/POSIX.xs
-
- TESTS
-
- Title: "Test nested here-docs"
- From: hv@crypt.compulink.co.uk (Hugo van der Sanden)
- Msg-ID: <199701210053.AAA02139@crypt.compulink.co.uk>
- Date: Tue, 21 Jan 1997 00:53:44 +0000 (GMT)
- Files: t/base/lex.t
-
- Title: "Fix tests of $^X and $0 to work with QNX"
- From: Chip Salzenberg
- Files: t/lib/io_pipe.t t/lib/open2.t t/lib/open3.t t/op/magic.t
-
- Title: "Patch tests for systems without fork()"
- From: Norbert Pueschel
- Msg-ID: <77724697@Armageddon.meb.uni-bonn.de>
- Date: Thu, 23 Jan 1997 23:51:28 +0100
- Files: t/io/pipe.t t/lib/filehand.t t/lib/io_pipe.t t/lib/io_sock.t
- t/lib/open2.t t/lib/open3.t t/op/fork.t
-
- Title: "Test patches for OS/2"
- From: Ilya Zakharevich
- Msg-ID: <199701170448.XAA28948@monk.mps.ohio-state.edu>
- Date: Thu, 16 Jan 1997 23:48:18 -0500 (EST)
- Files: os2/OS2/ExtAttr/t/os2_ea.t os2/OS2/PrfDB/t/os2_prfdb.t
- os2/OS2/REXX/t/rx_cmprt.t os2/OS2/REXX/t/rx_dllld.t
- os2/OS2/REXX/t/rx_objcall.t os2/OS2/REXX/t/rx_sql.test
- os2/OS2/REXX/t/rx_tiesql.test os2/OS2/REXX/t/rx_tievar.t
- os2/OS2/REXX/t/rx_tieydb.t os2/OS2/REXX/t/rx_varset.t
- os2/OS2/REXX/t/rx_vrexx.t t/README t/cmd/while.t
- t/comp/colon.t t/comp/multiline.t t/io/argv.t t/lib/anydbm.t
- t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t t/lib/sdbm.t
- t/op/cmp.t t/op/magic.t
-
- UTILITIES
-
- Title: "Translate \200 to &#200; in pod2html"
- From: Chip Salzenberg
- Files: pod/pod2html.PL
-
- Title: "VMS patches: '.com' extension on scripts"
- From: Charles Bailey
- Msg-ID: <01IELNPDLYJM003E7J@hmivax.humgen.upenn.edu>
- Date: Fri, 24 Jan 1997 18:42:29 -0500 (EST)
- Files: pod/checkpods.PL pod/pod2html.PL pod/pod2latex.PL
- pod/pod2man.PL pod/pod2text.PL utils/c2ph.PL utils/h2ph.PL
- utils/h2xs.PL utils/perlbug.PL utils/perldoc.PL
- utils/pl2pm.PL utils/splain.PL vms/Makefile vms/descrip.mms
- x2p/find2perl.PL x2p/s2p.PL
-
- Title: "Allow MakeMaker 5.34 to use libraries containing '+' in name"
- From: dennism@cyrix.com (Dennis Marsa)
- Msg-ID: <9701172027.AA27861@orion.cyrix.com>
- Date: Fri, 17 Jan 97 14:27:32 CST
- Files: lib/ExtUtils/Liblist.pm
-
- DOCUMENTATION
-
- Title: "First cut at INSTALL edit"
- From: Chip Salzenberg
- Files: INSTALL
-
- Title: "Additional docs for __DIE__ and __WARN__"
- From: Gurusamy Sarathy
- Files: pod/perlfunc.pod pod/perlrun.pod pod/perlvar.pod
-
- Title: "Document #line directive"
- From: Gurusamy Sarathy
- Msg-ID: <199701240908.EAA23846@aatma.engin.umich.edu>
- Date: Fri, 24 Jan 1997 04:08:44 -0500
- Files: pod/perlsyn.pod pod/perltoc.pod
-
- Title: "Perlguts version 30"
- From: Jeff Okamoto
- Msg-ID: <199701172117.AA116515863@hpcc123.corp.hp.com>
- Date: Fri, 17 Jan 1997 13:17:43 -0800
- Files: pod/perlguts.pod
-
- Title: "delta for perldelta"
- From: Tom Christiansen
- Msg-ID: <804.854121463@jinete>
- Date: Fri, 24 Jan 1997 07:57:43 -0800
- Files: pod/perlnews.pod pod/perltoc.pod
-
- Title: "Updates to perldelta"
- From: Ilya Zakharevich
- Msg-ID: <199701211610.LAA06227@monk.mps.ohio-state.edu>
- Date: Mon, 20 Jan 1997 06:48:49 -0500 (EST)
- Files: pod/perlnews.pod pod/perltoc.pod
-
- Title: "perlnews.pod diff for the Fcntl"
- From: Jarkko Hietaniemi
- Msg-ID: <199701211600.SAA30117@alpha.hut.fi>
- Date: Tue, 21 Jan 1997 18:00:56 +0200 (EET)
- Files: pod/perlnews.pod
-
- Title: "Rename perlnews -> perldelta per Tom's request"
- From: Chip Salzenberg
- Files: MANIFEST pod/Makefile pod/buildtoc pod/perl.pod
- pod/perldelta.pod pod/perltoc.pod pod/roffitall
-
- Title: "Remove bad advice from perllocale.pod"
- From: Chip Salzenberg
- Files: pod/perllocale.pod
-
-
-----------------
-Version 5.003_22
-----------------
-
-This release is primarily made up of bug fixes, the foremost among
-which repairs a showstopper memory corruption bug in formats.
-
- CORE LANGUAGE CHANGES
-
- Title: "Fix parsing of C< ${ xyz } >"
- From: Chip Salzenberg
- Files: toke.c
-
- Title: "Don't parse method calls in strings"
- From: Chip Salzenberg
- Files: toke.c
-
- Title: "Fix overly picky carping about leading '{' in regex"
- From: Chip Salzenberg
- Files: regcomp.c
-
- OTHER CORE CHANGES
-
- Title: "Fix memory corruption from formats"
- From: Chip Salzenberg
- Files: op.c perl.c perly.c perly.c.diff perly.y proto.h sv.c toke.c
-
- BUILD PROCESS
-
- Title: "Fix '_mopop' typo"
- From: Chip Salzenberg
- Files: Makefile.SH
-
- LIBRARY AND EXTENSIONS
-
- Title: "Gut IO::Handle::DESTROY"
- From: Chip Salzenberg
- Files: ext/IO/lib/IO/Handle.pm
-
- Title: "RiscOS is case-insensitive"
- From: Chip Salzenberg
- Files: lib/File/Basename.pm
-
- TESTS
-
- Title: "Fix thinko in db-recno.t"
- From: Chip Salzenberg
- Files: t/lib/db-recno.t
-
- UTILITIES
-
- Title: "Make perlbug more cautionary and more verbose"
- From: Kenneth Albanowski and Jarkko Hietaniemi
- Files: utils/perlbug.PL
-
- DOCUMENTATION
-
- Title: "NEW roffitall + INSTALL fix"
- From: Raphael Manfredi <Raphael_Manfredi@grenoble.hp.com>
- Msg-ID: <6058.853410121@lyon.grenoble.hp.com>
- Date: Thu, 16 Jan 97 11:22:01 +0100
- Files: INSTALL pod/roffitall
-
- Title: "srand() doc update"
- From: Roderick Schertler
- Msg-ID: <24195.853379065@eeyore.ibcinc.com>
- Date: Wed, 15 Jan 1997 20:44:25 -0500
- Files: pod/perlfunc.pod
-
- Title: "documentation of configpm (perl5.003_20)"
- From: win@in.rhein-main.de (Winfried Koenig)
- Msg-ID: <m0vkU40-0004WAC@incom.rhein-main.de>
- Date: Wed, 15 Jan 1997 14:03:27 +0200 (EET)
- Files: configpm
-
-
-----------------
-Version 5.003_21
-----------------
-
-This release includes several important bug fixes, and a couple of
-minor but valuable language tweaks. Please read on for a list of the
-significant changes:
-
- CORE LANGUAGE CHANGES
-
- Title: "Fix overloading via inherited autoloaded functions"
- From: Ilya Zakharevich
- Msg-ID: <199701131022.FAA22830@monk.mps.ohio-state.edu>
- Date: Mon, 13 Jan 1997 05:22:47 -0500 (EST)
- Files: gv.c lib/overload.pm pod/perldiag.pod t/pragma/overload.t
-
- Title: "Method call fixes: Don't cache in alias, don't skip undef"
- From: Chip Salzenberg
- Files: global.sym gv.c gv.h hv.c op.c pod/perlguts.pod
- pod/perltoc.pod pp.c pp_ctl.c pp_hot.c proto.h scope.c sv.c
- t/op/method.t
-
- Title: "Formats can be closures"
- From: Chip Salzenberg
- Files: cv.h op.c perly.c perly.c.diff perly.y pp_sys.c sv.h
-
- Title: "Quote 'foo' in C<$x{-foo}>"
- From: Chip Salzenberg
- Files: toke.c
-
- Title: "Forbid C< x->{y} > and C< x->[0] > under C<strict refs>"
- From: Chip Salzenberg
- Files: op.c pod/perldiag.pod t/pragma/strict-refs
-
- Title: "Allow <=> to return undef when operands are not ordered"
- From: Chip Salzenberg and Andreas Koenig
- Files: MANIFEST pp.c t/op/cmp.t
-
- Title: "Fail regex that starts with '{'"
- From: Chip Salzenberg
- Files: regcomp.c
-
- CORE PORTABILITY
-
- Title: "Re: Perl 5.003_20: OS/2 patches"
- From: Ilya Zakharevich
- Msg-ID: <199701101102.GAA19051@monk.mps.ohio-state.edu>
- Date: Fri, 10 Jan 1997 06:02:16 -0500 (EST)
- Files: hints/os2.sh os2/Changes os2/os2.c os2/os2ish.h pp_sys.c
-
- Title: "VMS patches for _20"
- From: Charles Bailey
- Msg-ID: <01IE7MGK7ULQ003K5M@hmivax.humgen.upenn.edu>
- Date: Tue, 14 Jan 1997 17:34:43 -0500 (EST)
- Files: configpm dosish.h os2/os2ish.h plan9/plan9ish.h proto.h
- t/pragma/strict.t t/pragma/subs.t t/pragma/warning.t toke.c
- unixish.h vms/Makefile vms/config.vms vms/descrip.mms
- vms/genconfig.pl vms/perly_c.vms vms/test.com vms/vmsish.h
- x2p/a2p.h x2p/str.c
-
- Title: "Irix 6.3 & 6.4 and perl5.003_20"
- From: John Stoffel <jfs@fluent.com>
- Msg-ID: <199701132242.RAA14601@jfs.Fluent.COM>
- Date: Mon, 13 Jan 1997 17:42:50 -0500 (EST)
- Files: MANIFEST hints/irix_6_3.sh hints/irix_6_4.sh
-
- Title: "Patch: MachTen hints, Configure"
- From: Dominic Dunlop <domo@slipper.ip.lu>
- Msg-ID: <v03010d00af0123a93670@[194.51.248.75]>
- Date: Tue, 14 Jan 1997 13:43:13 +0100
- Files: Configure hints/machten.sh
-
- Title: "Rename aux.sh to aux_3.sh for MS-LOSS"
- From: Chip Salzenberg
- Files: MANIFEST hints/aux_3.sh
-
- OTHER CORE CHANGES
-
- Title: "Fix C< eval { my $x; eval '$x' } >"
- From: Chip Salzenberg
- Files: op.c t/op/misc.t
-
- Title: "Don't warn if eval '' uses outer func's lexicals"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Avoid memory wastage in wait(); make pidstatus global"
- From: Chip Salzenberg
- Files: global.sym interp.sym perl.c perl.h pp_sys.c
-
- Title: "Forbid ++ and -- on readonly values"
- From: "John Q. Linux" <jql@accessone.com>
- Msg-ID: <Pine.LNX.3.95.970110193330.11249D-100000@jql.accessone.com>
- Date: Fri, 10 Jan 1997 19:47:16 -0800 (PST)
- Files: pp.c pp_hot.c
-
- Title: "Keep array from dying during foreach(@array)"
- From: Chip Salzenberg
- Files: cop.h pp_ctl.c
-
- Title: "Fix C< $a="simple"; split /($a)/o >"
- From: Chip Salzenberg
- Files: pp.c t/op/misc.t
-
- Title: "Fix infinite loop for undef function in @SIG{__WARN__,__DIE__}"
- From: Chip Salzenberg
- Files: util.c
-
- Title: "Fix for anon-lists with tied entries coredump"
- From: Gurusamy Sarathy
- Msg-ID: <199701100745.CAA13057@aatma.engin.umich.edu>
- Date: Fri, 10 Jan 1997 02:45:11 -0500
- Files: pp.c
-
- Title: "Don't set SVf_PADBUSY on immortal SVs"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Patch for Object subroutines"
- From: Ilya Zakharevich
- Msg-ID: <199701080156.UAA15366@monk.mps.ohio-state.edu>
- Date: Tue, 7 Jan 1997 20:56:02 -0500 (EST)
- Files: cop.h
-
- Title: "Use an SVt_PVLV to hold stacked OP pointers when debugging"
- From: Chip Salzenberg
- Files: pp.c pp_hot.c
-
- Title: "Undo change that freed large pad vars"
- From: Chip Salzenberg
- Files: scope.c
-
- BUILD PROCESS
-
- Title: "Make MachTen hints file warn about db-recno failures"
- From: Dominic Dunlop <domo@slipper.ip.lu>
- Msg-ID: <v03010d00aef92fba6aca@[194.51.248.78]>
- Date: Wed, 8 Jan 1997 12:07:18 +0100
- Files: hints/machten.sh
-
- Title: "5.003_20, FreeBSD 3.0 and minor patch"
- From: roberto@eurocontrol.fr (Ollivier Robert)
- Msg-ID: <Mutt.19970108143747.roberto@caerdonn.eurocontrol.fr>
- Date: Wed, 8 Jan 1997 14:37:47 +0100
- Files: Configure
-
- Title: "Make installperl quieter; only shared libraries need 0555"
- From: Chip Salzenberg
- Files: installperl
-
- TESTS
-
- Title: "Advice on TEST failure"
- From: Dominic Dunlop <domo@slipper.ip.lu>
- Msg-ID: <v03010d01aefbaefcf3bc@[194.51.248.78]>
- Date: Fri, 10 Jan 1997 10:19:07 +0100
- Files: t/TEST
-
- Title: "UNIVERSAL tests"
- From: Roderick Schertler
- Files: MANIFEST t/op/universal.t
-
- Title: "Test deletion of array during foreach"
- From: Jarkko Hietaniemi
- Files: t/op/misc.t
-
- Title: "patch for db-recno.t"
- From: Paul Marquess
- Msg-ID: <9701121509.AA11147@claudius.bfsec.bt.co.uk>
- Date: Sun, 12 Jan 1997 15:09:33 +0000 (GMT)
- Files: t/lib/db-recno.t
-
- LIBRARY AND EXTENSIONS
-
- Title: "Localize info about filesystems being case-forgiving"
- From: Chip Salzenberg
- Files: lib/File/Basename.pm pod/checkpods.PL pod/pod2html.PL
- pod/pod2latex.PL pod/pod2man.PL pod/pod2text.PL
- utils/c2ph.PL utils/h2ph.PL utils/h2xs.PL utils/perlbug.PL
- utils/perldoc.PL utils/pl2pm.PL utils/splain.PL
- x2p/find2perl.PL x2p/s2p.PL
-
- Title: "Fix for fd leak in IO::File::new_tmpfile"
- From: Graham Barr and Chip Salzenberg
- Files: ext/IO/IO.xs ext/IO/lib/IO/Handle.pm
-
- Title: "Refresh Getopt::Long to 2.6"
- From: Johan Vromans <jvromans@squirrel.nl>
- Files: lib/Getopt/Long.pm
-
- Title: "Refresh DB_File to 1.10"
- From: Paul Marquess
- Msg-ID: <9701141247.AA21242@claudius.bfsec.bt.co.uk>
- Date: Tue, 14 Jan 97 12:47:40 GMT
- Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs
-
- Title: "Re: FileCache::cacheout clobbers $_"
- From: Roderick Schertler
- Msg-ID: <pz3ewb3189.fsf@eeyore.ibcinc.com>
- Date: 08 Jan 1997 23:45:58 -0500
- Files: lib/FileCache.pm lib/cacheout.pl
-
- Title: "PATCH: AutoSplit"
- From: Graham Barr
- Msg-ID: <9603111010.AA29935@tiuk.ti.com>
- Date: 11 Mar 1996 06:01:58 -0500
- Files: lib/AutoSplit.pm
-
- Title: "Re: Uninitialized value in Carp.pm ? "
- From: Gurusamy Sarathy
- Msg-ID: <199701141815.NAA07960@aatma.engin.umich.edu>
- Date: Tue, 14 Jan 1997 13:15:25 -0500
- Files: lib/Carp.pm
-
- Title: "Avoid "uninitialized" warnings from POSIX::constant()"
- From: Chip Salzenberg
- Files: ext/POSIX/POSIX.pm
-
- Title: "Eliminate warning from C<use overload>"
- From: Chip Salzenberg
- Files: lib/overload.pm
-
- Title: "low priority patches"
- From: Paul Marquess
- Msg-ID: <9701081655.AA27349@claudius.bfsec.bt.co.uk>
- Date: Wed, 8 Jan 97 16:55:02 GMT
- Files: lib/Cwd.pm t/comp/redef.t t/lib/db-btree.t
-
- UTILITIES
-
- Title: "Re: xsubpp and Tk ==> segfault"
- From: Ilya Zakharevich
- Msg-ID: <199701080825.DAA15813@monk.mps.ohio-state.edu>
- Date: Wed, 8 Jan 1997 03:25:47 -0500 (EST)
- Files: lib/ExtUtils/xsubpp
-
- Title: "Re: MakeMaker and 'make uninstall'"
- From: Andreas Koenig
- Msg-ID: <199701101243.NAA26400@anna.in-berlin.de>
- Date: Fri, 10 Jan 1997 13:43:39 +0100
- Files: lib/ExtUtils/MM_Unix.pm
-
- Title: "Don't search for pod if path is already valid"
- From: Wayne Scott <wscott@ichips.intel.com>
- Msg-ID: <199701082325.PAA04521@pdxlx008.intel.com>
- Date: Wed, 08 Jan 1997 15:25:19 -0800
- Files: utils/perldoc.PL
-
- Title: "Yet another perldoc option"
- From: Gisle Aas
- Msg-ID: <199610022200.AAA15334@furubotn.sn.no>
- Date: Thu, 3 Oct 1996 00:00:35 +0200
- Files: utils/perldoc.PL
-
- Title: "Re: perldoc, temp files, async pagers"
- From: Roderick Schertler
- Msg-ID: <pzwwtoom8p.fsf@eeyore.ibcinc.com>
- Date: 07 Jan 1997 22:54:14 -0500
- Files: utils/perldoc.PL
-
- DOCUMENTATION
-
- Title: "Full documentation generation patch"
- From: Raphael Manfredi <Raphael_Manfredi@grenoble.hp.com>
- Msg-ID: <15309.853323388@lyon.grenoble.hp.com>
- Date: Wed, 15 Jan 97 11:16:28 +0100
- Files: MANIFEST pod/roffitall pod/rofftoc
-
- Title: "Re: documentation correction (i.e. patch) for perlsyn.pod"
- From: "M.J.T. Guy"
- Msg-ID: <E0vilLh-0000M6-00@ursa.cus.cam.ac.uk>
- Date: Fri, 10 Jan 1997 18:06:37 +0000
- Files: pod/perlsyn.pod
-
- Title: "Document use of pos() and /\G/"
- From: Gurusamy Sarathy
- Msg-ID: <199701132013.PAA26606@aatma.engin.umich.edu>
- Date: Mon, 13 Jan 1997 15:13:12 -0500
- Files: pod/perlfunc.pod pod/perlnews.pod pod/perlop.pod
- pod/perlre.pod pod/perltoc.pod pod/perltrap.pod
-
- Title: "Fix example #4 in perlXStut"
- From: Ilya Zakharevich
- Msg-ID: <199701050739.CAA11112@monk.mps.ohio-state.edu>
- Date: Sun, 5 Jan 1997 02:39:45 -0500 (EST)
- Files: pod/perlxstut.pod
-
- Title: "Document new closure warnings"
- From: Chip Salzenberg
- Files: op.c pod/perldiag.pod
-
- Title: "Misc. doc patches missing in _20"
- From: Roderick Schertler
- Msg-ID: <102.852695733@eeyore.ibcinc.com>
- Date: Tue, 07 Jan 1997 22:55:33 -0500
- Files: pod/perlsub.pod pod/perltoc.pod pod/perlvar.pod
-
-
-----------------
-Version 5.003_20
-----------------
-
-The only language change in this release is the recension of support
-for named closures: Now, no subroutine declared "sub foo {}" can be
-a closure. (This is a return to the behavior of 5.003.) In addition,
-there are new warnings triggered by any apparent attempt to use named
-functions as closures.
-
-And, as usual, there are the usual little fixes, documentation
-updates, and expanded tests. This is good stuff. "I love you, man!"
-
- CORE LANGUAGE CHANGES
-
- Title: "Rescind named closures"
- From: Chip Salzenberg
- Files: Makefile.SH op.c perly.c perly.c.diff perly.y pp_hot.c
-
- Title: "Fix: empty @_ when calling empty-proto subs without parens"
- From: Graham Barr
- Msg-ID: <32CE30F0.7E8425A5@tiuk.ti.com>
- Date: Sat, 04 Jan 1997 10:29:04 +0000
- Files: perly.c perly.y
-
- CORE PORTABILITY
-
- Title: "Fix $^X on systems that set it to Perl's basename"
- From: Chip Salzenberg
- Files: hints/hpux.sh toke.c
-
- Title: "Configure/perl5/Compartmented Mode Workstation (fwd)"
- From: Andy Dougherty
- Msg-ID: <Pine.SOL.3.95.970106131505.1662C-100000@fractal.lafayette.ed
- Date: Mon, 06 Jan 1997 13:15:38 -0500 (EST)
- Files: Configure hints/dec_osf.sh
-
- Title: "Remove obsolete file "dl_os2.xs"."
- From: Ilya Zakharevich
- Files: MANIFEST
-
- OTHER CORE CHANGES
-
- Title: "Fix C< sub foo (&@); sub bar (&); foo {}, bar {}, bar {} >"
- From: Chip Salzenberg
- Files: perly.c perly.c.diff perly.y
-
- Title: "plug for safe/opcode leaks"
- From: Doug MacEachern
- Msg-ID: <199701072220.RAA02117@postman.osf.org>
- Date: Tue, 07 Jan 1997 17:20:46 -0500
- Files: op.c
-
- Title: "Finish OP= warnings: none on ^="
- From: Chip Salzenberg
- Files: doop.c pp.c t/op/assignwarn.t
-
- Title: "Fix Dynaloader failures with DProf"
- From: Gurusamy Sarathy
- Msg-ID: <199701061718.MAA26909@aatma.engin.umich.edu>
- Date: Mon, 06 Jan 1997 12:18:46 -0500
- Files: pp_hot.c
-
- BUILD PROCESS
-
- Title: "Make Configure default to the first domain in /etc/resolv.conf"
- From: Chip Salzenberg
- Files: Configure
-
- Title: "Start all helper scripts with $startsh"
- From: Chip Salzenberg
- Files: Configure
-
- Title: "Support libperl.so under FreeBSD"
- From: roberto@keltia.freenix.fr (Ollivier Robert)
- Msg-ID: <Mutt.19970105224149.roberto@keltia.freenix.fr>
- Date: Sun, 5 Jan 1997 22:41:49 +0100
- Files: Configure Makefile.SH
-
- TESTS
-
- Title: "New test: comp/proto.t"
- From: Graham Barr
- Msg-ID: <32D0C21F.3FB28D51@tiuk.ti.com>
- Date: Mon, 06 Jan 1997 09:13:03 +0000
- Files: MANIFEST t/comp/proto.t
-
- Title: "More magic variable tests"
- From: Roderick Schertler
- Msg-ID: <7043.852565192@eeyore.ibcinc.com>
- Date: Mon, 06 Jan 1997 10:39:52 -0500
- Files: t/harness t/op/magic.t
-
- LIBRARY AND EXTENSIONS
-
- Title: "File::Basename::dirname bugs"
- From: Robin Barker <rmb@cise.npl.co.uk>
- Msg-ID: <12393.9701071719@tempest.cise.npl.co.uk>
- Date: Tue, 7 Jan 97 17:19:59 GMT
- Files: lib/File/Basename.pm t/lib/basename.t
-
- Title: "sigaction() problems"
- From: Roderick Schertler
- Msg-ID: <12808.852583324@eeyore.ibcinc.com>
- Date: Mon, 06 Jan 1997 15:42:04 -0500
- Files: ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod
-
- Title: "Fix importation of FileHandle methods; fix POSIX docs"
- From: Chip Salzenberg
- Files: ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod lib/FileHandle.pm
-
- Title: "Patch: make hints files warn about db-recno failures"
- From: Dominic Dunlop <domo@slipper.ip.lu>
- Msg-ID: <v03010d00aef53ac4d18a@[194.51.248.68]>
- Date: Sun, 5 Jan 1997 12:34:25 +0100
- Files: MANIFEST hints/aux.sh hints/broken-db.msg hints/freebsd.sh
-
- UTILITIES
-
- Title: "pod2html.PL patch (for 5.003-19)"
- From: Fabien TASSIN <tassin@eerie.fr>
- Msg-ID: <199701052347.AAA21297@solar5>
- Date: Mon, 6 Jan 1997 00:47:01 +0100
- Files: pod/pod2html.PL
-
- DOCUMENTATION
-
- Title: "tiny doc patches"
- From: Roderick Schertler
- Msg-ID: <23338.852394333@eeyore.ibcinc.com>
- Date: Sat, 04 Jan 1997 11:12:13 -0500
- Files: pod/perlapio.pod pod/perlnews.pod pod/perltoc.pod
-
- Title: "doc patch for defined on perlfunc.pod"
- From: Roderick Schertler
- Msg-ID: <pz91686ek1.fsf@eeyore.ibcinc.com>
- Date: 04 Jan 1997 21:28:30 -0500
- Files: pod/perlfunc.pod
-
- Title: "doc patch: perldsc"
- From: Roderick Schertler
- Msg-ID: <pzafqo6eo9.fsf@eeyore.ibcinc.com>
- Date: 04 Jan 1997 21:25:58 -0500
- Files: pod/perldsc.pod pod/perltoc.pod
-
- Title: "Re: constant function inlining"
- From: Roderick Schertler
- Msg-ID: <pzk9pp1b95.fsf@eeyore.ibcinc.com>
- Date: 07 Jan 1997 15:27:50 -0500
- Files: pod/perldiag.pod pod/perlsub.pod
-
- Title: "scalar caller doc fix"
- From: Roderick Schertler
- Msg-ID: <18245.852608060@eeyore.ibcinc.com>
- Date: Mon, 06 Jan 1997 22:34:20 -0500
- Files: pod/perlfunc.pod
-
- Title: "perlpod.pod possible patches"
- From: lvirden@cas.org (Larry W. Virden, x2487)
- Msg-ID: <9701070756.AA1185@cas.org>
- Date: Tue, 7 Jan 1997 07:56:30 -0500
- Files: pod/perlpod.pod
-
- Title: "Misc perlfunc updates"
- From: Tom Christiansen
- Files: pod/perlfunc.pod pod/perltoc.pod
-
-
-----------------
-Version 5.003_19
-----------------
-
-Lots of internal cleanup in this patch, especially plugged memory
-leaks when embedded Perl interpreters shut down and restart. The
-method cache is now invisible to user code. And there is a new test
-directory, "t/pragma".
-
-IMHO, this is Beta quality code.
-
-Here's a list of the more significant changes...
-
- CORE LANGUAGE CHANGES
-
- Title: "Make method cache invisible to user code"
- From: Chip Salzenberg
- Files: dump.c gv.c gv.h hv.c op.c perl.c pp_hot.c pp_sys.c sv.c
- toke.c
-
- Title: "Never parse "{m,s,y,tr,q{,q,w,x}}:{,:}" as package or label"
- From: Chip Salzenberg
- Files: toke.c
-
- CORE PORTABILITY
-
- Title: "Fix $^X under HP-UX"
- From: Chip Salzenberg
- Files: hints/hpux.sh toke.c
-
- Title: "New hints/hpux.sh"
- From: Jeff Okamoto
- Msg-ID: <199612312309.AA283393772@hpcc123.corp.hp.com>
- Date: Tue, 31 Dec 1996 15:09:32 -0800
- Files: hints/hpux.sh
-
- OTHER CORE CHANGES
-
- Title: "Fix segv when calling named closures"
- From: Chip Salzenberg
- Files: pp_hot.c
-
- Title: "Finish rationalizing "undef value" warnings"
- From: Chip Salzenberg
- Files: doop.c pp.c sv.c t/op/assignwarn.t
-
- Title: "Arrange for all "_<file" entries to be in %main::"
- From: Chip Salzenberg
- Files: gv.c lib/perl5db.pl
-
- Title: "Introduce CVf_NODEBUG flag"
- From: Gurusamy Sarathy
- Msg-ID: <199701012042.PAA25994@aatma.engin.umich.edu>
- Date: Wed, 01 Jan 1997 15:42:05 -0500
- Files: cv.h pp_hot.c
-
- Title: "Reword 'may be "0"' warning per Larry; fix its line number"
- From: Chip Salzenberg
- Files: op.c pod/perldiag.pod
-
- Title: "5.003_18: perl_{con,des}truct fixes"
- From: Doug MacEachern
- Msg-ID: <199701032042.PAA06766@postman.osf.org>
- Date: Fri, 03 Jan 1997 15:42:04 -0500
- Files: perl.c perl.h pod/perlembed.pod pod/perltoc.pod t/op/sysio.t
-
- Title: "Fix lost value from READLINE after TIEHANDLE"
- From: Gurusamy Sarathy
- Files: pp_hot.c sv.h
-
- Title: "Free memory of large lexical variables when leaving scope"
- From: Chip Salzenberg
- Files: scope.c
-
- TESTS
-
- Title: "Create t/pragma directory; populate with new and old"
- From: Paul Marquess
- Files: MANIFEST Makefile.SH t/TEST t/comp/use.t t/lib/locale.t
- t/op/overload.t t/op/use.t t/pragma/locale.t t/pragma/overload.t
- t/pragma/strict-refs t/pragma/strict-subs t/pragma/strict-vars
- t/pragma/strict.t t/pragma/subs.t t/pragma/warn-global
- t/pragma/warning.t
-
- Title: "New tests: comp/colon.t and op/assignwarn.t"
- From: Robin Barker <rmb@cise.npl.co.uk>
- Files: MANIFEST t/comp/colon.t t/op/assignwarn.t
-
- LIBRARY AND EXTENSIONS
-
- Title: "Make libs clean under '-w'"
- From: Jarkko Hietaniemi
- Files: lib/AutoSplit.pm lib/Devel/SelfStubber.pm lib/Env.pm
- lib/Math/Complex.pm lib/Pod/Functions.pm lib/Search/Dict.pm
- lib/SelfLoader.pm lib/Term/Complete.pm lib/chat2.pl
- lib/complete.pl lib/diagnostics.pm lib/ftp.pl lib/termcap.pl
- lib/validate.pl
-
- DOCUMENTATION
-
- Title: "Perlguts, version 28"
- From: Jeff Okamoto
- Msg-ID: <199701032110.AA102535846@hpcc123.corp.hp.com>
- Date: Fri, 3 Jan 1997 13:10:46 -0800
- Files: pod/perlguts.pod
-
- Title: "Re: perldelta, take 3"
- From: Tim Bunce
- Msg-ID: <9701031748.AA15335@toad.ig.co.uk>
- Date: Fri, 3 Jan 1997 17:48:46 +0000
- Files: pod/perlnews.pod
-
- Title: "Miscellaneous pod patches"
- From: Ralf S. Engelschall <rse@engelschall.com>
- Files: pod/Makefile pod/perldebug.pod pod/perlfunc.pod
- pod/perlguts.pod
-
- Title: "expanded flock() docs"
- From: Roderick Schertler
- Msg-ID: <4481.852337871@eeyore.ibcinc.com>
- Date: Fri, 03 Jan 1997 19:31:11 -0500
- Files: pod/perlfunc.pod
-
- Title: "Use Text::Wrap in buildtoc; run buildtoc"
- From: Ulrich Pfeifer
- Files: pod/buildtoc pod/perltoc.pod
-
- Title: "Remove obsolete perlovl.pod"
- From: Chip Salzenberg
- Files: MANIFEST plan9/mkfile pod/perlovl.pod vms/Makefile
- vms/descrip.mms
-
+____________________________________________________________________________
+[ 1063] By: mbeattie on 1998/05/29 15:19:55
+ Log: Remove duplicate win32/TEST line from MANIFEST.
+ Branch: perl
+ ! MANIFEST
+____________________________________________________________________________
+[ 1062] By: mbeattie on 1998/05/29 15:18:33
+ Log: Add missing ";" to pp_umask (spotted by Jarkko Hietaniemi).
+ Branch: perl
+ ! pp_sys.c
+____________________________________________________________________________
+[ 1061] By: mbeattie on 1998/05/29 12:02:17
+ Log: Integrate from win32 branch into mainline (this now pulls in the
+ asperl stuff).
+ Branch: perl
+ +> ObjXSub.h XSLock.h ipdir.h ipenv.h iplio.h ipmem.h ipproc.h
+ +> ipsock.h ipstdio.h objpp.h t/lib/h2ph.h t/lib/h2ph.pht
+ +> t/lib/h2ph.t win32/GenCAPI.pl
+ !> (integrate 104 files)
+____________________________________________________________________________
+[ 1060] By: gsar on 1998/05/29 11:05:50
+ Log: reverse integrate asperl branch contents (phew!)
+ - various fixups to ensure AS stuff does no harm
+ - adjust win32/makefiles for the new directory layout (new layout
+ looks rather a muddle--needs rework)
+ - verified build & test on NT and Solaris/gcc
+ Branch: win32/perl
+ +> ObjXSub.h XSLock.h ipdir.h ipenv.h iplio.h ipmem.h ipproc.h
+ +> ipsock.h ipstdio.h objpp.h win32/GenCAPI.pl
+ ! ext/POSIX/POSIX.xs lib/ExtUtils/Mksymlists.pm win32/Makefile
+ ! win32/config.bc win32/config.gc win32/config.vc
+ ! win32/config_H.bc win32/config_H.gc win32/config_H.vc
+ ! win32/makefile.mk
+ !> (integrate 77 files)
+____________________________________________________________________________
+[ 1059] By: gsar on 1998/05/29 08:33:56
+ Log: asperl branch verified to build w/o PERL_OBJECT on Solaris and NT
+ Branch: asperl
+ ! util.c
+____________________________________________________________________________
+[ 1058] By: gsar on 1998/05/29 08:31:09
+ Log: type xtext for *.t that were missing it
+ Branch: asperl
+ ! t/lib/thread.t t/op/nothread.t
+____________________________________________________________________________
+[ 1057] By: gsar on 1998/05/29 08:28:46
+ Log: stray t/op/ipc*.t fixups
+ Branch: win32/perl
+ ! t/op/ipcmsg.t t/op/ipcsem.t
+____________________________________________________________________________
+[ 1056] By: gsar on 1998/05/29 07:41:49
+ Log: fixups to make it build and pass tests under both compilers
+ Branch: asperl
+ ! ObjXSub.h objpp.h proto.h
+____________________________________________________________________________
+[ 1055] By: gsar on 1998/05/29 07:22:51
+ Log: integrate mainline changes
+ Branch: asperl
+ +> t/lib/h2ph.h t/lib/h2ph.pht t/lib/h2ph.t
+ !> (integrate 69 files)
+ Branch: win32/perl
+ ! Todo.5.005 pod/perldelta.pod
+____________________________________________________________________________
+[ 1054] By: gsar on 1998/05/29 05:04:03
+ Log: add a txt_compare() routine to t/h2ph.t for DOSISH sanity
+ Branch: win32/perl
+ ! t/lib/h2ph.t
+____________________________________________________________________________
+[ 1053] By: gsar on 1998/05/29 05:01:54
+ Log: misc changes
+ - remove code that works around lack of I_STDARG (we're a happy ANSI family)
+ - leave dump_foo() stubs when not -DDEBUGGING for consistent symbol exports
+ Branch: win32/perl
+ ! deb.c dump.c ext/DynaLoader/dlutils.c ext/POSIX/POSIX.xs
+ ! perl.h perlio.c proto.h regcomp.c run.c scope.c sv.c util.c
+ ! x2p/util.c x2p/util.h
+____________________________________________________________________________
+[ 1052] By: gsar on 1998/05/29 02:31:44
+ Log: merge changes#1014,1038 from maintbranch
+ Branch: win32/perl
+ + t/lib/h2ph.h t/lib/h2ph.pht t/lib/h2ph.t
+ ! MANIFEST Makefile.SH doio.c ext/POSIX/POSIX.xs gv.c
+ ! lib/Benchmark.pm lib/ExtUtils/MM_Unix.pm pod/perldebug.pod
+ ! pod/perldiag.pod pod/perlfunc.pod pod/perlop.pod
+ ! pod/perlre.pod pod/perltie.pod pod/perltrap.pod sv.c
+ ! t/io/pipe.t utils/h2ph.PL
+____________________________________________________________________________
+[ 1051] By: gsar on 1998/05/29 01:38:51
+ Log: regenerate win32/config_H.?c
+ Branch: win32/perl
+ ! win32/config_H.bc win32/config_H.gc win32/config_H.vc
+____________________________________________________________________________
+[ 1050] By: gsar on 1998/05/29 01:32:41
+ Log: integrate mainline
+ Branch: win32/perl
+ ! win32/Makefile win32/makefile.mk
+ !> Configure INSTALL MANIFEST Porting/Glossary Porting/config.sh
+ !> Porting/config_H Porting/patching.pod config_h.SH doio.c
+ !> ext/POSIX/hints/sunos_4.pl hints/bsdos.sh hints/openbsd.sh
+ !> hints/solaris_2.sh hints/sunos_4_1.sh hints/svr4.sh
+ !> lib/FileHandle.pm patchlevel.h perl.h plan9/config.plan9
+ !> vms/config.vms win32/config.bc win32/config.gc win32/config.vc
+____________________________________________________________________________
+[ 1049] By: gsar on 1998/05/29 00:57:05
+ Log: fix various shenanigans with C<environ>, BC and VC builds now pass
+ all tests
+ Branch: asperl
+ ! globals.c win32/Makefile win32/makefile.mk win32/runperl.c
+ ! win32/win32.h win32/win32iop.h
+____________________________________________________________________________
+[ 1048] By: mbeattie on 1998/05/28 18:07:24
+ Log: Integrated win32 branch into mainline. The changes to t/op/ipc*.t
+ in change 1043 clashed badly with changes made in the win32
+ branch. I did an accept on the win32 branch version for now.
+ Branch: perl
+ +> t/op/die.t
+ !> (integrate 52 files)
+____________________________________________________________________________
+[ 1047] By: mbeattie on 1998/05/28 17:59:18
+ Log: From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Subject: [PATCH 5.004_65] Config_65-02-03.diff: SunOS and Solaris hints
+ Date: Thu, 28 May 1998 13:27:25 -0400 (EDT)
+ Subject: [PATCH 5.004_65] Config_65-03-04.diff: semctl probing
+ Date: Thu, 28 May 1998 13:28:21 -0400 (EDT)
+ Branch: perl
+ ! Configure MANIFEST Porting/Glossary Porting/config.sh
+ ! Porting/config_H config_h.SH doio.c ext/POSIX/hints/sunos_4.pl
+ ! hints/solaris_2.sh hints/sunos_4_1.sh perl.h vms/config.vms
+ ! win32/config.bc win32/config.gc win32/config.vc
+____________________________________________________________________________
+[ 1046] By: mbeattie on 1998/05/28 17:55:48
+ Log: Back out change 1043 since Andy's forthcoming Config patch
+ includes a modified version.
+ Branch: perl
+ ! Configure config_h.SH doio.c perl.h
+____________________________________________________________________________
+[ 1045] By: mbeattie on 1998/05/28 17:52:40
+ Log: Bump patchlevel.h to 66.
+ Branch: perl
+ ! patchlevel.h
+____________________________________________________________________________
+[ 1044] By: mbeattie on 1998/05/28 17:51:49
+ Log: From: Daniel Grisinger <dgris@perrin.dimensional.com>
+ Subject: [PATCH] _04m2 <DOC> perlfunc.pod (fwd)
+ Date: Fri, 15 May 1998 16:18:26 -0600 (MDT)
+ (above minus the t/system.t test pending checking)
+ Subject: [PATCH] 5.004[04|65] <DOC> FileHandle.pm
+ Date: Wed, 20 May 1998 19:50:50 -0600 (MDT)
+ Subject: [PATCH] _65 and _04 <DOC> patching.pod
+ Date: Thu, 21 May 1998 16:33:03 -0600 (MDT)
+ Branch: perl
+ ! Porting/patching.pod lib/FileHandle.pm pod/perlfunc.pod
+____________________________________________________________________________
+[ 1043] By: mbeattie on 1998/05/28 17:42:21
+ Log: This change really is:
+ Subject: [PATCH] 5.004_65: the infamous semctl()
+ Date: Sun, 24 May 1998 16:13:21 +0300 (EET DST)
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+
+ Change 1041 claimed to be this patch but was really:
+ Subject: [PATCH] 5.004_65: t/op/ipc*.t
+ Date: Sat, 16 May 1998 00:52:39 +0300 (EET DST)
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Branch: perl
+ ! Configure config_h.SH doio.c perl.h
+____________________________________________________________________________
+[ 1042] By: mbeattie on 1998/05/28 17:36:57
+ Log: From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Subject: [PATCH 5.004_65] Config_65-01: lchown() detection.
+ Date: Thu, 28 May 1998 13:25:21 -0400 (EDT)
+ Subject: [PATCH 5.004_65] Config_65-01-02.diff: INSTALL and hints fixes
+ Date: Thu, 28 May 1998 13:26:18 -0400 (EDT)
+ Branch: perl
+ ! Configure INSTALL Porting/Glossary Porting/config.sh
+ ! Porting/config_H config_h.SH doio.c hints/bsdos.sh
+ ! hints/openbsd.sh hints/svr4.sh plan9/config.plan9
+ ! vms/config.vms win32/config.bc win32/config.gc win32/config.vc
+____________________________________________________________________________
+[ 1041] By: mbeattie on 1998/05/28 17:34:26
+ Log: Subject: [PATCH] 5.004_65: the infamous semctl()
+ Date: Sun, 24 May 1998 16:13:21 +0300 (EET DST)
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Branch: perl
+ ! t/op/ipcmsg.t t/op/ipcsem.t
+____________________________________________________________________________
+[ 1040] By: gsar on 1998/05/28 02:06:47
+ Log: tweaks to enable Borland build
+ Branch: asperl
+ ! win32/makefile.mk win32/win32.c
+____________________________________________________________________________
+[ 1039] By: gsar on 1998/05/27 23:29:22
+ Log: remove C<#define index strchr> from win32.h (unused, and the
+ pollution causes spurious variable name changes in extensions)
+ Branch: win32/perl
+ ! win32/win32.h
+____________________________________________________________________________
+[ 1038] By: TimBunce on 1998/05/27 17:29:15
+ Log: Assorted patches:
+
+ ------ BUILD PROCESS ------
+
+ Title: "add utilities to make test dependencies"
+ From: Robin Barker <rmb1@cise.npl.co.uk>
+ Msg-ID: <2607.9805211303@tempest.cise.npl.co.uk>
+ Files: Makefile.SH
+
+ Title: "Add 'make nok' complement to 'make ok'"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0ycRDf-0005Wh-00@taurus.cus.cam.ac.uk>
+ Files: Makefile.SH
+
+ Title: "further h2ph patches (add enum support)"
+ From: Billy <wdconsta@cs.adelaide.edu.au>
+ Msg-ID: <Pine.SV4.3.93.980521025541.14577A-100000@xenon.teaching.cs.adelaide.edu.au>
+ Files: MANIFEST t/lib/h2ph.pht t/lib/h2ph.t utils/h2ph.PL
+
+ ------ CORE LANGUAGE ------
+
+ Title: "Fix %! error spelling and add perldiag.pod entry"
+ From: Graham Barr <gbarr@pobox.com>, Tim Bunce
+ Msg-ID: <19980524193101.A573@pobox.com>
+ Files: pod/perldiag.pod gv.c
+
+ Title: "Remove obsolete Win32 uppercasing ENV code"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199805201510.LAA28676@aatma.engin.umich.edu>
+ Files: perl.c
+
+ Title: "Don't mung $! on implicit close"
+ From: Chip Salzenberg <chip@perl.org>
+ Msg-ID: <19980525113309.A15845@perlsupport.com>
+ Files: doio.c
+
+ Title: "Maint trial 3 fails on SunOS 4.1.3 with Sun cc"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980527113114.26608D-100000@newton.phys>
+ Files: doio.c
+
+ ------ DOCUMENTATION ------
+
+ Title: "doc patch: you canna return an array ( list context: || vs or)"
+ From: Jarkko Hietaniemi <jhi@cc.hut.fi>
+ Msg-ID: <oeeemxguf5h.fsf_-_@alpha.hut.fi>
+ Files: pod/perldebug.pod pod/perlfunc.pod pod/perltie.pod pod/perltrap.pod
+
+ Title: "doc patch: @ needs escaping in m/\Q\E/ environment"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0yecim-0002qr-00@taurus.cus.cam.ac.uk>
+ Files: pod/perlop.pod pod/perlre.pod
+
+ Title: "Discrepancy between perlop.pod and m// operator", "Doc fix: Only
+ with /g does list context get matches without parens"
+ From: Greg Chapman <glc@well.com>, Tom Christiansen
+ <tchrist@jhereg.perl.com>, Tom Phoenix
+ <rootbeer@teleport.com>
+ Msg-ID: <000201bd865e$f3bf72e0$1f04400c@assigned.well.com>,
+ <199805231559.JAA21316@jhereg.perl.com>,
+ <Pine.GSO.3.96.980523084947.22348I-100000@user2.teleport.com>
+ Files: pod/perlop.pod
+
+ Title: "Documenting last/next/redo even further"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Tom Phoenix
+ <rootbeer@teleport.com>
+ Msg-ID: <E0yec2h-0000B9-00@taurus.cus.cam.ac.uk>,
+ <Pine.GSO.3.96.980526111426.27437K-100000@user2.teleport.com>
+ Files: pod/perlfunc.pod
+
+ Title: "Documenting last/next/redo within continue block"
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID: <Pine.GSO.3.96.980525214558.7133H-100000@user2.teleport.com>
+ Files: pod/perlfunc.pod
+
+ Title: "Document stat return in scalar context"
+ From: Mark-Jason Dominus <mjd@plover.com>
+ Files: pod/perlfunc.pod
+
+ ------ EXTENSIONS ------
+
+ Title: "Better LD_RUN_PATH handling on IRIX"
+ From: "W. Phillip Moore" <wpm@ms.com>
+ Msg-ID: <199805212206.SAA07504@zappa.morgan.com>
+ Files: lib/ExtUtils/MM_Unix.pm
+
+ Title: "Dealing with <unistd.h> in POSIX and SunOS"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980527115256.26608F-100000@newton.phys>
+ Files: ext/POSIX/hints/sunos_4.pl hints/sunos_4_1.sh ext/POSIX/POSIX.xs
+
+ ------ LIBRARY ------
+
+ Title: "Fix FileHandle.pm example bug"
+ From: Daniel Grisinger <dgris@perrin.dimensional.com>
+ Msg-ID: <Pine.LNX.3.96.980520194825.10845C-100000@perrin.dimensional.com>
+ Files: lib/FileHandle.pm
+
+ Title: "Add zero/negative $count docs for Benchmark.pm"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0ydEAr-0006NV-00@taurus.cus.cam.ac.uk>
+ Files: lib/Benchmark.pm
+
+ ------ PORTABILITY - GENERAL ------
+
+ Title: "Add test suite recommendations to Porting/patching.pod"
+ From: Daniel Grisinger <dgris@perrin.dimensional.com>
+ Msg-ID: <Pine.LNX.3.96.980521162925.3568B-100000@perrin.dimensional.com>
+ Files: Porting/patching.pod
+
+ ------ TESTS ------
+
+ Title: "Fix looping bug in t/io/pipe.t"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0yc737-0006fB-00@taurus.cus.cam.ac.uk>
+ Files: t/io/pipe.t
+ Branch: maint-5.004/perl
+ ! MANIFEST Makefile.SH Porting/patching.pod doio.c
+ ! ext/POSIX/POSIX.xs ext/POSIX/hints/sunos_4.pl gv.c
+ ! hints/sunos_4_1.sh lib/Benchmark.pm lib/ExtUtils/MM_Unix.pm
+ ! lib/FileHandle.pm perl.c pod/perldebug.pod pod/perldiag.pod
+ ! pod/perlfunc.pod pod/perlop.pod pod/perlre.pod pod/perltie.pod
+ ! pod/perltrap.pod t/io/pipe.t t/lib/h2ph.pht t/lib/h2ph.t
+ ! utils/h2ph.PL
+____________________________________________________________________________
+[ 1037] By: gsar on 1998/05/27 16:18:30
+ Log: add AS patch#22 (fix to make die_exit.t pass)
+ Branch: asperl
+ ! win32/runperl.c
+____________________________________________________________________________
+[ 1036] By: gsar on 1998/05/27 12:50:34
+ Log: add AS patch#21 (misc. fixes)
+ Branch: asperl
+ ! ObjXSub.h lib/ExtUtils/MM_Unix.pm objpp.h perl.h
+ ! win32/GenCAPI.pl win32/Makefile win32/makefile.mk
+ ! win32/win32.c win32/win32sck.c
+____________________________________________________________________________
+[ 1035] By: gsar on 1998/05/26 17:26:17
+ Log: more changes to satisfy non-debug VC build (C-API doesn't
+ build, and the testsuite still won't run)
+ Branch: asperl
+ ! ObjXSub.h deb.c dump.c ext/POSIX/POSIX.xs globals.c proto.h
+ ! regcomp.c run.c scope.c sv.c util.c win32/GenCAPI.pl
+____________________________________________________________________________
+[ 1034] By: gsar on 1998/05/26 17:20:22
+ Log: remove doubled hunk (perforce auto-integrate oddity)
+ Branch: win32/perl
+ ! pod/perldiag.pod
+____________________________________________________________________________
+[ 1033] By: gsar on 1998/05/26 13:39:14
+ Log: tweaks to make it build with the Borland compiler. Won't run
+ testsuite because @INC intuition from location of perlcore.dll seems
+ to be broken. Also, system() and qx// seem broken as well.
+ Branch: asperl
+ ! ObjXSub.h doio.c embedvar.h ext/POSIX/POSIX.xs interp.sym
+ ! intrpvar.h objpp.h perl.c perl.h perlvars.h proto.h regcomp.c
+ ! regexec.c toke.c
+____________________________________________________________________________
+[ 1032] By: gsar on 1998/05/24 23:13:05
+ Log: tweak Benchmark.pm to restore old timestr() behavior--show wall secs
+ Branch: win32/perl
+ ! lib/Benchmark.pm
+____________________________________________________________________________
+[ 1031] By: gsar on 1998/05/24 05:36:44
+ Log: tweak makefiles
+ Branch: asperl
+ ! win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 1030] By: gsar on 1998/05/23 18:58:23
+ Log: merge changes#1016,1018 from maintbranch (1017 is n/a)
+ Branch: win32/perl
+ ! pp_sys.c t/op/die.t
+____________________________________________________________________________
+[ 1029] By: gsar on 1998/05/23 18:55:13
+ Log: merge change#1015 from maintbranch (must revisit 1014 later, is
+ incomplete)
+ Branch: win32/perl
+ ! embed.h global.sym op.c pp.c proto.h sv.c
+____________________________________________________________________________
+[ 1028] By: gsar on 1998/05/23 18:25:14
+ Log: merge change#1013 from maintbranch (1012 is n/a)
+ Branch: win32/perl
+ ! toke.c
+____________________________________________________________________________
+[ 1027] By: gsar on 1998/05/23 18:02:21
+ Log: merge change#1011 from maintbranch
+ Branch: win32/perl
+ ! perl.c pod/perldiag.pod pod/perlfunc.pod pp_ctl.c
+ ! utils/perlbug.PL
+____________________________________________________________________________
+[ 1026] By: nick on 1998/05/23 08:45:04
+ Log: Ids of msgs and sems can be zero, so change || die to a defined() test
+ Branch: win32/perl
+ ! t/op/ipcmsg.t t/op/ipcsem.t
+____________________________________________________________________________
+[ 1025] By: nick on 1998/05/23 08:36:36
+ Log: Resolve win32 into ansiperl
+ Branch: ansiperl
+ +> t/op/die.t
+ !> (integrate 42 files)
+____________________________________________________________________________
+[ 1024] By: gsar on 1998/05/21 21:11:12
+ Log: more mingw32 tweaks
+ Branch: win32/perl
+ ! ext/POSIX/POSIX.xs t/pragma/locale.t
+____________________________________________________________________________
+[ 1023] By: gsar on 1998/05/21 19:15:02
+ Log: fix problematic change#965 from maintbranch
+ Message-Id: <199805162145.RAA02552@monk.mps.ohio-state.edu>
+ Date: Sat, 16 May 1998 17:45:22 EDT
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Subject: Re: Not OK (after all) : perl 5.00404 +MAINT_TRIAL_3 on sun4-solaris 2.5
+ Branch: win32/perl
+ ! gv.c op.c t/comp/proto.t
+____________________________________________________________________________
+[ 1022] By: gsar on 1998/05/21 01:37:04
+ Log: fix POSIX for mingw32
+ Branch: win32/perl
+ ! ext/POSIX/POSIX.xs win32/config.gc win32/config_H.gc
+____________________________________________________________________________
+[ 1021] By: gsar on 1998/05/20 15:02:21
+ Log: remove strupr() from perl.c
+ Branch: win32/perl
+ ! perl.c
+____________________________________________________________________________
+[ 1020] By: TimBunce on 1998/05/19 22:41:40
+ Log: Title: "fix up descrepancy in h2ph test"
+ From: Tim Bunce
+ Files: t/lib/h2ph.pht
+ Branch: maint-5.004/perl
+ ! t/lib/h2ph.pht
+____________________________________________________________________________
+[ 1019] By: TimBunce on 1998/05/19 22:17:15
+ Log: Title: "add a test to check return value from successful s/// (there was none!)"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199805161759.NAA12995@aatma.engin.umich.edu>
+ Files: t/op/subst.t
+
+ Title: "fix up descrepancy in h2ph test"
+ From: Tim Bunce
+ Files: t/lib/h2ph.t
+ Branch: maint-5.004/perl
+ ! t/lib/h2ph.t t/op/subst.t
+____________________________________________________________________________
+[ 1018] By: TimBunce on 1998/05/19 21:56:32
+ Log: Title: "fix mem leak and core dump from change 1016"
+ From: Tim Bunce
+ Files: pp_sys.c
+ Branch: maint-5.004/perl
+ ! pp_sys.c
+____________________________________________________________________________
+[ 1017] By: TimBunce on 1998/05/19 21:26:03
+ Log: Title: "qsort, Win32 "POSIX" plus other devel changes for patch-compatibility"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Files: MANIFEST cflags.SH pod/perlembed.pod pod/perlfunc.pod
+ pod/perlguts.pod pod/perlref.pod pod/perlrun.pod
+ pod/perlxstut.pod av.h embed.h hv.h op.h perl.h pp.h
+ proto.h Todo av.c cygwin32/perlgcc cygwin32/perlld deb.c
+ doio.c doop.c ext/ODBM_File/ODBM_File.xs
+ ext/POSIX/Makefile.PL ext/POSIX/POSIX.pm ext/POSIX/POSIX.xs
+ gv.c hv.c interp.sym lib/AutoSplit.pm lib/Cwd.pm
+ lib/FindBin.pm lib/strict.pm lib/ExtUtils/Command.pm
+ lib/ExtUtils/Liblist.pm lib/ExtUtils/MakeMaker.pm
+ lib/ExtUtils/Manifest.pm lib/File/Basename.pm
+ lib/File/Find.pm lib/File/Path.pm lib/Getopt/Long.pm
+ lib/Getopt/Std.pm lib/Net/Ping.pm lib/Pod/Html.pm
+ lib/Pod/Text.pm lib/Term/Cap.pm lib/Test/Harness.pm mg.c
+ op.c perl.c pod/pod2latex.PL pod/pod2man.PL pp.c pp_ctl.c
+ pp_hot.c pp_sys.c scope.c sv.c t/lib/posix.t
+ t/pragma/locale.t utils/perldoc.PL win32/win32.h toke.c
+ universal.c util.c win32/Makefile win32/config_H.bc
+ win32/config_H.vc win32/dl_win32.xs win32/makedef.pl
+ win32/makefile.mk win32/perlglob.c win32/runperl.c
+ win32/win32.c win32/win32sck.c x2p/s2p.PL
+ Branch: maint-5.004/perl
+ ! MANIFEST Todo av.c av.h cflags.SH cygwin32/perlgcc
+ ! cygwin32/perlld deb.c doio.c doop.c embed.h
+ ! ext/ODBM_File/ODBM_File.xs ext/POSIX/Makefile.PL
+ ! ext/POSIX/POSIX.pm ext/POSIX/POSIX.xs gv.c hv.c hv.h
+ ! interp.sym lib/AutoSplit.pm lib/Cwd.pm lib/ExtUtils/Command.pm
+ ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MakeMaker.pm
+ ! lib/ExtUtils/Manifest.pm lib/File/Basename.pm lib/File/Find.pm
+ ! lib/File/Path.pm lib/FindBin.pm lib/Getopt/Long.pm
+ ! lib/Getopt/Std.pm lib/Net/Ping.pm lib/Pod/Html.pm
+ ! lib/Pod/Text.pm lib/Term/Cap.pm lib/Test/Harness.pm
+ ! lib/strict.pm mg.c op.c op.h perl.c perl.h pod/perlembed.pod
+ ! pod/perlfunc.pod pod/perlguts.pod pod/perlref.pod
+ ! pod/perlrun.pod pod/perlxstut.pod pod/pod2latex.PL
+ ! pod/pod2man.PL pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c proto.h
+ ! scope.c sv.c t/lib/posix.t t/pragma/locale.t toke.c
+ ! universal.c util.c utils/perldoc.PL win32/Makefile
+ ! win32/config_H.bc win32/config_H.vc win32/dl_win32.xs
+ ! win32/makedef.pl win32/makefile.mk win32/perlglob.c
+ ! win32/runperl.c win32/win32.c win32/win32.h win32/win32sck.c
+ ! x2p/s2p.PL
+____________________________________________________________________________
+[ 1016] By: TimBunce on 1998/05/19 20:37:42
+ Log: Title: "eval { die $obj }; die; calls $obj->PROPAGATE"
+ From: Graham Barr <gbarr@ti.com>
+ Msg-ID: <3561D147.7F3E0C88@ti.com>
+ Files: pp_sys.c t/op/die.t
+ Branch: maint-5.004/perl
+ ! pp_sys.c t/op/die.t
+____________________________________________________________________________
+[ 1015] By: TimBunce on 1998/05/19 20:07:01
+ Log: Title: "loosen const sub re-defined warnings"
+ From: Doug MacEachern <dougm@pobox.com>
+ Msg-ID: <355F713B.6A4C0F04@pobox.com>
+ Files: proto.h global.sym op.c pp.c sv.c
+ Branch: maint-5.004/perl
+ ! global.sym op.c pp.c proto.h sv.c
+____________________________________________________________________________
+[ 1014] By: TimBunce on 1998/05/19 19:48:18
+ Log: Title: "s/FORMLINE/FORMAT/ in sv.c"
+ From: Hugo van der Sanden <hv@crypt0.demon.co.uk>
+ Msg-ID: <l03130303b1837a243670@[194.222.64.89]>
+ Files: sv.c
+
+ Title: "Further h2ph patches (including a test suite)"
+ From: Billy <wdconsta@cs.adelaide.edu.au>
+ Msg-ID: <Pine.SV4.3.93.980516234652.2100A-100000@xenon.teaching.cs.adelaide.edu.au>
+ Files: MANIFEST t/lib/h2ph.h t/lib/h2ph.pht t/lib/h2ph.t utils/h2ph.PL
+ Branch: maint-5.004/perl
+ + t/lib/h2ph.h t/lib/h2ph.pht t/lib/h2ph.t
+ ! MANIFEST sv.c utils/h2ph.PL
+____________________________________________________________________________
+[ 1013] By: TimBunce on 1998/05/19 19:14:13
+ Log: Title: "Remove change 673 (Allow empty BLOCK in code)"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>, Ilya Zakharevich
+ <ilya@math.ohio-state.edu>
+ Msg-ID: <199805151857.OAA29586@monk.mps.ohio-state.edu>,
+ <199805151931.PAA23086@aatma.engin.umich.edu>,
+ <19980129002112Z13378-6931+226@scapa.cs.ualberta.ca>
+ Files: toke.c
+ Branch: maint-5.004/perl
+ ! toke.c
+____________________________________________________________________________
+[ 1012] By: TimBunce on 1998/05/19 19:03:32
+ Log: Title: "Further SysV sem/msg fixes and removal of non-portable tests"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>, Jarkko Hietaniemi
+ <jhi@iki.fi>
+ Msg-ID: <199805182028.XAA15717@alpha.hut.fi>,
+ <Pine.SUN.3.96.980518133606.17488A-100000@newton.phys>
+ Files: MANIFEST Configure config_h.SH perl.h doio.c t/op/ipcmsg.t
+ t/op/ipcsem.t
+ Branch: maint-5.004/perl
+ ! Configure MANIFEST config_h.SH doio.c perl.h t/op/ipcmsg.t
+ ! t/op/ipcsem.t
+____________________________________________________________________________
+[ 1011] By: TimBunce on 1998/05/19 17:55:38
+ Log: Title: "interp.sym is missing C<e_script> after -e fix"
+ From: jan.dubois@ibm.net (Jan Dubois)
+ Msg-ID: <355d460d.7621669@smtp1.ibm.net>
+ Files: embed.h interp.sym
+
+ Title: "Undo changed error message which breaks Tk"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199805161557.LAA08106@aatma.engin.umich.edu>
+ Files: pp_ctl.c
+
+ Title: "Minor fixups to new -e script code"
+ From: Tim Bunce
+ Files: perl.c
+
+ Title: "Remove old diags not relevant after -e fix"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>, Gurusamy Sarathy
+ <gsar@engin.umich.edu>, Tim.Bunce@ig.co.uk (Tim Bunce)
+ Msg-ID: <199805172143.RAA07896@aatma.engin.umich.edu>,
+ <199805181335.OAA07008@toad.ig.co.uk>,
+ <Pine.SUN.3.96.980517104819.16183B-100000@newton.phys>
+ Files: pod/perldiag.pod
+
+ Title: "more examples for vec()"
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID: <Pine.GSO.3.96.980518093728.28732P-100000@user2.teleport.com>
+ Files: pod/perlfunc.pod
+
+ Title: ""make ok" (perlbug -ok) should not be interactive"
+ From: Hugo van der Sanden <hv@crypt0.demon.co.uk>, Jarkko Hietaniemi
+ <jhi@iki.fi>
+ Msg-ID: <199805160942.MAA20171@alpha.hut.fi>,
+ <l03130300b1834f9732a0@[194.222.64.89]>
+ Files: utils/perlbug.PL
+ Branch: maint-5.004/perl
+ ! embed.h interp.sym perl.c pod/perldiag.pod pod/perlfunc.pod
+ ! pp_ctl.c utils/perlbug.PL
+____________________________________________________________________________
+[ 1010] By: gsar on 1998/05/18 09:40:58
+ Log: integrate mainline changes (untested)
+ Branch: asperl
+ +> Porting/Contract Porting/patching.pod README.beos beos/nm.c
+ +> ext/DynaLoader/DynaLoader.pm.PL ext/POSIX/hints/bsdos.pl
+ +> ext/POSIX/hints/freebsd.pl ext/POSIX/hints/netbsd.pl
+ +> ext/POSIX/hints/openbsd.pl hints/beos.sh hints/openbsd.sh
+ +> pod/perldelta4.pod t/op/defins.t t/op/die.t t/op/die_exit.t
+ +> t/op/ipcmsg.t t/op/ipcsem.t t/op/pos.t utils/perlcc.PL
+ - ext/DynaLoader/DynaLoader.pm
+ ! win32/win32.c
+ !> (integrate 234 files)
+____________________________________________________________________________
+[ 1009] By: gsar on 1998/05/18 07:51:19
+ Log: more whitespace tweaks from maintbranch
+ Branch: win32/perl
+ ! av.c perl.c pp_ctl.c pp_sys.c toke.c
+____________________________________________________________________________
+[ 1008] By: gsar on 1998/05/17 22:37:20
+ Log: sundry whitespace cleanups from maintbranch
+ Branch: win32/perl
+ ! Porting/Contract XSUB.h av.c gv.c mg.c perl.c
+____________________________________________________________________________
+[ 1007] By: gsar on 1998/05/16 21:59:46
+ Log: integrate mainline
+ Branch: win32/perl
+ !> INSTALL doio.c lib/strict.pm perl.c perl.h pod/perldebug.pod
+ !> t/op/ipcmsg.t t/op/ipcsem.t
+____________________________________________________________________________
+[ 1006] By: gsar on 1998/05/16 21:54:23
+ Log: merge changes#996,998,999 from maintbranch
+ Branch: win32/perl
+ ! Changes5.004 Porting/makerel t/base/lex.t toke.c
+____________________________________________________________________________
+[ 1005] By: gsar on 1998/05/16 21:49:47
+ Log: merge change#995 from maintbranch, tweak interp.sym and
+ run embed.pl
+ Branch: win32/perl
+ ! embedvar.h interp.sym intrpvar.h perl.c
+____________________________________________________________________________
+[ 1004] By: gsar on 1998/05/16 21:27:18
+ Log: merge changes#989,990,992 from maintbranch
+ Branch: win32/perl
+ + t/op/die.t
+ ! MANIFEST installperl pod/perldiag.pod pp_ctl.c t/op/ipcmsg.t
+____________________________________________________________________________
+[ 1003] By: gsar on 1998/05/16 21:16:47
+ Log: sync config*.gc with others, and verify that nothing from
+ change#986 needs to be merged
+ Branch: win32/perl
+ ! win32/config.gc win32/config_H.gc
+____________________________________________________________________________
+[ 1002] By: gsar on 1998/05/16 21:04:04
+ Log: merge change#985 from maintbranch
+ Branch: win32/perl
+ ! lib/AutoSplit.pm lib/ExtUtils/Manifest.pm pp_ctl.c pp_sys.c
+ ! util.c
+____________________________________________________________________________
+[ 1001] By: gsar on 1998/05/16 17:53:16
+ Log: add a test to check return value from successful s/// (there was none!)
+ Branch: win32/perl
+ ! t/op/subst.t
+____________________________________________________________________________
+[ 1000] By: gsar on 1998/05/16 17:42:34
+ Log: fix misplaced SPAGAIN that caused successful s/// to fail to
+ return a value on the stack
+ Branch: win32/perl
+ ! pp_hot.c
+____________________________________________________________________________
+[ 999] By: TimBunce on 1998/05/15 23:04:30
+ Log: Title: "Update Porting/makerel script for perforce dir structure"
+ From: Tim Bunce
+ Files: Porting/makerel
+ Branch: maint-5.004/perl
+ ! Porting/makerel
+____________________________________________________________________________
+[ 998] By: TimBunce on 1998/05/15 22:49:55
+ Log: Title: "Updated Changes file for trial 3"
+ From: Tim Bunce
+ Files: Changes
+ Branch: maint-5.004/perl
+ ! Changes
+____________________________________________________________________________
+[ 997] By: gsar on 1998/05/15 22:21:41
+ Log: merge changes#982,984 from maintbranch
+ Branch: win32/perl
+ ! gv.c lib/English.pm perl.c pod/perlfunc.pod t/io/pipe.t
+ ! t/op/exec.t t/op/ipcsem.t util.c utils/h2ph.PL utils/h2xs.PL
+____________________________________________________________________________
+[ 996] By: TimBunce on 1998/05/15 22:19:32
+ Log: Title: "Negative array subscript unrecognized in regex"
+ From: Mark-Jason Dominus <mjd@plover.com>,
+ h.sanden@elsevier.nl (Hugo van der Sanden)
+ Msg-ID: <19980425040819.13828.qmail@plover.com>,
+ <199805151514.RAA04121@dorlas.elsevier.nl>
+ Files: t/base/lex.t toke.c
+
+ Title: "Remove e_fp from toke.c after change 955"
+ From: Tim Bunce
+ Files: toke.c
+ Branch: maint-5.004/perl
+ ! t/base/lex.t toke.c
+____________________________________________________________________________
+[ 995] By: TimBunce on 1998/05/15 22:08:32
+ Log: Title: "Fix -e security hole (no longer uses temp file)"
+ From: Tim Bunce
+ Files: embed.h perl.h perl.c
+ Branch: maint-5.004/perl
+ ! embed.h perl.c perl.h
+____________________________________________________________________________
+[ 994] By: gsar on 1998/05/15 22:08:17
+ Log: merge change#981 from maintbranch, add XXX comment about
+ supporting %! for usethreads case
+ Branch: win32/perl
+ ! gv.c op.c
+____________________________________________________________________________
+[ 992] By: TimBunce on 1998/05/15 22:01:32
+ Log: Title: "install non-backwards compatible .pm files into archlib"
+ From: Tim Bunce
+ Files: installperl
+
+ Title: "revert "Can't locate" message to original for maintenance"
+ From: Tim Bunce
+ Msg-ID: <199804240047.SAA24155@den-mdev1.co.csgsystems.com>
+ Files: pod/perldiag.pod pp_ctl.c
+ Branch: maint-5.004/perl
+ ! installperl pod/perldiag.pod pp_ctl.c
+____________________________________________________________________________
+[ 991] By: gsar on 1998/05/15 21:35:00
+ Log: reverse integrate ansiperl (all except the
+ C<attrs qw(package locked)> stuff, and the duplicate hunks)
+ i.e. prototype fixes, perldoc.PL enhancements, and s/comment/comment_t/g
+ Branch: win32/perl
+ !> bytecode.h byterun.c cv.h ext/attrs/attrs.pm
+ !> ext/attrs/attrs.xs pod/perlop.pod pp_hot.c sv.c toke.c
+ !> utils/perldoc.PL
+____________________________________________________________________________
+[ 990] By: TimBunce on 1998/05/15 16:54:18
+ Log: Title: "Add tests for die $ref"
+ From: Graham Barr <gbarr@ti.com>
+ Msg-ID: <355C6297.121B576B@ti.com>
+ Files: MANIFEST t/op/die.t
+ Branch: maint-5.004/perl
+ + t/op/die.t
+ ! MANIFEST
+____________________________________________________________________________
+[ 989] By: TimBunce on 1998/05/15 16:38:19
+ Log: Title: "Fix t/op/ipcmsg.t for Digital UNIX"
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199805151337.QAA01174@alpha.hut.fi>
+ Files: t/op/ipcmsg.t
+ Branch: maint-5.004/perl
+ ! t/op/ipcmsg.t
+____________________________________________________________________________
+[ 988] By: mbeattie on 1998/05/15 16:28:08
+ Log: Patch from Sarathy to fix up win32 integration. Patch from Jarkko
+ (manually applied and tweaked) to fix up SysV IPC semaphores for
+ Solaris and Linux (pre-glibc and glibc). Fix up t/op/ipcmsg.t and
+ t/op/ipcsem.t for platforms which wanted to skip test. Completely
+ disable ipcsem.t since it doesn't seem to work properly even when
+ not skipped. This is _65.
+ Branch: perl
+ ! INSTALL doio.c lib/strict.pm perl.c perl.h pod/perldebug.pod
+ ! t/op/ipcmsg.t t/op/ipcsem.t
+____________________________________________________________________________
+[ 987] By: nick on 1998/05/15 16:03:35
+ Log: Integrate win32
+ Branch: ansiperl
+ +> Porting/Contract Porting/patching.pod README.beos beos/nm.c
+ +> ext/DynaLoader/DynaLoader.pm.PL ext/POSIX/hints/bsdos.pl
+ +> ext/POSIX/hints/freebsd.pl ext/POSIX/hints/netbsd.pl
+ +> ext/POSIX/hints/openbsd.pl hints/beos.sh hints/openbsd.sh
+ +> pod/perldelta4.pod t/op/die_exit.t t/op/ipcmsg.t t/op/ipcsem.t
+ +> t/op/pos.t utils/perlcc.PL
+ - ext/DynaLoader/DynaLoader.pm
+ !> (integrate 208 files)
+____________________________________________________________________________
+[ 986] By: TimBunce on 1998/05/15 15:28:45
+ Log: Title: "Patches for BeOS port of Perl, courtesy of Tom Spindler"
+ From: Jarkko Hietaniemi <jhi@iki.fi>, Tom Spindler
+ Msg-ID: <199805042312.CAA09025@alpha.hut.fi>
+ Files: MANIFEST Configure config_h.SH hints/beos.sh pod/perlfunc.pod
+ Porting/Glossary README.beos beos/nm.c lib/Term/ReadLine.pm
+ plan9/config.plan9 pp_sys.c t/io/pipe.t vms/config.vms
+ win32/config.bc win32/config.vc win32/config_H.bc
+ win32/config_H.vc
+ Branch: maint-5.004/perl
+ + README.beos beos/nm.c hints/beos.sh
+ ! Configure MANIFEST Porting/Glossary config_h.SH
+ ! lib/Term/ReadLine.pm plan9/config.plan9 pod/perlfunc.pod
+ ! pp_sys.c t/io/pipe.t vms/config.vms win32/config.bc
+ ! win32/config.vc win32/config_H.bc win32/config_H.vc
+____________________________________________________________________________
+[ 985] By: TimBunce on 1998/05/15 15:02:43
+ Log: Title: "allow die $ref"
+ From: Graham Barr <gbarr@ti.com>, Tim.Bunce@ig.co.uk (Tim Bunce)
+ Msg-ID: <199805151351.OAA01985@toad.ig.co.uk>, <355C3E67.AF25B9F7@ti.com>
+ Files: pp_ctl.c pp_sys.c util.c
+
+ Title: "ExtUtils::Manifest could truncate files during "make dist""
+ From: "James E Jurach Jr." <muaddib@arrakis.int.ein.cz>,
+ koenig@kulturbox.de (Andreas J. Koenig)
+ Msg-ID: <199805111048.MAA02573@arrakis.int.ein.cz>,
+ <sfc90o8bgie.fsf@dubravka.in-berlin.de>
+ Files: lib/ExtUtils/Manifest.pm
+
+ Title: "Autosplit doesn't like upper case letters in sub names on VMS"
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Msg-ID: <3.0.5.32.19980330152332.009cb130@osshe.edu>
+ Files: lib/AutoSplit.pm
+
+ Title: "AutoSplit/AutoLoaded subs: give useful line numbers in warnings etc"
+ From: "Jesse N. Glick" <jglick@sig.bsh.com>, koenig@anna.mind.de (Andreas
+ J. Koenig), larry@wall.org (Larry Wall)
+ Msg-ID: <199709292015.NAA09627@wall.org>, <342FCDDF.23534195@sig.bsh.com>,
+ <sfc202c9jsb.fsf@anna.in-berlin.de>,
+ <sfc3efg5rhg.fsf@dubravka.in-berlin.de>
+ Files: lib/AutoSplit.pm
+ Branch: maint-5.004/perl
+ ! lib/AutoSplit.pm lib/ExtUtils/Manifest.pm pp_ctl.c pp_sys.c
+ ! util.c
+____________________________________________________________________________
+[ 984] By: TimBunce on 1998/05/15 14:18:52
+ Log: ------ CORE LANGUAGE ------
+
+ Title: "Fix close pipe returning status from wrong child"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, kstar@chapin.edu@ig.co.uk ()
+ Msg-ID: <199805142313.TAA02684@chapin.edu>,
+ <E0yZ8ah-0005d8-00@taurus.cus.cam.ac.uk>
+ Files: t/io/pipe.t util.c
+
+ Title: "Avoid English.pm triggering load of Errno.pm"
+ From: Tim Bunce
+ Files: gv.c lib/English.pm
+
+ ------ DOCUMENTATION ------
+
+ Title: "Document child exit cause a parent sleep to end early"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0yZwMK-0000D9-00@taurus.cus.cam.ac.uk>
+ Files: pod/perlfunc.pod
+
+ ------ EXTENSIONS ------
+
+ Title: "BSD Platforms need STRUCT_TM_HASZONE for POSIX"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980512095524.8158C-100000@newton.phys>
+ Files: MANIFEST ext/POSIX/hints/bsdos.pl ext/POSIX/hints/freebsd.pl
+ ext/POSIX/hints/netbsd.pl ext/POSIX/hints/openbsd.pl
+
+ Title: "MM_VMS.pm fixes for building external library"
+ From: Dan Sugalski <sugalskd@ous.edu>
+ Msg-ID: <3.0.5.32.19980511160542.009dd480@ous.edu>
+ Files: lib/ExtUtils/MM_VMS.pm
+
+ Title: "Appease picky DEC compiler in POSIX.xs"
+ From: Dan Sugalski <sugalskd@ous.edu>
+ Msg-ID: <3.0.5.32.19980511161434.009f8bb0@ous.edu>
+ Files: ext/POSIX/POSIX.xs
+
+ ------ TESTS ------
+
+ Title: "Fix constant detection in t/op/ipcsem.t for Digit UNIX"
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199805121212.PAA15351@alpha.hut.fi>
+ Files: t/op/ipcsem.t
+
+ Title: "Fix doc bug for system() return value"
+ From: Daniel Grisinger <dgris@perrin.dimensional.com>
+ Msg-ID: <Pine.LNX.3.96.980514165608.4062A-100000@perrin.dimensional.com>
+ Files: pod/perlfunc.pod t/op/exec.t
+
+ ------ UTILITIES ------
+
+ Title: "Avoid possible constant autoload loop"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Graham Barr <gbarr@ti.com>, Ilya
+ Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199805141910.PAA26994@monk.mps.ohio-state.edu>,
+ <355B475A.C5AD4B90@ti.com>,
+ <E0ya11X-0000hm-00@taurus.cus.cam.ac.uk>
+ Files: utils/h2xs.PL
+
+ Title: "Further improvements to h2ph.PL"
+ From: kstar@chapin.edu
+ Msg-ID: <199805130241.WAA25459@chapin.edu>
+ Files: utils/h2ph.PL
+ Branch: maint-5.004/perl
+ + ext/POSIX/hints/bsdos.pl ext/POSIX/hints/freebsd.pl
+ + ext/POSIX/hints/netbsd.pl ext/POSIX/hints/openbsd.pl
+ ! MANIFEST ext/POSIX/POSIX.xs gv.c lib/English.pm
+ ! lib/ExtUtils/MM_VMS.pm pod/perlfunc.pod t/io/pipe.t
+ ! t/op/exec.t t/op/ipcsem.t util.c utils/h2ph.PL utils/h2xs.PL
----------------
-Version 5.003_18
+Version 5.004_64
----------------
-Yet further down the road to 5.004....
-
- CORE LANGUAGE CHANGES
-
- Title: "Inherited overloading"
- From: Ilya Zakharevich
- Msg-ID: <199612291312.IAA02134@monk.mps.ohio-state.edu>
- Date: Sun, 29 Dec 1996 08:12:54 -0500 (EST)
- Files: gv.c lib/overload.pm perl.h sv.c sv.h t/op/overload.t
-
- Title: "Hide lexicals from C<use>d or C<require>d module (!)"
- From: Chip Salzenberg
- Files: pp_ctl.c
-
- Title: "Closures at file scope must be anonymous"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Warn on '{if,while} ($x = X)' where X is glob, readdir, or <FH>"
- From: Chip Salzenberg
- Files: op.c pod/perldiag.pod
-
- Title: "Warn on 'undef $x; $x OP 1' where OP is *=, /=, %=, or **="
- From: Chip Salzenberg
- Files: pp.c
-
- CORE PORTABILITY
-
- Title: "Ultrix setlocale() workaround"
- From: Chip Salzenberg
- Files: hints/ultrix_4.sh util.c
-
- OTHER CORE CHANGES
-
- Title: "Get rid of 'Leaked scalars'"
- From: Chip Salzenberg
- Files: cop.h gv.c op.c
-
- Title: "Don't forget $c in C<(($a,$b,$c)=(1,2))=(3,4,5)>"
- From: Chip Salzenberg
- Files: pp_hot.c
-
- Title: "Fix core dump on perl_construct()/perl_destruct() loop"
- From: Chip Salzenberg
- Files: perl.c
-
- Title: "Add missing syms to global.sym; update magic doc"
- From: Chip Salzenberg
- Files: global.sym pod/perlguts.pod
-
- TESTS
-
- Title: "Expanded locale.t and misc.t"
- From: Jarkko Hietaniemi
- Files: t/lib/locale.t t/lib/misc.t
-
- Title: "Expanded my.t"
- From: Chip Salzenberg
- Files: t/lib/my.t
-
- Title: "test harness for C<use x.xxxx>"
- From: Graham Barr
- Msg-ID: <32C76882.3F3C7999@tiuk.ti.com>
- Date: Mon, 30 Dec 1996 07:00:18 +0000
- Files: MANIFEST t/op/use.t
-
- Title: "More tests"
- From: Tom Phoenix
- Msg-ID: <Pine.GSO.3.95.961229170736.15213M-100000@solaris.teleport.co
- Date: Sun, 29 Dec 1996 17:46:21 -0800 (PST)
- Files: t/op/each.t t/op/oct.t t/op/quotemeta.t t/op/rand.t
-
- LIBRARY AND EXTENSIONS
-
- Title: "Improving Config.pm"
- From: Tom Phoenix
- Msg-ID: <Pine.GSO.3.95.961230091244.13467L-100000@solaris.teleport.co
- Date: Mon, 30 Dec 1996 09:24:16 -0800 (PST)
- Files: configpm
-
- Title: "File::Copy under OS/2"
- From: Ilya Zakharevich
- Msg-ID: <199612280347.WAA00293@monk.mps.ohio-state.edu>
- Date: Fri, 27 Dec 1996 22:47:24 -0500 (EST)
- Files: lib/File/Copy.pm t/lib/filecopy.t
-
- DOCUMENTATION
-
- Title: "Updates to perllocale.pod"
- From: Dominic Dunlop <domo@slipper.ip.lu>
- Files: pod/perllocale.pod
-
- Title: "Locale-related pod patches, take 2"
- From: Dominic Dunlop <domo@slipper.ip.lu>
- Msg-ID: <v03007800aeea9e488b36@[194.51.248.77]>
- Date: Sat, 28 Dec 1996 10:56:41 +0100
- Files: pod/perl.pod pod/perlform.pod pod/perlfunc.pod pod/perlop.pod
- pod/perlre.pod pod/perlsec.pod
-
- Title: "Re: perldiag.pod entry for "Scalar value @%s{%s} ...""
- From: Roderick Schertler
- Msg-ID: <2043.852051019@eeyore.ibcinc.com>
- Date: Tue, 31 Dec 1996 11:50:19 -0500
- Files: pod/perldiag.pod
-
+____________________________________________________________________________
+[ 983] By: mbeattie on 1998/05/15 14:04:17
+ Log: Integrate win32 branch into mainline.
+ Branch: perl
+ +> Porting/patching.pod t/op/defins.t
+ !> (integrate 107 files)
+____________________________________________________________________________
+[ 982] By: TimBunce on 1998/05/15 12:33:26
+ Log: Title: "comment init_postdump_symbols issues"
+ From: Tim Bunce
+ Files: perl.c
+
+ Title: "Improve sort docs re SUBNAME"
+ From: circle@azstarnet.com
+ Msg-ID: <199804281828.LAA22737@andromeda.azstarnet.com>
+ Files: pod/perlfunc.pod
+ Branch: maint-5.004/perl
+ ! perl.c pod/perlfunc.pod
+____________________________________________________________________________
+[ 981] By: TimBunce on 1998/05/15 11:47:28
+ Log: Title: "Add hook to tie %! to external Errno.pm module (not included)"
+ From: Graham Barr <gbarr@ti.com>
+ Msg-ID: <355080CD.1111BC81@ti.com>
+ Files: gv.c
+ Branch: maint-5.004/perl
+ ! gv.c
+____________________________________________________________________________
+[ 980] By: gsar on 1998/05/15 06:16:13
+ Log: add doc for C<+{}> vs. C<{;}> disambiguation
+ Branch: win32/perl
+ ! pod/perlref.pod
+____________________________________________________________________________
+[ 979] By: gsar on 1998/05/15 04:59:47
+ Log: tweaks to win32 makefiles. This version builds and passes all
+ tests on Solaris/gcc, win32/[bv]c. Looks all set to go.
+ Branch: win32/perl
+ ! win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 978] By: gsar on 1998/05/15 02:41:58
+ Log: merge changes#922,944,949,965,970 from maintbranch
+ Branch: win32/perl
+ + Porting/patching.pod t/op/defins.t
+ ! MANIFEST Porting/makerel ext/POSIX/POSIX.pod gv.c gv.h hv.c
+ ! lib/File/Find.pm op.c pod/Makefile pod/perlfunc.pod
+ ! pod/perlguts.pod pod/perlop.pod pod/pod2man.PL
+ ! t/lib/filefind.t t/op/die_exit.t t/op/ipcmsg.t t/op/ipcsem.t
+ ! utils/perlbug.PL
+____________________________________________________________________________
+[ 977] By: gsar on 1998/05/15 02:15:25
+ Log: merge changes#906,907,909,910 from maintbranch
+ Branch: win32/perl
+ ! MANIFEST doio.c doop.c embed.h embedvar.h global.sym
+ ! keywords.h lib/Carp.pm lib/File/Basename.pm mg.c opcode.h
+ ! perl.c perl.h pod/perldiag.pod pp.c pp_hot.c proto.h sv.c
+ ! util.c
+____________________________________________________________________________
+[ 976] By: gsar on 1998/05/15 01:34:53
+ Log: merge change#905 from maintbranch, minor fixes to get
+ clean build+test on Solaris
+ Branch: win32/perl
+ ! doop.c dump.c embed.h embedvar.h lib/strict.pm mg.c op.h
+ ! opcode.h pod/perlop.pod pod/perlre.pod pp_ctl.c pp_hot.c
+ ! regcomp.c sv.c t/op/taint.t toke.c
+____________________________________________________________________________
+[ 975] By: gsar on 1998/05/14 23:34:26
+ Log: merge change#904 from maintbranch
+ Branch: win32/perl
+ ! doop.c ext/DynaLoader/dl_aix.xs ext/IO/lib/IO/Socket.pm
+ ! ext/NDBM_File/NDBM_File.pm lib/strict.pm lib/subs.pm
+ ! lib/vars.pm op.c perl.c pod/perldiag.pod pod/perlembed.pod
+ ! pod/perlfunc.pod pod/perlsec.pod pp_ctl.c sv.c utils/h2ph.PL
+ ! vms/descrip.mms
+____________________________________________________________________________
+[ 974] By: gsar on 1998/05/14 23:11:05
+ Log: merge change#897 from maintbranch
+ Branch: win32/perl
+ ! Porting/Contract Todo doio.c emacs/ptags embed.h ext/IO/IO.pm
+ ! ext/Opcode/Opcode.pm lib/Carp.pm lib/ExtUtils/MM_Unix.pm
+ ! lib/Pod/Html.pm lib/Term/ReadLine.pm lib/chat2.pl opcode.h
+ ! opcode.pl perl.c pod/perlapio.pod pod/perlcall.pod
+ ! pod/perldebug.pod pod/perldelta.pod pod/perldelta4.pod
+ ! pod/perldiag.pod pod/perlembed.pod pod/perlfaq2.pod
+ ! pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod
+ ! pod/perlfaq7.pod pod/perlfaq8.pod pod/perlform.pod
+ ! pod/perlfunc.pod pod/perlguts.pod pod/perlhist.pod
+ ! pod/perlipc.pod pod/perllocale.pod pod/perlmodlib.pod
+ ! pod/perlop.pod pod/perlre.pod pod/perlref.pod pod/perlrun.pod
+ ! pod/perlstyle.pod pod/perlsub.pod pod/perlsyn.pod
+ ! pod/perltoot.pod pod/perlvar.pod pod/perlxs.pod pod/pod2man.PL
+ ! pod/roffitall pp.c pp_sys.c t/TEST t/op/gv.t t/op/hashwarn.t
+ ! t/op/substr.t vms/vms.c win32/config.bc win32/config.vc
+ ! win32/config_H.bc win32/config_H.vc win32/win32.c
+ ! x2p/find2perl.PL
+____________________________________________________________________________
+[ 973] By: gsar on 1998/05/14 22:24:26
+ Log: integrate mainline
+ Branch: win32/perl
+ + Porting/Contract
+ +> README.beos beos/nm.c ext/POSIX/hints/bsdos.pl
+ +> ext/POSIX/hints/freebsd.pl ext/POSIX/hints/netbsd.pl
+ +> ext/POSIX/hints/openbsd.pl hints/beos.sh pod/perldelta4.pod
+ +> utils/perlcc.PL
+ ! MANIFEST Todo doio.c emacs/ptags embed.h ext/IO/IO.pm
+ ! ext/Opcode/Opcode.pm ext/Socket/Socket.xs hints/irix_5.sh
+ ! hints/netbsd.sh hv.c lib/Benchmark.pm lib/Carp.pm
+ ! lib/ExtUtils/Install.pm lib/ExtUtils/MM_Unix.pm
+ ! lib/Pod/Html.pm lib/Term/ReadLine.pm lib/chat2.pl opcode.h
+ ! opcode.pl perl.c perl.h pod/perlapio.pod pod/perlcall.pod
+ ! pod/perldebug.pod pod/perldelta.pod pod/perldiag.pod
+ ! pod/perlembed.pod pod/perlfaq2.pod pod/perlfaq3.pod
+ ! pod/perlfaq4.pod pod/perlfaq5.pod pod/perlfaq7.pod
+ ! pod/perlfaq8.pod pod/perlform.pod pod/perlfunc.pod
+ ! pod/perlguts.pod pod/perlhist.pod pod/perlipc.pod
+ ! pod/perllocale.pod pod/perlmodlib.pod pod/perlop.pod
+ ! pod/perlre.pod pod/perlref.pod pod/perlrun.pod
+ ! pod/perlstyle.pod pod/perlsub.pod pod/perlsyn.pod
+ ! pod/perltoot.pod pod/perlvar.pod pod/perlxs.pod pod/pod2man.PL
+ ! pod/roffitall pp.c pp_hot.c pp_sys.c sv.c t/TEST t/op/gv.t
+ ! t/op/hashwarn.t t/op/substr.t vms/vms.c win32/config.bc
+ ! win32/config.vc win32/config_H.bc win32/config_H.vc
+ ! win32/win32.c x2p/find2perl.PL
+ !> (integrate 59 files)
+____________________________________________________________________________
+[ 972] By: nick on 1998/05/14 18:09:01
+ Log: Changes to allow compiler with gcc-2.8.1 in C++ mode,
+ Remove K&R style functions, avoid struct/typedef clash.
+ Branch: ansiperl
+ ! bytecode.h byterun.c sv.c toke.c
+____________________________________________________________________________
+[ 971] By: TimBunce on 1998/05/14 16:52:19
+ Log:
+ Title: "fix C<print "foo ${\()}"> (pp_refgen fumbles when G_SCALAR, no args)"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199805070402.AAA02858@aatma.engin.umich.edu>
+ Files: pp.c
+ Branch: maint-5.004/perl
+ ! pp.c
+____________________________________________________________________________
+[ 970] By: TimBunce on 1998/05/14 16:18:06
+ Log:
+ Title: "perlbug reformatted"
+ From: Dominic Dunlop <domo@vo.lu>, Hugo van der Sanden
+ <hv@crypt0.demon.co.uk>
+ Msg-ID: <199805110954.LAA20367@dorlas.elsevier.nl>,
+ <l03130300b17cebcb6d33@[194.222.64.89]>,
+ <v03110702b17ccbab6824@[195.95.102.67]>
+ Files: utils/perlbug.PL
+ Branch: maint-5.004/perl
+ ! utils/perlbug.PL
+____________________________________________________________________________
+[ 969] By: mbeattie on 1998/05/14 16:15:09
+ Log: Integrate win32 branch into mainline
+ Branch: perl
+ +> ext/DynaLoader/DynaLoader.pm.PL hints/openbsd.sh
+ +> t/op/die_exit.t t/op/ipcmsg.t t/op/ipcsem.t t/op/pos.t
+ - ext/DynaLoader/DynaLoader.pm
+ !> (integrate 118 files)
+____________________________________________________________________________
+[ 968] By: mbeattie on 1998/05/14 16:05:57
+ Log: Bump patchlevel to 65
+ Branch: perl
+ ! patchlevel.h
+____________________________________________________________________________
+[ 967] By: mbeattie on 1998/05/14 16:05:19
+ Log: Another fixup of MANIFEST
+ Branch: perl
+ ! MANIFEST
+____________________________________________________________________________
+[ 966] By: mbeattie on 1998/05/14 16:02:20
+ Log: Add missing files to MANIFEST
+ Branch: perl
+ ! MANIFEST
+____________________________________________________________________________
+[ 965] By: TimBunce on 1998/05/14 16:00:11
+ Log:
+ Title: "Sub declaration cost reduced from ~500 to ~100 bytes"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199805050607.CAA02050@monk.mps.ohio-state.edu>
+ Files: gv.h gv.c op.c
+ Branch: maint-5.004/perl
+ ! gv.c gv.h op.c
+____________________________________________________________________________
+[ 964] By: mbeattie on 1998/05/14 15:58:01
+ Log: Subject: [PATCH] Using Getopts::* with strict vars
+ Date: Wed, 29 Apr 1998 22:48:16 -0700 (PDT)
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Branch: perl
+ ! lib/Getopt/Long.pm lib/Getopt/Std.pm lib/strict.pm
+____________________________________________________________________________
+[ 963] By: mbeattie on 1998/05/14 15:56:53
+ Log: Subject: [ PATCH 5.004_64 ] Integrated regression tests for compiler
+ Date: Wed, 29 Apr 1998 21:02:36 -0600 (MDT)
+ From: epeschko@den-mdev1 (Ed Peschko)
+ Branch: perl
+ + utils/perlcc.PL
+ ! MANIFEST Makefile.SH installperl lib/Test/Harness.pm
+ ! pod/Makefile t/TEST t/harness utils/Makefile x2p/Makefile.SH
+____________________________________________________________________________
+[ 962] By: mbeattie on 1998/05/14 15:45:28
+ Log: From: Dan Sugalski <sugalskd@ous.edu>
+ Subject: [PATCH 5.004_64] Final (I hope) doc patch for Thread.pm
+ Date: Wed, 08 Apr 1998 17:08:48 -0700
+ Subject: [PATCH 5.004_64] Revised second Thread.PM doc patch
+ Date: Fri, 08 May 1998 10:49:16 -0700
+ Branch: perl
+ ! ext/Thread/Thread.pm
+____________________________________________________________________________
+[ 961] By: mbeattie on 1998/05/14 15:43:39
+ Log: Subject: Consolidated patch to 5.004_64
+ Date: Wed, 08 Apr 1998 19:44:34 -0400 (EDT)
+ From: Charles Bailey <BAILEY@newman.upenn.edu>
+ Branch: perl
+ ! ext/B/byteperl.c lib/ExtUtils/MM_Unix.pm
+ ! lib/ExtUtils/MM_VMS.pm lib/chat2.pl perl.c pod/perlsub.pod
+ ! vms/config.vms vms/descrip.mms vms/genconfig.pl
+ ! vms/perlvms.pod
+____________________________________________________________________________
+[ 960] By: mbeattie on 1998/05/14 15:41:41
+ Log: Subject: Re: ANNOUNCE: Perl 5.005b1t3 (a.k.a. perl5.004_64) is available
+ Date: 07 Apr 1998 18:31:21 +0200
+ From: JVromans@Squirrel.nl (Johan Vromans)
+ Branch: perl
+ ! lib/Getopt/Long.pm
+____________________________________________________________________________
+[ 959] By: mbeattie on 1998/05/14 15:39:29
+ Log: From: Jarkko Hietaniemi <jhi@iki.fi>
+ Subject: Re: [PATCH] 5.004_04 or 5.004_64: Benchmark.pm: add run-for-some-time
+ Date: Wed, 8 Apr 1998 09:47:45 +0300 (EET DST)
+ Subject: [PATCH] perl 5.004_64+Config_04
+ Date: Thu, 14 May 1998 12:14:07 +0300 (EET DST)
+ Branch: perl
+ ! lib/Benchmark.pm pod/perlfunc.pod
+____________________________________________________________________________
+[ 958] By: mbeattie on 1998/05/14 15:36:30
+ Log: From: kstar@chapin.edu
+ Subject: [PATCH] hints for Irix 6
+ Date: Mon, 6 Apr 1998 15:14:14 -0400 (EDT)
+ Subject: [PATCH 5.004_64] Threads - an easy way for dual installation
+ Date: Wed, 29 Apr 1998 15:39:46 -0400 (EDT)
+ Branch: perl
+ ! INSTALL hints/irix_6.sh installperl
+____________________________________________________________________________
+[ 957] By: mbeattie on 1998/05/14 15:33:48
+ Log: Subject: [PATCH] Install extensions with bootstrap (again) in $archlib
+ Date: Mon, 06 Apr 1998 21:09:24 +0200
+ From: Achim Bohnet <ach@mpe.mpg.de>
+ Branch: perl
+ ! lib/ExtUtils/Install.pm
+____________________________________________________________________________
+[ 956] By: mbeattie on 1998/05/14 15:32:39
+ Log: Subject: [PATCH] Config: Irix 5 hints
+ Date: Mon, 6 Apr 1998 13:12:47 -0400 (EDT)
+ From: kstar@O2.chapin.edu
+ Branch: perl
+ ! hints/irix_5.sh
+____________________________________________________________________________
+[ 955] By: mbeattie on 1998/05/14 15:31:12
+ Log: Subject: PATCH: h2ph produces incorrect code
+ Date: Mon, 6 Apr 1998 23:52:13 +0930 (CST)
+ From: Billy <wdconsta@cs.adelaide.edu.au>
+ Branch: perl
+ ! utils/h2ph.PL
+____________________________________________________________________________
+[ 954] By: mbeattie on 1998/05/14 15:29:27
+ Log: Subject: [PATCH] perldebug.pod
+ Date: Mon, 6 Apr 1998 00:36:57 -0600
+ From: jason stewart <jasons@sandy-home.arc.unm.edu>
+ Branch: perl
+ ! pod/perldebug.pod
+____________________________________________________________________________
+[ 953] By: mbeattie on 1998/05/14 15:28:00
+ Log: From: Dominic Dunlop <domo@vo.lu>
+ Subject: [PATCH 5.004_64]: hints/machten.sh: disable semctl()
+ Date: Wed, 6 May 1998 14:39:32 +0000
+ Subject: [PATCH] Not OK: perl 5.00464 on powerpc-machten 4.1 (hashwarn @INC problem)
+ Date: Sat, 4 Apr 1998 19:44:34 +0000
+ Branch: perl
+ ! hints/machten.sh t/op/hashwarn.t
+____________________________________________________________________________
+[ 952] By: mbeattie on 1998/05/14 15:23:19
+ Log: New pod/perldelta.pod (previous one branched in last change):
+ Subject: [PATCH 5.004_64] Start new perldelta
+ Date: Thu, 23 Apr 1998 12:12:38 -0400 (EDT)
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Branch: perl
+ + pod/perldelta.pod
+____________________________________________________________________________
+[ 951] By: mbeattie on 1998/05/14 15:20:43
+ Log: From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Subject: [PATCH for 5.004_04 and 5.004_64] (Was: Obsoleted svr4.sh)
+ Date: Thu, 23 Apr 1998 11:10:15 -0400 (EDT)
+ Subject: [PATCH 5.004_64] Start new perldelta
+ Date: Thu, 23 Apr 1998 12:12:38 -0400 (EDT)
+ (above branched perldelta -> perldelta4, new perldelta will be
+ created/added next change)
+ Subject: [PATCH] BSD Platforms need STRUCT_TM_HASZONE
+ Date: Tue, 12 May 1998 09:58:49 -0400 (EDT)
+ Branch: perl
+ + ext/POSIX/hints/bsdos.pl ext/POSIX/hints/freebsd.pl
+ + ext/POSIX/hints/netbsd.pl ext/POSIX/hints/openbsd.pl
+ +> pod/perldelta4.pod
+ - pod/perldelta.pod
+ ! MANIFEST hints/svr4.sh
+____________________________________________________________________________
+[ 949] By: TimBunce on 1998/05/14 15:11:30
+ Log:
+ Title: "while($x=<>) no longer warns (implicit defined added)"
+ From: Nick Ing-Simmons <nik@tiuk.ti.com>
+ Msg-ID: <199805051035.LAA27365@pluto.tiuk.ti.com>
+ Files: MANIFEST op.c t/op/defins.t
+ Branch: maint-5.004/perl
+ + t/op/defins.t
+ ! MANIFEST op.c
+____________________________________________________________________________
+[ 948] By: mbeattie on 1998/05/14 15:09:51
+ Log: From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Subject: [PATCH for 5.004_64] Configure patch Config_64-01
+ Date: Tue, 14 Apr 1998 13:04:58 -0400 (EDT)
+ Subject: [PATCH for 5.004_64] Configure patch Config_64-01-02.diff
+ Date: Fri, 17 Apr 1998 11:01:13 -0400 (EDT)
+ Subject: [PATCH for 5.004_64] Configure patch Config_64-02-03.diff
+ Date: Thu, 23 Apr 1998 15:03:20 -0400 (EDT)
+ Subject: [PATCH 5.004_64] Config_64-03-04.diff
+ Date: Wed, 13 May 1998 14:33:30 -0400 (EDT)
+ Branch: perl
+ + README.beos beos/nm.c hints/beos.sh
+ ! Configure INSTALL MANIFEST Makefile.SH Policy_sh.SH
+ ! Porting/Glossary Porting/config.sh Porting/config_H
+ ! Porting/pumpkin.pod Todo cflags.SH config_h.SH
+ ! djgpp/djgppsed.sh doop.c handy.h hints/dos_djgpp.sh
+ ! hints/netbsd.sh hints/solaris_2.sh hints/unicos.sh
+ ! hints/unicosmk.sh hv.h lib/Term/ReadLine.pm perl.h
+ ! plan9/config.plan9 pod/perlfunc.pod pp.c pp_sys.c sv.h
+ ! t/io/pipe.t thread.h vms/config.vms win32/config.bc
+ ! win32/config.vc win32/config_H.bc win32/config_H.vc
+____________________________________________________________________________
+[ 946] By: TimBunce on 1998/05/14 15:07:06
+ Log:
+ Title: "Fix PERL_DESTRUCT_LEVEL core dumps"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199805062301.TAA24599@aatma.engin.umich.edu>
+ Files: perl.c sv.c t/op/misc.t
+ Branch: maint-5.004/perl
+ ! perl.c sv.c t/op/misc.t
+____________________________________________________________________________
+[ 945] By: mbeattie on 1998/05/14 15:00:31
+ Log: Subject: Perl Social Contract
+ Date: 13 Apr 1998 06:16:59 -0700
+ From: Russ Allbery <rra@stanford.edu>
+ Branch: perl
+ + Porting/Contract
+____________________________________________________________________________
+[ 944] By: TimBunce on 1998/05/14 14:59:37
+ Log:
+ Title: "5.004_04-m2 Cleanup of test failures"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199805070416.AAA03082@aatma.engin.umich.edu>
+ Files: t/op/die_exit.t t/op/ipcmsg.t t/op/ipcsem.t t/op/taint.t
+ win32/config.bc win32/config.vc
+ Branch: maint-5.004/perl
+ ! t/op/die_exit.t t/op/ipcmsg.t t/op/ipcsem.t t/op/taint.t
+ ! win32/config.bc win32/config.vc
+____________________________________________________________________________
+[ 943] By: mbeattie on 1998/05/14 14:58:13
+ Log: From: Joshua.Pritikin@NewYork2.dmg.deuba.com
+ Subject: [PATCH 5.004_64] Test.pm update
+ Date: Sat, 4 Apr 1998 08:33:50 -0500
+ Subject: [PATCH 5.004_64] modcount + comments
+ Date: Fri, 17 Apr 1998 16:07:35 -0400
+ Branch: perl
+ ! lib/Test.pm op.c thrdvar.h
+____________________________________________________________________________
+[ 942] By: mbeattie on 1998/05/14 14:49:43
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Subject: [PATCH 5.004_64] newSV
+ Date: Wed, 8 Apr 1998 03:21:03 -0400 (EDT)
+ Subject: [PATCH 5.004_64] Cryptic error from B::CC
+ Date: Sat, 11 Apr 1998 19:52:25 -0400 (EDT)
+ Branch: perl
+ ! ext/B/B/CC.pm handy.h proto.h sv.c
+____________________________________________________________________________
+[ 941] By: mbeattie on 1998/05/14 14:47:29
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Subject: [PATCH 5.004_64] anydbm.t
+ Date: Sat, 4 Apr 1998 01:39:03 -0500 (EST)
+ Subject: [PATCH 5.004_64] threads on OS/2
+ Date: Sat, 4 Apr 1998 01:44:29 -0500 (EST)
+ Subject: [PATCH 5.004_64] Better handling of Perl DLLs under OS/2
+ Date: Sat, 4 Apr 1998 01:47:58 -0500 (EST)
+ Subject: [PATCH 5.004_64] Immediate stop in debugger
+ Date: Sat, 11 Apr 1998 19:50:58 -0400 (EDT)
+ Subject: [PATCH 5.005_64] ptags broken
+ Date: Sat, 11 Apr 1998 22:08:21 -0400 (EDT)
+ Subject: [PATCH 5.004_64] Document switch syntax via RE
+ Date: Sun, 12 Apr 1998 01:12:33 -0400 (EDT)
+ Branch: perl
+ ! emacs/ptags lib/ExtUtils/MM_OS2.pm lib/ExtUtils/Mksymlists.pm
+ ! lib/perl5db.pl os2/Changes os2/Makefile.SHs os2/os2.c
+ ! os2/os2thread.h pod/perlsyn.pod t/lib/anydbm.t
+____________________________________________________________________________
+[ 940] By: mbeattie on 1998/05/14 14:38:44
+ Log: Subject: [PATCH 5.004_64] Build Stdio and DCLSym modules as part of normal VMS perl build
+ Date: Fri, 03 Apr 1998 16:01:57 -0800
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Branch: perl
+ ! vms/descrip.mms vms/ext/DCLsym/Makefile.PL
+ ! vms/ext/Stdio/Makefile.PL vms/ext/Stdio/Stdio.xs
+____________________________________________________________________________
+[ 939] By: mbeattie on 1998/05/14 14:35:42
+ Log: Subject: [PATCH 5.004_64] perl dies in perl_construct when compiled with MULTIPLICITY
+ Date: Fri, 03 Apr 1998 13:58:15 -0800
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Branch: perl
+ ! perl.c
+____________________________________________________________________________
+[ 938] By: gsar on 1998/05/14 10:53:55
+ Log: merge change#896 from maintbranch
+ Branch: win32/perl
+ ! doio.c ext/Socket/Socket.xs lib/Class/Struct.pm lib/Cwd.pm
+ ! lib/File/Find.pm lib/Math/BigInt.pm lib/lib.pm lib/strict.pm
+ ! op.c pod/perldiag.pod pod/perlfunc.pod pp.c pp_ctl.c sv.c
+ ! t/op/gv.t t/op/misc.t t/op/pack.t
+____________________________________________________________________________
+[ 937] By: gsar on 1998/05/14 09:31:34
+ Log: merge change#887 from maintbranch
+ Branch: win32/perl
+ + t/op/die_exit.t t/op/ipcmsg.t t/op/ipcsem.t
+ ! MANIFEST doio.c lib/File/CheckTree.pm lib/Getopt/Long.pm
+ ! lib/Math/BigFloat.pm lib/Text/ParseWords.pm lib/Text/Wrap.pm
+ ! lib/base.pm perl.c pod/perlre.pod t/lib/io_sock.t
+ ! t/lib/io_udp.t t/lib/parsewords.t t/lib/timelocal.t
+ ! t/op/stat.t toke.c utils/h2xs.PL
+____________________________________________________________________________
+[ 936] By: gsar on 1998/05/14 09:06:18
+ Log: merge change#886 from maintbranch
+ Branch: win32/perl
+ ! README.os2 README.vms cop.h ext/DynaLoader/dl_hpux.xs
+ ! ext/POSIX/POSIX.xs ext/POSIX/hints/linux.pl global.sym
+ ! hints/aix.sh hints/bsdos.sh hints/dec_osf.sh hints/hpux.sh
+ ! hints/linux.sh hints/netbsd.sh hints/os2.sh hints/svr4.sh
+ ! lib/ExtUtils/MM_OS2.pm lib/ExtUtils/MM_Unix.pm
+ ! lib/File/Basename.pm lib/File/Path.pm op.c os2/Makefile.SHs
+ ! os2/os2.c os2/perl2cmd.pl perl.c perl.h pod/perlguts.pod
+ ! pod/pod2man.PL pp_ctl.c pp_hot.c pp_sys.c proto.h
+ ! t/lib/filecopy.t util.c utils/perldoc.PL vms/config.vms
+ ! vms/descrip.mms vms/ext/Filespec.pm vms/ext/filespec.t
+ ! vms/test.com
+____________________________________________________________________________
+[ 935] By: gsar on 1998/05/14 07:00:02
+ Log: merge changes#872,873 from maintbranch
+ Branch: win32/perl
+ ! Changes5.004 INSTALL lib/ExtUtils/MakeMaker.pm
+ ! lib/FileHandle.pm lib/Tie/Hash.pm lib/constant.pm
+ ! lib/integer.pm pod/perl.pod pod/perlbook.pod pod/perldsc.pod
+ ! pod/perlfunc.pod pod/perlguts.pod pod/perlhist.pod
+ ! pod/perlop.pod pod/perlre.pod pod/perlrun.pod pod/perlsec.pod
+ ! pod/perltrap.pod pod/perlvar.pod pod/pod2latex.PL
+ ! utils/perldoc.PL
+____________________________________________________________________________
+[ 934] By: gsar on 1998/05/14 06:24:38
+ Log: merge changes#755..759,763,764 from maintbranch
+ Branch: win32/perl
+ + hints/openbsd.sh
+ ! MANIFEST Porting/patchls perl.c perlsdio.h pod/perlfunc.pod
+ ! t/op/pos.t utils/perldoc.PL
+____________________________________________________________________________
+[ 933] By: gsar on 1998/05/14 06:07:31
+ Log: merge change#754 from maintbranch
+ Branch: win32/perl
+ ! perl.c
+____________________________________________________________________________
+[ 932] By: gsar on 1998/05/14 06:03:50
+ Log: merge changes#752,753 from maintbranch
+ Branch: win32/perl
+ + t/op/pos.t
+ ! README ext/GDBM_File/GDBM_File.pm
+ ! ext/SDBM_File/sdbm/Makefile.PL pod/perlsyn.pod
+____________________________________________________________________________
+[ 931] By: gsar on 1998/05/14 05:51:19
+ Log: merge change#745 from maintbranch
+ Branch: win32/perl
+ + ext/DynaLoader/DynaLoader.pm.PL
+ - ext/DynaLoader/DynaLoader.pm
+ ! MANIFEST ext/DynaLoader/Makefile.PL
+____________________________________________________________________________
+[ 930] By: nick on 1998/05/13 20:39:59
+ Log: resolve -at //depot/win32 into ansiperl for C++ testing.
+ Branch: ansiperl
+ ! utils/perldoc.PL
+ !> MANIFEST ext/Fcntl/Fcntl.pm hv.c lib/ExtUtils/Liblist.pm op.c
+ !> perl.c pod/perlfunc.pod pod/perlguts.pod pp.c pp_ctl.c
+ !> regcomp.c regcomp.h regexec.c t/op/hashwarn.t t/op/runlevel.t
+ !> win32/Makefile win32/config.bc win32/config.gc win32/config.vc
+ !> win32/makedef.pl win32/makefile.mk
+____________________________________________________________________________
+[ 929] By: gsar on 1998/05/13 10:13:36
+ Log: merge change#687 from maintbranch
+ Branch: win32/perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 928] By: gsar on 1998/05/13 10:08:13
+ Log: merge change#683 from maintbranch
+ Branch: win32/perl
+ ! pod/perlguts.pod
+____________________________________________________________________________
+[ 927] By: gsar on 1998/05/13 09:51:43
+ Log: merge change#681 from maintbranch
+ Branch: win32/perl
+ ! ext/Fcntl/Fcntl.pm
+____________________________________________________________________________
+[ 926] By: gsar on 1998/05/13 09:47:11
+ Log: merge change#664 from maint branch
+ Branch: win32/perl
+ ! regcomp.c regcomp.h regexec.c
+____________________________________________________________________________
+[ 925] By: gsar on 1998/05/13 08:55:28
+ Log: merge missing part of change#663 from maint branch
+ Branch: win32/perl
+ ! op.c
+____________________________________________________________________________
+[ 924] By: gsar on 1998/05/12 18:50:04
+ Log: remove x586 code gen switch (-5) for Borland, it is non-generic,
+ and seems to generate problematic code for PII.
+ Branch: win32/perl
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 923] By: gsar on 1998/05/12 16:24:02
+ Log: fix test failure
+ Message-Id: <199805120940.KAA01252@pluto.tiuk.ti.com>
+ Date: Tue, 12 May 1998 10:40:57 BST
+ From: Nick.Ing-Simmons@tiuk.ti.com
+ Subject: test buglet
+ Branch: win32/perl
+ ! t/op/hashwarn.t
+____________________________________________________________________________
+[ 922] By: TimBunce on 1998/05/11 20:58:58
+ Log: Assorted patches:
+
+ ------ CORE LANGUAGE ------
+
+ Title: "incorrect return value for hv_iterinit"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199805031848.OAA20618@aatma.engin.umich.edu>
+ Files: pod/perlguts.pod hv.c
+
+ ------ DOCUMENTATION ------
+
+ Title: "perlvar.pod buglet E<EVMSERR>"
+ From: Achim Bohnet <ach@mpe.mpg.de>
+ Msg-ID: <9805041415.AA22185@o09.xray.mpe.mpg.de>
+ Files: pod/perlvar.pod
+
+ Title: "Improve docs for warning about code after an exec()"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Chaim Frenkel
+ <chaimf@concentric.net>
+ Msg-ID: <E0yYUit-0003yb-00@taurus.cus.cam.ac.uk>,
+ <m3ra22qn1z.fsf@chany-p100.emwp.com>
+ Files: pod/perlfunc.pod
+
+ Title: "Remove dead code from pod2man"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0yXmuT-0006Ll-00@ursa.cus.cam.ac.uk>
+ Files: pod/pod2man.PL
+
+ Title: "tweak doc for C<do FILENAME>"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199805090017.UAA06888@aatma.engin.umich.edu>
+ Files: pod/perlfunc.pod
+
+ Title: "Document integer pragma effect on % operator"
+ From: Gisle Aas <gisle@aas.no>
+ Msg-ID: <m3yawjmzhx.fsf@furu.g.aas.no>
+ Files: pod/perlop.pod
+
+ Title: "Reduce rm command line length in pod/Makefile"
+ From: Hugo van der Sanden <h.sanden@elsevier.nl>
+ Msg-ID: <199805041423.QAA13199@dorlas.elsevier.nl>
+ Files: pod/Makefile
+
+ ------ EXTENSIONS ------
+
+ Title: "Clarify Termios usage in POSIX.pod"
+ From: Rocco Caputo <troc@netrus.net>
+ Msg-ID: <199805101952.PAA12738@ns.netrus.net>
+ Files: ext/POSIX/POSIX.pod
+
+ ------ LIBRARY ------
+
+ Title: "Fix File::Find::finddepth typo in trial 2 release"
+ From: koenig@kulturbox.de (Andreas J. Koenig)
+ Msg-ID: <sfcbttflsjz.fsf@dubravka.in-berlin.de>
+ Files: lib/File/Find.pm t/lib/filefind.t
+
+ ------ PORTABILITY - GENERAL ------
+
+ Title: "Add Porting/patching.pod document"
+ From: Daniel Grisinger <dgris@tdrenterprises.com>
+ Msg-ID: <199805030305.XAA16147@relay.pair.com>
+ Files: MANIFEST Porting/patching.pod
+
+ Title: "hints/machten.sh: disable semctl(), align with devel version"
+ From: Dominic Dunlop <domo@vo.lu>
+ Msg-ID: <v03110701b175fc029eb1@[195.95.102.115]>
+ Files: hints/machten.sh
+
+ Title: "Add VMS specifics to Porting/makerel"
+ From: Charles Bailey <BAILEY@newman.upenn.edu>
+ Msg-ID: <01IWDK1LONRQ0026P0@cor.newman.upenn.edu>,
+ <199804271732.SAA13762@toad.ig.co.uk>,
+ <9804250212.AA27695@forte.com>
+ Files: Porting/makerel
+ Branch: maint-5.004/perl
+ + Porting/patching.pod
+ ! MANIFEST Porting/makerel ext/POSIX/POSIX.pod hints/machten.sh
+ ! hv.c lib/File/Find.pm pod/Makefile pod/perlfunc.pod
+ ! pod/perlguts.pod pod/perlop.pod pod/perlvar.pod pod/pod2man.PL
+ ! t/lib/filefind.t
+____________________________________________________________________________
+[ 921] By: gsar on 1998/05/10 02:28:03
+ Log: various tweaks to makefiles
+ Branch: win32/perl
+ ! win32/Makefile win32/makedef.pl win32/makefile.mk
+____________________________________________________________________________
+[ 920] By: gsar on 1998/05/10 02:27:19
+ Log: fix ExtUtils::Liblist mishandling paths with spaces
+ Branch: win32/perl
+ ! lib/ExtUtils/Liblist.pm
+____________________________________________________________________________
+[ 919] By: gsar on 1998/05/09 17:10:15
+ Log: minor cleanup
+ Branch: win32/perl
+ ! MANIFEST perl.c
+____________________________________________________________________________
+[ 918] By: gsar on 1998/05/09 17:09:09
+ Log: protect sortcop from C<sort { sort { ... } ... } ...>
+ Message-Id: <199805082333.TAA06287@aatma.engin.umich.edu>
+ Date: Fri, 08 May 1998 19:33:44 EDT
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Subject: [PATCH] Re: double recursion in sort
+ Branch: win32/perl
+ ! pp_ctl.c t/op/runlevel.t
+____________________________________________________________________________
+[ 917] By: gsar on 1998/05/09 17:05:55
+ Log: c
+ Branch: win32/perl
+ ! win32/config.bc win32/config.gc win32/config.vc
+____________________________________________________________________________
+[ 916] By: gsar on 1998/05/07 03:40:15
+ Log: fix C<print "foo ${\()}"> (pp_refgen fumbles when G_SCALAR, no args)
+ Branch: win32/perl
+ ! pp.c
+____________________________________________________________________________
+[ 915] By: mbeattie on 1998/05/06 13:08:29
+ Log: Speed up pp_entersub for usethreads with only 1 thread running.
+ Branch: perl
+ ! pp_hot.c
+____________________________________________________________________________
+[ 914] By: gsar on 1998/05/03 18:44:38
+ Log: make hv_iterinit() return HvKEYS()
+ Message-Id: <3.0.1.32.19980502162922.009e6320@www.syncad.com>
+ Date: Sat, 02 May 1998 16:29:22 EDT
+ From: "SynaptiCAD, Inc." <sales@syncad.com>
+ Subject: incorrect return value for hv_iterinit
+ Branch: win32/perl
+ ! hv.c pod/perlguts.pod
+____________________________________________________________________________
+[ 913] By: TimBunce on 1998/05/01 22:38:38
+ Log: Update MANIFEST for trial 2.
+ (Porting/Contract lib/Tie/Handle.pm t/op/tiehandle.t)
+ Branch: maint-5.004/perl
+ ! MANIFEST
+____________________________________________________________________________
+[ 912] By: TimBunce on 1998/05/01 22:30:29
+ Log: Add t/op/tiehandle.t as xtext to repository (see change 911)
+ Branch: maint-5.004/perl
+ + t/op/tiehandle.t
+____________________________________________________________________________
+[ 911] By: TimBunce on 1998/05/01 21:35:03
+ Log:
+ Title: "Add ERRSV, ERRHV, DEFSV and SAVE_DEFSV for XS 5.005 compatibility"
+ From: timbo@ig.co.uk (Tim Bunce)
+ Msg-ID: <199804200854.JAA01482@toad.ig.co.uk>
+ Files: perl.h
+
+ Title: "Add WRITE & CLOSE to TIEHANDLE"
+ From: Graham Barr <gbarr@pobox.com>
+ Msg-ID: <34F63DC8.CA95670F@pobox.com>
+ Files: pod/perltie.pod lib/Tie/Handle.pm pp_sys.c t/op/tiehandle.t
+ Branch: maint-5.004/perl
+ + lib/Tie/Handle.pm
+ ! perl.h pod/perltie.pod pp_sys.c
+____________________________________________________________________________
+[ 910] By: TimBunce on 1998/05/01 20:47:47
+ Log:
+ Title: "Add warning for Illegal hex digit"
+ From: Stephen P Potter <spp@spp.users.ds.net>, Stephen Potter
+ <spp@psasolar.colltech.com>, Tim.Bunce@ig.co.uk (Tim Bunce)
+ Msg-ID: <199804232219.SAA02267@spp.users.ds.net>,
+ <199804271409.PAA12819@toad.ig.co.uk>,
+ <199804280307.WAA12332@psasolar.psa.pencom.com>
+ Files: pod/perldiag.pod util.c
+
+ Title: "perl_call_method() bug fix (corrupt op pointer)"
+ From: "Alterman, Eugene" <Eugene.Alterman@bremer-inc.com>
+ Msg-ID: <510415F72ECFD111A31700A0C9B3CCDE3098@efx98digmasa.bremer-inc.com>
+ Files: perl.c
+
+ Title: "Fix printf segmentation fault"
+ From: Hugo van der Sanden <hv@crypt0.demon.co.uk>
+ Msg-ID: <l03130300b16bebdbc314@[194.222.64.89]>
+ Files: pp_hot.c
+
+ Title: "Document changed local($a[$i],$b{$j}) behaviour re delete/splice"
+ From: Charles Bailey <BAILEY@newman.upenn.edu>
+ Msg-ID: <01IVMVIHNZ36001NKH@cor.newman.upenn.edu>
+ Files: pod/perlsub.pod
+ Branch: maint-5.004/perl
+ ! perl.c pod/perldiag.pod pod/perlsub.pod pp_hot.c util.c
+____________________________________________________________________________
+[ 909] By: TimBunce on 1998/05/01 19:44:47
+ Log:
+ Title: "Change Ilya's do_binmode to K&R prototype and move to doio.c"
+ Files: doio.c util.c
+ Branch: maint-5.004/perl
+ ! doio.c util.c
+____________________________________________________________________________
+[ 908] By: gsar on 1998/05/01 19:21:02
+ Log: add AS patch#20 (exposes more global constants)
+ Branch: asperl
+ ! ObjXSub.h byterun.h embed.h embedvar.h global.sym globals.c
+ ! interp.sym ipsock.h ipstdio.h objpp.h perlio.h perlsock.h
+ ! proto.h util.c win32/GenCAPI.pl win32/runperl.c
+____________________________________________________________________________
+[ 907] By: TimBunce on 1998/05/01 17:50:46
+ Log:
+ Title: "Runtime Carp verbosity without aliasing"
+ From: Joshua.Pritikin@NewYork2.dmg.deuba.com, Tim Bunce
+ Msg-ID: <H00000e50003936c@MHS>
+ Files: lib/Carp.pm
+
+ Title: "Fix File::Basename to not untaint results (using new //t flag)"
+ From: Eric Hammond <erich@finity.citysearch.com>, Tom Phoenix
+ <rootbeer@teleport.com>
+ Msg-ID: <199710070515.WAA00682@finity.citysearch.com>,
+ <Pine.GSO.3.96.971007074114.14211J-100000@usertest.teleport.com>
+ Files: lib/File/Basename.pm
+ Branch: maint-5.004/perl
+ ! lib/Carp.pm lib/File/Basename.pm
+____________________________________________________________________________
+[ 906] By: TimBunce on 1998/04/28 11:04:49
+ Log:
+ ------ CORE LANGUAGE ------
+
+ Title: "5.004_04m5t1: Fix dangling references in LVs", "Fix dangling
+ references in LVs"
+ From: Spider Boardman <spider@orb.nashua.nh.us>
+ Msg-ID: <199804010541.AAA32615@Orb.Nashua.NH.US>,
+ <19980422164037.D29222@perl.org>
+ Files: embed.h keywords.h opcode.h perl.h proto.h doop.c global.sym mg.c
+ pp.c sv.c
+
+ Title: "Fix SvGMAGIC typo in change 904"
+ Files: doop.c
+ Branch: maint-5.004/perl
+ ! doop.c embed.h global.sym keywords.h mg.c opcode.h perl.h pp.c
+ ! proto.h sv.c
+____________________________________________________________________________
+[ 905] By: TimBunce on 1998/04/28 10:32:20
+ Log: Regexp patches
+
+ Title: "New regex flag //t to leave $1 etc. tainted"
+ From: Chip Salzenberg <chip@pobox.com>, Tim Bunce <Tim.Bunce@ig.co.uk>
+ Msg-ID: <19980310192640.37826@cyprus>
+ Files: pod/perlop.pod pod/perlre.pod op.h dump.c mg.c pp_hot.c sv.c
+ t/op/taint.t toke.c
+
+ Title: "Don't accidentally untaint target of s///"
+ From: Chip Salzenberg <chip@pobox.com>
+ Msg-ID: <19980310151756.24767@cyprus>
+ Files: pp_ctl.c pp_hot.c t/op/taint.t
+
+ Title: "Allow but ignore embedded /...(?o).../ in regexp"
+ From: h.sanden@elsevier.nl (Hugo van der Sanden)
+ Msg-ID: <199804201243.OAA08244@dorlas.elsevier.nl>
+ Files: regcomp.c
+ Branch: maint-5.004/perl
+ ! dump.c mg.c op.h pod/perlop.pod pod/perlre.pod pp_ctl.c
+ ! pp_hot.c regcomp.c sv.c t/op/taint.t toke.c
+____________________________________________________________________________
+[ 904] By: TimBunce on 1998/04/27 20:20:21
+ Log: Assorted patches:
+
+ ------ CORE LANGUAGE ------
+
+ Title: "Protect join() against double reads on undef and SvGMAGICALs"
+ From: Chip Salzenberg <chip@perlsupport.com>, Tim Bunce
+ <Tim.Bunce@ig.co.uk>
+ Msg-ID: <19980424080630.D13985@perl.org>
+ Files: doop.c
+
+ Title: "Better error message for require failure"
+ From: epeschko@den-mdev1 (Ed Peschko)
+ Msg-ID: <199804240047.SAA24155@den-mdev1.co.csgsystems.com>
+ Files: pod/perldiag.pod pp_ctl.c
+
+ Title: "fixes for various noises under PERL_DESTRUCT_LEVEL"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199804231926.PAA23969@aatma.engin.umich.edu>
+ Files: perl.c
+
+ Title: "Fix nice_chunk memory leak"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199804052347.TAA15699@aatma.engin.umich.edu>
+ Files: sv.c
+
+ Title: "-2.0 vs. -2 (was Number representations)"
+ From: Chip Salzenberg <chip@pobox.com>
+ Msg-ID: <19980309185652.11231@cyprus>
+ Files: op.c
+
+ Title: "perl.c fixes for -DUNEXEC"
+ From: Matt Wette <mwette@mr-ed.jpl.nasa.gov>, Matthew R Wette
+ <mwette@mr-ed.jpl.nasa.gov>
+ Msg-ID: <199710152146.OAA07283@mr-ed.jpl.nasa.gov>
+ Files: perl.c
+
+ ------ DOCUMENTATION ------
+
+ Title: "perlcall is Perl from C, not C from Perl"
+ From: Steve A Fink <sfink@cs.berkeley.edu>
+ Files: pod/perlembed.pod
+
+ Title: "Clarify require "Foo::Bar" non-bareword issue"
+ From: Dominique Dumont <domi@ss7serv.grenoble.hp.com>
+ Msg-ID: <199804231527.AA153445256@ss7serv.grenoble.hp.com>
+ Files: pod/perlfunc.pod
+
+ Title: "(repost) new text for perlsec", "new text for perlsec"
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID: <Pine.GSO.3.96.980423161605.5518N-100000@user2.teleport.com>
+ Files: pod/perlsec.pod
+
+ ------ EXTENSIONS ------
+
+ Title: "IO::Socket->socketpair broken (typo)"
+ From: Olaf Titz <olaf@bigred.inka.de>
+ Msg-ID: <19980425224535.2807.qmail@bigred.inka.de>
+ Files: ext/IO/lib/IO/Socket.pm
+
+ Title: "NDBM_File man page needs Fcntl"
+ From: "Danny R. Faught" <faught@mailhost.rsn.hp.com>
+ Msg-ID: <199707011500.IAA00601@palrel3.hp.com>
+ Files: ext/NDBM_File/NDBM_File.pm
+
+ ------ LIBRARY ------
+
+ Title: "Documentation discrepancy: pragmatic modules"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, h.sanden@elsevier.nl (Hugo van der Sanden)
+ Msg-ID: <199804221525.RAA12695@dorlas.elsevier.nl>,
+ <E0ySPhk-00034f-00@taurus.cus.cam.ac.uk>
+ Files: lib/strict.pm lib/subs.pm lib/vars.pm
+
+ ------ PORTABILITY - GENERAL ------
+
+ Title: "Updated hints file for svr4"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980423110522.26621A-100000@newton.phys>
+ Files: hints/svr4.sh
+
+ Title: "Pumpkin update -- shared libperl.so location"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980424115837.6222A-100000@newton.phys>
+ Files: Porting/pumpkin.pod
+
+ Title: "perl compile fix for AIX 4.3"
+ From: Jens-Uwe Mager <jum@helios.de>
+ Msg-ID: <199804261611.SAA34728@ans.helios.de>
+ Files: ext/DynaLoader/dl_aix.xs
+
+ Title: "Dynaloader build on VMS",
+ From: pvhp@forte.com (Peter Prymmer), timbo@ig.co.uk (Tim Bunce)
+ Msg-ID: <199804271732.SAA13762@toad.ig.co.uk>, <9804250212.AA27695@forte.com>
+ Files: vms/descrip.mms
+
+ ------ UTILITIES ------
+
+ Title: "Major update to h2ph.PL"
+ From: Billy <wdconsta@cs.adelaide.edu.au>
+ Msg-ID: <Pine.SV4.3.93.980424031837.20782A-200000@ermintrude.teaching.cs.adelaide.edu.au>
+ Files: utils/h2ph.PL
+ Branch: maint-5.004/perl
+ ! Porting/pumpkin.pod doop.c ext/DynaLoader/dl_aix.xs
+ ! ext/IO/lib/IO/Socket.pm ext/NDBM_File/NDBM_File.pm
+ ! hints/svr4.sh lib/strict.pm lib/subs.pm lib/vars.pm op.c
+ ! perl.c pod/perldiag.pod pod/perlembed.pod pod/perlfunc.pod
+ ! pod/perlsec.pod pp_ctl.c sv.c utils/h2ph.PL vms/descrip.mms
+____________________________________________________________________________
+[ 903] By: gsar on 1998/04/25 22:27:19
+ Log: add AS patch#19 (adds socket layer generation to GenCAPI.pl)
+ Branch: asperl
+ ! win32/GenCAPI.pl
+____________________________________________________________________________
+[ 902] By: nick on 1998/04/25 16:35:08
+ Log: Case sensitive tweak to perldoc.PL
+ Branch: ansiperl
+ ! utils/perldoc.PL
+____________________________________________________________________________
+[ 901] By: nick on 1998/04/25 15:16:54
+ Log: Implement use attrs qw(locked package);
+ Passes all tests except posix (hangs/dies) in sigaction test after
+ printing "ok 9".
+ Branch: ansiperl
+ ! cv.h ext/attrs/attrs.pm ext/attrs/attrs.xs pp_hot.c
+____________________________________________________________________________
+[ 900] By: nick on 1998/04/25 13:58:17
+ Log: Auto-insert defined() test in while when test expression is
+ readline (i.e. <>), glob, readdir, or each.
+ Branch: ansiperl
+ + t/op/defins.t
+ ! op.c pod/perlop.pod
+____________________________________________________________________________
+[ 899] By: nick on 1998/04/25 13:14:52
+ Log: Resolve ansiperl against win32 branch
+ Branch: ansiperl
+ +> (branch 53 files)
+ - config_H
+ !> (integrate 227 files)
+____________________________________________________________________________
+[ 898] By: gsar on 1998/04/24 17:01:05
+ Log: add AS patch#18
+ Branch: asperl
+ ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/xsubpp win32/GenCAPI.pl
+____________________________________________________________________________
+[ 897] By: TimBunce on 1998/04/23 19:49:22
+ Log: Assorted patches:
+
+ ------ CORE LANGUAGE ------
+
+ Title: "fix for "Unbalanced string table refcount""
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199804042251.RAA25527@aatma.engin.umich.edu>
+ Files: sv.c
+
+ Title: "Allow more lenient switch processing"
+ From: "John L. Allen" <allen@grumman.com>
+ Msg-ID: <199803251638.LAA22664@gateway.grumman.com>
+ Files: perl.c
+
+ Title: "Add fourth arg to substr: substr EXPR,OFFSET,LEN,REPLACEMENT"
+ From: Gisle Aas <gisle@aas.no>
+ Msg-ID: <m3g1jglqtm.fsf@furu.g.aas.no>
+ Files: pod/perlfunc.pod Todo opcode.pl pp.c t/op/substr.t
+
+ Title: "Odd number of elements in hash list."
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID: <Pine.GSO.3.96.980328151929.29336D-100000@user2.teleport.com>
+ Files: MANIFEST pod/perldiag.pod pp.c pp_hot.c t/op/hashwarn.t
+
+ Title: "another destruct_level fix"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199804030105.UAA04400@aatma.engin.umich.edu>
+ Files: hv.c
+
+ Title: "bidirectional pipe warning blues"
+ From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ Msg-ID: <9804082151.AA20399@claudius.bfsec.bt.co.uk>
+ Files: doio.c
+
+ Title: "stale pointers after realloc (MEXTEND in pp_print and pp_prtf)"
+ From: Malcolm Beattie <mbeattie@sable.ox.ac.uk>
+ Msg-ID: <199801191107.LAA17979@sable.ox.ac.uk>
+ Files: pp_hot.c pp_sys.c
+
+ Title: "unimplemented umask() should return undef not die"
+ From: kstar@chapin.edu (Kurt D. Starsinic)
+ Msg-ID: <199803120515.VAA08660@chapin.edu>
+ Files: pod/perlfunc.pod pp_sys.c
+
+ Title: "warning for: bless $foo, """
+ From: Joshua.Pritikin@NewYork2.dmg.deuba.com
+ Msg-ID: <H00000e5000378a0@MHS>
+ Files: pod/perldiag.pod pp.c
+
+ ------ DOCUMENTATION ------
+
+ Title: "Mention SWIG in perlxs.pod"
+ From: Steve A Fink <sfink@cs.berkeley.edu>
+ Msg-ID: <Pine.HPP.3.96.980408154956.20990K-100000@brooksie.CS.Berkeley.EDU>
+ Files: pod/perlxs.pod
+
+ Title: "fix-up of previous perlre.pod patch"
+ From: Ted Ashton <ashted@southern.edu>
+ Msg-ID: <199803031540.KAA09388@ns.southern.edu>
+ Files: pod/perlre.pod
+
+ Title: "long list of man page nitpicks"
+ From: Greg Bacon <gbacon@mickey.cs.uah.edu>, Tom Christiansen
+ <tchrist@jhereg.perl.com>
+ Msg-ID: <199804221844.NAA08338@pluto.cs.uah.edu>,
+ <199804222204.QAA20805@jhereg.perl.com>
+ Files: pod/perlapio.pod pod/perlcall.pod pod/perldebug.pod pod/perldelta.pod
+ pod/perldiag.pod pod/perlembed.pod pod/perlfaq2.pod
+ pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod
+ pod/perlfaq7.pod pod/perlfaq8.pod pod/perlform.pod
+ pod/perlfunc.pod pod/perlguts.pod pod/perlipc.pod
+ pod/perllocale.pod pod/perlmodlib.pod pod/perlop.pod
+ pod/perlre.pod pod/perlref.pod pod/perlrun.pod
+ pod/perlstyle.pod pod/perlsub.pod pod/perlsyn.pod
+ pod/perltoot.pod pod/perlvar.pod pod/perlxs.pod
+ pod/pod2man.PL
+
+ Title: "document that system() does not set $! when it fails"
+ From: "Mark R. Levinson" <mrl@isc.upenn.edu>
+ Msg-ID: <199803011946.OAA31942@anaximander.dccs.upenn.edu>
+ Files: pod/perlfunc.pod
+
+ Title: "Fix pod/roffitall execute permission"
+ From: lvirden@cas.org
+ Msg-ID: <1997Nov17.132031.2589892@cor.newman>
+ Files: pod/roffitall
+
+ Title: "document when split ignores trailing empty fields"
+ From: Hugo van der Sanden <hv@crypt0.demon.co.uk>
+ Msg-ID: <l03130300b14fac832b77@[194.222.64.89]>
+ Files: pod/perlfunc.pod
+
+ ------ EXTENSIONS ------
+
+ Title: "Buglet in Opcode.pm documentation"
+ From: Horst von Brand <vonbrand@sleipnir.valparaiso.cl>
+ Msg-ID: <199804170349.XAA32445@sleipnir.valparaiso.cl>
+ Files: ext/Opcode/Opcode.pm
+
+ Title: "Failure to append to perllocal.pod should not be fatal"
+ From: koenig@kulturbox.de (Andreas J. Koenig)
+ Msg-ID: <sfciuogy67x.fsf@dubravka.in-berlin.de>
+ Files: lib/ExtUtils/MM_Unix.pm
+
+ Title: "Document that IO.pm does not load IO::Select etc"
+ From: Graham Barr <gbarr@ti.com>
+ Msg-ID: <353B48F1.64E35A63@ti.com>
+ Files: ext/IO/IO.pm
+
+ Title: "Install extensions with bootstrap (again) in $archlib"
+ From: Achim Bohnet <ach@mpe.mpg.de>, koenig@kulturbox.de (Andreas J.
+ Koenig)
+ Msg-ID: <9804061909.AA12675@o09.xray.mpe.mpg.de>,
+ <sfc90oxc0uj.fsf@dubravka.in-berlin.de>
+ Files: lib/ExtUtils/Install.pm
+
+ Title: "glibc2.0.6 missing MSG_* <sys/socket.h> defines."
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980406113950.3166L-100000@newton.phys>
+ Files: ext/Socket/Socket.xs
+
+ ------ LIBRARY ------
+
+ Title: "Benchmark.pm: add run-for-some-time mode"
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199804080647.JAA15136@alpha.hut.fi>
+ Files: lib/Benchmark.pm
+
+ Title: "Comments added to Carp.pm"
+ From: Andy Wardley <abw@cre.canon.co.uk>, Chip Salzenberg
+ <chip@perlsupport.com>, Tom Christiansen
+ <tchrist@jhereg.perl.com>
+ Msg-ID: <19980422164242.E29222@perl.org>,
+ <199804222033.OAA17959@jhereg.perl.com>,
+ <980409182357.ZM21638@bandanna>
+ Files: lib/Carp.pm
+
+ Title: "chat2.pl fix"
+ From: Charles Bailey <BAILEY@newman.upenn.edu>
+ Msg-ID: <01IVMVF507PO001NKH@cor.newman.upenn.edu>
+ Files: lib/chat2.pl
+
+ Title: "lib/Pod/Html.pm"
+ From: d-lewart@uiuc.edu (Daniel S. Lewart)
+ Msg-ID: <199710170718.DAA25472@staff1.cso.uiuc.edu>,
+ <199710180417.AAA19778@staff2.cso.uiuc.edu>
+ Files: lib/Pod/Html.pm
+
+ Title: "ormaments method in Term/ReadLine.pm causes warning with string
+ arg."
+ From: hiroo.hayashi@computer.org
+ Msg-ID: <199804061519.AAA21907@mail.fb3.so-net.ne.jp>
+ Files: lib/Term/ReadLine.pm
+
+ ------ OTHER CHANGES ------
+
+ Title: "ptags broken"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199804120208.WAA29264@monk.mps.ohio-state.edu>
+ Files: emacs/ptags
+
+ ------ PORTABILITY - WIN32 ------
+
+ Title: "win32 tweaks (signals and crypt support)"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199804170505.BAA06413@aatma.engin.umich.edu>
+ Files: perl.h win32/config.bc win32/config.vc win32/config_H.bc
+ win32/config_H.vc win32/win32.c
+
+ ------ PORTABILITY - GENERAL ------
+
+ Title: "Add Social Contract (2nd Draft) as Porting/Contract"
+ From: Russ Allbery <rra@stanford.edu>
+ Msg-ID: <m3btw66n8i.fsf@windlord.Stanford.EDU>
+ Files: Porting/Contract
+
+ Title: "Config: Irix 5 hints"
+ From: kstar@O2.chapin.edu
+ Msg-ID: <199804061712.NAA22823@O2.chapin.edu>
+ Files: hints/irix_5.sh
+
+ Title: "VMS patches to 5.004_03"
+ From: Charles Bailey <BAILEY@newman.upenn.edu>
+ Msg-ID: <01IVYJS0L8D200209B@cor.newman.upenn.edu>
+ Files: vms/vms.c
+
+ Title: "hints/netbsd.sh - enable vfork"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980417110749.19327B-100000@newton.phys>
+ Files: hints/netbsd.sh
+
+ ------ UTILITIES ------
+
+ Title: "support find2perl -follow"
+ From: Billy <wdconsta@cs.adelaide.edu.au>
+ Msg-ID: <Pine.SV4.3.93.980408005903.24081A-100000@ermintrude.teaching.cs.adelaide.edu.au>
+ Files: x2p/find2perl.PL
+ Branch: maint-5.004/perl
+ + Porting/Contract t/op/hashwarn.t
+ ! MANIFEST Todo doio.c emacs/ptags embed.h ext/IO/IO.pm
+ ! ext/Opcode/Opcode.pm ext/Socket/Socket.xs hints/irix_5.sh
+ ! hints/netbsd.sh hv.c lib/Benchmark.pm lib/Carp.pm
+ ! lib/ExtUtils/Install.pm lib/ExtUtils/MM_Unix.pm
+ ! lib/Pod/Html.pm lib/Term/ReadLine.pm lib/chat2.pl opcode.h
+ ! opcode.pl perl.c perl.h pod/perlapio.pod pod/perlcall.pod
+ ! pod/perldebug.pod pod/perldelta.pod pod/perldiag.pod
+ ! pod/perlembed.pod pod/perlfaq2.pod pod/perlfaq3.pod
+ ! pod/perlfaq4.pod pod/perlfaq5.pod pod/perlfaq7.pod
+ ! pod/perlfaq8.pod pod/perlform.pod pod/perlfunc.pod
+ ! pod/perlguts.pod pod/perlhist.pod pod/perlipc.pod
+ ! pod/perllocale.pod pod/perlmodlib.pod pod/perlop.pod
+ ! pod/perlre.pod pod/perlref.pod pod/perlrun.pod
+ ! pod/perlstyle.pod pod/perlsub.pod pod/perlsyn.pod
+ ! pod/perltoot.pod pod/perlvar.pod pod/perlxs.pod pod/pod2man.PL
+ ! pod/roffitall pp.c pp_hot.c pp_sys.c sv.c t/TEST t/op/gv.t
+ ! t/op/substr.t vms/vms.c win32/config.bc win32/config.vc
+ ! win32/config_H.bc win32/config_H.vc win32/win32.c
+ ! x2p/find2perl.PL
+____________________________________________________________________________
+[ 896] By: TimBunce on 1998/04/22 11:49:24
+ Log: Assorted patches:
+
+ ------ CORE LANGUAGE ------
+
+ Title: "Additional regex-cache patch"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Msg-ID: <19980305104831.38100@cyprus>
+ Files: pp_ctl.c
+
+ Title: "Conservative C<*x = undef> patch"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Msg-ID: <19980310163310.48509@cyprus>
+ Files: pod/perldiag.pod pod/perlfunc.pod pp.c sv.c t/op/gv.t
+
+ Title: "Consider @ARGV to be plain files if inplace (-i)"
+ From: Chip Salzenberg <salzench@nielsenmedia.com>
+ Msg-ID: <199802042106.QAA04082@nielsenmedia.com>
+ Files: doio.c
+
+ Title: "Fix semctl for Linux, Sun and SVR4"
+ From: Graham Barr <gbarr@ti.com>, lvirden@cas.org (Larry W. Virden, x2487)
+ Msg-ID: <3484247D.BB036D39@ti.com>, <9712021313.AA11495@cas.org>
+ Files: doio.c
+
+ Title: "C<dSP> entails using C<SP>, not C<sp>"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199803070149.UAA12217@aatma.engin.umich.edu>
+ Files: pod/perlcall.pod pod/perlembed.pod pod/perlguts.pod pod/perlxs.pod
+ doio.c doop.c ext/DB_File/DB_File.xs
+ ext/DynaLoader/dl_dld.xs ext/Opcode/Opcode.xs
+ ext/POSIX/POSIX.xs ext/Socket/Socket.xs gv.c
+ lib/ExtUtils/typemap mg.c os2/OS2/REXX/REXX.xs
+ win32/win32.c
+
+ Title: "Make autouse -w-safe"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199803030236.VAA13244@monk.mps.ohio-state.edu>
+ Files: lib/autouse.pm op.c sv.c
+
+ Title: "Misleading error on close of unopened handle"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0y4R07-0003PH-00@ursa.cus.cam.ac.uk>
+ Files: doio.c
+
+ Title: "Confusing error from perl -e "x'""
+ From: Hans Mulder <hansmu@xs4all.nl>
+ Msg-ID: <1998Mar25.174320.2866352@cor.newman.upenn.edu>
+ Files: toke.c
+
+ Title: "Add HAS_GNULIBC define"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980305115202.9180K-100000@newton.phys>
+ Files: config_H config_h.SH
+
+ Title: "h_errno might not be an int"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980325165059.22255D-100000@newton.phys>
+ Files: pp_sys.c
+
+ Title: "Revised taint hole closer", "Revised taint hole closer"
+ From: Chip Salzenberg <chip@atlantic.net>, Ilya Zakharevich
+ <ilya@math.ohio-state.edu>
+ Msg-ID: <19980310222127.09350@cyprus>,
+ <199803110554.AAA29157@monk.mps.ohio-state.edu>
+ Files: doio.c
+
+ Title: "SEGV compiling localised lexical in perl5.004_05t1"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>, h.sanden@elsevier.nl (Hugo
+ van der Sanden)
+ Msg-ID: <199803171530.QAA24053@dorlas.elsevier.nl>,
+ <199803171727.MAA05234@aatma.engin.umich.edu>
+ Files: op.c t/op/misc.t
+
+ Title: "Stale SP in pp_substr"
+ From: Stephen McCamant <alias@mcs.com>
+ Msg-ID: <m0yFsTS-000EZpC@alias-2.pr.mcs.net>
+ Files: pp.c
+
+ Title: "Statement unlikely to be reached warning"
+ From: Hans Mulder <hansm@icgned.nl>
+ Msg-ID: <1997Dec24.171511.2683516@cor.newman>
+ Files: op.c
+
+ Title: "Tainting propagates from nowhere"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199803140411.XAA09343@aatma.engin.umich.edu>
+ Files: pp.c
+
+ Title: "two trivial tweaks to 5.004m5t1"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199803060553.AAA28461@aatma.engin.umich.edu>
+ Files: proto.h win32/Makefile
+
+ Title: "unpacking negatives on Alpha"
+ From: Achim Bohnet <ach@mpe.mpg.de>
+ Msg-ID: <9710201503.AA24797@o09.xray.mpe.mpg.de>
+ Files: pp.c t/op/pack.t
+
+ ------ LIBRARY AND EXTENSIONS ------
+
+ Title: "Cwd.pm: abs_path() and fast_abs_path() plus code merge"
+ From: Graham Barr <gbarr@ti.com>
+ Msg-ID: <3482F365.4A0486BA@ti.com>
+ Files: lib/Cwd.pm
+
+ Title: "Math/BigInt.pm, fixed use of undefined value."
+ From: abigail@fnx.com
+ Msg-ID: <19980313052452.27365.qmail@betelgeuse.wayne.fnx.com>
+ Files: lib/Math/BigInt.pm
+
+ Title: "File::Find rewrite"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199803052344.SAA01008@monk.mps.ohio-state.edu>
+ Files: lib/File/Find.pm
+
+ Title: "efficient version of strict.pm"
+ From: koenig@anna.mind.de (Andreas J. Koenig)
+ Msg-ID: <sfcpvonhdnc.fsf@anna.in-berlin.de>
+ Files: lib/strict.pm
+
+ Title: "Socket occasional SEGV in pack_sockaddr_un"
+ From: Trevor Blackwell <tlb@viaweb.com>
+ Msg-ID: <199710281804.NAA09632@wagg.viaweb.com>
+ Files: ext/Socket/Socket.xs
+
+ Title: "Warning on mis-use of 'use lib'"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Tom Phoenix
+ <rootbeer@teleport.com>, chip@atlantic.net
+ Msg-ID: <199801270435.XAA14147@cyprus.atlantic.net>,
+ <E0xx9x4-0006jc-00@ursa.cus.cam.ac.uk>,
+ <Pine.GSO.3.96.980126192445.22284N-100000@user2.teleport.com>
+ Files: lib/lib.pm
+
+ Title: "bug in Class::Struct"
+ From: Tom Christiansen <tchrist@toy.perl.com>
+ Msg-ID: <199803290814.KAA05699@toy.perl.com>
+ Files: lib/Class/Struct.pm
+
+ Title: "Allow POSIX to export nice()"
+ From: bkeelerx@iwa.dp.intel.com (Bruce J. Keeler)
+ Msg-ID: <eclg1kf5yf0.fsf@ws010.dp.intel.com>
+ Files: ext/POSIX/POSIX.pm
+
+ Title: "'use Env' on WinNT/95 fails"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199803280511.AAA15933@aatma.engin.umich.edu>
+ Files: lib/Env.pm
+
+ ------ OTHER CHANGES ------
+
+ Title: "mv-if-diff"
+ From: Robin Barker <rmb1@cise.npl.co.uk>
+ Msg-ID: <14572.9803271806@tempest.cise.npl.co.uk>
+ Files: mv-if-diff
+
+ ------ PORTABILITY - WIN32 ------
+
+ Title: "fix various problems with backticks on win32"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199803070705.CAA15945@aatma.engin.umich.edu>
+ Files: win32/config_h.PL win32/win32.c
+
+ ------ TESTS ------
+
+ Title: "Fix bug in locale.t"
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199801042148.XAA08599@alpha.hut.fi>
+ Files: t/pragma/locale.t
+ Branch: maint-5.004/perl
+ ! config_H config_h.SH doio.c doop.c ext/DB_File/DB_File.xs
+ ! ext/DynaLoader/dl_dld.xs ext/Opcode/Opcode.xs
+ ! ext/POSIX/POSIX.pm ext/POSIX/POSIX.xs ext/Socket/Socket.xs
+ ! gv.c lib/Class/Struct.pm lib/Cwd.pm lib/Env.pm
+ ! lib/ExtUtils/typemap lib/File/Find.pm lib/Math/BigInt.pm
+ ! lib/autouse.pm lib/lib.pm lib/strict.pm mg.c mv-if-diff op.c
+ ! os2/OS2/REXX/REXX.xs pod/perlcall.pod pod/perldiag.pod
+ ! pod/perlembed.pod pod/perlfunc.pod pod/perlguts.pod
+ ! pod/perlxs.pod pp.c pp_ctl.c pp_sys.c proto.h sv.c t/op/gv.t
+ ! t/op/misc.t t/op/pack.t t/pragma/locale.t toke.c
+ ! win32/Makefile win32/config_h.PL win32/win32.c
+____________________________________________________________________________
+[ 895] By: gsar on 1998/04/22 03:13:19
+ Log: intern -> sys_intern
+ Branch: win32/perl
+ ! embedvar.h interp.sym intrpvar.h win32/win32.h
+____________________________________________________________________________
+[ 894] By: gsar on 1998/04/22 02:42:20
+ Log: hand-applied patch along with small tweaks
+ Message-Id: <35400e2a.13538517@smtp1.ibm.net>
+ Date: Tue, 21 Apr 1998 23:31:06 +0200
+ From: jan.dubois@ibm.net (Jan Dubois)
+ Subject: Re: Per-Interpreter variables for win32.c
+ Branch: win32/perl
+ ! embedvar.h interp.sym intrpvar.h perl.c perl.h proto.h
+ ! win32/makedef.pl win32/win32.c win32/win32.h
+____________________________________________________________________________
+[ 893] By: gsar on 1998/04/21 03:42:21
+ Log: add AS patch#17
+ Branch: asperl
+ + win32/GenCAPI.pl
+ ! MANIFEST XSUB.h cv.h ipstdio.h lib/ExtUtils/MM_Unix.pm
+ ! lib/ExtUtils/MM_Win32.pm lib/ExtUtils/MakeMaker.pm
+ ! lib/ExtUtils/Mksymlists.pm lib/ExtUtils/xsubpp op.c perl.h
+ ! pp_ctl.c pp_hot.c proto.h sv.h thread.h win32/Makefile
+ ! win32/dl_win32.xs win32/makefile.mk win32/runperl.c
+ ! win32/win32.c
+____________________________________________________________________________
+[ 892] By: gsar on 1998/04/20 20:51:50
+ Log: add AS patch#16
+ Branch: asperl
+ ! globals.c ipdir.h perl.h perlvars.h regcomp.h win32/Makefile
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 891] By: gsar on 1998/04/19 23:50:34
+ Log: tweak doc for C<do FILENAME>
+ Branch: win32/perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 890] By: gsar on 1998/04/19 01:08:11
+ Log: use a pidtable that grows dynamically for popen()
+ Message-Id: <3539f434.44835409@smtp1.ibm.net>
+ Date: Sat, 18 Apr 1998 21:01:27 +0200
+ From: jan.dubois@ibm.net (Jan Dubois)
+ Subject: Re: [PATCH] for bug in 5.004_64 when compiled with MSC++ 4.2
+ Branch: win32/perl
+ ! win32/win32.c
+____________________________________________________________________________
+[ 889] By: gsar on 1998/04/17 02:13:58
+ Log: support POSIX, enable more locale tests
+ Branch: win32/perl
+ ! ext/POSIX/Makefile.PL ext/POSIX/POSIX.pm ext/POSIX/POSIX.xs
+ ! t/lib/posix.t t/pragma/locale.t win32/Makefile
+ ! win32/makedef.pl win32/makefile.mk
+____________________________________________________________________________
+[ 888] By: mbeattie on 1998/04/14 16:22:51
+ Log: CC did "<<" instead of ">>" for right-shift on ints.
+ Branch: perl
+ ! ext/B/B/CC.pm
+____________________________________________________________________________
+[ 887] By: TimBunce on 1998/04/10 17:44:55
+ Log: Assorted patches:
+
+ ------ CORE LANGUAGE ------
+
+ Title: "Re: die exits with 0"
+ From: Robin Barker <rmb1@cise.npl.co.uk>
+ Files: perl.c t/op/die_exit.t
+
+ Title: "More toke.c commentary; fix oddity"
+ From: h.sanden@elsevier.nl (Hugo van der Sanden)
+ Msg-ID: <199803251022.LAA01308@dorlas.elsevier.nl>
+ Files: toke.c
+
+ Title: "for semctl on solaris"
+ From: Graham Barr <gbarr@ti.com>
+ Msg-ID: <34624B80.C014E841@ti.com>
+ Files: doio.c t/op/ipcmsg.t t/op/ipcsem.t
+
+ ------ DOCUMENTATION ------
+
+ Title: "Add more 'see also's to perlre.pod.", "Perl regexp /g modifier bug"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>, epeschko@den-mdev1 (Ed
+ Peschko), pjr@watcher.telstra.com.au (Peter Richardson)
+ Msg-ID: <199803050000.LAA11476@watcher.telecom.com.au>,
+ <199803050231.VAA19128@monk.mps.ohio-state.edu>,
+ <199803050605.XAA09785@den-mdev1.co.csgsystems.com>
+ Files: pod/perlre.pod
+
+ ------ LIBRARY AND EXTENSIONS ------
+
+ Title: "BigFloat - small neagtive numbers cause panic"
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Msg-ID: <199711201325.NAA09732@crypt.compulink.co.uk>
+ Files: lib/Math/BigFloat.pm
+
+ Title: "Update Getopt::Long to 2.16"
+ From: JVromans@Squirrel.nl (Johan Vromans), Johan Vromans
+ <jvromans@squirrel.nl>
+ Msg-ID: <13571.48089.726787.147769@plume.nl.compuware.com>,
+ <13572.6847.863219.973795@phoenix.squirrel.nl>
+ Files: lib/Getopt/Long.pm
+
+ Title: "New Text::ParseWords"
+ From: pomeranz@netcom.com (Hal Pomeranz)
+ Msg-ID: <199710162118.OAA06275@netcom7.netcom.com>
+ Files: lib/Text/ParseWords.pm t/lib/parsewords.t
+
+ Title: "Fixed Text/Wrap.pm bugs (2)"
+ From: Jacqui Caren <Jacqui.Caren@ig.co.uk>
+ Msg-ID: <199709291548.QAA08645@toad.ig.co.uk>
+ Files: lib/Text/Wrap.pm
+
+ Title: "Very *evil* File::CheckTree behavior! (now uses warn/die not
+ print/exit)"
+ From: Eryq <eryq@zeegee.com>, Randal Schwartz <merlyn@stonehenge.com>
+ Msg-ID: <34B542FD.190A@zeegee.com>, <8cen2i9k6f.fsf@gadget.cscaper.com>
+ Files: lib/File/CheckTree.pm
+
+ ------ OTHER CHANGES ------
+
+ Title: "Add ./emacs/ptags"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199803150847.DAA08196@monk.mps.ohio-state.edu>
+ Files: emacs/ptags
+
+ ------ TESTS ------
+
+ Title: "Avoid stat test failure from build in /tmp (tmpfs)", "Build in /tmp"
+ From: Andy Dougherty <doughera@newton.phys.lafayette.edu>, Greg Bacon
+ <gbacon@adtran.com>, pudge@pobox.com (Chris Nandor)
+ Msg-ID: <199710171616.LAA13435@crp-201.adtran.com>,
+ <Pine.SUN.3.96.971017171023.2349A-100000@newton.phys>,
+ <v02130515b06be80f1486@[205.228.240.16]>
+ Files: t/op/stat.t
+
+ Title: "for failure with lib/timelocal"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, jan.dubois@ibm.net (Jan Dubois)
+ Msg-ID: <34c78f61.2529827@smtp1.ibm.net>,
+ <E0xvdfI-00057d-00@ursa.cus.cam.ac.uk>
+ Files: t/lib/timelocal.t
+
+ Title: "Make "localhost" related failures more clear"
+ From: Paul Hoffman <phoffman@proper.com>
+ Msg-ID: <199801201859.KAA05686@mail.proper.com>
+ Files: t/lib/io_sock.t t/lib/io_udp.t
+
+ ------ UTILITIES ------
+
+ Title: "Let h2xs read multiple header files"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>, Benjamin Sugars
+ <bsugars@canoe.ca>
+ Msg-ID: <Pine.SOL.3.95.980310091946.25236A-100000@interact>,
+ <Pine.SUN.3.96.980310145455.638A-100000@newton.phys>
+ Files: utils/h2xs.PL
+ Branch: maint-5.004/perl
+ + emacs/ptags t/op/die_exit.t t/op/ipcmsg.t t/op/ipcsem.t
+ ! MANIFEST doio.c lib/File/CheckTree.pm lib/Getopt/Long.pm
+ ! lib/Math/BigFloat.pm lib/Text/ParseWords.pm lib/Text/Wrap.pm
+ ! lib/base.pm perl.c pod/perlre.pod t/lib/io_sock.t
+ ! t/lib/io_udp.t t/lib/parsewords.t t/lib/timelocal.t
+ ! t/op/stat.t toke.c utils/h2xs.PL vms/perly_h.vms
+____________________________________________________________________________
+[ 886] By: TimBunce on 1998/04/10 14:35:34
+ Log: Changes relating primarily to portability.
+
+ ------ CORE LANGUAGE ------
+
+ Title: "5.004_55: Another round of OS/2 patches"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199803050945.EAA20153@monk.mps.ohio-state.edu>
+ Files: hints/os2.sh pod/perlguts.pod cop.h perl.h proto.h README.os2
+ global.sym lib/ExtUtils/MM_OS2.pm lib/File/Path.pm op.c
+ os2/Changes os2/Makefile.SHs os2/os2.c os2/perl2cmd.pl
+ perl.c pod/pod2man.PL pp_ctl.c pp_hot.c pp_sys.c
+ t/lib/filecopy.t util.c utils/perldoc.PL
+
+ Title: "VMS: chdir() with empty arg list"
+ From: lane@duphy4.drexel.edu (Charles Lane)
+ Msg-ID: <980317125556.222041c7@DUPHY4.Physics.Drexel.Edu>
+ Files: pp_sys.c
+
+ ------ LIBRARY AND EXTENSIONS ------
+
+ Title: "ExtUtils/MM_Unix.pm changed to use ld -rpath on IRIX"
+ From: "W. Phillip Moore" <wpm@ms.com>
+ Msg-ID: <199712011738.MAA21139@zappa.morgan.com>
+ Files: lib/ExtUtils/MM_Unix.pm
+
+ Title: "[Linux] POSIX::_[PS]C_.+ bug (add HINT_SC_EXIST)"
+ From: Yutaka OIWA <oiwa@is.s.u-tokyo.ac.jp>
+ Msg-ID: <199712251923.EAA08260@tjms1f.is.s.u-tokyo.ac.jp>
+ Files: ext/POSIX/hints/linux.pl ext/POSIX/POSIX.xs
+
+ Title: "5.004_04-m1] Use HAS_GNULIBC in POSIX.xs"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980305115517.9180L-100000@newton.phys>
+ Files: ext/POSIX/POSIX.xs
+
+ Title: ""ODBM_File.c", line 275: NULL undefined"
+ From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ Msg-ID: <9803091310.AA23264@claudius.bfsec.bt.co.uk>
+ Files: ext/ODBM_File/ODBM_File.xs
+
+ ------ OTHER CHANGES ------
+ Files:
+
+ ------ PORTABILITY - GENERAL ------
+
+ Title: "5.004_04 QNX getcwd"
+ From: Norton Allen <allen@huarp.harvard.edu>
+ Msg-ID: <199802121838.NAA20452@dolores.harvard.edu>,
+ <199803061511.KAA22346@bottesini.harvard.edu>
+ Files: hints/qnx.sh lib/Cwd.pm t/op/magic.t
+
+ Title: "hints/netbsd.sh d_setrgid d_setruid"
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199802281435.QAA10866@alpha.hut.fi>
+ Files: hints/netbsd.sh
+
+ Title: "osname=unixware, osvers=2.03, archname=i386-unixware
+ d_casti32=undef"
+ From: Tom Hughes <tom@compton.demon.co.uk>
+ Msg-ID: <465398da47%tom@compton.demon.co.uk>
+ Files: hints/svr4.sh
+
+ Title: "hints/bsdos.sh patch for BSDI 3.1"
+ From: Jan-Pieter Cornet <johnpc@xs4all.nl>
+ Msg-ID: <6fbip6$3cp$1@xs1.xs4all.nl>
+ Files: hints/bsdos.sh
+
+ Title: "Remove BIND_NOSTART from DynaLoader for HP"
+ From: Keong Lim <Keong.Lim@sr.com.au>
+ Msg-ID: <01BD1D03.53B65E90@sieplan2.sr.com.au>
+ Files: ext/DynaLoader/dl_hpux.xs
+
+ Title: "Building Perl on AIX 4+ with shared libraries and dynamic loading"
+ From: Juan Gallego <Little.Boss@physics.mcgill.ca>
+ Msg-ID: <Pine.SGI.3.91.971022084517.17052F-100000@nazgul.physics.mcgill.ca>
+ Files: hints/aix.sh
+
+ Title: "alpha-dec_osf 5.0"
+ From: Spider Boardman <spider@Orb.Nashua.NH.US>
+ Msg-ID: <199712232305.SAA08359@Orb.Nashua.NH.US>
+ Files: hints/dec_osf.sh
+
+ Title: "Off-by-one error with OS2::PrfDB"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199710170920.FAA00390@monk.mps.ohio-state.edu>
+ Files: os2/OS2/PrfDB/PrfDB.xs
+
+ Title: "5.004_04-m1] Allow overrides in hints/openbsd.sh"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980305115956.9180N-100000@newton.phys>
+ Files: hints/openbsd.sh
+
+ Title: "5.004_04-m1] Linux shouldn't use -lnet"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980305115843.9180M-100000@newton.phys>
+ Files: hints/linux.sh
+
+ Title: "5.004_(04|63)] Close VMS security hole"
+ From: Charles Bailey <BAILEY@newman.upenn.edu>
+ Msg-ID: <01IV6LRJCSSC0009C4@cor.newman.upenn.edu>
+ Files: vms/vms.c
+
+ Title: "Re: Perl online documentation on OpenVMS"
+ From: pvhp@forte.com (Peter Prymmer)
+ Msg-ID: <9803192143.AA28120@forte.com>
+ Files: README.vms
+
+ Title: "Perl5.004_04m4t4 *almost* makes it for VMS", "Updated
+ vms/perly_c.vms and vms/perly_h.vms"
+ From: Andy Dougherty <doughera@newton.phys.lafayette.edu>, Dan Sugalski
+ <sugalskd@osshe.edu>, larry@wall.org (Larry Wall)
+ Msg-ID: <199710151650.JAA29185@wall.org>,
+ <3.0.3.32.19971014150404.02fdef78@osshe.edu>,
+ <Pine.SUN.3.96.971015121704.28456F-100000@newton.phys>
+ Files: vms/perly_c.vms
+
+ Title: "Updated, non-wordwrapped, patch to README.VMS"
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Msg-ID: <3.0.5.32.19980213133828.0092c870@osshe.edu>
+ Files: README.vms
+
+ Title: "VMS patches to 5.004_03 (excluding installperl and timelocal.t)"
+ From: Charles Bailey <BAILEY@newman.upenn.edu>
+ Msg-ID: <01INZT9G2LZS0006YW@cor.newman.upenn.edu>
+ Files: lib/File/Basename.pm lib/File/Path.pm vms/config.vms vms/descrip.mms
+ vms/genconfig.pl vms/test.com vms/vms.c vms/ext/Filespec.pm
+ vms/ext/filespec.t
+
+ Title: "Re: VMSperl crashes on -Mblib argument"
+ From: bailey@newman.upenn.edu (Charles Bailey)
+ Msg-ID: <1997Dec10.004439.2635060@cor.newman>
+ Files: lib/blib.pm vms/vms.c
+
+ Title: "hints/linux.sh (MkLinux / PPC)"
+ From: pudge@pobox.com (Chris Nandor)
+ Msg-ID: <v0213050cb06c19682a25@[205.228.240.28]>
+ Files: hints/linux.sh
+
+ Title: "hpux.sh hints file clarification suggestion"
+ From: root@qad.com
+ Msg-ID: <199802192351.QAA09096@jhereg.perl.com>
+ Files: hints/hpux.sh
+
+ Title: "new hints/solaris_2.sh"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0xw80h-0005SV-00@ursa.cus.cam.ac.uk>
+ Files: hints/solaris_2.sh
+ Branch: maint-5.004/perl
+ ! README.os2 README.vms cop.h ext/DynaLoader/dl_hpux.xs
+ ! ext/ODBM_File/ODBM_File.xs ext/POSIX/POSIX.xs
+ ! ext/POSIX/hints/linux.pl global.sym hints/aix.sh
+ ! hints/bsdos.sh hints/dec_osf.sh hints/hpux.sh hints/linux.sh
+ ! hints/netbsd.sh hints/openbsd.sh hints/os2.sh hints/qnx.sh
+ ! hints/solaris_2.sh hints/svr4.sh lib/Cwd.pm
+ ! lib/ExtUtils/MM_OS2.pm lib/ExtUtils/MM_Unix.pm
+ ! lib/File/Basename.pm lib/File/Path.pm lib/blib.pm op.c
+ ! os2/Changes os2/Makefile.SHs os2/OS2/PrfDB/PrfDB.xs os2/os2.c
+ ! os2/perl2cmd.pl perl.c perl.h pod/perlguts.pod pod/pod2man.PL
+ ! pp_ctl.c pp_hot.c pp_sys.c proto.h t/lib/filecopy.t
+ ! t/op/magic.t util.c utils/perldoc.PL vms/config.vms
+ ! vms/descrip.mms vms/ext/Filespec.pm vms/ext/filespec.t
+ ! vms/genconfig.pl vms/perly_c.vms vms/perly_h.vms vms/test.com
+ ! vms/vms.c
+____________________________________________________________________________
+[ 885] By: gsar on 1998/04/08 01:14:29
+ Log: small tweaks to make it compile (doesn't run)
+ Branch: asperl
+ ! objpp.h win32/Makefile win32/config.bc win32/config.gc
+ ! win32/config.vc win32/makefile.mk
+____________________________________________________________________________
+[ 884] By: gsar on 1998/04/08 00:14:13
+ Log: integrate mainline changes
+ Branch: asperl
+ +> Changes5.004 ext/Thread/Thread/Signal.pm
+ +> lib/ExtUtils/Installed.pm lib/ExtUtils/Packlist.pm
+ +> lib/ExtUtils/inst t/op/hashwarn.t
+ ! ObjXSub.h embedvar.h interp.sym intrpvar.h objpp.h
+ !> (integrate 127 files)
+____________________________________________________________________________
+[ 883] By: gsar on 1998/04/06 20:21:20
+ Log: make old DomainName() implementation the default (so Win95
+ is happy)
+ Branch: win32/perl
+ ! win32/win32.c
+____________________________________________________________________________
+[ 882] By: gsar on 1998/04/05 23:32:33
+ Log: fix memory leaks in offer_nice_chunk()
+ Branch: win32/perl
+ ! perl.h sv.c
+____________________________________________________________________________
+[ 881] By: gsar on 1998/04/04 23:11:52
+ Log: set up PUSHSTACK for __DIE__ and __WARN__ hooks also
+ Branch: win32/perl
+ ! cop.h util.c
+____________________________________________________________________________
+[ 880] By: gsar on 1998/04/04 22:35:54
+ Log: fix refcounting of GvSTASH() when glob becomes nought
+ (this takes care of the "unbalanced strtab refcount" problem)
+ Branch: win32/perl
+ ! sv.c
+____________________________________________________________________________
+[ 879] By: gsar on 1998/04/04 21:16:17
+ Log: change 866 was incomplete
+ Branch: win32/perl
+ ! hv.c
+____________________________________________________________________________
+[ 878] By: gsar on 1998/04/04 20:31:56
+ Log: fixes for various noises under PERL_DESTRUCT_LEVEL
+ Branch: win32/perl
+ ! cop.h perl.c pp_ctl.c
+____________________________________________________________________________
+[ 877] By: gsar on 1998/04/04 17:55:30
+ Log: integrate mainline
+ Branch: win32/perl
+ +> Changes5.004
+ !> Changes MANIFEST sv.c t/op/misc.t
+____________________________________________________________________________
+[ 876] By: gsar on 1998/04/04 17:26:32
+ Log: remove __declspec kludge in sdbm.h in favor of setting a
+ flag for static symbols
+ Branch: win32/perl
+ ! EXTERN.h ext/SDBM_File/sdbm/Makefile.PL
+ ! ext/SDBM_File/sdbm/sdbm.h
+____________________________________________________________________________
+[ 875] By: gsar on 1998/04/04 01:11:57
+ Log: fix order of init
+ Message-Id: <3.0.5.32.19980403135815.009d2440@osshe.edu>
+ Date: Fri, 03 Apr 1998 13:58:15 PST
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Subject: [PATCH 5.004_64] perl dies in perl_construct when compiled
+ with MULTIPLICITY
+ Branch: win32/perl
+ ! perl.c
+____________________________________________________________________________
+[ 874] By: gsar on 1998/04/04 00:34:59
+ Log: the EXTCONST in sdbm.h breaks SDBM on Borland, since
+ the declared symbol is not in a DLL (so kludge it)
+ Branch: win32/perl
+ ! ext/SDBM_File/sdbm/sdbm.h
+____________________________________________________________________________
+[ 873] By: TimBunce on 1998/04/03 22:17:40
+ Log: Title: "FileHandle Documentation patch"
+ From: "Darren/Torin/Who Ever..." <torin@daft.com>
+ Msg-ID: <87emzqo49g.fsf@perv.daft.com>
+ Files: lib/FileHandle.pm
+ Branch: maint-5.004/perl
+ ! lib/FileHandle.pm
+____________________________________________________________________________
+[ 872] By: TimBunce on 1998/04/03 22:01:03
+ Log: Documentation and documentation related patches:
+
+ ------ BUILD PROCESS ------
+
+ Title: "Docs re /usr/bin/perl quasi-standard location"
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID: <Pine.GSO.3.96.971117080737.12318C-100000@usertest.teleport.com>
+ Files: INSTALL pod/perlrun.pod
+
+ ------ DOCUMENTATION ------
+
+ Title: "/RFC|RFC-1305/ non-greedy"
+ From: Jan-Pieter Cornet <johnpc@xs4all.nl>
+ Msg-ID: <6epo02$c4r$1@xs1.xs4all.nl>
+ Files: pod/perlre.pod
+
+ Title: "5.004_04: perlhist.pod, buildtoc, perltoc.pod"
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199802191543.RAA29231@alpha.hut.fi>
+ Files: pod/perl.pod pod/perlhist.pod pod/perltoc.pod pod/buildtoc
+
+ Title: "5.004_04: pod/perlfunc.pod: i18n example for localtime()"
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199711141555.RAA18875@alpha.hut.fi>
+ Files: pod/perlfunc.pod
+
+ Title: "typo-fix and suggestion for perlguts.pod"
+ From: h.sanden@elsevier.nl (Hugo van der Sanden)
+ Msg-ID: <199803051543.QAA03097@dorlas.elsevier.nl>
+ Files: pod/perlguts.pod
+
+ Title: "perlfunc/syscall curiosity"
+ From: Roderick Schertler <roderick@argon.org>, Tkil
+ <tkil@reptile.scrye.com>
+ Msg-ID: <199711302259.PAA02134@reptile.scrye.com>,
+ <pziut8snva.fsf@eeyore.ibcinc.com>
+ Files: pod/perlfunc.pod
+
+ Title: "Document sprintf %#x behaviour for zero value"
+ From: ilya@math.ohio-state.edu (Ilya Zakharevich)
+ Msg-ID: <1997Nov5.185959.2539604@cor.newman>
+ Files: pod/perlfunc.pod
+
+ Title: "NUL termination (was Re: STOP THE PRESSES)"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0xsn5M-0002gw-00@ursa.cus.cam.ac.uk>
+ Files: pod/perlguts.pod
+
+ Title: "Typo fix."
+ From: abigail@fnx.com
+ Msg-ID: <19971101120114.1030.qmail@betelgeuse.wayne.fnx.com>
+ Files: pod/perlop.pod pod/perlvar.pod
+
+ Title: "5.004_63 perlrun.pod: _DEBUG_MSTATS"
+ From: Achim Bohnet <ach@mpe.mpg.de>
+ Msg-ID: <9803181940.AA22587@o09.xray.mpe.mpg.de>
+ Files: pod/perlrun.pod
+
+ Title: "Re: Conservative C<*x = undef> patch"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0yCjHT-0005Dt-00@ursa.cus.cam.ac.uk>
+ Files: pod/perltrap.pod
+
+ Title: "perlfunc.pod for flock()"
+ From: "Jeremy D. Zawodny" <jzawodn@wcnet.org>
+ Msg-ID: <3.0.5.32.19971118203119.00a723e0@woody.wcnet.org>
+ Files: pod/perlfunc.pod
+
+ Title: "buglet: 'perltoc' not mentioned in perl.pod"
+ From: Tkil <tkil@scrye.com>
+ Msg-ID: <19971127035036.17668.qmail@scrye.com>
+ Files: pod/perl.pod
+
+ Title: "for() and map() peculiarity"
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0y4YAa-0003Qu-00@ursa.cus.cam.ac.uk>
+ Files: pod/perlsyn.pod
+
+ Title: "Re: new text for perlsec"
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID: <Pine.GSO.3.96.980328100418.22321T-100000@user2.teleport.com>
+ Files: pod/perlsec.pod
+
+ Title: "perldsc's debugger x command"
+ From: Roderick Schertler <roderick@argon.org>
+ Msg-ID: <10669.878352893@eeyore.ibcinc.com>
+ Files: pod/perldsc.pod
+
+ Title: "perlre.pod"
+ From: Ted Ashton <ashted@southern.edu>
+ Msg-ID: <199802271501.KAA09279@ns.southern.edu>
+ Files: pod/perlre.pod
+
+ Title: "Re: printf and $\", "printf and $\"
+ From: Roderick Schertler <roderick@argon.org>, Tom Phoenix
+ <rootbeer@teleport.com>, nag <nick@flirble.org>
+ Msg-ID: <199711141918.TAA08096@flirble.org>,
+ <Pine.GSO.3.96.971117085421.12318J-100000@usertest.teleport
+ .com>, <pzyb2ncr42.fsf@eeyore.ibcinc.com>
+ Files: pod/perlfunc.pod
+
+ Title: "recv() typo"
+ From: Roderick Schertler <roderick@argon.org>
+ Msg-ID: <12064.877012073@eeyore.ibcinc.com>
+ Files: pod/perlfunc.pod
+
+ Title: "truncate return value"
+ From: Roderick Schertler <roderick@argon.org>
+ Msg-ID: <5490.878337883@eeyore.ibcinc.com>
+ Files: pod/perlfunc.pod
+
+ Title: "update to perlbook.pod"
+ From: "Nathan V. Patwardhan" <nvp@mediaone.net>, Randal Schwartz
+ <merlyn@stonehenge.com>, Stephen Potter
+ <spp@psasolar.colltech.com>, Tom Phoenix
+ <rootbeer@teleport.com>
+ Msg-ID: <199803241354.HAA23938@psasolar.psa.pencom.com>,
+ <199803241441.OAA01261@mediaone.net>,
+ <8clnu0i05k.fsf@gadget.cscaper.com>,
+ <Pine.GSO.3.96.980324111957.15753C-100000@user1.teleport.com>
+ Files: pod/perlbook.pod
+
+ Title: "utime documentation"
+ From: "Brandon S. Allbery KF8NH" <bsa@kf8nh.apk.net>, "M.J.T. Guy"
+ <mjtg@cus.cam.ac.uk>
+ Msg-ID: <199802180256.VAA11369@speaker.kf8nh.apk.net>,
+ <E0y4qd6-0000P6-00@ursa.cus.cam.ac.uk>
+ Files: pod/perlfunc.pod
+
+ Title: "(well, doc patch) use of // requires successful match"
+ From: Roderick Schertler <roderick@argon.org>
+ Msg-ID: <pz7mb4bips.fsf@eeyore.ibcinc.com>
+ Files: pod/perlop.pod
+
+ ------ LIBRARY AND EXTENSIONS ------
+
+ Title: "MakeMaker PM doc patch and a DIR buglet"
+ From: Achim Bohnet <ach@mpe.mpg.de>
+ Msg-ID: <9711101050.AA13868@o09.xray.mpe.mpg.de>
+ Files: lib/ExtUtils/MakeMaker.pm
+
+ Title: "bareword clarification for constant.pm"
+ From: Roderick Schertler <roderick@argon.org>
+ Msg-ID: <6460.878143077@eeyore.ibcinc.com>
+ Files: lib/constant.pm
+
+ Title: "integer rand - bug or feature?"
+ From: Roderick Schertler <roderick@argon.org>
+ Msg-ID: <pzhg8lvgta.fsf@eeyore.ibcinc.com>
+ Files: lib/integer.pm
+
+ ------ OTHER CHANGES ------
+
+ Title: "FileHandle Documentation patch"
+ From: "Darren/Torin/Who Ever..." <torin@daft.com>
+ Msg-ID: <87emzqo49g.fsf@perv.daft.com>
+
+ Title: "perl5.004_61 myconfig updates"
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980305150629.11530G-100000@newton.phys>
+ Files: myconfig
+
+ Title: "small fixups in pod2latex.PL"
+ From: "Darren/Torin/Who Ever..." <torin@daft.com>
+ Msg-ID: <873eg6o3v2.fsf@perv.daft.com>
+
+ ------ PORTABILITY - GENERAL ------
+
+ Title: "Misc doc fixes for README.VMS"
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Msg-ID: <3.0.5.32.19980121113134.00924a20@osshe.edu>
+ Files: README.vms
+
+ Title: "moved DynaLib"
+ From: John Tobey <jtobey@channel1.com>
+ Msg-ID: <199710182332.XAA21630@remote212>
+ Files: ext/DynaLoader/DynaLoader.pm.PL
+
+ ------ UTILITIES ------
+
+ Title: "Searching for FAQs (patch to perldoc)"
+ From: Piers Cawley <pdcawley@bofh.org.uk>, Russ Allbery <rra@stanford.edu>
+ Msg-ID: <m3d8gsb8uk.fsf@windlord.Stanford.EDU>,
+ <m3iuqkfmiq.fsf@tower.bofh.org.uk>
+ Files: utils/perldoc.PL
+
+ Title: "perldoc"
+ From: Ted Ashton <ashted@southern.edu>
+ Msg-ID: <199802271510.KAA10506@ns.southern.edu>
+ Files: utils/perldoc.PL
+
+ Title: "perldoc -f not using pod2man"
+ From: Russ Allbery <rra@stanford.edu>
+ Msg-ID: <m3hg4f9vyy.fsf@windlord.Stanford.EDU>
+ Files: utils/perldoc.PL
+
+ Title: "perldoc -m should not require pod"
+ From: Robin Houston <robin@nml.guardian.co.uk>
+ Msg-ID: <199803241319.NAA24777@stringfellow.guardian.co.uk>
+ Files: utils/perldoc.PL
+
+ Title: "small fix for perldoc in perl 5.004_04"
+ From: Julian Yip <julian@imoney.com>
+ Msg-ID: <Roam.SIMC.2.0.6.884805579.5280.julian@imoney.com>
+ Files: utils/perldoc.PL
+ Branch: maint-5.004/perl
+ - ext/DynaLoader/DynaLoader.pm
+ ! Changes Configure INSTALL README.vms
+ ! ext/DynaLoader/DynaLoader.pm.PL ext/Socket/Socket.pm
+ ! lib/ExtUtils/MakeMaker.pm lib/Tie/Hash.pm lib/constant.pm
+ ! lib/integer.pm myconfig pod/buildtoc pod/checkpods.PL
+ ! pod/perl.pod pod/perlbook.pod pod/perldelta.pod
+ ! pod/perldiag.pod pod/perldsc.pod pod/perlfunc.pod
+ ! pod/perlguts.pod pod/perlhist.pod pod/perllocale.pod
+ ! pod/perlmod.pod pod/perlop.pod pod/perlre.pod pod/perlrun.pod
+ ! pod/perlsec.pod pod/perlstyle.pod pod/perlsyn.pod
+ ! pod/perltoc.pod pod/perltrap.pod pod/perlvar.pod
+ ! pod/pod2latex.PL toke.c utils/perldoc.PL
----------------
-Version 5.003_17
+Version 5.004_64
----------------
-The rate of patches is slowing down.... I see 5.004 at the end of the
-tunnel! (Hey, what's that whistle?)
-
- CORE LANGUAGE CHANGES
-
- Title: "Support named closures"
- From: Chip Salzenberg
- Files: cv.h op.c perl.c pp.c pp_ctl.c pp_hot.c
-
- CORE PORTABILITY
-
- Title: "perl5.003_15 and Interactive Unix"
- From: win@in.rhein-main.de (Winfried Koenig)
- Msg-ID: <m0vd254-0004oKC@incom.rhein-main.de>
- Date: Thu, 26 Dec 1996 00:45:45 +0200 (EET)
- Files: hints/isc.sh pp_sys.c
-
- Title: "Suggest "usemymalloc='n'" for FreeBSD 2.*"
- From: rse@engelschall.com (Ralf S. Engelschall)
- Files: hints/freebsd.sh
-
- Title: "Minor OS/2 fixes"
- From: Ilya Zakharevich
- Msg-ID: <199612252105.QAA11890@monk.mps.ohio-state.edu>
- Date: Wed, 25 Dec 1996 16:05:42 -0500 (EST)
- Files: os2/os2ish.h pod/perlxstut.pod
-
- OTHER CORE CHANGES
-
- Title: "Fix {,un}tainting of $1 etc. when C<use locale>"
- From: Chip Salzenberg
- Files: mg.c sv.c
-
- Title: "Limit effects of "=pod" to a single file"
- From: Chip Salzenberg
- Files: toke.c
-
- TESTS
-
- Title: "New tests: op/method.t and op/locale.t"
- From: Ilya Zakharevich and Jarkko Hietaniemi
- Files: MANIFEST t/lib/locale.t t/op/method.t
-
- Title: "Test C< ()=() >"
- From: Chip Salzenberg
- Files: t/op/misc.t
-
- LIBRARY AND EXTENSIONS
-
- Title: "Refresh MakeMaker to 5.39"
- From: Andreas Koenig
- Files: lib/ExtUtils/Install.pm lib/ExtUtils/Liblist.pm
- lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm
- lib/ExtUtils/Mksymlists.pm
-
- Title: "Newer debugger"
- From: Ilya Zakharevich
- Msg-ID: <199612261954.OAA12999@monk.mps.ohio-state.edu>
- Date: Thu, 26 Dec 1996 14:54:34 -0500 (EST)
- Files: lib/perl5db.pl
-
- DOCUMENTATION
-
- Title: "Perlguts, version 27"
- From: Jeff Okamoto
- Msg-ID: <199612250144.AA059528263@hpcc123.corp.hp.com>
- Date: Tue, 24 Dec 1996 17:44:23 -0800
- Files: pod/perlguts.pod
-
- Title: "perlpod.pod patch for _16"
- From: Kenneth Albanowski
- Msg-ID: <Pine.LNX.3.93.961224225906.337B-100000@kjahds.com>
- Date: Tue, 24 Dec 1996 23:00:10 -0500 (EST)
- Files: pod/perlpod.pod
-
- Title: "tiny perllocale.pod diff for _16"
- From: Jarkko Hietaniemi
- Msg-ID: <199612261306.PAA21161@alpha.hut.fi>
- Date: Thu, 26 Dec 1996 15:06:04 +0200 (EET)
- Files: pod/perllocale.pod
-
+____________________________________________________________________________
+[ 871] By: mbeattie on 1998/04/03 13:38:59
+ Log: Update Changes5.004 and Changes, fix MANIFEST
+ Branch: perl
+ + Changes
+ ! Changes5.004 MANIFEST
+____________________________________________________________________________
+[ 870] By: mbeattie on 1998/04/03 13:36:29
+ Log: Rename Changes to Changes5.004 (via an integrate)
+ Branch: perl
+ +> Changes5.004
+ - Changes
+____________________________________________________________________________
+[ 869] By: mbeattie on 1998/04/03 11:53:00
+ Log: Subject: [PATCH] Perl 5.005b1t2/perl5.004_63 (resend)
+ Date: Wed, 18 Mar 1998 01:24:20 +0100 (MET)
+ From: Jan-Pieter Cornet <johnpc@xs4all.net>
+ Branch: perl
+ ! sv.c t/op/misc.t
+____________________________________________________________________________
+[ 868] By: mbeattie on 1998/04/03 11:16:26
+ Log: Integrate win32 branch into mainline
+ Branch: perl
+ !> (integrate 31 files)
+____________________________________________________________________________
+[ 867] By: gsar on 1998/04/03 08:47:55
+ Log: config.* fixes
+ Branch: win32/perl
+ ! win32/Makefile win32/config.bc win32/config.gc win32/config.vc
+ ! win32/config_H.bc win32/config_H.gc win32/config_H.vc
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 866] By: gsar on 1998/04/03 07:22:50
+ Log: fixup hv_free_ent() to not fail on null HeVAL()
+ Branch: win32/perl
+ ! hv.c perl.c
+____________________________________________________________________________
+[ 865] By: gsar on 1998/04/03 07:06:12
+ Log: integrate mainline
+ Branch: win32/perl
+ +> ext/Thread/Thread/Signal.pm t/op/hashwarn.t
+ !> (integrate 71 files)
+____________________________________________________________________________
+[ 864] By: gsar on 1998/04/03 06:59:37
+ Log: implement stack-of-stacks so that magic invocations don't
+ invalidate local stack pointer
+ Branch: win32/perl
+ ! av.c cop.h deb.c embed.h embedvar.h global.sym gv.c interp.sym
+ ! intrpvar.h mg.c op.c perl.c pp.h pp_ctl.c pp_sys.c proto.h
+ ! scope.c sv.c t/op/runlevel.t thrdvar.h util.c
+____________________________________________________________________________
+[ 863] By: gsar on 1998/04/03 01:26:09
+ Log: add AS patch#15
+ Branch: asperl
+ ! ipenv.h lib/ExtUtils/MM_Unix.pm perl.c perlenv.h
+ ! 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 win32/runperl.c
+ ! win32/win32.c win32/win32.h
+____________________________________________________________________________
+[ 862] By: mbeattie on 1998/04/02 17:08:43
+ Log: Subject: [PATCH for 5.004_63] Config_63-04-05.diff
+ Date: Thu, 2 Apr 1998 11:56:51 -0500 (EST)
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Branch: perl
+ ! Configure ext/Socket/Socket.xs myconfig
+____________________________________________________________________________
+[ 861] By: mbeattie on 1998/04/02 16:32:53
+ Log: Change 854 added { NULL, 0 } to sdbm.h which needs to be {0, 0}
+ since appropriate headers aren't included.
+ Branch: perl
+ ! ext/SDBM_File/sdbm/sdbm.h
+____________________________________________________________________________
+[ 860] By: mbeattie on 1998/04/02 16:17:11
+ Log: Bumped patchlevel.h to 64
+ Branch: perl
+ ! patchlevel.h
+____________________________________________________________________________
+[ 859] By: mbeattie on 1998/04/02 16:16:26
+ Log: Subject: Re: [PATCH] 5.004_63: UNICOS 9
+ Date: Fri, 20 Mar 1998 19:39:28 +0200 (EET)
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Branch: perl
+ ! hints/unicos.sh regcomp.h
+____________________________________________________________________________
+[ 858] By: mbeattie on 1998/04/02 16:13:24
+ Log: Subject: [PATCH] Re: Odd number of elements in hash list.
+ Date: Sat, 28 Mar 1998 15:26:46 -0800 (PST)
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Branch: perl
+ + t/op/hashwarn.t
+ ! MANIFEST pod/perldiag.pod pp.c pp_hot.c
+____________________________________________________________________________
+[ 857] By: mbeattie on 1998/04/02 16:08:43
+ Log: Subject: [PATCH 5.004_(04|63)] Close VMS security hole
+ Date: Sat, 28 Mar 1998 02:05:03 -0500 (EST)
+ From: Charles Bailey <BAILEY@newman.upenn.edu>
+ Branch: perl
+ ! vms/vms.c
+____________________________________________________________________________
+[ 856] By: mbeattie on 1998/04/02 16:07:44
+ Log: Subject: [PATCH] mv-if-diff
+ Date: Fri, 27 Mar 98 18:06:11 GMT
+ From: Robin Barker <rmb1@cise.npl.co.uk>
+ Branch: perl
+ ! mv-if-diff
+____________________________________________________________________________
+[ 855] By: mbeattie on 1998/04/02 16:06:54
+ Log: From: Jan-Pieter Cornet <johnpc@xs4all.net>
+ Subject: Re: [PATCH] [BUG 5.004_63] define/set of PERL_DESTRUCT_LEVEL
+ Date: Fri, 27 Mar 1998 02:11:21 +0100 (MET)
+ Subject: [PATCH] another destruct_level fix
+ Date: Mon, 30 Mar 1998 23:48:12 +0200 (MET DST)
+ Branch: perl
+ ! perl.c sv.c
+____________________________________________________________________________
+[ 854] By: mbeattie on 1998/04/02 16:03:37
+ Log: Subject: Next wave of _63 VMS patches
+ Date: Thu, 26 Mar 1998 15:11:50 -0500 (EST)
+ From: Charles Bailey <BAILEY@newman.upenn.edu>
+ Branch: perl
+ ! EXTERN.h INTERN.h ext/SDBM_File/Makefile.PL
+ ! ext/SDBM_File/sdbm/Makefile.PL ext/SDBM_File/sdbm/dba.c
+ ! ext/SDBM_File/sdbm/dbd.c ext/SDBM_File/sdbm/dbu.c
+ ! ext/SDBM_File/sdbm/hash.c ext/SDBM_File/sdbm/pair.c
+ ! ext/SDBM_File/sdbm/sdbm.c ext/SDBM_File/sdbm/sdbm.h
+ ! ext/Thread/io.t installperl lib/ExtUtils/MM_VMS.pm
+ ! lib/Net/Ping.pm perldir.h perlsdio.h t/lib/english.t
+ ! vms/config.vms vms/descrip.mms vms/ext/Filespec.pm
+ ! vms/ext/Stdio/0README.txt vms/ext/Stdio/Stdio.pm
+ ! vms/ext/Stdio/Stdio.xs vms/ext/Stdio/test.pl
+ ! vms/ext/filespec.t vms/genconfig.pl vms/perly_c.vms vms/vms.c
+ ! vms/vmsish.h
+____________________________________________________________________________
+[ 853] By: mbeattie on 1998/04/02 15:55:46
+ Log: Subject: [PATCH 5.00463] Confusing error from perl -e "x'"
+ Date: Wed, 25 Mar 1998 17:43:17 -0500 (EST)
+ From: Hans Mulder <hansmu@xs4all.nl>
+ Branch: perl
+ ! toke.c
+____________________________________________________________________________
+[ 852] By: mbeattie on 1998/04/02 15:54:24
+ Log: Subject: [PATCH] small fixups in pod2latex.PL
+ Date: 25 Mar 1998 13:30:25 -0800
+ From: "Darren/Torin/Who Ever..." <torin@daft.com>
+ Branch: perl
+ ! pod/pod2latex.PL
+____________________________________________________________________________
+[ 851] By: mbeattie on 1998/04/02 15:50:58
+ Log: Subject: [PATCH] hints/irix_6.sh with GCC
+ Date: Tue, 24 Mar 1998 12:25:10 -0800 (EST)
+ From: kstar@chapin.edu (Kurt D. Starsinic)
+ Branch: perl
+ ! hints/irix_6.sh
+____________________________________________________________________________
+[ 850] By: mbeattie on 1998/04/02 15:45:33
+ Log: Subject: [PATCH] perldoc -m
+ Date: Tue, 24 Mar 1998 13:19:38 GMT
+ From: Robin Houston <robin@nml.guardian.co.uk>
+ Branch: perl
+ ! utils/perldoc.PL
+____________________________________________________________________________
+[ 849] By: mbeattie on 1998/04/02 15:42:52
+ Log: Subject: [PATCH for 5.004_63] dos-djgpp update
+ Date: Mon, 23 Mar 1998 14:13:46 +0100
+ From: Laszlo Molnar <molnarl@cdata.tvnet.hu>
+ Branch: perl
+ ! djgpp/config.over hints/dos_djgpp.sh
+____________________________________________________________________________
+[ 848] By: mbeattie on 1998/04/02 15:38:19
+ Log: Subject: [PATCH] Stale SP in pp_substr
+ Date: Thu, 19 Mar 1998 21:28:02 -0600 (CST)
+ From: Stephen McCamant <alias@mcs.com>
+ Branch: perl
+ ! pp.c
+____________________________________________________________________________
+[ 847] By: mbeattie on 1998/04/02 15:36:33
+ Log: Add missing export of "nice" to ext/POSIX/POSIX.pm (Phil Tait)
+ Branch: perl
+ ! ext/POSIX/POSIX.pm
+____________________________________________________________________________
+[ 846] By: mbeattie on 1998/04/02 15:34:36
+ Log: Subject: [PATCH] 5.004_63: further -e patching
+ Date: Wed, 18 Mar 1998 23:21:08 +0200 (EET)
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Branch: perl
+ ! perl.c pod/perldiag.pod
+____________________________________________________________________________
+[ 845] By: mbeattie on 1998/04/02 15:25:18
+ Log: Andy Dougherty's configuration patches (Config_63-01 up to 04).
+ Branch: perl
+ ! Configure INSTALL Policy_sh.SH Porting/Glossary
+ ! Porting/config.sh Porting/config_H config_h.SH
+ ! ext/POSIX/POSIX.xs handy.h hints/hpux.sh myconfig perlsock.h
+ ! pp.c pp_sys.c regexec.c
+____________________________________________________________________________
+[ 844] By: mbeattie on 1998/04/02 14:28:17
+ Log: Subject: [PATCH 5.004_63] perlrun.pod: PERL_DEBUG_MSTATS
+ Date: Wed, 18 Mar 1998 20:40:19 +0100
+ From: Achim Bohnet <ach@mpe.mpg.de>
+ Branch: perl
+ ! pod/perlrun.pod
+____________________________________________________________________________
+[ 843] By: mbeattie on 1998/04/02 14:26:52
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ Subject: 5.004_63 picky compiler fixes [PATCH]
+ Date: Wed, 18 Mar 1998 09:36:32 -0800
+ Subject: [PATCH 5.004_63] Fix function prototype with long doubles
+ Date: Wed, 18 Mar 1998 14:48:19 -0800
+ Branch: perl
+ ! ext/POSIX/POSIX.xs ext/Thread/Thread.xs vms/vms.c
+____________________________________________________________________________
+[ 842] By: mbeattie on 1998/04/02 14:22:41
+ Log: From: Stephen Potter <spp@psasolar.colltech.com>
+ Subject: Re: doc: perlrun typo
+ Date: Wed, 18 Mar 1998 10:06:55 -0600
+ Subject: Re: [PATCH 5.004_63] PerlLIO abstraction cleanup
+ Date: Tue, 24 Mar 1998 21:20:51 -0600
+ Branch: perl
+ ! mg.c perl.c pod/perlrun.pod pp_hot.c pp_sys.c util.c
+____________________________________________________________________________
+[ 841] By: mbeattie on 1998/04/02 14:17:31
+ Log: Subject: [PATCH] Add "Full 64 bit support" to Todo; document Todo in pumpkin.pod
+ Date: Wed, 18 Mar 1998 12:44:58 +0100
+ From: Dominic Dunlop <domo@vo.lu>
+ Branch: perl
+ ! Porting/pumpkin.pod Todo
+____________________________________________________________________________
+[ 840] By: mbeattie on 1998/04/02 14:14:22
+ Log: Subject: [PATCH] Configure hints/ patches
+ Date: Wed, 18 Mar 1998 02:47:38 +0100 (MET)
+ From: Jan-Pieter Cornet <johnpc@xs4all.net>
+ Branch: perl
+ ! hints/linux.sh hints/qnx.sh
+____________________________________________________________________________
+[ 839] By: mbeattie on 1998/04/02 14:13:13
+ Log: Remove duplicate code in cygwin32/perlgcc (Blair Zajac)
+ Branch: perl
+ ! cygwin32/perlgcc
+____________________________________________________________________________
+[ 838] By: gsar on 1998/03/28 05:01:57
+ Log: fix Env.pm to weed out illegal names
+ Branch: win32/perl
+ ! lib/Env.pm
+____________________________________________________________________________
+[ 837] By: gsar on 1998/03/28 04:39:43
+ Log: fix typo in makefile.mk
+ Branch: win32/perl
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 836] By: gsar on 1998/03/23 17:40:15
+ Log: add file: to installhtml URLs
+ Branch: win32/perl
+ ! win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 835] By: mbeattie on 1998/03/18 11:03:11
+ Log: Add Thread::Signal to run signal handlers reliably in a new thread
+ Branch: perl
+ + ext/Thread/Thread/Signal.pm
+ ! MANIFEST ext/Thread/Thread.xs
----------------
-Version 5.003_16
+Version 5.004_63
----------------
-This patch is all bug fixes, library updates, and documentation
-updates. We'll get to 5.004 RSN, I promise. :-)
-
- CORE LANGUAGE CHANGES
-
- Title: "Fix closures that are not in subroutines"
- From: Chip Salzenberg
- Files: op.c
-
- CORE PORTABILITY
-
- Title: "_13: patches for unicos/unicosmk"
- From: Dean Roehrich
- Msg-ID: <199612202038.OAA22805@poplar.cray.com>
- Date: Fri, 20 Dec 1996 14:38:50 -0600
- Files: Configure MANIFEST hints/unicos.sh hints/unicosmk.sh
-
- OTHER CORE CHANGES
-
- Title: "Fix 'foreach(@ARGV) { while (<>) { push @p,$_ } }'"
- From: Chip Salzenberg
- Files: cop.h pp_hot.c scope.c
-
- Title: "Eliminate warnings from C< undef $x; $x OP= "foo" >"
- From: Chip Salzenberg
- Files: doop.c pp.c pp.h pp_hot.c
-
- Title: "Try again to improve method caching"
- From: Ilya Zakharevich
- Msg-ID: <199612240113.UAA09487@monk.mps.ohio-state.edu>
- Date: Mon, 23 Dec 1996 20:13:56 -0500 (EST)
- Files: gv.c sv.c
-
- Title: "Be more careful about 'o' magic memory management"
- From: Chip Salzenberg
- Files: mg.c sv.c
-
- Title: "Fix bad pointer refs when localized object loses magic"
- From: Chip Salzenberg
- Files: scope.c
-
- LIBRARY AND EXTENSIONS
-
- Title: "Refresh CPAN to 1.09"
- From: Andreas Koenig
- Files: lib/CPAN.pm
-
- Title: "Refresh Net::Ping to 2.02"
- From: Russell Mosemann <mose@ccsn.edu>
- Files: lib/Net/Ping.pm
-
- Title: "Refresh IO to 1.14"
- From: Graham Barr
- Files: MANIFEST ext/IO/IO.xs ext/IO/README ext/IO/lib/IO/File.pm
- ext/IO/lib/IO/Handle.pm ext/IO/lib/IO/Pipe.pm
- ext/IO/lib/IO/Seekable.pm ext/IO/lib/IO/Select.pm
- ext/IO/lib/IO/Socket.pm t/lib/io_dup.t t/lib/io_pipe.t
- t/lib/io_sel.t t/lib/io_sock.t t/lib/io_tell.t
- t/lib/io_udp.t t/lib/io_xs.t
-
- BUILD PROCESS AND UTILITIES
-
- Title: "Don't recurse into subdirs twice on 'make realclean'"
- From: Chip Salzenberg
- Files: Makefile.SH
-
- Title: "Use root EXTERN.h when compiling x2p/malloc.c."
- From: Paul Marquess
- Files: x2p/Makefile.SH
-
- Title: "Fix compilation errors when malloc.c used for x2p"
- From: Robin Barker <rmb@cise.npl.co.uk>
- Files: malloc.c
-
- DOCUMENTATION
-
- Title: "Edit INSTALL to describe new binary compat setup"
- From: Chip Salzenberg
- Files: INSTALL
-
- Title: "Update to perllocale.pod"
- From: Jarkko Hietaniemi
- Files: pod/perllocale.pod
-
+____________________________________________________________________________
+[ 834] By: mbeattie on 1998/03/17 16:19:10
+ Log: Policy_sh.SH had extra $ in pager=$pager comment (Hallvard B Furuseth)
+ Branch: perl
+ ! Policy_sh.SH
+____________________________________________________________________________
+[ 833] By: mbeattie on 1998/03/17 16:11:02
+ Log: Integrate win32 branch into mainline.
+ Branch: perl
+ !> regcomp.c win32/config.bc win32/config.gc win32/config.vc
+ !> win32/config_H.bc win32/config_H.gc win32/config_H.vc
+ !> win32/win32.c
+____________________________________________________________________________
+[ 832] By: gsar on 1998/03/17 14:32:39
+ Log: propagate bugfix @ change831 from asperl
+ Branch: win32/perl
+ ! regcomp.c
+____________________________________________________________________________
+[ 831] By: gsar on 1998/03/17 14:02:51
+ Log: fix buggy order of free() in regcomp.c (from AS)
+ Branch: asperl
+ ! regcomp.c
+____________________________________________________________________________
+[ 830] By: gsar on 1998/03/17 01:10:54
+ Log: add a part of AS patch#14, backout incomplete variable
+ name changes for gcc. Builds and tests under VC/BC once again.
+ Branch: asperl
+ ! bytecode.h mg.c pp.c pp_ctl.c pp_hot.c toke.c
+____________________________________________________________________________
+[ 829] By: gsar on 1998/03/16 23:49:18
+ Log: stray tweak to win32.c
+ Branch: win32/perl
+ ! win32/win32.c
+____________________________________________________________________________
+[ 828] By: gsar on 1998/03/16 22:06:03
+ Log: update win32/config* files
+ Branch: win32/perl
+ ! win32/config.bc win32/config.gc win32/config.vc
+ ! win32/config_H.bc win32/config_H.gc win32/config_H.vc
+____________________________________________________________________________
+[ 827] By: gsar on 1998/03/16 19:09:30
+ Log: trivial integrate of mainline
+ Branch: win32/perl
+ +> lib/ExtUtils/Installed.pm lib/ExtUtils/Packlist.pm
+ +> lib/ExtUtils/inst
+ !> (integrate 61 files)
+____________________________________________________________________________
+[ 826] By: mbeattie on 1998/03/16 16:39:23
+ Log: newCONSTSUB had private MY_start_subparse.
+ Branch: perl
+ ! op.c
+____________________________________________________________________________
+[ 825] By: mbeattie on 1998/03/16 16:36:55
+ Log: Missing dTHR in hv_fetch_ent when statics moved to thread struct.
+ Branch: perl
+ ! hv.c
+____________________________________________________________________________
+[ 824] By: mbeattie on 1998/03/16 16:27:43
+ Log: Added missing entry for lib/ExtUtils/Packlist.pm to MANIFEST
+ Branch: perl
+ ! MANIFEST
+____________________________________________________________________________
+[ 823] By: mbeattie on 1998/03/16 16:26:02
+ Log: Missed p4 add of lib/ExtUtils/Packlist.pm in change 814.
+ Branch: perl
+ + lib/ExtUtils/Packlist.pm
+____________________________________________________________________________
+[ 822] By: mbeattie on 1998/03/16 16:22:58
+ Log: Bump patchlevel.h to 63.
+ Branch: perl
+ ! ext/IO/IO.xs patchlevel.h
+ !> (integrate 41 files)
+____________________________________________________________________________
+[ 821] By: mbeattie on 1998/03/16 16:18:35
+ Log: newCONSTSUB added (XSUB equivalent for inlinable sub () { 123 }).
+ Subject: Bundling builtin.pm and newCONSTSUB with the core?
+ From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Sun, 15 Mar 1998 19:09:05 +0100
+ Branch: perl
+ ! embed.h global.sym op.c pod/perlguts.pod proto.h
+____________________________________________________________________________
+[ 820] By: mbeattie on 1998/03/16 16:02:50
+ Log: Subject: [PATCH] STRESS_REALLOC
+ Date: Fri, 13 Mar 1998 22:28:19 -0600 (CST)
+ From: Stephen McCamant <alias@mcs.com>
+ Branch: perl
+ ! malloc.c perl.c scope.c
+____________________________________________________________________________
+[ 819] By: mbeattie on 1998/03/16 16:01:06
+ Log: Subject: [BUG+PATCH] _62 with -DDEBUGGING and -Duseperlio
+ Date: Fri, 13 Mar 1998 23:21:25 +0100
+ From: Jan-Pieter Cornet <john@pc.xs4all.nl>
+ Branch: perl
+ ! perly.c
+____________________________________________________________________________
+[ 818] By: mbeattie on 1998/03/16 15:59:16
+ Log: Subject: [Configure PATCH] for OS/2
+ Date: Fri, 13 Mar 1998 16:18:12 -0500 (EST)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ [Two hunks to Configure failed to apply due to clashes]
+ Branch: perl
+ ! Configure hints/os2.sh
+____________________________________________________________________________
+[ 817] By: mbeattie on 1998/03/16 15:55:28
+ Log: Subject: [PATCH 5.004_62] VMS updates (direct)
+ Date: Thu, 12 Mar 1998 16:02:29 -0500 (EST)
+ From: Charles Bailey <BAILEY@newman.upenn.edu>
+ [Needed manual tweaks on vms/config.vms since it clashed with other
+ patches. I may have got it wrong.]
+ Branch: perl
+ ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_VMS.pm
+ ! lib/ExtUtils/Mksymlists.pm perl.h pp.c pp_hot.c regcomp.c
+ ! regcomp.h utils/perldoc.PL vms/config.vms vms/descrip.mms
+ ! vms/ext/Stdio/Stdio.pm vms/ext/filespec.t vms/fndvers.com
+ ! vms/gen_shrfls.pl vms/genconfig.pl vms/sockadapt.h
+ ! vms/test.com vms/vms.c vms/vmsish.h
+____________________________________________________________________________
+[ 816] By: mbeattie on 1998/03/16 15:26:04
+ Log: Subject: [PATCH] Let h2xs read multiple header files
+ Date: Tue, 10 Mar 1998 09:35:42 -0500 (EST)
+ From: Benjamin Sugars <bsugars@canoe.ca>
+ Branch: perl
+ ! utils/h2xs.PL
+____________________________________________________________________________
+[ 815] By: mbeattie on 1998/03/16 15:24:12
+ Log: Subject: Re: Almost OK: Perl 5.004_62 on VMS 7.1
+ Date: Mon, 09 Mar 1998 09:18:56 -0800
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Branch: perl
+ ! vms/config.vms
+____________________________________________________________________________
+[ 814] By: mbeattie on 1998/03/16 13:17:14
+ Log: Subject: PATCH for 5.004_62 : Add .packlist handling classes to ExtUtils
+ Date: Sun, 08 Mar 1998 12:50:23 +0000
+ From: Alan Burlison <alan.burlison@UK.Sun.COM>
+ plus manual update of MANIFEST
+ Branch: perl
+ + lib/ExtUtils/Installed.pm lib/ExtUtils/inst
+ ! MANIFEST installman installperl lib/ExtUtils/Install.pm
+ ! lib/ExtUtils/MM_Unix.pm
+____________________________________________________________________________
+[ 813] By: mbeattie on 1998/03/16 13:08:55
+ Log: From: Blair Zajac <blair@gps.caltech.edu>
+ Subject: PATCH: util.c and util.h function declarations do not match
+ Date: Fri, 6 Mar 1998 10:29:29 -0800 (PST)
+ Subject: PATCH: cgywin32 patch for perlgcc
+ Date: Fri, 6 Mar 1998 11:15:36 -0800 (PST)
+ Subject: PATCH: perl5.004_62 on cygwin32
+ Date: Fri, 6 Mar 1998 11:57:35 -0800 (PST)
+ Branch: perl
+ ! Configure cygwin32/perlgcc cygwin32/perlld pp_sys.c x2p/util.c
+____________________________________________________________________________
+[ 812] By: mbeattie on 1998/03/16 12:55:39
+ Log: From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Subject: [PATCH 5.004_62} Config_62-01 patch available.
+ Date: Mon, 9 Mar 1998 15:23:33 -0500 (EST)
+ Subject: [PATCH 5.004_62] Tiny hint file updates
+ Date: Mon, 9 Mar 1998 13:21:46 -0500 (EST)
+ Branch: perl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH ext/ODBM_File/ODBM_File.xs handy.h hints/aix.sh
+ ! hints/dec_osf.sh hints/dos_djgpp.sh hints/freebsd.sh
+ ! hints/irix_6.sh hints/irix_6_0.sh hints/irix_6_1.sh
+ ! hints/os2.sh hints/solaris_2.sh patchlevel.h perl.c perl.h
+ ! perllio.h pod/perldiag.pod pp_sys.c vms/config.vms
+____________________________________________________________________________
+[ 811] By: mbeattie on 1998/03/16 12:13:55
+ Log: DOS djgpp updates:
+ From: Laszlo Molnar <molnarl@cdata.tvnet.hu>
+ Subject: [PATCH for 5.004_61] dos-djgpp update
+ Date: Fri, 6 Mar 1998 10:41:01 +0100
+ Subject: [PATCH 5.004_62] dos-djgpp update
+ Date: Thu, 12 Mar 1998 13:34:51 +0100
+ Branch: perl
+ ! djgpp/config.over hints/dos_djgpp.sh
+____________________________________________________________________________
+[ 810] By: gsar on 1998/03/16 08:48:17
+ Log: integrate mainline
+ Branch: win32/perl
+ !> pp_sys.c
+____________________________________________________________________________
+[ 809] By: gsar on 1998/03/16 08:44:37
+ Log: various changes to get asperl working under Borland
+ (passes all tests when built under PERL_OBJECT)
+ Branch: asperl
+ ! ObjXSub.h ext/Opcode/Opcode.xs globals.c mg.c objpp.h op.c
+ ! perl.h perly.c perly.c.diff pp.c pp_ctl.c pp_hot.c pp_sys.c
+ ! proto.h scope.h sv.c toke.c win32/Makefile win32/config_H.bc
+ ! win32/config_H.gc win32/config_H.vc win32/makedef.pl
+ ! win32/makefile.mk win32/runperl.c win32/win32.c win32/win32.h
+ ! win32/win32sck.c
+____________________________________________________________________________
+[ 808] By: gsar on 1998/03/12 19:50:20
+ Log: set sockets to nonoverlapped mode for every thread
+ Message-Id: <35081FE4.965A484D@enteract.com>
+ Date: Thu, 12 Mar 1998 11:48:20 CST
+ From: Steve Nielsen <spn@enteract.com>
+ Subject: [PATCH 5.004_62] win32: set sockopt on a per-thread basis
+ Branch: win32/perl
+ ! win32/win32.h win32/win32sck.c
+____________________________________________________________________________
+[ 807] By: gsar on 1998/03/12 19:26:54
+ Log: add AS patch#13
+ Branch: asperl
+ ! win32/Makefile
+____________________________________________________________________________
+[ 806] By: gsar on 1998/03/12 00:51:08
+ Log: added AS patch#12 with minor changes
+ Branch: asperl
+ ! ObjXSub.h bytecode.h byterun.c doio.c iplio.h
+ ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm
+ ! lib/ExtUtils/Mksymlists.pm lib/ExtUtils/xsubpp objpp.h perl.c
+ ! perllio.h proto.h regcomp.c win32/Makefile win32/config_h.PL
+ ! win32/runperl.c
+____________________________________________________________________________
+[ 805] By: gsar on 1998/03/10 20:35:10
+ Log: reinstate some standard sig_names to avoid noise from
+ modules (and in hopes of making them _do_ something in future)
+ Branch: win32/perl
+ ! win32/config.bc win32/config.gc win32/config.vc
+ ! win32/config_H.bc win32/config_H.gc win32/config_H.vc
+____________________________________________________________________________
+[ 804] By: gsar on 1998/03/10 20:33:05
+ Log: mingw32 tweaks
+ Branch: win32/perl
+ ! win32/makefile.mk win32/win32.c win32/win32.h
+____________________________________________________________________________
+[ 803] By: gsar on 1998/03/09 20:56:07
+ Log: tweak Win32::DomainName() implementation
+ Branch: win32/perl
+ ! win32/Makefile win32/win32.c
+____________________________________________________________________________
+[ 802] By: gsar on 1998/03/09 03:51:01
+ Log: merge C<local $tied{foo}> patch, also moved statics in
+ [ah]v.c to thrdvar.h
+ Branch: win32/perl
+ ! av.c embedvar.h hv.c scope.c t/op/local.t thrdvar.h
+____________________________________________________________________________
+[ 801] By: gsar on 1998/03/09 02:38:35
+ Log: minor win32 support fixes
+ - add a better implementation of Win32::DomainName() (as
+ suggested by Jutta M. Klebe <jmk@exc.bybyte.de>)
+ - fix opendir() emulation was unsafe what given long paths
+ Branch: win32/perl
+ ! win32/win32.c
+____________________________________________________________________________
+[ 800] By: nick on 1998/03/07 09:36:41
+ Log: There has been a 'thaw' in config.h (the ICE has gone ;-))
+ So pp_sys.c needs tweaking otherwise it does not believe getservby*()
+ exist. (Breaks libnet).
+ Branch: perl
+ ! pp_sys.c
+____________________________________________________________________________
+[ 799] By: gsar on 1998/03/07 07:51:28
+ Log: integrate mainline changes
+ Branch: asperl
+ !> (integrate 111 files)
+____________________________________________________________________________
+[ 798] By: gsar on 1998/03/07 07:01:55
+ Log: integrate mainline
+ Branch: win32/perl
+ !> myconfig patchlevel.h
+____________________________________________________________________________
+[ 797] By: gsar on 1998/03/07 06:49:49
+ Log: provide our own popen()/pclose() to fix problems with qx//:
+ - qx// used to always invoke the shell, now does so only when needed
+ - qx// didn't respect PERL5SHELL, now does
+ Branch: win32/perl
+ ! lib/ExtUtils/typemap win32/config_h.PL win32/win32.c
+____________________________________________________________________________
+[ 796] By: gsar on 1998/03/07 01:37:10
+ Log: a missed s/sp/SP/
+ Branch: win32/perl
+ ! lib/ExtUtils/typemap pod/perlcall.pod
+____________________________________________________________________________
+[ 795] By: gsar on 1998/03/07 01:05:21
+ Log: change all 'sp' to 'SP' in code and in the docs. Explicitly
+ mention that local stack pointer should be called SP. This makes the
+ API safer from source incompatibilities down the line.
+ Branch: win32/perl
+ ! av.c doio.c doop.c ext/DB_File/DB_File.xs
+ ! ext/DynaLoader/dl_dld.xs ext/Opcode/Opcode.xs
+ ! ext/POSIX/POSIX.xs ext/Socket/Socket.xs ext/Thread/Thread.xs
+ ! gv.c mg.c op.c os2/OS2/REXX/REXX.xs perl.c pod/perlcall.pod
+ ! pod/perlembed.pod pod/perlguts.pod pod/perlxs.pod pp.c
+ ! pp_ctl.c pp_hot.c pp_sys.c util.c
----------------
-Version 5.003_15
+Version 5.004_62
----------------
-As soon as I posted 5.003_14, I found a fatal error in it. :-(
-
-This release is strictly a bug fix -- it removes some function caching
-changes that were supposed to be improvements, but weren't.
-
+____________________________________________________________________________
+[ 794] By: mbeattie on 1998/03/06 09:38:08
+ Log: Subject: [PATCH] perl5.004_61 myconfig updates
+ Date: Thu, 5 Mar 1998 15:10:54 -0500 (EST)
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Branch: perl
+ ! myconfig
+____________________________________________________________________________
+[ 793] By: mbeattie on 1998/03/06 09:36:37
+ Log: Bump patchlevel.h to 62.
+ Branch: perl
+ ! patchlevel.h
+____________________________________________________________________________
+[ 792] By: mbeattie on 1998/03/06 09:35:57
+ Log: Integrate win32 branch into mainline.
+ Branch: perl
+ !> bytecode.h op.c proto.h scope.c win32/Makefile win32/config.bc
+ !> win32/config.gc win32/config.vc win32/config_H.bc
+ !> win32/config_H.gc win32/config_H.vc win32/makefile.mk
+____________________________________________________________________________
+[ 791] By: gsar on 1998/03/06 06:00:08
+ Log: various
+ - s/PerlIO_fread/PerlIO_read/, the former doesn't exist
+ - add missing prototypes
+ - regenerate win32/config*.?c
+ Branch: win32/perl
+ ! bytecode.h proto.h win32/config.bc win32/config.gc
+ ! win32/config.vc win32/config_H.bc win32/config_H.gc
+ ! win32/config_H.vc win32/makefile.mk
+____________________________________________________________________________
+[ 790] By: gsar on 1998/03/06 03:19:23
+ Log: fix typo in Makefile
+ Branch: win32/perl
+ ! win32/Makefile
+____________________________________________________________________________
+[ 789] By: gsar on 1998/03/05 22:55:53
+ Log: integrate mainline
+ Branch: win32/perl
+ !> (integrate 47 files)
+____________________________________________________________________________
+[ 788] By: gsar on 1998/03/05 20:02:09
+ Log: added AS patch#11
+ Message-Id: <01BD4820.AFC70110.dougl@ActiveState.com>
+ Date: Thu, 05 Mar 1998 10:23:04 PST
+ From: Douglas Lankshear <dougl@ActiveState.com>
+
+ This patch fixes a bug I introduced removing duplicate code.
+ -- Doug
+ Branch: asperl
+ ! ObjXSub.h objpp.h win32/runperl.c
+____________________________________________________________________________
+[ 787] By: gsar on 1998/03/05 19:56:17
+ Log: add Nick's dTHR fixes
+ Branch: win32/perl
+ ! op.c scope.c
+____________________________________________________________________________
+[ 786] By: gsar on 1998/03/05 19:54:49
+ Log: maintpatch
+ Message-Id: <199803050749.CAA15206@Orb.Nashua.NH.US>
+ Date: Thu, 05 Mar 1998 02:49:46 EST
+ From: Spider Boardman <spider@orb.nashua.nh.us>
+ Subject: [PATCH] 5.004_04 +MAINT_TRIAL_1 broken when sizeof(int) != sizeof(void
+ Branch: win32/perl
+ ! scope.c
+____________________________________________________________________________
+[ 785] By: mbeattie on 1998/03/05 19:12:14
+ Log: Subject: [5.004_61 PATCH] Make incompatible changes to RE engine NOW
+ Date: Wed, 4 Mar 1998 23:55:54 -0500 (EST)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Branch: perl
+ ! op.c proto.h regcomp.c regexp.h util.c
+____________________________________________________________________________
+[ 784] By: mbeattie on 1998/03/05 19:11:09
+ Log: Subject: [PATCH] Re: perl 5.0061 unable to build on sparc 5 Sol2.5.1 threads.
+ Date: Wed, 4 Mar 1998 10:18:03 GMT
+ From: Nick Ing-Simmons <nik@tiuk.ti.com>
+ Branch: perl
+ ! atomic.h
+____________________________________________________________________________
+[ 783] By: mbeattie on 1998/03/05 19:09:16
+ Log: Subject: Configure patches -01 and -02 for 5.004_61.
+ Date: Tue, 3 Mar 1998 16:41:16 -0500 (EST)
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Branch: perl
+ ! Configure INSTALL Policy_sh.SH Porting/Glossary
+ ! Porting/config.sh Porting/config_H Porting/pumpkin.pod
+ ! config_h.SH handy.h hints/README.hints hints/aix.sh
+ ! hints/linux.sh hints/solaris_2.sh hints/unicos.sh
+ ! makedepend.SH myconfig pp_sys.c
+____________________________________________________________________________
+[ 782] By: mbeattie on 1998/03/05 19:05:23
+ Log: Subject: [PATCH] Compiling with OP_IN_REGISTER
+ Date: 03 Mar 1998 18:05:07 +0100
+ From: Gisle Aas <gisle@aas.no>
+ Branch: perl
+ ! perl.h pp_ctl.c
+____________________________________________________________________________
+[ 781] By: mbeattie on 1998/03/05 19:04:34
+ Log: Subject: [PATCH] Make autouse -w-safe
+ Date: Mon, 2 Mar 1998 21:36:02 -0500 (EST)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Branch: perl
+ ! lib/autouse.pm op.c sv.c
+____________________________________________________________________________
+[ 780] By: mbeattie on 1998/03/05 19:02:50
+ Log: Subject: [PATCH] External symbol re_croak2
+ Date: 02 Mar 1998 13:00:45 +0100
+ From: Gisle Aas <gisle@aas.no>
+ Branch: perl
+ ! regcomp.c regcomp.h
+____________________________________________________________________________
+[ 779] By: mbeattie on 1998/03/05 19:01:25
+ Log: Subject: [PATCH 5.004_61] Miscellaneous minor fixes
+ Date: Mon, 02 Mar 1998 01:48:27 -0500 (EST)
+ From: bailey@newman.upenn.edu (Charles Bailey)
+ Branch: perl
+ ! bytecode.h embedvar.h ext/B/Makefile.PL ext/B/byteperl.c
+ ! ext/Thread/Makefile.PL lib/File/Path.pm patchlevel.h perldir.h
+ ! sv.h
+____________________________________________________________________________
+[ 778] By: mbeattie on 1998/03/05 18:53:13
+ Log: Subject: [PATCH 5.004_61] USHRT range limit macros
+ Date: Mon, 02 Mar 1998 01:41:41 -0500 (EST)
+ From: bailey@newman.upenn.edu (Charles Bailey)
+ Branch: perl
+ ! perl.h
+____________________________________________________________________________
+[ 777] By: mbeattie on 1998/03/05 18:50:25
+ Log: Subject: [PATCH 5.004_61] File::Basename taint fix (revised)
+ Date: Mon, 02 Mar 1998 01:39:47 -0500 (EST)
+ From: bailey@newman.upenn.edu (Charles Bailey)
+ Branch: perl
+ ! lib/File/Basename.pm
+____________________________________________________________________________
+[ 776] By: mbeattie on 1998/03/05 18:49:15
+ Log: Subject: [PATCH] Take out version number in perlguts (perl5.004_61)
+ Date: 01 Mar 1998 15:16:03 +0100
+ From: Gisle Aas <gisle@aas.no>
+ Branch: perl
+ ! pod/perlguts.pod
+____________________________________________________________________________
+[ 775] By: mbeattie on 1998/03/05 18:48:05
+ Log: Subject: Re: [PATCH] 5.004_61: Makefile.SH (Re: 5.004_61: annoyingly missing patch)
+ Date: Sun, 1 Mar 1998 12:14:44 +0200 (EET)
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Branch: perl
+ ! Makefile.SH perl_exp.SH
+____________________________________________________________________________
+[ 774] By: mbeattie on 1998/03/05 18:46:32
+ Log: Subject: Almost OK: 5.004_61 (threads, perlio)
+ Date: Sun, 1 Mar 1998 02:02:47 -0500
+ From: Spider Boardman <spider@orb.nashua.nh.us>
+ Branch: perl
+ ! bytecode.h bytecode.pl byterun.c byterun.h perlsdio.h
+____________________________________________________________________________
+[ 773] By: mbeattie on 1998/03/05 18:43:57
+ Log: Subject: [PATCH 5.004_61] print sort {-1} 1..10; hangs
+ Date: Sat, 28 Feb 1998 15:51:14 -0500 (EST)
+ From: Hans Mulder <hansmu@xs4all.nl>
+ Branch: perl
+ ! pp_ctl.c
+____________________________________________________________________________
+[ 772] By: mbeattie on 1998/03/05 18:39:25
+ Log: Subject: [PATCH] 5.004_61: Makefile.SH: 'ok' target needs perlbug...
+ Date: Sat, 28 Feb 1998 17:06:41 +0200 (EET)
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Branch: perl
+ ! Makefile.SH
+____________________________________________________________________________
+[ 771] By: mbeattie on 1998/03/05 18:38:32
+ Log: Subject: [PATCH] 5.004_61: hints/netbsd.sh
+ Date: Sat, 28 Feb 1998 16:35:32 +0200 (EET)
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Branch: perl
+ ! hints/netbsd.sh
+____________________________________________________________________________
+[ 770] By: mbeattie on 1998/03/05 18:36:50
+ Log: Add byterun.c to cflags.SH (Dominic Dunlop <domo@vo.lu>)
+ Branch: perl
+ ! cflags.SH
+____________________________________________________________________________
+[ 769] By: mbeattie on 1998/03/05 18:34:35
+ Log: Change getc/fread to PerlIO_getc/fread in bytecode.h:
+ Subject: [PATCH 5.004_61] bunch of small patches
+ Date: Fri, 27 Feb 1998 20:03:29 -0500 (EST)
+ From: Andrew Cohen <cohen@andy.bu.edu>
+ Branch: perl
+ ! bytecode.h
+____________________________________________________________________________
+[ 768] By: mbeattie on 1998/03/05 18:13:06
+ Log: Integrate win32 branch into mainline.
+ Branch: perl
+ !> (integrate 53 files)
+____________________________________________________________________________
+[ 767] By: TimBunce on 1998/03/05 11:48:09
+ Log: Update to change 744.
+ Branch: maint-5.004/perl
+ ! lib/ExtUtils/Install.pm
+____________________________________________________________________________
+[ 765] By: TimBunce on 1998/03/05 11:24:24
+ Log: Update embed.h after make regen_headers.
+ Branch: maint-5.004/perl
+ ! embed.h
+____________________________________________________________________________
+[ 764] By: TimBunce on 1998/03/05 11:05:13
+ Log: APPLLIB_EXP now has arch and version dirs added to @INC
+ Branch: maint-5.004/perl
+ ! perl.c
+____________________________________________________________________________
+[ 763] By: TimBunce on 1998/03/05 11:01:38
+ Log: Added hints/openbsd.sh and t/op/pos.t to MANIFEST
+ Added MAINT_TRIAL_1 local patch label to patchlevel.h
+ Removed win32/win32io.c and win32/win32io.h from repository
+ Branch: maint-5.004/perl
+ - win32/win32io.c win32/win32io.h
+ ! MANIFEST patchlevel.h
+____________________________________________________________________________
+[ 762] By: TimBunce on 1998/03/05 10:05:34
+ Log: Title: "5.004_04 +MAINT_TRIAL_1 broken when sizeof(int) != sizeof(void)"
+ From: Spider Boardman <spider@orb.nashua.nh.us>
+ Files: scope.c
+ Branch: maint-5.004/perl
+ ! scope.c
+____________________________________________________________________________
+[ 761] By: TimBunce on 1998/03/05 10:03:10
+ Log: Title: "properly refcount localization, fix C<local $tied{foo}>"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199802191207.MAA10742@toad.ig.co.uk>
+ Files: av.c hv.c scope.c t/op/local.t
+ Branch: maint-5.004/perl
+ ! av.c hv.c scope.c t/op/local.t
+____________________________________________________________________________
+[ 760] By: gsar on 1998/03/04 20:58:21
+ Log: added AS patch#10
+ Message-Id: <01BD4691.963D1670.dougl@ActiveState.com>
+ Date: Tue, 03 Mar 1998 10:46:13 PST
+ From: Douglas Lankshear <dougl@ActiveState.com>
+ Subject: [PATCH]
+
+ Here's a patch to win32/dl_win32.xs that is a fix for the lookup of statically
+ linked modules.
+
+ -- Doug
+ Branch: asperl
+ ! win32/dl_win32.xs
+____________________________________________________________________________
+[ 759] By: TimBunce on 1998/03/04 18:46:41
+ Log: Update patchls utility
+ Branch: maint-5.004/perl
+ ! Porting/patchls
+____________________________________________________________________________
+[ 758] By: TimBunce on 1998/03/04 17:07:06
+ Log: perldoc -f now uses pager if text is too long for screen
+ Branch: maint-5.004/perl
+ ! utils/perldoc.PL
+____________________________________________________________________________
+[ 757] By: TimBunce on 1998/03/04 16:57:04
+ Log: Added OpenBSD hint file from <Todd.Miller@courtesan.com>
+ Document 'warn with no args' behaviour, from <johnpc@xs4all.net>
+ Branch: maint-5.004/perl
+ + hints/openbsd.sh
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 756] By: TimBunce on 1998/03/04 16:48:40
+ Log: Fix for new gnulibc stdio.h when using sfio+perlio
+ Branch: maint-5.004/perl
+ ! perlsdio.h
+____________________________________________________________________________
+[ 755] By: TimBunce on 1998/03/04 16:47:08
+ Log: Fixed typo in vms/ext/Stdio/Stdio.pm AUTOLOAD
+ Added details of split in scalar context to perlfunc.pod
+ Branch: maint-5.004/perl
+ ! pod/perlfunc.pod vms/ext/Stdio/Stdio.pm
+____________________________________________________________________________
+[ 754] By: TimBunce on 1998/03/04 16:35:58
+ Log: Updated perl -v info to include reference to docs and home page.
+ Branch: maint-5.004/perl
+ ! perl.c
+____________________________________________________________________________
+[ 753] By: TimBunce on 1998/03/04 16:31:29
+ Log: Updated hints/bsdos.sh for BSD/OS 3.1
+ Fixed typo in pod/perlsyn.pod
+ Added workaround for old gmake in ext/SDBM_File/sdbm/Makefile.PL
+ Fixed typo in ext/GDBM_File/GDBM_File.pm
+ Branch: maint-5.004/perl
+ ! ext/GDBM_File/GDBM_File.pm ext/SDBM_File/sdbm/Makefile.PL
+ ! hints/bsdos.sh pod/perlsyn.pod
+____________________________________________________________________________
+[ 752] By: TimBunce on 1998/03/04 15:49:19
+ Log: Changed bug address in README to perlbug@perl.com
+ Changed Copyright in perl.c to 1998
+ Added op/pos.t test from Robin Houston <robin@oneworld.org>
+ Branch: maint-5.004/perl
+ + t/op/pos.t
+ ! README perl.c
+____________________________________________________________________________
+[ 751] By: TimBunce on 1998/03/04 14:47:15
+ Log: Make t/comp/require.t and t/lib/ph.t executable in repository
+ Branch: maint-5.004/perl
+ ! t/comp/require.t t/lib/ph.t
+____________________________________________________________________________
+[ 750] By: TimBunce on 1998/03/04 13:29:58
+ Log: Added dTHR definition to ease backwards compatibility for XS
+ source code from 5.005.
+ Branch: maint-5.004/perl
+ ! perl.h
+____________________________________________________________________________
+[ 749] By: TimBunce on 1998/03/04 12:19:19
+ Log: Title: "rename local 'op' variables to 'o'", #F114
+ From: Gurusamy Sarathy
+ Files: op.h opcode.h proto.h dump.c op.c opcode.pl pp_ctl.c run.c scope.c
+ toke.c
+ Branch: maint-5.004/perl
+ ! dump.c op.c op.h opcode.h opcode.pl pp_ctl.c proto.h run.c
+ ! scope.c toke.c
+____________________________________________________________________________
+[ 748] By: TimBunce on 1998/03/04 12:12:27
+ Log: Title: "consolidated win32 patch", #F112
+ From: Gurusamy Sarathy
+ Files: MANIFEST pod/perlfaq2.pod pod/perlrun.pod win32/include/sys/socket.h
+ EXTERN.h INTERN.h dosish.h lib/ExtUtils/Command.pm
+ lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Win32.pm
+ lib/ExtUtils/Mksymlists.pm lib/File/DosGlob.pm t/TEST
+ t/harness win32/win32.h win32/win32iop.h README.win32
+ doio.c installhtml installperl pp_sys.c win32/Makefile
+ win32/config.bc win32/config.vc win32/config_H.bc
+ win32/config_H.vc win32/config_h.PL win32/config_sh.PL
+ win32/dl_win32.xs win32/makedef.pl win32/makefile.mk
+ win32/perllib.c win32/runperl.c win32/win32.c
+ win32/win32sck.c win32/bin/perlglob.pl x2p/a2p.h x2p/a2p.c
+ x2p/a2py.c
+ Branch: maint-5.004/perl
+ + win32/bin/perlglob.pl
+ ! EXTERN.h INTERN.h MANIFEST README.win32 doio.c dosish.h
+ ! installhtml installperl lib/ExtUtils/Command.pm
+ ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Win32.pm
+ ! lib/ExtUtils/Mksymlists.pm lib/File/DosGlob.pm
+ ! pod/perlfaq2.pod pod/perlrun.pod pp_sys.c t/TEST t/harness
+ ! win32/Makefile win32/config.bc win32/config.vc
+ ! win32/config_H.bc win32/config_H.vc win32/config_h.PL
+ ! win32/config_sh.PL win32/dl_win32.xs
+ ! win32/include/sys/socket.h win32/makedef.pl win32/makefile.mk
+ ! win32/perllib.c win32/runperl.c win32/win32.c win32/win32.h
+ ! win32/win32iop.h win32/win32sck.c x2p/a2p.c x2p/a2p.h
+ ! x2p/a2py.c
+____________________________________________________________________________
+[ 747] By: TimBunce on 1998/03/04 11:59:57
+ Log: Title: "initialize @INC in ph.t, and fix up MANIFEST", #F111
+ From: Gurusamy Sarathy
+ Files: MANIFEST t/lib/ph.t
+ Branch: maint-5.004/perl
+ ! MANIFEST t/lib/ph.t
+____________________________________________________________________________
+[ 746] By: TimBunce on 1998/03/04 11:47:43
+ Log: Title: "properly save STDOUT during system() in debugger", #F110
+ From: Jason Smith <smithj4@rpi.edu>
+ Files: lib/perl5db.pl
+ Branch: maint-5.004/perl
+ ! lib/perl5db.pl
+____________________________________________________________________________
+[ 745] By: TimBunce on 1998/03/04 11:40:19
+ Log: Title: "generate DynaLoader.pm at build time", #F109
+ From: Achim Bohnet <ach@mpe.mpg.de>
+ Msg-ID: <9802111938.AA26224@o09.xray.mpe.mpg.de>
+ Files: MANIFEST ext/DynaLoader/DynaLoader.pm.PL ext/DynaLoader/Makefile.PL
+ Branch: maint-5.004/perl
+ + ext/DynaLoader/DynaLoader.pm.PL
+ ! MANIFEST ext/DynaLoader/Makefile.PL
+____________________________________________________________________________
+[ 744] By: TimBunce on 1998/03/04 11:34:09
+ Log: Title: "Install extensions with bootstrap in $archlib", #F108
+ From: koenig@anna.mind.de (Andreas J. Koenig), koenig@kulturbox.de (Andreas
+ J. Koenig)
+ Msg-ID: <sfcra9fqx0n.fsf@anna.in-berlin.de>
+ Files: lib/ExtUtils/Install.pm
+ Branch: maint-5.004/perl
+ ! lib/ExtUtils/Install.pm
+____________________________________________________________________________
+[ 743] By: TimBunce on 1998/03/04 10:45:05
+ Log: Title: "Pod::Html trips over "C<0>"", #F107
+ From: Chip Salzenberg
+ Files: lib/Pod/Html.pm
+ Branch: maint-5.004/perl
+ ! lib/Pod/Html.pm
+____________________________________________________________________________
+[ 742] By: TimBunce on 1998/03/04 10:12:54
+ Log: Title: "5.004_58 | _04: pod2*,perlpod: L<show this|man/section>", #F106
+ From: Achim Bohnet <ach@mpe.mpg.de>
+ Msg-ID: <9802111629.AA00595@o09.xray.mpe.mpg.de>
+ Files: pod/perlpod.pod lib/Pod/Html.pm lib/Pod/Text.pm pod/pod2man.PL
+ Branch: maint-5.004/perl
+ ! lib/Pod/Html.pm lib/Pod/Text.pm pod/perlpod.pod pod/pod2man.PL
+____________________________________________________________________________
+[ 741] By: TimBunce on 1998/03/04 10:08:31
+ Log: Title: "New patch for $^E==GetLastError() under Win32", #F105
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>, Tye McQueen
+ <tye@metronet.com>, ilya@math.ohio-state.edu (Ilya
+ Zakharevich)
+ Msg-ID: <199801040630.AA29298@metronet.com>,
+ <199801041826.NAA11568@aatma.engin.umich.edu>,
+ <1998Jan4.130412.2719461@cor.newman>
+ Files: pod/perlfunc.pod pod/perlvar.pod doio.c lib/dumpvar.pl lib/perl5db.pl
+ win32/win32.h mg.c util.c win32/makedef.pl win32/win32.c
+ Branch: maint-5.004/perl
+ ! doio.c lib/dumpvar.pl lib/perl5db.pl mg.c pod/perlfunc.pod
+ ! pod/perlvar.pod util.c win32/makedef.pl win32/win32.c
+ ! win32/win32.h
+____________________________________________________________________________
+[ 740] By: TimBunce on 1998/03/04 09:55:57
+ Log: Title: "5.004_56: Patch to Tie::Hash and docs", #F104
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199801120134.UAA05437@monk.mps.ohio-state.edu>
+ Files: pod/perlfunc.pod lib/Tie/Hash.pm
+ Branch: maint-5.004/perl
+ ! lib/Tie/Hash.pm pod/perlfunc.pod
+____________________________________________________________________________
+[ 739] By: TimBunce on 1998/03/04 09:26:01
+ Log: Title: "more doc for perldoc", #F103
+ From: Gurusamy Sarathy
+ Files: utils/perldoc.PL
+ Branch: maint-5.004/perl
+ ! utils/perldoc.PL
+____________________________________________________________________________
+[ 738] By: TimBunce on 1998/03/04 09:23:16
+ Log: Title: "Make perldoc look for an index file ", #F102
+ From: Gisle Aas <gisle@aas.no>
+ Msg-ID: <199801221220.NAA22902@furu.g.aas.no>
+ Files: utils/perldoc.PL
+ Branch: maint-5.004/perl
+ ! utils/perldoc.PL
+____________________________________________________________________________
+[ 737] By: TimBunce on 1998/03/04 09:21:15
+ Log: Title: "perldoc -F filename", #F101
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199712120037.TAA00176@math.mps.ohio-state.edu>
+ Files: utils/perldoc.PL
+ Branch: maint-5.004/perl
+ ! utils/perldoc.PL
+____________________________________________________________________________
+[ 736] By: TimBunce on 1998/03/04 09:16:20
+ Log: Title: "sv_grow can fail for HAS_64K_LIMIT systems", #F100
+ From: Gisle Aas <gisle@aas.no>
+ Msg-ID: <m3iuqsl3oq.fsf@furu.g.aas.no>
+ Files: sv.c
+ Branch: maint-5.004/perl
+ ! sv.c
+____________________________________________________________________________
+[ 735] By: TimBunce on 1998/03/04 09:08:51
+ Log: Title: "Benchmark.pm: timethese corrupts $_", #F099
+ From: abigail@fnx.com
+ Msg-ID: <19980201114609.7779.qmail@betelgeuse.wayne.fnx.com>
+ Files: lib/Benchmark.pm
+ Branch: maint-5.004/perl
+ ! lib/Benchmark.pm
+____________________________________________________________________________
+[ 734] By: TimBunce on 1998/03/04 08:59:58
+ Log: Title: "STRANGE_MALLOC should test failed alloc", #F098
+ From: Gisle Aas <gisle@aas.no>
+ Msg-ID: <199802021406.PAA03285@furu.g.aas.no>
+ Files: hv.c
+ Branch: maint-5.004/perl
+ ! hv.c
+____________________________________________________________________________
+[ 733] By: TimBunce on 1998/03/04 08:35:19
+ Log: Title: "support caseless %ENV", #F097
+ From: Gurusamy Sarathy
+ Files: hv.c t/op/magic.t win32/win32.h
+ Branch: maint-5.004/perl
+ ! hv.c t/op/magic.t win32/win32.h
+____________________________________________________________________________
+[ 732] By: TimBunce on 1998/03/04 08:33:58
+ Log: Title: "newer cperl-mode.el (from 5.004_60)", #F096
+ From: Ilya Zakharevich
+ Files: emacs/cperl-mode.el
+ Branch: maint-5.004/perl
+ ! emacs/cperl-mode.el
+____________________________________________________________________________
+[ 731] By: TimBunce on 1998/03/04 08:26:23
+ Log: Title: "Handle set magic on xsub OUTPUT args, add API functions that handle
+ magic", #F095
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199801190409.XAA26710@aatma.engin.umich.edu>
+ Files: pod/perlguts.pod pod/perlxs.pod embed.h proto.h sv.h global.sym
+ lib/ExtUtils/xsubpp sv.c
+ Branch: maint-5.004/perl
+ ! embed.h global.sym lib/ExtUtils/xsubpp pod/perlguts.pod
+ ! pod/perlxs.pod proto.h sv.c sv.h
+____________________________________________________________________________
+[ 730] By: TimBunce on 1998/03/04 08:20:52
+ Log: Title: "Fix flawed cleanup when signal handlers are not defined", #F094
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199710290106.UAA11485@aatma.engin.umich.edu>
+ Files: mg.c
+ Branch: maint-5.004/perl
+ ! mg.c
+____________________________________________________________________________
+[ 729] By: TimBunce on 1998/03/04 08:18:02
+ Log: Title: "Tests for C<sort 'foo','bar'>", #F093
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Msg-ID: <199711021247.MAA01743@crypt.compulink.co.uk>
+ Files: t/op/sort.t
+ Branch: maint-5.004/perl
+ ! t/op/sort.t
+____________________________________________________________________________
+[ 728] By: TimBunce on 1998/03/04 08:17:07
+ Log: Title: "Make search.pl work on win32", #F092
+ From: Gurusamy Sarathy
+ Files: win32/bin/search.pl
+ Branch: maint-5.004/perl
+ ! win32/bin/search.pl
+____________________________________________________________________________
+[ 727] By: gsar on 1998/03/04 04:13:23
+ Log: missing s/op/o/ from one of the mainpatches
+ Branch: win32/perl
+ ! op.c
+____________________________________________________________________________
+[ 726] By: gsar on 1998/03/04 02:12:13
+ Log: maintpatches #102 and #103 to perldoc.PL
+ Branch: win32/perl
+ ! utils/perldoc.PL
+____________________________________________________________________________
+[ 725] By: gsar on 1998/03/04 02:00:15
+ Log: renumber some tests to match maint branch
+ Branch: win32/perl
+ ! t/op/local.t
+____________________________________________________________________________
+[ 724] By: gsar on 1998/03/04 01:25:50
+ Log: maintpatch
+ #70: "Fix random whitespace errors in docs"
+ From: Roderick Schertler <roderick@argon.org>
+ Msg-ID: <12726.877706444@eeyore.ibcinc.com>
+ Date: Fri, 24 Oct 1997 11:20:44 -0400
+ Files: pod/checkpods.PL pod/perlfunc.pod
+ Branch: win32/perl
+ ! pod/checkpods.PL
+____________________________________________________________________________
+[ 723] By: gsar on 1998/03/04 01:04:37
+ Log: sync maintpatch
+ #76: "Fix infinite loop on unlink() failure in File::Path::rmtree()
+ From: Chip Salzenberg
+ Files: lib/File/Path.pm
+ Branch: win32/perl
+ ! lib/File/Path.pm
+____________________________________________________________________________
+[ 722] By: gsar on 1998/03/04 00:46:46
+ Log: remove redundancy in File::Find
+ Branch: win32/perl
+ ! lib/File/Find.pm
+____________________________________________________________________________
+[ 721] By: TimBunce on 1998/03/03 20:06:41
+ Log: Title: "Fix spurious perldoc warnings on DOSISH platforms", #F091
+ From: Molnar Laszlo <molnarl@cdata.tvnet.hu>
+ Msg-ID: <34475659.1AA69855@cdata.tvnet.hu>
+ Files: utils/perldoc.PL
+ Branch: maint-5.004/perl
+ ! utils/perldoc.PL
+____________________________________________________________________________
+[ 720] By: TimBunce on 1998/03/03 20:03:59
+ Log: Title: "Make ExtUtils::MM_Unix::fixin() do something meaningful on win32",
+ #F090
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199801070016.TAA17766@aatma.engin.umich.edu>
+ Files: lib/ExtUtils/MM_Unix.pm
+ Branch: maint-5.004/perl
+ ! lib/ExtUtils/MM_Unix.pm
+____________________________________________________________________________
+[ 719] By: TimBunce on 1998/03/03 20:02:06
+ Log: Title: "Fix inconsistent case $ENV{Path} (vs $ENV{PATH})", #F089
+ From: Gurusamy Sarathy
+ Files: lib/FindBin.pm
+ Branch: maint-5.004/perl
+ ! lib/FindBin.pm
+____________________________________________________________________________
+[ 718] By: TimBunce on 1998/03/03 20:00:26
+ Log: Title: "Fix File::Find's longstanding confusion about win32 being like VMS",
+ #F088
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199802020459.XAA04964@aatma.engin.umich.edu>
+ Files: lib/File/Find.pm
+ Branch: maint-5.004/perl
+ ! lib/File/Find.pm
+____________________________________________________________________________
+[ 717] By: TimBunce on 1998/03/03 19:59:38
+ Log: Title: "do_postponed breaks with multiple interpreters", #F087
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199710290316.WAA15888@aatma.engin.umich.edu>
+ Files: op.c
+ Branch: maint-5.004/perl
+ ! op.c
+____________________________________________________________________________
+[ 716] By: TimBunce on 1998/03/03 19:57:17
+ Log: Title: "Make warning on C<Nosuch::> optional, add to perl{diag,delta}.pod",
+ #F086
+ From: Gurusamy Sarathy
+ Files: pod/perldelta.pod pod/perldiag.pod toke.c
+ Branch: maint-5.004/perl
+ ! pod/perldelta.pod pod/perldiag.pod toke.c
+____________________________________________________________________________
+[ 715] By: TimBunce on 1998/03/03 19:51:33
+ Log: Title: "Pod::Html bug and fix: missing </UL> in index", #F085
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199802192314.SAA23326@aatma.engin.umich.edu>
+ Files: lib/Pod/Html.pm
+ Branch: maint-5.004/perl
+ ! lib/Pod/Html.pm
+____________________________________________________________________________
+[ 714] By: TimBunce on 1998/03/03 19:50:28
+ Log: Title: "New pod: perlhist", #F084
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199802191556.RAA09578@alpha.hut.fi>
+ Files: MANIFEST pod/perl.pod pod/perlhist.pod pod/perltoc.pod pod/buildtoc
+ Branch: maint-5.004/perl
+ + pod/perlhist.pod
+ ! MANIFEST pod/buildtoc pod/perl.pod pod/perltoc.pod
+____________________________________________________________________________
+[ 713] By: TimBunce on 1998/03/03 19:47:13
+ Log: Title: "Fix restoration of locals on scope unwinding", #F083
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199802110515.AAA23700@aatma.engin.umich.edu>
+ Files: pp_ctl.c t/op/local.t
+ Branch: maint-5.004/perl
+ ! pp_ctl.c t/op/local.t
+____________________________________________________________________________
+[ 712] By: TimBunce on 1998/03/03 19:45:56
+ Log: Title: "after an eval-ed bad require, requiring a string ref SEGVs", #F082
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199802102349.SAA16001@aatma.engin.umich.edu>
+ Files: pp_ctl.c
+ Branch: maint-5.004/perl
+ ! pp_ctl.c
+____________________________________________________________________________
+[ 711] By: TimBunce on 1998/03/03 19:44:41
+ Log: Title: "Fix seg fault on eval/require and syntax errors", #F081
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199802102321.SAA15346@aatma.engin.umich.edu>
+ Files: MANIFEST scope.h op.c pp_ctl.c scope.c t/comp/require.t toke.c
+ Branch: maint-5.004/perl
+ + t/comp/require.t
+ ! MANIFEST op.c pp_ctl.c scope.c scope.h toke.c
+____________________________________________________________________________
+[ 710] By: TimBunce on 1998/03/03 19:36:34
+ Log: Title: "5.004_58: the locale.t problem in IRIX", #F080
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199802091747.TAA01735@alpha.hut.fi>
+ Files: t/pragma/locale.t
+ Branch: maint-5.004/perl
+ ! t/pragma/locale.t
+____________________________________________________________________________
+[ 709] By: TimBunce on 1998/03/03 19:32:30
+ Log: Title: "sv_setnv will upgrade SVt_NV to SVt_PVNV", #F079
+ From: Gisle Aas <gisle@aas.no>
+ Msg-ID: <m3g1lwl3bq.fsf@furu.g.aas.no>
+ Files: sv.c
+ Branch: maint-5.004/perl
+ ! sv.c
+____________________________________________________________________________
+[ 708] By: TimBunce on 1998/03/03 19:28:06
+ Log: Title: "Eliminate double warnings under C<package;>", #F077
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0y0paq-0000Ov-00@ursa.cus.cam.ac.uk>
+ Files: gv.c op.c toke.c
+ Branch: maint-5.004/perl
+ ! gv.c op.c toke.c
+____________________________________________________________________________
+[ 707] By: TimBunce on 1998/03/03 19:13:17
+ Log: Title: "Fix infinite loop on unlink() failure in File::Path::rmtree()",
+ #F076
+ From: Murray Nesbitt <mjn@pathcom.com>, Tim Bunce <Tim.Bunce@ig.co.uk>
+ Msg-ID: <199802061100.LAA16423@toad.ig.co.uk>
+ Files: lib/File/Path.pm
+ Branch: maint-5.004/perl
+ ! lib/File/Path.pm
+____________________________________________________________________________
+[ 706] By: TimBunce on 1998/03/03 19:08:45
+ Log: Title: "Update of h2ph", #F075
+ From: kstar@www.chapin.edu (Kurt D. Starsinic)
+ Msg-ID: <199802051354.FAA11452@www.chapin.edu>
+ Files: t/lib/ph.t utils/h2ph.PL
+ Branch: maint-5.004/perl
+ + t/lib/ph.t
+ ! utils/h2ph.PL
+____________________________________________________________________________
+[ 705] By: TimBunce on 1998/03/03 18:56:59
+ Log: Title: "Fix AutoLoader for deep packages", #F074
+ From: Zachary Miller <zcmiller@zappy.er.usgs.gov>
+ Msg-ID: <199710092348.SAA02108@zappy.er.usgs.gov>
+ Files: lib/AutoLoader.pm
+ Branch: maint-5.004/perl
+ ! lib/AutoLoader.pm
+____________________________________________________________________________
+[ 704] By: TimBunce on 1998/03/03 18:35:36
+ Log: Title: "Fix order of warnings for misplaced subscripts", #F073
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Msg-ID: <199710131023.LAA16796@crypt.compulink.co.uk>
+ Files: op.c
+ Branch: maint-5.004/perl
+ ! op.c
+____________________________________________________________________________
+[ 703] By: TimBunce on 1998/03/03 18:32:28
+ Log: Title: "Make recursive lexical analysis more robust", #F072
+ From: Ilya Zakharevich and Chip Salzenberg
+ Msg-ID: <199710160102.VAA28817@monk.mps.ohio-state.edu>
+ Files: toke.c
+ Branch: maint-5.004/perl
+ ! toke.c
+____________________________________________________________________________
+[ 702] By: TimBunce on 1998/03/03 18:18:10
+ Log: Title: "Fix random whitespace errors in docs", #F070
+ From: Roderick Schertler <roderick@argon.org>
+ Msg-ID: <12726.877706444@eeyore.ibcinc.com>
+ Files: pod/perlfunc.pod pod/checkpods.PL
+ Branch: maint-5.004/perl
+ ! pod/checkpods.PL pod/perlfunc.pod
+____________________________________________________________________________
+[ 701] By: TimBunce on 1998/03/03 18:13:54
+ Log: Title: "Fix line numbers after here documents in eval STRING", #F069
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199710241745.NAA08166@monk.mps.ohio-state.edu>
+ Files: toke.c
+ Branch: maint-5.004/perl
+ ! toke.c
+____________________________________________________________________________
+[ 700] By: TimBunce on 1998/03/03 18:11:20
+ Log: Title: "Fix SEGV from combining caller and C<package;>", #F068
+ From: James Duncan <jduncan@epitome.hawk.igs.net>, Nicholas Clark
+ <nick@flirble.org>
+ Msg-ID: <199710241248.NAA00163@flirble.org>,
+ <Pine.LNX.3.96.971024135912.12197A-100000@epitome.hawk.igs.
+ net>
+ Files: pp_ctl.c sv.c
+ Branch: maint-5.004/perl
+ ! pp_ctl.c sv.c
+____________________________________________________________________________
+[ 699] By: TimBunce on 1998/03/03 18:06:59
+ Log: Title: "Don't fold string comparison under C<use locale>", #F067
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199711151506.RAA26287@alpha.hut.fi>
+ Files: op.c
+ Branch: maint-5.004/perl
+ ! op.c
+____________________________________________________________________________
+[ 698] By: TimBunce on 1998/03/03 18:04:51
+ Log: Title: "Fix SEGV on constant at end of sort block", #F066
+ From: Administration <fadmin@informatics.muni.cz>
+ Msg-ID: <199711170838.JAA26073@thetis.fi.muni.cz>
+ Files: op.c
+ Branch: maint-5.004/perl
+ ! op.c
+____________________________________________________________________________
+[ 697] By: TimBunce on 1998/03/03 18:02:54
+ Log: Title: "Allow C<last()> to mean C<last>", #F065
+ From: Chip Salzenberg
+ Files: op.c
+ Branch: maint-5.004/perl
+ ! op.c
+____________________________________________________________________________
+[ 696] By: TimBunce on 1998/03/03 17:58:12
+ Log: Title: "Fix extension version mismatch message", #F064
+ From: Chip Salzenberg
+ Files: XSUB.h
+ Branch: maint-5.004/perl
+ ! XSUB.h
+____________________________________________________________________________
+[ 695] By: TimBunce on 1998/03/03 17:53:04
+ Log: Title: "Better handle and test struct tm of Linux and SunOS", #F063
+ From: Andy Dougherty <doughera@newton.phys.lafayette.edu>
+ Msg-ID: <Pine.SUN.3.96.980205134340.15567B-100000@newton.phys>
+ Files: MANIFEST ext/POSIX/hints/linux.pl ext/POSIX/hints/sunos_4.pl
+ hints/linux.sh hints/sunos_4_1.sh t/lib/posix.t
+ Branch: maint-5.004/perl
+ + ext/POSIX/hints/linux.pl ext/POSIX/hints/sunos_4.pl
+ ! MANIFEST hints/linux.sh hints/sunos_4_1.sh t/lib/posix.t
+____________________________________________________________________________
+[ 694] By: TimBunce on 1998/03/03 17:40:47
+ Log: Title: "Fix doc bug in getservbyname() examples", #F062
+ From: Tom Christiansen
+ Files: ext/Socket/Socket.pm
+ Branch: maint-5.004/perl
+ ! ext/Socket/Socket.pm
+____________________________________________________________________________
+[ 693] By: TimBunce on 1998/03/03 17:32:57
+ Log: Title: "Kill warning about parameter type", #F061
+ From: Chip Salzenberg
+ Files: op.c
+ Branch: maint-5.004/perl
+ ! op.c
+____________________________________________________________________________
+[ 692] By: TimBunce on 1998/03/03 17:11:07
+ Log: Title: "Socket occasional SEGV", #F060
+ From: Trevor Blackwell <tlb@viaweb.com>
+ Msg-ID: <199710281804.NAA09632@wagg.viaweb.com>
+ Files: ext/Socket/Socket.xs
+ Branch: maint-5.004/perl
+ ! ext/Socket/Socket.xs
+____________________________________________________________________________
+[ 691] By: TimBunce on 1998/03/03 17:09:51
+ Log: Title: "Avoid SEGV from local($@)", #F059
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199710290251.VAA14362@aatma.engin.umich.edu>
+ Files: pp_ctl.c
+ Branch: maint-5.004/perl
+ ! pp_ctl.c
+____________________________________________________________________________
+[ 690] By: TimBunce on 1998/03/03 17:08:21
+ Log: Title: "Don't use broken pad_reset() (was Re: Perl bug in 5.004_03 )", #F058
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199710300036.TAA01004@aatma.engin.umich.edu>
+ Files: op.c
+ Branch: maint-5.004/perl
+ ! op.c
+____________________________________________________________________________
+[ 689] By: TimBunce on 1998/03/03 17:05:57
+ Log: Title: "Use STMT_{START,END} in XSRETURN", #F057
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199710300245.VAA04244@aatma.engin.umich.edu>
+ Files: XSUB.h
+ Branch: maint-5.004/perl
+ ! XSUB.h
+____________________________________________________________________________
+[ 688] By: TimBunce on 1998/03/03 17:04:15
+ Log: Title: "Re: Sort grammar bug", #F056
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199711011946.OAA18882@aatma.engin.umich.edu>
+ Files: toke.c
+ Branch: maint-5.004/perl
+ ! toke.c
+____________________________________________________________________________
+[ 687] By: TimBunce on 1998/03/03 17:01:32
+ Log: Title: "Document indirect object cases for exec(), system()", #F055
+ From: Dominic Dunlop <domo@slipper.ip.lu>
+ Msg-ID: <v03110700b084e89234a7@[194.51.248.90]>
+ Files: pod/perlfunc.pod
+ Branch: maint-5.004/perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 686] By: TimBunce on 1998/03/03 16:56:44
+ Log: Title: "Update docs on tr///", #F054
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID: <Pine.GSO.3.96.971103071602.10568C-100000@usertest.teleport.com>
+ Files: pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod
+ pod/perllocale.pod pod/perlmod.pod pod/perlop.pod
+ pod/perlstyle.pod toke.c
+ Branch: maint-5.004/perl
+ ! pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod
+ ! pod/perllocale.pod pod/perlmod.pod pod/perlop.pod
+ ! pod/perlstyle.pod toke.c
+____________________________________________________________________________
+[ 685] By: TimBunce on 1998/03/03 16:38:50
+ Log: Title: "Re: perlop bitwise & | ^ documentation", #F053
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID: <Pine.GSO.3.96.971106073858.29771O-100000@usertest.teleport.com>
+ Files: pod/perlop.pod
+ Branch: maint-5.004/perl
+ ! pod/perlop.pod
+____________________________________________________________________________
+[ 684] By: TimBunce on 1998/03/03 16:37:00
+ Log: Title: "Fix SEGV on C<*glob{'SCALAR','ARRAY'}>", #F052
+ From: "Joseph N. Hall" <joseph@cscaper.com>
+ Msg-ID: <199711110552.WAA12613@gadget.cscaper.com>
+ Files: perly.c perly.c.diff perly.y vms/perly_c.vms
+ Branch: maint-5.004/perl
+ ! perly.c perly.c.diff perly.y vms/perly_c.vms
+____________________________________________________________________________
+[ 683] By: TimBunce on 1998/03/03 16:31:15
+ Log: Title: "for perlguts.pod: document sv_derived_from, sv_vcatpfn and
+ sv_vsetpfn", #F051
+ From: jan.dubois@ibm.net (Jan Dubois) and Chip Salzenberg
+ Msg-ID: <346ae970.7444534@smtp1.ibm.net>
+ Files: pod/perlguts.pod
+ Branch: maint-5.004/perl
+ ! pod/perlguts.pod
+____________________________________________________________________________
+[ 682] By: TimBunce on 1998/03/03 16:28:30
+ Log: Title: "5.004_04: locale startup failure (at last) documented", #F050
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199711172054.WAA08261@alpha.hut.fi>
+ Files: INSTALL pod/perldiag.pod pod/perllocale.pod
+ Branch: maint-5.004/perl
+ ! INSTALL pod/perldiag.pod pod/perllocale.pod
+____________________________________________________________________________
+[ 681] By: TimBunce on 1998/03/03 16:24:12
+ Log: Title: "Cope with lack of args in Fcntl::AUTOLOAD", #F049
+ From: Jerome Abela <abela@hsc.fr>
+ Msg-ID: <19971120183248.23588@coredump.hsc.fr>
+ Files: ext/Fcntl/Fcntl.pm
+ Branch: maint-5.004/perl
+ ! ext/Fcntl/Fcntl.pm
+____________________________________________________________________________
+[ 680] By: TimBunce on 1998/03/03 16:23:20
+ Log: Title: "Commenting toke.c", #F048
+ From: gnat@frii.com
+ Msg-ID: <199801082138.OAA14186@prometheus.frii.com>
+ Files: toke.c
+ Branch: maint-5.004/perl
+ ! toke.c
+____________________________________________________________________________
+[ 679] By: TimBunce on 1998/03/03 16:18:32
+ Log: Title: "Re: 5.004_04 vec() fails with 32-bit values", #F047
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Msg-ID: <E0xsnr8-0007SS-00@taurus.cus.cam.ac.uk>
+ Files: pod/perlguts.pod pp.c t/op/vec.t
+ Branch: maint-5.004/perl
+ ! pod/perlguts.pod pp.c t/op/vec.t
+____________________________________________________________________________
+[ 678] By: TimBunce on 1998/03/03 16:15:44
+ Log: Title: "A few perl5.004_03 bugs", #F046
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Msg-ID: <199801221211.MAA05315@crypt.compulink.co.uk>
+ Files: mg.c t/op/magic.t
+ Branch: maint-5.004/perl
+ ! mg.c t/op/magic.t
+____________________________________________________________________________
+[ 677] By: TimBunce on 1998/03/03 16:13:11
+ Log: Title: "Faster, cleaner av_unshift() ", #F045
+ From: Gisle Aas <gisle@aas.no>
+ Msg-ID: <199801221850.TAA23111@furu.g.aas.no>
+ Files: av.c
+ Branch: maint-5.004/perl
+ ! av.c
+____________________________________________________________________________
+[ 676] By: TimBunce on 1998/03/03 16:04:30
+ Log: Title: "New hints/solaris2.sh", #F044
+ From: Stephen Zander <srz@mckesson.com>
+ Msg-ID: <87oh12y458.fsf@wsuse5.mckesson.com>
+ Files: hints/solaris_2.sh
+ Branch: maint-5.004/perl
+ ! hints/solaris_2.sh
+____________________________________________________________________________
+[ 675] By: TimBunce on 1998/03/03 15:33:07
+ Log: Title: "Refresh Complex.pm and test", #F043
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199802051608.SAA20262@alpha.hut.fi>
+ Files: lib/Math/Complex.pm t/lib/complex.t
+ Branch: maint-5.004/perl
+ ! lib/Math/Complex.pm t/lib/complex.t
+____________________________________________________________________________
+[ 674] By: TimBunce on 1998/03/03 15:29:16
+ Log: Title: "Fix (\@@) proto", #F042
+ From: "Joseph N. Hall" <joseph@cscaper.com>
+ Msg-ID: <199801240132.SAA25111@gadget.cscaper.com>
+ Files: op.c t/comp/proto.t
+ Branch: maint-5.004/perl
+ ! op.c t/comp/proto.t
+____________________________________________________________________________
+[ 673] By: TimBunce on 1998/03/03 15:26:31
+ Log: Title: "Allow empty BLOCK in code", #F041
+ From: Vladimir Alexiev <vladimir@cs.ualberta.ca>
+ Msg-ID: <19980129002112Z13378-6931+226@scapa.cs.ualberta.ca>
+ Files: toke.c
+ Branch: maint-5.004/perl
+ ! toke.c
+____________________________________________________________________________
+[ 672] By: TimBunce on 1998/03/03 15:23:55
+ Log: Title: "Fix name of $Foo::{'Bar::'}: '*Foo::Bar::'", #F040
+ From: Chip Salzenberg
+ Files: gv.c t/op/gv.t
+ Branch: maint-5.004/perl
+ ! gv.c t/op/gv.t
+____________________________________________________________________________
+[ 671] By: TimBunce on 1998/03/03 10:02:32
+ Log: Title: "Keep accurate reference count on globs' stashes", #F038
+ From: Gisle Aas <gisle@aas.no>
+ Msg-ID: <m3zpk7sd3n.fsf@furu.g.aas.no>
+ Files: gv.c sv.c
+ Branch: maint-5.004/perl
+ ! gv.c sv.c
+____________________________________________________________________________
+[ 670] By: TimBunce on 1998/03/03 09:59:48
+ Log: Title: "Avoid memory allocation in gv_fetchpv(), for speed", #F037
+ From: Chip Salzenberg
+ Files: gv.c
+ Branch: maint-5.004/perl
+ ! gv.c
+____________________________________________________________________________
+[ 669] By: TimBunce on 1998/03/03 09:58:58
+ Log: Title: "Make Configure less negative about PerlIO", #F036
+ From: chip@atlantic.net
+ Msg-ID: <199801312323.SAA15237@cyprus.atlantic.net>
+ Files: Configure
+ Branch: maint-5.004/perl
+ ! Configure
+____________________________________________________________________________
+[ 668] By: TimBunce on 1998/03/03 09:55:51
+ Log: Title: "Fix (mostly) pseudo-same-REs due to embedded NULs", #F035
+ From: Martin Plechsmid <plechsmi@karlin.mff.cuni.cz>
+ Msg-ID: <199802021217.NAA05230@albert.karlin.mff.cuni.cz>
+ Files: pp_ctl.c
+ Branch: maint-5.004/perl
+ ! pp_ctl.c
+____________________________________________________________________________
+[ 667] By: TimBunce on 1998/03/03 09:52:59
+ Log: Title: "Make Getopt::Long avoid $&, $`, $'", #F034
+ From: Irving Reid <irving@tor.securecomputing.com>
+ Msg-ID: <98Feb3.005102est.11655@janus.tor.securecomputing.com>
+ Files: lib/Getopt/Long.pm
+ Branch: maint-5.004/perl
+ ! lib/Getopt/Long.pm
+____________________________________________________________________________
+[ 666] By: TimBunce on 1998/03/03 09:51:27
+ Log: Title: "adding the newSVpvn API function", #F033
+ From: Matthias Ulrich Neeracher <neeri@iis.ee.ethz.ch>
+ Msg-ID: <199801310532.GAA23798@solar.ethz.ch>
+ Files: pod/perlguts.pod pod/perltoc.pod proto.h global.sym sv.c
+ Branch: maint-5.004/perl
+ ! global.sym pod/perlguts.pod pod/perltoc.pod proto.h sv.c
+____________________________________________________________________________
+[ 665] By: TimBunce on 1998/03/03 09:43:30
+ Log: Title: "Support C<Package::> as function-blind bearword", #F032
+ From: Chip Salzenberg
+ Files: toke.c
+ Branch: maint-5.004/perl
+ ! toke.c
+____________________________________________________________________________
+[ 664] By: TimBunce on 1998/03/03 09:41:40
+ Log: Title: "Re-optimize character classes", #F031
+ From: Chip Salzenberg
+ Files: regcomp.h regcomp.c regexec.c
+ Branch: maint-5.004/perl
+ ! regcomp.c regcomp.h regexec.c
+____________________________________________________________________________
+[ 663] By: TimBunce on 1998/03/03 09:39:55
+ Log: Title: "Fix C<if (1) { local $x }> which needed ENTER/LEAVE", #F030
+ From: dfh@dwroll.lucent.com (D461-David_F_Haertig(Dave)83040)
+ Msg-ID: <EnKC0q.6qI@drnews.dr.lucent.com>
+ Files: op.c t/op/local.t
+ Branch: maint-5.004/perl
+ ! op.c t/op/local.t
+____________________________________________________________________________
+[ 662] By: TimBunce on 1998/03/03 09:37:51
+ Log: Title: "Dramatically improve performance of // with parens or $&", #F029
+ From: Chip Salzenberg
+ Files: cop.h perl.h proto.h regexp.h gv.c interp.sym perl.c pp.c pp_ctl.c
+ pp_hot.c regexec.c scope.c
+ Branch: maint-5.004/perl
+ ! cop.h gv.c interp.sym perl.c perl.h pp.c pp_ctl.c pp_hot.c
+ ! proto.h regexec.c regexp.h scope.c
+____________________________________________________________________________
+[ 661] By: TimBunce on 1998/03/03 09:27:04
+ Log: Title: "Don't warn on $x{shift}, ne => 1, or -f => 1", #F028
+ From: Chip Salzenberg
+ Files: toke.c
+ Branch: maint-5.004/perl
+ ! toke.c
+____________________________________________________________________________
+[ 660] By: TimBunce on 1998/03/03 09:24:41
+ Log: Title: "Protect against weirdness with unreal @_ in C<local @_>", #F027
+ From: Chip Salzenberg
+ Files: scope.c
+ Branch: maint-5.004/perl
+ ! scope.c
+____________________________________________________________________________
+[ 659] By: TimBunce on 1998/03/03 09:24:00
+ Log: Title: "Fix C<printf "%.0d", 0>", #F026
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Msg-ID: <199711021331.NAA01826@crypt.compulink.co.uk>
+ Files: sv.c t/op/sprintf.t
+ Branch: maint-5.004/perl
+ ! sv.c t/op/sprintf.t
+____________________________________________________________________________
+[ 658] By: TimBunce on 1998/03/03 09:22:13
+ Log: Title: "Tiny core patch for source filters", #F025
+ From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ Msg-ID: <9711202312.AA02937@claudius.bfsec.bt.co.uk>
+ Files: toke.c
+ Branch: maint-5.004/perl
+ ! toke.c
+____________________________________________________________________________
+[ 657] By: TimBunce on 1998/03/03 09:20:00
+ Log: Title: "Here-doc in s///e (was: Bug)", #F024
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Msg-ID: <199711221445.OAA14153@crypt.compulink.co.uk>
+ Files: t/base/lex.t toke.c
+ Branch: maint-5.004/perl
+ ! t/base/lex.t toke.c
+____________________________________________________________________________
+[ 656] By: TimBunce on 1998/03/03 09:17:56
+ Log: Title: "Fix duplicate warnings on C<-e undef>", #F023
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Msg-ID: <199711221252.MAA14000@crypt.compulink.co.uk>
+ Files: doio.c t/pragma/warn-1global
+ Branch: maint-5.004/perl
+ ! doio.c t/pragma/warn-1global
+____________________________________________________________________________
+[ 655] By: TimBunce on 1998/03/03 09:16:56
+ Log: Title: "Fix '*' prototype", #F022
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199711212225.RAA00755@monk.mps.ohio-state.edu>
+ Files: toke.c
+ Branch: maint-5.004/perl
+ ! toke.c
+____________________________________________________________________________
+[ 654] By: TimBunce on 1998/03/03 09:15:04
+ Log: Title: "File::Find bugs (and patches)", "File::Find bugs & patches", #F021
+ From: "Conrad E. Kimball" <cek@tblv021.ca.boeing.com>
+ Msg-ID: <199711260703.XAA21257@mailgate2.boeing.com>
+ Files: lib/File/Find.pm
+ Branch: maint-5.004/perl
+ ! lib/File/Find.pm
+____________________________________________________________________________
+[ 653] By: TimBunce on 1998/03/03 09:11:55
+ Log: Title: "Fix typo: FORM{,AT}LINE", #F020
+ From: Chip Salzenberg
+ Files: sv.c
+ Branch: maint-5.004/perl
+ ! sv.c
+____________________________________________________________________________
+[ 652] By: TimBunce on 1998/03/03 09:07:50
+ Log: Title: "Fix use of unref mem when blessed object goes out of scope", #F019
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199711282326.SAA15090@aatma.engin.umich.edu>
+ Files: scope.c
+ Branch: maint-5.004/perl
+ ! scope.c
+____________________________________________________________________________
+[ 651] By: TimBunce on 1998/03/03 09:07:10
+ Log: Title: "Fix C<my ($a, undef, $b) = @x>", #F018
+ From: Stephane Payrard <stef@francenet.fr>
+ Msg-ID: <199712040054.BAA04612@www.zweig.com>
+ Files: op.c t/op/my.t
+ Branch: maint-5.004/perl
+ ! op.c t/op/my.t
+____________________________________________________________________________
+[ 650] By: TimBunce on 1998/03/03 09:04:04
+ Log: Title: "enhanced "use strict" warning", #F017
+ From: Tkil <tkil@reptile.scrye.com>
+ Msg-ID: <199712040938.CAA07628@reptile.scrye.com>
+ Files: gv.c t/pragma/strict-subs t/pragma/strict-vars
+ Branch: maint-5.004/perl
+ ! gv.c t/pragma/strict-subs t/pragma/strict-vars
+____________________________________________________________________________
+[ 649] By: TimBunce on 1998/03/03 09:02:55
+ Log: Title: "eval of sub gives spurious "uninitialised" warning", #F016
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199712061025.FAA14396@aatma.engin.umich.edu>
+ Files: pod/perldelta.pod pod/perlfunc.pod op.c t/op/eval.t
+ Branch: maint-5.004/perl
+ ! op.c pod/perldelta.pod pod/perlfunc.pod t/op/eval.t
+____________________________________________________________________________
+[ 648] By: TimBunce on 1998/03/03 08:58:00
+ Log: Title: "[PERL] Assigning result of pop scrambles unrelated reference", #F015
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199712061100.GAA14864@aatma.engin.umich.edu>
+ Files: sv.c
+ Branch: maint-5.004/perl
+ ! sv.c
+____________________________________________________________________________
+[ 647] By: TimBunce on 1998/03/03 08:53:35
+ Log: Title: "[PERL] Filedescriptor leak in 5.004_55 (and earlier)", #F014
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199712151922.OAA06410@monk.mps.ohio-state.edu>
+ Files: os2/os2.c util.c
+ Branch: maint-5.004/perl
+ ! os2/os2.c util.c
+____________________________________________________________________________
+[ 646] By: TimBunce on 1998/03/03 08:51:04
+ Log: Title: "Fix fdopen() on STD{IN,OUT,ERR}", #F013
+ From: Roderick Schertler <roderick@argon.org>
+ Msg-ID: <pzg1npp6e3.fsf@eeyore.ibcinc.com>
+ Files: doio.c t/op/misc.t
+ Branch: maint-5.004/perl
+ ! doio.c t/op/misc.t
+____________________________________________________________________________
+[ 645] By: TimBunce on 1998/03/03 08:49:34
+ Log: Title: "Fix local $a[0] and local $h{a}", #F012
+ From: Stephen McCamant <alias@mcs.com>
+ Msg-ID: <m0xjWFq-000EZeC@alias-2.pr.mcs.net>
+ Files: embed.h scope.h global.sym pp.c pp_hot.c scope.c t/op/local.t
+ Branch: maint-5.004/perl
+ ! embed.h global.sym pp.c pp_hot.c scope.c scope.h t/op/local.t
+____________________________________________________________________________
+[ 644] By: TimBunce on 1998/03/03 08:43:06
+ Log: Title: "Eliminate redundant mg_get() in SvTRUE()", #F011
+ From: Spider Boardman <spider@orb.nashua.nh.us>
+ Msg-ID: <199712251839.NAA14800@Orb.Nashua.NH.US>
+ Files: sv.c
+ Branch: maint-5.004/perl
+ ! sv.c
+____________________________________________________________________________
+[ 643] By: TimBunce on 1998/03/03 08:41:07
+ Log: Title: "Don't force scalar context on C<my @x> or C<my %x>", #F010
+ From: Chip Salzenberg
+ Files: op.c t/op/my.t
+ Branch: maint-5.004/perl
+ ! op.c t/op/my.t
+____________________________________________________________________________
+[ 642] By: TimBunce on 1998/03/03 08:39:11
+ Log: Title: "Fix assignment to $_[0] in DESTROY", #F009
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199801010030.TAA14274@aatma.engin.umich.edu>
+ Files: pod/perlobj.pod sv.c t/op/ref.t
+ Branch: maint-5.004/perl
+ ! pod/perlobj.pod sv.c t/op/ref.t
+____________________________________________________________________________
+[ 641] By: gsar on 1998/03/03 04:39:49
+ Log: merge problematic maintpatch to op.c
+ #77: "Eliminate double warnings under C<package;>"
+ From: Chip Salzenberg
+ Files: gv.c op.c toke.c
+ Branch: win32/perl
+ ! gv.c op.c toke.c
+____________________________________________________________________________
+[ 640] By: gsar on 1998/03/03 04:30:22
+ Log: merge another conflicting maintpatch to op.c
+ #17: "Enhanced "use strict" warning"
+ From: Tkil <tkil@reptile.scrye.com>
+ Msg-ID: <199712040938.CAA07628@reptile.scrye.com>
+ Date: Thu, 4 Dec 1997 02:38:26 -0700
+ Files: gv.c t/pragma/strict-subs t/pragma/strict-vars
+ Branch: win32/perl
+ ! gv.c t/pragma/strict-subs t/pragma/strict-vars
+____________________________________________________________________________
+[ 639] By: gsar on 1998/03/03 04:09:11
+ Log: maintpatch
+ #73: "Fix order of warnings for misplaced subscripts"
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Msg-ID: <199710131023.LAA16796@crypt.compulink.co.uk>
+ Date: Mon, 13 Oct 1997 11:23:56 +0100
+ Files: op.c
+ Branch: win32/perl
+ ! op.c
+____________________________________________________________________________
+[ 638] By: gsar on 1998/03/03 04:02:16
+ Log: manually apply another conflicting maintpatch
+ #64: "Fix extension version mismatch message"
+ From: Chip Salzenberg
+ Files: XSUB.h
+ Branch: win32/perl
+ ! XSUB.h
+____________________________________________________________________________
+[ 637] By: gsar on 1998/03/03 03:57:08
+ Log: maintpatch
+ #62: "Fix doc bug in getservbyname() examples"
+ From: Tom Christiansen
+ Files: ext/Socket/Socket.pm
+ Branch: win32/perl
+ ! ext/Socket/Socket.pm
+____________________________________________________________________________
+[ 636] By: gsar on 1998/03/03 03:55:13
+ Log: maintpatch
+ #60: "Socket occasional SEGV"
+ From: Trevor Blackwell <tlb@viaweb.com>
+ Msg-ID: <199710281804.NAA09632@wagg.viaweb.com>
+ Date: Tue, 28 Oct 1997 13:04:43 -0500 (EST)
+ Files: ext/Socket/Socket.xs
+ Branch: win32/perl
+ ! ext/Socket/Socket.xs
+____________________________________________________________________________
+[ 635] By: gsar on 1998/03/03 03:51:01
+ Log: maintpatches for docs
+ #53: "Perlop bitwise & | ^ documentation"
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID: <Pine.GSO.3.96.971106073858.29771O-100000@usertest.teleport.c
+ Date: Thu, 6 Nov 1997 07:44:52 -0800 (PST)
+ Files: pod/perlfunc.pod
+ --------
+ #54: "Update docs on tr///"
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID: <Pine.GSO.3.96.971103071602.10568C-100000@usertest.teleport.c
+ Date: Mon, 3 Nov 1997 07:28:39 -0800 (PST)
+ Files: pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod
+ pod/perllocale.pod pod/perlmod.pod pod/perlop.pod
+ pod/perlstyle.pod toke.c
+ Branch: win32/perl
+ ! pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod
+ ! pod/perllocale.pod pod/perlmod.pod pod/perlop.pod
+ ! pod/perlstyle.pod toke.c
+____________________________________________________________________________
+[ 634] By: gsar on 1998/03/03 03:43:42
+ Log: another maintpatch (this one needed adjust of test nos.)
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Message-Id: <199801221211.MAA05315@crypt.compulink.co.uk>
+ Date: Thu, 22 Jan 1998 12:11:49 +0000
+ Subject: Re: [PERL] A few perl5.004_03 bugs
+ Branch: win32/perl
+ ! mg.c t/op/magic.t
+____________________________________________________________________________
+[ 633] By: gsar on 1998/03/03 03:36:40
+ Log: merge another toke.c patch and its dependent (very carefully)
+ #32: "Support C<Package::> as function-blind bearword"
+ From: Chip Salzenberg
+ Files: toke.c
+ --------
+ #86: "Make warning on C<Nosuch::> optional, add to perl{diag,delta}.pod"
+ From: Gurusamy Sarathy
+ Files: toke.c pod/perldelta.pod pod/perldiag.pod
+ Branch: win32/perl
+ ! pod/perldelta.pod pod/perldiag.pod toke.c
+____________________________________________________________________________
+[ 632] By: gsar on 1998/03/03 03:12:16
+ Log: another toke.c maintpatch
+ #28: "Don't warn on $x{shift}, ne => 1, or -f => 1"
+ From: Chip Salzenberg
+ Files: toke.c
+ Branch: win32/perl
+ ! toke.c
+____________________________________________________________________________
+[ 631] By: gsar on 1998/03/03 03:06:59
+ Log: still another maintpatch
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Message-Id: <199711021331.NAA01826@crypt.compulink.co.uk>
+ Date: Sun, 02 Nov 1997 13:31:54 +0000
+ Subject: [PATCH] assorted sprintf bugs
+ Branch: win32/perl
+ ! sv.c t/op/sprintf.t
+____________________________________________________________________________
+[ 630] By: gsar on 1998/03/03 03:03:55
+ Log: yet another maintpatch
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Message-Id: <199711221252.MAA14000@crypt.compulink.co.uk>
+ Date: Sat, 22 Nov 1997 12:52:16 +0000
+ Subject: Re: [PERL] Unexpected output
+ Branch: win32/perl
+ ! doio.c t/pragma/warn-1global
+____________________________________________________________________________
+[ 629] By: gsar on 1998/03/03 02:57:33
+ Log: merge another maintpatch to toke.c
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Date: Sat, 22 Nov 1997 14:45:23 GMT
+ Message-Id: <199711221445.OAA14153@crypt.compulink.co.uk>
+ Subject: Re: [PERL] Here-doc in s///e (was: Bug)
+ Branch: win32/perl
+ ! t/base/lex.t toke.c
+____________________________________________________________________________
+[ 628] By: gsar on 1998/03/03 02:50:20
+ Log: manually merge a maintpatch
+ Date: Thu, 8 Jan 1998 14:38:04 -0700 (MST)
+ Message-Id: <199801082138.OAA14186@prometheus.frii.com>
+ From: gnat@frii.com
+ Subject: [PERL] Commenting toke.c
+ Branch: win32/perl
+ ! toke.c
+____________________________________________________________________________
+[ 627] By: TimBunce on 1998/03/02 22:34:47
+ Log: Title: "Fix inefficient checks for TIEHANDLE", #F008
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199801080106.UAA05048@aatma.engin.umich.edu>
+ Files: pp_hot.c pp_sys.c
+ Branch: maint-5.004/perl
+ ! pp_hot.c pp_sys.c
+____________________________________________________________________________
+[ 626] By: TimBunce on 1998/03/02 22:31:13
+ Log: This is the change description for change 625
+ Title: "Fix tr///s option", #F007
+ From: Inaba Hiroto <inaba@st.rim.or.jp>
+ Msg-ID: <19980110155333D.inaba@st.rim.or.jp>
+ Files: doop.c
+ Branch: maint-5.004/perl
+ ! doop.c
+____________________________________________________________________________
+[ 625] By: TimBunce on 1998/03/02 22:23:48
+ Log: Branch: maint-5.004/perl
+ ! doop.c
+____________________________________________________________________________
+[ 623] By: TimBunce on 1998/03/02 21:51:53
+ Log: Title: "Fix lexical lookup in eval-sub-eval", #F006
+ From: Chip Salzenberg
+ Files: pp_ctl.c
+ Branch: maint-5.004/perl
+ ! pp_ctl.c
+____________________________________________________________________________
+[ 622] By: TimBunce on 1998/03/02 21:43:29
+ Log: Title: "Don't upgrade target of assignment from LVALUE", #F005
+ From: Chip Salzenberg
+ Files: sv.c
+ Branch: maint-5.004/perl
+ ! sv.c
+____________________________________________________________________________
+[ 621] By: TimBunce on 1998/03/02 21:29:59
+ Log: Title: "Fix compile-time warning line in while ()", #F004
+ From: Chip Salzenberg
+ Files: op.c
+ Branch: maint-5.004/perl
+ ! op.c
+____________________________________________________________________________
+[ 620] By: TimBunce on 1998/03/02 21:25:27
+ Log: Title: "STMT foreach LIST;", #F002
+ From: Chip Salzenberg
+ Files: pod/perlsyn.pod perly.c perly.c.diff perly.y t/cmd/mod.t toke.c
+ vms/perly_c.vms
+ Branch: maint-5.004/perl
+ ! perly.c perly.c.diff perly.y pod/perlsyn.pod t/cmd/mod.t
+ ! toke.c vms/perly_c.vms
+____________________________________________________________________________
+[ 619] By: TimBunce on 1998/03/02 21:12:58
+ Log: Title: "Fix SIGSEGV on C<42 until forever>", #F001
+ From: Chip Salzenberg
+ Files: op.c
+ Branch: maint-5.004/perl
+ ! op.c
+____________________________________________________________________________
+[ 618] By: gsar on 1998/03/02 04:40:16
+ Log: make t/lib/nothread.t type xtext also
+ Branch: win32/perl
+ ! t/op/nothread.t
+____________________________________________________________________________
+[ 617] By: gsar on 1998/03/02 04:35:15
+ Log: make t/lib/thread.t type xtext
+ Branch: win32/perl
+ ! t/lib/thread.t
+____________________________________________________________________________
+[ 616] By: gsar on 1998/03/02 04:17:40
+ Log: fix misapplied hunks in change#614
+ Branch: win32/perl
+ ! scope.c scope.h
+____________________________________________________________________________
+[ 615] By: gsar on 1998/03/02 03:39:16
+ Log: another one down
+ From: "Conrad E. Kimball" <cek@tblv021.ca.boeing.com>
+ Message-Id: <199711260703.XAA21257@mailgate2.boeing.com>
+ Date: Tue, 25 Nov 1997 23:03:48 -0800
+ Subject: [PERL] File::Find bugs & patches
+ Branch: win32/perl
+ ! lib/File/Find.pm
+____________________________________________________________________________
+[ 614] By: gsar on 1998/03/02 03:28:28
+ Log: this one with adjusted test numbers
+ Message-Id: <m0xjWFq-000EZeC@alias-2.pr.mcs.net>
+ Date: Sat, 20 Dec 1997 15:16:14 -0600 (CST)
+ From: Stephen McCamant <alias@mcs.com>
+ Subject: [PERL] [PATCH] Fix local $a[0] and local $h{a}
+ Branch: win32/perl
+ ! embed.h global.sym pp.c pp_hot.c scope.c scope.h t/op/local.t
+____________________________________________________________________________
+[ 613] By: gsar on 1998/03/02 03:13:32
+ Log: still another
+ From: Inaba Hiroto <inaba@st.rim.or.jp>
+ Subject: [PERL] tr///s bug
+ Message-Id: <19980110155333D.inaba@st.rim.or.jp>
+ Date: Sat, 10 Jan 1998 15:53:33 +0900
+ Branch: win32/perl
+ ! doop.c t/op/subst.t
+____________________________________________________________________________
+[ 612] By: gsar on 1998/03/02 03:01:27
+ Log: yet another patch
+ From: Chip Salzenberg <salzench@nielsenmedia.com>
+ Message-Id: <199709161748.NAA08418@nielsenmedia.com>
+ Subject: Tiny but massively cool: C<statement foreach @list>
+ Date: Tue, 16 Sep 1997 13:47:28 -0400 (EDT)
+ Branch: win32/perl
+ ! perly.c perly.c.diff perly.y pod/perlsyn.pod t/cmd/mod.t
+ ! toke.c vms/perly_c.vms
+____________________________________________________________________________
+[ 611] By: gsar on 1998/03/02 01:52:46
+ Log: yet another 'old' patch
+ From: Stephane Payrard <stef@francenet.fr>
+ Message-Id: <199712040054.BAA04612@www.zweig.com>
+ To: perl5-porters@perl.org
+ Subject: Re: [PERL] buglet : minor but gratuitous inconsistency
+ between `my' and `local' (Patch included)
+ Branch: win32/perl
+ ! op.c t/op/my.t
+____________________________________________________________________________
+[ 610] By: gsar on 1998/03/02 01:45:55
+ Log: another 'old' patch
+ From: Roderick Schertler <roderick@argon.org>
+ Date: 19 Dec 1997 12:52:36 -0500
+ Message-Id: <pzg1npp6e3.fsf@eeyore.ibcinc.com>
+ Subject: [PERL] [PATCH] Re: Problem with open >&=
+ Branch: win32/perl
+ ! doio.c t/op/misc.t
+____________________________________________________________________________
+[ 609] By: gsar on 1998/03/02 01:23:56
+ Log: apply missing pieces from:
+ From: Chip Salzenberg <salzench@nielsenmedia.com>
+ Message-Id: <199711272044.PAA12102@nielsenmedia.com>
+ Subject: [PATCH] Improved LVALUE patch
+ Date: Thu, 27 Nov 1997 15:44:02 -0500 (EST)
+ Branch: win32/perl
+ ! sv.c
+____________________________________________________________________________
+[ 608] By: gsar on 1998/03/02 01:13:01
+ Log: merge two important 'old' patches
+ From: Chip Salzenberg <salzench@nielsenmedia.com>
+ Message-Id: <199709241632.MAA09164@nielsenmedia.com>
+ Subject: [PATCH] Fix C<42 until forever> SIGSEGV
+ Date: Wed, 24 Sep 1997 12:32:11 -0400 (EDT)
+ ------
+ From: Chip Salzenberg <salzench@nielsenmedia.com>
+ Message-Id: <199710221332.JAA04814@nielsenmedia.com>
+ Subject: [PATCH] Fix for compile-time while() warnings
+ Date: Wed, 22 Oct 1997 09:31:50 -0400 (EDT)
+ Branch: win32/perl
+ ! op.c
+____________________________________________________________________________
+[ 607] By: gsar on 1998/03/01 06:52:26
+ Log: integrate mainline changes
+ Branch: asperl
+ +> Policy_sh.SH Porting/config.sh Porting/config_H atomic.h
+ +> lib/Tie/Handle.pm t/op/tiehandle.t
+ - config_H
+ !> (integrate 89 files)
+____________________________________________________________________________
+[ 606] By: gsar on 1998/02/28 23:11:00
+ Log: misc small tweaks
+ - AutoLoader fix for long::pack::names
+ - d_mymalloc can be set from makefiles now
+ - make search.pl actually work on win32
+ - revert podoc about $^E on OS/2 (per Ilya's wishes)
+ Branch: win32/perl
+ ! lib/AutoLoader.pm pod/perlvar.pod win32/Makefile
+ ! win32/bin/search.pl win32/makefile.mk win32/win32.c
+____________________________________________________________________________
+[ 605] By: gsar on 1998/02/28 22:16:45
+ Log: fix typo in sv.h, and run 'make regen_headers' to make it build
+ Branch: win32/perl
+ ! embedvar.h sv.h
+____________________________________________________________________________
+[ 604] By: gsar on 1998/02/28 21:08:58
+ Log: integrate mainline
+ Branch: win32/perl
+ +> Policy_sh.SH atomic.h lib/Tie/Handle.pm t/op/tiehandle.t
+ !> Configure MANIFEST Makefile.SH bytecode.h bytecode.pl
+ !> byterun.c ext/SDBM_File/Makefile.PL
+ !> ext/SDBM_File/sdbm/Makefile.PL ext/SDBM_File/sdbm/sdbm.h
+ !> lib/ExtUtils/MM_VMS.pm os2/diff.configure os2/os2.c perl.c
+ !> perlvars.h pod/perltie.pod pp_sys.c sv.c sv.h t/lib/anydbm.t
+ !> t/lib/sdbm.t util.c vms/descrip.mms vms/perlvms.pod
+ !> vms/test.com win32/makedef.pl
+____________________________________________________________________________
+[ 603] By: nick on 1998/02/28 11:31:15
+ Log: Missed FREAD in bytecode.h
+ Cannot export svref_mutex in non-threaded perl
+ Branch: perl
+ ! bytecode.h win32/makedef.pl
----------------
-Version 5.003_14
+Version 5.004_61
----------------
-We seem to have achieved "release candidate" status.
-
- CORE LANGUAGE CHANGES
-
- Title: "Eliminate support for {if,unless,while,until} BLOCK BLOCK"
- From: Chip Salzenberg
- Files: perly.c perly.c.diff perly.y toke.c
-
- Title: "Taint $x after $x =~ s/pat/xyz/ if pat or xyz is tainted by locale"
- From: Chip Salzenberg
- Files: cop.h mg.c pp_ctl.c pp_hot.c
-
- Title: "Complete support for modifying undefined array members in foreach"
- From: Chip Salzenberg
- Files: global.sym mg.c perl.h pp.c pp_hot.c proto.h sv.c
-
- OTHER CORE CHANGES
-
- Title: "patch for regex bug: (x|x){n}"
- From: Gurusamy Sarathy
- Msg-ID: <199612210259.VAA10170@aatma.engin.umich.edu>
- Date: Fri, 20 Dec 1996 21:59:22 -0500
- Files: regexec.c
-
- Title: "Bug in debugger with import manipulations"
- From: Ilya Zakharevich
- Msg-ID: <199612231037.FAA08617@monk.mps.ohio-state.edu>
- Date: Mon, 23 Dec 1996 05:37:48 -0500 (EST)
- Files: pp_hot.c
-
- Title: "Import and dynamic methods"
- From: Ilya Zakharevich
- Msg-ID: <199612230645.BAA08378@monk.mps.ohio-state.edu>
- Date: Mon, 23 Dec 1996 01:45:37 -0500 (EST)
- Files: gv.c hv.c sv.c
-
- Title: "malloc.c patch"
- From: Ilya Zakharevich
- Msg-ID: <199612220748.CAA07164@monk.mps.ohio-state.edu>
- Date: Sun, 22 Dec 1996 02:48:58 -0500 (EST)
- Files: malloc.c
-
- Title: "sv_gets patch"
- From: Ilya Zakharevich
- Msg-ID: <199612220824.DAA07235@monk.mps.ohio-state.edu>
- Date: Sun, 22 Dec 1996 03:24:04 -0500 (EST)
- Files: pp_hot.c
-
- Title: "pos $str patch"
- From: Ilya Zakharevich
- Msg-ID: <199612220831.DAA07247@monk.mps.ohio-state.edu>
- Date: Sun, 22 Dec 1996 03:31:21 -0500 (EST)
- Files: mg.c pp_hot.c t/op/pat.t
-
- Title: "Prevent warnings when STDCHAR is unsigned"
- From: Chip Salzenberg
- Files: perlio.c perlio.h
-
- PORTABILITY
-
- Title: "Fix bugs in bincompat3 usage"
- From: Chip Salzenberg
- Files: perl.h perl_exp.SH
-
- Title: "Support shared libperl on SunOS"
- From: Ulrich Pfeifer
- Files: Makefile.SH
-
- Title: "Configure on OS/2"
- From: Ilya Zakharevich
- Msg-ID: <199612202325.SAA05505@monk.mps.ohio-state.edu>
- Date: Fri, 20 Dec 1996 18:25:30 -0500 (EST)
- Files: Configure
-
- Title: "Fixes for Interactive Unix"
- From: win@in.rhein-main.de (Winfried Koenig)
- Msg-ID: <m0vbeNO-00003WC@incom.rhein-main.de>
- Date: Sun, 22 Dec 96 05:14 EET
- Files: hints/isc.sh op.c pp_sys.c universal.c
-
- Title: "Use "proto" instead of "_" in sdbm.h"
- From: Chip Salzenberg
- Files: ext/SDBM_File/sdbm/sdbm.h
-
- Title: "VMS patches to 5.003_13"
- From: Charles Bailey
- Msg-ID: <01IDBYYFYPIS002ASE@hmivax.humgen.upenn.edu>
- Date: Mon, 23 Dec 1996 01:26:47 -0500 (EST)
- Files: deb.c ext/POSIX/POSIX.xs gv.c lib/File/Copy.pm mg.c perl.c
- perl.h proto.h sv.c t/lib/filecopy.t taint.c toke.c util.c
- vms/Makefile vms/config.vms vms/descrip.mms
- vms/gen_shrfls.pl vms/genconfig.pl vms/genopt.com
- vms/perly_c.vms vms/perly_h.vms vms/test.com vms/vms.c
- vms/vms_yfix.pl
-
- UTILITIES, LIBRARY, AND EXTENSIONS
-
- Title: "Remove libnet"
- From: Chip Salzenberg
- Files: MANIFEST pod/perlmod.pod
-
- Title: "Refresh CPAN module to 1.08"
- From: Chip Salzenberg
- Files: lib/CPAN.pm lib/CPAN/FirstTime.pm
-
- Title: "Refresh ExtUtils::Manifest to version 1.28"
- From: Andreas Koenig
- Files: lib/ExtUtils/Manifest.pm
-
- Title: "Update IO->VERSION() to 1.1201 for CPAN's sake"
- From: Chip Salzenberg
- Files: ext/IO/lib/IO/Handle.pm lib/IO/Handle.pm
-
- Title: "Remodel File::Copy."
- From: Chip Salzenberg
- Files: lib/File/Copy.pm
-
- Title: "dumb bug in User::pwent.pm"
- From: Tom Christiansen
- Msg-ID: <199612201145.EAA27860@mox.perl.com>
- Date: Fri, 20 Dec 1996 04:45:37 -0700
- Files: lib/User/pwent.pm
-
- DOCUMENTATION
-
- Title: "Better support for =for"
- From: Kenneth Albanowski
- Msg-ID: <Pine.LNX.3.93.961220163747.298T-100000@kjahds.com>
- Date: Fri, 20 Dec 1996 16:43:35 -0500 (EST)
- Files: lib/Pod/Text.pm pod/pod2latex.PL pod/pod2man.PL
-
- Title: "perllocale.pod -- second draft"
- From: Dominic Dunlop <domo@slipper.ip.lu>
- Msg-ID: <v03007800aee1923e30a2@[194.51.248.68]>
- Date: Sat, 21 Dec 1996 15:00:50 +0100
- Files: pod/perllocale.pod
-
- Title: "Perlguts, version 26"
- From: Jeff Okamoto
- Msg-ID: <199612201943.AA048111018@hpcc123.corp.hp.com>
- Date: Fri, 20 Dec 1996 11:43:38 -0800
- Files: pod/perlguts.pod
-
- Title: "Update pod/Makefile; s/perli18n/perllocale/"
- From: Chip Salzenberg
- Files: ext/POSIX/POSIX.pod lib/I18N/Collate.pm pod/Makefile
- pod/perl.pod pod/perlmod.pod pod/perlnews.pod pod/roffitall
-
- Title: "obstruct pod2man doc tweaks"
- From: Roderick Schertler
- Msg-ID: <3923.851106237@eeyore.ibcinc.com>
- Date: Fri, 20 Dec 1996 13:23:57 -0500
- Files: lib/Class/Template.pm lib/Time/tm.pm
-
-
-----------------
-Version 5.003_13
-----------------
-
-The watchword here is "synchronization." There were a couple of
-show-stopper bugs in 5.003_12, so I'm issuing this patch to bring
-everyone up to a common working base.
-
- CORE LANGUAGE CHANGES
-
- Title: "Disallow labels named q, qq, qw, qx, s, y, and tr"
- From: Chip Salzenberg
- Files: toke.c
-
- Title: "Make evals' lexicals visible to nested evals"
- From: Chip Salzenberg
- Files: pp_ctl.c
-
- OTHER CORE CHANGES
-
- Title: "Fix core dump bug with anoncode"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Allow DESTROY to make refs to dying objects"
- From: Chip Salzenberg
- Files: sv.c
-
- PORTABILITY
-
- Title: "Add missing backslash in Configure"
- From: Chip Salzenberg
- Files: Configure
-
- UTILITIES, LIBRARY, AND EXTENSIONS
-
- Title: "Include libnet-1.01 instead of old Net::FTP"
- From: Graham Barr
- Files: MANIFEST lib/Net/Cmd.pm lib/Net/Domain.pm
- lib/Net/DummyInetd.pm lib/Net/FTP.pm lib/Net/NNTP.pm
- lib/Net/Netrc.pm lib/Net/POP3.pm lib/Net/SMTP.pm
- lib/Net/SNPP.pm lib/Net/Socket.pm lib/Net/Telnet.pm
- lib/Net/Time.pm pod/perlmod.pod
-
- Title: "Use binmode when doing binary FTP"
- From: Ilya Zakharevich
- Files: lib/Net/FTP.pm
-
- Title: "Re: Open3.pm tries to close unopened file handle"
- From: Roderick Schertler
- Msg-ID: <pzloavmd9h.fsf@eeyore.ibcinc.com>
- Date: 18 Dec 1996 22:19:54 -0500
- Files: MANIFEST lib/IPC/Open2.pm lib/IPC/Open3.pm lib/open2.pl
- lib/open3.pl pod/perldiag.pod pod/perlfunc.pod t/lib/open2.t
- t/lib/open3.t
-
- Title: "Long-standing problem in Socket module"
- From: Spider Boardman
- Msg-ID: <199612190418.XAA07291@Orb.Nashua.NH.US>
- Date: Wed, 18 Dec 1996 23:18:14 -0500
- Files: Configure Porting/Glossary config_H config_h.SH
- ext/Socket/Socket.pm ext/Socket/Socket.xs
-
- Title: "flock() constants"
- From: Roderick Schertler
- Msg-ID: <26669.850977437@eeyore.ibcinc.com>
- Date: Thu, 19 Dec 1996 01:37:17 -0500
- Files: ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs pod/perlfunc.pod
-
- Title: "Re: find2perl . -xdev BROKEN still"
- From: Roderick Schertler
- Msg-ID: <pzvi9yig3h.fsf@eeyore.ibcinc.com>
- Date: 19 Dec 1996 12:44:34 -0500
- Files: lib/File/Find.pm lib/find.pl lib/finddepth.pl
-
- DOCUMENTATION
-
- Title: "small doc tweaks for _12"
- From: Roderick Schertler
- Msg-ID: <1826.851011557@eeyore.ibcinc.com>
- Date: Thu, 19 Dec 1996 11:05:57 -0500
- Files: lib/UNIVERSAL.pm pod/perldiag.pod pod/perltie.pod
-
- Title: "Re: missing E<> POD directive in perlpod.pod"
- From: Roderick Schertler
- Msg-ID: <pzwwueimak.fsf@eeyore.ibcinc.com>
- Date: 19 Dec 1996 10:30:43 -0500
- Files: pod/perlpod.pod pod/pod2html.PL
-
+____________________________________________________________________________
+[ 602] By: mbeattie on 1998/02/27 18:35:27
+ Log: Change FREAD/FGETC to BGET_FREAD/BGET_FGETC to avoid clash with
+ preprocessor symbol on Digital UNIX.
+ Branch: perl
+ ! bytecode.h bytecode.pl byterun.c
+____________________________________________________________________________
+[ 601] By: mbeattie on 1998/02/27 18:27:00
+ Log: Fix stupid ATOMIC_DEC_AND_TEST typo in sv.h.
+ Branch: perl
+ ! sv.h
+____________________________________________________________________________
+[ 600] By: mbeattie on 1998/02/27 18:15:07
+ Log: Add atomic.h to MANIFEST
+ Branch: perl
+ ! MANIFEST
+____________________________________________________________________________
+[ 599] By: mbeattie on 1998/02/27 18:13:52
+ Log: Integrate win32 branch into mainline.
+ Branch: perl
+ ! bytecode.pl
+ !> bytecode.h byterun.c byterun.h dosish.h embed.h embedvar.h
+ !> ext/B/B.xs ext/B/Makefile.PL global.sym perl.h sv.c
+ !> win32/Makefile win32/bin/pl2bat.pl 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/makedef.pl win32/makefile.mk win32/win32.c win32/win32.h
+ !> win32/win32thread.h
+____________________________________________________________________________
+[ 598] By: mbeattie on 1998/02/27 18:06:41
+ Log: Make refcounts atomic for threading (dependent on appropriate
+ arch-dependent and compiler-dependent definitions in atomic.h
+ or else falls back to a global mutex to protect refcounts).
+ Branch: perl
+ + atomic.h
+ ! global.sym perl.c perlvars.h sv.c sv.h
+____________________________________________________________________________
+[ 597] By: mbeattie on 1998/02/27 15:37:22
+ Log: Tiehandle stuff in change 595 didn't add to MANIFEST
+ Branch: perl
+ ! MANIFEST
+____________________________________________________________________________
+[ 596] By: mbeattie on 1998/02/27 15:34:55
+ Log: Missed adding new file Policy_sh.SH in change 592.
+ Branch: perl
+ + Policy_sh.SH
+____________________________________________________________________________
+[ 595] By: mbeattie on 1998/02/27 15:34:06
+ Log: Subject: [PATCH] _60 & _04 - Add WRITE & CLOSE to TIEHANDLE
+ Date: Fri, 27 Feb 1998 04:15:04 +0000
+ From: Graham Barr <gbarr@pobox.com>
+ Branch: perl
+ + lib/Tie/Handle.pm t/op/tiehandle.t
+ ! pod/perltie.pod pp_sys.c
+____________________________________________________________________________
+[ 594] By: mbeattie on 1998/02/27 15:31:12
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ Subject: [PATCH 5.004_60] Fix to MM_VMS.PM
+ Date: Thu, 26 Feb 1998 11:09:55 -0800
+ Subject: [PATCH 5.004_60] Get SDBM_File working on VMS
+ Date: Thu, 26 Feb 1998 11:15:24 -0800
+ Branch: perl
+ ! ext/SDBM_File/Makefile.PL ext/SDBM_File/sdbm/Makefile.PL
+ ! ext/SDBM_File/sdbm/sdbm.h lib/ExtUtils/MM_VMS.pm
+ ! t/lib/anydbm.t t/lib/sdbm.t vms/descrip.mms vms/perlvms.pod
+ ! vms/test.com
+____________________________________________________________________________
+[ 593] By: mbeattie on 1998/02/27 15:26:45
+ Log: Fix file-descriptor leak when pipes fail via taint checks:
+ Subject: [PATCH] Some patches went through cracks
+ Date: Thu, 26 Feb 1998 02:47:46 -0500 (EST)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Branch: perl
+ ! os2/os2.c util.c
+____________________________________________________________________________
+[ 592] By: mbeattie on 1998/02/27 15:15:12
+ Log: Subject: Config_60-03-04.diff patch for 5.004_60
+ Date: Wed, 25 Feb 1998 17:14:39 -0500 (EST)
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Branch: perl
+ ! Configure MANIFEST Makefile.SH os2/diff.configure
+____________________________________________________________________________
+[ 591] By: gsar on 1998/02/26 19:34:50
+ Log: added AS patch#9
+ Branch: asperl
+ - win32/ipdir.c win32/ipenv.c win32/iplio.c win32/ipmem.c
+ - win32/ipproc.c win32/ipsock.c win32/ipstdio.c
+ - win32/ipstdiowin.h win32/perlobj.def
+ ! ObjXSub.h globals.c perl.c proto.h win32/Makefile
+ ! win32/dl_win32.xs win32/runperl.c win32/win32.c win32/win32.h
+ ! win32/win32sck.c win32/win32thread.c
+____________________________________________________________________________
+[ 590] By: gsar on 1998/02/26 04:25:40
+ Log: various changes to make win32 build under the new Configure & co.
+ - added byterun.c to core C build
+ - makefile.mk now has a regen_config_h target to quickly update config_H.[bgv]c
+ after adding new variables to config.[bgv]c
+ - sig_name_init now has only the valid signals
+ - we now have $Config{usethreads}
+ - tested under the two commercial compilers w/ and w/o usethreads
+ Branch: win32/perl
+ ! win32/Makefile 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/makedef.pl win32/makefile.mk
+____________________________________________________________________________
+[ 589] By: gsar on 1998/02/26 03:56:19
+ Log: various cleanups so that B can be built as "just another extension"
+ - export symbols needed for building B
+ - bset_obj_store() is needed by byterun(), so define it there instead
+ of at B.xs, and export it
+ - freadpv() is only used in B.xs, so move it there
+ - byte*.h are now included by perl.h
+ - regenerate embed*.h
+ Branch: win32/perl
+ ! bytecode.h bytecode.pl byterun.c byterun.h embed.h embedvar.h
+ ! ext/B/B.xs ext/B/Makefile.PL global.sym perl.h
+____________________________________________________________________________
+[ 588] By: gsar on 1998/02/25 21:46:35
+ Log: integrate mainline
+ Branch: win32/perl
+ +> Porting/config.sh Porting/config_H
+ - config_H
+ !> (integrate 54 files)
+____________________________________________________________________________
+[ 587] By: gsar on 1998/02/25 19:20:26
+ Log: added AS patch#8
+ Branch: asperl
+ ! sv.c x2p/a2py.c x2p/util.c
+____________________________________________________________________________
+[ 586] By: gsar on 1998/02/25 19:08:06
+ Log: added AS patch#7
+ Message-Id: <01BD40F9.CE57B210.dougl@ActiveState.com>
+ Date: Tue, 24 Feb 1998 07:57:07 PST
+ From: Douglas Lankshear <dougl@ActiveState.com>
+ Subject: [PATCH]
+
+ Here's an attempt at
+ 6. MANIFEST must be updated with new file names
+ 5. Mktime(), Stat() etc., rather than MKtime()/STat() etc.
+ And some changes to move toward
+ 1. Merge PERL_OBJECT build support into regular Makefile and makefile.mk
+
+ -- Doug
+ Branch: asperl
+ ! MANIFEST installperl ipdir.h ipenv.h iplio.h ipmem.h ipproc.h
+ ! ipsock.h ipstdio.h lib/ExtUtils/MM_Win32.pm perldir.h
+ ! perlenv.h perlio.h perllio.h win32/Makefile
+____________________________________________________________________________
+[ 585] By: mbeattie on 1998/02/25 17:44:34
+ Log: More compiler tweaks.
+ Branch: perl
+ ! Makefile.SH bytecode.pl byterun.c byterun.h ext/B/B/Asmdata.pm
+____________________________________________________________________________
+[ 584] By: mbeattie on 1998/02/25 15:36:38
+ Log: Subject: [PATCH 5.004_60] dos-djgpp update
+ Date: Wed, 25 Feb 1998 11:17:07 +0100
+ From: Laszlo Molnar <molnarl@cdata.tvnet.hu>
+ Branch: perl
+ ! djgpp/djgpp.c dosish.h hints/dos_djgpp.sh perl.c thread.h
+____________________________________________________________________________
+[ 583] By: mbeattie on 1998/02/25 15:34:48
+ Log: Move find_threadsv to right bit of global.sym. Bump patchlevel to 61.
+ Branch: perl
+ ! global.sym patchlevel.h
+____________________________________________________________________________
+[ 582] By: mbeattie on 1998/02/25 15:28:08
+ Log: Subject: Re: [PATCH 5.004_60] Fix goto-in-eval segfault (unwrapped!)
+ Date: Tue, 24 Feb 1998 11:15:57 +0000
+ From: Robin Houston <robin@oneworld.org>
+ Branch: perl
+ ! pod/perldiag.pod pp_ctl.c
+____________________________________________________________________________
+[ 581] By: mbeattie on 1998/02/25 15:27:06
+ Log: Subject: [PATCH] #ifdef CAN_PROTOTYPE cleanup
+ Date: 23 Feb 1998 23:36:09 +0100
+ From: Gisle Aas <gisle@aas.no>
+ Branch: perl
+ ! doio.c miniperlmain.c op.c perl.c pp.h regcomp.c toke.c util.c
+____________________________________________________________________________
+[ 580] By: mbeattie on 1998/02/25 15:25:29
+ Log: Subject: [PATCH 5.004_60] improved Test.pm
+ Date: Sat, 21 Feb 1998 14:17:09 -0500
+ From: Joshua Pritikin <pritikin@mindspring.com>
+ Branch: perl
+ ! lib/Test.pm
+____________________________________________________________________________
+[ 579] By: mbeattie on 1998/02/25 15:23:24
+ Log: HP-UX hints and AIX global.sym changes (with Makefile.SH rule)
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Subject: [PATCH] 5.004_60: AIX: global.sym and Makefile.SH
+ Date: Sat, 21 Feb 1998 15:26:19 +0200 (EET)
+ Subject: Re: your HP-UX perl patch
+ Date: Mon, 23 Feb 1998 23:14:37 +0200 (EET)
+ Branch: perl
+ ! Makefile.SH embed.h global.sym hints/hpux.sh
+____________________________________________________________________________
+[ 578] By: mbeattie on 1998/02/25 15:18:06
+ Log: Back out DB_File patch (change _553) and tweak Configure.
+ Subject: ANNOUNCE: perl5.004_60 is available
+ Date: Mon, 23 Feb 1998 10:47:26 -0000
+ From: Paul Marquess <pmarquess@bfsec.bt.co.uk>
+ Branch: perl
+ ! Configure ext/DB_File/DB_File.xs
+____________________________________________________________________________
+[ 577] By: mbeattie on 1998/02/25 15:04:00
+ Log: Subject: [PATCH] Cwd.pm
+ Date: Fri, 20 Feb 1998 10:27:54 -0600
+ From: Graham Barr <gbarr@ti.com>
+ Branch: perl
+ ! lib/Cwd.pm
+____________________________________________________________________________
+[ 576] By: mbeattie on 1998/02/25 15:02:57
+ Log: From: ilya@math.ohio-state.edu (Ilya Zakharevich)
+ Subject: [5.004_5* PATCH] Make ornaments default in Term::ReadLine
+ Date: Fri, 20 Feb 1998 00:09:52 -0500 (EST)
+ Subject: [PATCH 5.004_5*] Fix debugger messages and the default package
+ Date: Fri, 20 Feb 1998 00:12:28 -0500 (EST)
+ Subject: Re: Continued presence of segmentation violation in study_chunk()[PATCH]
+ Date: Sat, 21 Feb 1998 15:32:29 -0500 (EST)
+ Branch: perl
+ ! lib/Term/ReadLine.pm lib/perl5db.pl regcomp.c
+____________________________________________________________________________
+[ 575] By: mbeattie on 1998/02/25 14:58:00
+ Log: Subject: Re: ANNOUNCE: perl5.004_60 Configure patch is available
+ Date: Tue, 24 Feb 1998 16:02:43 -0500 (EST)
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Branch: perl
+ + Porting/config.sh Porting/config_H
+ - config_H
+ ! Configure INSTALL MANIFEST Makefile.SH Porting/Glossary
+ ! Porting/pumpkin.pod config_h.SH ext/POSIX/POSIX.xs
+ ! hints/aix.sh hints/amigaos.sh hints/bsdos.sh hints/dec_osf.sh
+ ! hints/freebsd.sh hints/irix_6.sh hints/linux.sh
+ ! hints/netbsd.sh hints/next_3.sh hints/next_4.sh hints/os2.sh
+ ! hints/solaris_2.sh makedepend.SH perl.c perl.h pp.c pp_sys.c
+ ! t/lib/thread.t t/op/nothread.t x2p/Makefile.SH
+____________________________________________________________________________
+[ 574] By: gsar on 1998/02/24 02:21:14
+ Log: fix typos in sv.c
+ Branch: win32/perl
+ ! sv.c
+____________________________________________________________________________
+[ 573] By: mbeattie on 1998/02/23 10:03:39
+ Log: Remove old Linux+threads segfault degugging kludge.
+ Branch: perl
+ ! perl.c
+____________________________________________________________________________
+[ 572] By: gsar on 1998/02/23 09:45:26
+ Log: undo previous change (no added value!)
+ Branch: win32/perl
+ ! win32/bin/pl2bat.pl
+____________________________________________________________________________
+[ 571] By: gsar on 1998/02/23 09:18:32
+ Log: fix pl2bat.pl to tolerate trailing .bat (as suggested by
+ John Cavanaugh <cavanaug@sdd.hp.com>)
+ Branch: win32/perl
+ ! win32/bin/pl2bat.pl
+____________________________________________________________________________
+[ 570] By: gsar on 1998/02/22 04:02:15
+ Log: support chown() (just a noop for now)
+ Branch: win32/perl
+ ! dosish.h win32/win32.c win32/win32.h
+____________________________________________________________________________
+[ 569] By: gsar on 1998/02/22 03:09:55
+ Log: integrate latest win32 branch
+ Branch: asperl
+ +> (branch 41 files)
+ !> (integrate 59 files)
+____________________________________________________________________________
+[ 568] By: gsar on 1998/02/22 02:40:56
+ Log: get compiler building under win32 (needed Makefile.PL
+ hacks that could be applicable to other platforms)
+ Branch: win32/perl
+ ! ext/B/Makefile.PL win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 567] By: gsar on 1998/02/22 01:30:19
+ Log: integrate mainline
+ Branch: win32/perl
+ +> (branch 41 files)
+ !> (integrate 46 files)
+____________________________________________________________________________
+[ 566] By: gsar on 1998/02/20 22:31:56
+ Log: fix handle leak in join()
+ Branch: win32/perl
+ ! win32/win32thread.h
----------------
-Version 5.003_12
+Version 5.004_60
----------------
-This patch is huge. A multitude of bug fixes, new modules (especially
-CPAN and Net::FTP), a couple of new Configure variables, updated
-docs... it's a long list. And speaking of lists, here's a list of
-the more significant changes in 5.003_12:
-
- CORE LANGUAGE CHANGES
-
- Title: "Support C<delete @hash{@keys}>"
- From: Chip Salzenberg
- Files: op.c op.h opcode.pl pod/perldiag.pod pod/perlfunc.pod pp.c
- t/op/delete.t
-
- Title: "Autovivify scalars"
- From: Chip Salzenberg
- Files: dump.c op.c op.h pp.c pp_hot.c
-
- Title: "Allow any word, including keyword, as label"
- From: Chip Salzenberg
- Files: toke.c
-
- OTHER CORE CHANGES
-
- Title: "Allow assignment to empty array values during foreach()"
- From: Chip Salzenberg
- Files: cop.h global.sym mg.c op.c perl.h pp_hot.c proto.h sv.c
-
- Title: "Fix nested closures"
- From: Chip Salzenberg
- Files: op.c opcode.pl pp.c pp_ctl.c pp_hot.c
-
- Title: "Fix core dump on auto-vivification"
- From: Chip Salzenberg
- Files: pp_hot.c
-
- Title: "Fix core dump on C<open $undef_var, "X">"
- From: Chip Salzenberg
- Files: pp_sys.c
-
- Title: "Fix -T/-B on globs and globrefs"
- From: Chip Salzenberg
- Files: pp_sys.c
-
- Title: "Fix memory management of $`, $&, and $'"
- From: Chip Salzenberg
- Files: pp_hot.c regexec.c
-
- Title: "Fix paren matching during backtracking"
- From: Chip Salzenberg
- Files: regexec.c
-
- Title: "Fix memory leak and std{in,out,err} death in perl_{con,de}str
- From: Chip Salzenberg
- Files: miniperlmain.c perl.c perl.h sv.c
-
- Title: "Discard garbage bytes at end of prototype()"
- From: Chip Salzenberg
- Files: pp.c
-
- Title: "Fix local($pack::{foo})"
- From: Chip Salzenberg
- Files: global.sym pp.c pp_hot.c proto.h scope.c
-
- Title: "Fix for AmigaOS - inplace operation"
- From: Norbert Pueschel
- Msg-ID: <77724601@Armageddon.meb.uni-bonn.de>
- Date: Sun, 08 Dec 1996 15:33:00 +0100
- Files: doio.c
-
- Title: "Disable warn, die, and parse hooks _before_ global destruction
- From: Chip Salzenberg
- Files: perl.c
-
- Title: "Re: Bug in formline "
- From: Gurusamy Sarathy
- Msg-ID: <199612081958.OAA26025@aatma.engin.umich.edu>
- Date: Sun, 08 Dec 1996 14:58:32 -0500
- Files: pp_ctl.c
-
- Title: "Fix C<@a = ($a,$b,$c,$d) = (1,2)>"
- From: Chip Salzenberg
- Files: pp_hot.c
-
- Title: "Fix %ENV assignment when environment starts out empty"
- From: Chip Salzenberg
- Files: hv.c
-
- Title: "Properly support and document newRV{,_inc,_noinc}"
- From: Chip Salzenberg
- Files: global.sym pod/perlguts.pod sv.c sv.h
-
- Title: "Support SvREADONLY on arrays"
- From: Chip Salzenberg
- Files: av.c
-
- Title: "Allow lvalue pos inside recursive function"
- From: Chip Salzenberg
- Files: op.c pp.c pp_ctl.c pp_hot.c
-
- PORTABILITY
-
- Title: "Eliminate PerlIO warnings when setting cnt to -1"
- From: Chip Salzenberg
- Files: perlio.c
-
- Title: "Make $privlib contents compatible with 5.003"
- From: Chip Salzenberg
- Files: INSTALL ext/Opcode/Safe.pm installperl lib/FileHandle.pm
- lib/Test/Harness.pm
-
- Title: "Support $bincompat3 config variable; update metaconfig units"
- From: Chip Salzenberg
- Files: Configure MANIFEST compat3.sym config_h.SH embed.pl global.sym
- old_embed.pl old_global.sym old_perl_exp.SH perl_exp.SH
-
- Title: "Look for gettimeofday() in Configure"
- From: John Hughes <john@AtlanTech.COM>
- Msg-ID: <01BBE77A.F6F37F80@malvinas.AtlanTech.COM>
- Date: Wed, 11 Dec 1996 15:49:57 +0100
- Files: Configure config_H config_h.SH pp.c
-
- Title: "Make $startperl a relative path if people want portable scrip
- From: Chip Salzenberg
- Files: Configure
-
- Title: "Homogenize use of "eval exec" hack"
- From: Chip Salzenberg
- Files: Porting/Glossary eg/README eg/nih eg/sysvipc/ipcmsg
- eg/sysvipc/ipcsem eg/sysvipc/ipcshm lib/diagnostics.pm
- makeaperl.SH pod/checkpods.PL pod/perlrun.pod
- pod/pod2html.PL pod/pod2latex.PL pod/pod2man.PL
- pod/pod2text.PL utils/c2ph.PL utils/h2ph.PL utils/h2xs.PL
- utils/perlbug.PL utils/perldoc.PL utils/pl2pm.PL x2p/a2py.c
- x2p/find2perl.PL x2p/s2p.PL
-
- Title: "LynxOS support"
- From: seibert@Lynx.COM (Greg Seibert)
- Msg-ID: <m0vYEsY-0000IZC@kzinti.lynx.com>
- Date: Thu, 12 Dec 1996 09:25:00 PST
- Files: Configure MANIFEST hints/lynxos.sh t/op/stat.t
-
- Title: "In Linux hints, set suidsafe=no and dosuid=yes"
- From: Chip Salzenberg
- Files: hints/linux.sh
-
- Title: "5.003_11 on UnixWare 2.1.1 - Only one small UnixWare buglet"
- From: aburlison@cix.compulink.co.uk (Alan Burlison)
- Msg-ID: <memo.453720@cix.compulink.co.uk>
- Date: Wed, 11 Dec 96 18:34 GMT0
- Files: hints/svr4.sh
-
- Title: "Re: db-recno.t failures with _11 on Freebsd 2.1-stable"
- From: Roderick Schertler
- Msg-ID: <pzohg0r5tr.fsf@eeyore.ibcinc.com>
- Date: 11 Dec 1996 18:58:56 -0500
- Files: INSTALL hints/freebsd.sh
-
- Title: "OS/2 updates from Ilya"
- From: Ilya Zakharevich
- Files: README.os2 os2/Changes os2/Makefile.SHs os2/os2.c os2/os2ish.h
-
- Title: "VMS patches to 5.003_11"
- From: Charles Bailey
- Msg-ID: <01ICTR32LCZG001A1D@hmivax.humgen.upenn.edu>
- Date: Mon, 09 Dec 1996 23:16:10 -0500 (EST)
- Files: MANIFEST regexec.c t/lib/filehand.t util.c vms/*
-
- TESTING
-
- Title: "recurse recurse recurse ..."
- From: Jarkko Hietaniemi
- Msg-ID: <199612092144.XAA29025@alpha.hut.fi>
- Date: Mon, 9 Dec 1996 23:44:27 +0200 (EET)
- Files: MANIFEST t/op/recurse.t
-
- UTILITIES, LIBRARY, AND EXTENSIONS
-
- Title: "Add CPAN and Net::FTP"
- From: Chip Salzenberg
- Files: MANIFEST lib/CPAN.pm lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm
- lib/Net/FTP.pm lib/Net/Netrc.pm lib/Net/Socket.pm
- pod/perlmod.pod
-
- Title: "Please update Text::Wrap and Text::Tabs"
- From: David Muir Sharnoff <muir@idiom.com>
- Msg-ID: <199612180659.WAA24957@idiom.com>
- Date: Tue, 17 Dec 1996 22:59:59 -0800 (PST)
- Files: lib/Text/Tabs.pm lib/Text/Wrap.pm
-
- Title: "Add File::Compare"
- From: Nick Ing-Simmons
- Msg-ID: <199612161844.SAA02152@pluto>
- Date: Mon, 16 Dec 1996 18:44:59 GMT
- Files: MANIFEST lib/File/Compare.pm pod/perlmod.pod
-
- Title: "Add Tie::RefHash"
- From: Gurusamy Sarathy
- Msg-ID: <199612152358.SAA28665@aatma.engin.umich.edu>
- Date: Sun, 15 Dec 1996 18:58:08 -0500
- Files: MANIFEST lib/Tie/RefHash.pm pod/perlmod.pod
-
- Title: "Put "splain" in utils."
- From: Chip Salzenberg
- Files: Makefile.SH installperl utils/Makefile utils/splain.PL
-
- Title: "Some h2ph fixes"
- From: Jeff Okamoto
- Msg-ID: <199612131934.AA289845652@hpcc123.corp.hp.com>
- Date: Fri, 13 Dec 1996 11:34:12 -0800
- Files: utils/h2ph.PL
-
- Title: "xsubpp patch to add #line"
- From: Nick Ing-Simmons
- Msg-ID: <199612162153.VAA03590@ni-s.u-net.com>
- Date: Mon, 16 Dec 1996 21:53:56 GMT
- Files: lib/ExtUtils/xsubpp
-
- Title: "Re: Proposed addition to File::Copy: move"
- From: Charles Bailey
- Msg-ID: <01ICZBN0LRC8001A1D@hmivax.humgen.upenn.edu>
- Date: Sat, 14 Dec 1996 00:27:29 -0500 (EST)
- Files: lib/File/Copy.pm t/lib/filecopy.t
-
- Title: "DB_File 1.09 patch"
- From: Paul Marquess
- Msg-ID: <9612181037.AA10123@claudius.bfsec.bt.co.uk>
- Date: Wed, 18 Dec 96 10:37:58 GMT
- Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs
-
- Title: "Debugger update"
- From: Ilya Zakharevich
- Msg-ID: <199612111038.FAA24363@monk.mps.ohio-state.edu>
- Date: Wed, 11 Dec 1996 05:38:28 -0500 (EST)
- Files: lib/perl5db.pl
-
- DOCUMENTATION
-
- Title: "Update pods: perldelta -> perlnews, perli18n -> perllocale"
- From: Tom Christiansen and Dominic Dunlop
- Files: MANIFEST pod/perl.pod pod/perldelta.pod pod/perli18n.pod
- pod/perlnews.pod
-
- Title: "perltoot.pod"
- From: Tom Christiansen
- Msg-ID: <199612091444.HAA09947@toy.perl.com>
- Date: Mon, 09 Dec 1996 07:44:10 -0700
- Files: MANIFEST pod/perltoot.pod
-
- Title: "Perlguts, version 25"
- From: Jeff Okamoto
- Msg-ID: <199612061940.AA055461228@hpcc123.corp.hp.com>
- Date: Fri, 6 Dec 96 11:40:27 PST
- Files: pod/perlguts.pod
-
- Title: "pod/perlipc.pod patch"
- From: d-lewart@uiuc.edu (Daniel S. Lewart)
- Msg-ID: <199612090910.CAA20906@mox.perl.com>
- Date: Mon, 9 Dec 96 3:10:02 CST
- Files: pod/perlipc.pod
-
- Title: "pod patches for English errors"
- From: Steve Kelem <steve.kelem@xilinx.com>
- Msg-ID: <24616.850167191@castor>
- Date: Mon, 09 Dec 1996 13:33:11 -0800
- Files: pod/*.pod
-
- Title: "Misc doc updates"
- From: Tom Christiansen
- Msg-ID: <199612150156.SAA12506@mox.perl.com>
- Date: Sat, 14 Dec 1996 18:56:33 -0700
- Files: pod/*
-
-----------------
-Version 5.003_11
-----------------
-
-This patch is (still) closing in on 5.004. Nothing dramatic, lots of
-value.
-
- CORE LANGUAGE CHANGES
-
- Title: "Fix precedence problems with subs as uniops or listops"
- From: Chip Salzenberg
- Files: perly.c perly.c.diff perly.h perly.y
-
- Title: "Don't reset $. on open()"
- From: Chip Salzenberg
- Files: pp_sys.c
-
- Title: "Support *glob{IO} (eventually deprecate *glob{FILEHANDLE})"
- From: Chip Salzenberg
- Files: pod/perlref.pod pp_hot.c sv.c
-
- Title: "Don't let expression context force return context"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Properly convert "1E2" et al to IV/UV"
- From: Chip Salzenberg
- Files: doio.c sv.c
-
- Title: "Fix modulo operator in UV realm"
- From: Chip Salzenberg
- Files: pp.c
-
- Title: "Fix stat(_) after stat(HANDLE)"
- From: Chip Salzenberg
- Files: pp_sys.c
-
- Title: "Fix: s/// and "$x =~ $y" under 'use locale'"
- From: Chip Salzenberg
- Files: op.c toke.c
-
- OTHER CORE CHANGES
-
- Title: "Eliminate spurious warning when splicing undefs"
- From: Chip Salzenberg
- Files: pp.c sv.h
-
- Title: "Eliminate spurious warning from "x=" operator"
- From: Chip Salzenberg
- Files: op.c
-
- Title: "Fix line numbers near control structures"
- From: Chip Salzenberg
- Files: op.c perly.c perly.c.diff perly.y proto.h
-
- Title: "Don't let scalar unpack() underflow stack"
- From: Chip Salzenberg
- Files: pp.c
-
- Title: "Fix core dump from precedence bug in "@foo" warning"
- From: Chip Salzenberg
- Files: toke.c
-
- Title: "Move die() to utils.c; add varargs hack to croak()"
- From: Chip Salzenberg
- Files: pp_ctl.c util.c
-
- Title: "Avoid memcmp() for magnitude test if it thinks char is signed"
- From: Chip Salzenberg
- Files: Configure config_H config_h.SH doop.c
- ext/SDBM_File/sdbm/pair.c ext/SDBM_File/sdbm/sdbm.h handy.h
- hv.c perl.h pp_hot.c proto.h regexec.c sv.c toke.c util.c
-
- Title: "Less malloc in magic"
- From: Chip Salzenberg
- Files: mg.c
-
- Title: "Re: 5.003_09: PADTMP fix"
- From: Ilya Zakharevich
- Msg-ID: <199611281150.GAA06884@monk.mps.ohio-state.edu>
- Date: Thu, 28 Nov 1996 06:50:58 -0500 (EST)
- Files: pod/perlguts.pod
-
- Title: "Fully paramaterize locales; disable all if NO_LOCALE"
- From: Chip Salzenberg
- Files: ext/POSIX/POSIX.xs op.c perl.h pp.c pp_sys.c sv.c util.c
-
- PORTABILITY AND TESTING
-
- Title: "Bitwise op fix for Alpha"
- From: Chip Salzenberg
- Files: pp.c
-
- Title: "hints/dgux.sh update"
- From: Roderick Schertler
- Msg-ID: <24178.849309616@eeyore.ibcinc.com>
- Date: Fri, 29 Nov 1996 18:20:16 -0500
- Files: hints/dgux.sh
-
- Title: "BUG in hints/hpux.sh"
- From: Jeff McDougal <jmcdo@cris.com>
- Msg-ID: <32A42C11.7FA2@cris.com>
- Date: Tue, 03 Dec 1996 08:33:05 -0500
- Files: hints/hpux.sh
-
- Title: "VMS patches for 5.003_10"
- From: Charles Bailey
- Msg-ID: <01ICMALO8NMS001A1D@hmivax.humgen.upenn.edu>
- Date: Wed, 04 Dec 1996 16:40:12 -0500 (EST)
- Files: EXTERN.h INTERN.h old_perl_exp.SH perl.c perl.h perl_exp.SH
- pp.c pp_ctl.c pp_sys.c proto.h sv.c toke.c util.c
- utils/perldoc.PL vms/config.vms vms/descrip.mms
- vms/gen_shrfls.pl vms/genconfig.pl vms/vmsish.h
-
- Title: "_10+ under OS/2"
- From: Ilya Zakharevich
- Msg-ID: <199612011107.GAA10805@monk.mps.ohio-state.edu>
- Date: Sun, 1 Dec 1996 06:07:19 -0500 (EST)
- Files: malloc.c os2/diff.configure
-
- LIBRARY AND EXTENSIONS
-
- Title: "{in,ob}structive pods"
- From: Tom Christiansen
- Msg-ID: <199611301652.JAA24201@toy.perl.com>
- Date: Sat, 30 Nov 1996 09:52:57 -0700
- Files: MANIFEST lib/Class/Template.pm lib/File/stat.pm
- lib/Net/hostent.pm lib/Net/netent.pm lib/Net/protoent.pm
- lib/Net/servent.pm lib/Time/gmtime.pm lib/Time/localtime.pm
- lib/Time/tm.pm lib/User/grent.pm lib/User/pwent.pm
-
- Title: "FileHandle that 'ISA' IO::File"
- From: Nick Ing-Simmons
- Msg-ID: <199612021718.RAA04416@pluto>
- Date: Mon, 2 Dec 1996 17:18:02 GMT
- Files: MANIFEST lib/FileHandle.pm
-
- Title: "Make IO::File::import use its parameters"
- From: Chip Salzenberg
- Files: ext/IO/lib/IO/File.pm
-
- Title: "10+ debugger patch"
- From: Ilya Zakharevich
- Msg-ID: <199612011137.GAA10864@monk.mps.ohio-state.edu>
- Date: Sun, 1 Dec 1996 06:37:31 -0500 (EST)
- Files: lib/perl5db.pl perl.c pod/perldebug.pod
-
- Title: "Don't call CORE::close in file handle DESTROY method"
- From: Chip Salzenberg
- Files: ext/IO/lib/IO/Handle.pm
-
- Title: "Re: Namespace cleanup: Does SDBM need binary compatibility?"
- From: Hallvard B Furuseth
- Msg-ID: <199612031445.PAA19056@bombur2.uio.no>
- Date: Tue, 3 Dec 1996 15:45:27 +0100 (MET)
- Files: ext/SDBM_File/sdbm/pair.h ext/SDBM_File/sdbm/sdbm.3
-
- Title: "DB_File 1.07"
- From: Paul Marquess
- Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs t/lib/db-btree.t
- t/lib/db-recno.t
-
- Title: "DB_File 1.08"
- From: Paul Marquess
- Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs
-
+____________________________________________________________________________
+[ 565] By: mbeattie on 1998/02/20 18:23:47
+ Log: Remove compiler files from their old lib/B locations. The compiler
+ now builds by default (without the byteperl executable so far) and
+ seems to work at least minimally.
+ Branch: perl
+ - lib/B.pm lib/B/Asmdata.pm lib/B/Assembler.pm lib/B/Bblock.pm
+ - lib/B/Bytecode.pm lib/B/C.pm lib/B/CC.pm lib/B/Debug.pm
+ - lib/B/Deparse.pm lib/B/Disassembler.pm lib/B/Lint.pm
+ - lib/B/Showlex.pm lib/B/Stackobj.pm lib/B/Terse.pm
+ - lib/B/Xref.pm lib/B/assemble lib/B/cc_harness
+ - lib/B/disassemble lib/B/makeliblinks lib/O.pm
+ ! MANIFEST bytecode.pl
+____________________________________________________________________________
+[ 564] By: mbeattie on 1998/02/20 18:05:33
+ Log: Move lib/B/... and lib/[BO].pm over to where they should be,
+ under ext/B.
+ Branch: perl
+ +> ext/B/B.pm ext/B/B/Asmdata.pm ext/B/B/Assembler.pm
+ +> ext/B/B/Bblock.pm ext/B/B/Bytecode.pm ext/B/B/C.pm
+ +> ext/B/B/CC.pm ext/B/B/Debug.pm ext/B/B/Deparse.pm
+ +> ext/B/B/Disassembler.pm ext/B/B/Lint.pm ext/B/B/Showlex.pm
+ +> ext/B/B/Stackobj.pm ext/B/B/Terse.pm ext/B/B/Xref.pm
+ +> ext/B/B/assemble ext/B/B/cc_harness ext/B/B/disassemble
+ +> ext/B/B/makeliblinks ext/B/O.pm
+____________________________________________________________________________
+[ 563] By: mbeattie on 1998/02/20 17:54:58
+ Log: Start getting compiler to work when built with the core.
+ [Still won't work as of this change.]
+ Branch: perl
+ +> byterun.c byterun.h lib/B/Asmdata.pm lib/B/Assembler.pm
+ +> lib/B/Bblock.pm lib/B/Bytecode.pm lib/B/C.pm lib/B/CC.pm
+ +> lib/B/Debug.pm lib/B/Deparse.pm lib/B/Disassembler.pm
+ +> lib/B/Lint.pm lib/B/Showlex.pm lib/B/Stackobj.pm
+ +> lib/B/Terse.pm lib/B/Xref.pm
+ ! MANIFEST Makefile.SH bytecode.pl ext/B/Makefile.PL
+____________________________________________________________________________
+[ 562] By: mbeattie on 1998/02/20 16:42:13
+ Log: Merge perlext/Compiler/... into mainline. Some files move to
+ ext/B/..., some to lib/B/..., O.pm and B.pm go in lib and some
+ move to the base perl directory (e.g. headers). Will need some
+ cleaning up before it builds properly, I would guess.
+ Branch: perl
+ +> bytecode.h bytecode.pl cc_runtime.h ext/B/B.xs
+ +> ext/B/Makefile.PL ext/B/NOTES ext/B/README ext/B/TESTS
+ +> ext/B/Todo ext/B/byteperl.c ext/B/ramblings/cc.notes
+ +> ext/B/ramblings/curcop.runtime ext/B/ramblings/flip-flop
+ +> ext/B/ramblings/magic ext/B/ramblings/reg.alloc
+ +> ext/B/ramblings/runtime.porting ext/B/typemap lib/B.pm
+ +> lib/B/assemble lib/B/cc_harness lib/B/disassemble
+ +> lib/B/makeliblinks lib/O.pm
+____________________________________________________________________________
+[ 561] By: mbeattie on 1998/02/20 16:39:38
+ Log: Win32 changes from Sarathy, tweaked slightly by me.
+ Branch: perlext
+ ! Compiler/B.xs Compiler/B/Asmdata.pm Compiler/B/Bytecode.pm
+ ! Compiler/B/C.pm Compiler/Makefile.PL Compiler/assemble
+ ! Compiler/bytecode.h Compiler/bytecode.pl Compiler/byteperl.c
+ ! Compiler/byterun.c Compiler/byterun.h Compiler/cc_harness
+____________________________________________________________________________
+[ 560] By: mbeattie on 1998/02/20 15:46:15
+ Log: Initialise $@ early (fixes t/lib/ph.t for threaded perl).
+ Branch: perl
+ ! perl.c
+____________________________________________________________________________
+[ 559] By: mbeattie on 1998/02/20 12:56:10
+ Log: Add missing t/op/wantarray.t to MANIFEST. Bump patchlevel to 60.
+ Branch: perl
+ ! MANIFEST patchlevel.h
+____________________________________________________________________________
+[ 558] By: mbeattie on 1998/02/20 12:53:26
+ Log: Integrate win32 branch into mainline.
+ Branch: perl
+ !> XSUB.h config_h.SH doio.c lib/Pod/Html.pm pp_sys.c
+ !> win32/Makefile win32/config.bc win32/config.gc win32/config.vc
+ !> win32/config_H.bc win32/config_H.gc win32/config_H.vc
+ !> win32/makedef.pl win32/makefile.mk win32/win32.c win32/win32.h
+ !> win32/win32iop.h x2p/a2p.h
+____________________________________________________________________________
+[ 557] By: mbeattie on 1998/02/20 12:51:42
+ Log: Subject: retry [PATCH] 5.004_59: the perlhist.pod etc
+ Date: Thu, 19 Feb 1998 17:54:52 +0200 (EET)
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Branch: perl
+ ! ext/Thread/Thread.pm ext/Thread/Thread/Queue.pm
+ ! ext/Thread/Thread/Semaphore.pm ext/Thread/Thread/Specific.pm
+ ! lib/fields.pm pod/buildtoc pod/perl.pod pod/perlhist.pod
+ ! pod/perltoc.pod pod/perlvar.pod
+____________________________________________________________________________
+[ 556] By: mbeattie on 1998/02/20 12:49:54
+ Log: Subject: [PATCH] installperl
+ Date: Wed, 18 Feb 1998 11:51:44 -0500 (est)
+ From: Norton Allen <allen@huarp.harvard.edu>
+ Branch: perl
+ ! installperl
+____________________________________________________________________________
+[ 555] By: mbeattie on 1998/02/20 12:49:09
+ Log: Subject: [PATCH:_59] t/op/wantarray.t
+ Date: Wed, 18 Feb 1998 11:19:54 -0500 (est)
+ From: Norton Allen <allen@huarp.harvard.edu>
+ Branch: perl
+ + t/op/wantarray.t
+____________________________________________________________________________
+[ 554] By: mbeattie on 1998/02/20 12:47:44
+ Log: Subject: Misprint in regcomp.c [PATCH]
+ Date: Tue, 17 Feb 1998 23:54:07 -0500 (EST)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Branch: perl
+ ! regcomp.c
+____________________________________________________________________________
+[ 553] By: mbeattie on 1998/02/20 12:45:08
+ Log: Subject: DB_File ->length does not work just after tie.
+ Date: Tue, 17 Feb 1998 13:19:18 GMT
+ From: Nick Ing-Simmons <nik@tiuk.ti.com>
+ Branch: perl
+ ! ext/DB_File/DB_File.xs
+____________________________________________________________________________
+[ 552] By: mbeattie on 1998/02/20 12:43:32
+ Log: Subject: [PATCH] - perl5.005_59, update Copyright
+ Date: Mon, 16 Feb 1998 20:31:06 -0500 (EST)
+ From: lusol@CS4.CC.Lehigh.EDU (Stephen O. Lidie)
+ Branch: perl
+ ! perl.c
+____________________________________________________________________________
+[ 551] By: mbeattie on 1998/02/20 12:42:41
+ Log: Subject: Re: for() and map() peculiarity
+ Date: Mon, 16 Feb 1998 21:33:44 +0000
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Branch: perl
+ ! pod/perlsyn.pod
+____________________________________________________________________________
+[ 550] By: mbeattie on 1998/02/20 12:41:53
+ Log: Subject: [PATCH 5.004_59] Updates to VMS/CONFIG.VMS
+ Date: Mon, 16 Feb 1998 11:46:29 -0800
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Branch: perl
+ ! vms/config.vms
+____________________________________________________________________________
+[ 549] By: mbeattie on 1998/02/20 12:40:55
+ Log: Subject: [PATCH] 5.004_59 global.sym for AIX 3.2.5
+ Date: Mon, 16 Feb 1998 14:27:53 -0500 (EST)
+ From: "Stephen O. Lidie" <lusol@turkey.cc.Lehigh.EDU>
+ Branch: perl
+ ! global.sym
+____________________________________________________________________________
+[ 548] By: mbeattie on 1998/02/20 12:39:56
+ Log: Subject: [PATCH] 5.004_59: hints/irix_6.sh
+ Date: Mon, 16 Feb 1998 15:44:57 +0200 (EET)
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Branch: perl
+ ! hints/irix_6.sh
+____________________________________________________________________________
+[ 547] By: mbeattie on 1998/02/20 12:38:58
+ Log: Subject: [PATCH] perlguts update
+ Date: 16 Feb 1998 11:23:53 +0100
+ From: Gisle Aas <gisle@aas.no>
+ Branch: perl
+ ! pod/perlguts.pod
+____________________________________________________________________________
+[ 546] By: mbeattie on 1998/02/20 12:38:01
+ Log: Subject: [PATCH 5.004_59] bsdos/hints.sh is wrong
+ Date: Sun, 15 Feb 1998 23:56:05 -0500
+ From: Irving Reid <irving@tor.securecomputing.com>
+ Branch: perl
+ ! hints/bsdos.sh
+____________________________________________________________________________
+[ 545] By: mbeattie on 1998/02/20 12:37:11
+ Log: Subject: [PATCH] 5% speedup in an empty loop
+ Date: Sun, 15 Feb 1998 17:49:46 -0500 (EST)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Branch: perl
+ ! op.c
+____________________________________________________________________________
+[ 544] By: mbeattie on 1998/02/20 12:36:26
+ Log: Subject: [PATCH for 5.004_59] netdb_host_type and netdb_hlen_type on NeXt
+ Date: Sun, 15 Feb 98 23:06:16 +0100
+ From: Hans Mulder <hansm@icgroup.nl>
+ Branch: perl
+ ! hints/next_3.sh hints/next_4.sh
+____________________________________________________________________________
+[ 543] By: mbeattie on 1998/02/20 12:35:39
+ Log: Subject: [PATCH for 5.004_59] Perl_sbrk declared inconsistently
+ Date: Sun, 15 Feb 98 23:05:20 +0100
+ From: Hans Mulder <hansm@icgroup.nl>
+ Branch: perl
+ ! malloc.c
+____________________________________________________________________________
+[ 542] By: mbeattie on 1998/02/20 12:35:03
+ Log: Subject: [PATCH for 5.004_59] "d_gethbyname" misspelled in Configure
+ From: Hans Mulder <hansm@icgroup.nl>
+ Date: Sun, 15 Feb 98 23:04:29 +0100
+ Branch: perl
+ ! Configure
+____________________________________________________________________________
+[ 541] By: mbeattie on 1998/02/20 12:33:56
+ Log: Subject: [PATCH for 5.004_59] NeXT doesn't need DONT_DECLARE_STD (was:
+ NeXT needs DONT_DECLARE_STD)
+ Date: Sun, 15 Feb 98 23:04:19 +0100
+ From: Hans Mulder <hansm@icgroup.nl>
+ Branch: perl
+ ! perl.h
+____________________________________________________________________________
+[ 540] By: mbeattie on 1998/02/20 12:32:25
+ Log: Subject: [PATCH] sv_check_thinkfirst macroized
+ Date: 15 Feb 1998 22:00:38 +0100
+ From: Gisle Aas <gisle@aas.no>
+ Branch: perl
+ ! sv.c
+____________________________________________________________________________
+[ 539] By: mbeattie on 1998/02/20 12:31:07
+ Log: Subject: [PATCH 5.004_59] allow the Test::Harness to grok TODO-type tests docs
+ Date: Sat, 14 Feb 1998 17:58:01 -0500
+ From: Joshua Pritikin <pritikin@mindspring.com>
+ Branch: perl
+ + lib/Test.pm
+ ! MANIFEST lib/Test/Harness.pm
+____________________________________________________________________________
+[ 538] By: mbeattie on 1998/02/20 12:24:31
+ Log: Subject: [PATCH] 5.004_59: locale startup problems documentation++
+ Date: Sat, 14 Feb 1998 15:40:44 +0200 (EET)
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Branch: perl
+ ! INSTALL pod/perldiag.pod pod/perllocale.pod
+____________________________________________________________________________
+[ 537] By: mbeattie on 1998/02/20 12:23:04
+ Log: Subject: [PATCH] Updated, non-wordwrapped, patch to README.VMS
+ Date: Fri, 13 Feb 1998 13:38:28 -0800
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Branch: perl
+ ! README.vms
+____________________________________________________________________________
+[ 536] By: mbeattie on 1998/02/20 12:20:29
+ Log: Subject: [PATCH] 5.004_58, move intuition tests
+ Date: Thu, 12 Feb 1998 17:11:05 -0600
+ From: Stephen Potter <spp@psa.pencom.com>
+ Branch: perl
+ ! t/lib/anydbm.t t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t
+ ! t/lib/sdbm.t t/op/array.t t/op/delete.t t/op/each.t
+ ! t/op/flip.t t/op/pat.t t/op/push.t
+____________________________________________________________________________
+[ 535] By: gsar on 1998/02/19 23:07:24
+ Log: applied a version of this with tabs intact
+ Message-Id: <wklnv7pdf5.fsf@turangalila.harmonixmusic.com>
+ Date: 19 Feb 1998 15:06:38 EST
+ From: dfan@harmonixmusic.com (Dan Schmidt)
+ Subject: Pod::Html bug and fix: missing </UL> in index
+ Branch: win32/perl
+ ! lib/Pod/Html.pm
+____________________________________________________________________________
+[ 534] By: gsar on 1998/02/19 19:40:27
+ Log: Fix C<0> problem in Pod::Html
+ Branch: win32/perl
+ ! lib/Pod/Html.pm
+____________________________________________________________________________
+[ 533] By: gsar on 1998/02/18 18:11:08
+ Log: non-debug VC builds are -O1 now (they say it works, and is
+ faster)
+ Branch: win32/perl
+ ! win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 532] By: gsar on 1998/02/18 04:11:03
+ Log: integrate nick's patch to mainline
+ Branch: win32/perl
+ !> pp.c
+____________________________________________________________________________
+[ 531] By: mbeattie on 1998/02/17 17:50:50
+ Log: Assorted changes to the compiler
+ Branch: perlext
+ ! Compiler/B.pm Compiler/B.xs Compiler/B/Asmdata.pm
+ ! Compiler/B/Bytecode.pm Compiler/B/C.pm Compiler/B/Debug.pm
+ ! Compiler/NOTES Compiler/O.pm Compiler/bytecode.pl
+ ! Compiler/byterun.c Compiler/byterun.h Compiler/typemap
+____________________________________________________________________________
+[ 530] By: gsar on 1998/02/17 01:47:35
+ Log: DLLs are now ok on mingw32/gcc-2.8.0 after removing the
+ FORCE_ARG_STRING() hack (that bug is fixed in gcc now). mingw32
+ build passes all tests except t/lib/io_xs.t (seems to be due to
+ broken tmpfile() in the CRT or import lib)
+ Branch: win32/perl
+ ! XSUB.h win32/makefile.mk win32/win32.h
+____________________________________________________________________________
+[ 529] By: gsar on 1998/02/16 23:03:31
+ Log: fix mingw32 gcc 2.8.0 build (DLLs generated seem to be broken
+ in this version of gcc!)
+ Branch: win32/perl
+ ! doio.c pp_sys.c win32/config.gc win32/makefile.mk
+ ! win32/win32.c win32/win32.h win32/win32iop.h x2p/a2p.h
+____________________________________________________________________________
+[ 528] By: nick on 1998/02/16 22:13:04
+ Log: Missing PUSHMARK in unshift TIEARRAY hook
+ Branch: perl
+ ! pp.c
+____________________________________________________________________________
+[ 527] By: gsar on 1998/02/15 20:59:07
+ Log: integrate win32 branch
+ Branch: asperl
+ !> config_h.SH win32/config.bc win32/config.gc win32/config.vc
+ !> win32/config_H.bc win32/config_H.gc win32/config_H.vc
+ !> win32/makedef.pl
+____________________________________________________________________________
+[ 526] By: gsar on 1998/02/15 20:02:11
+ Log: Fix typo: s/GETNETBYADD\b/GETNETBYADDR/
+ Branch: win32/perl
+ ! config_h.SH win32/config_H.bc win32/config_H.gc
+ ! win32/config_H.vc
+____________________________________________________________________________
+[ 525] By: gsar on 1998/02/15 03:26:45
+ Log: fix build problems due to renamed Config variables
+ Branch: win32/perl
+ ! win32/config.bc win32/config.gc win32/config.vc
+ ! win32/config_H.bc win32/config_H.gc win32/config_H.vc
+ ! win32/makedef.pl
+____________________________________________________________________________
+[ 524] By: gsar on 1998/02/14 01:00:15
+ Log: bring ASPerl uptodate with mainline changes
+ Branch: asperl
+ +> ext/DB_File/Changes t/comp/require.t
+ !> (integrate 41 files)
+____________________________________________________________________________
+[ 523] By: gsar on 1998/02/14 00:52:17
+ Log: integrate mainline
+ Branch: win32/perl
+ !> hints/qnx.sh lib/Cwd.pm lib/ExtUtils/xsubpp patchlevel.h
+ !> pp_hot.c t/op/magic.t
+____________________________________________________________________________
+[ 522] By: gsar on 1998/02/14 00:42:37
+ Log: added AS patch#6
+ Message-Id: <01BD3846.B29FB880.dougl@ActiveState.com>
+ Date: Fri, 13 Feb 1998 06:14:51 PST
+ From: Douglas Lankshear <dougl@ActiveState.com>
+ Subject: [PATCH] command line build
+
+ This patch is for the command line build of perl object.
+ I'll merge the ipfoo.c function with win32_xxx functions next.
+
+ -- Doug
+ Branch: asperl
+ ! ObjXSub.h ext/Opcode/Opcode.xs lib/ExtUtils/MM_Win32.pm
+ ! objpp.h proto.h sv.c win32/dl_win32.xs win32/ipenv.c
+ ! win32/ipstdio.c win32/makedef.pl win32/runperl.c win32/win32.h
+____________________________________________________________________________
+[ 521] By: gsar on 1998/02/14 00:14:04
+ Log: added AS patch#5 (patch #4 was intentionally skipped after
+ discussion)
+ Branch: asperl
+ ! embed.h embedvar.h global.sym globals.c hv.c interp.sym
+ ! intrpvar.h op.c perl.c perl.h pp_ctl.c proto.h regcomp.c
+ ! regexec.c sv.c toke.c
+____________________________________________________________________________
+[ 520] By: nick on 1998/02/13 18:15:46
+ Log: Resolve ansiperl against win32
+ Branch: ansiperl
+ +> ext/DB_File/Changes ext/POSIX/hints/linux.pl
+ +> ext/POSIX/hints/sunos_4.pl lib/Fatal.pm t/comp/require.t
+ +> t/lib/ph.t
+ !> (integrate 898 files)
----------------
-Version 5.003_10
+Version 5.004_59
----------------
-This patch is closing in on 5.004. It contains lots of small and
-valuable changes, but nothing dramatic.
-
- CORE LANGUAGE CHANGES
-
- Title: "Allow &{sub {...}} without warning"
- From: Chip Salzenberg
- Files: toke.c
-
- Title: "Make parens optional on [gs]ethost and [gs]et{pw,gr} functions
- From: John L. Allen <allen@gateway.grumman.com>
- Files: toke.c
-
- Title: "Fix syntax error with "$x [0]" and "$x {y}" and "@x {y}""
- From: Chip Salzenberg
- Files: toke.c
-
- OTHER CORE CHANGES
-
- Title: "Fix regex matching of chars with high bit set"
- From: Chip Salzenberg
- Files: regexec.c
-
- Title: "Hash key memory corruption fix and naming cleanup"
- From: Chip Salzenberg
- Files: hv.c hv.h perl.h
-
- Title: "Undo broken perf. patch (PADTMP stealing)"
- From: Chip Salzenberg
- Files: sv.c
-
- Title: "Make SV unstudied in sv_gets()"
- From: Chip Salzenberg
- Files: sv.c
-
- Title: "Better support for UVs"
- From: Paul Marquess
- Files: global.sym old_global.sym perl.h pp.c pp.h proto.h sv.c sv.h
-
- Title: "Minor locale cleanups"
- (Accept "POSIX" locale as standard like "C". Reset locale to
- 'C' when testing strtod() in t/lib/posix.t.)
- From: Chip Salzenberg
- Files: t/lib/posix.t util.c
-
- Title: "Always taint result of sprintf() on float"
- From: Chip Salzenberg
- Files: doop.c
-
- Title: "Fix spurious warning from bitwise string ops"
- From: Chip Salzenberg
- Files: doop.c
-
- Title: "Eliminate warning on {,sys}read(,$newvar,)"
- From: Chip Salzenberg
- Files: doop.c pp_sys.c
-
- Title: "Don't call fcntl(fileno(rsfp)) if !rsfp"
- From: Chip Salzenberg
- Files: perl.c
-
- Title: "Save message when calling __DIE__ hook"
- From: Chip Salzenberg
- Files: pp_ctl.c
-
- Title: "Namespace cleanup"
- From: Chip Salzenberg
- Files: global.sym old_global.sym perl.h
-
- Title: "Modify perl_exp.SH; create old_perl_exp.SH; document old_*"
- From: Chip Salzenberg
- Files: Configure INSTALL MANIFEST old_perl_exp.SH perl_exp.SH
-
- PORTABILITY
-
- Title: "Reliable signal patch"
- From: Kenneth Albanowski
- Msg-ID: <Pine.LNX.3.93.961126053209.294J-100000@kjahds.com>
- Date: Tue, 26 Nov 1996 05:40:50 -0500 (EST)
- Files: global.sym mg.c old_global.sym perl.h pp_sys.c proto.h util.c
-
- Title: "Emulate missing flock() with either fcntl() or lockf()"
- From: Chip Salzenberg
- Files: pp_sys.c
-
- Title: "3_09: minor patches for OS/2"
- From: Ilya Zakharevich
- Msg-ID: <199611270830.DAA04985@monk.mps.ohio-state.edu>
- Date: Wed, 27 Nov 1996 03:30:05 -0500 (EST)
- Files: doio.c global.sym malloc.c old_global.sym os2/Makefile.SHs
- os2/OS2/ExtAttr/Makefile.PL os2/OS2/PrfDB/Makefile.PL
- os2/OS2/Process/Makefile.PL os2/OS2/REXX/Makefile.PL
- os2/os2.c os2/os2ish.h perl.h
-
- Title: "Re: 5.003_09 and QNX"
- From: nort@bottesini.harvard.edu (Norton Allen)
- Msg-ID: <9611271836.AA14460@bottesini.harvard.edu>
- Date: Wed, 27 Nov 96 13:36:06 est
- Files: Configure MANIFEST README.qnx hints/qnx.sh qnx/ar qnx/cpp
- t/TEST toke.c util.c x2p/proto.h
-
- Title: "Re: updated patch on the sysread, syswrite for VMS"
- From: Charles Bailey
- Msg-ID: <01ICB648K2XG001A1D@hmivax.humgen.upenn.edu>
- Date: Tue, 26 Nov 1996 17:28:23 -0500 (EST)
- Files: t/op/sysio.t
-
- LIBRARY AND EXTENSIONS
-
- Title: "Minor patch to debugger"
- From: Ilya Zakharevich
- Msg-ID: <199611290533.AAA08053@monk.mps.ohio-state.edu>
- Date: Fri, 29 Nov 1996 00:33:49 -0500 (EST)
- Files: lib/perl5db.pl
-
- Title: "AutoLoader::AUTOLOAD optimization"
- From: Nick Ing-Simmons
- Msg-ID: <199611231954.TAA09921@ni-s.u-net.com>
- Date: Sat, 23 Nov 1996 19:54:52 GMT
- Files: lib/AutoLoader.pm
-
- Title: "Diagnostic cleanup"
- From: Chip Salzenberg
- Files: lib/diagnostics.pm pod/perldiag.pod
-
- DOCUMENTATION
-
- Title: "Improve documentation for sysread() and syswrite()"
- From: Chip Salzenberg
- Files: pod/perlfunc.pod
-
- Title: "Document how to use $SIG{ALRM} and alarm()"
- From: Roderick Schertler
- Msg-ID: <5898.849026569@eeyore.ibcinc.com>
- Date: Tue, 26 Nov 1996 11:42:49 -0500
- Files: pod/perlfunc.pod
-
+____________________________________________________________________________
+[ 519] By: mbeattie on 1998/02/13 17:05:37
+ Log: Integrate win32 into mainline.
+ Branch: perl
+ ! lib/ExtUtils/xsubpp
+ !> win32/Makefile win32/config.bc win32/config.gc win32/config.vc
+ !> win32/makefile.mk
+____________________________________________________________________________
+[ 518] By: mbeattie on 1998/02/13 17:01:16
+ Log: Bump patchlevel.h to 59.
+ Branch: perl
+ ! patchlevel.h
+____________________________________________________________________________
+[ 517] By: mbeattie on 1998/02/13 16:57:59
+ Log: Subject: [PATCH] _58: wantarray in void context broken
+ Date: Fri, 13 Feb 1998 11:24:49 -0500 (est)
+ From: Norton Allen <allen@huarp.harvard.edu>
+ Branch: perl
+ ! pp_hot.c
+____________________________________________________________________________
+[ 516] By: mbeattie on 1998/02/13 16:55:33
+ Log: Subject: [PATCH] 5.004_58 QNX getcwd
+ Date: Thu, 12 Feb 1998 13:40:56 -0500 (est)
+ From: Norton Allen <allen@huarp.harvard.edu>
+ Branch: perl
+ ! hints/qnx.sh lib/Cwd.pm t/op/magic.t
+____________________________________________________________________________
+[ 515] By: gsar on 1998/02/12 18:29:52
+ Log: pickup lddlflags properly for Config.pm
+ Branch: win32/perl
+ ! win32/Makefile win32/config.bc win32/config.gc win32/config.vc
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 514] By: gsar on 1998/02/12 18:16:09
+ Log: fix xsubpp bug in SETMAGIC code
+ Branch: win32/perl
+ ! lib/ExtUtils/xsubpp
+____________________________________________________________________________
+[ 513] By: gsar on 1998/02/12 18:06:30
+ Log: integrate mainline
+ Branch: win32/perl
+ +> ext/DB_File/Changes
+ !> Configure MANIFEST config_h.SH ext/DB_File/DB_File.pm
+ !> ext/DB_File/DB_File.xs hints/machten.sh
+ !> lib/ExtUtils/Install.pm lib/Pod/Html.pm lib/Pod/Text.pm
+ !> lib/perl5db.pl malloc.c pod/perldiag.pod pod/perlpod.pod
+ !> pod/pod2man.PL pp_sys.c regcomp.c regexec.c scope.h sv.c
+ !> t/lib/db-recno.t t/lib/filecopy.t t/op/misc.t t/op/pat.t
+ !> t/op/re_tests t/pragma/locale.t
+____________________________________________________________________________
+[ 512] By: mbeattie on 1998/02/12 17:34:02
+ Log: Missing WITH_THR from new deb() in ENTER/LEAVE caused builds
+ with -DUSE_THREADS -DDEBUGGING to fail.
+ Branch: perl
+ ! scope.h
+____________________________________________________________________________
+[ 511] By: mbeattie on 1998/02/12 16:44:03
+ Log: Integrate win32 into mainline
+ Branch: perl
+ +> t/comp/require.t
+ !> MANIFEST pp_ctl.c scope.c scope.h t/op/local.t toke.c
+____________________________________________________________________________
+[ 510] By: mbeattie on 1998/02/12 16:42:26
+ Log: Subject: Re: [PATCH] 5.004_58 | _04 DynaLoader.pm -> DynaLoader.pm.PL (resend)
+ Date: 12 Feb 1998 14:25:55 +0100
+ From: koenig@kulturbox.de (Andreas J. Koenig)
+ Branch: perl
+ ! lib/ExtUtils/Install.pm
+____________________________________________________________________________
+[ 509] By: mbeattie on 1998/02/12 16:40:34
+ Log: Subject: Re: wrong prototype for sbrk [PATCH]
+ Date: Wed, 11 Feb 1998 15:37:31 -0500 (EST)
+ From: Andy Dougherty <doughera@newton.phys.lafayette.edu>
+ Branch: perl
+ ! malloc.c
+____________________________________________________________________________
+[ 508] By: mbeattie on 1998/02/12 16:36:53
+ Log: Subject: [PATCH] 5.004_58 | _04: pod2*,perlpod: L<show this|man/section>
+ Date: Wed, 11 Feb 1998 17:29:20 +0100
+ From: Achim Bohnet <ach@mpe.mpg.de>
+ Branch: perl
+ ! lib/Pod/Html.pm lib/Pod/Text.pm pod/perlpod.pod pod/pod2man.PL
+____________________________________________________________________________
+[ 507] By: mbeattie on 1998/02/12 16:35:26
+ Log: Subject: [PATCH] slight tweaks to hints/machten.sh
+ Date: Wed, 11 Feb 1998 14:59:46 +0100
+ From: Dominic Dunlop <domo@vo.lu>
+ Branch: perl
+ ! hints/machten.sh
+____________________________________________________________________________
+[ 506] By: mbeattie on 1998/02/12 16:28:40
+ Log: Subject: DB_File 1.58 patch
+ Date: Tue, 10 Feb 1998 11:23:22 +0000 (GMT)
+ From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ Branch: perl
+ + ext/DB_File/Changes
+ ! MANIFEST ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs
+ ! t/lib/db-recno.t
+____________________________________________________________________________
+[ 505] By: mbeattie on 1998/02/12 16:24:26
+ Log: Subject: 5.004_5*: [PATCH] restore old behaviour of \1 in RE
+ Date: Tue, 10 Feb 1998 02:57:46 -0500 (EST)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Branch: perl
+ ! regexec.c t/op/re_tests
+____________________________________________________________________________
+[ 504] By: mbeattie on 1998/02/12 16:22:46
+ Log: From: Jarkko Hietaniemi <jhi@iki.fi>
+ Subject: [PATCH] 5.004_58: the locale.t problem in IRIX
+ Date: Mon, 9 Feb 1998 19:47:22 +0200 (EET)
+ Subject: [PATCH] 5.004_58: reserve the POSIX regexp extensions
+ Date: Tue, 10 Feb 1998 15:12:12 +0200 (EET)
+ Subject: [PATCH] 5.004_58: <netdb.h> API prototype probing
+ Date: Wed, 11 Feb 1998 12:50:35 +0200 (EET)
+ Branch: perl
+ ! Configure config_h.SH pod/perldiag.pod pp_sys.c regcomp.c
+ ! t/op/misc.t t/op/pat.t t/op/re_tests t/pragma/locale.t
+____________________________________________________________________________
+[ 503] By: mbeattie on 1998/02/12 16:15:43
+ Log: Subject: [PATCH] filecopy.t #3 fails on dos-djgpp
+ Date: Mon, 9 Feb 1998 13:19:45 +0100
+ From: Laszlo Molnar <molnarl@cdata.tvnet.hu>
+ Branch: perl
+ ! t/lib/filecopy.t
+____________________________________________________________________________
+[ 502] By: mbeattie on 1998/02/12 16:14:27
+ Log: Assorted patches to sv.c:
+ From: Gisle Aas <gisle@aas.no>
+ Subject: [PATCH] sv_grow can fail for HAS_64K_LIMIT systems
+ Date: 07 Feb 1998 00:21:57 +0100
+ Subject: [PATCH] sv_setnv will upgrade SVt_NV to SVt_PVNV
+ Date: 07 Feb 1998 00:29:45 +0100
+ Subject: [PATCH] sv_upgrade() always returns TRUE
+ Date: 09 Feb 1998 15:44:01 +0100
+ Branch: perl
+ ! sv.c
+____________________________________________________________________________
+[ 501] By: mbeattie on 1998/02/12 16:09:26
+ Log: Fix saving of STDOUT during system() in lib/perl5db.pl:
+ Subject: Perl debugger.
+ Date: Fri, 6 Feb 1998 17:47:08 -0500
+ From: "Jason A. Smith" <smithj4@rpi.edu>
+ Branch: perl
+ ! lib/perl5db.pl
+____________________________________________________________________________
+[ 500] By: gsar on 1998/02/12 03:20:55
+ Log: merge another maint patch
+ Message-Id: <199802102349.SAA16001@aatma.engin.umich.edu>
+ Date: Tue, 10 Feb 1998 18:49:00 EST
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Subject: Re: after an eval-ed bad require, requiring a string ref gives a SEGV
+ Branch: win32/perl
+ ! pp_ctl.c
+____________________________________________________________________________
+[ 499] By: gsar on 1998/02/12 03:14:39
+ Log: make t/comp/require.t type xtext
+ Branch: win32/perl
+ ! t/comp/require.t
+____________________________________________________________________________
+[ 498] By: gsar on 1998/02/12 03:09:58
+ Log: fix extra LEAVE when require fails
+ Message-Id: <199802102321.SAA15346@aatma.engin.umich.edu>
+ Date: Tue, 10 Feb 1998 18:21:37 EST
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Subject: Re: evals and requires make seg-fault with bad require file
+ Branch: win32/perl
+ + t/comp/require.t
+ ! MANIFEST pp_ctl.c scope.c scope.h toke.c
+____________________________________________________________________________
+[ 497] By: gsar on 1998/02/12 02:47:29
+ Log: merge a maint patch
+ Message-Id: <199802110515.AAA23700@aatma.engin.umich.edu>
+ Date: Wed, 11 Feb 1998 00:15:51 EST
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Subject: Re: "local" can crash perl-4.00[34] on Solaris-x86 & FreeBSD
+ Branch: win32/perl
+ ! pp_ctl.c t/op/local.t
+____________________________________________________________________________
+[ 496] By: mbeattie on 1998/02/11 13:04:50
+ Log: Integrate win32 into mainline.
+ Branch: perl
+ !> embed.h ext/GDBM_File/typemap ext/NDBM_File/typemap
+ !> ext/ODBM_File/typemap ext/SDBM_File/typemap global.sym gv.c
+ !> lib/ExtUtils/typemap lib/ExtUtils/xsubpp op.c
+ !> os2/OS2/PrfDB/typemap pod/perlguts.pod pod/perlobj.pod
+ !> pod/perlxs.pod pod/perlxstut.pod proto.h sv.c sv.h t/op/ref.t
+ !> win32/makedef.pl win32/win32.c win32/win32iop.h
+____________________________________________________________________________
+[ 495] By: mbeattie on 1998/02/11 13:03:59
+ Log: Fix special constants in Xref.pm
+ Branch: perlext
+ ! Compiler/B/Xref.pm
+____________________________________________________________________________
+[ 494] By: gsar on 1998/02/10 18:26:28
+ Log: fix opendir() problem on share names
+ Message-Id: <199802101828.NAA10420@aatma.engin.umich.edu>
+ Date: Tue, 10 Feb 1998 13:28:53 EST
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Subject: Re: BUG: opendir and UNC names on NT
+ Branch: win32/perl
+ ! win32/win32.c
+____________________________________________________________________________
+[ 493] By: gsar on 1998/02/09 23:09:40
+ Log: integrate win32 branch contents
+ Branch: asperl
+ +> ext/POSIX/hints/linux.pl ext/POSIX/hints/sunos_4.pl
+ +> lib/Fatal.pm t/lib/ph.t
+ ! hv.c
+ !> (integrate 895 files)
+____________________________________________________________________________
+[ 492] By: gsar on 1998/02/09 07:30:19
+ Log: enhancements to previous patch for XSUB OUTPUT args
+ Message-Id: <199802090731.CAA04438@aatma.engin.umich.edu>
+ Date: Mon, 09 Feb 1998 02:31:55 EST
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Subject: Re: [PATCH] XSUB OUTPUT arguments and 'set' magic
+ Branch: win32/perl
+ ! embed.h ext/GDBM_File/typemap ext/NDBM_File/typemap
+ ! ext/ODBM_File/typemap ext/SDBM_File/typemap global.sym
+ ! lib/ExtUtils/typemap lib/ExtUtils/xsubpp os2/OS2/PrfDB/typemap
+ ! pod/perlguts.pod pod/perlxs.pod pod/perlxstut.pod proto.h sv.c
+ ! sv.h
+____________________________________________________________________________
+[ 491] By: gsar on 1998/02/09 03:00:52
+ Log: don't share TARG unless -DUSE_BROKEN_PAD_RESET
+ Message-Id: <199710300036.TAA01004@aatma.engin.umich.edu>
+ Date: Wed, 29 Oct 1997 19:36:25 EST
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Subject: [PATCH] Don't use broken pad_reset() (was Re: Perl bug in 5.004_03 )
+ Branch: win32/perl
+ ! op.c
+____________________________________________________________________________
+[ 490] By: gsar on 1998/02/09 02:30:43
+ Log: fix for bugs in handling DESTROY (adjusted test numbers)
+ Message-Id: <199801010030.TAA14274@aatma.engin.umich.edu>
+ Subject: Re: [PERL] RFD: iterative DESTROYing of objects
+ Date: Wed, 31 Dec 1997 19:30:46 -0500
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Branch: win32/perl
+ ! pod/perlobj.pod sv.c t/op/ref.t
+____________________________________________________________________________
+[ 489] By: gsar on 1998/02/09 00:30:35
+ Log: ansify prototype for my_safemalloc(), avoid warnings
+ Branch: win32/perl
+ ! sv.c
+____________________________________________________________________________
+[ 488] By: gsar on 1998/02/09 00:29:08
+ Log: fix misapplied hunks in 5.004_58
+ Message-Id: <199802080718.CAA18115@aatma.engin.umich.edu>
+ Date: Sun, 08 Feb 1998 02:18:12 EST
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Subject: [PATCH] fixes for test failures in 5.004_58
+ Branch: win32/perl
+ ! gv.c op.c
+____________________________________________________________________________
+[ 487] By: gsar on 1998/02/09 00:27:16
+ Log: win32_utime() tweaks to avoid warnings
+ Branch: win32/perl
+ ! win32/win32.c win32/win32iop.h
+____________________________________________________________________________
+[ 486] By: gsar on 1998/02/07 23:45:22
+ Log: integrate mainline, plus a few small win32 enhancements
+ - remove Win32::GetCurrentDirectory()
+ - add Win32::Sleep() for compat
+ - add smarter utime() from Jan Dubois, and export it as win32_utime()
+ Branch: win32/perl
+ +> ext/POSIX/hints/linux.pl ext/POSIX/hints/sunos_4.pl
+ +> lib/Fatal.pm t/lib/ph.t
+ ! win32/makedef.pl win32/win32.c win32/win32iop.h
+ !> (integrate 61 files)
----------------
-Version 5.003_09
+Version 5.004_58
----------------
-This patch was a compendium of various fixes and enhancements from
-many people, including some serious improvement in lexical variable
-scoping and locale handling.
-
- CORE LANGUAGE CHANGES
-
- Title: "Lexical locales"
- (make effectiveness of locales depend on C<use locale>)
- From: Chip Salzenberg
- Files: too many to list
-
- Title: "Lexical scoping cleanup"
- (tighten scoping of lexical variables, somewhat on the
- new constructs and somewhat on the old)
- From: Chip Salzenberg
- Files: many... but mostly perly.y and toke.c
-
- Title: "Re: memory corruption / security bug in sysread,syswrite + pa
- From: Jarkko Hietaniemi
- Msg-ID: <199611251946.VAA30459@alpha.hut.fi>
- Date: Mon, 25 Nov 1996 21:46:31 +0200 (EET)
- Files: MANIFEST pod/perldiag.pod pod/perlfunc.pod pp_sys.c
- t/op/sysio.t
-
- OTHER CORE CHANGES
-
- Title: "Configure fix for handling DynaLoader"
- From: Chip Salzenberg
- Files: Configure
-
- Title: "Properly prototype safe{malloc,calloc,realloc,free}."
- From: Chip Salzenberg
- Files: proto.h
-
- Title: "UnixWare 2.1 fix for perl5.003_08 - cope with fp->_cnt < -1,
- From: John Hughes <john@AtlanTech.COM>
- Msg-ID: <01BBD6EE.E915C860@malvinas.AtlanTech.COM>
- Date: Wed, 20 Nov 1996 14:27:06 +0100
- Files: sv.c
-
- Title: ""static" call to UNIVERSAL::can"
- From: Nick Ing-Simmons
- Msg-ID: <199611211547.PAA15878@pluto>
- Date: Thu, 21 Nov 1996 15:47:46 GMT
- Files: universal.c
-
- Title: "die -> croak"
- From: Gurusamy Sarathy
- Msg-ID: <199611212111.QAA17070@aatma.engin.umich.edu>
- Date: Thu, 21 Nov 1996 16:11:21 -0500
- Files: pp_ctl.c
-
- Title: "Patch for embed.pl when !EMBED && !MULTIPLICITY"
- From: Chip Salzenberg
- Files: embed.pl
-
- Title: "Add new symbols to old_global.sym, too."
- From: Chip Salzenberg
- Files: global.sym old_global.sym
-
- Title: "Cleanup of {,un}pack('w')."
- From: Chip Salzenberg
- Files: pp.c
-
- Title: "Cleanups from Ilya."
- From: Chip Salzenberg
- Files: gv.c malloc.c pod/perlguts.pod pp_ctl.c
-
- Title: "Fix for unpack('w') on 64-bit systems."
- From: Chip Salzenberg
- Files: pp.c
-
- Title: "Re: LC_NUMERIC support is ready + performance"
- From: Ilya Zakharevich
- Msg-ID: <199611260308.WAA02677@monk.mps.ohio-state.edu>
- Date: Mon, 25 Nov 1996 22:08:27 -0500 (EST)
- Files: sv.c
-
- Title: "Hash key sharing improvements from Ilya."
- From: Chip Salzenberg
- Files: hv.c hv.h proto.h
-
- Title: "Mortal stack pre-allocation from Ilya."
- From: Chip Salzenberg
- Files: pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c
-
- PORTABILITY
-
- Title: "VMS patches post-5.003_08"
- From: Charles Bailey
- Msg-ID: <1996Nov22.181631.1603238@hmivax.humgen.upenn.edu>
- Date: Fri, 22 Nov 1996 18:16:31 -0500 (EST)
- Files: lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_VMS.pm
- lib/ExtUtils/MakeMaker.pm lib/File/Path.pm mg.c pp_ctl.c
- utils/h2xs.PL vms/config.vms vms/descrip.mms
- vms/gen_shrfls.pl vms/genconfig.pl vms/perlvms.pod vms/vms.c
- vms/vmsish.h
-
- Title: "5.003_08: OS/2-specific bugs/enhancements"
- From: Ilya Zakharevich
- Msg-ID: <199611241147.GAA00490@monk.mps.ohio-state.edu>
- Date: Sun, 24 Nov 1996 06:47:25 -0500 (EST)
- Files: README.os2 hints/os2.sh os2/Changes os2/Makefile.SHs
- os2/OS2/PrfDB/PrfDB.pm os2/os2.c
-
- Title: "HP patches didn't make it into _08 (fwd)"
- From: Jeff Okamoto
- Msg-ID: <199611260215.AA100414526@hpcc123.corp.hp.com>
- Date: Mon, 25 Nov 96 18:15:26 PST
- Files: ext/DynaLoader/dl_hpux.xs
-
- Title: "Another HP "patch" that didn't make it (new hints file)"
- From: Jeff Okamoto
- Msg-ID: <199611252116.AA245766577@hpcc123.corp.hp.com>
- Date: Mon, 25 Nov 1996 13:16:17 -0800
- Files: hints/hpux.sh
-
- LIBRARY AND EXTENSIONS
-
- Title: "Elide spurious space in db-hash.t"
- From: Chip Salzenberg
- Files: t/lib/db-hash.t
-
- Title: "Update documentation and warning in I18N::Collate."
- From: Chip Salzenberg
- Files: lib/I18N/Collate.pm
-
- Title: "Fix bitwise op test; clean up a couple of others"
- From: Chip Salzenberg
- Files: t/lib/bigintpm.t t/op/bop.t t/op/overload.t
-
- Title: "minimal timelocal.pl for _09"
- From: Achim Bohnet <ach@rosat.mpe-garching.mpg.de>
- Msg-ID: <9611191854.AA19586@o09.rosat.mpe-garching.mpg.de>
- Date: Tue, 19 Nov 1996 19:54:23 +0100
- Files: lib/Time/Local.pm
-
- Title: "Socket test improvement from Ilya."
- From: Chip Salzenberg
- Files: t/lib/io_sock.t
-
- Title: "Re: blib"
- From: Nick Ing-Simmons
- Msg-ID: <199611230917.JAA00471@ni-s.u-net.com>
- Date: Sat, 23 Nov 1996 09:17:40 GMT
- Files: lib/blib.pm
-
- DOCUMENTATION
-
- Title: "perldiag documentation patch."
- From: Paul Marquess
- Msg-ID: <9611201607.AA12729@claudius.bfsec.bt.co.uk>
- Date: Wed, 20 Nov 96 16:07:28 GMT
- Files: pod/perldiag.pod
-
- Title: "a missing perldiag entry"
- From: Gurusamy Sarathy
- Msg-ID: <199611212024.PAA15758@aatma.engin.umich.edu>
- Date: Thu, 21 Nov 1996 15:24:02 -0500
- Files: pod/perldiag.pod
-
- Title: "perlfunc patch"
- From: Paul Marquess
- Msg-ID: <9611201404.AA12477@claudius.bfsec.bt.co.uk>
- Date: Wed, 20 Nov 96 14:04:08 GMT
- Files: pod/perlfunc.pod
-
- Title: "Patch for pod/perlpod.pod"
- From: "Joseph S. Myers" <jsm28@cam.ac.uk>
- Msg-ID: <Pine.LNX.3.95.961120235016.6666A-100000@hammer.chu.cam.ac.uk
- Date: Wed, 20 Nov 1996 23:54:41 +0000 (GMT)
- Files: pod/perlpod.pod
-
- Title: "Update locale documentation."
- From: Chip Salzenberg
- Files: pod/perli18n.pod
-
- BUNDLED UTILITIES
-
- Title: "Fix type mismatches in x2p's safe{alloc,realloc,free}."
- From: Chip Salzenberg
- Files: x2p/util.c
-
+____________________________________________________________________________
+[ 485] By: mbeattie on 1998/02/06 18:11:47
+ Log: Bump patchlevel to 58.
+ Branch: perl
+ ! patchlevel.h
+____________________________________________________________________________
+[ 484] By: mbeattie on 1998/02/06 18:08:28
+ Log: Fix up problem with gv.c from change 477.
+ Fix up Config.pm use in t/lib/ph.t from change 478.
+ Branch: perl
+ ! gv.c t/lib/ph.t
+____________________________________________________________________________
+[ 483] By: mbeattie on 1998/02/06 17:34:34
+ Log: Integrate win32 branch into mainline
+ Branch: perl
+ !> win32/win32sck.c
+____________________________________________________________________________
+[ 482] By: mbeattie on 1998/02/06 17:26:41
+ Log: lib/Fatal.pm missing from repository
+ Branch: perl
+ + lib/Fatal.pm
+____________________________________________________________________________
+[ 481] By: mbeattie on 1998/02/06 17:24:57
+ Log: Subject: [PATCH] Re: posix::strftime (core dumped)
+ Date: Thu, 5 Feb 1998 13:55:23 -0500 (EST)
+ From: Andy Dougherty <doughera@newton.phys.lafayette.edu>
+ Branch: perl
+ + ext/POSIX/hints/linux.pl ext/POSIX/hints/sunos_4.pl
+ ! MANIFEST hints/linux.sh hints/sunos_4_1.sh t/lib/posix.t
+____________________________________________________________________________
+[ 480] By: mbeattie on 1998/02/06 17:19:52
+ Log: x2p/str.c was missing from list of changed files in change 466
+ Branch: perl
+ ! x2p/str.c
+____________________________________________________________________________
+[ 479] By: mbeattie on 1998/02/06 17:16:54
+ Log: Added t/lib/ph.t to MANIFEST
+ Branch: perl
+ ! MANIFEST
+____________________________________________________________________________
+[ 478] By: mbeattie on 1998/02/06 17:15:38
+ Log: Subject: [PATCH] h2ph.PL
+ Date: Thu, 5 Feb 1998 05:53:54 -0800 (EST)
+ From: kstar@www.chapin.edu (Kurt D. Starsinic)
+ Branch: perl
+ + t/lib/ph.t
+ ! utils/h2ph.PL
+____________________________________________________________________________
+[ 477] By: mbeattie on 1998/02/06 17:10:46
+ Log: Subject: [PATCH] Faster gv_fetchpv() for nested packages
+ Date: 04 Feb 1998 14:49:46 +0100
+ From: Gisle Aas <gisle@aas.no>
+ as modified by
+ From: chip@atlantic.net
+ Date: Wed, 4 Feb 1998 11:46:49 -0500 (EST)
+ Branch: perl
+ ! gv.c
+____________________________________________________________________________
+[ 476] By: mbeattie on 1998/02/06 16:47:03
+ Log: From: Jarkko Hietaniemi <jhi@iki.fi>
+ Subject: [PATCH] almost OK: perl 5.00457 on i386-freebsd-thread 3.0
+ Date: Wed, 4 Feb 1998 12:59:47 +0200 (EET)
+ Subject: Re: [PATCH] 5.004_04 and 5.004_57: Complex.pm and complex.t
+ Date: Thu, 5 Feb 1998 18:08:20 +0200 (EET)
+ Branch: perl
+ ! hints/freebsd.sh lib/Math/Complex.pm t/lib/complex.t
+____________________________________________________________________________
+[ 475] By: mbeattie on 1998/02/06 16:44:57
+ Log: Subject: [PATCH] nomemok
+ Date: Mon, 2 Feb 1998 15:06:50 +0100
+ From: Gisle Aas <gisle@aas.no>
+ Branch: perl
+ ! hv.c
+____________________________________________________________________________
+[ 474] By: mbeattie on 1998/02/06 16:43:46
+ Log: Subject: [PATCH] Benchmark.pm: timethese corrupts $_
+ Date: Sun, 1 Feb 1998 06:46:08 -0500 (EST)
+ From: abigail@fnx.com
+ Branch: perl
+ ! lib/Benchmark.pm
+____________________________________________________________________________
+[ 473] By: mbeattie on 1998/02/06 16:42:53
+ Log: Subject: [PATCH] adding the newSVpvn API function
+ Date: Sat, 31 Jan 1998 06:32:42 +0100
+ From: Matthias Ulrich Neeracher <neeri@iis.ee.ethz.ch>
+ Branch: perl
+ ! embed.h embedvar.h global.sym pod/perlguts.pod pod/perltoc.pod
+ ! proto.h sv.c
+____________________________________________________________________________
+[ 472] By: mbeattie on 1998/02/06 16:35:41
+ Log: Subject: Re: [PATCH] new hints/solaris2.sh (was Re: make check fails 17% of it's tests on Solaris...)
+ Date: 28 Jan 1998 17:40:37 -0800
+ From: Stephen Zander <srz@mckesson.com>
+ Branch: perl
+ ! hints/solaris_2.sh
+____________________________________________________________________________
+[ 471] By: mbeattie on 1998/02/06 16:02:57
+ Log: Subject: [PATCH] Re: 5.004_04 vec() fails with 32-bit values
+ Date: Thu, 15 Jan 1998 11:53:06 +0000
+ From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Branch: perl
+ ! pod/perlguts.pod pp.c t/op/vec.t
+____________________________________________________________________________
+[ 470] By: mbeattie on 1998/02/06 16:01:36
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Subject: 5.004_56: Patch to Tie::Hash and docs
+ Date: Sun, 11 Jan 1998 20:34:05 -0500 (EST)
+ Subject: 5.004_56: Patch to (?{}) quoting + cosmetic
+ Date: Mon, 2 Feb 1998 01:28:46 -0500 (EST)
+ Branch: perl
+ ! lib/Tie/Hash.pm pod/perlfunc.pod pod/perlre.pod regcomp.c
+ ! t/op/misc.t t/op/pat.t toke.c
+____________________________________________________________________________
+[ 469] By: mbeattie on 1998/02/06 15:58:31
+ Log: Subject: Another Array.pm patch
+ Date: Wed, 4 Feb 1998 20:37:03 +0000 (GMT)
+ From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ Branch: perl
+ ! lib/Tie/Array.pm
+____________________________________________________________________________
+[ 468] By: mbeattie on 1998/02/06 15:56:28
+ Log: Subject: documentation patch for 5.004_57
+ Date: Wed, 4 Feb 1998 14:54:13 +0000 (GMT)
+ From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ Branch: perl
+ ! lib/Tie/Array.pm
+____________________________________________________________________________
+[ 467] By: mbeattie on 1998/02/06 15:55:34
+ Log: Subject: 5.004_56: patch for `use Fatal' again
+ Date: Thu, 29 Jan 1998 17:04:28 -0500 (EST)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Branch: perl
+ ! MANIFEST pod/perldiag.pod pod/perlfunc.pod pod/perlmodlib.pod
+ ! pp.c t/comp/proto.t toke.c
+____________________________________________________________________________
+[ 466] By: mbeattie on 1998/02/06 15:53:53
+ Log: Subject: Newer -DLEAKTEST patch
+ Date: Fri, 9 Jan 1998 17:55:09 -0500 (EST)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Branch: perl
+ ! ext/DB_File/DB_File.xs ext/DynaLoader/dl_next.xs
+ ! ext/DynaLoader/dl_vms.xs ext/Opcode/Opcode.xs handy.h hv.c
+ ! perl.c perly.c perly.c.diff perly.fixer pod/perlembed.pod
+ ! pod/perlguts.pod pod/perlrun.pod pod/perltoc.pod pp_hot.c sv.c
+ ! toke.c util.c vms/perly_c.vms x2p/hash.c
+____________________________________________________________________________
+[ 465] By: mbeattie on 1998/02/06 15:46:35
+ Log: More Chip patches (tweaked for _5x). The final one mentioned here
+ (@ARGV with -i) actually went in at change 462 but I failed to
+ add it to the change description:
+ Subject: [PATCH] Fix typo: "FORM{,AT}LINE"
+ Date: Sun, 11 Jan 1998 19:37:17 -0500 (EST)
+ Subject: [PATCH] Fix for C<@x = my @y>
+ Date: Sun, 11 Jan 1998 18:12:16 -0500 (EST)
+ Subject: [PATCH] Fix SEGV on C<*glob{SCALAR,ARRAY}>
+ Date: Thu, 5 Feb 1998 21:30:13 -0500 (EST)
+ Subject: [PATCH] Allow last() to mean last
+ Date: Thu, 5 Feb 1998 21:42:57 -0500 (EST)
+ Subject: [PATCH] Consider @ARGV to be plain files if inplace (-i)
+ Date: Wed, 4 Feb 1998 16:04:47 -0500 (EST)
+ Branch: perl
+ ! op.c perly.c perly.h perly.y sv.c t/op/my.t vms/perly_c.vms
+ ! vms/perly_h.vms
+____________________________________________________________________________
+[ 464] By: mbeattie on 1998/02/06 15:06:18
+ Log: More Chip patches:
+ Subject: [PATCH] Fix SEGV from combining caller and C<package;>
+ Date: Thu, 5 Feb 1998 21:47:50 -0500 (EST)
+ Subject: [PATCH] Fix line numbers after here documents in eval STRING
+ Date: Thu, 5 Feb 1998 21:50:08 -0500 (EST)
+ Subject: [PATCH] Make recursive lexical analysis more robust
+ Date: Thu, 5 Feb 1998 21:57:02 -0500 (EST)
+ Branch: perl
+ ! pp_ctl.c sv.c toke.c
+____________________________________________________________________________
+[ 463] By: mbeattie on 1998/02/06 15:04:17
+ Log: Some more Chip patches (tweaked to match _5x):
+ Subject: [PATCH] Fix empty BLOCK
+ Date: Wed, 4 Feb 1998 16:52:28 -0500 (EST)
+ Subject: [PATCH] fix (\@@) proto
+ Date: Thu, 5 Feb 1998 10:24:29 -0500 (EST)
+ Subject: [PATCH] Cope with lack of args in Fcntl::AUTOLOAD
+ Date: Thu, 5 Feb 1998 21:26:55 -0500 (EST)
+ Subject: [PATCH] Don't fold string comparison under C<use locale>
+ Date: Thu, 5 Feb 1998 21:46:25 -0500 (EST)
+ Branch: perl
+ ! ext/Fcntl/Fcntl.pm op.c t/comp/proto.t toke.c
+____________________________________________________________________________
+[ 462] By: mbeattie on 1998/02/06 14:56:30
+ Log: Some Chip patches (some tweaked to match _5x source):
+ From: Chip Salzenberg <salzench@nielsenmedia.com>
+ Subject: [PATCH] local leakage
+ Date: Tue, 3 Feb 1998 09:16:50 -0500 (EST)
+ Subject: [PATCH] NULs in patterns
+ Date: Wed, 4 Feb 1998 01:33:51 -0500 (EST)
+ Subject: [PATCH] Configure on PerlIO
+ Date: Wed, 4 Feb 1998 01:38:43 -0500 (EST)
+ Subject: [PATCH] Avoid core dump on package alias
+ Date: Wed, 4 Feb 1998 15:38:42 -0500 (EST)
+ Subject: [PATCH] Fix name of $Foo::{'Bar::'}
+ Date: Wed, 4 Feb 1998 16:37:51 -0500 (EST)
+ Branch: perl
+ ! Configure doio.c gv.c op.c pp_ctl.c sv.c t/op/gv.t
+ ! t/op/local.t
+____________________________________________________________________________
+[ 461] By: gsar on 1998/02/04 03:34:36
+ Log: support win32_select(0,0,0,msec) (winsock doesn't)
+ Branch: win32/perl
+ ! win32/win32sck.c
+____________________________________________________________________________
+[ 460] By: gsar on 1998/02/04 00:44:47
+ Log: bug: win32_select() must StartSockets()
+ Branch: win32/perl
+ ! win32/win32sck.c
----------------
-Version 5.003_08
+Version 5.004_57
----------------
-This patch was a compendium of various fixes and enhancements from
-many people. Here are some of the more significant changes.
-
-
- CORE LANGUAGE CHANGES
-
- Title: "Make C<no FOO> fail if C<unimport FOO> fails"
- From: Tim Bunce
- Files: gv.c
-
- Title: "Bitwise op sign rationalization"
- (Make bitwise ops result in unsigned values, unless C<use
- integer> is in effect. Includes initial support for UVs.)
- From: Chip Salzenberg
- Files: op.c opcode.pl pod/perlop.pod pod/perltoc.pod pp.c pp.h
- pp_hot.c proto.h sv.c t/op/bop.t
-
- Title: "Defined scoping for C<my> in control structures"
- (Finally defines semantics of "my" in control expressions,
- like the condition of "if" and "while". In all cases, scope
- of a "my" var extends to the end of the entire control
- structure. Also adds new construct "for my", which
- automatically declares the control variable "my" and limits
- its scope to the loop.)
- From: Chip Salzenberg
- Files: op.c perly.c perly.c.diff perly.h perly.y proto.h toke.c
-
- Title: "Fix ++/-- after int conversion (e.g. 'printf "%d"')"
- (This patch makes Perl correctly ignore SvIVX() if either
- NOK or POK is true, since SvIVX() may be a truncated or
- overflowed version of the real value.)
- From: Chip Salzenberg
- Files: pp.c pp_hot.c sv.c
-
- Title: "Make code match Camel II re: functions that use $_"
- From: Paul Marquess
- Files: opcode.pl
-
- Title: "Provide scalar context on left side of "->""
- From: Chip Salzenberg
- Files: perly.c perly.y
-
- Title: "Quote bearword package/handle FOO in "funcname FOO => 'bar'""
- From: Chip Salzenberg
- Files: toke.c
-
-
- OTHER CORE CHANGES
-
- Title: "Warn on overflow of octal and hex integers"
- From: Chip Salzenberg
- Files: proto.h toke.c util.c
-
- Title: "If -w active, warn for commas and hashes ('#') in qw()"
- From: Chip Salzenberg
- Files: toke.c
-
- Title: "Fixes for pack('w')"
- From: Ulrich Pfeifer
- Files: pp.c t/op/pack.t
-
- Title: "More complete output from sv_dump()"
- From: Gurusamy Sarathy
- Files: sv.c
-
- Title: "Major '..' and debugger patches"
- From: Ilya Zakharevich
- Files: lib/perl5db.pl op.c pp_ctl.c scope.c scope.h
-
- Title: "Fix for formline()"
- From: Gurusamy Sarathy
- Files: global.sym mg.c perl.h pod/perldiag.pod pp_ctl.c proto.h sv.c
- t/op/write.t
-
- Title: "Fix stack botch in untie and binmode"
- From: Gurusamy Sarathy
- Files: pp_sys.c
-
- Title: "Complete EMBED, including symbols from interp.sym"
- (New define EMBEDMYMALLOC makes embedding total by
- avoiding "Mymalloc" etc.)
- From: Chip Salzenberg
- Files: MANIFEST embed.pl ext/DynaLoader/dlutils.c
- ext/SDBM_File/sdbm/sdbm.h global.sym handy.h malloc.c
- perl.h pp_sys.c proto.h regexec.c toke.c util.c
- x2p/Makefile.SH x2p/a2p.h x2p/handy.h x2p/util.h
-
- Title: "Support old embedding for people who want it"
- From: Chip Salzenberg
- Files: MANIFEST Makefile.SH old_embed.pl old_global.sym
-
-
- PORTABILITY
-
- Title: "Miscellaneous VMS fixes"
- From: Charles Bailey
- Files: lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_VMS.pm
- lib/Math/Complex.pm lib/Time/Local.pm lib/timelocal.pl
- perl.h perl_exp.SH proto.h t/TEST t/io/read.t
- t/lib/findbin.t t/lib/getopt.t util.c utils/h2xs.PL
- vms/Makefile vms/config.vms vms/descrip.mms
- vms/ext/Stdio/Stdio.pm vms/ext/Stdio/Stdio.xs
- vms/perlvms.pod vms/test.com vms/vms.c
-
- Title: "DJGPP patches (MS-DOS)"
- From: "Douglas E. Wegscheid" <wegscd@whirlpool.com>
- Files: doio.c dosish.h ext/SDBM_File/sdbm/sdbm.c handy.h
- lib/AutoSplit.pm lib/Cwd.pm lib/File/Find.pm malloc.c perl.c
- perl.h pp_sys.c proto.h sv.c util.c
-
- Title: "Plan 9 update"
- From: Luther Huffman <lutherh@infinet.com>
- Files: plan9/buildinfo plan9/config.plan9 plan9/exclude
- plan9/genconfig.pl plan9/mkfile plan9/setup.rc
-
- Title: "Patch to make Perl work under AmigaOS"
- From: Norbert Pueschel
- Files: MANIFEST hints/amigaos.sh installman lib/File/Basename.pm
- lib/File/Find.pm pod/pod2man.PL pp_sys.c util.c
-
- LIBRARY AND EXTENSIONS
-
- Title: "DB_File 1.05"
- From: Paul Marquess
- Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs t/lib/db-hash.t
-
- Title: "Getopts::Std patch for hash support"
- From: Stephen Zander <stephen.zander@interlock.mckesson.com>
- Files: lib/Getopt/Std.pm
-
- Title: "Kludge for bareword handles"
- (Add 'require IO::Handle' at beginning of FileHandle.pm)
- From: Chip Salzenberg
- Files: ext/FileHandle/FileHandle.pm
-
- Title: "Re: strtod / strtol patch for POSIX module"
- From: hammen@gothamcity.jsc.nasa.gov (David Hammen)
- Files: Configure config_h.SH ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod
- ext/POSIX/POSIX.xs t/lib/posix.t
-
- BUNDLED UTILITIES
-
- Title: "Fix a2p translation of '{print "a" "b" "c"}'"
- From: Chip Salzenberg
- Files: x2p/a2p.c x2p/a2p.y
-
+____________________________________________________________________________
+[ 459] By: mbeattie on 1998/02/03 16:00:07
+ Log: Replaced two occurrences of THREADSV(find_thread_sv(...)) (order
+ of execution causes core dump if threadsvp is moved). Replaced
+ lvalue occurrence of AvARRAY(av) with SvPVX(av) (former does cast).
+ Branch: perl
+ ! av.c perl.c
+____________________________________________________________________________
+[ 458] By: mbeattie on 1998/02/03 14:40:02
+ Log: Fix up MANIFEST.
+ Branch: perl
+ ! MANIFEST
+____________________________________________________________________________
+[ 457] By: mbeattie on 1998/02/03 13:50:23
+ Log: Integrate win32 into mainline. My last integration from ansiperl
+ to the mainline was a dismal failure: I did -ay but meant -at.
+ This should fix things now since win32 has already integrated
+ all the necessary changes from ansiperl.
+ Branch: perl
+ !> (integrate 111 files)
+____________________________________________________________________________
+[ 456] By: gsar on 1998/02/03 04:48:08
+ Log: Fix minor problems with non USE_THREADS build. win32 branch
+ now looks 5.004_57-ready.
+ Branch: win32/perl
+ ! thread.h win32/makedef.pl
+____________________________________________________________________________
+[ 455] By: gsar on 1998/02/03 03:45:09
+ Log: integrate mainline
+ Branch: win32/perl
+ !> (integrate 887 files)
+____________________________________________________________________________
+[ 454] By: mbeattie on 1998/02/02 16:44:24
+ Log: The new dec_osf.sh didn't work so the new glibpth and useshrplib
+ defaults have been commented out for now.
+ Branch: perl
+ ! hints/dec_osf.sh
+____________________________________________________________________________
+[ 453] By: mbeattie on 1998/02/02 15:51:39
+ Log: Introduced thr->threadsvp and THREADSV() for faster per-thread
+ variables. Moved threadnum to a per-interpreter variable and
+ made dTHR and lock/unlock of sv_mutex bypass the get/lock unless
+ more than one thread may be running. Minor tweaks to Thread.xs.
+ Branch: perl
+ ! dosish.h embedvar.h ext/Thread/Thread.xs interp.sym intrpvar.h
+ ! op.c perl.c perl.h pp.c pp_ctl.c scope.c sv.c thrdvar.h
+ ! thread.h util.c
+____________________________________________________________________________
+[ 452] By: gsar on 1998/02/02 04:56:50
+ Log: remove totally egregious s/\\dir// in File::Find
+ Branch: win32/perl
+ ! lib/File/Find.pm
+____________________________________________________________________________
+[ 451] By: gsar on 1998/02/01 22:20:20
+ Log: added AS patch#3
+ Message-Id: <01BD2EF2.53433A40.dougl@ActiveState.com>
+ Date: Sun, 01 Feb 1998 09:18:13 PST
+ From: Douglas Lankshear <dougl@ActiveState.com>
+ To: "'Gurusamy Sarathy'" <gsar@umich.edu>
+
+ Here's an additional diff against //depot/asperl
+
+ The field name mg_length was changed back to mg_len
+ The function name mg_len was change to mg_length
+
+ The need for sort_mutex removed thanks to the code derived
+ from Tom Horsley's work.
+
+ -- Doug
+ Branch: asperl
+ + XSLock.h
+ ! ObjXSub.h XSUB.h av.c embedvar.h ext/DynaLoader/dlutils.c
+ ! globals.c ipstdio.h mg.c mg.h objpp.h perl.c perl.h perlio.h
+ ! perlvars.h perly.c pp.c pp_ctl.c pp_hot.c proto.h regexec.c
+ ! scope.c scope.h sv.c toke.c universal.c util.c
+ ! win32/dl_win32.xs win32/iplio.c win32/ipstdio.c
+ ! win32/perlobj.def win32/runperl.c
+____________________________________________________________________________
+[ 450] By: gsar on 1998/01/30 23:43:57
+ Log: various tweaks
+ - add new functions to proto.h
+ - fix up makefile.mk for $(OBJECT)
+ Branch: asperl
+ ! pp_ctl.c proto.h win32/makefile.mk
+____________________________________________________________________________
+[ 449] By: gsar on 1998/01/30 21:23:15
+ Log: fix up missing patches from AS patch#2
+ Branch: asperl
+ ! perldir.h perlenv.h perllio.h perlmem.h perlproc.h perlsock.h
+ ! pp_ctl.c proto.h
+____________________________________________________________________________
+[ 448] By: gsar on 1998/01/30 18:23:17
+ Log: fix htonlx typo
+ Branch: win32/perl
+ ! perlsock.h
+____________________________________________________________________________
+[ 447] By: mbeattie on 1998/01/30 16:03:49
+ Log: Fix up MANIFEST to add missing files
+ Branch: perl
+ ! MANIFEST
+____________________________________________________________________________
+[ 446] By: mbeattie on 1998/01/30 12:34:55
+ Log: Bump patchlevel to 57.
+ Branch: perl
+ ! patchlevel.h
+____________________________________________________________________________
+[ 445] By: gsar on 1998/01/30 10:44:38
+ Log: initial merge of latest win32 branch into ASPerl
+ Branch: asperl
+ +> lib/Tie/Array.pm pod/perlhist.pod t/lib/tie-push.t
+ +> t/lib/tie-stdarray.t t/lib/tie-stdpush.t t/op/tiearray.t
+ +> win32/bin/perlglob.pl
+ !> (integrate 141 files)
+____________________________________________________________________________
+[ 444] By: gsar on 1998/01/30 09:25:58
+ Log: goofed branching, redo asperl branch
+ Branch: asperl
+ ! perl.h
+____________________________________________________________________________
+[ 443] By: gsar on 1998/01/30 09:23:36
+ Log: added AS patch#2
+ Branch: asperl
+ + ObjXSub.h ipdir.h ipenv.h iplio.h ipmem.h ipproc.h ipsock.h
+ + ipstdio.h objpp.h win32/ipdir.c win32/ipenv.c win32/iplio.c
+ + win32/ipmem.c win32/ipproc.c win32/ipsock.c win32/ipstdio.c
+ + win32/ipstdiowin.h win32/perlobj.def
+ ! EXTERN.h XSUB.h cv.h doio.c dosish.h dump.c embedvar.h
+ ! globals.c gv.c hv.c intrpvar.h malloc.c mg.c mg.h op.c op.h
+ ! opcode.h perl.c perl.h perldir.h perlenv.h perlio.h perllio.h
+ ! perlmem.h perlproc.h perlsock.h perlvars.h perly.c pp.c pp.h
+ ! pp_ctl.c pp_hot.c pp_sys.c proto.h regcomp.c regcomp.h
+ ! regexec.c run.c scope.c scope.h sv.c sv.h thread.h toke.c
+ ! universal.c util.c vms/vms.c win32/Makefile win32/config_H.bc
+ ! win32/config_H.vc win32/dl_win32.xs win32/include/sys/socket.h
+ ! win32/makedef.pl win32/runperl.c win32/win32iop.h
+____________________________________________________________________________
+[ 441] By: gsar on 1998/01/30 08:54:19
+ Log: Created new branch from win32@396, added AS patch#1
+ Branch: asperl
+ + doio.c malloc.c perl.c perl.h perldir.h perlenv.h perllio.h
+ + perlmem.h perlproc.h perlsock.h pp.c pp_hot.c pp_sys.c
+ + regcomp.c scope.h sv.c toke.c util.c
+ +> (branch 915 files)
+____________________________________________________________________________
+[ 440] By: gsar on 1998/01/30 04:43:23
+ Log: integrate winansi
+ Branch: win32/perl
+ +> pod/perlhist.pod
+ !> MANIFEST av.c hv.c op.c perlsock.h pp_ctl.c pp_sys.c scope.c
+ !> util.c
+____________________________________________________________________________
+[ 439] By: mbeattie on 1998/01/27 15:31:53
+ Log: Integrate ansi branch into mainline (resolve -ay).
+ Branch: perl
+ +> lib/Tie/Array.pm perldir.h perlenv.h perllio.h perlmem.h
+ +> perlproc.h perlsock.h pod/perlhist.pod t/lib/tie-push.t
+ +> t/lib/tie-stdarray.t t/lib/tie-stdpush.t t/op/tiearray.t
+ +> win32/bin/perlglob.pl
+ ! op.c
+ !> (integrate 868 files)
+____________________________________________________________________________
+[ 438] By: nick on 1998/01/24 12:02:34
+ Log: Gisle's av_unshift tweak, two small patches from chip
+ and check for NULL in hv_delete in case '~' and tie magic
+ are present
+ Branch: ansiperl
+ ! av.c hv.c op.c pp_ctl.c scope.c
+____________________________________________________________________________
+[ 437] By: nick on 1998/01/24 10:37:56
+ Log: Get PerlXxx_yyyy() macro stuff to _compile_ on Solaris.
+ Ugh! ...
+ Macros were unsuitable for declaring the functions, extra () round
+ parameters removed - non-function forms of PerlXxx_yyyy() need to
+ add () themselves.
+ Need to include perlmem.h in util.c (at least) if not using Perl's malloc.
+ Branch: ansiperl
+ ! perlsock.h pp_sys.c util.c
+____________________________________________________________________________
+[ 436] By: nick on 1998/01/24 10:03:03
+ Log: Integrate win32 into ansiperl
+ Branch: ansiperl
+ +> perldir.h perlenv.h perllio.h perlmem.h perlproc.h perlsock.h
+ +> win32/bin/perlglob.pl
+ !> (integrate 38 files)
+____________________________________________________________________________
+[ 435] By: nick on 1998/01/24 09:47:49
+ Log: Add perlhist.pod
+ Branch: ansiperl
+ + pod/perlhist.pod
+ ! MANIFEST
+____________________________________________________________________________
+[ 434] By: gsar on 1998/01/19 05:01:47
+ Log: s/PerlENV/PerlEnv/ just to be consistent
+ Branch: win32/perl
+ ! malloc.c perl.c perlenv.h regcomp.c toke.c util.c
+____________________________________________________________________________
+[ 433] By: gsar on 1998/01/19 04:52:18
+ Log: foo() -> PerlGroup_foo() patch from ActiveState
+ Branch: win32/perl
+ + perldir.h perlenv.h perllio.h perlmem.h perlproc.h perlsock.h
+ ! doio.c malloc.c perl.c perl.h pp.c pp_hot.c pp_sys.c regcomp.c
+ ! scope.h sv.c toke.c util.c
+____________________________________________________________________________
+[ 432] By: gsar on 1998/01/19 04:42:26
+ Log: integrate mainline
+ Branch: win32/perl
+ !> pod/perlfunc.pod
+____________________________________________________________________________
+[ 431] By: gsar on 1998/01/19 04:40:04
+ Log: integrate changes in winansi
+ Branch: win32/perl
+ +> lib/Tie/Array.pm t/lib/tie-push.t t/lib/tie-stdarray.t
+ +> t/lib/tie-stdpush.t t/op/tiearray.t
+ !> (integrate 98 files)
+____________________________________________________________________________
+[ 430] By: gsar on 1998/01/19 04:10:43
+ Log: Fix autovivification problems with XSUB OUTPUT args
+ Message-Id: <199801190409.XAA26710@aatma.engin.umich.edu>
+ Date: Sun, 18 Jan 1998 23:09:07 EST
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Subject: [PATCH] XSUB OUTPUT arguments and 'set' magic
+ Branch: win32/perl
+ ! ext/GDBM_File/typemap ext/NDBM_File/typemap
+ ! ext/ODBM_File/typemap ext/SDBM_File/typemap
+ ! lib/ExtUtils/typemap os2/OS2/PrfDB/typemap pod/perlguts.pod
+ ! pod/perlxs.pod pod/perlxstut.pod sv.c sv.h win32/win32.h
+____________________________________________________________________________
+[ 429] By: nick on 1998/01/17 21:01:50
+ Log: Subject: [PATCH] 5.004_56 threaded and "CONFIG key 'exe_ext' does not exist in Config.pm"
+ Date: Thu, 25 Dec 1997 13:39:15 -0500
+ From: Spider Boardman <spider@Orb.Nashua.NH.US>
+ To: perl5-porters@perl.org
+
+ It turns out that the potential for the "CONFIG key 'exe_ext'
+ does not exist in Config.pm" problem has been around for a while,
+ in the definition of SvTRUE(). It's just that non-gcc compilers
+ are more or less being built as CRIPPLED_CC when USE_THREADS is
+ defined (even if they can inline things). The inline macro for
+ SvTRUE works with tied hashes and the EXISTS method, and the
+ functional version (sv_true in 5.004_56, or SvTRUE in 5.004_04)
+ does not, because it adds an excess mg_get() which replaces the
+ EXISTS result with a FETCH result.
+ Branch: ansiperl
+ ! sv.c
+____________________________________________________________________________
+[ 428] By: nick on 1998/01/17 20:59:11
+ Log: From: Robin Barker <rmb1@cise.npl.co.uk>
+ Date: Fri, 19 Dec 97 17:19:09 GMT
+ Message-Id: <26260.9712191719@lightning.cise.npl.co.uk>
+ Branch: ansiperl
+ ! doio.c sv.c toke.c util.c
+____________________________________________________________________________
+[ 427] By: nick on 1998/01/17 12:01:53
+ Log: Permit tie ?foo,$object
+ tidy up dead #ifdef ORIGINAL_TIE)
+ Remove 'P' magic from hash, before adding new one in dbm_open like tie does.
+ Branch: ansiperl
+ ! pp_sys.c
+____________________________________________________________________________
+[ 426] By: nick on 1998/01/15 18:06:36
+ Log: First working TIEARRAY and other misc tie fixes
+ Branch: ansiperl
+ ! MANIFEST pp.c pp_hot.c t/op/tiearray.t
+____________________________________________________________________________
+[ 425] By: nick on 1998/01/14 21:56:40
+ Log: Not working yet - split problems ...
+ Branch: ansiperl
+ ! pp.c t/lib/thread.t t/op/tiearray.t
+____________________________________________________________________________
+[ 424] By: nick on 1998/01/14 18:49:25
+ Log: TIEARRAY updates - almost works ...
+ Branch: ansiperl
+ + t/lib/tie-push.t t/lib/tie-stdarray.t t/lib/tie-stdpush.t
+ ! MANIFEST av.c av.h ext/DB_File/DB_File.pm lib/Tie/Array.pm
+ ! mg.c pod/perltie.pod pp.c pp_hot.c pp_sys.c scope.c
+ ! t/op/avhv.t t/op/push.t t/op/tiearray.t
+____________________________________________________________________________
+[ 423] By: gsar on 1998/01/14 00:13:16
+ Log: fix MakeMaker installbin problem
+ Message-Id: <199801070016.TAA17766@aatma.engin.umich.edu>
+ Subject: Re: can't modify message with HTML-Stream, v.1.42
+ Date: Tue, 06 Jan 1998 19:16:35 -0500
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Branch: win32/perl
+ ! lib/ExtUtils/MM_Unix.pm
+____________________________________________________________________________
+[ 422] By: gsar on 1998/01/13 23:53:02
+ Log: add archname to *sitearch in config.{b,g,v}c
+ Branch: win32/perl
+ ! win32/config.bc win32/config.gc win32/config.vc
+____________________________________________________________________________
+[ 421] By: gsar on 1998/01/13 23:15:14
+ Log: set $ENV{PERL5LIB} in t/harness (so child perlglob.bat sees it)
+ Branch: win32/perl
+ ! t/harness
+____________________________________________________________________________
+[ 420] By: nick on 1998/01/13 22:55:02
+ Log: tiearray tweaks
+ Branch: ansiperl
+ ! av.c pp_sys.c t/op/nothread.t t/op/tiearray.t
+____________________________________________________________________________
+[ 419] By: nick on 1998/01/13 21:27:33
+ Log: Skeleton Tie::Array
+ Branch: ansiperl
+ + lib/Tie/Array.pm
+____________________________________________________________________________
+[ 418] By: nick on 1998/01/13 20:52:38
+ Log: tie array changes to core and tests
+ Branch: ansiperl
+ + t/op/tiearray.t
+ ! MANIFEST av.c av.h deb.c embed.h ext/DB_File/DB_File.pm
+ ! global.sym gv.c mg.c op.c perl.c perl.h pp.c pp.h pp_ctl.c
+ ! pp_hot.c proto.h sv.c toke.c universal.c util.c
+____________________________________________________________________________
+[ 417] By: gsar on 1998/01/13 20:49:52
+ Log: fix perlglob.bat warnings by splitting it from File::DosGlob
+ Branch: win32/perl
+ + win32/bin/perlglob.pl
+ ! MANIFEST README.win32 lib/File/DosGlob.pm win32/Makefile
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 416] By: gsar on 1998/01/13 02:46:53
+ Log: various tweaks to build support (NOTE: meant for 5.004_57)
+ - build and install x2p
+ - fix installperl warnings on win32
+ - `make install` now does puts the archlibs in right places
+ - makefiles don't default to USE_THREADS anymore
+ - sync config.{b,g,v}c
+ - sync makefile.mk -> Makefile
+ Branch: win32/perl
+ ! installperl win32/Makefile win32/config.bc win32/config.gc
+ ! win32/config.vc win32/config_sh.PL win32/makefile.mk x2p/a2p.h
+ ! x2p/a2py.c
+____________________________________________________________________________
+[ 415] By: nick on 1998/01/11 16:54:26
+ Log: Integrate win32 into ansiperl
+ Branch: ansiperl
+ !> Configure hints/dec_osf.sh hv.c lib/Getopt/Long.pm lib/blib.pm
+ !> lib/newgetopt.pl perl.h perl_exp.SH pp_ctl.c pp_hot.c pp_sys.c
+ !> proto.h regcomp.h regexec.c t/op/re_tests t/pragma/locale.t
+ !> utils/perldoc.PL vms/config.vms vms/descrip.mms
+ !> vms/gen_shrfls.pl vms/genconfig.pl vms/perly_c.vms vms/vms.c
+ !> vms/vmsish.h x2p/s2p.PL
+____________________________________________________________________________
+[ 414] By: nick on 1998/01/11 15:13:49
+ Log: Integratye mainline -> ansiperl
+ Branch: ansiperl
+ !> (integrate 64 files)
+____________________________________________________________________________
+[ 413] By: mbeattie on 1998/01/09 12:57:58
+ Log: Add missing blank line in pod/perlfunc.pod.
+ Branch: perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 412] By: gsar on 1998/01/08 20:54:31
+ Log: change#398 breaks ENV_IS_CASELESS, fix it
+ Branch: win32/perl
+ ! hv.c
+____________________________________________________________________________
+[ 411] By: gsar on 1998/01/08 18:33:58
+ Log: Integrate mainline
+ Branch: win32/perl
+ !> Configure hints/dec_osf.sh hv.c lib/Getopt/Long.pm lib/blib.pm
+ !> lib/newgetopt.pl perl.h perl_exp.SH pp_ctl.c pp_hot.c pp_sys.c
+ !> proto.h regcomp.h regexec.c t/op/re_tests t/pragma/locale.t
+ !> utils/perldoc.PL vms/config.vms vms/descrip.mms
+ !> vms/gen_shrfls.pl vms/genconfig.pl vms/perly_c.vms vms/vms.c
+ !> vms/vmsish.h x2p/s2p.PL
+____________________________________________________________________________
+[ 410] By: mbeattie on 1998/01/08 16:06:22
+ Log: Fix thinko in t/pragma/locale.t:
+ Subject: [PATCH] _04 or _56: locale.t
+ Date: Sun, 4 Jan 1998 23:48:44 +0200 (EET)
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Branch: perl
+ ! t/pragma/locale.t
+____________________________________________________________________________
+[ 409] By: mbeattie on 1998/01/08 16:05:09
+ Log: Use Tom Horley's qsort for sorting:
+ Subject: Re: [PATCH for 5.004_56] Re: op/sort.t hangs under Solaris 2.5
+ Date: Fri, 02 Jan 1998 19:33:24 -0500 (EST)
+ From: Hans Mulder <hansm@icgned.nl>
+ Branch: perl
+ ! pp_ctl.c
+____________________________________________________________________________
+[ 408] By: mbeattie on 1998/01/08 16:01:57
+ Log: Make s2p not use cpp:
+ Subject: [PATCH for 5.004_56] s2p shouldn't use cpp
+ Date: Mon, 29 Dec 1997 19:38:18 -0500 (EST)
+ From: Hans Mulder <hansm@icgned.nl>
+ Branch: perl
+ ! x2p/s2p.PL
+____________________________________________________________________________
+[ 407] By: mbeattie on 1998/01/08 15:57:31
+ Log: DG/UX tweaks to perl.h:
+ Subject: [PATCH] _56 on dgux without threads
+ Date: Sat, 20 Dec 1997 23:01:40 -0500
+ From: Roderick Schertler <roderick@argon.org>
+ Branch: perl
+ ! perl.h
+____________________________________________________________________________
+[ 406] By: mbeattie on 1998/01/08 15:56:02
+ Log: Configure and hints/dec_osf.sh changes for Digital UNIX:
+ Subject: [PATCH] perl5.004_56 NOT OK on alpha-dec_osf-thread (Digital UNIX X5.0-13)
+ Date: Sat, 20 Dec 1997 02:30:01 -0500
+ From: Spider Boardman <spider@web.zk3.dec.com>
+ Branch: perl
+ ! Configure hints/dec_osf.sh
+____________________________________________________________________________
+[ 405] By: mbeattie on 1998/01/08 15:53:40
+ Log: Missing "" in Configure echo for gethbadd_addr_type.
+ Branch: perl
+ ! Configure
+____________________________________________________________________________
+[ 404] By: mbeattie on 1998/01/08 13:04:48
+ Log: print/printf/... over-eager mg_find for glob magic:
+ Subject: [PATCH] fix inefficient checks for TIEHANDLE
+ Date: Wed, 07 Jan 1998 20:06:05 -0500
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Branch: perl
+ ! pp_hot.c pp_sys.c
+____________________________________________________________________________
+[ 403] By: mbeattie on 1998/01/08 12:56:31
+ Log: Assorted VMS patches (mostly VMS makefile update for new headers):
+ Subject: [PATCH] VMS update for 5.004_56
+ Date: Sat, 03 Jan 1998 03:54:29 -0500 (EST)
+ From: Charles Bailey <bailey@newman.upenn.edu>
+ Branch: perl
+ ! lib/blib.pm proto.h regcomp.h vms/config.vms vms/descrip.mms
+ ! vms/gen_shrfls.pl vms/genconfig.pl vms/perly_c.vms vms/vms.c
+ ! vms/vmsish.h
+____________________________________________________________________________
+[ 402] By: mbeattie on 1998/01/08 12:46:15
+ Log: Fix utils/perldoc.PL for dos-djgpp:
+ Subject: 5.004_56: perldoc.PL dos-djgpp patches
+ Date: Tue, 6 Jan 1998 18:14:59 +0100
+ From: Molnar Laszlo <molnarl@cdata.tvnet.hu>
+ Branch: perl
+ ! utils/perldoc.PL
+____________________________________________________________________________
+[ 401] By: mbeattie on 1998/01/08 12:40:14
+ Log: Version 2.13 of GetoptLong:
+ Subject: Re: ANNOUNCE: perl 5.004_56 is available
+ Date: 06 Jan 1998 16:21:45 +0100
+ From: JVromans@Squirrel.nl (Johan Vromans)
+ Branch: perl
+ ! lib/Getopt/Long.pm lib/newgetopt.pl
+____________________________________________________________________________
+[ 400] By: mbeattie on 1998/01/08 12:28:08
+ Log: Fix variable export and threading configuration for AIX:
+ Subject: [PATCH] 5.004_56: AIX 4.1.5.0: sans et avec threads
+ Date: Tue, 23 Dec 1997 15:39:12 +0200 (EET)
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Branch: perl
+ ! Configure perl_exp.SH
+____________________________________________________________________________
+[ 399] By: mbeattie on 1998/01/08 12:25:38
+ Log: Regexp fix: (?>a+)b doesn't match aaab:
+ Subject: Re: Regexp [PATCH] 5.004_56 (?>...)
+ Date: Fri, 19 Dec 1997 16:02:50 -0500 (EST)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Branch: perl
+ ! regexec.c t/op/re_tests
+____________________________________________________________________________
+[ 398] By: mbeattie on 1998/01/08 12:23:41
+ Log: Fix hv_delete for 'm'-magic. Based on following patch, modified
+ to cope with ENV_IS_CASELESS:
+ Subject: [perl5.004_56] [PATCH] hv_delete and 'm' magic
+ Date: Fri, 19 Dec 1997 11:31:36 -0500
+ From: Owen Taylor <owt1@cornell.edu>
+ Branch: perl
+ ! hv.c
+____________________________________________________________________________
+[ 397] By: mbeattie on 1998/01/08 12:10:29
+ Log: Integrate win32 branch into mainline.
+ Branch: perl
+ !> (integrate 41 files)
+____________________________________________________________________________
+[ 396] By: gsar on 1998/01/07 19:12:27
+ Log: tweak case-insensitive ENV implementation
+ Branch: win32/perl
+ ! hv.c
+____________________________________________________________________________
+[ 395] By: nick on 1998/01/07 18:40:55
+ Log: Integrate win32 branch
+ Branch: ansiperl
+ !> (integrate 31 files)
+____________________________________________________________________________
+[ 394] By: gsar on 1998/01/05 19:17:40
+ Log: Allow $ENV{PERL5SHELL} to contain switches etc., and document
+ the fact
+ Branch: win32/perl
+ ! pod/perlrun.pod win32/win32.c
+____________________________________________________________________________
+[ 393] By: gsar on 1998/01/05 05:43:33
+ Log: Support case-tolerant %ENV
+ - underlying system calls see the case-as-supplied by user
+ - added tests to verify addition/deletion/enumeration case-tolerance
+ - hv.c touched, but changes are fully conditional on -DENV_IS_CASELESS,
+ which is default on win32 now
+ Branch: win32/perl
+ ! hv.c t/op/magic.t win32/win32.h
+____________________________________________________________________________
+[ 392] By: gsar on 1998/01/04 17:55:19
+ Log: Add a tweaked version of:
+ Message-Id: <199801040630.AA29298@metronet.com>
+ Date: Sun, 04 Jan 1998 00:30:57 CST
+ From: Tye McQueen <tye@metronet.com>
+ Subject: New patch for $^E==GetLastError() under Win32
+ Branch: win32/perl
+ ! doio.c lib/dumpvar.pl lib/perl5db.pl mg.c perl.h
+ ! pod/perlfunc.pod pod/perlvar.pod util.c win32/makedef.pl
+ ! win32/win32.c win32/win32.h
+____________________________________________________________________________
+[ 391] By: gsar on 1998/01/04 07:59:44
+ Log: Various win32 fixes
+ - support spawn via system(&P_NOWAIT,...) like OS2
+ - support wait() and waitpid()
+ - s/GetCurrentDirectory/GetCwd/, long-named XS to be removed
+ - support -lfoo properly in ExtUtils::Liblist
+ - fix outdated info about Win32 support in perlfaq2
+ - fix win32 bug in perldoc that causes spurious warnings
+ - regularize global function/variable names yet more
+ - fix bug in do_aspawn() (it was always invoking shell, instead of
+ almost never)
+ - implement and export win32_wait()
+ - stub version of USE_RTL_THREAD_API
+ Branch: win32/perl
+ ! README.win32 dosish.h lib/Cwd.pm lib/ExtUtils/Liblist.pm
+ ! pod/perlfaq2.pod pp_sys.c util.c utils/perldoc.PL
+ ! win32/config_H.bc win32/config_H.gc win32/config_H.vc
+ ! win32/config_h.PL win32/perllib.c win32/win32.c win32/win32.h
+ ! win32/win32iop.h win32/win32sck.c win32/win32thread.c
+ ! win32/win32thread.h
+____________________________________________________________________________
+[ 390] By: gsar on 1997/12/30 21:00:28
+ Log: Fix $ENV{Path} in FindBin.pm
+ Branch: win32/perl
+ ! lib/FindBin.pm
+____________________________________________________________________________
+[ 389] By: nick on 1997/12/29 10:33:23
+ Log: Resolve ansiperl against win32
+ Branch: ansiperl
+ !> (integrate 105 files)
+____________________________________________________________________________
+[ 388] By: gsar on 1997/12/24 04:59:28
+ Log: make $? Unix (and ActiveWare) compatible
+ Branch: win32/perl
+ ! README.win32 win32/win32.c
+____________________________________________________________________________
+[ 387] By: gsar on 1997/12/24 04:21:30
+ Log: support ioctl() on sockets (does what ioctlsocket() does) to make
+ non-blocking IO on sockets possible
+ Branch: win32/perl
+ ! README.win32 dosish.h win32/makedef.pl win32/win32.c
+ ! win32/win32iop.h win32/win32sck.c
+____________________________________________________________________________
+[ 386] By: gsar on 1997/12/24 03:10:55
+ Log: support getlogin()
+ Branch: win32/perl
+ ! README.win32 win32/config.bc win32/config.gc win32/config.vc
+ ! win32/config_H.bc win32/config_H.gc win32/config_H.vc
+ ! win32/win32.c win32/win32.h
+____________________________________________________________________________
+[ 385] By: gsar on 1997/12/24 02:24:59
+ Log: add support for crypt() via user-supplied des_fcrypt() source or library.
+ Update README.win32.
+ Branch: win32/perl
+ ! README.win32 perl.h win32/Makefile win32/makedef.pl
+ ! win32/makefile.mk win32/win32.c win32/win32.h win32/win32iop.h
+____________________________________________________________________________
+[ 384] By: gsar on 1997/12/24 02:22:42
+ Log: tweak op.c to avoid warning
+ Branch: win32/perl
+ ! op.c
+____________________________________________________________________________
+[ 383] By: gsar on 1997/12/23 21:12:42
+ Log: Trivial bugfix#3 from local repository
+ Message-Id: <199712061100.GAA14864@aatma.engin.umich.edu>
+ Subject: Re: Assigning result of pop scrambles unrelated reference
+ Date: Sat, 06 Dec 1997 06:00:45 -0500
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Branch: win32/perl
+ ! sv.c
+____________________________________________________________________________
+[ 382] By: gsar on 1997/12/23 21:09:32
+ Log: Trivial bugfix#2 from local repository
+ Message-Id: <199712061025.FAA14396@aatma.engin.umich.edu>
+ Subject: Re: eval of sub gives spurious "uninitialised" warning
+ Date: Sat, 06 Dec 1997 05:25:07 -0500
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Branch: win32/perl
+ ! op.c pod/perldelta.pod pod/perlfunc.pod t/op/eval.t
+____________________________________________________________________________
+[ 381] By: gsar on 1997/12/23 21:01:04
+ Log: Trivial bugfix#1 from local repository
+ Message-Id: <199711282326.SAA15090@aatma.engin.umich.edu>
+ Subject: [PATCH] Re: [5.004_04 BUG] bless broke scoping?
+ Date: Fri, 28 Nov 1997 18:26:52 -0500
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Branch: win32/perl
+ ! scope.c
+____________________________________________________________________________
+[ 380] By: gsar on 1997/12/18 15:10:23
+ Log: Integrate mainline
+ Branch: win32/perl
+ +> README.dos djgpp/config.over djgpp/configure.bat djgpp/djgpp.c
+ +> djgpp/djgppsed.sh djgpp/fixpmain hints/dos_djgpp.sh
+ +> os2/os2.sym os2/os2thread.h
+ !> (integrate 77 files)
----------------
-Version 5.003_07
+Version 5.004_56
----------------
-This patch was primarily to fix bugs or include little things I missed
-in 5.003_06. 5.003_07 is intended to be stable enough to merit serious
-testing with an eye towards eventual release as 5.004.
-
-If it doesn't work for you, try
-
- LC_ALL=C; export LC_ALL
-
-for Bourne shell users, or
-
- setenv LC_ALL C
-
-for C-shell users. Some versions of IRIX are reported to have
-problems with sort when the locale is other than C. This manifests
-as an infinite loop in the ./miniperl configpm step.
-
-The details are described below. A very brief summary is:
-
-o Visible Changes to Core Functionality
-
- -Support for BER compressed integers. See perlfunc.pod for
- documentation on the 'w' option.
-
- -untaint support added to IO extension.
-
-o Changes in Core Internals
-
- -Perl's realloc is once again called 'Myremalloc' (with -DHIDEMYMALLOC),
- as it was pre-5.003_01. Again, this is for binary compatibility
- with 5.003. (5.003_06 erroneously called it Myrealloc.)
-
- -Getopt::Long updated to version 2.4.
-
-o Configure and build enhancements
-
- -improved SCO hints. Actually these are unconfirmed guesses, but
- they may be right.
-
- -OS/2 and Plan9 updates.
-
-o Bug fixes
-
- -print sort (4,1,3,2);
-
- -group numbers are integers again.
-
- -other things. See the specific changes for details.
-
-o Specific Changes
-
-Here are the specific file-by-file changes.
-
-Index: Changes
-
- Updated for 5.003_07.
-
- Fixed a spelling error.
-
-Index: Configure
-
- Detect GNU libc (thanks, Skimo!) and avoid nm if we have GNU libc.
- Since the GNU libc test requires compiling and linking a test
- program, the dependencies have been altered and lots of pieces of
- Configure have moved around unchanged. The patch is big but the
- effect is little.
-
- Allow for both <sys/select.h> and <time.h> in fd_set tests.
- Systems which don't allow both (e.g. SCO) have to turn off one
- or the other in the hints file for now.
-
-Index: INSTALL
-
- Warn about re-using config.sh version-specific values.
-
-Index: MANIFEST
-
- Date: Tue, 8 Oct 1996 22:24:48 -0400
- From: "Randy J. Ray" <rjray@uswest.com>
- Subject: PATCH: untaint method for IO::Handle, 5.003_06 version
-
- This is a re-post of my patch to Graham's IO library to add a method in
- IO::Handle called "untaint", that sets the IOf_UNTAINT flag on an object
- that is of or inherits from IO::Handle. With this flag set, data read from
- said handle is not tainted, whether running under -T, suid or sgid.
-
- This patch adds the method to IO.xs, adds documentation and warning to the
- pod of IO/Handle.pm, creates a new test in t/lib called io_taint.t, and
- adds mention of the new file to MANIFEST.
-
- Add mention of t/lib/io_taint.t
-
- Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT)
- From: Ilya Zakharevich
-
- os2/Changes added.
-
-Index: Makefile.SH
-
- Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT)
- From: Ilya Zakharevich
-
- All the executable targets are moved into the same chunk with
- shared library target, which is delegated to
- $osname/Makefile.SHs if found.
- config.h should depend on config_h.SH.
-
- Remove mkmanifest target, since it will generate incorrectly
- sorted MANIFEST file, I would imagine (I haven't checked).
-
-Index: README.os2
-
- New version.
-
-Index: config_H
-
- Update SH_PATH comment.
-
-Index: config_h.SH
-
- Update SH_PATH comment.
-
-Index: ext/IO/IO.xs
-
- Date: Tue, 8 Oct 1996 22:24:48 -0400
- From: "Randy J. Ray" <rjray@uswest.com>
- Subject: PATCH: untaint method for IO::Handle, 5.003_06 version
-
- This is a re-post of my patch to Graham's IO library to add a method in
- IO::Handle called "untaint", that sets the IOf_UNTAINT flag on an object
- that is of or inherits from IO::Handle. With this flag set, data read from
- said handle is not tainted, whether running under -T, suid or sgid.
-
- This patch adds the method to IO.xs, adds documentation and warning to the
- pod of IO/Handle.pm, creates a new test in t/lib called io_taint.t, and
- adds mention of the new file to MANIFEST.
-
- Add method "untaint" into class IO::Handle
-
-Index: ext/IO/lib/IO/Handle.pm
-
- Date: Tue, 8 Oct 1996 22:24:48 -0400
- From: "Randy J. Ray" <rjray@uswest.com>
- Subject: PATCH: untaint method for IO::Handle, 5.003_06 version
-
- This is a re-post of my patch to Graham's IO library to add a method in
- IO::Handle called "untaint", that sets the IOf_UNTAINT flag on an object
- that is of or inherits from IO::Handle. With this flag set, data read from
- said handle is not tainted, whether running under -T, suid or sgid.
-
- This patch adds the method to IO.xs, adds documentation and warning to the
- pod of IO/Handle.pm, creates a new test in t/lib called io_taint.t, and
- adds mention of the new file to MANIFEST.
-
- Document IO::Handle::untaint and give warning about the bad
- things it can do.
-
-Index: ext/SDBM_File/sdbm/sdbm.h
-
- Change Myrealloc to Myremalloc to conform to 5.003's version.
- I left in the Mycalloc since malloc.c now includes a calloc,
- and we might need to hide it.
-
-Index: gv.c
-
- Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT)
- From: Ilya Zakharevich
-
- Better error message for overload.
-
-Index: hints/os2.sh
-
- Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT)
- From: Ilya Zakharevich
-
- Some optimization (speedup in loading GNU utilities with some
- memory present - 32M should be quite enough).
- Test for revision of EMX, and setting fork()ing appropriately.
- libc was in .../st/... instead of mt.
- README.os2 is installed as pod/perlos2.pod.
-
-Index: hints/sco.sh
-
- Don't include <sys/select.h> along with <time.h>.
-
-Index: installperl
-
- Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT)
- From: Ilya Zakharevich
-
- Restore timestamps under OS/2 (needed for binary install).
-
-Index: lib/Cwd.pm
-
- Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT)
- From: Ilya Zakharevich
-
- Use builtin methods if present under OS/2 (maybe should be
- done outside of OS/2 too?).
-
-Index: lib/ExtUtils/MM_Unix.pm
-
- Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT)
- From: Ilya Zakharevich
-
- Made `use strict'-clean even in parts shadowed by Autoloading.
-
-Index: lib/ExtUtils/typemap
-
- Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT)
- From: Ilya Zakharevich
-
- `bool' entry added.
-
-Index: lib/ExtUtils/xsubpp
-
- Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT)
- From: Ilya Zakharevich
-
- Logic for processing RETVAL documented (at last!).
-
-Index: lib/File/Copy.pm
-
- Date: Thu, 10 Oct 1996 00:42:29 -0400 (EDT)
- From: Ilya Zakharevich
- Subject: Cleanup after new test
-
- Below are patches for File::Copy (copying to filehandles was just
- plain broken under OS/2 and VMS)
-
-Index: lib/FindBin.pm
-
- Date: Fri, 20 Sep 1996 15:04:04 +0200
- From: Gisle Aas
- Subject: Documentation patch to the FindBin module
-
-Index: lib/Getopt/Long.pm
-
- Update to version 2.4.
-
-Index: lib/lib.pm
-
- Date: Thu, 10 Oct 1996 14:22:05 -0400
- From: "Brent B. Powers" <powers@ml.com>
- Subject: Re: patch for lib.pm
-
- Ignore undefined entries.
-
-Index: lib/newgetopt.pl
-
- Updated to version 2.4 to match Getopt::Long.
-
-Index: makedepend.SH
-
- Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT)
- From: Ilya Zakharevich
-
- weed out perl_exp.SH, config_h.SH
- (They have these funny names to avoid names like perl.exp.SH
- with more than two '.' Such names are illegal on some systems.)
-
-Index: mg.c
-
- Date: Thu, 10 Oct 1996 14:33:08 +0000 ()
- From: Chip Salzenberg
- Subject: Re: Group fix for 5.003_06
-
- The group problems recently experienced are due to a small error
- introduced in 5.003_06. This patch is required to fix the bug:
-
-Index: os2/Changes
-
- Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT)
- From: Ilya Zakharevich
-
- sys/un.h is not very useful without Merlin toolkit.
- updates for fork()ing.
-
- Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT)
- From: Ilya Zakharevich
-
- added.
-
-Index: os2/Makefile.SHs
-
- Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT)
- From: Ilya Zakharevich
-
- Convoluted process to create chimera executables added.
- aout_clean is done automatically on clean.
-
-Index: os2/OS2/ExtAttr/t/os2_ea.t
-
- Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT)
- From: Ilya Zakharevich
-
- Use `unlink' where appropriate.
-
-Index: os2/diff.configure
-
- Updated.
-
-Index: os2/os2.c
-
- Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT)
- From: Ilya Zakharevich
-
- /bin/sh is translated to the configured value of location of sh.exe.
- popen() used even if we can fork (as we do now).
- builtins added for the sake of path manipulation.
-
-Index: os2/os2ish.h
-
- Date: Wed, 9 Oct 1996 22:29:44 -0400 (EDT)
- From: Ilya Zakharevich
-
- sys/un.h is not very useful without Merlin toolkit.
- updates for fork()ing.
-
-Index: patchlevel.h
-
- Change to subversion 7.
-
-Index: perl.c
-
- Date: Wed, 9 Oct 1996 19:03:41 +0000
- From: Tim Bunce
- Subject: Infinte loop with perl_destruct_level and $SIG{__WARN__}
-
- I've just started using purify on a perl with DBD::Oracle linked in
- (the number of uninitialised memory reads in the Oracle libraries
- is frightning!).
-
- If perl_destruct_level and $SIG{__WARN__} are set then I see a range
- of problems typified by this example and folowed by a core dump:
-
- Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT)
- From: Ilya Zakharevich
-
- Copywrite of OS/2 port now has \n\n.
- Now deletes -e file (again!) if compilation is interrupted.
-
-Index: perl.h
-
- Change Myrealloc to Myremalloc to conform to 5.003's version.
- I left in the Mycalloc since malloc.c now includes a calloc,
- and we might need to hide it.
-
-Index: plan9/aperl
-
- Updated for 5.003_07
-
-Index: plan9/arpa/inet.h
-
- Updated for 5.003_07
-
-Index: plan9/buildinfo
-
- Updated for 5.003_07
-
-Index: plan9/config.plan9
-
- Updated for 5.003_07
-
-Index: plan9/exclude
-
- Updated for 5.003_07
-
-Index: plan9/fndvers
-
- Updated for 5.003_07
-
-Index: plan9/genconfig.pl
-
- Updated for 5.003_07
-
-Index: plan9/mkfile
-
- Updated for 5.003_07
-
-Index: plan9/myconfig.plan9
-
- Updated for 5.003_07
-
-Index: plan9/perlplan9.doc
-
- Updated for 5.003_07
-
-Index: plan9/perlplan9.pod
-
- Updated for 5.003_07
-
-Index: plan9/plan9.c
-
- Updated for 5.003_07
-
-Index: plan9/plan9ish.h
-
- Updated for 5.003_07
-
-Index: plan9/setup.rc
-
- Updated for 5.003_07
-
-Index: plan9/versnum
-
- Updated for 5.003_07
-
-Index: pod/perldiag.pod
-
- Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT)
- From: Ilya Zakharevich
-
- mention that malloc in berkeley DB is broken, and PERL_BADFREE.
- OS/2-specific messages added.
-
-Index: pod/perlfunc.pod
-
- Date: 20 Sep 1996 13:17:14 +0200
- From: Ulrich Pfeifer
- Subject: Re: Patch for ASN.1 compressed integer in pack/unpack
-
-Index: pod/perli18n.pod
-
- Updated version with high bits intact.
-
-Index: pod/perlop.pod
-
- Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT)
- From: Ilya Zakharevich
-
- Crossrefs corrected.
-
-Index: pod/perltrap.pod
-
- Clarified that warn() _always_ printed to STDERR, both in perl4
- and perl5.
-
-Index: pod/perlvar.pod
-
- Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT)
- From: Ilya Zakharevich
-
- $^E under OS/2.
-
-Index: pp.c
-
- Date: 20 Sep 1996 13:17:14 +0200
- From: Ulrich Pfeifer
- Subject: Re: Patch for ASN.1 compressed integer in pack/unpack
-
-Index: pp_sys.c
-
- Date: Wed, 9 Oct 1996 19:07:24 GMT
- From: Chris Faylor <cgf@bbc.com>
-
- The problem is that SCO apparently needs to have a file opened
- with write privileges for chsize to work correctly.
-
-Index: sv.c
-
- Date: Tue, 08 Oct 1996 23:54:47 -0400
- From: Gurusamy Sarathy
- Subject: Re: Sorting lists of integers doesn't always work
-
- >> > print sort (4,1,2,3);
- >> >
- >> > actually prints "4123", i.e. doesn't actually sort. Bug? Feature?
-
- This broke between 5.001n and 5.002. There was a long winded thread
- about sorting undefs in some order (rather than coredumping) around
- the 5.002beta times (search for "bogorefs" in the subject-line on
- p5p archive for details). Larry added in some code that presumes that
- the private flags are set by the time qsort() is called:
-
- Unfortunately, sv_2pv() does not set the POKp flag, so the above
- code breaks! Here's a patch against 5.00306.
-
-Index: t/lib/anydbm.t
-
- Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT)
- From: Ilya Zakharevich
-
- File mode under OS/2 is not what you expect. However, this has
- nothing to do with databases, _and_ there is a test
- for this in stat.t (which dutifully fails). There is
- no point to consider this behaviour as a bug in
- database code.
- So OS/2 is special-cased in these tests.
-
-Index: t/lib/db-btree.t
-
- Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT)
- From: Ilya Zakharevich
-
- File mode under OS/2 is not what you expect. However, this has
- nothing to do with databases, _and_ there is a test
- for this in stat.t (which dutifully fails). There is
- no point to consider this behaviour as a bug in
- database code.
- So OS/2 is special-cased in these tests.
-
-Index: t/lib/db-hash.t
-
- Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT)
- From: Ilya Zakharevich
-
- File mode under OS/2 is not what you expect. However, this has
- nothing to do with databases, _and_ there is a test
- for this in stat.t (which dutifully fails). There is
- no point to consider this behaviour as a bug in
- database code.
- So OS/2 is special-cased in these tests.
-
-Index: t/lib/db-recno.t
-
- Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT)
- From: Ilya Zakharevich
-
- File mode under OS/2 is not what you expect. However, this has
- nothing to do with databases, _and_ there is a test
- for this in stat.t (which dutifully fails). There is
- no point to consider this behaviour as a bug in
- database code.
- So OS/2 is special-cased in these tests.
-
-Index: t/lib/gdbm.t
-
- Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT)
- From: Ilya Zakharevich
-
- File mode under OS/2 is not what you expect. However, this has
- nothing to do with databases, _and_ there is a test
- for this in stat.t (which dutifully fails). There is
- no point to consider this behaviour as a bug in
- database code.
- So OS/2 is special-cased in these tests.
-
-Index: t/lib/io_pipe.t
-
- Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT)
- From: Ilya Zakharevich
-
- Better error message on dying.
-
-Index: t/lib/io_taint.t
-
- Date: Tue, 8 Oct 1996 22:24:48 -0400
- From: "Randy J. Ray" <rjray@uswest.com>
- Subject: PATCH: untaint method for IO::Handle, 5.003_06 version
-
- This is a re-post of my patch to Graham's IO library to add a method in
- IO::Handle called "untaint", that sets the IOf_UNTAINT flag on an object
- that is of or inherits from IO::Handle. With this flag set, data read from
- said handle is not tainted, whether running under -T, suid or sgid.
-
- This patch adds the method to IO.xs, adds documentation and warning to the
- pod of IO/Handle.pm, creates a new test in t/lib called io_taint.t, and
- adds mention of the new file to MANIFEST.
-
- Test suite for the untaint method of class IO::Handle.
-
-Index: t/lib/ndbm.t
-
- Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT)
- From: Ilya Zakharevich
-
- File mode under OS/2 is not what you expect. However, this has
- nothing to do with databases, _and_ there is a test
- for this in stat.t (which dutifully fails). There is
- no point to consider this behaviour as a bug in
- database code.
- So OS/2 is special-cased in these tests.
-
-Index: t/lib/odbm.t
-
- Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT)
- From: Ilya Zakharevich
-
- File mode under OS/2 is not what you expect. However, this has
- nothing to do with databases, _and_ there is a test
- for this in stat.t (which dutifully fails). There is
- no point to consider this behaviour as a bug in
- database code.
- So OS/2 is special-cased in these tests.
-
-Index: t/lib/sdbm.t
-
- Date: Wed, 9 Oct 1996 22:30:38 -0400 (EDT)
- From: Ilya Zakharevich
-
- File mode under OS/2 is not what you expect. However, this has
- nothing to do with databases, _and_ there is a test
- for this in stat.t (which dutifully fails). There is
- no point to consider this behaviour as a bug in
- database code.
- So OS/2 is special-cased in these tests.
-
-Index: t/lib/socket.t
-
- Date: Thu, 10 Oct 1996 01:09:59 -0400
- From: Spider Boardman
- Subject: Re: 5.003_06 is available (results on ULTRIX)
-
- fix t/lib/socket.t to treat TCP like the stream protocol it is
- rather than expecting it behave rationally in all cases.
-
-Index: t/op/pack.t
-
- Date: 20 Sep 1996 13:17:14 +0200
- From: Ulrich Pfeifer
- Subject: Re: Patch for ASN.1 compressed integer in pack/unpack
-
-Index: t/op/sort.t
-
- Date: Wed, 09 Oct 1996 00:41:27 -0400
- From: Gurusamy Sarathy
- Subject: more t/op/sort.t tests
-
-Index: util.c
-
- Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT)
- From: Ilya Zakharevich
-
- uses my_syspopen, my_syspclose ifdef OS2. my_pclose is defined
- as my_syspclose ifdef OS2 and can FORK (as OS2 does).
-
-Index: x2p/Makefile.SH
-
- Date: Wed, 9 Oct 96 16:00:29 edt
- From: Norton Allen <nort@bottesini.harvard.edu>
- Subject: Re: sh Configure?
-
- Extract x2p/Makefile.SH and x2p/cflags.SH correctly down
- in the x2p directory, even if $0 isn't set to the full
- pathname of the file being extracted.
-
-Index: x2p/cflags.SH
-
- Date: Wed, 9 Oct 96 16:00:29 edt
- From: Norton Allen <nort@bottesini.harvard.edu>
- Subject: Re: sh Configure?
-
- Extract x2p/Makefile.SH and x2p/cflags.SH correctly down
- in the x2p directory, even if $0 isn't set to the full
- pathname of the file being extracted.
-
+____________________________________________________________________________
+[ 379] By: mbeattie on 1997/12/18 13:28:35
+ Log: Integrate ansi @364,@366 into mainline.
+ Branch: perl
+ !> lib/ExtUtils/MakeMaker.pm miniperlmain.c perl.h
+____________________________________________________________________________
+[ 378] By: mbeattie on 1997/12/18 13:20:15
+ Log: Add a few missing files to MANIFEST
+ Branch: perl
+ ! MANIFEST
+____________________________________________________________________________
+[ 377] By: mbeattie on 1997/12/18 13:00:16
+ Log: Bump patchlevel to 56.
+ Branch: perl
+ ! patchlevel.h
+____________________________________________________________________________
+[ 376] By: nick on 1997/12/18 01:32:12
+ Log: Resolve against mainline
+ Branch: ansiperl
+ +> README.dos djgpp/config.over djgpp/configure.bat djgpp/djgpp.c
+ +> djgpp/djgppsed.sh djgpp/fixpmain hints/dos_djgpp.sh
+ +> os2/os2.sym os2/os2thread.h
+ !> (integrate 74 files)
+____________________________________________________________________________
+[ 375] By: nick on 1997/12/18 01:06:15
+ Log: Resolve against Win32
+ Branch: ansiperl
+ !> Configure README.threads config_h.SH doop.c embed.h
+ !> ext/DynaLoader/dl_aix.xs global.sym hints/aix.sh
+ !> hints/irix_6.sh op.c op.h perl.h perlvars.h pp_hot.c pp_sys.c
+ !> sv.c sv.h thread.h util.c
+____________________________________________________________________________
+[ 374] By: mbeattie on 1997/12/17 14:44:26
+ Log: Lots of VMS changes. vms/gen_shrfls.pl (which parses header files)
+ needs rewriting now that we use perlvars.h and foovar.h:
+ Subject: [PATCH] 5.004_54 under VMS (fwd)
+ Date: Wed, 26 Nov 1997 12:32:09 -0400 (EDT)
+ From: Charles Bailey <BAILEY@newman.upenn.edu>
+ Branch: perl
+ ! dosish.h handy.h intrpvar.h os2/os2ish.h perl.c perl.h
+ ! plan9/plan9ish.h pp.c proto.h sv.c t/lib/thread.t
+ ! t/lib/timelocal.t t/op/nothread.t taint.c thrdvar.h toke.c
+ ! unixish.h vms/config.vms vms/descrip.mms vms/fndvers.com
+ ! vms/gen_shrfls.pl vms/genconfig.pl vms/perly_c.vms
+ ! vms/test.com vms/vms.c vms/vms_yfix.pl vms/vmsish.h
+____________________________________________________________________________
+[ 373] By: mbeattie on 1997/12/17 14:10:50
+ Log: Major changes to the DOS/djgpp port (including threading):
+ Subject: Re: dos-djgpp port not in perl 5.004_54
+ Date: Fri, 21 Nov 1997 10:58:26 +0100
+ From: Molnar Laszlo <molnarl@cdata.tvnet.hu>
+ Branch: perl
+ + README.dos djgpp/config.over djgpp/configure.bat djgpp/djgpp.c
+ + djgpp/djgppsed.sh djgpp/fixpmain hints/dos_djgpp.sh
+ ! Configure MANIFEST Makefile.SH doio.c dosish.h
+ ! ext/POSIX/POSIX.xs installhtml installperl lib/AutoSplit.pm
+ ! lib/Cwd.pm lib/ExtUtils/Install.pm lib/ExtUtils/MM_Unix.pm
+ ! lib/ExtUtils/Manifest.pm lib/File/Basename.pm lib/File/Find.pm
+ ! lib/File/Path.pm lib/FindBin.pm lib/Pod/Html.pm
+ ! lib/Pod/Text.pm lib/Term/Cap.pm lib/perl5db.pl makedepend.SH
+ ! mg.c perl.c pod/pod2man.PL pp_hot.c t/io/fs.t t/lib/anydbm.t
+ ! t/lib/filehand.t t/lib/gdbm.t t/lib/io_sel.t t/lib/io_tell.t
+ ! t/lib/sdbm.t t/lib/thread.t t/op/magic.t t/op/stat.t
+ ! t/op/sysio.t t/op/taint.t utils/perldoc.PL
+____________________________________________________________________________
+[ 372] By: mbeattie on 1997/12/17 13:18:34
+ Log: Upgrade DB_File to 1.56:
+ Subject: DB_File-1.56 for _55
+ Date: Tue, 16 Dec 1997 22:25:29 +0000 (GMT)
+ From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ Branch: perl
+ ! Configure ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs
+ ! ext/DB_File/Makefile.PL ext/DB_File/typemap t/lib/db-btree.t
+____________________________________________________________________________
+[ 371] By: mbeattie on 1997/12/17 12:02:03
+ Log: Threading patches for OS/2 (missing files taken from previous patch):
+ Subject: Re: 5.004_55: OS/2 patches again
+ Date: Sat, 13 Dec 1997 18:09:15 -0500 (EST)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Branch: perl
+ + os2/os2.sym os2/os2thread.h
+ ! MANIFEST hints/os2.sh os2/Changes os2/Makefile.SHs
+ ! os2/OS2/PrfDB/PrfDB.xs os2/OS2/REXX/REXX.xs os2/os2.c
+ ! os2/os2ish.h perl.h
+____________________________________________________________________________
+[ 370] By: mbeattie on 1997/12/17 11:01:34
+ Log: Add OS2 to list for DONT_DECLARE_STD in perl.h:
+ Subject: Re: 5.004_55: OS/2 patches again
+ Date: Sat, 13 Dec 1997 18:05:55 -0500 (EST)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Branch: perl
+ ! perl.h
+____________________________________________________________________________
+[ 369] By: mbeattie on 1997/12/17 10:59:40
+ Log: Fix typo in compiler B/C.pm.
+ Branch: perlext
+ ! Compiler/B/C.pm
+____________________________________________________________________________
+[ 368] By: mbeattie on 1997/12/17 10:58:35
+ Log: Allow "perldoc -F filename":
+ Subject: 5.004_55: Patch to perldoc
+ Date: Thu, 11 Dec 1997 19:37:00 -0500 (EST)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Branch: perl
+ ! utils/perldoc.PL
+____________________________________________________________________________
+[ 367] By: mbeattie on 1997/12/17 10:54:47
+ Log: Fix not-reached warning for pp_threadsv.
+ Branch: perl
+ ! pp.c
+____________________________________________________________________________
+[ 366] By: nick on 1997/12/14 16:06:24
+ Log: Fix typo in Ilya's patch :-(
+ Branch: ansiperl
+ ! lib/ExtUtils/MakeMaker.pm
+____________________________________________________________________________
+[ 365] By: nick on 1997/12/14 15:30:25
+ Log: #undef new PERLVARIC macro in appropriate places
+ Branch: ansiperl
+ ! miniperlmain.c perl.h
+____________________________________________________________________________
+[ 364] By: nick on 1997/12/14 15:04:36
+ Log: Ilya's MakeMaker (empty makefile) patch
+ Branch: ansiperl
+ ! lib/ExtUtils/MakeMaker.pm
+____________________________________________________________________________
+[ 363] By: gsar on 1997/12/13 05:57:13
+ Log: Integrate mainline. Builds and passes (Borland).
+ Branch: win32/perl
+ !> Configure README.threads config_h.SH doop.c embed.h
+ !> ext/DynaLoader/dl_aix.xs global.sym hints/aix.sh
+ !> hints/irix_6.sh op.c op.h perl.h perlvars.h pp_hot.c pp_sys.c
+ !> sv.c sv.h thread.h util.c
+____________________________________________________________________________
+[ 362] By: nick on 1997/12/13 02:53:03
+ Log: Resolve ansiperl against mainline
+ Branch: ansiperl
+ !> (integrate 92 files)
+____________________________________________________________________________
+[ 361] By: mbeattie on 1997/12/12 16:20:38
+ Log: pp_print and pp_prtf handling of tied file handles used EXTEND
+ instead of MEXTEND leading to core dumps. This fix needs
+ propagating back to the maintenance branch.
+ Branch: perl
+ ! pp_hot.c pp_sys.c
+____________________________________________________________________________
+[ 360] By: mbeattie on 1997/12/11 15:45:56
+ Log: Add missing patch to op.c that didn't come across with win32 merge.
+ Branch: perl
+ ! op.c
+____________________________________________________________________________
+[ 359] By: mbeattie on 1997/12/11 11:54:41
+ Log: Stop tr/// from writing to target when only counting.
+ Branch: perl
+ ! doop.c op.c op.h
+____________________________________________________________________________
+[ 358] By: mbeattie on 1997/12/10 18:36:26
+ Log: Fix char*/unsigned char* clashes in util.c:fbm_instr and remove
+ a few extraneous trailing semicolons in perlvars.h.
+ Branch: perl
+ ! perlvars.h util.c
+____________________________________________________________________________
+[ 357] By: mbeattie on 1997/12/10 18:33:53
+ Log: Start overhauling compiler. It was working at least minimally
+ right up until the final tweak of B.xs to add threadsv_names
+ at which point building it provokes a seg fault in perl while
+ doing the xsubpp :-(.
+ Branch: perl
+ ! op.h util.c
+ Branch: perlext
+ ! Compiler/B.pm Compiler/B.xs Compiler/B/Asmdata.pm
+ ! Compiler/B/C.pm Compiler/B/CC.pm Compiler/Makefile.PL
+ ! Compiler/bytecode.pl Compiler/byteperl.c Compiler/byterun.c
+ ! Compiler/byterun.h Compiler/cc_harness Compiler/cc_runtime.h
+ ! Compiler/ccop.c Compiler/ccop.h Compiler/test_harness
+ ! Compiler/test_harness_cc
+____________________________________________________________________________
+[ 356] By: mbeattie on 1997/12/10 13:43:32
+ Log: Fix perl_os_thread typedef for pthreads. Tweak SvTAINT so that
+ sv_setfoo functions go back to not needing dTHR. Fix Configure
+ to check for already-existing -thread on archname and to check
+ better for d_pthread_created_joinable.
+ Branch: perl
+ ! Configure perl.h sv.c sv.h thread.h
+____________________________________________________________________________
+[ 355] By: mbeattie on 1997/12/10 10:53:58
+ Log: Minor fix/speedup to util.c:fbm_instr:
+ Subject: 5.004_55: Minor regexp patch
+ Date: Fri, 5 Dec 1997 05:09:54 -0500 (EST)
+ From: Ilya Zakharevich <ilya@MATH.OHIO-STATE.EDU>
+ Branch: perl
+ ! util.c
+____________________________________________________________________________
+[ 354] By: mbeattie on 1997/12/10 10:41:25
+ Log: Patches for IRIX, AIX and some generic stuff:
+ Subject: [PATCH] _55: Mostly AIX stuff but also IRIX and generic
+ Date: Sat, 29 Nov 1997 08:35:30 -0800 (PST)
+ From: Jarkko Hietaniemi <jarkko.hietaniemi@research.nokia.com>
+ (checked/ignored a few rejects; tweaked wording).
+ Branch: perl
+ ! Configure README.threads config_h.SH embed.h
+ ! ext/DynaLoader/dl_aix.xs global.sym hints/aix.sh
+ ! hints/irix_6.sh
+____________________________________________________________________________
+[ 353] By: mbeattie on 1997/12/10 10:10:19
+ Log: Integrate win32 back into mainline (trivial).
+ Branch: perl
+ +> embedvar.h intrpvar.h perlvars.h thrdvar.h win32/config.gc
+ +> win32/config_H.gc
+ !> (integrate 36 files)
+____________________________________________________________________________
+[ 352] By: nick on 1997/12/09 17:36:45
+ Log: Resolve win32 - Sarathy's tweak.
+ Branch: ansiperl
+ !> win32/makedef.pl
+____________________________________________________________________________
+[ 351] By: gsar on 1997/12/08 06:13:04
+ Log: re-add PERLVARI?C? change that somehow went missing in makedef.pl
+ Branch: win32/perl
+ ! win32/makedef.pl
+____________________________________________________________________________
+[ 350] By: nick on 1997/12/05 00:56:03
+ Log: Resolve ansiperl against win32
+ Branch: ansiperl
+ - win32/makegcc.mk
+ !> embed.h embed.pl embedvar.h global.sym miniperlmain.c perl.h
+ !> perlvars.h win32/Makefile win32/config.gc win32/makedef.pl
+ !> win32/makefile.mk win32/perllib.c win32/win32.h
+____________________________________________________________________________
+[ 349] By: gsar on 1997/12/02 07:28:23
+ Log: Revert to keeping (some) constant strings as globals
+ Branch: win32/perl
+ ! embed.h embed.pl embedvar.h global.sym miniperlmain.c perl.h
+ ! perlvars.h win32/makedef.pl win32/perllib.c
+____________________________________________________________________________
+[ 348] By: gsar on 1997/12/02 05:38:06
+ Log: makegcc.mk merged into makefile.mk, so makegcc.mk is gone.
+ Other minor fixes. Now is a good time to get the changes in win32 branch.
+ Branch: win32/perl
+ - win32/makegcc.mk
+ ! win32/Makefile win32/config.gc win32/makefile.mk win32/win32.h
+____________________________________________________________________________
+[ 347] By: gsar on 1997/12/02 03:32:55
+ Log: Integrate winansi again. Result builds and passes all tests on all
+ three compilers.
+ Branch: win32/perl
+ !> lib/ExtUtils/MM_Win32.pm win32/config.gc win32/makefile.mk
+ !> win32/makegcc.mk win32/win32.h
+____________________________________________________________________________
+[ 346] By: gsar on 1997/12/02 03:28:23
+ Log: various hacks to get mingw32 to build. Sync Makefile with makefile.mk.
+ makegcc.mk to be merged into makefile.mk soon.
+ Branch: win32/perl
+ ! lib/ExtUtils/MM_Win32.pm win32/Makefile win32/config.gc
+ ! win32/makedef.pl win32/makefile.mk win32/makegcc.mk
+ ! win32/win32.h
+____________________________________________________________________________
+[ 345] By: nick on 1997/12/02 01:57:17
+ Log: Add a 4th step (yes FOUR) to dll build process for gcc.
+ Now runs again...
+ Branch: ansiperl
+ ! lib/ExtUtils/MM_Win32.pm
+____________________________________________________________________________
+[ 344] By: nick on 1997/12/02 01:11:16
+ Log: Sarathy's patch
+ Branch: ansiperl
+ ! lib/ExtUtils/MM_Win32.pm win32/config.gc win32/makefile.mk
+ ! win32/makegcc.mk win32/win32.h
+____________________________________________________________________________
+[ 343] By: gsar on 1997/12/01 04:37:06
+ Log: Reverse integrate to get all of Nick's changes over at winansi (win32/perl/*
+ is identical to ansiperl/* now)
+ Branch: win32/perl
+ +> embedvar.h intrpvar.h perlvars.h thrdvar.h
+ !> (integrate 34 files)
+____________________________________________________________________________
+[ 342] By: nick on 1997/12/01 04:01:57
+ Log: Builds and passes all tests with gcc on Win32 - phew!
+ Branch: ansiperl
+ ! embed.h embedvar.h ext/Opcode/Opcode.xs global.sym perl.h
+ ! proto.h util.c win32/makedef.pl
+____________________________________________________________________________
+[ 341] By: nick on 1997/12/01 02:54:29
+ Log: Create a struct for all perls globals (as an option)
+ Mainly for Mingw32 which cannot import data.
+ Now only Opcode tests fail (op_desc/op_name not
+ handled yet stuff)
+ Branch: ansiperl
+ ! EXTERN.h embed.h embed.pl embedvar.h ext/Thread/Thread.xs
+ ! global.sym miniperlmain.c perl.c perl.h perlvars.h pp_hot.c
+ ! proto.h run.c util.c win32/Makefile win32/makedef.pl
+ ! win32/makegcc.mk win32/perllib.c win32/win32.c win32/win32.h
+ ! win32/win32iop.h win32/win32thread.c
+____________________________________________________________________________
+[ 340] By: nick on 1997/11/30 20:21:10
+ Log: Fixup exports in non -DDEBUGGING case
+ Branch: ansiperl
+ ! win32/makedef.pl
+____________________________________________________________________________
+[ 339] By: nick on 1997/11/30 20:10:04
+ Log: Disable hard-coded -DDEBUGGING
+ Branch: ansiperl
+ ! win32/config_h.PL
+____________________________________________________________________________
+[ 338] By: nick on 1997/11/30 20:00:19
+ Log: embed.pl now reads *var*.h to do its stuff.
+ Split generated embed.h into two - new embedvar.h
+ is #included when 'op' etc. will not mess up proto.h etc.
+ Removed #define foo (thr->Tfoo) from thread.h
+ Added some 'missing' symbols to global.sym, removed
+ those in the *var*.h files
+ Has build all MULTIPLICITY/USE_THREADS options on win32
+ with VC++ (and passed tests), but not with exactly this set
+ of files.
+ Branch: ansiperl
+ + embedvar.h
+ ! embed.h embed.pl global.sym interp.sym intrpvar.h perl.h
+ ! perlvars.h regcomp.c thrdvar.h thread.h win32/Makefile
+ ! win32/makedef.pl
+____________________________________________________________________________
+[ 337] By: nick on 1997/11/29 23:55:31
+ Log: Globals and structs via macros - part 1 of N
+ - introduce perlvars.h intrpvar.h and thrdvar.h
+ - change perl.h and thread.h to include them with
+ appropriate macros defined
+ - result is status-quo but with macros
+ - next step is to tweak embed.* to capitalize on
+ new easy-to-find info.
+ Branch: ansiperl
+ + intrpvar.h perlvars.h thrdvar.h
+ ! perl.h thread.h win32/Makefile
+____________________________________________________________________________
+[ 336] By: nick on 1997/11/29 19:13:55
+ Log: VC++ default to threaded
+ Branch: ansiperl
+ ! win32/Makefile
+____________________________________________________________________________
+[ 335] By: nick on 1997/11/29 18:38:26
+ Log: Avoid __declspec(thread) by default, for both scratch
+ return areas and THR stuff. Use struct thread intern instead.
+ Branch: ansiperl
+ ! win32/win32.c win32/win32.h win32/win32sck.c
+ ! win32/win32thread.c win32/win32thread.h
+____________________________________________________________________________
+[ 334] By: nick on 1997/11/29 17:49:04
+ Log: Non-threaded build fix
+ Branch: ansiperl
+ ! win32/win32thread.c
+____________________________________________________________________________
+[ 333] By: nick on 1997/11/29 17:29:07
+ Log: Sort out malloc_mutex for perl's malloc
+ Remove BINCOMPAT3 from embed.pl
+ Add dependancy to CORE_H for PERL95_OBJ
+ Branch: ansiperl
+ ! dosish.h embed.h embed.pl global.sym perl.h win32/Makefile
+ ! win32/win32.c
+____________________________________________________________________________
+[ 332] By: nick on 1997/11/29 16:21:01
+ Log: Integrate win32 into ansiperl
+ Branch: ansiperl
+ !> README.threads hints/irix_6.sh lib/Test/Harness.pm
+ !> lib/perl5db.pl malloc.c miniperlmain.c perl.h sv.c t/TEST
+ !> t/lib/anydbm.t t/lib/db-btree.t t/lib/db-hash.t
+ !> t/lib/db-recno.t t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t
+ !> t/lib/safe2.t t/lib/sdbm.t t/op/pat.t t/op/taint.t
+ !> win32/perllib.c
+____________________________________________________________________________
+[ 331] By: nick on 1997/11/29 01:35:45
+ Log: GCC + Threads on Win32 - best gcc results yet
+ Branch: ansiperl
+ ! XSUB.h perl.h thread.h win32/makedef.pl win32/makegcc.mk
+ ! win32/win32.h win32/win32iop.h win32/win32thread.c
+ ! win32/win32thread.h
+____________________________________________________________________________
+[ 330] By: nick on 1997/11/28 23:05:08
+ Log: Un-botch gcc workround
+ Branch: ansiperl
+ ! XSUB.h
+____________________________________________________________________________
+[ 329] By: nick on 1997/11/28 22:39:39
+ Log: Builds completely with Mingw32, dynamic loaded extensions
+ don't work yet - suspect __declspec() non-implemented issues.
+ Branch: ansiperl
+ ! XSUB.h lib/ExtUtils/Command.pm lib/ExtUtils/MM_Win32.pm
+ ! lib/ExtUtils/Mksymlists.pm win32/config.gc win32/makegcc.mk
+ ! win32/runperl.c win32/win32.c win32/win32iop.h
+____________________________________________________________________________
+[ 328] By: gsar on 1997/11/28 05:48:15
+ Log: integrate winansi.
+ Branch: win32/perl
+ +> win32/config.gc win32/config_H.gc win32/makegcc.mk
+ ! perl.h
+ !> dosish.h hv.c win32/dl_win32.xs win32/include/sys/socket.h
+ !> win32/makedef.pl win32/makefile.mk win32/runperl.c
+ !> win32/win32.c win32/win32.h win32/win32iop.h win32/win32sck.c
+____________________________________________________________________________
+[ 327] By: gsar on 1997/11/28 05:38:48
+ Log: Integrate mainline.
+ Branch: win32/perl
+ !> README.threads hints/irix_6.sh lib/Test/Harness.pm
+ !> lib/perl5db.pl malloc.c miniperlmain.c sv.c t/TEST
+ !> t/lib/anydbm.t t/lib/db-btree.t t/lib/db-hash.t
+ !> t/lib/db-recno.t t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t
+ !> t/lib/safe2.t t/lib/sdbm.t t/op/pat.t t/op/taint.t
+ !> win32/perllib.c
+____________________________________________________________________________
+[ 326] By: nick on 1997/11/27 19:13:36
+ Log: GCC builds perl.dll and perl.exe on Win32
+ Branch: ansiperl
+ ! win32/makedef.pl win32/makegcc.mk
+____________________________________________________________________________
+[ 325] By: nick on 1997/11/27 17:46:30
+ Log: Add files and tweak others to get 'native' Mingw32 gcc port as
+ far as building miniperl and perl.dll (but not import lib yet)
+ Seems to lack popen()/pclose() and fcloseall() and fflushall().
+ Also only CRTDLL not MCRTDLL so threading is probably not
+ possible yet.
+ Had to mess with win32iop.h's placement as we need __attribute__
+ to get STDCALL, and #define of printf messes up proto.h
+ Branch: ansiperl
+ + win32/config.gc win32/config_H.gc win32/makegcc.mk
+ ! dosish.h perl.h win32/dl_win32.xs win32/include/sys/socket.h
+ ! win32/makefile.mk win32/runperl.c win32/win32.c win32/win32.h
+ ! win32/win32iop.h win32/win32sck.c
+____________________________________________________________________________
+[ 324] By: mbeattie on 1997/11/27 17:08:06
+ Log: Give dire warnings about the IRIX 6.2 kernel panic.
+ Branch: perl
+ ! README.threads hints/irix_6.sh
+____________________________________________________________________________
+[ 323] By: mbeattie on 1997/11/27 16:57:33
+ Log: Fix prototypes of sv_vsetpvfn and sv_vcatpvfn:
+ Subject: Re: ANNOUNCE: perl 5.004_55 is available
+ Date: 27 Nov 1997 17:18:53 +0100
+ From: koenig@kulturbox.de (Andreas J. Koenig)
+ Branch: perl
+ ! sv.c
+____________________________________________________________________________
+[ 322] By: mbeattie on 1997/11/27 16:12:15
+ Log: Integrate win32 branch back into mainline.
+ Branch: perl
+ !> (integrate 42 files)
+____________________________________________________________________________
+[ 321] By: mbeattie on 1997/11/27 15:06:36
+ Log: Fix t/lib/safe2.t for SunOS 4.1.3:
+ Subject: Re: ANNOUNCE: perl 5.004_55 is available
+ Date: Thu, 27 Nov 1997 10:46:42 +0000 (GMT)
+ From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ Branch: perl
+ ! t/lib/safe2.t
+____________________________________________________________________________
+[ 320] By: mbeattie on 1997/11/27 15:02:59
+ Log: Fix MYMALLOC (wrong #define in malloc.c):
+ Subject: 5.004_55: MYMALLOC completely busted
+ Date: Thu, 27 Nov 1997 01:08:16 -0500 (EST)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Branch: perl
+ ! malloc.c
+____________________________________________________________________________
+[ 319] By: mbeattie on 1997/11/27 15:01:37
+ Log: Fix newSVrv so sv_setref_foo work better:
+ Subject: [PATCH] [5.004_55] newSVrv (again)
+ Date: Thu, 27 Nov 1997 00:25:50 -0500
+ From: Owen Taylor <owt1@cornell.edu>
+ Branch: perl
+ ! sv.c
+____________________________________________________________________________
+[ 318] By: mbeattie on 1997/11/27 14:59:03
+ Log: Output skipped test information in test suite:
+ Subject: 5.004_55: Making test harness platform_aware
+ Date: Wed, 26 Nov 1997 17:16:55 -0500 (EST)
+ Date: Wed, 26 Nov 1997 17:16:55 -0500 (EST)
+ Branch: perl
+ ! lib/Test/Harness.pm t/TEST t/lib/anydbm.t t/lib/db-btree.t
+ ! t/lib/db-hash.t t/lib/db-recno.t t/lib/gdbm.t t/lib/ndbm.t
+ ! t/lib/odbm.t t/lib/sdbm.t t/op/taint.t
+____________________________________________________________________________
+[ 317] By: mbeattie on 1997/11/27 14:55:15
+ Log: Add 'W'atch command to debugger and improve help:
+ Subject: 5.004_55: Debugger patch again
+ Date: Wed, 26 Nov 1997 17:05:57 -0500 (EST)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Branch: perl
+ ! lib/perl5db.pl
+____________________________________________________________________________
+[ 316] By: mbeattie on 1997/11/27 14:52:44
+ Log: Stop double initialisation of malloc_mutex:
+ Subject: 5.004_55: Double initialiazation of malloc_mutex
+ Date: Wed, 26 Nov 1997 16:51:43 -0500 (EST)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Branch: perl
+ ! miniperlmain.c win32/perllib.c
+____________________________________________________________________________
+[ 315] By: mbeattie on 1997/11/27 14:48:58
+ Log: Fix PVLV case in sv_setsv (plus tests in op/pat.t).
+ Branch: perl
+ ! sv.c t/op/pat.t
+____________________________________________________________________________
+[ 314] By: nick on 1997/11/27 01:03:19
+ Log: Merge win32 and ansiperl branches post _55 tweaks from Sarathy.
+ Branch: ansiperl
+ !> (integrate 897 files)
+____________________________________________________________________________
+[ 313] By: gsar on 1997/11/26 03:20:55
+ Log: merge win32-aware installperl in ansiperl branch.
+ Branch: win32/perl
+ !> installperl
+____________________________________________________________________________
+[ 312] By: gsar on 1997/11/26 01:50:37
+ Log: Fix for C<sort 'foo'...> bug:
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Message-Id: <199711011946.OAA18882@aatma.engin.umich.edu>
+ Subject: [PATCH] Re: Sort grammar bug
+ Date: Sat, 01 Nov 1997 14:46:35 -0500
+ ------
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Message-Id: <199711021247.MAA01743@crypt.compulink.co.uk>
+ Subject: Re: Sort grammar bug
+ Date: Sun, 02 Nov 1997 12:47:51 +0000
+ Branch: win32/perl
+ ! t/op/sort.t toke.c
+____________________________________________________________________________
+[ 311] By: nick on 1997/11/26 01:42:50
+ Log: Win32-ize installperl
+ Branch: ansiperl
+ ! installperl
+____________________________________________________________________________
+[ 310] By: gsar on 1997/11/26 01:36:39
+ Log: Another trivial patch:
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Message-Id: <199710300245.VAA04244@aatma.engin.umich.edu>
+ Subject: [PATCH] Re: Why doesn't XSRETURN have STMT_START/STMT_END brackets?
+ Date: Wed, 29 Oct 1997 21:45:26 -0500
+ Branch: win32/perl
+ ! XSUB.h
+____________________________________________________________________________
+[ 309] By: nick on 1997/11/26 01:33:32
+ Log: Fixup _55 for Win32:
+ Missed thread :-> perl_thread changes
+ Two #define THR (not the same)
+ K&R style func in hv.c
+ Branch: ansiperl
+ ! hv.c win32/win32thread.c win32/win32thread.h
+____________________________________________________________________________
+[ 308] By: gsar on 1997/11/26 01:30:21
+ Log: Sync yet another patch (this one manually edited):
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Message-Id: <199710290251.VAA14362@aatma.engin.umich.edu>
+ Subject: [PATCH] Re: local($@) gives core dump
+ Date: Tue, 28 Oct 1997 21:51:25 -0500
+ Branch: win32/perl
+ ! pp_ctl.c
+____________________________________________________________________________
+[ 307] By: gsar on 1997/11/26 01:22:10
+ Log: Sync another change from local repository.
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Message-Id: <199710290316.WAA15888@aatma.engin.umich.edu>
+ Subject: Re: do_postponed breaks with multiple interpreters
+ Date: Tue, 28 Oct 1997 22:16:13 -0500
+ Branch: win32/perl
+ ! op.c
+____________________________________________________________________________
+[ 306] By: gsar on 1997/11/26 01:17:46
+ Log: Sync a change from local repository.
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Message-Id: <199710290106.UAA11485@aatma.engin.umich.edu>
+ Subject: [PATCH] Re: Core dump from using sockets w/ system or open(pipe) or "`"
+ Date: Tue, 28 Oct 1997 20:06:06 -0500
+ Branch: win32/perl
+ ! mg.c
+____________________________________________________________________________
+[ 305] By: nick on 1997/11/26 00:50:10
+ Log: Integrate mainline as of _55
+ Branch: ansiperl
+ +> emacs/ptags
+ !> (integrate 36 files)
+____________________________________________________________________________
+[ 304] By: gsar on 1997/11/26 00:27:57
+ Log: Various changes to make it build cleanly and pass all tests:
+ - needed to run `perl embed.pl`
+ - use PERL_CORE instead of PERLDLL in places that do mean PERL_CORE
+ - fix prototypes for a few declarations (Borland is finally quiet)
+ - move declaration of Mymalloc etc to perl.h (since win32 and other
+ ports may #define malloc themselves, to let extensions bind to
+ the version that perl used)
+ - move struct reg_data into a public header file, since it is
+ referenced in a public datatype
+ - win32 makefile fixes
+ - fix remaining s/thread/perl_thread/
+ Branch: win32/perl
+ ! EXTERN.h embed.h ext/DynaLoader/dlutils.c
+ ! ext/SDBM_File/sdbm/sdbm.h hv.c perl.h proto.h regcomp.h
+ ! regexp.h win32/Makefile win32/dl_win32.xs win32/makefile.mk
+ ! win32/win32.h win32/win32iop.h win32/win32thread.c
+____________________________________________________________________________
+[ 303] By: gsar on 1997/11/25 20:57:31
+ Log: Fixup the places where the automatic merge got it wrong.
+ Previous change (#302) was just a normal integration--ignore the
+ "reverse" in there.
+ Branch: win32/perl
+ ! op.c perl.h
+____________________________________________________________________________
+[ 302] By: gsar on 1997/11/25 20:32:12
+ Log: reverse integrate mainline
+ Branch: win32/perl
+ +> emacs/ptags
+ !> (integrate 896 files)
----------------
-Version 5.003_06
+Version 5.004_55
----------------
-This patch was primarily to fix bugs, improve the documentation,
-and work towards restoring binary compatibility with 5.003.
-The details are described below. A very brief summary is:
-
-o Visible Changes to Core Functionality
-
- -Significantly improved support _with documentation_ for
- locales, including LC_COLLATE. See the new pod/perli18n.pod.
- Thanks to Jarkko Hietaniemi.
-
- -new version of Math::Complex, with test suite. Ought to be
- backwards compatible, but check it out if you use Math::Complex.
-
- -Pre-extending hashes now works. keys %hash = 5000 will pre-size
- %hash.
-
- -__DATA__ filehandle is untainted.
-
-o Changes in Core Internals
-
- -gv_fullname and gv_efullname have reverted to their pre-5.003_03
- versions for binary compatibility. Actually, they are implemented
- as stubs pointing to the new 3-argument forms gv_fullname3 and
- gv_efullname3.
-
- -Perl's malloc is once again called 'Mymalloc' (with -DHIDEMYMALLOC),
- as it was pre-5.003_01. Again, this is for binary compatibility
- with 5.003.
-
-o Configure and build enhancements
-
- -many new tests for the standard library.
-
- -test suite now locale-friendly.
-
- -a2p.man and s2p.man now made into pods.
-
-o Bug fixes
-
- -whitespace lexer errors fixed.
-
- -many, many other things. See details below.
-
-o Specific Changes
-
-Here are the specific file-by-file changes.
-
-# This is my patch perl5.003_06.pat to perl5.003_05
-# The full description is below.
-# Please execute the following commands before applying this patch.
-# (You can feed this patch to 'sh' to do so.)
-# -- Andy Dougherty
-
-# We'll create some new tests, but patch won't automatically make them
-# executable.
-for t in abbrev.t autoloader.t basename.t checktree.t complex.t \
- env.t fatal.t filecache.t filecopy.t filefind.t filepath.t \
- findbin.t getopt.t hostname.t parsewords.t searchdict.t \
- selectsaver.t symbol.t texttabs.t textwrap.t timelocal.t
-do
- touch t/lib/$t
- chmod +x t/lib/$t
-done
-
-# The a2p.man and s2p.man pages have been changed into pods.
-rm -f x2p/a2p.man x2p/s2p.man
-
-exit 0
-
-
-This is patch perl5.003_06.pat to perl version 5.003_05.
-This takes you from 5.003_05 to 5.003_06.
-
-To apply this patch, run the above commands,
-cd to your perl source directory and then type
-
- patch -p1 -N < perl5.003_06.pat
-
-The changes are described after each /^Index:/ line below. This is
-designed so you can examine each change with a command such as
-
- csplit -k perl5.003_06.pat '/^Index:/' '{999}'
-
-(Of course, since there are more than 100 Index entries, your
-csplit may complain, since many csplit's have an arbitrary limit of 100
-files. Still, you can manually split the file or roll your own.)
-
-Index: Changes
-
- Updated for 5.003_06.
-
-Index: Configure
-
- Add -Wl,rpath option for irix* to find the installed shared
- libperl.so
-
- Add /shlib to libpth. It is used by Digital Unix 4.0.
-
- Date: Mon, 30 Sep 1996 14:01:05 +0100
- From: Sven Verdoolaege <skimo@breughel.ufsia.ac.be>
-
- Detect Cygnus Win32, or at least don't let Configure get fooled
- into thinking it's OS/2.
-
-Index: INSTALL
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- added LC_COLLATE doc.
-
-Index: MANIFEST
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
- Date: Sat, 28 Sep 1996 15:11:06 +0200
- From: Andreas Koenig
- Subject: Dale's posting as patch (Was: Perl 5.003_5 make fails on NS3.2 - CURED)
-
- Handle NeXT, POSIX, and setpgid in pp_sys.c and POSIX.
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- added perli18n.pod.
-
-Index: README
-
- Changed Larry's address to larry@wall.org.
-
-Index: configpm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: configure
-
- Date: Mon, 30 Sep 1996 14:01:05 +0100
- From: Sven Verdoolaege <skimo@breughel.ufsia.ac.be>
-
- Warn the user of case-insensitive file systems that they may have
- accidentally gotten 'configure' instead of 'Configure'.
-
-Index: doio.c
-
- Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT)
- From: Charles Bailey
- Subject: VMS patches to 5.003_05
-
-Index: doop.c
-
- Date: Mon, 30 Sep 1996 01:13:28 -0400
- From: Spider Boardman
- Subject: Re: pre extending hash? - need speed
-
- The patch below (which is relative to perl5.001l) implements
- "keys %hash = 50_000;" (or other integer-evaluable sizes) for
- pre-sizing hashes. I've only moved the patch forward from
- when I first did it. I'm sure the code in hv_ksplit could be
- improved.
-
-Index: dump.c
-
- Restore the 5.003 gv_fullname() and gv_efullname() functions.
- Provide new 3-arg forms gv_fullname3() and gv_efullname3().
-
-Index: embed.h
-
- Restore the 5.003 gv_fullname() and gv_efullname() functions.
- Provide new 3-arg forms gv_fullname3() and gv_efullname3().
-
-Index: ext/DynaLoader/DynaLoader.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: ext/FileHandle/FileHandle.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: ext/IO/IO.pm
-
- Updated to IO-1.12.
-
-Index: ext/IO/IO.xs
-
- Updated to IO-1.12.
-
-Index: ext/IO/lib/IO/File.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
- Updated to IO-1.12.
-
-Index: ext/IO/lib/IO/Handle.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
- Updated to IO-1.12.
-
-Index: ext/IO/lib/IO/Pipe.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
- Updated to IO-1.12.
-
-Index: ext/IO/lib/IO/Seekable.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
- Updated to IO-1.12.
-
-Index: ext/IO/lib/IO/Select.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
- Updated to IO-1.12.
-
-Index: ext/IO/lib/IO/Socket.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
- Updated to IO-1.12.
-
-Index: ext/NDBM_File/hints/dynixptx.pl
-
- Perl 5.003_05 compiles on DYNIX/ptx 4.0 (v4.1.3), and passes all tests.
- The only change needed is in "ext/NDBM_File/Makefile.PL" - on this system,
- ndbm is actually contained in the libc library, and must be linked against
- -lc when compiling. (this is for dynamic ELF executables, I didn't compile
- statically)
-
-Index: ext/Opcode/Opcode.pm
-
- Date: Fri, 20 Sep 1996 12:59:21 +0200
- From: Gisle Aas
- Subject: Re: Symbol.pm clobbers $_ at startup
-
- The same kind of problem seem to be present in Opcode.pm:
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: ext/Opcode/Safe.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: ext/POSIX/POSIX.pod
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- enhanced setlocale() docs and introduced the one-argument variant doc.
-
-Index: ext/POSIX/POSIX.xs
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- setlocale() allowed one argument only,
- call to perl_init_fold() (in util.c) if setlocale() succeeded.
-
-Index: ext/POSIX/hints/next_3.pl
-
- Date: Sat, 28 Sep 1996 15:11:06 +0200
- From: Andreas Koenig
- Subject: Dale's posting as patch (Was: Perl 5.003_5 make fails on NS3.2 - CURED)
-
- Handle NeXT, POSIX, and setpgid in pp_sys.c and POSIX.
-
-Index: ext/SDBM_File/sdbm/sdbm.h
-
- Revert from Perl_malloc to Mymalloc for binary compatibility with
- 5.003.
-
-Index: ext/Socket/Socket.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: global.sym
-
- Restore the 5.003 gv_fullname() and gv_efullname() functions.
- Provide new 3-arg forms gv_fullname3() and gv_efullname3().
-
- Date: Mon, 30 Sep 1996 01:13:28 -0400
- From: Spider Boardman
- Subject: Re: pre extending hash? - need speed
-
- The patch below (which is relative to perl5.001l) implements
- "keys %hash = 50_000;" (or other integer-evaluable sizes) for
- pre-sizing hashes. I've only moved the patch forward from
- when I first did it. I'm sure the code in hv_ksplit could be
- improved.
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- added var lc_collate_active and func mem_collxfrm.
-
-Index: gv.c
-
- Restore the 5.003 gv_fullname() and gv_efullname() functions.
- Provide new 3-arg forms gv_fullname3() and gv_efullname3().
-
-Index: handy.h
-
- Date: Sat, 21 Sep 1996 21:33:15 -0400 (EDT)
- From: Kenneth Albanowski
- Subject: Full LONG_MAX & co. patch over 5.003_05
-
- This patch contains the changes I've collected for the various _MAX issues
- since 5.003_05. No patches issued between 5.003_05 and this one should be
- applied, use this one instead.
-
- The effect is to remove the CHAR_* and I8_* constants (which are
- ambiguous) and to explicitly cast all of the constants.
-
-Index: hints/machten.sh
-
- Add notes about MachTen 4.0.3 SYSV IPC.
-
-Index: hints/next_3.sh
-
- Replace optimize="-g" by optimize="" since we're just trying to turn off
- the optimizier.
-
- Date: Sat, 28 Sep 1996 15:11:06 +0200
- From: Andreas Koenig
- Subject: Dale's posting as patch (Was: Perl 5.003_5 make fails on NS3.2 - CURED)
-
- Handle NeXT, POSIX, and setpgid in pp_sys.c and POSIX.
-
-Index: hv.c
-
- Date: Fri, 20 Sep 1996 15:38:57 -0400
- From: Gurusamy Sarathy
- Subject: Re: "Attempt to free non-existent shared string"? (with patch)
-
- I found a subtle problem with the lazydelete mechanism (which is used
- to postpone the delete of a entry that may be getting iterated over).
- I was using the HeKLEN slot to hold the hint, but the real HeKLEN is
- needed later to call unsharepvn(). This means that only magical
- hash entries can use the HeKLEN slot to hold flags.
-
- Here's a tested patch against 5.00305 that fixes the problem.
- The patch simply moves the LAZYDEL hint to become a SV-level private
- flag.
-
- Date: Mon, 30 Sep 1996 01:13:28 -0400
- From: Spider Boardman
- Subject: Re: pre extending hash? - need speed
-
- The patch below (which is relative to perl5.001l) implements
- "keys %hash = 50_000;" (or other integer-evaluable sizes) for
- pre-sizing hashes. I've only moved the patch forward from
- when I first did it. I'm sure the code in hv_ksplit could be
- improved.
-
-Index: hv.h
-
- Date: Fri, 20 Sep 1996 15:38:57 -0400
- From: Gurusamy Sarathy
- Subject: Re: "Attempt to free non-existent shared string"? (with patch)
-
- I found a subtle problem with the lazydelete mechanism (which is used
- to postpone the delete of a entry that may be getting iterated over).
- I was using the HeKLEN slot to hold the hint, but the real HeKLEN is
- needed later to call unsharepvn(). This means that only magical
- hash entries can use the HeKLEN slot to hold flags.
-
- Here's a tested patch against 5.00305 that fixes the problem.
- The patch simply moves the LAZYDEL hint to become a SV-level private
- flag.
-
-Index: installman
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: installperl
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/AutoLoader.pm
-
- Date: Mon Sep 9 09:29:44 1996
- From: Gisle Aas
- Subject: Re: problem with 'die' and UserAgent
-
- > This is a patch to the AutoLoader.pm (from 5.003) that fixes the problem:
- This is a better patch (no need to test for /::DESTROY$/ twice):
-
- Date: Mon, 30 Sep 1996 00:54:37 -0400
- From: Spider Boardman
-
- The test and patches for AutoLoader were also non-functional,
- since the regexp context (curpm) was still being clobbered by the
- filename manipulations:
-
- Date: Sun, 06 Oct 1996 16:15:07 +0200
- From: Gisle Aas
- Subject: Re: Can't locate auto/U/autosplit.ix
-
- It would IMHO be much better if the AutoLoader exported the AUTOLOAD()
- function. With an exported AUTOLOAD() we would not have to inherit
- from AutoLoader, and we would avoid these problems.
-
- This patch tries to explain the behavior of AutoLoader instead by
- updating its documentation.
-
-Index: lib/Benchmark.pm
-
- Date: Sat, 28 Sep 1996 17:01:22 +0300 (EET DST)
- From: Jarkko Hietaniemi
- Subject: a really really tiny typo
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/Cwd.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/Devel/SelfStubber.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/Env.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/Exporter.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/ExtUtils/Embed.pm
-
- Remove unwantd space after the I in -I$Config[archlib}
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/ExtUtils/Install.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/ExtUtils/MM_Unix.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/ExtUtils/MM_VMS.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
- Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT)
- From: Charles Bailey
- Subject: VMS patches to 5.003_05
-
-Index: lib/ExtUtils/MakeMaker.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/ExtUtils/Manifest.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
- Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT)
- From: Charles Bailey
- Subject: VMS patches to 5.003_05
-
-Index: lib/ExtUtils/Mksymlists.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/ExtUtils/xsubpp
-
- Change a reference from perlapi(1) to perlxs(1).
-
-Index: lib/File/Basename.pm
-
- Date: Fri, 20 Sep 1996 14:11:05 +0200
- From: Gisle Aas
- Subject: File::BaseName: "/" is legal path separator for MSDOS
-
- The File::BaseName module should allow "/" as path separator when
- fileparse_set_fstype("MSDOS") is in effect:
-
- Date: Fri, 20 Sep 1996 13:58:52 +0200
- From: Gisle Aas
- Subject: File::Basename documentation patch
-
- Date: Mon, 30 Sep 1996 00:54:37 -0400
- From: Spider Boardman
-
- For t/lib/basename.t, though, the associated patch for
- File::Basename was also wrong:
-
- Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT)
- From: Charles Bailey
- Subject: VMS patches to 5.003_05
-
-Index: lib/File/Copy.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/File/Find.pm
-
- Date: Sat, 7 Sep 1996 21:37:44 +0200
- From: Michael De La Rue <mikedlr@it.com.pl>
- Subject: File::Find assumes $_ remains unchanged; bug
-
- The File::Find perl module assumes that the $_ variable remains unchanged
- through the user defined function which is callbacked from find. It carries
- out a stat operation
-
- Simplest fix is merely to document this
-
-Index: lib/File/Path.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/FindBin.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/Getopt/Long.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/I18N/Collate.pm
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- deprecated and trapped (will whine if called and tell to migrate away)
-
-Index: lib/IPC/Open2.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/IPC/Open3.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/Math/BigInt.pm
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- ord() is a dangerous thing.
-
-Index: lib/Math/Complex.pm
-
- Date: Thu, 03 Oct 96 18:38:08 +0200
- From: Raphael Manfredi <Raphael_Manfredi@grenoble.hp.com>
- # Complex numbers and associated mathematical functions
- # -- Raphael Manfredi, Sept 1996
- # New version. Should be backwards compatible, but please
- # check it out if you use it.
-
-Index: lib/Pod/Text.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/Search/Dict.pm
-
- Date: Sat, 21 Sep 1996 23:02:42 +0200
- From: Gisle Aas
- Subject: look() in Search::Dict should use lc() istead of tr/A-Z/a-z/
-
- The Search::Dict look() function should use the lc() function instead
- of tr/A-Z/a-z/. This will make folding of non-english letters work if
- the locale is set up correctly.
-
-Index: lib/SelfLoader.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/Symbol.pm
-
- Date: Fri, 20 Sep 1996 12:38:14 +0200
- From: Gisle Aas
- Subject: Symbol.pm clobbers $_ at startup
-
- perl -le 'BEGIN {$_="foo";} use Symbol; print qualify($_)'
-
- I don't understand why the module want to initialize %global from
- <DATA> in the first place. Perhaps we want to apply this patch
- instead.
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/Sys/Hostname.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/Term/Cap.pm
-
- Date: 23 Sep 1996 14:11:38 +0200
- From: Ulrich Pfeifer
- Subject: Patch for Term::Cap
-
- 'use Term::Cap' produces a warning when diagnosics are active. The
- patch below avoids the warning.
-
- [The $entry .= $_ usage is idiomatic enough that it ought to be
- ok, I would think, but the patch certainly is ok too.]
-
-Index: lib/Term/Complete.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/Term/ReadLine.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/Test/Harness.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
- Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT)
- From: Charles Bailey
- Subject: VMS patches to 5.003_05
-
-Index: lib/Text/Abbrev.pm
-
- Date: 23 Sep 1996 11:33:01 +0200
- From: Ulrich Pfeifer
- Subject: Text::Abbrev (Re: More standard library test scripts)
-
- This patch merges the Text::Abbrev related patches/tests from Gisle
- and my previous patch (i.e. replaces both).
-
-Index: lib/Text/Tabs.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/Text/Wrap.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/Time/Local.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/UNIVERSAL.pm
-
- Add in stub file.
-
-Index: lib/bigint.pl
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- ord() is a dangerous thing.
-
-Index: lib/diagnostics.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/overload.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/perl5db.pl
-
- Date: Mon, 30 Sep 1996 00:34:58 -0400 (EDT)
- From: Ilya Zakharevich
- Subject: Re: dereferencing a hash from the debugger won't work
-
-Index: lib/splain
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: lib/strict.pm
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: makedepend.SH
-
- Add explicit $touch $firstmakefile for QNX which apparently
- preserves modification times for a 'cp' command.
- I worry, though, that touch might not be portable to OS/2.
- If it is, then I'll remove the fancy case statement.
-
-Index: malloc.c
-
- Not all sbrks return zeroed memory.
-
-Index: mg.c
-
- Restore the 5.003 gv_fullname() and gv_efullname() functions.
- Provide new 3-arg forms gv_fullname3() and gv_efullname3().
-
- Date: Sun, 29 Sep 1996 22:18:19 -0400 (EDT)
- From: Chip Salzenberg
- Subject: 5.003_05: Fix numeric value of $!
-
- This patch undoes a bit of over-zealous integerization in mg.c, related
- to the numeric value of $!.
-
- Date: Mon, 30 Sep 1996 01:13:28 -0400
- From: Spider Boardman
- Subject: Re: pre extending hash? - need speed
-
- The patch below (which is relative to perl5.001l) implements
- "keys %hash = 50_000;" (or other integer-evaluable sizes) for
- pre-sizing hashes. I've only moved the patch forward from
- when I first did it. I'm sure the code in hv_ksplit could be
- improved.
-
- Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT)
- From: Charles Bailey
- Subject: VMS patches to 5.003_05
-
- Date: Fri, 4 Oct 1996 12:38:31 -0400 (EDT)
- From: Chip Salzenberg
- Subject: 5.003_05: Fix numeric $! and $^E
-
- This patch undoes a bit of over-zealous integerization in mg.c,
- related to the numeric values of $! and $^E. This patch *REPLACES*
- the one I posted earlier, which was only effective for $!.
-
- [Some of this is superceded by similar stuff in the VMS patches.]
-
-Index: op.c
-
- Restore the 5.003 gv_fullname() and gv_efullname() functions.
- Provide new 3-arg forms gv_fullname3() and gv_efullname3().
-
- Date: Mon, 30 Sep 1996 01:13:28 -0400
- From: Spider Boardman
- Subject: Re: pre extending hash? - need speed
-
- The patch below (which is relative to perl5.001l) implements
- "keys %hash = 50_000;" (or other integer-evaluable sizes) for
- pre-sizing hashes. I've only moved the patch forward from
- when I first did it. I'm sure the code in hv_ksplit could be
- improved.
-
-Index: opcode.h
-
- Date: Mon, 16 Sep 1996 16:37:48 -0700
- From: Jonathan Biggar <jon@sems.com>
- Subject: Perl 5.003 bug when embedding in C++ program
-
- The following patch is necessary in order to embed the Perl5.003 interpreter
- into a C++ program without getting prototype mismatch errors from the
- C++ compiler.
-
-Index: opcode.pl
-
- Date: Mon, 16 Sep 1996 16:37:48 -0700
- From: Jonathan Biggar <jon@sems.com>
- Subject: Perl 5.003 bug when embedding in C++ program
-
- The following patch is necessary in order to embed the Perl5.003 interpreter
- into a C++ program without getting prototype mismatch errors from the
- C++ compiler.
-
-Index: patchlevel.h
-
- Change to subversion 6.
-
-Index: perl.c
-
- From: Roderick Schertler
- Subject: Re: -T flag and removal of `.' from @INC
-
- support C<perl -e'attached code'>
-
- Date: Tue, 01 Oct 1996 19:02:17 -0400
- From: Gurusamy Sarathy
- Subject: Re: 2 core dumps (patch)
- Message-Id: <199610012302.TAA08395@aatma.engin.umich.edu>
-
- The problem is an uninitialized SV slot in errgv. Here's a patch.
-
- Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT)
- From: Charles Bailey
- Subject: VMS patches to 5.003_05
-
-Index: perl.h
-
- Date: Sat, 21 Sep 1996 21:33:15 -0400 (EDT)
- From: Kenneth Albanowski
- Subject: Full LONG_MAX & co. patch over 5.003_05
-
- This patch contains the changes I've collected for the various _MAX issues
- since 5.003_05. No patches issued between 5.003_05 and this one should be
- applied, use this one instead.
-
- The effect is to remove the CHAR_* and I8_* constants (which are
- ambiguous) and to explicitly cast all of the constants.
-
- Date: Mon, 30 Sep 1996 01:13:28 -0400
- From: Spider Boardman
- Subject: Re: pre extending hash? - need speed
-
- The patch below (which is relative to perl5.001l) implements
- "keys %hash = 50_000;" (or other integer-evaluable sizes) for
- pre-sizing hashes. I've only moved the patch forward from
- when I first did it. I'm sure the code in hv_ksplit could be
- improved.
-
- Revert from Perl_malloc to Mymalloc for binary compatibility with
- 5.003.
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
-Index: perl_exp.SH
-
- Add new function perl_init_fold. (I'm not sure it goes here.)
-
-Index: perlio.c
-
- Date: Thu, 12 Sep 96 15:58 PDT
- From: Hunter Kelly <retnuh@zule.pixar.com>
- Subject: Re: 5.003_05 is available.
-
- Fix PerlIO_reopen parameters.
-
-Index: perlsdio.h
-
- Date: Fri, 13 Sep 1996 17:24:01 -0400
- From: John Stoffel <jfs@jfs.fluent.com>
- Subject: Re: 5.003_05 is available.
-
- Undef Irix getc_unlocked and putc_unlocked #defines.
-
- Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT)
- From: Charles Bailey
- Subject: VMS patches to 5.003_05
-
-Index: pod/Makefile
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- perli18n.pod (and perlapio.pod, btw) added.
-
-Index: pod/buildtoc
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perl.pod
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
- Changed Larry's address to larry@wall.org.
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- perli18n advertised.
-
-Index: pod/perlapio.pod
-
- Date: Wed, 11 Sep 1996 11:55:18 -0500
- From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu>
- Subject: POD spelling patches
-
-Index: pod/perlbook.pod
-
- Updated for Second Edition.
-
-Index: pod/perlcall.pod
-
- Date: Wed, 11 Sep 1996 11:55:18 -0500
- From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu>
- Subject: POD spelling patches
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perldata.pod
-
- Date: Wed, 11 Sep 1996 11:55:18 -0500
- From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu>
- Subject: POD spelling patches
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perldebug.pod
-
- Date: Wed, 11 Sep 1996 11:55:18 -0500
- From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu>
- Subject: POD spelling patches
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perldiag.pod
-
- Date: Wed, 11 Sep 1996 11:55:18 -0500
- From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu>
- Subject: POD spelling patches
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
- Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT)
- From: Charles Bailey
- Subject: VMS patches to 5.003_05
-
-Index: pod/perldsc.pod
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perlembed.pod
-
- Date: Wed, 11 Sep 1996 11:55:18 -0500
- From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu>
- Subject: POD spelling patches
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perlform.pod
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perlfunc.pod
-
- Date: Wed, 11 Sep 1996 11:55:18 -0500
- From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu>
- Subject: POD spelling patches
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perlguts.pod
-
- Date: Wed, 11 Sep 1996 11:55:18 -0500
- From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu>
- Subject: POD spelling patches
- Date: Mon, 23 Sep 96 13:18:01 PDT
- From: Jeff Okamoto
- Subject: Re: perlguts API Listing patch
-
- Here's the lastest complete version for inclusion into _06 or .004. This
- incorporates and supersedes Dean's patch.
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perli18n.pod
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- written.
-
-Index: pod/perlipc.pod
-
- Date: Wed, 11 Sep 1996 11:55:18 -0500
- From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu>
- Subject: POD spelling patches
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perllol.pod
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perlmod.pod
-
- Date: Wed, 11 Sep 1996 11:55:18 -0500
- From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu>
- Subject: POD spelling patches
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
- Date: Wed, 02 Oct 1996 16:52:08 -0400
- From: Roderick Schertler
- Subject: documentation for $? in END
-
- Document the behavior with $? WRT END subroutines.
-
-Index: pod/perlobj.pod
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perlop.pod
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
- Date: Fri, 4 Oct 1996 10:36:19 -0400 (EDT)
- From: Kenneth Albanowski
- Subject: Re: Suggestion for improving man page
-
- Add alternative names for various escape sequences.
-
-Index: pod/perlpod.pod
-
- Date: Wed, 11 Sep 1996 11:55:18 -0500
- From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu>
- Subject: POD spelling patches
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perlre.pod
-
- Date: Wed, 11 Sep 1996 11:55:18 -0500
- From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu>
- Subject: POD spelling patches
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
- Date: Fri, 4 Oct 1996 10:36:19 -0400 (EDT)
- From: Kenneth Albanowski
- Subject: Re: Suggestion for improving man page
-
- Add alternative names for various escape sequences.
-
-Index: pod/perlref.pod
-
- Date: Wed, 11 Sep 1996 11:55:18 -0500
- From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu>
- Subject: POD spelling patches
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perlrun.pod
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perlsec.pod
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perlstyle.pod
-
- Date: Wed, 11 Sep 1996 11:55:18 -0500
- From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu>
- Subject: POD spelling patches
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perlsub.pod
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perlsyn.pod
-
- Date: Wed, 11 Sep 1996 11:55:18 -0500
- From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu>
- Subject: POD spelling patches
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perltie.pod
-
- Date: Wed, 11 Sep 1996 11:55:18 -0500
- From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu>
- Subject: POD spelling patches
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perltoc.pod
-
- Date: Wed, 11 Sep 1996 11:55:18 -0500
- From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu>
- Subject: POD spelling patches
-
- Changed Larry's address to larry@wall.org.
-
-Index: pod/perltrap.pod
-
- Date: Wed, 11 Sep 1996 13:26:18 -0400
- From: Gurusamy Sarathy
- Subject: a perl425 trap
-
- Here's an addition that should be self-explanatory.
- [interpolation issues]
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/perlvar.pod
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
- Date: Wed, 02 Oct 1996 16:52:08 -0400
- From: Roderick Schertler
- Subject: documentation for $? in END
-
- Document the behavior with $? WRT END subroutines.
-
-Index: pod/perlxstut.pod
-
- Date: Wed, 11 Sep 1996 11:55:18 -0500
- From: "Daniel S. Lewart" <lewart@vadds.cvm.uiuc.edu>
- Subject: POD spelling patches
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: pod/pod2man.PL
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
- Bugs found in pod2man
-
- The following bugs were noticed, and some fixed:
-
- 1. Where a L<> link extends over more than one line, pod2man does not
- treat it as a link but displays it literally, and so these have been
- rearranged to place the link on one line. This is the only bug worked
- around. [Fixed; the rearrangements, which were done beforehand,
- remain in some cases, but are no longer necessary, and pod paragraphs
- can now be safely reformatted to whatever width is desired in the pod,
- without breaking links.]
-
- 2. It seems to swallow spaces after certain links: for example, part
- of the "open" entry in the perlfunc manpage comes out as "the
- \f(CWbinmode\fR entry elsewhere in this documentfor tips", the source
- having been "L</binmode> for tips". [Fixed.]
-
- 3. 'L</"Pass by Reference">', in perlsub.pod, comes out as '\fI/"Pass
- by Reference\fR', that is, with an initial '/"'.
-
- 4. If a pod line begins with ".", nothing is done to prevent [tng]roff
- from treating it as a [tng]roff instruction.
-
- 5. When the paragraph below =head1 NAME has more than one line, this
- confuses pod2man: so in the case of Term::Readline, the manpage begins
- with a stray line 'no real package is found, substitutes stubs instead
- of basic functions."'.
-
- Of course, it would be better to fix pod2man; I hope that the new Pod
- modules, when ready, will not have these defects.
-
-Index: pp_ctl.c
-
- Restore the 5.003 gv_fullname() and gv_efullname() functions.
- Provide new 3-arg forms gv_fullname3() and gv_efullname3().
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- sortcmp() sprouted a LC_COLLATE branch.
-
-Index: pp_hot.c
-
- Restore the 5.003 gv_fullname() and gv_efullname() functions.
- Provide new 3-arg forms gv_fullname3() and gv_efullname3().
-
- Date: Thu, 19 Sep 1996 11:58:22 -0400
- From: "Randy J. Ray" <rjray@uswest.com>
- Subject: Patch: Untaint FH flag and clean DATA handles
-
- This patch adds a IOf_UNTAINT flag in sv.h, as one of the possibles
- on an xpvio->xio_flags struct member. It is used to mark the given
- file handle as a clean source, even when tainting is turned on.
- There are also patches to pp_sys.c in pp_sysread to check this flag
- before tainting data, and in pp_hot.c in do_readline for the same
- reason. Lastly, it patches toke.c to automatically set this flag on
- on a __DATA__ filehandle. The creation of the $pack::DATA
- pseudo-filehandle is already checked against running under eval, so
- this should not introduce any insecurity.
-
- This patch *does not*:
-
- * Add the "untaint" keyword.
-
-Index: pp_sys.c
-
- Restore the 5.003 gv_fullname() and gv_efullname() functions.
- Provide new 3-arg forms gv_fullname3() and gv_efullname3().
-
- Date: Thu, 19 Sep 1996 11:58:22 -0400
- From: "Randy J. Ray" <rjray@uswest.com>
- Subject: Patch: Untaint FH flag and clean DATA handles
-
- This patch adds a IOf_UNTAINT flag in sv.h, as one of the possibles
- on an xpvio->xio_flags struct member. It is used to mark the given
- file handle as a clean source, even when tainting is turned on.
- There are also patches to pp_sys.c in pp_sysread to check this flag
- before tainting data, and in pp_hot.c in do_readline for the same
- reason. Lastly, it patches toke.c to automatically set this flag on
- on a __DATA__ filehandle. The creation of the $pack::DATA
- pseudo-filehandle is already checked against running under eval, so
- this should not introduce any insecurity.
-
- This patch *does not*:
-
- * Add the "untaint" keyword.
-
- Date: Sun, 22 Sep 1996 17:26:57 -0400
- From: "Randy J. Ray" <rjray@uswest.com>
- Subject: Patch to patch for untainting
-
- The following patch ensures that a glob used as a filehandle that
- has had the UNTAINT flag set will not carry that flag over on a
- re-open. In a nutshell, a re-open of the DATA filehandle would be
- considered untainted, and an object of class IO::Handle (or one of
- its sub-classes) that is marked untainted with the untaint method,
- then closed and re-opened, retained the untaintedness.
-
- Date: Mon, 30 Sep 1996 00:54:37 -0400
- From: Spider Boardman
-
- First, with IO::untaint, the patches as posted resulted in a
- miniperl which couldn't open files, so the autosplitting of the
- library and the creation of Makefiles for the extensions didn't
- work. Worse, it didn't just fail to open files, it dumped core.
-
-Index: proto.h
-
- Restore the 5.003 gv_fullname() and gv_efullname() functions.
- Provide new 3-arg forms gv_fullname3() and gv_efullname3().
-
- Date: Mon, 30 Sep 1996 01:13:28 -0400
- From: Spider Boardman
- Subject: Re: pre extending hash? - need speed
-
- The patch below (which is relative to perl5.001l) implements
- "keys %hash = 50_000;" (or other integer-evaluable sizes) for
- pre-sizing hashes. I've only moved the patch forward from
- when I first did it. I'm sure the code in hv_ksplit could be
- improved.
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- mem_collxfrm() and perl_init_fold() added.
-
-Index: run.c
-
- Restore the 5.003 gv_fullname() and gv_efullname() functions.
- Provide new 3-arg forms gv_fullname3() and gv_efullname3().
-
-Index: sv.c
-
- Restore the 5.003 gv_fullname() and gv_efullname() functions.
- Provide new 3-arg forms gv_fullname3() and gv_efullname3().
-
- Date: Mon, 30 Sep 1996 01:13:28 -0400
- From: Spider Boardman
- Subject: Re: pre extending hash? - need speed
-
- The patch below (which is relative to perl5.001l) implements
- "keys %hash = 50_000;" (or other integer-evaluable sizes) for
- pre-sizing hashes. I've only moved the patch forward from
- when I first did it. I'm sure the code in hv_ksplit could be
- improved.
-
- Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT)
- From: Charles Bailey
- Subject: VMS patches to 5.003_05
-
- I've added some DEBUG_Ps to sv.c which give a trace of the
- fast I/O fiddling with stdio in sv_gets(). These were useful
- to me in setting up the VMS fast I/O, and I left them in in
- case they're useful to someone in the future. However, if you
- think it overloads -DP too much, feel free to drop it. (-DP
- already adds a profile of op usage to its advertised output.)
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- sv_cmp() sprouted a LC_COLLATE branch.
-
-Index: sv.h
-
- Date: Thu, 19 Sep 1996 11:58:22 -0400
- From: "Randy J. Ray" <rjray@uswest.com>
- Subject: Patch: Untaint FH flag and clean DATA handles
-
- This patch adds a IOf_UNTAINT flag in sv.h, as one of the possibles
- on an xpvio->xio_flags struct member. It is used to mark the given
- file handle as a clean source, even when tainting is turned on.
- There are also patches to pp_sys.c in pp_sysread to check this flag
- before tainting data, and in pp_hot.c in do_readline for the same
- reason. Lastly, it patches toke.c to automatically set this flag on
- on a __DATA__ filehandle. The creation of the $pack::DATA
- pseudo-filehandle is already checked against running under eval, so
- this should not introduce any insecurity.
-
- This patch *does not*:
-
- * Add the "untaint" keyword.
-
- Date: Fri, 20 Sep 1996 15:38:57 -0400
- From: Gurusamy Sarathy
- Subject: Re: "Attempt to free non-existent shared string"? (with patch)
-
- I found a subtle problem with the lazydelete mechanism (which is used
- to postpone the delete of a entry that may be getting iterated over).
- I was using the HeKLEN slot to hold the hint, but the real HeKLEN is
- needed later to call unsharepvn(). This means that only magical
- hash entries can use the HeKLEN slot to hold flags.
-
- Here's a tested patch against 5.00305 that fixes the problem.
- The patch simply moves the LAZYDEL hint to become a SV-level private
- flag.
-
-Index: t/base/term.t
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- \n not necessarily lt ' '.
-
-Index: t/comp/package.t
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- XYZ not necessarily gt xyz.
-
-Index: t/lib/abbrev.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
- Date: 23 Sep 1996 11:33:01 +0200
- From: Ulrich Pfeifer
- Subject: Text::Abbrev (Re: More standard library test scripts)
-
- This patch merges the Text::Abbrev related patches/tests from Gisle
- and my previous patch (i.e. replaces both).
-
-Index: t/lib/anydbm.t
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- A not necessarily gt a.
-
-Index: t/lib/autoloader.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
- Date: Mon, 30 Sep 1996 00:54:37 -0400
- From: Spider Boardman
-
- The test and patches for AutoLoader were also non-functional,
- since the regexp context (curpm) was still being clobbered by the
- filename manipulations:
-
-Index: t/lib/basename.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
- Date: Mon, 30 Sep 1996 00:54:37 -0400
- From: Spider Boardman
-
- Fix the number of tests.
-
- Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT)
- From: Charles Bailey
- Subject: VMS patches to 5.003_05
-
- A different set of tests for File::Basename and friends.
-
-Index: t/lib/checktree.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
-Index: t/lib/complex.t
-
- Date: Thu, 03 Oct 96 18:38:08 +0200
- From: Raphael Manfredi <Raphael_Manfredi@grenoble.hp.com>
- # Complex numbers and associated mathematical functions
- # -- Raphael Manfredi, Sept 1996
-
- Tests for new version.
-
-Index: t/lib/db-btree.t
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- A not necessarily gt a.
-
-Index: t/lib/db-hash.t
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- A not necessarily gt a.
-
-Index: t/lib/env.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
-Index: t/lib/fatal.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
-Index: t/lib/filecache.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
-Index: t/lib/filecopy.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
-Index: t/lib/filefind.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
-Index: t/lib/filepath.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
-Index: t/lib/findbin.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
-Index: t/lib/gdbm.t
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- A not necessarily gt a.
-
-Index: t/lib/getopt.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
-Index: t/lib/hostname.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
-Index: t/lib/ndbm.t
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- A not necessarily gt a.
-
-Index: t/lib/odbm.t
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- A not necessarily gt a.
-
-Index: t/lib/parsewords.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
-Index: t/lib/sdbm.t
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- A not necessarily gt a.
-
-Index: t/lib/searchdict.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
-Index: t/lib/selectsaver.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
-Index: t/lib/symbol.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
- Date: Mon, 30 Sep 1996 00:54:37 -0400
- From: Spider Boardman
-
- The various new lib/*.t tests didn't all work. For some, it was
- only because the count of tests was wrong:
-
-Index: t/lib/texttabs.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
-Index: t/lib/textwrap.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
-Index: t/lib/timelocal.t
-
- Date: Sun, 22 Sep 1996 00:59:56 +0200
- From: Gisle Aas
- Subject: More standard library test scripts
-
- This is a collection of test scripts for the standard library modules.
- Some of the tests does not pass unless some of the patches I have sent
- out are applied.
-
-Index: t/op/each.t
-
- Date: Mon, 30 Sep 1996 01:13:28 -0400
- From: Spider Boardman
- Subject: Re: pre extending hash? - need speed
-
- The patch below (which is relative to perl5.001l) implements
- "keys %hash = 50_000;" (or other integer-evaluable sizes) for
- pre-sizing hashes. I've only moved the patch forward from
- when I first did it. I'm sure the code in hv_ksplit could be
- improved.
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- A not necessarily gt a.
-
-Index: t/op/glob.t
-
- Date: Tue, 01 Oct 1996 16:37:03 -0400 (EDT)
- From: Charles Bailey
- Subject: Re: glob test 1 failing...bad test or bug
-
- Under AIX 4.1.4, with LOCALE set en_GB (British english) glob test one
- fails because <op/*> sorts op/re_* before op/rea*, while
- $otherway = `echo op/*` sorts op/re_* after op/re[a-z]*.t
-
- This version doesn't rely on the sorting order.
-
-Index: t/op/magic.t
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
-Index: t/op/readdir.t
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- A not necessarily gt a.
-
-Index: t/op/sort.t
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- A not necessarily gt a.
-
-Index: toke.c
-
- Date: Sat, 14 Sep 1996 17:08:16 -0400
- From: Gurusamy Sarathy
- Subject: whitespace induced lexer errors (with patch)
-
- I finally got around to fixing skipspace() to not indiscriminately
- overwrite oldbufptr and oldoldbufptr (which are used in making
- expectation decisions in the lexer).
-
- Date: Sat, 14 Sep 1996 18:55:16 -0400
- From: Gurusamy Sarathy
- Subject: perl lexer won't accept C<my($a,$b);$a<=>$b;>
-
- Date: Thu, 19 Sep 1996 11:58:22 -0400
- From: "Randy J. Ray" <rjray@uswest.com>
- Subject: Patch: Untaint FH flag and clean DATA handles
-
- This patch adds a IOf_UNTAINT flag in sv.h, as one of the possibles
- on an xpvio->xio_flags struct member. It is used to mark the given
- file handle as a clean source, even when tainting is turned on.
- There are also patches to pp_sys.c in pp_sysread to check this flag
- before tainting data, and in pp_hot.c in do_readline for the same
- reason. Lastly, it patches toke.c to automatically set this flag on
- on a __DATA__ filehandle. The creation of the $pack::DATA
- pseudo-filehandle is already checked against running under eval, so
- this should not introduce any insecurity.
-
- This patch *does not*:
-
- * Add the "untaint" keyword.
-
-Index: util.c
-
- Date: Mon, 7 Oct 1996 22:03:00 +0300
- From: Jarkko Hietaniemi
- Subject: LC_COLLATE.
-
- Big patch to add, document, and test LC_COLLATE support.
-
- rewrote perl_init_i18n() completely.
- - reworded to be much more friendly and clear.
- - perl_init_fold() split to its own function.
- wrote mem_collxfrm().
-
-Index: utils/c2ph.PL
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: utils/h2ph.PL
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: utils/h2xs.PL
-
- Date: Sat, 21 Sep 1996 16:38:24 -0500
- From: Dean Roehrich
- Subject: h2xs bug fix
-
- The h2xs that is in perl5.003_05 has a regexp bug which prevents it from
- finding #define statements and filling the constant() function. This patch
- fixes that. The h2xs_test program found this--maybe people who are
- modifying h2xs should get a copy of the test program.
-
- This also adds a -d to enable debugging messages (there's just one for now).
- I've also placed some of the doc-related things in alphabetical order.
-
- h2xs_test can be found in my directory on CPAN. Those of you modifying
- xsubpp should know there's a test suite for that, too, called XSTEST which
- can also be found in my directory on CPAN.
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- Here is a patch for various typos and other defects in the Perl
- 5.003_05 pods, including the pods embedded in library modules.
-
-Index: utils/perldoc.PL
-
- Date: Sun, 29 Sep 1996 22:00:09 -0400 (EDT)
- From: Kenneth Albanowski
- Subject: perldoc patch
-
- Ilya has found that this change makes perldoc much more useful under OS/2.
-
-Index: vms/config.vms
-
- Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT)
- From: Charles Bailey
- Subject: VMS patches to 5.003_05
-
-Index: vms/descrip.mms
-
- Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT)
- From: Charles Bailey
- Subject: VMS patches to 5.003_05
-
-Index: vms/genconfig.pl
-
- Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT)
- From: Charles Bailey
- Subject: VMS patches to 5.003_05
-
-Index: vms/perlvms.pod
-
- Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT)
- From: Charles Bailey
- Subject: VMS patches to 5.003_05
-
-Index: vms/vms.c
-
- Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT)
- From: Charles Bailey
- Subject: VMS patches to 5.003_05
-
-Index: x2p/a2p.pod
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- This patch just changed the old a2p.man page into a pod page.
-
-Index: x2p/s2p.PL
-
- Date: Fri, 20 Sep 1996 15:08:33 +0100 (BST)
- From: "Joseph S. Myers" <jsm28@hermes.cam.ac.uk>
- Subject: Pod typos, pod2man bugs, and miscellaneous installation comments
-
- This patch just changed the old s2p.man page into a pod page.
- I then embedded the pod into the s2p script.
-
+____________________________________________________________________________
+[ 301] By: mbeattie on 1997/11/25 17:59:53
+ Log: Fix minor thinkos in hv.c and pp_ctl.c. This is 5.004_55.
+ Branch: perl
+ ! hv.c pp_ctl.c
+____________________________________________________________________________
+[ 300] By: mbeattie on 1997/11/25 16:29:36
+ Log: Add t/avhv.t to MANIFEST and bump patchlevel.h to 55.
+ Branch: perl
+ ! MANIFEST patchlevel.h
+____________________________________________________________________________
+[ 299] By: mbeattie on 1997/11/25 15:59:16
+ Log: Move malloc_mutex initialisation/destruction:
+ Subject: patch to 5.004_54 for pthreads with Perl's malloc
+ From: ilya@math.ohio-state.edu (Ilya Zakharevich)
+ Branch: perl
+ ! malloc.c os2/os2.c os2/os2ish.h perl.c perl.h plan9/plan9ish.h
+ ! unixish.h vms/vmsish.h
+____________________________________________________________________________
+[ 298] By: mbeattie on 1997/11/25 15:49:22
+ Log: Make hv_ functions cope better with 'm'-magic:
+ Subject: [5.004_54] Another neglected patch
+ Date: Fri, 21 Nov 1997 22:28:17 -0500
+ From: Owen Taylor <owt1@cornell.edu>
+ Branch: perl
+ ! hv.c
+____________________________________________________________________________
+[ 297] By: mbeattie on 1997/11/25 15:47:36
+ Log: Fix typo in Thread.xs.
+ Branch: perl
+ ! ext/Thread/Thread.xs
+____________________________________________________________________________
+[ 296] By: mbeattie on 1997/11/25 15:42:07
+ Log: Integrate from ansi branch to mainline.
+ Branch: perl
+ !> (integrate 890 files)
+____________________________________________________________________________
+[ 295] By: mbeattie on 1997/11/25 14:29:31
+ Log: AIX patch for DynaLoader/dl_aix.xs and hints/aix.sh:
+ Subject: Re: _54 on AIX
+ Date: Tue, 25 Nov 1997 00:49:52 -0800 (PST)
+ From: Jarkko Hietaniemi <jarkko.hietaniemi@research.nokia.com>
+ Branch: perl
+ ! ext/DynaLoader/dl_aix.xs
+____________________________________________________________________________
+[ 294] By: mbeattie on 1997/11/25 14:29:10
+ Log: AIX patch for hints/aix.sh:
+ Subject: Re: _54 on AIX
+ Date: Tue, 25 Nov 1997 00:49:52 -0800 (PST)
+ From: Jarkko Hietaniemi <jarkko.hietaniemi@research.nokia.com>
+ Branch: perl
+ ! hints/aix.sh
+____________________________________________________________________________
+[ 291] By: mbeattie on 1997/11/25 14:17:05
+ Log: Fix scalar dereference of threadsv variables (e.g. $$_).
+ Branch: perl
+ ! op.c op.h
+____________________________________________________________________________
+[ 290] By: mbeattie on 1997/11/25 14:16:29
+ Log: AIX patch (including Configure support for {sched,pthread}_yield,
+ pthread initial detach state, renaming perl_thread to perl_os_thread
+ and struct thread to struct perl_thread):
+ Subject: Re: _54 on AIX
+ Date: Thu, 20 Nov 1997 06:10:51 -0800 (PST)
+ From: Jarkko Hietaniemi <jarkko.hietaniemi@research.nokia.com>
+ Branch: perl
+ ! Configure config_h.SH cv.h ext/DB_File/DB_File.xs
+ ! ext/Thread/Makefile.PL ext/Thread/Thread.pm
+ ! ext/Thread/Thread.xs fakethr.h hints/aix.sh perl.c perl.h pp.h
+ ! proto.h sv.h thread.h util.c win32/win32thread.c
+ ! win32/win32thread.h
+____________________________________________________________________________
+[ 289] By: mbeattie on 1997/11/25 12:33:02
+ Log: Rename perl_thread to perl_os_thread.
+ Branch: perl
+ ! fakethr.h thread.h util.c win32/win32thread.h
+____________________________________________________________________________
+[ 288] By: mbeattie on 1997/11/25 12:27:35
+ Log: Remove bincompat3 support:
+ Subject: Re: ANNOUNCE: perl5.004_54 is available
+ Date: Wed, 19 Nov 1997 08:07:10 -0800 (PST)
+ From: Jarkko Hietaniemi <jarkko.hietaniemi@research.nokia.com>
+ Branch: perl
+ ! Configure INSTALL embed.h global.sym malloc.c
+____________________________________________________________________________
+[ 287] By: mbeattie on 1997/11/25 12:23:50
+ Log: Emacs/tags update:
+ Subject: Emacs/tags update for 5.004_54
+ Date: Fri, 21 Nov 1997 15:02:09 -0500 (EST)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Branch: perl
+ + emacs/ptags
+ ! MANIFEST Makefile.SH emacs/cperl-mode.el
+____________________________________________________________________________
+[ 286] By: nick on 1997/11/23 23:03:56
+ Log: Add $$_ test
+ Branch: ansiperl
+ ! t/op/ref.t
+____________________________________________________________________________
+[ 285] By: gsar on 1997/11/23 08:26:00
+ Log: Initial reverse integration of winansi branch.
+ Branch: win32/perl
+ !> (integrate 50 files)
+____________________________________________________________________________
+[ 284] By: gsar on 1997/11/23 07:32:24
+ Log: Add to docs about the BEGIN { shift } feature. Make the change
+ yet simpler using CvUNIQUE(compcv) instead of subline (Chip's idea).
+ Branch: win32/perl
+ ! op.c perly.c perly.y pod/perlfunc.pod vms/perly_c.vms
+____________________________________________________________________________
+[ 283] By: nick on 1997/11/22 21:29:30
+ Log: Duplicate perl_threadsv
+ Branch: ansiperl
+ ! global.sym
+____________________________________________________________________________
+[ 282] By: nick on 1997/11/22 21:18:11
+ Log: Munge pseudo-Configure stuff to add -thread to archname as
+ Malcolm seems to think that is way to test for threads.
+ Update @INC stuffing hackery to have traditional @INC
+ search order archlib, privlib, sitearch, site.
+ Branch: ansiperl
+ ! t/lib/english.t win32/config.bc win32/config_H.bc
+ ! win32/config_H.vc win32/config_h.PL win32/config_sh.PL
+ ! win32/makefile.mk win32/win32.c win32/win32.h
+____________________________________________________________________________
+[ 281] By: nick on 1997/11/22 19:28:21
+ Log: Builds and passes all but english.t on win32 VC++
+ Branch: ansiperl
+ ! global.sym pp_ctl.c win32/Makefile win32/config.vc
+ ! win32/config_H.vc win32/win32thread.h
+____________________________________________________________________________
+[ 280] By: nick on 1997/11/22 18:10:50
+ Log: ansiperl builds with Borland C++ again
+ Branch: ansiperl
+ ! pp_ctl.c regcomp.c regcomp.h regexec.c toke.c util.c
+ ! win32/config.bc win32/config_H.bc win32/perlglob.c
+ ! win32/win32.c win32/win32.h
+____________________________________________________________________________
+[ 279] By: nick on 1997/11/22 16:42:51
+ Log: Resolve ansiperl against mainline
+ Branch: ansiperl
+ !> embed.h ext/Thread/Thread.xs global.sym op.c op.h perl.c
+ !> perl.h pp.c pp_ctl.c pp_hot.c proto.h scope.c scope.h
+ !> t/lib/english.t thread.h toke.c util.c
+____________________________________________________________________________
+[ 278] By: nick on 1997/11/22 16:30:27
+ Log: Resolve ansiperl against win32
+ Branch: ansiperl
+ !> (integrate 55 files)
+____________________________________________________________________________
+[ 277] By: gsar on 1997/11/22 09:48:02
+ Log: - shift() inside BEGIN|END|INIT now shifts @ARGV instead of @_
+ - added a test for the above
+ - fixed up perly.c.diff and vms/perl_c.vms for above and added the
+ ansification hunks
+ Branch: win32/perl
+ ! op.c perly.c perly.c.diff perly.y t/op/misc.t vms/perly_c.vms
+____________________________________________________________________________
+[ 276] By: gsar on 1997/11/22 07:24:01
+ Log: Generic change in win32 branch: don't just turn on CRIPPLED_CC
+ when USE_THREADS. GCC for instance, can do without macros that use
+ globals. Instead, selectively re#define only those macros
+ that use globals to their functional equivalents. Tests 100% on
+ Solaris/gcc (after `chmod +x t/op/nothread.t t/lib/thread.t` (hint,hint)).
+ Branch: win32/perl
+ ! perl.h sv.h
+____________________________________________________________________________
+[ 275] By: gsar on 1997/11/22 05:27:04
+ Log: Integrate mainline.
+ Branch: win32/perl
+ +> ext/Thread/die.t ext/Thread/die2.t t/op/avhv.t
+ - lib/Class/Fields.pm lib/ISA.pm
+ !> (integrate 41 files)
+____________________________________________________________________________
+[ 274] By: mbeattie on 1997/11/21 18:28:22
+ Log: $_ is now per-thread (rather a lot of changes). Only tested under
+ *-linux-thread at the moment.
+ Branch: perl
+ ! embed.h ext/Thread/Thread.xs global.sym op.c op.h perl.c
+ ! perl.h pp.c pp_ctl.c pp_hot.c proto.h scope.c scope.h
+ ! t/lib/english.t thread.h toke.c util.c
+____________________________________________________________________________
+[ 273] By: mbeattie on 1997/11/21 10:31:29
+ Log: Filter patch to toke.c:
+ Subject: Tiny core patch for source filters
+ Date: Thu, 20 Nov 1997 23:12:09 +0000 (GMT)
+ From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ Branch: perl
+ ! toke.c
+____________________________________________________________________________
+[ 272] By: nick on 1997/11/21 00:54:43
+ Log: Basic integrate of lastest perl into ansiperl
+ Branch: ansiperl
+ +> ext/Thread/die.t ext/Thread/die2.t t/op/avhv.t
+ - lib/Class/Fields.pm lib/ISA.pm
+ ! win32/win32.c win32/win32.h
+ !> (integrate 57 files)
+____________________________________________________________________________
+[ 271] By: mbeattie on 1997/11/20 12:12:00
+ Log: Initial stab at IRIX configuration support for threading. Manually
+ applied parts of following patches:
+ Subject: Perl 5.004_54 on IRIX
+ Date: Wed, 19 Nov 1997 18:37:14 +0200 (EET)
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Subject: Re: Perl 5.004_54 on IRIX
+ Date: 19 Nov 1997 17:10:17 -0800
+ From: Scott Henry <scotth@sgi.com>
+ Branch: perl
+ ! README.threads hints/irix_6.sh hints/irix_6_0.sh
+ ! hints/irix_6_1.sh perl.h
+____________________________________________________________________________
+[ 270] By: mbeattie on 1997/11/19 17:45:37
+ Log: The new jumbo regexp stuff did SSPUSHINT on a char* instead of
+ SSPUSHPTR causing Alpha to core dump in pat.t. While fixing it,
+ also fixed two instances of referring to SVs after destruction.
+ Branch: perl
+ ! regcomp.c regexec.c
+____________________________________________________________________________
+[ 269] By: mbeattie on 1997/11/19 15:33:23
+ Log: avhv_keys under Digital UNIX made avhv.t fail because *keysp was
+ changed by mg_get(*keysp) (!). Introducing a new local variable
+ fixed it but I don't know if it's a compiler problem or some
+ other corruption happening elsewhere.
+ Branch: perl
+ ! av.c
+____________________________________________________________________________
+[ 268] By: mbeattie on 1997/11/19 11:39:49
+ Log: Let Configure sort out get{host,net}byaddr* prototypes:
+ Subject: [PATCH] 5.004_54: little something for
+ get{hos,ne}tbyaddr protos (Configure, config_h.SH, pp_sys.c)
+ Date: Tue, 18 Nov 1997 19:08:19 +0200 (EET)
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Branch: perl
+ ! Configure config_h.SH pp_sys.c
+____________________________________________________________________________
+[ 267] By: mbeattie on 1997/11/19 11:04:15
+ Log: Jumbo regexp patch applied (with minor fix-up tweaks):
+ Subject: Version 7 of Jumbo RE patch available
+ Date: Sun, 16 Nov 1997 00:29:39 -0500 (EST)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Branch: perl
+ ! MANIFEST dump.c embed.h global.sym mg.c op.c op.h perl.c
+ ! perl.h pod/perlre.pod pp.c pp_ctl.c pp_hot.c proto.h regcomp.c
+ ! regcomp.h regexec.c regexp.h sv.c t/op/misc.t t/op/pat.t
+ ! t/op/re_tests t/op/regexp.t t/op/split.t t/op/subst.t toke.c
+ ! util.c
+____________________________________________________________________________
+[ 266] By: mbeattie on 1997/11/18 17:26:09
+ Log: Separate avhv_foo() key handling into avhv_keys(). Slightly tweaked
+ version of patch:
+ Subject: tie fake hash patch for 5.004_54
+ Date: Sat, 15 Nov 1997 19:18:30 -0500
+ From: Joshua Pritikin <pritikin@mindspring.com>
+ Branch: perl
+ + t/op/avhv.t
+ ! av.c embed.h global.sym proto.h
+____________________________________________________________________________
+[ 265] By: mbeattie on 1997/11/18 16:51:04
+ Log: Bring MANIFEST up to date. Add new thread tests.
+ Branch: perl
+ + ext/Thread/die.t ext/Thread/die2.t
+ ! MANIFEST
+____________________________________________________________________________
+[ 264] By: mbeattie on 1997/11/18 16:41:27
+ Log: magic_setisa enhanced to update %FIELDS automatically when @ISA
+ is assigned to. Added tests to t/op/array.t. magic_setisa now
+ warns about including non-existent packages in @ISA when -w is on.
+ Branch: perl
+ - lib/Class/Fields.pm lib/ISA.pm
+ ! mg.c t/op/array.t
+____________________________________________________________________________
+[ 263] By: mbeattie on 1997/11/18 16:38:57
+ Log: Fix typo in win32 -> mainline integration.
+ Branch: perl
+ ! perl.h
+____________________________________________________________________________
+[ 262] By: mbeattie on 1997/11/18 11:56:09
+ Log: Integrate win32 branch back into mainline.
+ Branch: perl
+ - win32/win32io.c win32/win32io.h
+ ! op.c
+ !> (integrate 30 files)
+____________________________________________________________________________
+[ 261] By: gsar on 1997/11/18 00:14:02
+ Log: Export our own FD_SET() et al to complete sockets-as-handles pretense.
+ Branch: win32/perl
+ ! win32/config.bc win32/config.vc win32/config_H.bc
+ ! win32/config_H.vc win32/include/sys/socket.h win32/win32sck.c
+____________________________________________________________________________
+[ 260] By: nick on 1997/11/16 23:16:16
+ Log: Generic file changes for MYMALLOC
+ Branch: ansiperl
+ ! miniperlmain.c perl.c
+____________________________________________________________________________
+[ 259] By: nick on 1997/11/16 23:14:36
+ Log: MYMALLOC for Win32:
+ 1. Initialize malloc_mutex before it is used (all platforms!)
+ 2. Adjust #ifdef muddle to allow MYMALLOC and win32_ to coexist
+ 3. Tweak win32/config*.* to define MYMALLOC
+ 4. Provide sbrk() in terms of VirtualAlloc().
+
+ Also fixup -MT (perl95) build to handle Perl_current_thread
+ via call to DLL (as though an extension).
+ Branch: ansiperl
+ ! win32/Makefile win32/config.bc win32/config.vc
+ ! win32/config_H.bc win32/config_H.vc win32/makedef.pl
+ ! win32/makefile.mk win32/perllib.c win32/win32.c win32/win32.h
+ ! win32/win32iop.h win32/win32thread.h
+____________________________________________________________________________
+[ 258] By: nick on 1997/11/15 20:42:28
+ Log: Implement dTHR via __declspec(thread) - part 2
+ Branch: ansiperl
+ ! win32/makedef.pl win32/win32thread.c win32/win32thread.h
+____________________________________________________________________________
+[ 257] By: nick on 1997/11/15 19:52:53
+ Log: Use __declspec(thread) var rather tha TslAlloc & co.
+ Branch: ansiperl
+ ! win32/makedef.pl win32/win32thread.c win32/win32thread.h
+____________________________________________________________________________
+[ 256] By: gsar on 1997/11/15 02:58:09
+ Log: Add #include guard in Thread.xs so it will build even under
+ no USE_THREADS (for win32). This was missed because of edit
+ w/o checkout perforce kludge.
+ Branch: win32/perl
+ ! ext/Thread/Thread.xs
+____________________________________________________________________________
+[ 255] By: nick on 1997/11/15 00:33:46
+ Log: Integrate mainline (5.004_54?) into ansiperl
+ Branch: ansiperl
+ !> MANIFEST embed.h ext/Thread/Thread.pm ext/Thread/Thread.xs
+ !> ext/Thread/Thread/Specific.pm ext/Thread/join.t
+ !> ext/Thread/specific.t global.sym lib/fields.pm mg.c op.c
+ !> perl.c perl.h pp_ctl.c pp_hot.c pp_sys.c proto.h scope.c
+ !> t/io/pipe.t t/lib/io_pipe.t t/op/magic.t thread.h
+____________________________________________________________________________
+[ 254] By: nick on 1997/11/15 00:25:26
+ Log: Interate win32 into ansiperl
+ Branch: ansiperl
+ +> ext/Thread/Thread/Specific.pm ext/Thread/specific.t
+ +> lib/fields.pm
+ !> MANIFEST embed.h ext/Thread/Thread.pm ext/Thread/Thread.xs
+ !> ext/Thread/join.t global.sym mg.c op.c perl.c perl.h pp_ctl.c
+ !> pp_hot.c pp_sys.c proto.h scope.c t/io/pipe.t t/lib/io_pipe.t
+ !> t/op/magic.t thread.h win32/Makefile win32/config.bc
+ !> win32/config.vc win32/config_sh.PL win32/makefile.mk
+____________________________________________________________________________
+[ 253] By: gsar on 1997/11/14 22:04:58
+ Log: Integrate mainline changes into win32 branch. Now would be a good time
+ to reverse integrate the win32 branch into mainline.
+ Branch: win32/perl
+ +> ext/Thread/Thread/Specific.pm ext/Thread/specific.t
+ +> lib/fields.pm
+ !> MANIFEST embed.h ext/Thread/Thread.pm ext/Thread/Thread.xs
+ !> ext/Thread/join.t global.sym mg.c op.c perl.c perl.h pp_ctl.c
+ !> pp_hot.c pp_sys.c proto.h scope.c t/io/pipe.t t/lib/io_pipe.t
+ !> t/op/magic.t thread.h
----------------
-Version 5.003_05
+Version 5.004_54
----------------
-This patch was primarily to fix bugs and to clean up some of
-the remaining issues from in 5.003_04. The details are described below.
-A very brief summary is:
-
-o Visible Changes to Core Functionality
-
- -Add support for a READLINE method to tied filehandles.
-
- -times function now uses CLK_TCK if HZ is not available, rather
- than just defaulting to 60. times output might change on some
- systems, but should be correct now.
-
- -AnyDBM_File (modifying ISA does not work as expected)
- Now behaves as documented: Modifying ISA works to select
- order in which *DB* modules are tried. The default is still
- the same.
-
-o Configure and build enhancements
-
- -Enhance detection of [gs]etpgrp() variants. Some systems have
- BSD-style behavior for one and POSIX for the other. Use
- [gs]etpgid() instead, whenever possible.
-
- -You can now build a shared libperl.so without running through
- the LD_RUN_PATH hoops, if your system supports appropriate
- ld command-line options. Solaris, NetBSD, and Linux are currently
- supported. Others are easy to add. (This makes like a lot easier
- for embedders.)
-
- -VMS updates.
-
- -Fix installperl and installman so that the -n option really only
- prints commands. (previously, it would still do the mkdirs.)
-
-o Bug fixes
-
- -debugger ought to work.
-
- -A new heredoc tag in Makefile.SH is now quoted. This prevented
- 5.003_04 from working most places.
-
- -numerous smaller ones, detailed below.
-
-o Specific Changes
-
-Here are the specific file-by-file changes.
-
-# This is my patch perl5.003_05.pat to perl5.003_04
-# The full description is below.
-# Please execute the following commands before applying this patch.
-# (You can feed this patch to 'sh' to do so.)
-# -- Andy Dougherty
-
-# We'll create a new test, but patch won't automatically make it
-# executable.
-touch t/io/read.t
-chmod +x t/io/read.t
-
-exit 0
-
-
-This is patch perl5.003_05.pat to perl version 5.003_04.
-This takes you from 5.003_04 to 5.003_05.
-
-To apply this patch, run the above commands,
-cd to your perl source directory and then type
-
- patch -p1 -N < perl5.003_05.pat
-
-The changes are described after each /^Index/ line below. This is
-designed so you can examine each change with a command such as
-
- csplit -k perl5.003_05.pat '/^Index:/' '{99}'
-
-Index: Changes
-
- Updated for 5.003_05.
-
-Index: Configure
-
- Allow command line or hint-file overrides of $afs.
-
- Allow trailing spaces in nm output for HPUX10.
-
- Check for newer BIND 'search' directives in /etc/resolv.conf as well
- as older 'domain' directive.
-
- Enhance detection of [gs]etpgrp() variants. Some systems have
- BSD-style behavior for one and POSIX for the other. Use
- [gs]etpgid() instead, whenever possible.
-
- Include -s in the -h summary of available options.
-
- Allow command-line override of $afs.
-
- Handle trailing spaces in nm-output on HPUX10.
-
- Set shrpenv for handling LD_RUN_PATH, if needed. (This used to
- be in Makefile.SH. Now it's available for other modules too.)
-
- When using shared libperl, avoid LD_RUN_PATH if possible by adding
- correct ld flags. Currently, Solaris and NetBSD get the correct
- -R $archlibexp/CORE, and Linux gets its
- -Wl,-rpath,$archlibexp/CORE flag. Other contributions are
- welcome.
-
-Index: INSTALL
-
- Correct libperl5 -> libperl typo.
-
- Describe MakeMaker's Warning (will try anyway) messages.
-
- More info on where and how to send reports.
-
- Add info on non-Unix ports.
-
-
-Index: MANIFEST
-
- Add new test t/io/read.t.
-
- Add new hints files for ODBM_File for ultrix and hpux.
-
- Add new pod checker script.
-
-Index: Makefile.SH
-
- A new heredoc tag in Makefile.SH needs to be quoted.
-
- shrpenv stuff moved to Configure.
-
-Index: Porting/Glossary
-
- Updated to match Configure.
-
-Index: README.vms
-
- VMS 5.003_05 Update.
-
-Index: av.h
-
- Subject: turbidity in av.[ch]
- Date: Sun, 10 Dec 1995 00:21:31 -0500
- From: Gurusamy Sarathy
-
- Some unclean code that I noticed today.
-
-Index: config_H
-
- Updated to match newest config_h.SH.
-
-Index: config_h.SH
-
- Updated to match Configure.
-
- Changed the DLSYM_NEEDS_UNDERSCORE comment to
- /**/ to conform to metaconfig style.
-
-Index: emacs/cperl-mode.el
-
- From: Ilya Zakharevich
- Subject: Newer CPerl-mode
-
-Index: ext/DB_File/DB_File.pm
-
- Update to DB_File 1.03.
-
-Index: ext/DB_File/DB_File.xs
-
- Update to DB_File 1.03.
-
-Index: ext/Fcntl/Fcntl.pm
-
- Date: Thu, 5 Sep 1996 18:19:14 -0400 (EDT)
- From: Chip Salzenberg
- Subject: No AutoLoader for Fcntl
-
- Just like Socket, Fcntl doesn't need splitting and AutoLoading.
-
-Index: ext/FileHandle/FileHandle.pm
-
- From: Roderick Schertler
- Subject: FileHandle::DESTROY for fd 0
-
- This fixes FileHandle::DESTROY when called on stdin.
-
-Index: ext/ODBM_File/ODBM_File.xs
-
- Attempt to correct for "Bad free" in Ultrix and HPUX versions of
- odbm.
-
-Index: ext/ODBM_File/hints/hpux.pl
-
- Try to work around "bad free" in dbmclose().
-
-Index: ext/ODBM_File/hints/ultrix.pl
-
- Try to work around "bad free" in dbmclose().
-
-Index: ext/Socket/Socket.pm
-
- Date: Thu, 5 Sep 1996 09:58:08 +0200
- From: Andreas Koenig
- Subject: Patch to inhibit autosplit on Socket.pm
-
- This patch inhibits production and use of a completely useless
- auto/Socket/autosplit.ix.
-
-Index: handy.h
-
- Make a little more C++-friendly for IBM's CSET++ compiler.
-
-Index: hints/convexos.sh
-
- Remove [gs]etpgrp workaround. Configure & perl.h should handle
- this now.
-
-Index: hints/hpux.sh
-
- Add note about possible gcc GR3 warning message.
-
- Remove [gs]etpgrp workaround. Configure & perl.h should handle
- this now.
-
-Index: hints/sco.sh
-
- Turn off optimization for stock cc. This appears to
- prevent miniperl core dumps.
-
-Index: hints/solaris_2.sh
-
- Catch GNU ld even though it doesn't identify itself as a GNU tool.
- Thanks to Tim Pierce <twpierce@midway.uchicago.edu>.
-
-Index: hints/sunos_4_1.sh
-
- Describe solution for the __lib_version problem with acc on
- SunOS.
-
-Index: hv.c
-
- Date: Thu, 05 Sep 1996 00:25:28 -0400
- From: Gurusamy Sarathy
- Subject: minor misc. cleanup
-
- This patch makes some minor cleanups to the sources. No change
- in functionality whatsoever.
-
- Date: Thu, 05 Sep 1996 02:52:21 -0400
- From: Gurusamy Sarathy
-
- Subject: debugger problems--another patch (was Re: 5.003_04)
-
- I have tried to avoid copying of hash keys that are passed to
- magical hashes, but it seems that copying may be unavoidable
- since the hv_*_ent() functions could be PADTMPs (and other
- SVs that may get reused) as keys.
-
- VMS dynamic %ENV fix
-
-Index: installman
-
- From: scotth@sgi.com
- Subject: Re: installperl feature request (was: Re: Upgrade 4.0x to 5.001m)
-
- Fix installperl so that the -n option really only prints commands.
- (previously, it would still do the mkdirs.)
-
- an "ignore installed" option, so that it doesn't bother to check
- to see if the target already exists (an optimization that I
- *don't* want it to do when I do #1 above)
-
-Index: installperl
-
- From: scotth@sgi.com
- Subject: Re: installperl feature request (was: Re: Upgrade 4.0x to 5.001m)
-
- Fix installperl so that the -n option really only prints commands.
- (previously, it would still do the mkdirs.)
-
- an "ignore installed" option, so that it doesn't bother to check
- to see if the target already exists (an optimization that I
- *don't* want it to do when I do #1 above)
-
-Index: lib/AnyDBM_File.pm
-
- AnyDBM_File (modifying ISA does not work as expected)
- Now behaves as documented: Modifying ISA works to select
- order in which *DB* modules are tried. The default is still
- the same.
-
-
- Add helpful "die" message to end of AnyDBM_File. Previously
- it would return a 0, and the failure would eventually show up
- somewhere else in the script and be hard to track down. It is
- a failure if perl can't open AnyDBM_File. The test regression
- suite is supposed to indicate this as a failure too.
-
-Index: lib/ExtUtils/Install.pm
-
- Updated to MakeMaker-5.38.
-
- Fix for VMS utime.
-
-Index: lib/ExtUtils/Liblist.pm
-
- Updated to MakeMaker-5.38.
-
-Index: lib/ExtUtils/MM_Unix.pm
- Updated to MakeMaker-5.38.
-
-Index: lib/ExtUtils/MakeMaker.pm
-
- Updated to MakeMaker-5.38.
-
- Updated to MakeMaker-5.39 to allow CFLAGS in hint files.
-
-Index: lib/ExtUtils/Manifest.pm
-
- Updated to MakeMaker-5.38.
-
-Index: lib/ExtUtils/Mkbootstrap.pm
-
- Updated to MakeMaker-5.38.
-
-Index: lib/ExtUtils/Mksymlists.pm
-
- Updated to MakeMaker-5.38.
-
-Index: lib/File/Find.pm
-
- From: Michael Mahan <mahanm@nextwork.rose-hulman.edu>
- Subject: Cwd::fastcwd in File::Find
-
- Is there a good reason why File::Find uses Cwd::fastcwd instead of
- Cwd:cwd when fastcwd isn't as portable?
- [In particular, fastcwd() doesn't work on AFS.]
-
-Index: lib/Math/Complex.pm
-
- There was a mistake in the sqrt routine in lib/Math/Complex.pm that
- gave wrong answers when the magnitude of the imaginary part of the
- argument exceeded the magnitude of the real part. Line 69 had too
- many sqrt($y)'s. Further, expressions were re-arranged so that
- calls to the expensive real sqrt() routine were reduced from 4 to 2
- in this case.
-
-Index: lib/open3.pl
-
- The I/O directions on the dad_wtr and kid_rdr were backwards.
- IO/Open3.pm didn't have this error.
-
-Index: lib/syslog.pl
-
- Date: Tue, 03 Sep 1996 20:33:54 -0400
- From: Roderick Schertler
- Subject: syslog.pl `use Socket' lossage
-
- syslog.pl tries but fails to use
- Socket.pm, the problem is that use doesn't return a true value. This
- module should be recast in terms of Sys::Syslog, of course.
-
-Index: makedepend.SH
-
- This patch eliminates "\|" in sed patterns in makedepend.SH, since
- they're not really needed anyway in this one case.
-
-Index: mg.c
-
- Ok, here's a tested patch for the debugger problem.
- I was missing the fact that DB::dbline magic is actually
- uppercase (which means hv_store_ent() etc., will pass SV keys
- to the vtbl_dbline handlers).
-
- Replace the oft-repeated mg_ptr incantation with
- the simple MgPVKEY macro.
-
- Rename MgPVKEY to MgPV (to match with HePV elsewhere). Add
- additional parens around the "mg".
-
- (lines near 584) Part of VMS changes. I don't know what this did.
-
- Date: Fri, 23 Aug 1996 17:20:22 -0400 (EDT)
- From: Chip Salzenberg
- Subject: Integerize mg.c; eliminate warning on C< local($)) >
-
- This patch converts magic variables ($!, $^E, etc.) to use integers
- (C<sv_setiv>) instead of floats. It also eliminates a warning from
- C< local($)) >, via a hack similar to $!.
-
-Index: mg.h
-
- Replace the oft-repeated mg_ptr incantation with
- the simple MgPVKEY macro.
-
- Rename MgPVKEY to MgPV (to match with HePV elsewhere). Add
- additional parens around the "mg".
-
-Index: nostdio.h
-
- Add _STDIO_LOADED (VMS) to list of guard symbols.
-
-Index: op.c
-
- From: Gurusamy Sarathy
- Subject: Re: \ ( @array ) busted for lexical @array (once more)
-
-Index: patchlevel.h
-
- Change to subversion 5.
-
-Index: perl.c
-
- Make floating point constants Locale-friendly.
-
-Index: perl.h
-
- One last LONG & co. fix (yet another cut'n'paste error) and a few
- minor cleanups. Nothing crucial.
-
- Make a little more C++-friendly for IBM's CSET++ compiler.
-
- Enhance detection of [gs]etpgrp() variants. Some systems have
- BSD-style behavior for one and POSIX for the other. Use
- [gs]etpgid() instead, whenever possible.
-
-Index: perlio.c
-
- Eliminate potential "signed vs. unsigned" warning
-
- Add PerlIO_reopen and PerlIO_cgetname functions.
-
-Index: perlsdio.h
-
- Don't supply redundant parameters for PerlIO_open and PerlIO_fdopen.
-
- Include PerlIO_reopen and PerlIO_getname.
-
- s/FILE_(CNT|PTR)_LVALUE/STDIO_(CNT|PTR)_LVALUE to fix a typo.
- This had prevented SV_FAST_FGETS from working anywhere.
-
- Include PerlIO_canset_cnt. I'm not sure how this is supposed to
- differ from STDIO_CNT_LVALUE.
-
-Index: pod/Makefile
-
- Remove trailing spaces in pods.
- Include a call to the checkpods script in the Makefile (though it's
- not ordinarily used by users).
-
-Index: pod/checkpods.PL
-
- New script to check for common errors in pods. This is not
- normally called during the perl build process, but you can
- use it with B<make check>.
-
-Index: pod/perlfunc.pod
-
- Document correct C<use POSIX ":wait_h";> usage.
-
- Add notes about POSIX [gs]etpgrp.
-
-Index: pod/perlipc.pod
-
- Document correct C<use POSIX ":wait_h";> usage.
-
-Index: pod/perlref.pod
-
- From: Gurusamy Sarathy
- Subject: Re: \ ( @array ) busted for lexical @array (once more)
-
-Index: pod/perltie.pod
-
- Date: Thu, 29 Aug 1996 15:14:51 +0200
- From: Sven Verdoolaege <skimo@breughel.ufsia.ac.be>
- Subject: more TIEHANDLE
-
- This adds support for a READLINE method.
-
-Index: pod/perltrap.pod
-
- Here's documentation on the change in split's behavior between Perl 4
- and Perl 5.
-
- Subject: More (and less!) 425traps
-
- Large integer traps
-
- Precedence
-
- warn STDERR
-
- Change blank lines to empty lines.
-
-Index: pod/perlvar.pod
-
- Be explicit about $/="" matching empty lines, that is, lines
- with no spaces or tabs.
-
- Change blank lines to empty lines.
-
-Index: pp.c
-
- Date: Fri, 23 Aug 1996 17:22:40 -0400 (EDT)
- From: Chip Salzenberg
- Subject: Minor integer speedups in mathematics
-
- This patch provides minor speedups by using integer math and SVt_IV
- values when performing bitwise operations and modulus.
-
- Date: Tue, 3 Sep 1996 17:49:22 -0400 (EDT)
- From: Kenneth Albanowski
- Subject: Pack Patch (was Re: 5.002 - pack/unpack does not do "I" right)
-
- (double)auint cast added for call to sv_setnv().
-
-Index: pp_hot.c
-
- Date: Thu, 05 Sep 1996 00:25:28 -0400
- From: Gurusamy Sarathy
- Subject: minor misc. cleanup
-
- This patch makes some minor cleanups to the sources. No change
- in functionality whatsoever.
-
- Date: Thu, 29 Aug 1996 15:14:51 +0200
- From: Sven Verdoolaege <skimo@breughel.ufsia.ac.be>
- Subject: more TIEHANDLE
-
- This adds support for a READLINE method.
-
-Index: pp_sys.c
-
- Clear any buffer space exposed by by read().
- This is almost certainly a bug-fix.
-
- Undef and then re-define my_chsize from Perl_my_chsize to
- just plain chsize if this system HAS_CHSIZE. This probably only
- applies to SCO. This shows the perils of having internal
- functions with the same name as external library functions :-).
-
- Use CLK_TCK if HZ is not available.
-
-Index: sv.c
-
- Fix more spots where we had PerlIO_stderr() and should have had
- Perl_debug_log instead.
-
- Date: Fri, 23 Aug 1996 17:26:42 -0400 (EDT)
- From: Chip Salzenberg
- Subject: Minor potential bug in AV creation
-
- I wasn't the one who originated this patch. But it looks like it
- would improve the safety of AV creation.
-
- Remove potentially incorrect casts on PerlIO_set_ptrcnt.
- 'ptr' is already STDCHAR, which is supposed to be the type of
- char used in stdio.h, so we shouldn't have to cast it.
-
-Index: t/io/read.t
-
- Clear any buffer space exposed by by read().
- This is almost certainly a bug-fix.
-
-Index: t/lib/db-btree.t
-
- Update to DB_File 1.03.
-
-Index: t/lib/db-hash.t
-
- Update to DB_File 1.03.
-
-Index: t/lib/db-recno.t
-
- Update to DB_File 1.03.
-
-Index: t/lib/io_sock.t
-
- From: Lupe Christoph <lupe@alanya.m.isar.de>
- Subject: Perl 5.003.03: race condition in t/lib/io_sock.t
-
- io_sock.t works by forking a subprocess it can communicate with.
- It has the subprocess wait for the main process by sleeping 10
- seconds or until an alarm arrives.
-
- With my setup, the alarm signal arrives *before* the child
- has a chance to ignore the alarm signal.
-
- I fixed this by moving the "$SIG{ALRM} = sub {};" up before the
- fork. It does not hurt to have the parent ignore alarms, too.
-
-Index: t/op/inc.t
-
- One last LONG & co. fix (yet another cut'n'paste error) and a few
- minor cleanups. Nothing crucial.
-
-Index: t/op/misc.t
-
- Date: Thu, 29 Aug 1996 15:14:51 +0200
- From: Sven Verdoolaege <skimo@breughel.ufsia.ac.be>
- Subject: more TIEHANDLE
-
- This adds support for a READLINE method.
-
-Index: t/op/pack.t
-
- Date: Tue, 3 Sep 1996 17:49:22 -0400 (EDT)
- From: Kenneth Albanowski
- Subject: Pack Patch (was Re: 5.002 - pack/unpack does not do "I" right)
-
-Index: t/op/ref.t
-
- From: Gurusamy Sarathy
- Subject: Re: \ ( @array ) busted for lexical @array (once more)
-
-Index: universal.c
-
- Date: Thu, 29 Aug 96 07:05:10 BST
- From: Graham Barr
- Subject: Re: UNIVERSAL::class busted
-
- yes, but I also noticed that this does not check that the reference
- is an object, so the patch should be
-
-Index: unixish.h
-
- Change comment style so that IBM's picky xlc compiler doesn't
- think we've mistakenly tried to nest comments.
-
-Index: util.c
-
- One last LONG & co. fix (yet another cut'n'paste error) and a few
- minor cleanups. Nothing crucial.
-
-Index: utils/h2xs.PL
-
- Date: Fri, 6 Sep 1996 06:09:20 -0400 (EDT)
- From: Ilya Zakharevich
- Subject: updated h2xs
-
- Changes:
- a) Docs and examples for -x updated;
- b) Path to xxxx.h would not be changed to /usr/include/xxxx.h
- unless this file exists (outside of VMS, I'm afraid to make an error
- there). - Useful with -x option, when the file may be eaten via -I
- inside -F.
- c) .h file would be scanned only if needed.
- d) typemap would be generated (with T_PTROBJ).
- e) Documentation (=list) for autogenerated guys would be
- included into POD.
- f) duplicated XSUBs would not be generated;
- g) arguments to XSUBs being arrays are recognized (note that
- xsubpp would probably choke on such guys).
-
- -x option requires C-Scan-0.3 (releases a couple of minutes ago to
- ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl
- should propagate to CPAN soon).
-
-Index: utils/perlbug.PL
-
- Fix typo $Config{'has_sockets'} ought to be $Config{'d_socket'};
-
-Index: utils/perldoc.PL
-
- More choices in the pager war. Unfortunately, we can't rely on
- all users agreeing with the Sysadmin's choice, nor can we
- assign a default preference order, since opinions vary. If the
- user doesn't have $ENV{PAGER} set, we do want to pick up one that
- at least works, so we'll try whatever Configure found.
-
-Index: vms/Makefile
-
- VMS 5.003_05 Update.
-
-Index: vms/config.vms
-
- VMS 5.003_05 Update.
-
-Index: vms/descrip.mms
-
- VMS 5.003_05 Update.
-
-Index: vms/ext/Stdio/Stdio.pm
-
- VMS 5.003_05 Update.
-
-Index: vms/ext/filespec.t
-
- VMS 5.003_05 Update.
-
-Index: vms/gen_shrfls.pl
-
- VMS 5.003_05 Update.
-
-Index: vms/perlvms.pod
-
- VMS 5.003_05 Update.
-
-Index: vms/vms.c
-
- VMS 5.003_05 Update.
-
-Index: vms/vmsish.h
-
- VMS 5.003_05 Update.
-
+____________________________________________________________________________
+[ 252] By: mbeattie on 1997/11/14 15:07:19
+ Log: Two more delays added to test suite to help *-solaris-thread.
+ Branch: perl
+ ! t/io/pipe.t t/lib/io_pipe.t
+____________________________________________________________________________
+[ 251] By: mbeattie on 1997/11/14 15:05:57
+ Log: Remove stale code from Thread.xs.
+ Branch: perl
+ ! ext/Thread/Thread.xs
+____________________________________________________________________________
+[ 250] By: mbeattie on 1997/11/14 10:12:40
+ Log: Add delay to signal handling in t/op/magic.t. (Solaris with pthreads
+ doesn't run handlers for self-sent signals until kill has returned.)
+ Branch: perl
+ ! t/op/magic.t
+____________________________________________________________________________
+[ 249] By: gsar on 1997/11/14 05:14:44
+ Log: Fix various details in win32 makefiles and Config.pm setup.
+ - ldflags is set for both compilers now
+ - extensions list is now correct
+ - delete perl95.exe on distclean
+ - cf_time now gets updated (once)
+ - ccdlflags is set for Borland
+ - fix startperl so dprofpp works
+ Branch: win32/perl
+ ! win32/Makefile win32/config.bc win32/config.vc
+ ! win32/config_sh.PL win32/makefile.mk
+____________________________________________________________________________
+[ 248] By: mbeattie on 1997/11/13 18:01:27
+ Log: Rewrite thread return code to distinguish between ordinary return
+ and die() and make join propagate the die. Add tiny method eval
+ which just does "return eval { shift->join; }". Add Thread::Specific
+ class for access to thread specific user data along with specific.t.
+ Rename Class to classname throughout Thread.xs for consistency.
+ Fix pp_specific to pp_threadsv in global.sym. Add support to
+ pp_entersub in pp_hot.c to lock stash for static locked methods.
+ Branch: perl
+ + ext/Thread/Thread/Specific.pm ext/Thread/specific.t
+ + lib/fields.pm
+ ! MANIFEST embed.h ext/Thread/Thread.pm ext/Thread/Thread.xs
+ ! ext/Thread/join.t global.sym mg.c pp_hot.c thread.h
+____________________________________________________________________________
+[ 247] By: mbeattie on 1997/11/13 14:13:30
+ Log: Change CONTEXT to PERL_CONTEXT throughout source (since the #define
+ to avoid the Digital UNIX clash no longer works). Changed the #ifdef
+ in pp_sys.c for whether getnet* function get protoyped (since the
+ default had a broken prototype for getnetbyaddr).
+ Branch: perl
+ ! mg.c op.c perl.c perl.h pp_ctl.c pp_hot.c pp_sys.c proto.h
+ ! scope.c thread.h
+____________________________________________________________________________
+[ 246] By: nick on 1997/11/13 02:44:40
+ Log: Integrate Win32 branch
+ Branch: ansiperl
+ - configure ext/util/extliblist win32/bin/pl2bat.bat
+ - win32/bin/search.bat win32/bin/test.bat win32/bin/webget.bat
+ - win32/config.H win32/config.w32 win32/win32io.c
+ - win32/win32io.h
+ !> (integrate 905 files)
+____________________________________________________________________________
+[ 245] By: nick on 1997/11/13 00:47:54
+ Log: Integrate (-ay) win32 branch at its creation to
+ establish and ancestor as per perkforce technote #9
+ Branch: ansiperl
+ +> configure ext/util/extliblist win32/bin/pl2bat.bat
+ +> win32/bin/search.bat win32/bin/test.bat win32/bin/webget.bat
+ +> win32/config.H win32/config.w32
+ !> (integrate 859 files)
+____________________________________________________________________________
+[ 244] By: gsar on 1997/11/12 22:26:39
+ Log: More cleanups of win32/win32*.[ch] files. win32/win32iop.h now
+ contains the all the declarations and macros for the win32io layer.
+ New std-ish functions are exported now. All win32-specific exported
+ functions begin with "win32_" consistently. win32 version of
+ init_os_extras() is now exported, so embedders can get the in-core
+ xsubs.
+ Branch: win32/perl
+ ! dosish.h win32/makedef.pl win32/win32.c win32/win32.h
+ ! win32/win32iop.h win32/win32sck.c
+____________________________________________________________________________
+[ 243] By: gsar on 1997/11/12 07:41:52
+ Log: Really delete deleted files.
+ Branch: win32/perl
+ - win32/win32io.c win32/win32io.h
+____________________________________________________________________________
+[ 242] By: gsar on 1997/11/12 07:40:54
+ Log: Egregious IOsubsystem code excised. Phew, what a relief! Two
+ files (win32/win32io.[ch]) completely removed, as are all traces
+ of them in makefiles and MANIFEST. RunPerl() retains the void* arg
+ for later. Various myfoo() things regularized to my_foo(). CPP not
+ required anymore to create a perl binary :)
+ Branch: win32/perl
+ ! MANIFEST win32/Makefile win32/makedef.pl win32/makefile.mk
+ ! win32/perllib.c win32/runperl.c win32/win32.c win32/win32.h
+ ! win32/win32io.c win32/win32io.h win32/win32iop.h
+ ! win32/win32sck.c
+____________________________________________________________________________
+[ 241] By: gsar on 1997/11/12 05:31:28
+ Log: Fix various win32 code blemishes:
+ - s/stolen/win32/g
+ - s/(CROAK|WARN)/lc($1)/eg
+ - remove deadcode from most places
+ Branch: win32/perl
+ ! win32/makedef.pl win32/win32.c win32/win32io.c
+ ! win32/win32iop.h
+____________________________________________________________________________
+[ 240] By: gsar on 1997/11/12 04:36:29
+ Log: Carry over changes in ansiperl branch. Win32 branch is now
+ the leading edge.
+ Branch: win32/perl
+ ! embed.h global.sym perl.c win32/win32thread.c
+ ! win32/win32thread.h
+____________________________________________________________________________
+[ 239] By: gsar on 1997/11/12 03:39:57
+ Log: Add missing win32_closesocket() and export it (extension writers' complaint).
+ Branch: win32/perl
+ ! win32/include/sys/socket.h win32/makedef.pl win32/win32sck.c
+____________________________________________________________________________
+[ 238] By: gsar on 1997/11/12 03:25:17
+ Log: Clean up win32/win32sck.c (runtime load of Winsock now gone, it can be
+ done cleaner, if really needed (perhaps only for efficiency reasons?)).
+ Redundant EXTERN_C definitions and related warnings fixed.
+ Branch: win32/perl
+ ! miniperlmain.c perl.h win32/perllib.c win32/win32io.c
+ ! win32/win32iop.h win32/win32sck.c
+____________________________________________________________________________
+[ 237] By: nick on 1997/11/12 02:45:15
+ Log: Fixup Win32
+ - #undef start_env before re-#defining it
+ - change pp_specific pp_threadsv in global.sym
+ - re-build embed.h
+ - avoid HAVE_THREAD_INTERN - we don't and empty struct
+ is a pain. If we did have it it would contain cached
+ values of things we can only get at _IN_ the thread
+ so new_struct_thread is wrong place to call it.
+ - add new macro SET_THREAD_SELF - we must (in main thread)
+ define in win32thread.h, support in win32thread.c,
+ test and call in perl.c
+ Branch: ansiperl
+ ! embed.h global.sym perl.c thread.h win32/win32thread.c
+ ! win32/win32thread.h
+____________________________________________________________________________
+[ 236] By: nick on 1997/11/12 01:54:23
+ Log: Integrate mainline after it integrated us.
+ Accepted 'theirs' everywhere - so two branches should
+ now point to same files again.
+ Almost all of these were what was suggested, others were
+ whitespace diffs. A few dubious spots which we will now
+ go fix.
+ Branch: ansiperl
+ !> embed.h ext/DB_File/DB_File.xs ext/GDBM_File/GDBM_File.xs
+ !> ext/Opcode/Opcode.pm ext/Thread/Thread.xs interp.sym mg.c op.c
+ !> opcode.h opcode.pl perl.c perl.h pp.c pp_ctl.c pp_sys.c t/TEST
+ !> t/lib/safe2.t t/lib/thread.t t/op/nothread.t thread.h toke.c
+ !> util.c
+____________________________________________________________________________
+[ 235] By: gsar on 1997/11/12 01:22:26
+ Log: Minor tweaks to add a thread_intern struct that should ultimately
+ contain all the win32-specific statics.
+ Win32 branch now passes all tests with or w/o USE_THREADS.
+ Branch: win32/perl
+ ! embed.h perl.c win32/win32thread.c win32/win32thread.h
+____________________________________________________________________________
+[ 234] By: gsar on 1997/11/11 23:08:54
+ Log: Initial (untested) integration of mainline changes.
+ Branch: win32/perl
+ - configure
+ !> (integrate 89 files)
+____________________________________________________________________________
+[ 233] By: mbeattie on 1997/11/11 18:07:30
+ Log: Typo in thread.h: ADD_THREAD_INTERN should be HAVE_THREAD_INTERN
+ Branch: perl
+ ! thread.h
+____________________________________________________________________________
+[ 232] By: mbeattie on 1997/11/11 17:49:12
+ Log: t/TEST (reverted to @229 version) should have been included in the
+ previous change (231) but my way of recovering it didn't work
+ properly. The change 231 comments about successful tests applies
+ to this t/TEST (i.e. as of this change).
+ Branch: perl
+ ! t/TEST
+____________________________________________________________________________
+[ 231] By: mbeattie on 1997/11/11 17:46:59
+ Log: Fix up ansiperl integration. Back to passing all expected tests
+ with usethreads. Untested with non-threaded perl.
+ Branch: perl
+ ! embed.h ext/DB_File/DB_File.xs ext/GDBM_File/GDBM_File.xs
+ ! perl.c perl.h pp.c t/lib/thread.t t/op/nothread.t util.c
+____________________________________________________________________________
+[ 230] By: mbeattie on 1997/11/11 16:36:22
+ Log: Initial integration of ansi branch into mainline (untested).
+ Branch: perl
+ +> t/lib/thread.t t/op/nothread.t thread.sym
+ - configure
+ !> (integrate 84 files)
+____________________________________________________________________________
+[ 229] By: mbeattie on 1997/11/11 15:20:43
+ Log: Change name of OP_SPECIFIC to OP_THREADSV. Fixed perl_get_sv when
+ getting per-thread magicals. Fixed thr->errsv initialisation.
+ Branch: perl
+ ! ext/Opcode/Opcode.pm op.c opcode.h opcode.pl perl.c pp.c
+ ! t/lib/safe2.t toke.c
+____________________________________________________________________________
+[ 228] By: mbeattie on 1997/11/11 12:48:26
+ Log: Fix up $@ (ERRSV now refers to GvSV(errgv) for non-threaded perl and
+ thr->errsv for threaded perl). Fix pp_tie and pp_dbmopen to use
+ GvCV(gv) instead of gv so AUTOLOAD stuff works. All tests now pass
+ again for non-threaded perl. Enhanced perl_get_sv to return
+ per-thread magicals where necessary for threaded perl.
+ Branch: perl
+ ! embed.h ext/Thread/Thread.xs interp.sym mg.c op.c perl.c
+ ! perl.h pp_ctl.c pp_sys.c thread.h toke.c util.c
+____________________________________________________________________________
+[ 227] By: mbeattie on 1997/11/11 11:00:02
+ Log: hashlock bug.
+
+ Jobs fixed ...
+
+ hashlock fixed on 1997/11/11 by mbeattie@localhost
+
+ Subject: [perl5.004_53; patch] Another hash-locking fix
+ Date: 23 Oct 1997 14:13:55 -0400
+ From: Owen Taylor <owt1@cornell.edu>
+ Branch: bugs
+ + hashlock
+____________________________________________________________________________
+[ 226] By: gsar on 1997/11/11 02:11:23
+ Log: Slightly more refined lock() keyword recognition (using %INC).
+ Branch: win32/perl
+ ! toke.c
+____________________________________________________________________________
+[ 225] By: gsar on 1997/11/11 00:26:09
+ Log: "weak" lock keyword (hardcoded initial implementation) now works.
+ if not defined(&Thread::join) and defined(&__PACKAGE__::lock), 'lock'
+ is recognized as a sub, a regular keyword otherwise. Could be
+ generalized by storing a flag for every op in OP struct, and turning
+ the flag off when Thread.xs loads.
+ Branch: win32/perl
+ ! toke.c
+____________________________________________________________________________
+[ 224] By: gsar on 1997/11/10 22:59:55
+ Log: Merge a patch in preparation for "weak keywords":
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Message-Id: <199710080618.CAA23899@aatma.engin.umich.edu>
+ Subject: [PATCH] global overrides for keywords
+ Date: Wed, 08 Oct 1997 02:18:23 -0400
+ Branch: win32/perl
+ ! embed.h interp.sym perl.c perl.h toke.c
+____________________________________________________________________________
+[ 223] By: gsar on 1997/11/10 22:41:31
+ Log: Remove runlevel. It was used to count how many runops() calls
+ we were in the process of executing, and longjmp() to the topmost
+ one (if not already there). We use a null top_env->je_prev
+ to distinguish that now.
+ Branch: win32/perl
+ ! embed.h interp.sym perl.h pp_ctl.c run.c thread.h util.c
+____________________________________________________________________________
+[ 222] By: gsar on 1997/11/10 04:47:48
+ Log: Win32 branch now contains all non-ansification changes in ansiperl branch.
+ USE_THREADS case builds and passes all tests using both compilers.
+ Additional tweaks:
+ - fixup win32/makedef.pl to skip more symbols for non-thread build.
+ - sync win32/Makefile with win32/makefile.mk
+ >>>Non-thread build fails a lot of tests.<<<
+ Branch: win32/perl
+ + thread.sym
+ ! MANIFEST ext/Thread/Thread.xs perl.c perl.h pp_sys.c sv.c
+ ! util.c win32/Makefile win32/config.bc win32/config_H.bc
+ ! win32/makedef.pl win32/makefile.mk
+____________________________________________________________________________
+[ 221] By: gsar on 1997/11/10 00:57:53
+ Log: Initial (untested) merge of all non-ansi changes on ansiperl branch
+ into win32 branch.
+ Branch: win32/perl
+ + t/lib/thread.t t/op/nothread.t
+ ! MANIFEST embed.h ext/Opcode/Opcode.pm global.sym interp.sym
+ ! perl.c proto.h sv.h t/lib/english.t t/op/misc.t thread.h
+ ! util.c win32/Makefile win32/config.bc win32/config.vc
+ ! win32/config_H.bc win32/config_H.vc win32/makedef.pl
+ ! win32/makefile.mk win32/win32.c win32/win32.h win32/win32io.c
+ ! win32/win32io.h win32/win32iop.h win32/win32sck.c
+ ! win32/win32thread.c win32/win32thread.h
+____________________________________________________________________________
+[ 220] By: gsar on 1997/11/09 22:44:41
+ Log: Integrate latest mainline into win32 branch.
+ Branch: win32/perl
+ +> win32/win32thread.c win32/win32thread.h
+ !> (integrate 39 files)
+____________________________________________________________________________
+[ 219] By: nick on 1997/11/09 21:46:06
+ Log: Conditionalize english.t,
+ Enhance times() for NT,
+ (Failed) attempt to implement alarm(),
+ Fixed config.h dependancy in makefile.mk
+ Branch: ansiperl
+ ! t/lib/english.t win32/config.bc win32/config_H.bc
+ ! win32/makefile.mk win32/win32.c
+____________________________________________________________________________
+[ 218] By: nick on 1997/11/09 15:38:00
+ Log: Dick Hardt's patch for build on Alpha
+ Branch: ansiperl
+ ! win32/Makefile
+____________________________________________________________________________
+[ 217] By: nick on 1997/11/09 03:31:20
+ Log: MakeMaker not in vofig noise fix for dmake
+ Branch: ansiperl
+ ! win32/config.bc win32/makefile.mk
+____________________________________________________________________________
+[ 216] By: nick on 1997/11/09 03:15:06
+ Log: Fix 'anydbm.t' - if the gv is passed 1st call to inherited
+ TIEHASH works, but 2nd call (after db is closed, attempt
+ to reopen) tries to AUTOLOAD TIEHASH rather than using
+ cached value.
+ Branch: ansiperl
+ ! pp_sys.c
+____________________________________________________________________________
+[ 215] By: nick on 1997/11/08 16:41:24
+ Log: Cleanup MakeMaker 'not in config' noise
+ Branch: ansiperl
+ ! win32/Makefile win32/config.vc
+____________________________________________________________________________
+[ 214] By: nick on 1997/11/08 15:07:24
+ Log: Remove 'configure' leaving configure.gnu and Configure
+ Win32 ignores case and keeps trying to update
+ repository copy of 'configure' or 'Configure' with
+ the other.
+ Branch: ansiperl
+ - configure
+ ! MANIFEST
+____________________________________________________________________________
+[ 213] By: nick on 1997/11/08 15:03:39
+ Log: Get threads working again on Win32
+ Root cause of fail was init_thread_intern() in
+ new_struct_thread() (which is called in parent thread)
+ clobbering dTHR of parent thread.
+ It is doubtfull if setting 'self' in new_struct_thread()
+ is 'right' but left in for now.
+ Branch: ansiperl
+ ! ext/Thread/Thread.xs perl.c thread.h util.c win32/Makefile
+ ! win32/win32thread.c win32/win32thread.h
+____________________________________________________________________________
+[ 212] By: nick on 1997/11/08 00:34:03
+ Log: Add :base_thread to :default in Opcode.pm
+ This allows lib/safe.t to pass when threaded.
+ It is unclear if 'lock' should be safe as it allows
+ denial of service attack, but could not figure out
+ how to add just 'specific' (sic) to :default
+ without triggering 'already tagged' warning noise.
+ Branch: ansiperl
+ ! ext/Opcode/Opcode.pm win32/makefile.mk
+____________________________________________________________________________
+[ 211] By: nick on 1997/11/07 23:59:31
+ Log: Merge changes as of 18:00 CST
+ Branch: ansiperl
+ !> op.c pp.c pp_sys.c thread.h util.c
+____________________________________________________________________________
+[ 210] By: nick on 1997/11/07 23:52:35
+ Log: Reverse integrate Malcolm's chanes into local
+ repository, then import result back into my view
+ of Malcolm's repository.
+ Builds and passes (most) tests with GNU C++/Solaris
+ and Borland C++, Win32.
+ Branch: ansiperl
+ ! doop.c embed.h ext/Thread/Thread.xs global.sym gv.c hv.c
+ ! interp.sym mg.c op.c opcode.h opcode.pl patchlevel.h perl.c
+ ! perl.h pp.c pp_ctl.c pp_sys.c proto.h sv.c sv.h taint.c
+ ! thread.h toke.c util.c win32/makefile.mk
+____________________________________________________________________________
+[ 209] By: mbeattie on 1997/11/07 18:12:36
+ Log: Change pp_tie and pp_dbmopen to use perl_call_sv instead of a
+ DIY pp_entersub (in preparation for AUTOLOAD change). dbmopen
+ not tested. ofslen now maps to thr->Tofslen in thread.h. Added
+ missing #ifdef USE_THREADS around some DEBU_L statements in die().
+ Building without USE_THREADS fails quite a lot of tests. It looks
+ as though the move to per-thread magicals must be missing some
+ #ifdef USE_THREADS.
+ Branch: perl
+ ! op.c pp.c pp_sys.c thread.h util.c
+____________________________________________________________________________
+[ 208] By: nick on 1997/11/07 01:37:28
+ Log: Raw integrate of latest perl
+ Branch: ansiperl
+ ! t/TEST
+ !> README.threads Todo.5.005 embed.h ext/Opcode/Opcode.pm
+ !> ext/Thread/Thread.xs global.sym gv.c interp.sym op.c op.h
+ !> perl.c perl.h pp.c pp_ctl.c pp_hot.c proto.h scope.h sv.h
+ !> thread.h toke.c util.c
+____________________________________________________________________________
+[ 207] By: mbeattie on 1997/11/06 14:58:00
+ Log: Update README.threads and Todo.5.005.
+ Branch: perl
+ ! README.threads Todo.5.005
+____________________________________________________________________________
+[ 206] By: mbeattie on 1997/11/06 14:37:37
+ Log: Remove #ifdef DEPRECATED stuff: newXSUB, pp_entersubr, FREE_TMPS().
+ Branch: perl
+ ! op.c pp_ctl.c proto.h scope.h
+____________________________________________________________________________
+[ 205] By: mbeattie on 1997/11/06 14:31:38
+ Log: Per-thread magicals now stored in their own thr->magicals and keyed
+ more directly. cvcache and oursv become ordinary struct thread
+ fields instead of #defined thr->Tfoo ones. SvREFCNT_inc now checks
+ for 0 again. Main thread initialisation done by new function
+ init_main_thread instead of (now fixed) new_struct_thread.
+
+ Jobs fixed ...
+
+ jmpenv fixed on 1997/11/06 by mbeattie@localhost
+
+ Subject: [perl5.004_53; patch] eval's and threads
+ Date: 23 Oct 1997 23:59:19 -0400
+ From: Owen Taylor <owt1@cornell.edu>
+ Branch: bugs
+ + jmpenv
+ Branch: perl
+ ! embed.h ext/Thread/Thread.xs global.sym gv.c op.c perl.c
+ ! pp_ctl.c pp_hot.c proto.h sv.h thread.h toke.c util.c
+____________________________________________________________________________
+[ 204] By: mbeattie on 1997/11/05 17:18:18
+ Log: Per-thread magicals mostly working (and localisable). Now getting
+ intermittent occasional "Use of uninitialized value" warnings
+ which may be due to some op flag black magic I've broken.
+ Branch: perl
+ ! embed.h ext/Opcode/Opcode.pm ext/Thread/Thread.xs gv.c
+ ! interp.sym op.c op.h perl.c perl.h pp.c thread.h toke.c util.c
+____________________________________________________________________________
+[ 203] By: nick on 1997/11/05 01:04:10
+ Log: Builds C++ Borland, MSVC++ (Win32) and GCC++ (Solaris)
+ Branch: ansiperl
+ ! XSUB.h doio.c doop.c embed.h ext/SDBM_File/sdbm/sdbm.h
+ ! ext/Thread/Thread.xs global.sym gv.c hv.c interp.sym mg.c
+ ! miniperlmain.c op.c op.h opcode.h opcode.pl patchlevel.h
+ ! perl.c perl.h pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c proto.h
+ ! sv.c sv.h taint.c thread.h toke.c util.c win32/Makefile
+ ! win32/config.vc win32/config_H.vc win32/makedef.pl
+ ! win32/makefile.mk win32/perllib.c win32/win32.c win32/win32.h
+ ! win32/win32io.c win32/win32io.h win32/win32iop.h
+ ! win32/win32sck.c win32/win32thread.h
+____________________________________________________________________________
+[ 202] By: nick on 1997/11/05 00:50:27
+ Log: Compile(d) at least once with threads on win32
+ but did not work
+ Branch: ansiperl
+ ! embed.h perl.c thread.h
+____________________________________________________________________________
+[ 201] By: nick on 1997/11/05 00:32:13
+ Log: Trivial integrate
+ Branch: ansiperl
+ !> patchlevel.h
+____________________________________________________________________________
+[ 200] By: mbeattie on 1997/11/04 12:06:09
+ Log: Up patchlevel to 5.004_54 (I missed _53 for the last release).
+ Branch: perl
+ ! patchlevel.h
+____________________________________________________________________________
+[ 199] By: nick on 1997/11/01 00:18:52
+ Log: Integrate mainline @ 18:15 CST 31 Oct 1997
+ Branch: ansiperl
+ !> doop.c embed.h ext/Thread/Thread.xs global.sym gv.c hv.c
+ !> interp.sym mg.c op.c opcode.h opcode.pl perl.c perl.h pp.c
+ !> pp_ctl.c pp_sys.c proto.h sv.c sv.h taint.c thread.h toke.c
+ !> util.c
+____________________________________________________________________________
+[ 198] By: nick on 1997/11/01 00:08:33
+ Log: win32thread.* not in MANIFEST which has muddled moving
+ back and forth between depots.
+ Branch: ansiperl
+ ! MANIFEST win32/win32thread.c win32/win32thread.h
+____________________________________________________________________________
+[ 197] By: nick on 1997/11/01 00:02:49
+ Log: Test changes
+ Branch: ansiperl
+ + t/lib/thread.t t/op/nothread.t thread.sym
+ ! MANIFEST
+____________________________________________________________________________
+[ 196] By: nick on 1997/10/31 23:54:01
+ Log: Further ANSI changes now builds and passes (most) tests
+ with gcc -x c++.
+ Branch: ansiperl
+ ! INTERN.h embed.h ext/DynaLoader/dl_dlopen.xs
+ ! ext/Fcntl/Fcntl.xs ext/GDBM_File/GDBM_File.xs ext/IO/IO.xs
+ ! ext/Opcode/Opcode.xs ext/POSIX/POSIX.xs
+ ! ext/SDBM_File/sdbm/hash.c ext/SDBM_File/sdbm/pair.c
+ ! ext/SDBM_File/sdbm/sdbm.c ext/SDBM_File/sdbm/sdbm.h
+ ! ext/SDBM_File/sdbm/util.c ext/Socket/Socket.xs
+ ! ext/Thread/Thread.xs ext/attrs/attrs.xs global.sym perl.h
+ ! perly.c sv.c t/lib/english.t t/op/misc.t thread.h util.c
+ ! win32/Makefile win32/makedef.pl win32/makefile.mk x2p/a2p.c
+ ! x2p/a2p.h x2p/a2py.c x2p/hash.c x2p/str.c x2p/util.c
+ ! x2p/walk.c
+____________________________________________________________________________
+[ 195] By: mbeattie on 1997/10/31 18:05:31
+ Log: Half way through moving per-thread magicals into per-thread fields
+ and the associated new OP_SPECIFIC and find_thread_magical stuff.
+ perl will compile but plenty of the magicals are still broken.
+ Branch: perl
+ ! doop.c embed.h ext/Thread/Thread.xs global.sym gv.c hv.c
+ ! interp.sym mg.c op.c opcode.h opcode.pl perl.c perl.h pp.c
+ ! pp_ctl.c pp_sys.c proto.h sv.c sv.h taint.c thread.h toke.c
+ ! util.c
+____________________________________________________________________________
+[ 194] By: nick on 1997/10/31 01:43:49
+ Log: Convert miniperl sources to ANSI C. Several passes of
+ GNU C's 'protoize' plus a few hand edits.
+ Will compile miniperl with gcc -x c++ (i.e. treat .c a C++ files)
+ Does not link seems gcc's C++ does not define a symbol for
+ const char foo[] = "....";
+ i.e. with empty [].
+ Branch: ansiperl
+ ! av.c deb.c doio.c doop.c dump.c gv.c hv.c malloc.c mg.c
+ ! miniperlmain.c op.c perl.c perl.h perlio.c perly.y pp.c
+ ! pp_ctl.c pp_hot.c pp_sys.c regcomp.c regexec.c run.c scope.c
+ ! sv.c taint.c toke.c universal.c util.c
+____________________________________________________________________________
+[ 193] By: nick on 1997/10/30 03:00:01
+ Log: Make the ansi branch
+ Branch: ansiperl
+ +> (branch 907 files)
+____________________________________________________________________________
+[ 192] By: nick on 1997/10/30 02:48:17
+ Log: Oneperl builds with THREADS/THISPTR Borland
+ Manualy inserted Sarathy's new COND_XXXXX from his mail.
+ Manual change if Tself -> self as was easier than resolve :-(
+ Two aTHIS's in op.c
+ Branch: oneperl
+ ! embed.h op.c thread.h thread.sym win32/makefile.mk
+ ! win32/win32thread.h
+____________________________________________________________________________
+[ 191] By: nick on 1997/10/30 01:54:50
+ Log: Raw resolve of latest sources with oneperl
+ Branch: oneperl
+ !> Todo.5.005 ext/Thread/Thread.xs fakethr.h op.c op.h opcode.h
+ !> opcode.pl perl.c thread.h win32/win32thread.c
+ !> win32/win32thread.h
+____________________________________________________________________________
+[ 190] By: mbeattie on 1997/10/29 14:39:54
+ Log: Remove global macro "self". Change thr->Tself to thr->self.
+ Branch: perl
+ ! ext/Thread/Thread.xs fakethr.h perl.c thread.h
+ ! win32/win32thread.c win32/win32thread.h
+____________________________________________________________________________
+[ 189] By: mbeattie on 1997/10/29 12:49:01
+ Log: Add to Todo: compiler with fake SvCUR in comppad_name entries.
+ Branch: perl
+ ! Todo.5.005
+____________________________________________________________________________
+[ 188] By: mbeattie on 1997/10/29 12:45:32
+ Log: Add pp_lock knowledge to compiler
+ Branch: perlext
+ ! Compiler/ccop.c Compiler/ccop.h
+____________________________________________________________________________
+[ 187] By: mbeattie on 1997/10/29 12:45:02
+ Log: Change peep() to optimise away unneeded rv2av in lval->[] and lval->{}
+ Branch: perl
+ ! op.c
+____________________________________________________________________________
+[ 186] By: mbeattie on 1997/10/29 12:43:36
+ Log: Move compiler OP class information into opcode.pl.
+ Branch: perl
+ ! op.h opcode.h opcode.pl
+____________________________________________________________________________
+[ 185] By: nick on 1997/10/26 22:52:05
+ Log: Split failing test in op/misc.t into op/nothread.t
+ so all tests can be passed where they apply.
+ Cleanup other two cases of THREADS/THISPTR.
+ Conditional compile option for CriticalSection's on Win32
+ Branch: oneperl
+ + t/op/nothread.t
+ ! sv.h t/op/misc.t win32/Makefile win32/makedef.pl
+ ! win32/win32thread.h
+____________________________________________________________________________
+[ 184] By: nick on 1997/10/26 19:42:00
+ Log: USE_THISPTR fixes for CRIPPLED_CC (implied by threads)
+ Branch: oneperl
+ ! embed.h global.sym proto.h sv.c sv.h toke.c
+____________________________________________________________________________
+[ 183] By: nick on 1997/10/26 18:31:58
+ Log: Make USE_THREADS imply CRIPPLED_CC.
+ This avoids most of the uses of 'Sv' and hence many needs of
+ dTHR in extension code.
+ With this change Data::Dumper builds as-is
+ and Tk only needs four tweaks:
+ 1. Obscure dump-stack case which really needs dTHR
+ 2. A curcop in error-message code
+ 3. Two cases of SAVETMPS
+ 4. A curcop == &compiling which is probably not required.
+ IMHO the SAVETMPS case is only one which merits further automation.
+ Branch: oneperl
+ ! embed.h global.sym perl.h sv.c win32/Makefile win32/makedef.pl
+____________________________________________________________________________
+[ 182] By: nick on 1997/10/26 16:31:58
+ Log: Change dSP to imply dTHR for extension source compatibility
+ introduce djSP (Declare Just SP) for use in perl sources
+ and thread-aware extensions. Use latter.
+ Branch: oneperl
+ ! XSUB.h doio.c doop.c ext/Thread/Thread.xs gv.c mg.c perl.c
+ ! pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c sv.c
+____________________________________________________________________________
+[ 181] By: nick on 1997/10/26 00:39:57
+ Log: More tests
+ Branch: oneperl
+ ! t/lib/thread.t
+____________________________________________________________________________
+[ 180] By: nick on 1997/10/25 22:18:27
+ Log: Use return of THREAD_CREATE() - add basic thread test
+ Branch: oneperl
+ + t/lib/thread.t
+ ! ext/Thread/Thread.xs
+____________________________________________________________________________
+[ 179] By: nick on 1997/10/25 21:25:23
+ Log: Builds with no thread/this
+ Branch: oneperl
+ ! ext/Thread/Thread.xs t/lib/english.t win32/makedef.pl
+ ! win32/win32thread.c
+____________________________________________________________________________
+[ 178] By: nick on 1997/10/25 18:28:03
+ Log: Cleanup dead #ifdef branch introduced by scruffy merging.
+ Branch: oneperl
+ ! perl.c
+____________________________________________________________________________
+[ 177] By: nick on 1997/10/25 18:11:33
+ Log: Basic integrate of oneperl with threads, passes
+ tests THISPTR+THREADs - win32/win32thread.* needed
+ changes (where did they come from)?
+ Branch: oneperl
+ ! embed.h ext/Thread/Thread.xs perl.h thread.h win32/Makefile
+ ! win32/makedef.pl win32/win32thread.c win32/win32thread.h
+____________________________________________________________________________
+[ 176] By: nick on 1997/10/25 17:05:52
+ Log: Onepel builds THISPTR no threads
+ Branch: oneperl
+ ! ext/Thread/Thread.xs thread.h win32/makedef.pl
+____________________________________________________________________________
+[ 175] By: nick on 1997/10/25 16:40:10
+ Log: Integrate oneperl with new style JOIN etc. macros
+ Branch: oneperl
+ +> win32/win32thread.c win32/win32thread.h
+ !> Todo.5.005 ext/POSIX/POSIX.xs ext/Thread/Thread.xs fakethr.h
+ !> global.sym gv.c hv.c mg.c op.c opcode.h opcode.pl perl.c
+ !> perl.h pp.c pp_hot.c sv.h thread.h vms/descrip.mms
+ !> vms/gen_shrfls.pl vms/vms.c vms/vmsish.h win32/Makefile
+ !> win32/makefile.mk
+____________________________________________________________________________
+[ 174] By: mbeattie on 1997/10/24 17:14:00
+ Log: Remove xcv_condp CV field which is no longer used.
+ Branch: perl
+ ! sv.h
+____________________________________________________________________________
+[ 173] By: mbeattie on 1997/10/24 14:36:09
+ Log: Patches for VMS [Dan Sugalski]
+ Branch: bugs
+ + vms2
+ Branch: perl
+ ! ext/POSIX/POSIX.xs vms/descrip.mms vms/gen_shrfls.pl vms/vms.c
+ ! vms/vmsish.h
+____________________________________________________________________________
+[ 172] By: mbeattie on 1997/10/24 13:50:59
+ Log: Improve internal threading API. Introduce win32/win32thread.[ch]
+ to use new API and patch win32 makefile stuff a little.
+ Branch: perl
+ + win32/win32thread.c win32/win32thread.h
+ ! Todo.5.005 ext/Thread/Thread.xs fakethr.h global.sym gv.c hv.c
+ ! perl.c perl.h thread.h win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 171] By: mbeattie on 1997/10/23 14:00:27
+ Log: Fix pp_hot.c:get_db_sub core dump when perl debugger used.
+
+ Jobs fixed ...
+
+ get_db_sub fixed on 1997/10/23 by mbeattie@squash
+
+ Subject: [perl5.004_53] Debugger crash (patch)
+ Date: Thu, 16 Oct 1997 22:03:09 -0400
+ From: Owen Taylor <owt1@cornell.edu>
+ Branch: bugs
+ + get_db_sub
+ Branch: perl
+ ! pp_hot.c
+____________________________________________________________________________
+[ 170] By: mbeattie on 1997/10/23 09:22:40
+ Log: Fix refcounts for lock/magic_mutexfree. Make OP_LOCK auto-ref
+ its argument using ck_rfun as OP_DEFINED. Make pp_lock return
+ a ref to its argument for AV, HV, CV.
+ Branch: perl
+ ! mg.c op.c opcode.h opcode.pl pp.c pp_hot.c
+____________________________________________________________________________
+[ 169] By: gsar on 1997/10/21 03:49:25
+ Log: With these fixes, oneperl builds THISPTR && THREADS under both win32 compilers:
+ - Fixup static functions that were missing aTHIS.
+ - s/extern/EXT/ in dTHR macro, or Borland CC croaks.
+ - Removed static functions from global.sym.
+ - Typo in perl.h.
+ - Additions to makefile.mk.
+ Branch: oneperl
+ ! embed.h embed.pl global.sym op.c perl.h pp_ctl.c toke.c
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 168] By: nick on 1997/10/20 02:47:18
+ Log: Passes expected tests with -DUSE_THREADS with/without -DUSE_THISPTR
+ Branch: oneperl
+ ! embed.h ext/Thread/Thread.xs mg.c pp.c pp_hot.c proto.h
+ ! scope.h thread.h
+____________________________________________________________________________
+[ 167] By: nick on 1997/10/20 01:03:00
+ Log: Add missing aTHIS in cast
+ Branch: oneperl
+ ! win32/dl_win32.xs
+____________________________________________________________________________
+[ 166] By: nick on 1997/10/20 00:44:42
+ Log: Builds and passes test with -DUSE_THISPTR
+ Branch: oneperl
+ ! ext/Thread/Thread.xs win32/Makefile win32/makedef.pl
+ ! win32/perllib.c
+____________________________________________________________________________
+[ 165] By: nick on 1997/10/19 21:45:36
+ Log: Oneperl runs miniperl with THISPTR (Win32 threading patch included)
+ Branch: oneperl
+ ! embed.h ext/Thread/Thread.xs global.sym interp.sym perl.c
+ ! perl.h t/TEST thread.h win32/Makefile win32/makedef.pl
+ ! win32/makefile.mk win32/perllib.c
+____________________________________________________________________________
+[ 164] By: nick on 1997/10/19 20:09:13
+ Log: oneperl compiles (but fails) with -DUSE_THISPTR
+ Branch: oneperl
+ ! av.c embed.h mg.c perl.c perl.h pp.c pp_ctl.c pp_hot.c
+ ! pp_sys.c proto.h regexec.c sv.c thread.h thread.sym util.c
+ ! win32/win32.c win32/win32.h
+____________________________________________________________________________
+[ 163] By: nick on 1997/10/19 16:46:09
+ Log: Builds on NT4 without THISPTR or THREADS, passes all tests
+ Branch: oneperl
+ ! embed.h perl.h thread.h vars.h
+____________________________________________________________________________
+[ 162] By: nick on 1997/10/19 14:42:16
+ Log: Dubious merge of oneperl's variable and struct thread
+ Branch: oneperl
+ !> perl.h thread.h
+____________________________________________________________________________
+[ 161] By: nick on 1997/10/18 18:05:13
+ Log: integrate all but perl.h/thread.h
+ Branch: oneperl
+ +> Todo.5.005 perlio.sym
+ !> (integrate 98 files)
+____________________________________________________________________________
+[ 160] By: nick on 1997/10/18 03:49:27
+ Log: Integrate rest of sub-dirs into oneperl
+ Branch: oneperl
+ +> ext/Thread/Makefile.PL ext/Thread/Notes ext/Thread/README
+ +> ext/Thread/Thread.pm ext/Thread/Thread.xs
+ +> ext/Thread/Thread/Queue.pm ext/Thread/Thread/Semaphore.pm
+ +> ext/Thread/create.t ext/Thread/io.t ext/Thread/join.t
+ +> ext/Thread/join2.t ext/Thread/list.t ext/Thread/lock.t
+ +> ext/Thread/queue.t ext/Thread/sync.t ext/Thread/sync2.t
+ +> ext/Thread/typemap ext/Thread/unsync.t ext/Thread/unsync2.t
+ +> ext/Thread/unsync3.t ext/Thread/unsync4.t hints/newsos4.sh
+ +> hints/os390.sh
+ - ext/util/extliblist
+ !> (integrate 425 files)
+____________________________________________________________________________
+[ 159] By: nick on 1997/10/18 03:20:11
+ Log: Integrate (accept) t and win32 into oneperl
+ Branch: oneperl
+ +> t/lib/dosglob.t win32/bin/pl2bat.pl win32/bin/runperl.pl
+ +> win32/bin/search.pl win32/bin/webget.pl win32/config.bc
+ +> win32/config.vc win32/config_H.bc win32/config_H.vc
+ +> win32/makefile.mk
+ !> (integrate 188 files)
+____________________________________________________________________________
+[ 158] By: nick on 1997/10/18 03:12:59
+ Log: Integrate lib/... into oneperl
+ Branch: oneperl
+ +> lib/File/DosGlob.pm lib/base.pm lib/chat2.pl
+ !> (integrate 138 files)
+____________________________________________________________________________
+[ 157] By: nick on 1997/10/18 02:55:53
+ Log: Make lib/Bundle/CPAN.pm text in oneperl too.
+ Branch: oneperl
+ ! lib/Bundle/CPAN.pm
+____________________________________________________________________________
+[ 156] By: nick on 1997/10/18 02:52:44
+ Log: Make lib/Bundle/CPAN.pm a text file
+ Branch: perl
+ ! lib/Bundle/CPAN.pm
+____________________________________________________________________________
+[ 155] By: nick on 1997/10/18 02:33:02
+ Log: Some weirdness in the intgrate process
+ Branch: oneperl
+ - win32/bin/pl2bat.bat win32/bin/search.bat win32/bin/test.bat
+ - win32/bin/webget.bat win32/config.H win32/config.w32
+____________________________________________________________________________
+[ 153] By: nick on 1997/10/18 02:29:16
+ Log: Let us try all the pure integrate stuff
+ Branch: oneperl
+ !> (integrate 647 files)
+____________________________________________________________________________
+[ 152] By: nick on 1997/10/18 02:13:35
+ Log: Get more sub directories out of the way.
+ Branch: oneperl
+ !> (integrate 92 files)
+____________________________________________________________________________
+[ 151] By: nick on 1997/10/18 02:05:41
+ Log: Integrate hints
+ Branch: oneperl
+ !> (integrate 68 files)
+____________________________________________________________________________
+[ 150] By: nick on 1997/10/18 01:57:20
+ Log: Try reopening some non-contravertial files
+ Branch: oneperl
+ !> x2p/EXTERN.h x2p/INTERN.h x2p/Makefile.SH x2p/a2p.c x2p/a2p.h
+ !> x2p/a2p.pod x2p/a2p.y x2p/a2py.c x2p/cflags.SH
+ !> x2p/find2perl.PL x2p/hash.c x2p/hash.h x2p/proto.h x2p/s2p.PL
+ !> x2p/str.c x2p/str.h x2p/util.c x2p/util.h x2p/walk.c
+____________________________________________________________________________
+[ 144] By: gsar on 1997/10/16 22:26:07
+ Log: Merge changes to Thread and add makefile fixups to accomodate Thread
+ build. Once again, builds and runs all Thread tests using either
+ compiler.
+ Branch: win32/perl
+ ! embed.h ext/Thread/Thread.xs interp.sym perl.c win32/Makefile
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 143] By: gsar on 1997/10/16 20:45:58
+ Log: A quick merge of latest mainline.
+ Branch: win32/perl
+ +> ext/Thread/Makefile.PL ext/Thread/Notes ext/Thread/README
+ +> ext/Thread/Thread.pm ext/Thread/Thread.xs
+ +> ext/Thread/Thread/Queue.pm ext/Thread/Thread/Semaphore.pm
+ +> ext/Thread/create.t ext/Thread/io.t ext/Thread/join.t
+ +> ext/Thread/join2.t ext/Thread/list.t ext/Thread/lock.t
+ +> ext/Thread/queue.t ext/Thread/sync.t ext/Thread/sync2.t
+ +> ext/Thread/typemap ext/Thread/unsync.t ext/Thread/unsync2.t
+ +> ext/Thread/unsync3.t ext/Thread/unsync4.t hints/os390.sh
+ +> lib/base.pm t/lib/dosglob.t
+ - ext/util/extliblist
+ !> (integrate 134 files)
----------------
-Version 5.003_04
+Version 5.004_53
----------------
-This patch was primarily to fix bugs and to clean up some of
-the changes made in 5.003_03. The details are described below.
-A very brief summary is:
-
-o Visible Changes to Core Functionality
-
- -Allow and document permissions for FileHandle::new and
- IO::File::new.
- -glob in Safe compartment used to allow shell access; now
- it's in the same category as `` and system().
-
-o Configure and build enhancements
-
- -perl library name is again -lperl, not -lperl5 in some cases.
- -Several hint files no longer set -g -DDEBUGGING by default.
- Instead, they just turn off optimization, since that is
- probably what was intended.
- -Include OS/2 and Plan9 updates.
-
-o Bug fixes
-
- -SEGV with $_[0] and circular references fixed.
- -Ilya's debugger patch.
- -FAKE typeglobs fixed.
- -truncate with file name now works.
- -lval substr() no longer coredumps with refs
- -lval substr now clears lexicals in re-entered scopes.
- -core dump in caller() for signal handler for __DIE__.
-
-o Specific Changes
-
-Here are the specific file-by-file changes.
-
-# This is my patch perl5.003_04.pat to perl5.003_03
-# The full description is below.
-# Please execute the following commands before applying this patch.
-# (You can feed this patch to 'sh' to do so.)
-# -- Andy Dougherty
-
-# Obsolete perl4 hint file.
-rm -f hints/dnix.sh
-# Obsolete
-rm -f os2/notes
-
-# We'll create a new test, but patch won't automatically make it
-# executable.
-touch t/op/gv.t
-chmod +x t/op/gv.t
-
-exit 0
-
-
-This is patch perl5.003_04.pat to perl version 5.003_03.
-This takes you from 5.003_03 to 5.003_04.
-
-To apply this patch, run the above commands,
-cd to your perl source directory and then type
-
- patch -p1 -N < perl5.003_04.pat
-
-The changes are described after each /^Index/ line below. This is
-designed so you can examine each change with a command such as
-
- csplit -k perl5.003_04.pat '/^Index:/' '{99}'
-
-Index: Changes
-
- Updated for 5.003_04.
-
-Index: Configure
-
- Change name of shared libperl library back to libperl.so.xxx,
- so that a simple -lperl picks up either libperl.a or
- libperl.so.xxx.
-
- Check if $sh='' in case we've reloaded an old config.sh
-
-Index: INSTALL
-
- Change name of shared perl library to libperl, instead of
- libperl5.
-
- Add notes about fragility of shared libperl and the usefulness
- of archlib to separate different binaries.
-
-Index: MANIFEST
-
- os2/notes removed
-
- obsolete hints/dnix.sh removed.
-
- New typeglob test.
-
-Index: Makefile.SH
-
- For building shared libperl, relocate whole rule to
- inside the if test -f $osname/Makefile.SHs case.
-
-Index: Porting/Glossary
-
- Updated.
-
-Index: README.os2
-
- Updated.
-
-Index: av.c
-
- Subject: Re: SEGV with $_[0] and circular references
-
- Subject: random cleanup
-
- This patch removes a few obvious redundancies in the source.
-
-Index: config_H
-
- Updated. Note new comments to make AIX happy.
-
-Index: config_h.SH
-
- Change /*#define../**/ into /*#define../ **/
- to make IBM's xlc compiler shut up about nested comments.
- The /*#define FOO /**/ is a perfectly legal un-nested comment, and
- I wish IBM would fix it's blasted compiler instead. In the meantime
- we'll take mercy on the poor AIX user and get rid of the screenfulls
- of stupid warning messages. Thanks to Hallvard B Furuseth for the fix.
-
-Index: dump.c
-
- This patch changes neither behavior nor performance. However, it does
- reduce code size and improve maintainability by combining some common
- code in gv_fullname() and gv_efullname().
-
-Index: ext/FileHandle/FileHandle.pm
-
- This patch documents the behavior of FileHandle::{new,open} with
- regard to open modes. It also documents the exportation of Fcntl
- constants.
-
- This patch fixes a bug observed by Tom Christiansen: FileHandle::new
- didn't allow for file permissions after the file mode. Here's a patch.
-
-Index: ext/IO/lib/IO/File.pm
-
- This patch fixes a bug observed by Tom Christiansen: IO::File::new
- didn't allow for file permissions after the file mode. Here's a patch.
-
- This patch documents the behavior of IO::File::{new,open} with
- regard to open modes. It also documents the exportation of Fcntl
- constants.
-
-Index: ext/Opcode/Opcode.pm
-
- Subject: Re: glob in Safe compartment allows shell access
-
- I've moved the glob op into the same opcode tag as backticks and system
- and added a comment.
-
-Index: gv.c
-
- This patch changes neither behavior nor performance. However, it does
- reduce code size and improve maintainability by combining some common
- code in gv_fullname() and gv_efullname().
-
-Index: handy.h
-
- Subject: Patch for LONG_MAX & co.
-
- Sorry about adding yet another #ifdef forest, but hopefully this
- should resolve the *_MAX issues permanently. It adds to the
- previously defined PERL_LONG_MAX, PERL_LONG_MIN, and PERL_ULONG_MAX
- symbols the complete set of
- /PERL_U?(CHAR|SHORT|INT|LONG)_(MAX|MIN)/, and installs aliases to
- those from /(I|U)(8|16|32|V)_(MAX|MIN)/ so that for any standard
- Perl typedef, like I32 or UV, you can reference I32_MAX or UV_MIN,
- and get appropriate figures. All references to LONG_(MIN|MAX) are
- changed appropriately.
-
- The .c changes have the side effect of making cast_uv properly use quad
- limits if quads are in use, but longs aren't 64 bit. Hopefully this all
- works, but I don't have any handy Crays to try it out on.
-
- Add notes on perl's internal types, specifically Quad_t and IV.
-
-Index: hints/hpux.sh
-
- Remove the d_bsdpgrp hint. The defaults should be ok.
-
-Index: hints/irix_6_2.sh
-
- Change optimize=-g to optimize=none to avoid pulling in -DDEBUGGING,
- unless that's what the user really wants.
-
-Index: hints/mpeix.sh
-
- Change optimize=-g to optimize=none to avoid pulling in -DDEBUGGING,
- unless that's what the user really wants.
-
-Index: hints/os2.sh
-
- Fixes for sh vs. bin_sh + cleanup.
-
-Index: hints/ultrix_4.sh
-
- Don't call optimize=-g, just call optimize=none. The -g
- pulls in -DDEBUGGING, which might not be wanted.
-
-Index: lib/ExtUtils/MM_Unix.pm
-
- .C$(obj_ext) removed under OS/2 - conflicts with .c$(obj_ext).
-
-Index: lib/ExtUtils/xsubpp
-
- Fix SCOPE? (See pod/perlxs.pod).
- Up version number to 1.938.
-
-Index: lib/Test/Harness.pm
-
- Add a return value to runtests - non-zero if all tests ran ok,
- zero otherwise.
-
-Index: lib/perl5db.pl
-
- Ilya's debugger patch.
- Undefined subroutine &Carp::longmess called at
- /opt/perl5.003_03/lib/perl5db.pl line 1423.
-
-
- Make perl5db compatible with the recent 'strict refs' enforcement
- in %SIG.
-
-Index: malloc.c
-
- A patch to perl5.003_02/malloc to give a sensible error abort() message
- in ANSI C, and to give it to stderr instead of stdout.
-
- Use config_h's STRINGIFY macro instead of pre-ANSI "p".
-
-Index: mg.c
-
- Subject: FAKE typeglobs seriously busted (with patch)
-
- Handling of fake typeglobs (scalars that are really globs
- in disguise) is seriously busted since 5.002 (it wasn't
- so in 5.001n).
- The problem is that mg_get() on a glob calls gv_efullname()
- which might coerce its first arg to a string.
-
- Sub-critical patch to conceivably fix some %SIG problems. (Shared hash key
- weren't being properly detected by some of the sig magic, but as shared
- hash keys wouldn't normally be used in %SIG it's unlikely this is a
- significant problem.)
-
- This patch changes neither behavior nor performance. However, it does
- reduce code size and improve maintainability by combining some common
- code in gv_fullname() and gv_efullname().
-
-Index: myconfig
-
- Update perlio-related variables.
-
-Index: op.c
-
- This patch changes neither behavior nor performance. However, it does
- reduce code size and improve maintainability by combining some common
- code in gv_fullname() and gv_efullname().
-
-Index: opcode.h
-
- Updated. See opcode.pl.
-
-Index: opcode.pl
-
- Subject: Re: truncate with file name does not work (with patch)
-
- The prototype for truncate was changed so that perl won't die
- with C<use strict;> when the first arg is a bareword (filehandle).
- I think it was Tom (as in "tchrist") who brought this up.
-
- Here's a patch that undoes the damage, makes it work with
- C<use strict;>, and adds to the testsuite.
-
-Index: os2/Makefile.SHs
-
- perllib vs. LIBPERL
-
-Index: os2/diff.configure
-
- Updated.
-
-Index: os2/os2.c
-
- SH_PATH_INI vs. BIN_SH
-
-Index: os2/os2ish.h
-
- SH_PATH_INI added (needed to redefine SH_PATH for binary
- distribution).
- SH_PATH is redefined.
-
-Index: patchlevel.h
-
- SUBVERSION 4.
-
-Index: perl.h
-
- Subject: Patch for LONG_MAX & co.
-
- Sorry about adding yet another #ifdef forest, but hopefully this
- should resolve the *_MAX issues permanently. It adds to the
- previously defined PERL_LONG_MAX, PERL_LONG_MIN, and PERL_ULONG_MAX
- symbols the complete set of
- /PERL_U?(CHAR|SHORT|INT|LONG)_(MAX|MIN)/, and installs aliases to
- those from /(I|U)(8|16|32|V)_(MAX|MIN)/ so that for any standard
- Perl typedef, like I32 or UV, you can reference I32_MAX or UV_MIN,
- and get appropriate figures. All references to LONG_(MIN|MAX) are
- changed appropriately.
-
- The .c changes have the side effect of making cast_uv properly use quad
- limits if quads are in use, but longs aren't 64 bit. Hopefully this all
- works, but I don't have any handy Crays to try it out on.
-
- Add notes on perl's internal types, specifically Quad_t and IV.
-
-Index: perlio.c
-
- Removes an incorrect prototype for setlinebuf from
- perlio.c because it conflicts with the correct declaration in
- MachTen's stdio.h (and possibly other stdio's as well).
-
- Secondly, the code in perlio.c is not handling the (!PERLIO_IS_STDIO &
- HAS_F[GS]ETPOS) case. The patch fixes this omission (in a rather lumpen
- manner). I don't think this should affect platforms which try to hack a
- different path through the #ifdef forest, but this assertion would benefit
- from testing...
-
- Dominic Dunlop
-
-Index: plan9/config.plan9
-
- Updated.
-
-Index: plan9/fndvers
-
- Updated.
-
-Index: plan9/mkfile
-
- Updated.
-
-Index: plan9/setup.rc
-
- Updated.
-
-Index: pod/perldiag.pod
-
- Subject: lval substr() coredumps with refs (with patch)
-
- substr() coredumps with a target that is a ref, when it is used in
- an lvalue context.
- The patch below corrects the problem by stringifying the reference
- first (and emitting a warning when appropriate).
-
-Index: pod/perlxs.pod
-
- document xsubpp SCOPE:
-
-Index: pp.c
-
- Subject: lval substr() fails to clear lexicals in re-entered scopes (with patch)
-
- substr() in lvalue context interacts in buggy fashion with SVs that
- are !SvOK. This manifests itself with lexicals that have a REFCNT of
- 1, since these are merely "cleared in place" by setting SvOK_off.
-
- Subject: lval substr() coredumps with refs (with patch)
-
- substr() coredumps with a target that is a ref, when it is used in
- an lvalue context.
- The patch below corrects the problem by stringifying the reference
- first (and emitting a warning when appropriate).
-
- Subject: Patch for LONG_MAX & co.
-
-Index: pp_ctl.c
-
- This patch changes neither behavior nor performance. However, it does
- reduce code size and improve maintainability by combining some common
- code in gv_fullname() and gv_efullname().
-
-Index: pp_hot.c
-
- Subject: Patch for LONG_MAX & co.
-
- This patch changes neither behavior nor performance. However, it does
- reduce code size and improve maintainability by combining some common
- code in gv_fullname() and gv_efullname().
-
-Index: pp_sys.c
-
- This patch changes neither behavior nor performance. However, it does
- reduce code size and improve maintainability by combining some common
- code in gv_fullname() and gv_efullname().
-
-Index: proto.h
-
- This patch changes neither behavior nor performance. However, it does
- reduce code size and improve maintainability by combining some common
- code in gv_fullname() and gv_efullname().
-
-Index: run.c
-
- This patch changes neither behavior nor performance. However, it does
- reduce code size and improve maintainability by combining some common
- code in gv_fullname() and gv_efullname().
-
-Index: sv.c
-
- Subject: random cleanup
-
- This patch removes a few obvious redundancies in the source.
-
- Subject: sv_setsv patch
-
- This patch changes neither behavior nor performance. However, it does
- reduce code size and improve maintainability by combining some common
- code in gv_fullname() and gv_efullname().
-
- From: Chip Salzenberg
- Subject: Track SVs for destruction when -DPURIFY
-
- When checking for memory leaks, I compiled Perl with "-DPURIFY".
- Although that flag improves the leak checking, it also breaks
- destruction of global objects, because SVs aren't kept in captive
- arenas any more.
-
- This patch rectifies the problem by providing an alternative
- method for keeping track of SVs when Perl is compiled for Purify.
- It has no effect on normal operation.
-
-
- Add comment about assert(len >=0) when len is unsigned anyway.
-
-Index: t/io/fs.t
-
- Subject: Re: truncate with file name does not work (with patch)
-
- The prototype for truncate was changed so that perl won't die
- with C<use strict;> when the first arg is a bareword (filehandle).
- I think it was Tom (as in "tchrist") who brought this up.
-
- Here's a patch that undoes the damage, makes it work with
- C<use strict;>, and adds to the testsuite.
-
- The "not implemented" branch is missing a "\n".
-
-Index: t/op/gv.t
-
- Subject: FAKE typeglobs seriously busted (with patch)
-
- Handling of fake typeglobs (scalars that are really globs
- in disguise) is seriously busted since 5.002 (it wasn't
- so in 5.001n).
-
- The problem is that mg_get() on a glob calls gv_efullname()
- which might coerce its first arg to a string.
-
-Index: t/op/substr.t
-
-
- Subject: lval substr() fails to clear lexicals in re-entered scopes (with patch)
-
- substr() in lvalue context interacts in buggy fashion with SVs that
- are !SvOK. This manifests itself with lexicals that have a REFCNT of
- 1, since these are merely "cleared in place" by setting SvOK_off.
-
- Subject: lval substr() coredumps with refs (with patch)
-
- substr() coredumps with a target that is a ref, when it is used in
- an lvalue context.
- The patch below corrects the problem by stringifying the reference
- first (and emitting a warning when appropriate).
-
-Index: toke.c
-
- Subject: Re: truncate with file name does not work (with patch)
-
- The prototype for truncate was changed so that perl won't die
- with C<use strict;> when the first arg is a bareword (filehandle).
- I think it was Tom (as in "tchrist") who brought this up.
-
- Here's a patch that undoes the damage, makes it work with
- C<use strict;>, and adds to the testsuite.
-
-Index: util.c
-
- Subject: Re: Perl 5.003 dumps core executing caller() in signal handler for
- __DIE__ (with patch)
-
- sv_2pv() might call croak() (which is not prepared to handle that
- when it calls sv_2pv(), itself). Likewise for warn() (but under
- slightly more esoteric circumstances--mg_get() in sv_2pv() might
- trigger a call to warn()).
-
-
- Subject: Patch for LONG_MAX & co.
-
- PERL_BADLANG is examined by default before issuing a warning during
- internationalization.
-
-Index: utils/h2xs.PL
-
- Make leading =head NAME item a paragraph so pod2man finds it.
-
-Index: utils/perldoc.PL
-
- Use col -x to filter out half-line feeds (ESC-9) from
- HP-UX nroff -man output. (col -x isn't portable -- SunOS
- doesn't support the -x option.)
-
+____________________________________________________________________________
+[ 142] By: mbeattie on 1997/10/16 16:52:55
+ Log: Add newly moved perl/ext/Thread/... files to MANIFEST.
+ Branch: perl
+ ! MANIFEST
+____________________________________________________________________________
+[ 141] By: mbeattie on 1997/10/16 16:42:13
+ Log: Move perlext/Thread into perl/ext/Thread.
+ Branch: perl
+ +> ext/Thread/Makefile.PL ext/Thread/Notes ext/Thread/README
+ +> ext/Thread/Thread.pm ext/Thread/Thread.xs
+ +> ext/Thread/Thread/Queue.pm ext/Thread/Thread/Semaphore.pm
+ +> ext/Thread/create.t ext/Thread/io.t ext/Thread/join.t
+ +> ext/Thread/join2.t ext/Thread/list.t ext/Thread/lock.t
+ +> ext/Thread/queue.t ext/Thread/sync.t ext/Thread/sync2.t
+ +> ext/Thread/typemap ext/Thread/unsync.t ext/Thread/unsync2.t
+ +> ext/Thread/unsync3.t ext/Thread/unsync4.t
+ ! Configure
+ Branch: perlext
+ - Thread/Makefile.PL Thread/Notes Thread/README Thread/Thread.pm
+ - Thread/Thread.xs Thread/Thread/Queue.pm
+ - Thread/Thread/Semaphore.pm Thread/create.t Thread/io.t
+ - Thread/join.t Thread/join2.t Thread/list.t Thread/lock.t
+ - Thread/queue.t Thread/sync.t Thread/sync2.t Thread/typemap
+ - Thread/unsync.t Thread/unsync2.t Thread/unsync3.t
+ - Thread/unsync4.t
+____________________________________________________________________________
+[ 140] By: mbeattie on 1997/10/16 16:26:53
+ Log: Correct threads_mutex locking in main thread destruction.
+ Add per-interp thrsv to hold SV struct thread for main thread.
+ Move Thread.xs MUTEX_DESTROY from end of threadstart to remove_thread.
+ Add Thread/list.t test of Thread->list method.
+ Let Thread::Semaphore methods up and down take an extra argument.
+ Branch: perl
+ ! embed.h interp.sym perl.c perl.h thread.h
+ Branch: perlext
+ + Thread/list.t
+ ! Thread/Thread.xs Thread/Thread/Semaphore.pm
+____________________________________________________________________________
+[ 139] By: mbeattie on 1997/10/16 14:01:11
+ Log: Fix up merge with 5.004_04.
+ Branch: perl
+ ! op.c perl.c t/lib/dosglob.t
+____________________________________________________________________________
+[ 138] By: TimBunce on 1997/10/16 12:58:22
+ Log: Fix-up PerForce type for t/lib/dosglob.t from text to xtext
+ Branch: maint-5.004/perl
+ ! t/lib/dosglob.t
+____________________________________________________________________________
+[ 137] By: mbeattie on 1997/10/16 11:09:25
+ Log: Merge maint-5.004 branch (5.004_04) with mainline.
+ Branch: perl
+ +> hints/os390.sh lib/base.pm t/lib/dosglob.t
+ - ext/util/extliblist
+ !> (integrate 132 files)
+____________________________________________________________________________
+[ 135] By: gsar on 1997/10/15 21:46:05
+ Log: Win32 changes over 5.004_52:
+ - rearranged MUTEX_LOCK()s in perl_destroy so that we don't call it
+ on an already locked mutex.
+ - other minor tweaks.
+ Now builds and runs win32-version of Thread_52, passing all tests.
+ Branch: win32/perl
+ ! perl.c proto.h thread.h
+____________________________________________________________________________
+[ 134] By: gsar on 1997/10/15 18:19:31
+ Log: fixup makefile.mk conflict.
+ Branch: win32/perl
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 133] By: gsar on 1997/10/15 18:02:46
+ Log: Integrated latest changes from mainline into win32.
+ Branch: win32/perl
+ +> fakethr.h
+ !> MANIFEST Porting/makerel Porting/patchls README.threads
+ !> Todo.5.005 perl.c pp_hot.c thread.h util.c win32/config.bc
+ !> win32/config.vc win32/config_H.bc win32/config_H.vc
+ !> win32/makefile.mk
----------------
-Version 5.003_03
+Version 5.004_52
----------------
-Most of the changes in 5.003_03 are to make the build and installation
-process more robust. The details are described below. A very brief
-summary is:
-
-o Visible Changes to Core Functionality
-
- -Support for tied filehandles.
-
-o Configure enhancements
-
- -How to build and install a shared libperl.so is now documented
- and supported, though it's not the default for most platforms.
-
-o Bug fixes
-
- -Support bit operations on strings longer than 15 bytes.
-
- -If a regex supplied to split() contains paranthesized subpatterns
- that can result in null matches, perl no longer coredumps.
-
- -Fix problems with each() on tied hashes.
-
- -Make h2ph architecture-independent by using Config at run-time
- rather than extraction time.
-
-o Specific Changes
-
-Here are the specific file-by-file changes.
-
-# This is my patch perl5.003_03.pat to perl5.003_02
-# The full description is below.
-# Please execute the following commands before applying this patch.
-# (You can feed this patch to 'sh' to do so.)
-# -- Andy Dougherty
-
-# Absorbed into Changes5.002
-rm -f Changes.Conf
-
-# Not needed.
-rm -f ext/POSIX/mkposixman.pl
-
-# Moved to README.os2. I'm not sure why the README files are
-# here rather than in the appropriate subdirectories.
-rm -f os2/README
-
-# Not needed.
-rm -f pod/Makefile.PL
-
-# New test for bit ops.
-touch t/op/bob.t
-
-# Patches that create new tests don't always make them executable.
-chmod +x t/*/*.t
-
-# Create a new directory for Porting and Patching info.
-mkdir Porting
-
-exit 0
-
-This is patch perl5.003_03.pat to perl version 5.003_02.
-This takes you from 5.003_02 to 5.003_03.
-
-To apply this patch, run the above commands,
-cd to your perl source directory and then type
-
- patch -p1 -N < perl5.003_03.pat
-
-The changes are described after each /^Index/ line below. This is
-designed so you can examine each change with a command such as
-
- csplit -k perl5.003_03.pat '/^Index:/' '{99}'
-
-Index: Changes
-
- Include 5.003_03 change notes.
-
- Move older change notes to separate files.
-
-Index: Changes5.000
-
- New file. Changes from perl4.036 to 5.000.
-
-Index: Changes5.001
-
- New file. Changes from 5.000 to 5.001
-
-Index: Changes5.002
-
- New file. Changes from 5.001 to 5.002
-
-Index: Changes5.003
-
- New file. Changes from 5.002 to 5.003
-
-Index: Configure
-
- Relaxed warning about ksh on exotic machines.
-
- Changed usesafe to useopcode.
-
- Add search for gzip and zip.
-
- Look more carefully for $sh (the Bourne-ish shell).
- Use that info to set $startsh correctly.
-
- Change prompts for PerlIO interface. See INSTALL
- for how this is supposed to work. The default is
- still the same as in 5.003_02, namely don't use
- any fancy new PerlIO stuff.
-
- Don't look for sigvec() since we don't actually use it.
- (Plus, it used to print an alarming misleading message about
- race conditions.)
-
- Look for stdio's _filbuf under the possible names of
- _filbuf, __filbuf, and _fill.
-
- New $useshrplib variable to control whether we build a shared
- libperl.so. The name of the library is in $libperl.
- Always install it in $installarchlib/CORE/$libperl.
-
- Check for <sys/resource.h> and <sys/wait.h> for NetBSD.
-
- Replace old $altmake stuff with newer autoconf-ish
- $make_set_make, which checks if $make sets $(MAKE). Now you
- choose an alternate make with sh Configure -Dmake=gmake (or
- whatever).
-
- Remove 'ln' for the list of essential commands. Simulate
- it with 'cp' if necessary.
-
- Change `logname` prompts to handle extra gratuitous spaces in
- Ultrix output.
-
- Autodetect os2.
-
- Fix silly bug in checking for fully-qualified names in /etc/hosts.
-
- Generalize Gconvert tests. Give correct and more useful
- error messages.
-
- Use $obj_ext instead of literal '.o' in the dynaloader test.
-
- Include appropriate header files in bcopy() and memcpy()
- tests. Note whether memmove is available.
-
- Check whether struct sigaction works (needed for Solaris 2.5
- with -Xc).
-
- Include appropriate header files for randbits test.
-
-Index: INSTALL
-
- Add note about space requirements.
-
- Update to match Configure changes (Opcode vs. Safe,
- useperlio, useshrplib, etc.)
-
- Reorganize the structure of some of the hints.
-
- Miscellaneous clarifications.
-
-Index: MANIFEST
-
- Updated. 5.003_02 introduced some massive patches, mostly
- due to spacing changes. I didn't bother to sort them all out;
- I just started with 5.003's MANIEFST.
-
-Index: Makefile.SH
-
- Support the new simplified shared libperl mechanism.
-
- Use new $make_set_make directive.
-
- Remove redundant libperl Make variable.
-
- Remove unnecessary MAB variable.
-
- Remove dependency of minitest on lib/Config.pm, since it could
- well have been a failure of configpm that inspired testing
- miniperl in the first place!
-
-Index: Porting/Glossary
-
- New file describing all the config.sh variables.
- Eventually, I hope to fill this directory with other useful
- stuff.
-
-Index: README.os2
-
- Replace old README.os2 with more up-to-date os2/README.
-
-Index: config_H
-
- Updated to match current Configure and config_h.SH.
- Some rearrangement of parts has occurred due to new
- dependencies in the metaconfig units.
-
-Index: config_h.SH
-
- Updated to match current Configure and config_h.SH.
- Some rearrangement of parts has occurred due to new
- dependencies in the metaconfig units.
-
- Include full descriptions of ARCHLIB, OLDARCHLIB, PRIVLIB,
- SITEARCH, and SITELIB. Previous versions just included the
- ~-expanded names (with unhelpful descriptions). No functionality
- is changed, but maybe it's a little better documented now.
-
-Index: doio.c
-
- Possibly Include <signal.h> and <unistd.h>
-
-Index: doop.c
-
- No longer prefer bcmp over memcmp when order doesn't matter.
-
- Support bit operations on strings longer than 15 bytes.
-
-Index: embed.h
-
- Auto-generated.
-
-Index: embed.pl
-
- Expand warning at the top.
-
-Index: ext/IO/IO.pm
-
- Clean up docmentation installation errors.
-
-Index: ext/IO/lib/IO/Seekable.pm
-
- Clean up docmentation installation errors.
-
-Index: ext/IO/lib/IO/Select.pm
-
- Clean up docmentation installation errors.
-
-Index: ext/Opcode/Opcode.xs
-
- Add support for tied filehandles.
-
-Index: ext/SDBM_File/sdbm/sdbm.h
-
- Change the Mymalloc to match Perl_malloc in perl.h.
-
-Index: ext/util/make_ext
-
- Typo change.
- Get rid of unused altmake.
-
-Index: global.sym
-
- Fix problems with each() on tied hashes.
-
-Index: handy.h
-
- Change safe*alloc functions to have prototypes that
- match the system's malloc and free types. That is, use
- Malloc_t instead of char *, and Free_t instead of void.
- This is necessary so . . .
-
- Safefree cast matches type of free() whether it's perl's
- malloc/free or the system's malloc/free.
-
-Index: hints/README.hints
-
- Remove out-of-date info.
-
- Document a bit about how hint files work.
-
-Index: hints/aix.sh
-
- qmaxmem hint doesn't apply to gcc.
-
-Index: hints/dgux.sh
-
- Configure will now automatically detect shared libperl stuff.
-
-Index: hints/dynixptx.sh
-
- Fix typo in comment.
-
- Configure will now automatically detect shared libperl stuff.
-
-Index: hints/epix.sh
-
- Use glibpth instead of libpth. This allows Configure to
- add local directories, such as /opt/local/lib, etc.
-
-Index: hints/irix_6_2.sh
-
- Include some info on cc -n32 compile.
-
-Index: hints/linux.sh
-
- Configure now tests gcvt() more thoroughly.
-
-Index: hints/machten_2.sh
-
- Update where to find dld.
-
-Index: hints/mips.sh
-
- Use glibpth instead of libpth.
-
-Index: hints/next_3.sh
-
- Build up $mab dynamically. Since $mab isn't used anywhere
- anymore, this is useless. However, $mab was never used for
- next_3.sh anyway, so there's been no change in functionality.
-
-Index: hints/next_4.sh
-
- Get rid of extraneous isnext_4 variable. Configure and
- Makefile.SH will use $osname and $osvers instead.
-
- Build up $mab dynamically based on available architectures.
-
- Absorb $mab into ccflags and ccdlflags. I hope that will
- cover everything. (Configure should automatically remove
- the -arch stuff from cppflags.)
-
- Configure now knows next4 needs to use a shared libperl.5.so.
-
- Allow users to use -Dprefix.
-
-Index: hints/os2.sh
-
- Try to update to reflect newer shared libperl stuff.
- I probably goofed :-).
-
-Index: hints/sco.sh
-
- Additional notes on using icc.
-
- Additional flags for dynamic loading.
-
-Index: hints/solaris_2.sh
-
- Perl.h no longer prefers bcmp, so it's again ok if Configure
- finds them, since perl will prefer the mem* versions anyway.
-
-Index: hints/sunos_4_0.sh
-
- Don't include <unistd.h>
-
-Index: hints/sunos_4_1.sh
-
- Add brief note about GNU as and ld.
-
- Don't include <unistd.h>
-
- Add notes about WHOA THERE messages.
-
-Index: hints/titanos.sh
-
- Include sfio in libswanted.
-
- Don't set libpth any more.
-
-Index: hints/umips.sh
-
- New hint file.
-
-Index: hv.c
-
- Use memcmp even in cases where ordering doesn't matter.
-
- Fix problems with each() on tied hashes.
-
-Index: installperl
-
- Simplify installation of shared libperl.so.
-
- Avoid reaching Command Failed!!! with /usr/bin/perl.
-
-Index: lib/AutoSplit.pm
-
- Clean up docmentation installation errors.
-
-Index: lib/ExtUtils/MM_Unix.pm
-
- Remove MAB references.
-
- Use 'useshrplib' instead of 'd_shrplib'
-
-Index: lib/ExtUtils/MakeMaker.pm
-
- Remove mab references.
-
-Index: lib/FindBin.pm
-
- Clean up docmentation installation errors.
-
-Index: lib/Symbol.pm
-
- Put back in the BEGIN { require 5.002; }. The version in
- 5.003_02 wouldn't work in 5.002 anyway. Further, the whole
- point of the construct is to catch 5.001m, so we can't use
- syntax introduced after 5.001m to do that.
-
-Index: lib/Text/Wrap.pm
-
- Remove double 'use strict'.
-
-Index: lib/perl5db.pl
-
- Add explicit '&' to avoid warnings under strict refs.
-
-Index: lib/sigtrap.pm
-
- Clean up docmentation installation errors.
-
-Index: makedepend.SH
-
- Use Configure's $sh and $make_set_make variables.
-
-Index: mg.c
-
- Include <unistd.h>
-
- Use Safefree() macro instead of safefree() function with
- a (possibly) incorrect cast. The whole point of the
- Safefree() macro is that it does the correct cast for you.
-
-
-Index: patchlevel.h
-
- Change to SUBVERSION 3.
-
-Index: perl.c
-
- Include <unistd.h>
-
-Index: perl.h
-
- No longer prefer bcmp slightly for comparisons that don't care
- about ordering.
-
- Rely on Configure setting SH_PATH.
-
- Change the function name to Pause() instead of pause() to
- avoid potential prototype problems. (This naming convention
- is similar to the Fwrite and Fflush macros.)
-
- Fix problems with each() on tied hashes.
-
- Work around crypt prototype problem on NeXT.
-
-Index: perlio.c
-
- Fixes to support non-std stdio.
-
-Index: perlio.h
-
- Try to document the various #defines a bit. This is far from
- finished.
-
- Remove a lot of trailing whitespace. (It's of no consequence, but
- but I'm not going to redo the patch just to put back in the trailing
- whitespace either.)
-
-Index: perlsdio.h
-
- Fixes to support non-std stdio.
-
-Index: perly.c
-
- Restore use of Safefree() macro.
-
-Index: perly.c.diff
-
- Restore use of Safefree() macro.
-
-Index: perly.h
-
- Delete duplicate line.
-
-Index: plan9/buildinfo
-
- Update.
-
-Index: pod/perlapio.pod
-
- Clean up docmentation installation errors.
-
-Index: pod/perlipc.pod
-
- Fix typo.
-
- Untaint port number.
-
-Index: pod/perlmod.pod
-
- Fix a minor nit regarding Exporter.
-
-Index: pod/perlre.pod
-
- Clean up docmentation installation errors.
-
-Index: pod/perltie.pod
-
- Add support for tied filehandles.
-
-Index: pod/perltrap.pod
-
- Clean up docmentation installation errors.
-
-Index: pod/perlxstut.pod
-
- Clean up docmentation installation errors.
-
-Index: pod/pod2man.PL
-
- Clean up docmentation installation errors.
-
-Index: pp.c
-
- Add support for tied filehandles.
-
- If a regex supplied to split() contains paranthesized subpatterns
- that can result in null matches, perl coredumps.
-
-Index: pp_hot.c
-
- Use memcmp instead of bcmp even when we don't care about order.
-
- Add support for tied filehandles.
-
-Index: pp_sys.c
-
- Include <unistd.h>, <sys/wait.h>, and <sys/resource.h>.
- (The latter two are especially for NetBSD.)
-
- Don't assume sys/time.h and sys/select.h can't coexist.
-
- Use Pause macro.
-
-Index: proto.h
-
- Fix safe*alloc and safefree prototypes.
-
-Index: regexec.c
-
- Use memcmp instead of bcmp even when we don't care about order.
-
-Index: sv.c
-
- Use memcmp instead of bcmp even when we don't care about order.
-
-Index: t/lib/opcode.t
-
- Add support for tied filehandles.
-
-Index: t/op/bop.t
-
- Support bit operations on strings longer than 15 bytes.
-
-Index: t/op/misc.t
-
- Add support for tied filehandles.
-
-Index: t/op/split.t
-
- If a regex supplied to split() contains paranthesized subpatterns
- that can result in null matches, perl coredumps.
-
-Index: toke.c
-
- Include <unistd.h>.
-
- Use memcmp instead of bcmp even when we don't care about order.
-
-Index: util.c
-
- Include <unistd.h>.
-
- Use correct types for safe*alloc and safefree functions.
-
-Index: utils/h2ph.PL
-
- Make h2ph architecture-independent by using Config at run-time
- rather than extraction time.
-
-Index: writemain.SH
-
- Remove unnecessary curlies. (They are a leftover from
- an older auto_init mechanism.)
-
-Index: x2p/Makefile.SH
-
- Use Configure's $sh and $make_set_make.
-
- Remove MAB stuff, since it's now in ccflags.
-
- Keep 5.003's RCS info.
-
-Index: x2p/a2p.h
-
- Keep 5.003's RCS info.
-
-Index: x2p/str.c
-
- Use Configure's FILE_filbuf macro instead of a raw _filbuf.
-
+____________________________________________________________________________
+[ 132] By: mbeattie on 1997/10/15 17:02:38
+ Log: Remove out-of-date test Thread/cond.t.
+ Branch: perlext
+ - Thread/cond.t
+____________________________________________________________________________
+[ 131] By: mbeattie on 1997/10/15 16:57:45
+ Log: Finish thread state machine: fixes global destruction of threads,
+ detaching, joining etc. Alter FAKE_THREADS-specific fields to use
+ new HAVE_THREAD_INTERN stuff. Updates docs. Various fixes to
+ Thread.xs.
+ Branch: perl
+ ! MANIFEST README.threads Todo.5.005 perl.c util.c
+ Branch: perlext
+ ! Thread/Thread.xs Thread/queue.t
+____________________________________________________________________________
+[ 130] By: mbeattie on 1997/10/15 16:55:10
+ Log: Add HAVE_THREAD_INTERN for platform-dependent struct thread additions.
+ Fix ThrSETSTATE not to lock t->mutex itself.
+ Branch: perl
+ ! fakethr.h thread.h
+____________________________________________________________________________
+[ 129] By: mbeattie on 1997/10/15 16:53:35
+ Log: Remove stale code from pp_entersub which breaks sub ownership locks.
+ Branch: perl
+ ! pp_hot.c
+____________________________________________________________________________
+[ 128] By: TimBunce on 1997/10/15 15:55:26
+ Log: Maintenance 5.004_04 changes
+ Branch: maint-5.004/perl
+ + hints/os390.sh lib/base.pm t/lib/dosglob.t
+ - ext/util/extliblist
+ ! Changes Configure INSTALL MANIFEST Makefile.SH Porting/makerel
+ ! Porting/patchls Porting/pumpkin.pod README.vms av.c configpm
+ ! doop.c eg/sysvipc/ipcsem emacs/cperl-mode.el embed.h
+ ! ext/DynaLoader/DynaLoader.pm ext/IO/lib/IO/Socket.pm
+ ! ext/util/make_ext global.sym gv.c hints/bsdos.sh
+ ! hints/dec_osf.sh hints/dynixptx.sh hints/irix_6.sh
+ ! hints/linux.sh hints/machten.sh hints/os2.sh hints/qnx.sh hv.c
+ ! installperl lib/AutoLoader.pm lib/CPAN.pm
+ ! lib/CPAN/FirstTime.pm lib/Carp.pm lib/Cwd.pm lib/English.pm
+ ! lib/ExtUtils/Install.pm lib/ExtUtils/Liblist.pm
+ ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/xsubpp
+ ! lib/File/DosGlob.pm lib/File/Find.pm lib/FileHandle.pm
+ ! lib/Getopt/Long.pm lib/Getopt/Std.pm lib/Math/Complex.pm
+ ! lib/Sys/Hostname.pm lib/Sys/Syslog.pm lib/Test/Harness.pm
+ ! lib/Time/Local.pm lib/autouse.pm lib/blib.pm
+ ! lib/diagnostics.pm lib/getopt.pl lib/perl5db.pl lib/vars.pm
+ ! makedepend.SH malloc.c mg.c miniperlmain.c myconfig op.c
+ ! opcode.h os2/Changes os2/OS2/REXX/Makefile.PL
+ ! os2/OS2/REXX/REXX.pm os2/os2.c patchlevel.h perl.c perl.h
+ ! perly.c perly.fixer perly.y pod/perl.pod pod/perlapio.pod
+ ! pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod
+ ! pod/perlguts.pod pod/perlipc.pod pod/perlop.pod
+ ! pod/perlrun.pod pod/perlsec.pod pod/perlsub.pod
+ ! pod/perltrap.pod pod/perlvar.pod pod/perlxs.pod pp.c pp_ctl.c
+ ! pp_hot.c pp_sys.c proto.h regcomp.c regexec.c scope.c sv.c
+ ! t/TEST t/comp/proto.t t/lib/complex.t t/lib/io_sock.t
+ ! t/lib/io_udp.t t/op/glob.t t/op/method.t t/op/misc.t
+ ! t/op/ref.t t/op/runlevel.t t/op/split.t t/op/sprintf.t
+ ! t/op/subst.t t/op/taint.t t/pragma/locale.t taint.c toke.c
+ ! unixish.h util.c utils/h2ph.PL utils/h2xs.PL utils/perlbug.PL
+ ! utils/perldoc.PL vms/perly_c.vms vms/vms.c vms/vmsish.h
+ ! win32/Makefile win32/config_H.bc win32/config_H.vc
+ ! win32/makefile.mk win32/pod.mak win32/win32.c win32/win32io.c
+ ! win32/win32sck.c x2p/Makefile.SH x2p/util.c
+____________________________________________________________________________
+[ 127] By: mbeattie on 1997/10/15 10:00:18
+ Log: Added fakethr.h.
+ Branch: perl
+ + fakethr.h
+____________________________________________________________________________
+[ 126] By: mbeattie on 1997/10/15 09:50:57
+ Log: pthread_condattr_init in thread.h for OLD_PTHREADS_API.
+ Branch: perl
+ ! thread.h
+____________________________________________________________________________
+[ 125] By: mbeattie on 1997/10/15 09:09:24
+ Log: Started rewriting thread state machine.
+ Branch: perl
+ ! perl.c thread.h
+ Branch: perlext
+ ! Thread/Thread.xs
+____________________________________________________________________________
+[ 124] By: gsar on 1997/10/14 00:23:15
+ Log: Remove spurious extra MUTEX_LOCK in pp_entersub(). Now builds and passes
+ tests in win32 version of latest perlext/Thread.
+ Branch: win32/perl
+ ! pp_hot.c
+____________________________________________________________________________
+[ 123] By: gsar on 1997/10/13 23:18:38
+ Log: Initial merge of win32 threads patch.
+ Branch: win32/perl
+ ! embed.h global.sym interp.sym perl.c perl.h pp_hot.c thread.h
+ ! win32/Makefile win32/makedef.pl win32/makefile.mk
+ ! win32/perllib.c win32/pod.mak win32/win32.h
+____________________________________________________________________________
+[ 122] By: gsar on 1997/10/10 20:58:40
+ Log: Integrated changes on mainline into the win32 branch. Had to set
+ P4USER=mbeattie for the resolve step (due to the presence of newly
+ branched files that had not been submitted?)
+ Branch: win32/perl
+ +> Porting/makerel Porting/patchls README.threads Todo.5.005
+ +> ext/attrs/Makefile.PL ext/attrs/attrs.pm ext/attrs/attrs.xs
+ +> hints/newsos4.sh lib/File/DosGlob.pm lib/chat2.pl perlio.sym
+ +> win32/bin/pl2bat.pl win32/bin/runperl.pl win32/bin/search.pl
+ +> win32/bin/webget.pl win32/config.bc win32/config.vc
+ +> win32/config_H.bc win32/config_H.vc win32/makefile.mk
+ - win32/bin/pl2bat.bat win32/bin/search.bat win32/bin/test.bat
+ - win32/bin/webget.bat win32/config.H win32/config.w32
+ ! thread.h
+ !> (integrate 858 files)
+____________________________________________________________________________
+[ 121] By: mbeattie on 1997/10/10 17:23:41
+ Log: Tweak a few Thread tests.
+ Branch: perlext
+ + Thread/join2.t
+ ! Thread/io.t Thread/sync2.t
+____________________________________________________________________________
+[ 120] By: mbeattie on 1997/10/10 17:22:46
+ Log: Rewrite thread destruction system using linked list of threads.
+ Still not completely done. Add methods self, equal, flags, list
+ to Thread.xs. Add Thread_MAGIC_SIGNATURE check to typemap.
+ Branch: perl
+ ! perl.c perl.h thread.h
+ Branch: perlext
+ ! Thread/Thread.xs Thread/typemap
+____________________________________________________________________________
+[ 119] By: mbeattie on 1997/10/10 17:19:55
+ Log: Fix up locking/synchronisation for pp_entersub.
+ Branch: perl
+ ! pp_hot.c
+____________________________________________________________________________
+[ 118] By: mbeattie on 1997/10/10 09:55:32
+ Log: Put back entries in MANIFEST for the four now-returned win32/* files
+ Branch: perl
+ ! MANIFEST
+____________________________________________________________________________
+[ 117] By: mbeattie on 1997/10/10 08:12:23
+ Log: Took out mystack_foo for good, fixed up interp.sym and win32/makedef.pl
+ Branch: perl
+ ! Todo.5.005 embed.h interp.sym perl.h win32/makedef.pl
+____________________________________________________________________________
+[ 116] By: mbeattie on 1997/10/08 15:41:08
+ Log: Add missing sig_pipe definition to Thread.xs.
+ Branch: perlext
+ ! Thread/Thread.xs
+____________________________________________________________________________
+[ 115] By: mbeattie on 1997/10/08 15:40:46
+ Log: Fix up 5.004_03 merge: remove missing win32 files from MANIFEST,
+ add missing dTHR; to new function unwind_handler_stack() in mg.c
+ and bump patchlevel.h to 5.004_52.
+ Branch: perl
+ ! MANIFEST mg.c patchlevel.h
+____________________________________________________________________________
+[ 114] By: mbeattie on 1997/10/08 10:19:27
+ Log: Merge maint-5.004 branch (5.004_03) with mainline.
+ MANIFEST is out of sync.
+ Branch: perl
+ +> win32/bin/pl2bat.pl win32/bin/runperl.pl win32/bin/search.pl
+ +> win32/bin/webget.pl
+ - win32/bin/pl2bat.bat win32/bin/search.bat win32/bin/test.bat
+ - win32/bin/webget.bat
+ !> (integrate 168 files)
+____________________________________________________________________________
+[ 113] By: mbeattie on 1997/10/05 17:52:49
+ Log: Move init of global mutexes/cond vars earlier.
+ Branch: perl
+ ! perl.c
+____________________________________________________________________________
+[ 112] By: nick on 1997/10/04 15:25:28
+ Log: Add perl.sym to MANIFEST
+ Branch: oneperl
+ ! MANIFEST
+____________________________________________________________________________
+[ 111] By: nick on 1997/10/04 15:23:37
+ Log: Missing file
+ Branch: oneperl
+ + perl.sym
+____________________________________________________________________________
+[ 110] By: nick on 1997/10/04 13:04:26
+ Log: Now builds the extensions as well
+ Passes all tests
+ Branch: oneperl
+ ! XSUB.h embed.pl ext/DynaLoader/dlutils.c ext/Opcode/Opcode.xs
+ ! mg.c op.c perl.c pp_ctl.c pp_hot.c pp_sys.c proto.h sv.c
+ ! toke.c util.c writemain.SH
+____________________________________________________________________________
+[ 109] By: nick on 1997/10/04 12:02:14
+ Log: Odd checkin issue
+ Branch: oneperl
+ ! dump.c global.sym gv.c hv.c malloc.c mg.c op.c opcode.h perl.c
+ ! perly.c perly.c.diff perly.h perly.y pp.c pp_hot.c pp_sys.c
+ ! proto.h scope.c sv.c toke.c universal.c util.c vms/perly_c.vms
+ ! vms/perly_h.vms writemain.SH
+____________________________________________________________________________
+[ 108] By: nick on 1997/10/04 11:12:52
+ Log: Added lots of (missing) prototypes (ckprotos is util to check)
+ Fixed missing aTHIS flagged by above.
+ -DUSE_THISPTR passes minitest!
+ Branch: oneperl
+ + ckprotos
+ ! dump.c global.sym gv.c hv.c malloc.c mg.c op.c opcode.h perl.c
+ ! perly.c perly.c.diff perly.h perly.y pp.c pp_hot.c pp_sys.c
+ ! proto.h scope.c sv.c toke.c universal.c util.c vms/perly_c.vms
+ ! vms/perly_h.vms
+____________________________________________________________________________
+[ 107] By: nick on 1997/10/03 22:36:52
+ Log: .y muddle fixup - will get this sorted oneday ...
+ Branch: oneperl
+ ! miniperlmain.c perly.c perly.c.diff perly.h vms/perly_c.vms
+ ! vms/perly_h.vms
+____________________________________________________________________________
+[ 106] By: mbeattie on 1997/10/03 17:12:33
+ Log: Remove last traces of "tokenbuf as temp buffer" and removed it
+ from struct thread. Added missing thr->Tfoo defines for statbuf
+ and timesbuf and removed unused Tbuf field.
+ Branch: perl
+ ! doio.c mg.c perl.c pp_sys.c sv.c thread.h
+____________________________________________________________________________
+[ 105] By: nick on 1997/10/03 15:56:50
+ Log: dTHIS -> hasTHIS, dTHR -> dTHR; builds without THISPTR with/without USE_THREADS
+ Branch: oneperl
+ ! XSUB.h av.c deb.c doio.c doop.c dump.c embed.pl global.sym
+ ! gv.c hv.c mg.c op.c perl.c perl.h perlio.c perly.c pp.c pp.h
+ ! pp_ctl.c pp_hot.c pp_sys.c regcomp.c regexec.c run.c scope.c
+ ! sv.c taint.c thread.h toke.c universal.c util.c
+____________________________________________________________________________
+[ 104] By: mbeattie on 1997/10/03 15:23:25
+ Log: Back out sv_bless3 change which made pp_bless zap '~'-magic.
+ Branch: perl
+ ! global.sym pp.c proto.h sv.c
+____________________________________________________________________________
+[ 103] By: mbeattie on 1997/10/03 15:17:39
+ Log: Fixed sv_mutex locking for new_SV, del_SV and nice_chunks.
+ Branch: perl
+ ! av.c hv.c perl.h sv.c
+____________________________________________________________________________
+[ 102] By: mbeattie on 1997/10/03 11:53:51
+ Log: Reliable thread signal handling.
+ Branch: perl
+ ! global.sym mg.c perl.c perl.h
+ Branch: perlext
+ ! Thread/Thread.xs
+____________________________________________________________________________
+[ 101] By: nick on 1997/10/02 20:43:17
+ Log: Cleanup perly.y stuff
+ Branch: oneperl
+ ! embed.h perly.c perly.c.diff vms/perly_c.vms vms/perly_h.vms
+____________________________________________________________________________
+[ 100] By: nick on 1997/10/02 18:54:08
+ Log: Compiles with less invasive aTHIS adding
+ Branch: oneperl
+ + nothis.sym
+ ! MANIFEST XSUB.h av.c cop.h deb.c doio.c doop.c dump.c embed.h
+ ! embed.pl global.sym gv.c gv.h handy.h hv.c hv.h mg.c op.c op.h
+ ! opcode.h perl.c perl.h perlio.c perlsdio.h perly.c
+ ! perly.c.diff perly.y pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c
+ ! proto.h regcomp.c regcomp.h regexec.c run.c scope.c scope.h
+ ! sv.c sv.h t/op/sort.t taint.c thread.h toke.c universal.c
+ ! util.c vars.h
----------------
-Version 5.003_02
+Version 5.004_51
----------------
-o Visible Changes to Core Functionality
- - Redefining constant subs, or changing sub's prototype now give warnings.
- - Fixes for ++/-- of values close to max/min size of an integer
- - Warning for un-qualified bareword as handler in $SIG{}.
- - UNIVERSAL::isa can now be called as static method.
-
-o Changes in Core Internals
- - PerlIO abstraction added.
- Perl core and standard extensions no longer assume ANSI C's stdio is IO
- mechanism, Default Configure mode is still to use stdio via set of C macros.
- Alternate modes are to use stdio via one perlio.c module, or
- to use sfio if available.
-
- - Several bug fixs from perl5-porters
- - Make sources non-ANSI C correct again.
- - SUPER in gv.c
- - Last of shared-hash-key patches
- - eval '(0,1..3)'; # --> SegFault
- - coredumps after simple subsitutes.
- - Correction to UNIVERSAL::VERSION docs.
- - Fixed io_udp test.
- - Fixed another abuse of malloc'ed memory.
- - Enabled DEBUGING_MSTATS whenever perl's malloc() is used.
- - Reverted to default of not hiding perl's malloc (if used).
-
-o Changes in the Standard Library and Utilities
- - Fixed MakeMaker for static SDBM and builing in a link tree.
- - Upgraded to IO-1.09, and includes latest (still experimental) IO::Select.
- - Documentation/test tweak to DB_File
- - h2xs upgrade to allow use C::Scan module
-
-o Changes in OS-specific and Build-time Support
- - Attempted to re-created 5.003_01's NeXT support with metaconfig units.
- - Updated MANIFEST
- - make minitest now depends on lib/Config.pm, as some of tests require it.
- - Included latest plan9 sub-directory
- - Applied OS/2 patches.
- - Typo patch for VMS.
-
+____________________________________________________________________________
+[ 99] By: mbeattie on 1997/10/02 17:23:48
+ Log: Added Thread/queue.t.
+ Branch: perlext
+ + Thread/queue.t
+____________________________________________________________________________
+[ 98] By: mbeattie on 1997/10/02 17:19:44
+ Log: Bumped patchlevel to 51. Updated Todo.5.005.
+ Branch: perl
+ ! Todo.5.005 patchlevel.h
+____________________________________________________________________________
+[ 97] By: mbeattie on 1997/10/02 17:07:47
+ Log: Update README.threads amd Thread/README
+ Branch: perl
+ ! README.threads
+ Branch: perlext
+ ! Thread/README
+____________________________________________________________________________
+[ 96] By: mbeattie on 1997/10/02 16:58:47
+ Log: Configure -Dusethreads hints for dec_osf and solaris_2 and
+ fix sv_bless3 prototype.
+ Branch: perl
+ ! hints/dec_osf.sh hints/solaris_2.sh sv.c
+____________________________________________________________________________
+[ 95] By: mbeattie on 1997/10/02 16:50:21
+ Log: Fixed broken typemap for Thread.
+ Branch: perlext
+ ! Thread/typemap
+____________________________________________________________________________
+[ 94] By: mbeattie on 1997/10/02 16:34:03
+ Log: Fix pod text in Lint.pm for private-names option.
+ Branch: perlext
+ ! Compiler/B/Lint.pm
+____________________________________________________________________________
+[ 93] By: mbeattie on 1997/10/02 13:44:46
+ Log: Add Todo.5.005 to MANIFEST and submit remade embed.h.
+ Branch: perl
+ ! MANIFEST embed.h
+____________________________________________________________________________
+[ 92] By: mbeattie on 1997/10/02 13:27:10
+ Log: Add Todo.5.005
+ Branch: perl
+ + Todo.5.005
+____________________________________________________________________________
+[ 91] By: nick on 1997/10/01 20:23:38
+ Log: Raw _T# trial
+ Branch: oneperl
+ ! embed.h embed.pl proto.h sv.c
+____________________________________________________________________________
+[ 90] By: nick on 1997/10/01 18:22:03
+ Log: THIS + new sort stuff
+ Branch: oneperl
+ ! miniperlmain.c perl.c pp_ctl.c proto.h util.c
+____________________________________________________________________________
+[ 89] By: nick on 1997/10/01 18:03:05
+ Log: qsort cleanup - now tailored to perl's use and 'this' aware.
+ Branch: oneperl
+ ! pp_ctl.c proto.h util.c
+____________________________________________________________________________
+[ 88] By: mbeattie on 1997/10/01 17:04:12
+ Log: Start of Configure support for -Dusethreads plus associated
+ Linux hints.
+ Branch: perl
+ ! Configure hints/linux.sh
+____________________________________________________________________________
+[ 87] By: mbeattie on 1997/10/01 17:03:34
+ Log: Move runops_foo prototypes from proto.h to early in perl.h.
+ Branch: perl
+ ! perl.h proto.h
+____________________________________________________________________________
+[ 86] By: nick on 1997/09/30 19:15:21
+ Log: Debug hackery to thread.h - temporary
+ Quick-fix qsort() replacement - more to come.
+ Branch: oneperl
+ ! thread.h util.c
+____________________________________________________________________________
+[ 85] By: mbeattie on 1997/09/30 15:50:27
+ Log: Added Lint option regexp-variables.
+ Branch: perlext
+ ! Compiler/B/Lint.pm
+____________________________________________________________________________
+[ 84] By: mbeattie on 1997/09/30 15:11:07
+ Log: Merge maint-5.004 branch (5.004_01) with mainline.
+ Branch: perl
+ +> Porting/makerel Porting/patchls hints/newsos4.sh
+ +> lib/File/DosGlob.pm lib/chat2.pl perlio.sym win32/config.bc
+ +> win32/config.vc win32/config_H.bc win32/config_H.vc
+ +> win32/makefile.mk
+ - win32/config.H win32/config.w32
+ !> (integrate 109 files)
+____________________________________________________________________________
+[ 83] By: TimBunce on 1997/09/30 14:27:09
+ Log: Maintenance 5.004_03 changes (addendum)
+ Branch: maint-5.004/perl
+ - win32/bin/search.bat
+____________________________________________________________________________
+[ 82] By: TimBunce on 1997/09/30 14:11:29
+ Log: Maintenance 5.004_03 changes
+ Branch: maint-5.004/perl
+ + win32/bin/pl2bat.pl win32/bin/runperl.pl win32/bin/search.pl
+ + win32/bin/webget.pl
+ - win32/bin/pl2bat.bat win32/bin/runperl.bat win32/bin/test.bat
+ - win32/bin/webget.bat
+ ! Changes Configure MANIFEST Makefile.SH Porting/makerel
+ ! ext/DynaLoader/DynaLoader.pm hints/hpux.sh hints/linux.sh
+ ! hints/sco.sh hints/sunos_4_1.sh installhtml lib/CPAN.pm
+ ! lib/ExtUtils/MM_Unix.pm lib/FileCache.pm lib/Math/Complex.pm
+ ! lib/Math/Trig.pm lib/blib.pm os2/diff.configure patchlevel.h
+ ! perl.c pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod
+ ! pod/perlop.pod pod/perlre.pod pod/perlrun.pod pod/pod2man.PL
+ ! pp_ctl.c pp_sys.c t/lib/complex.t t/pragma/locale.t toke.c
+ ! utils/perlbug.PL win32/Makefile win32/makefile.mk
+ ! win32/win32.c
+____________________________________________________________________________
+[ 81] By: TimBunce on 1997/09/30 13:17:27
+ Log: Maintenance 5.004_02 changes
+ Branch: maint-5.004/perl
+ + win32/bin/runperl.bat
+ ! Changes Configure INSTALL MANIFEST Makefile.SH Porting/patchls
+ ! README.os2 README.win32 Todo XSUB.h av.c configpm doio.c
+ ! dosish.h embed.h ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs
+ ! ext/DB_File/typemap ext/GDBM_File/typemap ext/IO/IO.xs
+ ! ext/IO/lib/IO/File.pm ext/IO/lib/IO/Handle.pm
+ ! ext/IO/lib/IO/Socket.pm ext/NDBM_File/typemap
+ ! ext/ODBM_File/ODBM_File.xs ext/POSIX/POSIX.xs
+ ! ext/SDBM_File/typemap global.sym gv.c hints/cxux.sh
+ ! hints/os2.sh hints/sunos_4_1.sh hints/svr4.sh installhtml
+ ! lib/Bundle/CPAN.pm lib/CPAN.pm lib/CPAN/FirstTime.pm
+ ! lib/CPAN/Nox.pm lib/Carp.pm lib/Class/Struct.pm
+ ! lib/Exporter.pm lib/ExtUtils/Command.pm lib/ExtUtils/Embed.pm
+ ! lib/ExtUtils/Install.pm lib/ExtUtils/Liblist.pm
+ ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_VMS.pm
+ ! lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm
+ ! lib/ExtUtils/xsubpp lib/File/Compare.pm lib/File/Copy.pm
+ ! lib/File/Find.pm lib/File/Path.pm lib/FileHandle.pm
+ ! lib/I18N/Collate.pm lib/IPC/Open3.pm lib/Net/hostent.pm
+ ! lib/Pod/Html.pm lib/Shell.pm lib/Sys/Hostname.pm
+ ! lib/Sys/Syslog.pm lib/Term/ReadLine.pm lib/Time/Local.pm
+ ! lib/UNIVERSAL.pm lib/dumpvar.pl lib/ftp.pl lib/perl5db.pl
+ ! malloc.c mg.c op.c opcode.pl os2/Changes os2/Makefile.SHs
+ ! os2/diff.configure os2/os2.c os2/os2ish.h patchlevel.h perl.c
+ ! perl.h pod/perlapio.pod pod/perlbook.pod pod/perldebug.pod
+ ! pod/perldelta.pod pod/perldiag.pod pod/perlembed.pod
+ ! pod/perlfunc.pod pod/perlguts.pod pod/perlop.pod
+ ! pod/perlre.pod pod/perlrun.pod pod/perltoc.pod
+ ! pod/perltrap.pod pod/perlvar.pod pod/perlxstut.pod
+ ! pod/pod2man.PL pod/splitpod pp.c pp_ctl.c pp_hot.c pp_sys.c
+ ! proto.h regcomp.c regexec.c scope.c sv.c t/TEST t/base/lex.t
+ ! t/comp/cmdopt.t t/comp/term.t t/lib/db-btree.t t/lib/db-hash.t
+ ! t/lib/db-recno.t t/lib/filehand.t t/lib/gdbm.t t/lib/ndbm.t
+ ! t/lib/odbm.t t/lib/sdbm.t t/op/local.t t/op/magic.t
+ ! t/op/pack.t t/op/re_tests t/op/ref.t t/op/regexp.t t/op/stat.t
+ ! t/op/substr.t t/op/universal.t toke.c universal.c util.c
+ ! utils/Makefile utils/h2ph.PL utils/perlbug.PL utils/perldoc.PL
+ ! vms/config.vms vms/descrip.mms vms/ext/filespec.t
+ ! vms/sockadapt.c vms/sockadapt.h vms/test.com vms/vms.c
+ ! vms/vmsish.h win32/Makefile win32/bin/pl2bat.bat
+ ! win32/config.bc win32/config.vc win32/config_H.bc
+ ! win32/config_H.vc win32/config_h.PL win32/makedef.pl
+ ! win32/makefile.mk win32/perllib.c win32/win32.c win32/win32.h
+ ! win32/win32io.c win32/win32io.h win32/win32iop.h
+ ! win32/win32sck.c
+____________________________________________________________________________
+[ 80] By: nick on 1997/09/29 20:31:43
+ Log: Add some prototypes in attempt to flush out errors
+ Tidy up vars.h usage.
+ Branch: oneperl
+ ! av.c embed.h hv.c opcode.h perl.c perl.h perlio.c pp_sys.c
+ ! proto.h util.c vars.h
+____________________________________________________________________________
+[ 79] By: nick on 1997/09/29 17:12:07
+ Log: Builds and passes tests without THISPTR
+ Branch: oneperl
+ ! MANIFEST global.sym perl.c perl.h vars.h
+____________________________________________________________________________
+[ 78] By: mbeattie on 1997/09/29 16:57:23
+ Log: Re-introduce the changes from change 68 (runops becomes a
+ function pointer and sv_bless3 for '~'-magic) which got lost
+ during the preparation for the maint-merge.
+ Branch: perl
+ ! global.sym perl.h pp.c proto.h run.c sv.c
+____________________________________________________________________________
+[ 77] By: mbeattie on 1997/09/29 16:44:16
+ Log: Start merge with maint-5.004 branch by creating an ancestral
+ branch point via a fake resolution with the maint-merge branch.
+ See Perforce Tech Note 9 for details.
+ Branch: perl
+ !> (integrate 864 files)
+____________________________________________________________________________
+[ 76] By: nick on 1997/09/28 19:04:42
+ Log: Code with this pointer compiles (but core dumps)
+ Branch: oneperl
+ ! EXTERN.h INTERN.h XSUB.h av.c av.h cop.h cv.h deb.c doio.c
+ ! doop.c dosish.h dump.c form.h gv.c gv.h handy.h hv.c hv.h
+ ! keywords.h mg.c mg.h miniperlmain.c nostdio.h op.c op.h
+ ! opcode.h patchlevel.h perl.c perl.h perlio.c perlio.h
+ ! perlsdio.h perlsfio.h perly.c perly.c.diff perly.h perly.y
+ ! pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c proto.h regcomp.c
+ ! regcomp.h regexec.c regexp.h run.c scope.c scope.h sv.c sv.h
+ ! taint.c thread.h toke.c universal.c unixish.h util.c util.h
+ ! vars.h
+____________________________________________________________________________
+[ 75] By: nick on 1997/09/28 15:45:35
+ Log: Quasi sensible starting point for aTHIS addition.
+ Branch: oneperl
+ ! perl.c perl.h pp_ctl.c sv.c thread.h toke.c util.c
+____________________________________________________________________________
+[ 74] By: nick on 1997/09/28 11:23:32
+ Log: Ooops - unwind perly.* stuff for now
+ Branch: oneperl
+ ! perly.c perly.h perly.y vms/perly_c.vms vms/perly_h.vms
+____________________________________________________________________________
+[ 73] By: nick on 1997/09/28 11:17:23
+ Log: Builds and passes all tests again
+ Branch: oneperl
+ ! embed.pl ext/DB_File/DB_File.xs gv.c perl.c perl.h perly.y
+ ! pp.h proto.h thread.sym vms/perly_c.vms vms/perly_h.vms
+____________________________________________________________________________
+[ 72] By: nick on 1997/09/28 10:47:01
+ Log: Save "important things" before re-try
+ Branch: oneperl
+ + vars.h
+ ! embed.pl thread.h thread.sym
+____________________________________________________________________________
+[ 71] By: nick on 1997/09/26 17:47:31
+ Log: Basic hacks to build with USE_THISPTR, not yet useful
+ but builds miniperl and passes minitest with all thread
+ variables via a _GLOBAL_ thr variable rather than globals.
+ Now for the local thr variable ...
+ Branch: oneperl
+ + thread.sym
+ ! MANIFEST README.threads XSUB.h av.c cv.h deb.c doio.c doop.c
+ ! dump.c embed.pl ext/DB_File/DB_File.xs gv.c hints/solaris_2.sh
+ ! hv.c mg.c op.c perl.c perl.h pp.c pp_ctl.c pp_hot.c pp_sys.c
+ ! proto.h regcomp.c regexec.c run.c scope.c sv.c thread.h toke.c
+ ! util.c vms/vms.c
+____________________________________________________________________________
+[ 70] By: mbeattie on 1997/09/23 14:29:23
+ Log: Branch oneperl from mainline.
+ Branch: oneperl
+ +> (branch 871 files)
+____________________________________________________________________________
+[ 69] By: mbeattie on 1997/09/22 16:02:37
+ Log: struct thread now stored in an SV and uses '~'-magic for access.
+ Branch: perl
+ ! thread.h
+ Branch: perlext
+ ! Thread/Thread.xs Thread/typemap
+____________________________________________________________________________
+[ 68] By: mbeattie on 1997/09/22 16:01:48
+ Log: runops becomes a funtion pointer and sv_bless3 created
+ to avoid pointer forgery with '~'-magic.
+ Branch: perl
+ ! global.sym perl.c perl.h pp.c proto.h run.c sv.c
+____________________________________________________________________________
+[ 67] By: mbeattie on 1997/09/22 15:45:56
+ Log: More fprintf -> PerlIO_printf changes.
+ Branch: perl
+ ! perl.c pp_hot.c util.c
+____________________________________________________________________________
+[ 66] By: mbeattie on 1997/09/22 15:10:40
+ Log: Minor multi-threading patches for VMS.
+ Branch: perl
+ ! mg.c thread.h vms/vms.c
+____________________________________________________________________________
+[ 65] By: mbeattie on 1997/09/15 14:09:11
+ Log: Add undefined-subs option to Lint.pm.
+ Branch: perlext
+ ! Compiler/B/Lint.pm
+____________________________________________________________________________
+[ 64] By: mbeattie on 1997/09/10 16:39:41
+ Log: Debugging output for lock handling.
+ Branch: perl
+ ! mg.c pp.c pp_hot.c util.c
+____________________________________________________________________________
+[ 63] By: mbeattie on 1997/09/10 14:49:00
+ Log: Move Thread/Semaphore.pm to Thread/Thread/Semaphore.pm
+ Branch: perlext
+ +> Thread/Thread/Semaphore.pm
+ - Thread/Semaphore.pm
+____________________________________________________________________________
+[ 62] By: mbeattie on 1997/09/10 14:47:31
+ Log: Move Thread/Queue.pm to Thread/Thread/Queue.pm
+ Branch: perlext
+ +> Thread/Thread/Queue.pm
+ - Thread/Queue.pm
+____________________________________________________________________________
+[ 61] By: mbeattie on 1997/09/10 13:56:50
+ Log: Solaris fixes: delete pad and padname from thread.h and remove
+ MUTEX_* stuff when malloc.c gets copied to x2p/malloc.c.
+ Branch: perl
+ ! thread.h x2p/Makefile.SH
----------------
-Version 5.003_01
+Version 5.004_50 First developer release towards 5.005
----------------
-Version 5.003_01 contains bugfixes and additions accumulated since
-version 5.002_01, since the patch to version 5.003 was deliberately
-kept simple. In addition to numerous small bugfixes in the core,
-library files, and documentation, this patch contains several
-significant revisions, summarized below:
-
-o Visible Changes to Core Functionality
-
- - A port to Plan9 has been started, and changes are integrated into
- the standard distribution. As of this release, the Perl core
- and several common extensions are working.
-
- - A set of basic methods in the UNIVERSAL class have been added to
- the Perl core. Since UNIVERSAL is an implicit member of every
- class's @ISA, the methods can be called via any object.
-
- - A mandatory warning has been added for 'declarations' of lexical
- variables using the "my" operator which mask an existing lexical
- variable declared in the same scope, making the previous variable
- inaccessible by its name.
-
- - The "use" and "require" operators have been extended to allow
- checking of the required module's version. The "use" operator
- can now be used for an immediate version check of Perl itself.
-
- - A new "strict" pragma, "strict untie", has been added, which
- produces an error if a tied value is untied when other references
- exist to the internal object implementing the tie.
-
- - Barewords used as associative array keys (i.e. when specifying
- an associative array element like $foo{__BAR} or on the left
- side of the => operator) may now begin with an underscore as
- well as an alphabetic character.
-
- - Some of the configuration information previously produced by the
- -v switch has been moved to the -V switch, in order to keep -v
- output concise.
-
-o Changes in Core Internals
-
- - Symbol table and method lookups have been made faster.
-
- - Perl subroutines which just return a constant value are now
- optimized at compile time into inline constants.
-
- - Management of keys for associative arrays has been improved to
- conserve space when the same keys are reused frequently, and
- to pass true Perl values to tie functions, instead of stringified
- representations.
-
- - Messages normally output to stderr may be directed to another
- stream when Perl is built. This allows some platforms to
- present diagnostic output in a separate window from normal
- program results.
-
- - A bug which caused suiperl to fail silently, albeit securely,
- in version 5.003 on some systems has been fixed.
-
- - Management of Unix-style signal handlers via the %SIG associative
- array has been made safer.
-
- - Several global C symbols have been renamed to eliminate collisions
- with system C header files or libraries on some platforms.
- Unfortunately, this means that dynamic extensions compiled under
- previous versions of Perl will need to be rebuilt for Perl
- 5.003_01. We're in the process of cleaning up Perl's C
- namespace to make it easier to link Perl with other binaries,
- so this will probably happen again between now and version 5.004.
- After that, we'll do our best to maintain binary compatibility
- between versions.
-
- - An alternate allocation strategy has been added to Perl's
- optional private memory management routines. This strategy,
- which may be selected when Perl is built, is designed to
- conserve memory in programs which allocate many small
- chunks of memory with sizes near a power of 2, as is often
- the case in Perl programs.
-
- - Several memory leaks in the creation and destruction of
- multiple interpreters have been fixed.
-
-o Changes in the Standard Library and Utilities
-
- - The Opcode extension, which allows you to control a program's
- access to Perl operations, has been added to the standard
- distribution. This extends the work begun in the original
- Safe extension, and subsumes it. The Safe interface is still
- available.
-
- - The IO extension, which provides a set of classes for object-
- oriented handling of common I/O tasks, has been added to the
- standard distribution. The IO classes will form the basis
- for future development of Perl's I/O interface, and will
- subsume the FileHandle class in the near future. The default
- class to which all Perl I/O handles belong is now IO::Handle,
- rather than FileHandle.
-
- - The ExtUtils::Embed library module, which provides a set
- of utility function to help in embedding Perl in other
- applications, has been added to the standard distribution.
-
- - The Fatal library module, which provides a simple interface
- for creating "do-or-die" equivalents of existing functions,
- has been added to the standard distribution.
-
- - The FindBin library module, which determines the full path
- to the currently executing program, has been added to the
- standard distribution.
-
- - The DB_File extension, and the Getopt::Long, Test::Harness,
- Text::Tabs, Text::Wrap, Time::Local and sigtrap library modules
- have been updated to the authors' latest versions.
-
- - The Carp library module now considers the @ISA chain when
- determining the caller's package for inclusion in error messages.
-
- - The h2xs, perlbug, and xsubpp utilities have been updated.
-
- - The standard Perl debugger has been updated, and the information
- provided to the debugger when an XSUB is called has been improved,
- making it possible for alternate debuggers (such as Devel::DProf)
- to do a better job of tracking XSUB calls.
-
- - The pod documentation formatting tools in the standard distribution
- can now handle characters in the input stream whose high bit is set.
-
- - The cperl-mode EMACS editing mode has been updated.
-
-o Changes in Documentation
-
- - Typographic and formatting errors have been corrected in the pod
- documentation for the core and standard library files
-
- - Explanations of several core operators have been improved
-
- - The perldebug, perlembed, perlipc, perlsec, and perltrap documents
- extensively revised.
-
-o Changes in OS-specific and Build-time Support
-
- - Support for the NeXT platform has been extended through
- NeXTSTEP/OPENSTEP 4.0, and now includes the ability to create MABs.
-
- - Support for OS/2 has been extended as well, and now includes
- options for building a.out binaries.
-
- - Support for VMS has also been extended, incorporating improved
- processing of file specification strings, optional suppression of
- carriage control interpretation for record-structured files,
- improved support for the -S command line switch, a number of
- VMS-specific bugfixes, and significantly improved performance
- in line-oriented reading of files.
-
- - Several hints files have been added or updated: aux.sh (updated),
- convexos.sh (updated), irix_4.sh (updated), irix_5.sh (updated),
- irix_6_2.sh (updated), next_3.sh (updated), next_3_2.sh (new),
- next_3_3.sh (new), next_4.sh (new), os2/sh (updated),
- sco.sh (updated), and solaris_2.sh (updated).
-
- - The test driver for the regression tests now reports when a set
- of tests have been skipped (presumable because the operation
- they're designed to test isn't supported on the current system).
+Maintenance of the 5.004 version of perl continues with the 5.004_xx
+series, where 'xx' is <= 49. Development of the next version, 5.005,
+starts with 5.004_50.
+
+____________________________________________________________________________
+[ 60] By: mbeattie on 1997/09/09 16:57:41
+ Log: Update README.threads to mention -DL.
+ Branch: perl
+ ! README.threads
+____________________________________________________________________________
+[ 59] By: mbeattie on 1997/09/09 16:49:08
+ Log: Add Thread modules Queue.pm and Semaphore.pm
+ Branch: perlext
+ + Thread/Queue.pm Thread/Semaphore.pm
+____________________________________________________________________________
+[ 58] By: mbeattie on 1997/09/09 16:33:45
+ Log: Update README.threads
+ Branch: perl
+ ! README.threads
+____________________________________________________________________________
+[ 57] By: mbeattie on 1997/09/09 16:26:47
+ Log: Add debug info to Thread typemap.
+ Branch: perlext
+ ! Thread/typemap
+____________________________________________________________________________
+[ 56] By: mbeattie on 1997/09/09 15:04:26
+ Log: Rewrite synchronisation of subs/methods and add attrs
+ extension for specifying 'locked' and 'method' attributes.
+ Branch: perl
+ + ext/attrs/Makefile.PL ext/attrs/attrs.pm ext/attrs/attrs.xs
+ ! MANIFEST cv.h embed.h global.sym op.c perl.c pp.c pp_ctl.c
+ ! pp_hot.c proto.h sv.c sv.h toke.c
+ Branch: perlext
+ ! Thread/Thread.pm Thread/Thread.xs Thread/sync.t Thread/sync2.t
+____________________________________________________________________________
+[ 55] By: mbeattie on 1997/09/03 16:34:47
+ Log: Add new keyword "lock" to Opcode.pm
+ Branch: perl
+ ! ext/Opcode/Opcode.pm
+____________________________________________________________________________
+[ 54] By: mbeattie on 1997/09/03 14:44:44
+ Log: Run embed.pl and keywords.pl to complete RESTART -> INIT change
+ Branch: perl
+ ! embed.h keywords.h
+____________________________________________________________________________
+[ 53] By: mbeattie on 1997/09/03 13:52:24
+ Log: Add to MANIFEST: README.threads, lib/ISA.pm, lib/Class/Fields.pm
+ Branch: perl
+ ! MANIFEST
+____________________________________________________________________________
+[ 52] By: mbeattie on 1997/09/03 13:41:20
+ Log: Let Lint private_names catch out-of-package _foo methods.
+ Branch: perlext
+ ! Compiler/B/Lint.pm
+____________________________________________________________________________
+[ 51] By: mbeattie on 1997/09/03 13:20:12
+ Log: Bump patchlevel.h to 5.004_50
+ Branch: perl
+ ! patchlevel.h
+____________________________________________________________________________
+[ 50] By: mbeattie on 1997/09/03 12:31:48
+ Log: Make compiler build/work with devel 5.005
+ Branch: perlext
+ ! Compiler/B.xs Compiler/B/Asmdata.pm Compiler/bytecode.h
+ ! Compiler/bytecode.pl Compiler/byterun.c Compiler/byterun.h
+____________________________________________________________________________
+[ 49] By: mbeattie on 1997/09/03 12:28:05
+ Log: Rename RESTART to INIT and associated changes
+ Branch: perl
+ ! interp.sym keywords.pl op.c perl.c perl.h perly.c perly.y
+ ! toke.c vms/perly_c.vms
+____________________________________________________________________________
+[ 48] By: mbeattie on 1997/09/02 15:54:27
+ Log: Added private-names option.
+ Branch: perlext
+ ! Compiler/B/Lint.pm
+____________________________________________________________________________
+[ 47] By: mbeattie on 1997/09/02 11:54:55
+ Log: For compiler's CC, make PP_EVAL, PP_ENTERTRY work with JMPENV.
+ Branch: perlext
+ ! Compiler/cc_runtime.h
+____________________________________________________________________________
+[ 46] By: mbeattie on 1997/08/28 19:40:08
+ Log: Missing sprintf in try_autoload.
+ Branch: perlext
+ ! Compiler/B/C.pm
+____________________________________________________________________________
+[ 45] By: mbeattie on 1997/08/13 16:15:25
+ Log: Threading fixups for Digital UNIX.
+ Branch: perl
+ ! README.threads malloc.c perl.h toke.c
+____________________________________________________________________________
+[ 44] By: mbeattie on 1997/08/11 15:46:29
+ Log: Assorted changes for multi-threading (now works rather more).
+ Branch: perl
+ + README.threads
+ ! gv.c mg.c op.c perl.c perl.h pp_ctl.c pp_hot.c sv.c thread.h
+ ! toke.c util.c
+ Branch: perlext
+ ! Thread/Makefile.PL Thread/Thread.xs Thread/lock.t
+ ! Thread/unsync.t
+____________________________________________________________________________
+[ 43] By: mbeattie on 1997/08/08 14:11:00
+ Log: Made Lint check subs (and -u packages).
+ Added support for dollar_underscore and implicit $_ in foreach.
+ Branch: perlext
+ ! Compiler/B/Lint.pm
+____________________________________________________________________________
+[ 42] By: TimBunce on 1997/07/25 17:15:57
+ Log: Maintenance 5.004_01 changes
+ Branch: maint-5.004/perl
+ + Porting/makerel Porting/patchls hints/newsos4.sh
+ + lib/File/DosGlob.pm lib/chat2.pl perlio.sym win32/config.bc
+ + win32/config.vc win32/config_H.bc win32/config_H.vc
+ + win32/makefile.mk
+ - win32/config.H win32/config.w32
+ ! Changes Configure EXTERN.h INSTALL MANIFEST Makefile.SH
+ ! Porting/pumpkin.pod README README.win32 doio.c embed.h
+ ! ext/DynaLoader/dl_aix.xs ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs
+ ! ext/SDBM_File/Makefile.PL ext/SDBM_File/sdbm/Makefile.PL
+ ! global.sym hints/next_3.sh hints/next_4.sh hints/svr4.sh
+ ! installhtml installman lib/AutoLoader.pm lib/AutoSplit.pm
+ ! lib/CGI/Push.pm lib/CPAN.pm lib/ExtUtils/Install.pm
+ ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Unix.pm
+ ! lib/ExtUtils/MM_VMS.pm lib/ExtUtils/MM_Win32.pm
+ ! lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm
+ ! lib/ExtUtils/xsubpp lib/Pod/Html.pm lib/Pod/Text.pm
+ ! lib/Sys/Syslog.pm lib/Term/ReadLine.pm lib/Test/Harness.pm
+ ! lib/ftp.pl mg.c op.c patchlevel.h perl.c perl.h perl_exp.SH
+ ! perlio.c pod/checkpods.PL pod/perlbook.pod pod/perldata.pod
+ ! pod/perldebug.pod pod/perldelta.pod pod/perldiag.pod
+ ! pod/perlembed.pod pod/perlfaq4.pod pod/perlfaq8.pod
+ ! pod/perlfaq9.pod pod/perlfunc.pod pod/perlguts.pod
+ ! pod/perllol.pod pod/perlop.pod pod/perlrun.pod pod/perlsub.pod
+ ! pod/perltoc.pod pod/perltoot.pod pod/pod2man.PL pod/roffitall
+ ! pod/splitpod pp.c pp_ctl.c pp_hot.c pp_sys.c proto.h regcomp.c
+ ! regcomp.h regexec.c sv.c t/lib/safe2.t t/op/flip.t
+ ! t/op/groups.t t/op/magic.t t/op/mkdir.t t/op/re_tests
+ ! t/op/regexp.t t/op/split.t t/op/stat.t t/op/subst.t
+ ! t/op/taint.t util.c utils/Makefile utils/h2xs.PL
+ ! utils/perlbug.PL vms/ext/DCLsym/DCLsym.pm
+ ! vms/ext/Stdio/Stdio.pm vms/gen_shrfls.pl vms/perlvms.pod
+ ! win32/Makefile win32/config_sh.PL win32/include/sys/socket.h
+ ! win32/makedef.pl win32/makeperldef.pl win32/perlglob.c
+ ! win32/perllib.c win32/win32.c win32/win32.h win32/win32io.c
+ ! win32/win32io.h win32/win32iop.h win32/win32sck.c
+____________________________________________________________________________
+[ 41] By: mbeattie on 1997/07/24 14:57:53
+ Log: Start support for fake threads.
+ pp_lock now returns its argument.
+ Branch: perl
+ ! MANIFEST Makefile.SH cv.h op.c opcode.h opcode.pl perl.c
+ ! perl.h pp.c pp_ctl.c pp_hot.c proto.h sv.h thread.h toke.c
+ ! util.c
+ Branch: perlext
+ ! Thread/Thread.xs
+____________________________________________________________________________
+[ 40] By: mbeattie on 1997/07/24 14:55:07
+ Log: Add missing reset of eval_owner if doeval() fails to parse.
+ Branch: perl
+ ! pp_ctl.c
+____________________________________________________________________________
+[ 39] By: mbeattie on 1997/07/17 13:35:51
+ Log: Fix multiple problems with lexical @_.
+ Branch: perl
+ ! cop.h op.c perl.c pp.c pp_ctl.c pp_hot.c t/op/do.t thread.h
+ ! toke.c
+____________________________________________________________________________
+[ 38] By: mbeattie on 1997/07/16 17:02:09
+ Log: Change %lx to %x in B::CV::save to prevent some CV
+ fields becoming 0 in the init section. Add missing
+ write_back in B::Stackobj::Padsv::load_double to fix
+ test 22 of op/my.t.
+ Branch: perlext
+ ! Compiler/B/C.pm Compiler/B/Stackobj.pm
+____________________________________________________________________________
+[ 37] By: mbeattie on 1997/07/10 11:28:16
+ Log: Branch win32 developments from main perl branch.
+ Branch: win32/perl
+ +> (branch 867 files)
+____________________________________________________________________________
+[ 36] By: mbeattie on 1997/07/05 11:58:05
+ Log: B::CC::pp_padsv must cope with vivify_ref (5.004)
+ as well as provide_ref (5.003).
+ Branch: perlext
+ ! Compiler/B/C.pm Compiler/B/CC.pm Compiler/NOTES
+____________________________________________________________________________
+[ 35] By: mbeattie on 1997/07/05 11:55:18
+ Log: Introduce pp_lock.
+ Branch: perl
+ ! embed.h global.sym keywords.h keywords.pl opcode.h opcode.pl
+ ! pp.c pp_ctl.c toke.c
+____________________________________________________________________________
+[ 34] By: mbeattie on 1997/07/01 12:24:28
+ Log: Support for op in global register (still buggy)
+ Branch: perl
+ ! embed.h global.sym gv.c op.c perl.c perl.h pp_ctl.c pp_sys.c
+ ! proto.h scope.c scope.h thread.h
+____________________________________________________________________________
+[ 33] By: mbeattie on 1997/06/24 16:34:24
+ Log: Branch lexical warnings from perl branch.
+ Branch: lexwarn/perl
+ +> (branch 867 files)
+____________________________________________________________________________
+[ 32] By: mbeattie on 1997/06/24 14:33:57
+ Log: Branch integration of maint-5.004 from relperl.
+ Branch: mainline/perl
+ +> (branch 600 files)
+ Branch: maint-5.004/perl
+ +> (branch 864 files)
+____________________________________________________________________________
+[ 31] By: mbeattie on 1997/06/20 11:46:50
+ Log: corrected bad_type() prototype.
+ Branch: perl
+ ! op.c
+____________________________________________________________________________
+[ 30] By: mbeattie on 1997/06/12 12:38:05
+ Log: Tweak README.
+ Branch: perlext
+ ! Thread/README
+____________________________________________________________________________
+[ 29] By: mbeattie on 1997/06/12 12:34:59
+ Log: Document -m option of CC backend.
+ Branch: perlext
+ ! Compiler/NOTES
+____________________________________________________________________________
+[ 28] By: mbeattie on 1997/06/12 12:25:05
+ Log: Support sysseek introduced in 5.004.
+ Branch: perlext
+ ! Compiler/ccop.c Compiler/ccop.h
+____________________________________________________________________________
+[ 27] By: mbeattie on 1997/06/05 14:20:51
+ Log: More fixups for thrperl integration.
+ Branch: perl
+ ! ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs
+ ! ext/Opcode/Makefile.PL ext/Opcode/Opcode.pm
+ ! ext/Opcode/Opcode.xs gv.c hv.c mg.c op.c perl.c perly.c
+ ! perly.y pp.c pp_ctl.c run.c scope.c sv.c sv.h thread.h toke.c
+ ! util.c
+____________________________________________________________________________
+[ 25] By: mbeattie on 1997/05/28 15:11:24
+ Log: Fixups for thrperl integration.
+ Branch: perl
+ ! embed.h keywords.h op.c opcode.h perl.c util.c
+____________________________________________________________________________
+[ 24] By: mbeattie on 1997/05/26 20:10:42
+ Log: Integrate thrperl 5.003->5.004.
+ Branch: perl
+ +> thread.h
+ !> (integrate 33 files)
+____________________________________________________________________________
+[ 23] By: mbeattie on 1997/05/26 11:45:39
+ Log: Fix ppname when saving subs.
+ Branch: perlext
+ ! Compiler/B/C.pm
+____________________________________________________________________________
+[ 22] By: mbeattie on 1997/05/26 11:45:03
+ Log: -mFoo option now forces -uFoo.
+ Branch: perlext
+ ! Compiler/B/CC.pm
+____________________________________________________________________________
+[ 21] By: mbeattie on 1997/05/26 11:43:37
+ Log: Put back objsym/savesym (used by walkoptree_exec).
+ Branch: perlext
+ ! Compiler/B.pm
+____________________________________________________________________________
+[ 20] By: mbeattie on 1997/05/26 11:38:45
+ Log: Add avhv_store_ent. Add missing avhv_* to global.sym.
+ Branch: perl
+ ! av.c global.sym
+____________________________________________________________________________
+[ 19] By: mbeattie on 1997/05/25 21:19:38
+ Log: Fix up integration 5.003->5.004.
+ Branch: perl
+ + lib/Class/Fields.pm lib/ISA.pm
+ ! av.c ext/DB_File/DB_File.xs perl.c pp.c pp_hot.c proto.h
+ ! toke.c
+____________________________________________________________________________
+[ 18] By: mbeattie on 1997/05/25 10:31:21
+ Log: First stab at 5.003 -> 5.004 integration.
+ Branch: perl
+ +> (branch 291 files)
+ - Changes.Conf ext/DynaLoader/dl_os2.xs
+ - ext/FileHandle/FileHandle.pm ext/FileHandle/FileHandle.xs
+ - ext/FileHandle/Makefile.PL ext/SDBM_File/sdbm/readme.ps
+ - ext/Safe/Makefile.PL ext/Safe/Safe.pm ext/Safe/Safe.xs
+ - hints/aux.sh hints/dnix.sh hints/irix_6_2.sh lib/chat2.inter
+ - lib/chat2.pl lib/splain os2/README os2/README.old
+ - os2/diff.db_file os2/notes pod/perlovl.pod t/lib/safe.t
+ - t/op/overload.t t/re_tests vms/Makefile x2p/a2p.man
+ - x2p/handy.h x2p/s2p.man
+ !> (integrate 392 files)
+____________________________________________________________________________
+[ 17] By: mbeattie on 1997/05/24 18:46:49
+ Log: Wholesale update to 5.004.
+ Branch: relperl
+ + Changes5.000 Changes5.001 Changes5.002 Changes5.003
+ + Porting/Glossary Porting/pumpkin.pod README.amiga
+ + README.cygwin32 README.os2 README.plan9 README.qnx
+ + README.win32 compat3.sym configure.gnu cygwin32/cw32imp.h
+ + cygwin32/gcc2 cygwin32/ld2 cygwin32/perlgcc cygwin32/perlld
+ + eg/cgi/RunMeFirst eg/cgi/clickable_image.cgi eg/cgi/cookie.cgi
+ + eg/cgi/crash.cgi eg/cgi/customize.cgi eg/cgi/diff_upload.cgi
+ + eg/cgi/file_upload.cgi eg/cgi/frameset.cgi eg/cgi/index.html
+ + eg/cgi/internal_links.cgi eg/cgi/javascript.cgi
+ + eg/cgi/monty.cgi eg/cgi/multiple_forms.cgi
+ + eg/cgi/nph-clock.cgi eg/cgi/popup.cgi eg/cgi/save_state.cgi
+ + eg/cgi/tryit.cgi eg/cgi/wilogo.gif.uu
+ + ext/DynaLoader/dl_cygwin32.xs ext/IO/IO.pm ext/IO/IO.xs
+ + ext/IO/Makefile.PL ext/IO/README ext/IO/lib/IO/File.pm
+ + ext/IO/lib/IO/Handle.pm ext/IO/lib/IO/Pipe.pm
+ + ext/IO/lib/IO/Seekable.pm ext/IO/lib/IO/Select.pm
+ + ext/IO/lib/IO/Socket.pm ext/NDBM_File/hints/dec_osf.pl
+ + ext/NDBM_File/hints/dynixptx.pl ext/ODBM_File/hints/hpux.pl
+ + ext/ODBM_File/hints/ultrix.pl ext/Opcode/Makefile.PL
+ + ext/Opcode/Opcode.pm ext/Opcode/Opcode.xs ext/Opcode/Safe.pm
+ + ext/Opcode/ops.pm ext/POSIX/hints/next_3.pl hints/amigaos.sh
+ + hints/aux_3.sh hints/broken-db.msg hints/cygwin32.sh
+ + hints/dcosx.sh hints/irix_6_0.sh hints/irix_6_1.sh
+ + hints/lynxos.sh hints/next_4.sh hints/qnx.sh hints/umips.sh
+ + hints/unicosmk.sh installhtml lib/Bundle/CPAN.pm lib/CGI.pm
+ + lib/CGI/Apache.pm lib/CGI/Carp.pm lib/CGI/Fast.pm
+ + lib/CGI/Push.pm lib/CGI/Switch.pm lib/CPAN.pm
+ + lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm lib/Class/Struct.pm
+ + lib/ExtUtils/Command.pm lib/ExtUtils/Embed.pm
+ + lib/ExtUtils/MM_Win32.pm lib/File/Compare.pm lib/File/stat.pm
+ + lib/FileHandle.pm lib/FindBin.pm lib/Math/Trig.pm
+ + lib/Net/hostent.pm lib/Net/netent.pm lib/Net/protoent.pm
+ + lib/Net/servent.pm lib/Pod/Html.pm lib/Tie/RefHash.pm
+ + lib/Time/gmtime.pm lib/Time/localtime.pm lib/Time/tm.pm
+ + lib/UNIVERSAL.pm lib/User/grent.pm lib/User/pwent.pm
+ + lib/autouse.pm lib/blib.pm lib/constant.pm lib/locale.pm
+ + nostdio.h os2/Changes os2/OS2/ExtAttr/Changes
+ + os2/OS2/ExtAttr/ExtAttr.pm os2/OS2/ExtAttr/ExtAttr.xs
+ + os2/OS2/ExtAttr/MANIFEST os2/OS2/ExtAttr/Makefile.PL
+ + os2/OS2/ExtAttr/myea.h os2/OS2/ExtAttr/t/os2_ea.t
+ + os2/OS2/ExtAttr/typemap os2/OS2/PrfDB/Changes
+ + os2/OS2/PrfDB/MANIFEST os2/OS2/PrfDB/Makefile.PL
+ + os2/OS2/PrfDB/PrfDB.pm os2/OS2/PrfDB/PrfDB.xs
+ + os2/OS2/PrfDB/t/os2_prfdb.t os2/OS2/PrfDB/typemap
+ + os2/OS2/Process/MANIFEST os2/OS2/Process/Makefile.PL
+ + os2/OS2/Process/Process.pm os2/OS2/Process/Process.xs
+ + os2/OS2/REXX/Changes os2/OS2/REXX/MANIFEST
+ + os2/OS2/REXX/Makefile.PL os2/OS2/REXX/REXX.pm
+ + os2/OS2/REXX/REXX.xs os2/OS2/REXX/t/rx_cmprt.t
+ + os2/OS2/REXX/t/rx_dllld.t os2/OS2/REXX/t/rx_objcall.t
+ + os2/OS2/REXX/t/rx_sql.test os2/OS2/REXX/t/rx_tiesql.test
+ + os2/OS2/REXX/t/rx_tievar.t os2/OS2/REXX/t/rx_tieydb.t
+ + os2/OS2/REXX/t/rx_varset.t os2/OS2/REXX/t/rx_vrexx.t
+ + os2/dl_os2.c os2/dlfcn.h perlio.c perlio.h perlsdio.h
+ + perlsfio.h plan9/aperl plan9/arpa/inet.h plan9/buildinfo
+ + plan9/config.plan9 plan9/exclude plan9/fndvers
+ + plan9/genconfig.pl plan9/mkfile plan9/myconfig.plan9
+ + plan9/perlplan9.doc plan9/perlplan9.pod plan9/plan9.c
+ + plan9/plan9ish.h plan9/setup.rc plan9/versnum pod/checkpods.PL
+ + pod/perlapio.pod pod/perldelta.pod pod/perlfaq.pod
+ + pod/perlfaq1.pod pod/perlfaq2.pod pod/perlfaq3.pod
+ + pod/perlfaq4.pod pod/perlfaq5.pod pod/perlfaq6.pod
+ + pod/perlfaq7.pod pod/perlfaq8.pod pod/perlfaq9.pod
+ + pod/perllocale.pod pod/perlmodlib.pod pod/perltoot.pod
+ + pod/rofftoc qnx/ar qnx/cpp t/comp/colon.t t/comp/proto.t
+ + t/comp/redef.t t/comp/use.t t/io/read.t t/lib/abbrev.t
+ + t/lib/autoloader.t t/lib/basename.t t/lib/checktree.t
+ + t/lib/complex.t t/lib/env.t t/lib/filecache.t t/lib/filecopy.t
+ + t/lib/filefind.t t/lib/filepath.t t/lib/findbin.t
+ + t/lib/getopt.t t/lib/hostname.t t/lib/io_dup.t t/lib/io_pipe.t
+ + t/lib/io_sel.t t/lib/io_sock.t t/lib/io_taint.t
+ + t/lib/io_tell.t t/lib/io_udp.t t/lib/io_xs.t t/lib/opcode.t
+ + t/lib/open2.t t/lib/open3.t t/lib/ops.t t/lib/parsewords.t
+ + t/lib/safe1.t t/lib/safe2.t t/lib/searchdict.t
+ + t/lib/selectsaver.t t/lib/symbol.t t/lib/texttabs.t
+ + t/lib/textwrap.t t/lib/timelocal.t t/lib/trig.t t/op/arith.t
+ + t/op/assignwarn.t t/op/bop.t t/op/closure.t t/op/cmp.t
+ + t/op/gv.t t/op/inc.t t/op/method.t t/op/recurse.t
+ + t/op/runlevel.t t/op/sysio.t t/op/taint.t t/op/tie.t
+ + t/op/universal.t t/pragma/constant.t t/pragma/locale.t
+ + t/pragma/overload.t t/pragma/strict-refs t/pragma/strict-subs
+ + t/pragma/strict-vars t/pragma/strict.t t/pragma/subs.t
+ + t/pragma/warn-1global t/pragma/warning.t universal.c
+ + utils/splain.PL vms/ext/DCLsym/0README.txt
+ + vms/ext/DCLsym/DCLsym.pm vms/ext/DCLsym/DCLsym.xs
+ + vms/ext/DCLsym/Makefile.PL vms/ext/DCLsym/test.pl
+ + vms/ext/XSSymSet.pm vms/ext/filespec.t vms/ext/vmsish.pm
+ + vms/ext/vmsish.t win32/Makefile win32/TEST win32/autosplit.pl
+ + win32/bin/network.pl win32/bin/pl2bat.bat win32/bin/search.bat
+ + win32/bin/test.bat win32/bin/webget.bat win32/bin/www.pl
+ + win32/config.H win32/config.w32 win32/config_h.PL
+ + win32/config_sh.PL win32/dl_win32.xs win32/genxsdef.pl
+ + win32/include/arpa/inet.h win32/include/dirent.h
+ + win32/include/netdb.h win32/include/sys/socket.h
+ + win32/makedef.pl win32/makemain.pl win32/makeperldef.pl
+ + win32/perlglob.c win32/perllib.c win32/pod.mak win32/runperl.c
+ + win32/splittree.pl win32/win32.c win32/win32.h win32/win32io.c
+ + win32/win32io.h win32/win32iop.h win32/win32sck.c x2p/a2p.pod
+ + x2p/proto.h
+ - Changes.Conf ext/DynaLoader/dl_os2.xs
+ - ext/FileHandle/FileHandle.pm ext/FileHandle/FileHandle.xs
+ - ext/FileHandle/Makefile.PL ext/SDBM_File/sdbm/readme.ps
+ - ext/Safe/Makefile.PL ext/Safe/Safe.pm ext/Safe/Safe.xs
+ - hints/aux.sh hints/dnix.sh hints/irix_6_2.sh lib/chat2.inter
+ - lib/chat2.pl lib/splain os2/README os2/README.old
+ - os2/diff.db_file os2/notes pod/perlovl.pod t/lib/safe.t
+ - t/op/overload.t t/re_tests vms/Makefile x2p/a2p.man
+ - x2p/handy.h x2p/s2p.man
+ ! Artistic Changes Configure EXTERN.h INSTALL INTERN.h MANIFEST
+ ! Makefile.SH README README.vms Todo XSUB.h av.c av.h cflags.SH
+ ! config_H config_h.SH configpm configure cop.h cv.h deb.c
+ ! doio.c doop.c dosish.h dump.c eg/README eg/nih
+ ! eg/sysvipc/ipcmsg eg/sysvipc/ipcsem eg/sysvipc/ipcshm
+ ! emacs/cperl-mode.el embed.h embed.pl ext/DB_File/DB_File.pm
+ ! ext/DB_File/DB_File.xs ext/DB_File/Makefile.PL
+ ! ext/DB_File/typemap ext/DynaLoader/DynaLoader.pm
+ ! ext/DynaLoader/Makefile.PL ext/DynaLoader/dl_aix.xs
+ ! ext/DynaLoader/dl_dld.xs ext/DynaLoader/dl_dlopen.xs
+ ! ext/DynaLoader/dl_hpux.xs ext/DynaLoader/dl_next.xs
+ ! ext/DynaLoader/dl_vms.xs ext/DynaLoader/dlutils.c
+ ! ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs
+ ! ext/GDBM_File/GDBM_File.pm ext/NDBM_File/NDBM_File.pm
+ ! ext/ODBM_File/ODBM_File.pm ext/ODBM_File/ODBM_File.xs
+ ! ext/ODBM_File/hints/dec_osf.pl ext/POSIX/POSIX.pm
+ ! ext/POSIX/POSIX.pod ext/POSIX/POSIX.xs
+ ! ext/SDBM_File/Makefile.PL ext/SDBM_File/SDBM_File.pm
+ ! ext/SDBM_File/sdbm/Makefile.PL ext/SDBM_File/sdbm/pair.c
+ ! ext/SDBM_File/sdbm/pair.h ext/SDBM_File/sdbm/sdbm.3
+ ! ext/SDBM_File/sdbm/sdbm.c ext/SDBM_File/sdbm/sdbm.h
+ ! ext/Socket/Socket.pm ext/Socket/Socket.xs ext/util/make_ext
+ ! form.h global.sym gv.c gv.h handy.h hints/3b1.sh
+ ! hints/README.hints hints/aix.sh hints/apollo.sh hints/bsdos.sh
+ ! hints/convexos.sh hints/cxux.sh hints/dec_osf.sh hints/dgux.sh
+ ! hints/dynixptx.sh hints/epix.sh hints/esix4.sh
+ ! hints/freebsd.sh hints/hpux.sh hints/irix_4.sh hints/irix_5.sh
+ ! hints/irix_6.sh hints/isc.sh hints/linux.sh hints/machten.sh
+ ! hints/machten_2.sh hints/mips.sh hints/mpeix.sh
+ ! hints/netbsd.sh hints/next_3.sh hints/next_3_0.sh hints/os2.sh
+ ! hints/powerux.sh hints/sco.sh hints/sco_2_3_3.sh
+ ! hints/sco_2_3_4.sh hints/solaris_2.sh hints/sunos_4_0.sh
+ ! hints/sunos_4_1.sh hints/svr4.sh hints/titanos.sh
+ ! hints/ultrix_4.sh hints/unicos.sh hints/utekv.sh hv.c hv.h
+ ! installman installperl interp.sym keywords.h keywords.pl
+ ! lib/AnyDBM_File.pm lib/AutoLoader.pm lib/AutoSplit.pm
+ ! lib/Benchmark.pm lib/Carp.pm lib/Cwd.pm
+ ! lib/Devel/SelfStubber.pm lib/English.pm lib/Env.pm
+ ! lib/Exporter.pm lib/ExtUtils/Install.pm
+ ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_OS2.pm
+ ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_VMS.pm
+ ! lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Manifest.pm
+ ! lib/ExtUtils/Mkbootstrap.pm lib/ExtUtils/Mksymlists.pm
+ ! lib/ExtUtils/testlib.pm lib/ExtUtils/typemap
+ ! lib/ExtUtils/xsubpp lib/File/Basename.pm lib/File/Copy.pm
+ ! lib/File/Find.pm lib/File/Path.pm lib/FileCache.pm
+ ! lib/Getopt/Long.pm lib/Getopt/Std.pm lib/I18N/Collate.pm
+ ! lib/IPC/Open2.pm lib/IPC/Open3.pm lib/Math/BigInt.pm
+ ! lib/Math/Complex.pm lib/Net/Ping.pm lib/Pod/Functions.pm
+ ! lib/Pod/Text.pm lib/Search/Dict.pm lib/SelectSaver.pm
+ ! lib/SelfLoader.pm lib/Symbol.pm lib/Sys/Hostname.pm
+ ! lib/Sys/Syslog.pm lib/Term/Cap.pm lib/Term/Complete.pm
+ ! lib/Term/ReadLine.pm lib/Test/Harness.pm lib/Text/Abbrev.pm
+ ! lib/Text/ParseWords.pm lib/Text/Soundex.pm lib/Text/Tabs.pm
+ ! lib/Text/Wrap.pm lib/Tie/Hash.pm lib/Tie/Scalar.pm
+ ! lib/Tie/SubstrHash.pm lib/Time/Local.pm lib/abbrev.pl
+ ! lib/bigfloat.pl lib/bigint.pl lib/cacheout.pl lib/complete.pl
+ ! lib/diagnostics.pm lib/dotsh.pl lib/dumpvar.pl lib/find.pl
+ ! lib/finddepth.pl lib/ftp.pl lib/getcwd.pl lib/getopts.pl
+ ! lib/importenv.pl lib/lib.pm lib/look.pl lib/newgetopt.pl
+ ! lib/open2.pl lib/open3.pl lib/overload.pm lib/perl5db.pl
+ ! lib/sigtrap.pm lib/strict.pm lib/subs.pm lib/syslog.pl
+ ! lib/termcap.pl lib/timelocal.pl lib/validate.pl lib/vars.pm
+ ! makeaperl.SH makedepend.SH malloc.c mg.c mg.h minimod.pl
+ ! miniperlmain.c myconfig op.c op.h opcode.h opcode.pl
+ ! os2/Makefile.SHs os2/diff.configure os2/os2.c os2/os2ish.h
+ ! os2/perl2cmd.pl patchlevel.h perl.c perl.h perl_exp.SH perlsh
+ ! perly.c perly.c.diff perly.h perly.y pod/Makefile pod/buildtoc
+ ! pod/perl.pod pod/perlbook.pod pod/perlbot.pod pod/perlcall.pod
+ ! pod/perldata.pod pod/perldebug.pod pod/perldiag.pod
+ ! pod/perldsc.pod pod/perlembed.pod pod/perlform.pod
+ ! pod/perlfunc.pod pod/perlguts.pod pod/perlipc.pod
+ ! pod/perllol.pod pod/perlmod.pod pod/perlobj.pod pod/perlop.pod
+ ! pod/perlpod.pod pod/perlre.pod pod/perlref.pod pod/perlrun.pod
+ ! pod/perlsec.pod pod/perlstyle.pod pod/perlsub.pod
+ ! pod/perlsyn.pod pod/perltie.pod pod/perltoc.pod
+ ! pod/perltrap.pod pod/perlvar.pod pod/perlxs.pod
+ ! pod/perlxstut.pod pod/pod2html.PL pod/pod2latex.PL
+ ! pod/pod2man.PL pod/pod2text.PL pod/roffitall pp.c pp.h
+ ! pp_ctl.c pp_hot.c pp_sys.c proto.h regcomp.c regcomp.h
+ ! regexec.c regexp.h run.c scope.c scope.h sv.c sv.h t/README
+ ! t/TEST t/base/lex.t t/base/term.t t/cmd/mod.t t/cmd/while.t
+ ! t/comp/cpp.t t/comp/multiline.t t/comp/package.t
+ ! t/comp/script.t t/harness t/io/argv.t t/io/dup.t t/io/fs.t
+ ! t/io/inplace.t t/io/pipe.t t/io/tell.t t/lib/anydbm.t
+ ! t/lib/bigintpm.t t/lib/db-btree.t t/lib/db-hash.t
+ ! t/lib/db-recno.t t/lib/dirhand.t t/lib/filehand.t t/lib/gdbm.t
+ ! t/lib/ndbm.t t/lib/odbm.t t/lib/posix.t t/lib/sdbm.t
+ ! t/lib/socket.t t/op/chop.t t/op/delete.t t/op/each.t
+ ! t/op/exec.t t/op/fork.t t/op/glob.t t/op/goto.t t/op/groups.t
+ ! t/op/magic.t t/op/misc.t t/op/mkdir.t t/op/my.t t/op/oct.t
+ ! t/op/pack.t t/op/pat.t t/op/quotemeta.t t/op/rand.t
+ ! t/op/re_tests t/op/readdir.t t/op/ref.t t/op/regexp.t
+ ! t/op/sleep.t t/op/sort.t t/op/split.t t/op/stat.t t/op/subst.t
+ ! t/op/substr.t t/op/write.t taint.c toke.c unixish.h util.c
+ ! util.h utils/Makefile utils/c2ph.PL utils/h2ph.PL
+ ! utils/h2xs.PL utils/perlbug.PL utils/perldoc.PL utils/pl2pm.PL
+ ! vms/config.vms vms/descrip.mms vms/ext/Filespec.pm
+ ! vms/ext/Stdio/Stdio.pm vms/ext/Stdio/Stdio.xs
+ ! vms/ext/Stdio/test.pl vms/fndvers.com vms/gen_shrfls.pl
+ ! vms/genconfig.pl vms/genopt.com vms/myconfig.com
+ ! vms/perlvms.pod vms/perly_c.vms vms/perly_h.vms
+ ! vms/sockadapt.c vms/sockadapt.h vms/test.com vms/vms.c
+ ! vms/vms_yfix.pl vms/vmsish.h vms/writemain.pl writemain.SH
+ ! x2p/EXTERN.h x2p/INTERN.h x2p/Makefile.SH x2p/a2p.c x2p/a2p.h
+ ! x2p/a2p.y x2p/a2py.c x2p/cflags.SH x2p/find2perl.PL x2p/hash.c
+ ! x2p/hash.h x2p/s2p.PL x2p/str.c x2p/str.h x2p/util.c
+ ! x2p/util.h x2p/walk.c
+____________________________________________________________________________
+[ 16] By: mbeattie on 1997/05/23 22:42:08
+ Log: Initial integration of relperl from 5.003.
+ Branch: relperl
+ +> (branch 600 files)
+____________________________________________________________________________
+[ 14] By: mbeattie on 1997/05/12 20:22:56
+ Log: Finish code generation rewrite. Clean up B::Section class and
+ handle symbol table translation internally. Simple .pm modules
+ now compile OK.
+ Branch: perlext
+ ! Compiler/B.pm Compiler/B/Bblock.pm Compiler/B/C.pm
+ ! Compiler/B/CC.pm
+____________________________________________________________________________
+[ 13] By: mbeattie on 1997/05/05 19:41:18
+ Log: Don't make pp_enter and pp_return trigger basic blocks.
+ Branch: perlext
+ ! Compiler/B/Bblock.pm
+____________________________________________________________________________
+[ 12] By: mbeattie on 1997/05/05 19:40:16
+ Log: Rewrite code generation. Sections (de)multiplexed into a
+ temporary file instead of stored in arrays.
+ Branch: perlext
+ ! Compiler/B.pm Compiler/B/C.pm Compiler/B/CC.pm
+____________________________________________________________________________
+[ 11] By: mbeattie on 1997/05/03 20:20:59
+ Log: Development to pre-alpha4
+ Branch: perlext
+ + Compiler/B/Deparse.pm Compiler/B/Lint.pm Compiler/makeliblinks
+ ! Compiler/B.pm Compiler/B.xs Compiler/B/Bblock.pm
+ ! Compiler/B/Bytecode.pm Compiler/B/C.pm Compiler/B/CC.pm
+ ! Compiler/B/Debug.pm Compiler/B/Terse.pm Compiler/B/Xref.pm
+ ! Compiler/Makefile.PL Compiler/README Compiler/TESTS
+ ! Compiler/assemble Compiler/bytecode.pl Compiler/byteperl.c
+ ! Compiler/byterun.c Compiler/cc_runtime.h Compiler/disassemble
+ ! Compiler/test_harness Compiler/test_harness_cc
+____________________________________________________________________________
+[ 10] By: mbeattie on 1997/05/03 14:47:06
+ Log: Initial check-in of perl compiler.
+ Branch: perlext
+ + Compiler/Artistic Compiler/B.pm Compiler/B.xs
+ + Compiler/B/Asmdata.pm Compiler/B/Assembler.pm
+ + Compiler/B/Bblock.pm Compiler/B/Bytecode.pm Compiler/B/C.pm
+ + Compiler/B/CC.pm Compiler/B/Debug.pm
+ + Compiler/B/Disassembler.pm Compiler/B/Showlex.pm
+ + Compiler/B/Stackobj.pm Compiler/B/Terse.pm Compiler/B/Xref.pm
+ + Compiler/Copying Compiler/Makefile.PL Compiler/NOTES
+ + Compiler/O.pm Compiler/README Compiler/TESTS
+ + Compiler/TESTS.alpha2 Compiler/Todo Compiler/assemble
+ + Compiler/bytecode.h Compiler/bytecode.pl Compiler/byteperl.c
+ + Compiler/byterun.c Compiler/byterun.h Compiler/cc_harness
+ + Compiler/cc_runtime.h Compiler/ccop.c Compiler/ccop.h
+ + Compiler/disassemble Compiler/old/README.feb11
+ + Compiler/old/TESTS.mar11 Compiler/old/TESTS.mar20
+ + Compiler/old/TESTS.may11 Compiler/old/TESTS.pre-jul27
+ + Compiler/op.patch Compiler/ramblings/cc.notes
+ + Compiler/ramblings/curcop.runtime
+ + Compiler/ramblings/dontparse.c Compiler/ramblings/flip-flop
+ + Compiler/ramblings/foo.bench Compiler/ramblings/foo2.bench
+ + Compiler/ramblings/foo3.bench Compiler/ramblings/magic
+ + Compiler/ramblings/pp_i_add Compiler/ramblings/reg.alloc
+ + Compiler/ramblings/runtime.porting
+ + Compiler/ramblings/sort.notes Compiler/ramblings/sub.call
+ + Compiler/ramblings/subst.notes Compiler/run_bytecode_test
+ + Compiler/run_cc_test Compiler/run_test Compiler/test_harness
+ + Compiler/test_harness_bytecode Compiler/test_harness_cc
+ + Compiler/typemap
+____________________________________________________________________________
+[ 9] By: mbeattie on 1997/05/02 19:03:49
+ Log: Don't require CvDEPTH == 0 when bombing out of subs.
+ Branch: thrperl
+ ! pp_hot.c
+____________________________________________________________________________
+[ 8] By: mbeattie on 1997/04/23 19:06:45
+ Log: Added programmer-level condition variables via "condpair" magic.
+ Added support for detached threads and tweaked a few things.
+ Branch: thrperl
+ ! embed.h global.sym keywords.h mg.c opcode.h perl.c perl.h
+ ! pp_ctl.c pp_hot.c proto.h run.c scope.c sv.c sv.h thread.h
+ ! util.c
+____________________________________________________________________________
+[ 7] By: mbeattie on 1997/04/23 19:04:18
+ Log: Rewrote programmer-level condition variables from scratch. Added
+ support for detaching threads. Fixed handling for arguments
+ passed in to threads and return values for joined threads.
+ Branch: perlext
+ + Thread/lock.t
+ ! Thread/README Thread/Thread.pm Thread/Thread.xs Thread/cond.t
+ ! Thread/typemap
+____________________________________________________________________________
+[ 6] By: mbeattie on 1997/04/10 20:17:26
+ Log: Initial check-in of Thread module.
+ Branch: perlext
+ + Thread/Makefile.PL Thread/Notes Thread/README Thread/Thread.pm
+ + Thread/Thread.xs Thread/cond.t Thread/create.t Thread/io.t
+ + Thread/join.t Thread/sync.t Thread/sync2.t Thread/typemap
+ + Thread/unsync.t Thread/unsync2.t Thread/unsync3.t
+ + Thread/unsync4.t
+____________________________________________________________________________
+[ 5] By: mbeattie on 1997/04/10 20:05:52
+ Log: Tweaks to allow compilation without -DUSE_THREADS and fix
+ missing parens (pad allocation) in the tokener.
+ Branch: thrperl
+ ! op.c pp_ctl.c toke.c
+____________________________________________________________________________
+[ 4] By: mbeattie on 1997/03/28 18:40:44
+ Log: Initial 3-way merge from (5.001m, thr1m, 5.003) plus fixups.
+ Branch: thrperl
+ + thread.h
+ ! XSUB.h av.c cv.h deb.c doio.c doop.c dump.c global.sym gv.c
+ ! hv.c malloc.c mg.c op.c op.h opcode.h opcode.pl perl.c perl.h
+ ! pp.h pp_ctl.c pp_hot.c pp_sys.c proto.h regcomp.c regexec.c
+ ! run.c scope.c sv.c sv.h toke.c util.c
+____________________________________________________________________________
+[ 3] By: mbeattie on 1997/03/28 13:36:23
+ Log: Branch 5.003 -> thrperl
+ Branch: thrperl
+ +> (branch 600 files)
+____________________________________________________________________________
+[ 2] By: mbeattie on 1997/03/28 13:32:21
+ Log: Initial devel changes.
+ Pseudo-hashes. Optional strong typing. RESTART {}.
+ Branch: perl
+ ! av.c doop.c embed.h ext/DB_File/DB_File.xs global.sym
+ ! interp.sym keywords.h keywords.pl lib/ExtUtils/xsubpp op.c
+ ! perl.c perl.h pp.c pp_hot.c proto.h t/op/groups.t toke.c
+____________________________________________________________________________
+[ 1] By: mbeattie on 1997/03/28 13:17:33
+ Log: Perl 5.003 check-in
+ Branch: perl
+ + Artistic Changes Changes.Conf Configure Copying EXTERN.h
+ + INSTALL INTERN.h MANIFEST Makefile.SH README README.vms Todo
+ + XSUB.h av.c av.h cflags.SH config_H config_h.SH configpm
+ + configure cop.h cv.h deb.c doio.c doop.c dosish.h dump.c
+ + eg/ADB eg/README eg/changes eg/client eg/down eg/dus eg/findcp
+ + eg/findtar eg/g/gcp eg/g/gcp.man eg/g/ged eg/g/ghosts eg/g/gsh
+ + eg/g/gsh.man eg/muck eg/muck.man eg/myrup eg/nih eg/relink
+ + eg/rename eg/rmfrom eg/scan/scan_df eg/scan/scan_last
+ + eg/scan/scan_messages eg/scan/scan_passwd eg/scan/scan_ps
+ + eg/scan/scan_sudo eg/scan/scan_suid eg/scan/scanner eg/server
+ + eg/shmkill eg/sysvipc/README eg/sysvipc/ipcmsg
+ + eg/sysvipc/ipcsem eg/sysvipc/ipcshm eg/travesty eg/unuc
+ + eg/uudecode eg/van/empty eg/van/unvanish eg/van/vanexp
+ + eg/van/vanish eg/who eg/wrapsuid emacs/cperl-mode.el embed.h
+ + embed.pl ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs
+ + ext/DB_File/DB_File_BS ext/DB_File/Makefile.PL
+ + ext/DB_File/typemap ext/DynaLoader/DynaLoader.pm
+ + ext/DynaLoader/Makefile.PL ext/DynaLoader/README
+ + ext/DynaLoader/dl_aix.xs ext/DynaLoader/dl_dld.xs
+ + ext/DynaLoader/dl_dlopen.xs ext/DynaLoader/dl_hpux.xs
+ + ext/DynaLoader/dl_next.xs ext/DynaLoader/dl_none.xs
+ + ext/DynaLoader/dl_os2.xs ext/DynaLoader/dl_vms.xs
+ + ext/DynaLoader/dlutils.c ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs
+ + ext/Fcntl/Makefile.PL ext/FileHandle/FileHandle.pm
+ + ext/FileHandle/FileHandle.xs ext/FileHandle/Makefile.PL
+ + ext/GDBM_File/GDBM_File.pm ext/GDBM_File/GDBM_File.xs
+ + ext/GDBM_File/Makefile.PL ext/GDBM_File/typemap
+ + ext/NDBM_File/Makefile.PL ext/NDBM_File/NDBM_File.pm
+ + ext/NDBM_File/NDBM_File.xs ext/NDBM_File/hints/solaris.pl
+ + ext/NDBM_File/hints/svr4.pl ext/NDBM_File/typemap
+ + ext/ODBM_File/Makefile.PL ext/ODBM_File/ODBM_File.pm
+ + ext/ODBM_File/ODBM_File.xs ext/ODBM_File/hints/dec_osf.pl
+ + ext/ODBM_File/hints/sco.pl ext/ODBM_File/hints/solaris.pl
+ + ext/ODBM_File/hints/svr4.pl ext/ODBM_File/typemap
+ + ext/POSIX/Makefile.PL ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod
+ + ext/POSIX/POSIX.xs ext/POSIX/typemap ext/SDBM_File/Makefile.PL
+ + ext/SDBM_File/SDBM_File.pm ext/SDBM_File/SDBM_File.xs
+ + ext/SDBM_File/sdbm/CHANGES ext/SDBM_File/sdbm/COMPARE
+ + ext/SDBM_File/sdbm/Makefile.PL ext/SDBM_File/sdbm/README
+ + ext/SDBM_File/sdbm/README.too ext/SDBM_File/sdbm/biblio
+ + ext/SDBM_File/sdbm/dba.c ext/SDBM_File/sdbm/dbd.c
+ + ext/SDBM_File/sdbm/dbe.1 ext/SDBM_File/sdbm/dbe.c
+ + ext/SDBM_File/sdbm/dbm.c ext/SDBM_File/sdbm/dbm.h
+ + ext/SDBM_File/sdbm/dbu.c ext/SDBM_File/sdbm/grind
+ + ext/SDBM_File/sdbm/hash.c ext/SDBM_File/sdbm/linux.patches
+ + ext/SDBM_File/sdbm/makefile.sdbm ext/SDBM_File/sdbm/pair.c
+ + ext/SDBM_File/sdbm/pair.h ext/SDBM_File/sdbm/readme.ms
+ + ext/SDBM_File/sdbm/readme.ps ext/SDBM_File/sdbm/sdbm.3
+ + ext/SDBM_File/sdbm/sdbm.c ext/SDBM_File/sdbm/sdbm.h
+ + ext/SDBM_File/sdbm/tune.h ext/SDBM_File/sdbm/util.c
+ + ext/SDBM_File/typemap ext/Safe/Makefile.PL ext/Safe/Safe.pm
+ + ext/Safe/Safe.xs ext/Socket/Makefile.PL ext/Socket/Socket.pm
+ + ext/Socket/Socket.xs ext/util/extliblist ext/util/make_ext
+ + ext/util/mkbootstrap form.h global.sym globals.c gv.c gv.h
+ + h2pl/README h2pl/cbreak.pl h2pl/cbreak2.pl h2pl/eg/sizeof.ph
+ + h2pl/eg/sys/errno.pl h2pl/eg/sys/ioctl.pl h2pl/eg/sysexits.pl
+ + h2pl/getioctlsizes h2pl/mksizes h2pl/mkvars h2pl/tcbreak
+ + h2pl/tcbreak2 handy.h hints/3b1.sh hints/3b1cc
+ + hints/README.hints hints/aix.sh hints/altos486.sh
+ + hints/apollo.sh hints/aux.sh hints/bsdos.sh hints/convexos.sh
+ + hints/cxux.sh hints/dec_osf.sh hints/dgux.sh hints/dnix.sh
+ + hints/dynix.sh hints/dynixptx.sh hints/epix.sh hints/esix4.sh
+ + hints/fps.sh hints/freebsd.sh hints/genix.sh
+ + hints/greenhills.sh hints/hpux.sh hints/i386.sh
+ + hints/irix_4.sh hints/irix_5.sh hints/irix_6.sh
+ + hints/irix_6_2.sh hints/isc.sh hints/isc_2.sh hints/linux.sh
+ + hints/machten.sh hints/machten_2.sh hints/mips.sh hints/mpc.sh
+ + hints/mpeix.sh hints/ncr_tower.sh hints/netbsd.sh
+ + hints/next_3.sh hints/next_3_0.sh hints/opus.sh hints/os2.sh
+ + hints/powerux.sh hints/sco.sh hints/sco_2_3_0.sh
+ + hints/sco_2_3_1.sh hints/sco_2_3_2.sh hints/sco_2_3_3.sh
+ + hints/sco_2_3_4.sh hints/solaris_2.sh hints/stellar.sh
+ + hints/sunos_4_0.sh hints/sunos_4_1.sh hints/svr4.sh
+ + hints/ti1500.sh hints/titanos.sh hints/ultrix_4.sh
+ + hints/unicos.sh hints/unisysdynix.sh hints/utekv.sh
+ + hints/uts.sh hv.c hv.h installman installperl interp.sym
+ + keywords.h keywords.pl lib/AnyDBM_File.pm lib/AutoLoader.pm
+ + lib/AutoSplit.pm lib/Benchmark.pm lib/Carp.pm lib/Cwd.pm
+ + lib/Devel/SelfStubber.pm lib/DirHandle.pm lib/English.pm
+ + lib/Env.pm lib/Exporter.pm lib/ExtUtils/Install.pm
+ + lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_OS2.pm
+ + lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_VMS.pm
+ + lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Manifest.pm
+ + lib/ExtUtils/Mkbootstrap.pm lib/ExtUtils/Mksymlists.pm
+ + lib/ExtUtils/testlib.pm lib/ExtUtils/typemap
+ + lib/ExtUtils/xsubpp lib/File/Basename.pm lib/File/CheckTree.pm
+ + lib/File/Copy.pm lib/File/Find.pm lib/File/Path.pm
+ + lib/FileCache.pm lib/Getopt/Long.pm lib/Getopt/Std.pm
+ + lib/I18N/Collate.pm lib/IPC/Open2.pm lib/IPC/Open3.pm
+ + lib/Math/BigFloat.pm lib/Math/BigInt.pm lib/Math/Complex.pm
+ + lib/Net/Ping.pm lib/Pod/Functions.pm lib/Pod/Text.pm
+ + lib/Search/Dict.pm lib/SelectSaver.pm lib/SelfLoader.pm
+ + lib/Shell.pm lib/Symbol.pm lib/Sys/Hostname.pm
+ + lib/Sys/Syslog.pm lib/Term/Cap.pm lib/Term/Complete.pm
+ + lib/Term/ReadLine.pm lib/Test/Harness.pm lib/Text/Abbrev.pm
+ + lib/Text/ParseWords.pm lib/Text/Soundex.pm lib/Text/Tabs.pm
+ + lib/Text/Wrap.pm lib/Tie/Hash.pm lib/Tie/Scalar.pm
+ + lib/Tie/SubstrHash.pm lib/Time/Local.pm lib/abbrev.pl
+ + lib/assert.pl lib/bigfloat.pl lib/bigint.pl lib/bigrat.pl
+ + lib/cacheout.pl lib/chat2.inter lib/chat2.pl lib/complete.pl
+ + lib/ctime.pl lib/diagnostics.pm lib/dotsh.pl lib/dumpvar.pl
+ + lib/exceptions.pl lib/fastcwd.pl lib/find.pl lib/finddepth.pl
+ + lib/flush.pl lib/ftp.pl lib/getcwd.pl lib/getopt.pl
+ + lib/getopts.pl lib/hostname.pl lib/importenv.pl lib/integer.pm
+ + lib/less.pm lib/lib.pm lib/look.pl lib/newgetopt.pl
+ + lib/open2.pl lib/open3.pl lib/overload.pm lib/perl5db.pl
+ + lib/pwd.pl lib/shellwords.pl lib/sigtrap.pm lib/splain
+ + lib/stat.pl lib/strict.pm lib/subs.pm lib/syslog.pl
+ + lib/tainted.pl lib/termcap.pl lib/timelocal.pl lib/validate.pl
+ + lib/vars.pm makeaperl.SH makedepend.SH makedir.SH malloc.c
+ + mg.c mg.h minimod.pl miniperlmain.c mv-if-diff myconfig op.c
+ + op.h opcode.h opcode.pl os2/Makefile.SHs os2/POSIX.mkfifo
+ + os2/README os2/README.old os2/diff.configure os2/diff.db_file
+ + os2/notes os2/os2.c os2/os2ish.h os2/perl2cmd.pl patchlevel.h
+ + perl.c perl.h perl_exp.SH perlsh perly.c perly.c.diff
+ + perly.fixer perly.h perly.y pod/Makefile pod/buildtoc
+ + pod/perl.pod pod/perlbook.pod pod/perlbot.pod pod/perlcall.pod
+ + pod/perldata.pod pod/perldebug.pod pod/perldiag.pod
+ + pod/perldsc.pod pod/perlembed.pod pod/perlform.pod
+ + pod/perlfunc.pod pod/perlguts.pod pod/perlipc.pod
+ + pod/perllol.pod pod/perlmod.pod pod/perlobj.pod pod/perlop.pod
+ + pod/perlovl.pod pod/perlpod.pod pod/perlre.pod pod/perlref.pod
+ + pod/perlrun.pod pod/perlsec.pod pod/perlstyle.pod
+ + pod/perlsub.pod pod/perlsyn.pod pod/perltie.pod
+ + pod/perltoc.pod pod/perltrap.pod pod/perlvar.pod
+ + pod/perlxs.pod pod/perlxstut.pod pod/pod2html.PL
+ + pod/pod2latex.PL pod/pod2man.PL pod/pod2text.PL pod/roffitall
+ + pod/splitman pod/splitpod pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c
+ + proto.h regcomp.c regcomp.h regexec.c regexp.h run.c scope.c
+ + scope.h sv.c sv.h t/README t/TEST t/base/cond.t t/base/if.t
+ + t/base/lex.t t/base/pat.t t/base/term.t t/cmd/elsif.t
+ + t/cmd/for.t t/cmd/mod.t t/cmd/subval.t t/cmd/switch.t
+ + t/cmd/while.t t/comp/cmdopt.t t/comp/cpp.aux t/comp/cpp.t
+ + t/comp/decl.t t/comp/multiline.t t/comp/package.t
+ + t/comp/script.t t/comp/term.t t/harness t/io/argv.t t/io/dup.t
+ + t/io/fs.t t/io/inplace.t t/io/pipe.t t/io/print.t t/io/tell.t
+ + t/lib/anydbm.t t/lib/bigint.t t/lib/bigintpm.t
+ + t/lib/db-btree.t t/lib/db-hash.t t/lib/db-recno.t
+ + t/lib/dirhand.t t/lib/english.t t/lib/filehand.t t/lib/gdbm.t
+ + t/lib/ndbm.t t/lib/odbm.t t/lib/posix.t t/lib/safe.t
+ + t/lib/sdbm.t t/lib/socket.t t/lib/soundex.t t/op/append.t
+ + t/op/array.t t/op/auto.t t/op/chop.t t/op/cond.t t/op/delete.t
+ + t/op/do.t t/op/each.t t/op/eval.t t/op/exec.t t/op/exp.t
+ + t/op/flip.t t/op/fork.t t/op/glob.t t/op/goto.t t/op/groups.t
+ + t/op/index.t t/op/int.t t/op/join.t t/op/list.t t/op/local.t
+ + t/op/magic.t t/op/misc.t t/op/mkdir.t t/op/my.t t/op/oct.t
+ + t/op/ord.t t/op/overload.t t/op/pack.t t/op/pat.t t/op/push.t
+ + t/op/quotemeta.t t/op/rand.t t/op/range.t t/op/re_tests
+ + t/op/read.t t/op/readdir.t t/op/ref.t t/op/regexp.t
+ + t/op/repeat.t t/op/sleep.t t/op/sort.t t/op/split.t
+ + t/op/sprintf.t t/op/stat.t t/op/study.t t/op/subst.t
+ + t/op/substr.t t/op/time.t t/op/undef.t t/op/unshift.t
+ + t/op/vec.t t/op/write.t t/re_tests taint.c toke.c unixish.h
+ + util.c util.h utils/Makefile utils/c2ph.PL utils/h2ph.PL
+ + utils/h2xs.PL utils/perlbug.PL utils/perldoc.PL utils/pl2pm.PL
+ + vms/Makefile vms/config.vms vms/descrip.mms
+ + vms/ext/Filespec.pm vms/ext/Stdio/0README.txt
+ + vms/ext/Stdio/Makefile.PL vms/ext/Stdio/Stdio.pm
+ + vms/ext/Stdio/Stdio.xs vms/ext/Stdio/test.pl vms/fndvers.com
+ + vms/gen_shrfls.pl vms/genconfig.pl vms/genopt.com
+ + vms/make_command.com vms/mms2make.pl vms/myconfig.com
+ + vms/perlvms.pod vms/perly_c.vms vms/perly_h.vms
+ + vms/sockadapt.c vms/sockadapt.h vms/test.com vms/vms.c
+ + vms/vms_yfix.pl vms/vmsish.h vms/writemain.pl writemain.SH
+ + x2p/EXTERN.h x2p/INTERN.h x2p/Makefile.SH x2p/a2p.c x2p/a2p.h
+ + x2p/a2p.man x2p/a2p.y x2p/a2py.c x2p/cflags.SH
+ + x2p/find2perl.PL x2p/handy.h x2p/hash.c x2p/hash.h x2p/s2p.PL
+ + x2p/s2p.man x2p/str.c x2p/str.h x2p/util.c x2p/util.h
+ + x2p/walk.c
diff --git a/gnu/usr.bin/perl/Configure b/gnu/usr.bin/perl/Configure
index b32c5102afb..5bcdbdaa5c4 100644
--- a/gnu/usr.bin/perl/Configure
+++ b/gnu/usr.bin/perl/Configure
@@ -14,13 +14,14 @@
# (Note: this Configure script was generated automatically. Rather than
# working with this copy of Configure, you may wish to get metaconfig.
# The dist-3.0 package (which contains metaconfig) was posted in
-# comp.sources.misc so you may fetch it yourself from your nearest
-# archive site. Check with Archie if you don't know where that can be.)
+# comp.sources.misc and is available on CPAN under authors/id/RAM so
+# you may fetch it yourself from your nearest archive site.)
#
-# $Id: Head.U,v 3.0.1.8 1995/07/25 13:40:02 ram Exp $
+# $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
#
-# Generated on Sat Feb 1 00:26:40 EST 1997 [metaconfig 3.0 PL60]
+# Generated on Tue Jul 7 10:10:21 EDT 1998 [metaconfig 3.0 PL70]
+# (with additional metaconfig patches by jhi@iki.fi)
cat >/tmp/c1$$ <<EOF
ARGGGHHHH!!!!!
@@ -55,13 +56,17 @@ case "$0" in
;;
esac
-: Proper PATH separator
+: Proper separator for the PATH environment variable
p_=:
: On OS/2 this directory should exist if this is not floppy only system :-]
-if test -d c:/. -a -n "$OS2_SHELL"; then
- p_=\;
- PATH=`cmd /c "echo %PATH%" | tr '\\\\' / `
- OS2_SHELL=`cmd /c "echo %OS2_SHELL%" | tr '\\\\' / | tr '[A-Z]' '[a-z]'`
+if test -d c:/. ; then
+ if test -n "$OS2_SHELL"; then
+ p_=\;
+ PATH=`cmd /c "echo %PATH%" | tr '\\\\' / `
+ OS2_SHELL=`cmd /c "echo %OS2_SHELL%" | tr '\\\\' / | tr '[A-Z]' '[a-z]'`
+ elif test -n "$DJGPP"; then
+ p_=\;
+ fi
fi
: Proper PATH setting
@@ -85,55 +90,65 @@ done
PATH=.$p_$PATH
export PATH
-: This should not matter in scripts, but apparently it does, sometimes
-case "$CDPATH" in
-'') ;;
-*) CDPATH='' ;;
-esac
-
-: Sanity checks
-# WRONG: This makes it impossible to compile perl non-interactively
-#if test ! -t 0; then
-# echo "Say 'sh $me', not 'sh <$me'"
-# exit 1
-#fi
-
-: Test and see if we are running under ksh, either blatantly or in disguise.
+: shall we be using ksh?
+inksh=''
+needksh=''
+avoidksh=''
+newsh=/bin/ksh
+changesh=''
if (PATH=.; alias -x) >/dev/null 2>&1; then
- : running under ksh. Is this a good thing?
- if test -d /usr/lpp -a -f /usr/bin/bsh -a -f /usr/bin/uname ; then
- if test X`/usr/bin/uname -v` = X4 ; then
- : on AIX 4, /bin/sh is really ksh, and it causes us problems.
- : Avoid it
- cat <<'EOM'
-(Feeding myself to /usr/bin/bsh to avoid AIX 4's /bin/sh.)
-EOM
- unset ENV
- exec /usr/bin/bsh $0 "$@"
+ inksh=true
+fi
+if test -f /hp-ux -a -f /bin/ksh; then
+ needksh='to avoid sh bug in "here document" expansion'
+fi
+if test -d /usr/lpp -a -f /usr/bin/bsh -a -f /usr/bin/uname; then
+ if test X`/usr/bin/uname -v` = X4; then
+ avoidksh="to avoid AIX 4's /bin/sh"
+ newsh=/usr/bin/bsh
fi
- else
- if test ! -f /hp-ux ; then
- : Warn them if they use ksh on other systems
+fi
+case "$inksh/$needksh" in
+/[a-z]*)
+ ENV=''
+ changesh=true
+ reason="$needksh"
+ ;;
+esac
+case "$inksh/$avoidksh" in
+true/[a-z]*)
+ changesh=true
+ reason="$avoidksh"
+ ;;
+esac
+case "$inksh/$needksh-$avoidksh-" in
+true/--)
cat <<EOM
(I see you are using the Korn shell. Some ksh's blow up on $me,
-especially on older exotic systems. If yours does, try the Bourne
-shell instead.)
+mainly on older exotic systems. If yours does, try the Bourne shell instead.)
EOM
- unset ENV
- fi
- fi
-else
- : Not running under ksh. Maybe we should be?
- : On HP-UX, large Configure scripts may exercise a bug in /bin/sh
- if test -f /hp-ux -a -f /bin/ksh; then
- cat <<'EOM'
-(Feeding myself to ksh to avoid nasty sh bug in "here document" expansion.)
-EOM
- unset ENV
- exec /bin/ksh $0 "$@"
- fi
-fi
+ ;;
+esac
+case "$changesh" in
+true)
+ echo "(Feeding myself to $newsh $reason.)"
+ case "$0" in
+ Configure|*/Configure) exec $newsh $0 "$@";;
+ *) exec $newsh Configure "$@";;
+ esac
+ ;;
+esac
+: if needed set CDPATH to a harmless value that is not chatty
+: avoid bash 2.02 problems with empty CDPATH.
+case "$CDPATH" in
+'') ;;
+*) case "$SHELL" in
+ *bash*) CDPATH='.' ;;
+ *) CDPATH='' ;;
+ esac
+ ;;
+esac
: Configure runs within the UU subdirectory
test -d UU || mkdir UU
cd UU && rm -f ./*
@@ -141,6 +156,7 @@ cd UU && rm -f ./*
dynamic_ext=''
extensions=''
known_extensions=''
+nonxs_ext=''
static_ext=''
useopcode=''
useposix=''
@@ -149,6 +165,8 @@ d_eunice=''
d_xenix=''
eunicefix=''
Mcc=''
+ar=''
+full_ar=''
awk=''
bash=''
bison=''
@@ -170,7 +188,6 @@ emacs=''
expr=''
find=''
flex=''
-gcc=''
grep=''
gzip=''
inews=''
@@ -184,9 +201,11 @@ lpr=''
ls=''
mail=''
mailx=''
+make=''
mkdir=''
more=''
mv=''
+nm=''
nroff=''
perl=''
pg=''
@@ -204,6 +223,7 @@ submit=''
tail=''
tar=''
tbl=''
+tee=''
test=''
touch=''
tr=''
@@ -230,7 +250,9 @@ RCSfile=''
Revision=''
Source=''
State=''
-ar=''
+_a=''
+_exe=''
+_o=''
archobjs=''
exe_ext=''
firstmakefile=''
@@ -239,6 +261,7 @@ obj_ext=''
path_sep=''
afs=''
alignbytes=''
+ansi2knr=''
archlib=''
archlibexp=''
d_archlib=''
@@ -249,8 +272,6 @@ baserev=''
bin=''
binexp=''
installbin=''
-bincompat3=''
-d_bincompat3=''
byteorder=''
cc=''
gccversion=''
@@ -297,6 +318,10 @@ d_dlsymun=''
d_dosuid=''
d_suidsafe=''
d_dup2=''
+d_endhent=''
+d_endnent=''
+d_endpent=''
+d_endsent=''
d_fchmod=''
d_fchown=''
d_fcntl=''
@@ -308,31 +333,58 @@ d_flexfnam=''
d_flock=''
d_fork=''
d_fsetpos=''
+i_sysmount=''
+d_fstatfs=''
+d_statfsflags=''
+i_sysstatvfs=''
+d_fstatvfs=''
+i_mntent=''
+d_getmntent=''
+d_hasmntopt=''
d_ftime=''
d_gettimeod=''
d_Gconvert=''
d_getgrps=''
-d_setgrps=''
+d_gethbyaddr=''
+d_gethbyname=''
d_gethent=''
aphostname=''
d_gethname=''
d_phostname=''
d_uname=''
+d_gethostprotos=''
d_getlogin=''
+d_getnbyaddr=''
+d_getnbyname=''
+d_getnent=''
+d_getnetprotos=''
+d_getpent=''
d_getpgid=''
d_getpgrp2=''
d_bsdgetpgrp=''
d_getpgrp=''
d_getppid=''
d_getprior=''
+d_getpbyname=''
+d_getpbynumber=''
+d_getprotoprotos=''
+d_getsent=''
+d_getservprotos=''
+d_getsbyname=''
+d_getsbyport=''
d_gnulibc=''
d_htonl=''
d_inetaton=''
d_isascii=''
d_killpg=''
+d_lchown=''
d_link=''
d_locconv=''
d_lockf=''
+d_longdbl=''
+longdblsize=''
+d_longlong=''
+longlongsize=''
d_lstat=''
d_mblen=''
d_mbstowcs=''
@@ -357,6 +409,11 @@ d_pause=''
d_pipe=''
d_poll=''
d_portable=''
+d_pthread_yield=''
+d_sched_yield=''
+d_pthreads_created_joinable=''
+i_pthread=''
+i_machcthreads=''
d_readdir=''
d_rewinddir=''
d_seekdir=''
@@ -374,11 +431,14 @@ d_semget=''
d_semop=''
d_setegid=''
d_seteuid=''
+d_setgrps=''
+d_sethent=''
d_setlinebuf=''
d_setlocale=''
+d_setnent=''
+d_setpent=''
d_setpgid=''
d_setpgrp2=''
-d_bsdpgrp=''
d_bsdsetpgrp=''
d_setpgrp=''
d_setprior=''
@@ -388,7 +448,9 @@ d_setresuid=''
d_setreuid=''
d_setrgid=''
d_setruid=''
+d_setsent=''
d_setsid=''
+d_setvbuf=''
d_sfio=''
usesfio=''
d_shm=''
@@ -413,6 +475,7 @@ d_stdstdio=''
stdio_base=''
stdio_bufsiz=''
stdio_cnt=''
+stdio_filbuf=''
stdio_ptr=''
d_index=''
d_strchr=''
@@ -439,6 +502,9 @@ d_times=''
d_truncate=''
d_tzname=''
d_umask=''
+d_semctl_semid_ds=''
+d_semctl_semun=''
+d_union_semun=''
d_vfork=''
usevfork=''
d_voidsig=''
@@ -457,6 +523,8 @@ dlsrc=''
ld=''
lddlflags=''
usedl=''
+ebcdic=''
+doublesize=''
fpostype=''
gidtype=''
groupstype=''
@@ -464,6 +532,7 @@ h_fcntl=''
h_sysfile=''
db_hashtype=''
db_prefixtype=''
+i_arpainet=''
i_db=''
i_dbm=''
i_rpcsvcdbm=''
@@ -475,6 +544,10 @@ i_dlfcn=''
i_fcntl=''
i_float=''
i_gdbm=''
+d_grpasswd=''
+d_setgrent=''
+d_getgrent=''
+d_endgrent=''
i_grp=''
i_limits=''
i_locale=''
@@ -482,6 +555,7 @@ i_malloc=''
i_math=''
i_memory=''
i_ndbm=''
+i_netdb=''
i_neterrno=''
i_niin=''
i_sysin=''
@@ -490,7 +564,12 @@ d_pwchange=''
d_pwclass=''
d_pwcomment=''
d_pwexpire=''
+d_pwgecos=''
+d_pwpasswd=''
d_pwquota=''
+d_setpwent=''
+d_getpwent=''
+d_endpwent=''
i_pwd=''
i_sfio=''
i_stddef=''
@@ -539,10 +618,10 @@ libpth=''
loclibpth=''
plibpth=''
xlibpth=''
+ignore_versioned_solibs=''
libs=''
lns=''
lseektype=''
-make=''
make_set_make=''
d_mymalloc=''
freetype=''
@@ -574,35 +653,43 @@ d_eofnblk=''
eagain=''
o_nonblock=''
rd_nodata=''
+netdb_hlen_type=''
+netdb_host_type=''
+netdb_name_type=''
+netdb_net_type=''
groupcat=''
hostcat=''
passcat=''
-d_oldarchlib=''
-oldarchlib=''
-oldarchlibexp=''
orderlib=''
ranlib=''
package=''
spackage=''
pager=''
+apiversion=''
patchlevel=''
subversion=''
+version=''
perladmin=''
perlpath=''
+pidtype=''
prefix=''
prefixexp=''
installprivlib=''
privlib=''
privlibexp=''
prototype=''
+ptrsize=''
randbits=''
installscript=''
scriptdir=''
scriptdirexp=''
+selectminbits=''
selecttype=''
sh=''
sig_name=''
+sig_name_init=''
sig_num=''
+sig_num_init=''
installsitearch=''
sitearch=''
sitearchexp=''
@@ -614,17 +701,21 @@ so=''
sharpbang=''
shsharp=''
spitshell=''
+src=''
ssizetype=''
startperl=''
startsh=''
stdchar=''
sysman=''
+trnl=''
uidtype=''
nm_opt=''
nm_so_opt=''
runnm=''
usenm=''
useperlio=''
+d_oldpthreads=''
+usethreads=''
incpath=''
mips=''
mips_type=''
@@ -638,6 +729,12 @@ undef='undef'
smallmach='pdp11 i8086 z8000 i80286 iAPX286'
rmlist=''
+installusrbinperl=''
+
+ccsymbols=''
+cppsymbols=''
+cppccsymbols=''
+
: We must find out about Eunice early
eunicefix=':'
if test -f /etc/unixtovms; then
@@ -658,7 +755,7 @@ al="$al PWB R3000 RES RISC6000 RT Sun386i SVR3 SVR4"
al="$al SYSTYPE_BSD SYSTYPE_SVR4 SYSTYPE_SYSV Tek4132 Tek4300"
al="$al UMAXV USGr4 USGr4_2 UTEK UTS UTek UnicomPBB UnicomPBD Utek"
al="$al VMS Xenix286"
-al="$al _AIX _AIX32 _AIX370 _AM29000 _COFF _CRAY _CX_UX _EPI"
+al="$al _AIX _AIX32 _AIX370 _AIX41 _AM29000 _COFF _CRAY _CX_UX _EPI _POWER"
al="$al _IBMESA _IBMR2 _M88K _M88KBCS_TARGET"
al="$al _MIPSEB _MIPSEL _M_COFF _M_I86 _M_I86SM _M_SYS3"
al="$al _M_SYS5 _M_SYSIII _M_SYSV _M_UNIX _M_XENIX _NLS _PGC_ _R3000"
@@ -712,26 +809,7 @@ al="$al tower32_800 tower32_850 tss u370 u3b u3b2 u3b20 u3b200"
al="$al u3b20d u3b5 ultrix unix unixpc unos vax venix vms"
al="$al xenix z8000"
-groupstype=''
i_whoami=''
-: default library list
-libswanted=''
-: set useposix=false in your hint file to disable the POSIX extension.
-useposix=true
-: set useopcode=false in your hint file to disable the Opcode extension.
-useopcode=true
-: Define several unixisms. These can be used in hint files.
-exe_ext=''
-: Extra object files, if any, needed on this platform.
-archobjs=''
-: Possible local include directories to search.
-: Set locincpth to "" in a hint file to defeat local include searches.
-locincpth="/usr/local/include /opt/local/include /usr/gnu/include"
-locincpth="$locincpth /opt/gnu/include /usr/GNU/include /opt/GNU/include"
-:
-: no include file wanted by default
-inclwanted=''
-
: change the next line if compiling for Xenix/286 on Xenix/386
xlibpth='/usr/lib/386 /lib/386'
@@ -740,7 +818,7 @@ loclibpth="/usr/local/lib /opt/local/lib /usr/gnu/lib"
loclibpth="$loclibpth /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib"
: general looking path for locating libraries
-glibpth="/shlib /usr/shlib /usr/lib/pa1.1 /usr/lib/large"
+glibpth="/shlib /usr/shlib /lib/pa1.1 /usr/lib/large"
glibpth="$glibpth /lib /usr/lib $xlibpth"
glibpth="$glibpth /lib/large /usr/lib/small /lib/small"
glibpth="$glibpth /usr/ccs/lib /usr/ucblib /usr/local/lib"
@@ -750,11 +828,34 @@ glibpth="$glibpth /usr/ccs/lib /usr/ucblib /usr/local/lib"
: machines, like the mips. Usually, it should be empty.
plibpth=''
+: default library list
+libswanted=''
+: some systems want only to use the non-versioned libso:s
+ignore_versioned_solibs=''
+: Possible local include directories to search.
+: Set locincpth to "" in a hint file to defeat local include searches.
+locincpth="/usr/local/include /opt/local/include /usr/gnu/include"
+locincpth="$locincpth /opt/gnu/include /usr/GNU/include /opt/GNU/include"
+:
+: no include file wanted by default
+inclwanted=''
+
+: Trailing extension. Override this in a hint file, if needed.
+_exe=''
+: Extra object files, if any, needed on this platform.
+archobjs=''
+groupstype=''
: full support for void wanted by default
defvoidused=15
+: set useposix=false in your hint file to disable the POSIX extension.
+useposix=true
+: set useopcode=false in your hint file to disable the Opcode extension.
+useopcode=true
+: set usethreads on the Configure command line to enable threads.
: List of libraries we want.
-libswanted='sfio net socket inet nsl nm ndbm gdbm dbm db malloc dl'
+: If anyone needs -lnet, put it in a hint file.
+libswanted='sfio socket inet nsl nm ndbm gdbm dbm db malloc dl'
libswanted="$libswanted dld ld sun m c cposix posix ndir dir crypt"
libswanted="$libswanted ucb bsd BSD PW x"
: We probably want to search /usr/shlib before most other libraries.
@@ -767,8 +868,6 @@ usevfork=false
: Find the basic shell for Bourne shell scripts
case "$sh" in
'')
- : SYSTYPE is for some older MIPS systems.
- : I do not know if it is still needed.
case "$SYSTYPE" in
*bsd*|sys5*) xxx="/$SYSTYPE/bin/sh";;
*) xxx='/bin/sh';;
@@ -786,11 +885,9 @@ case "$sh" in
for xxx in $try; do
if test -f "$xxx"; then
sh="$xxx";
- echo "Your Bourne shell appears to be in $sh."
break
elif test -f "$xxx.exe"; then
sh="$xxx";
- echo "Hmm. Your Bourne shell appears to be in $sh."
break
fi
done
@@ -801,9 +898,9 @@ esac
case "$sh" in
'') cat <<EOM >&2
$me: Fatal Error: I can't find a Bourne Shell anywhere.
+
Usually it's in /bin/sh. How did you even get this far?
-Please contact me (Chip Salzenberg) at chip@perl.com and
-we'll try to straigten this all out.
+Please contact perlbug@perl.com and we'll try to straighten this all out.
EOM
exit 1
;;
@@ -813,7 +910,6 @@ esac
if `$sh -c '#' >/dev/null 2>&1`; then
shsharp=true
spitshell=cat
- echo " "
xcat=/bin/cat
test -f $xcat || xcat=/usr/bin/cat
echo "#!$xcat" >try
@@ -830,12 +926,11 @@ if `$sh -c '#' >/dev/null 2>&1`; then
if test -s today; then
sharpbang='#! '
else
- echo "Okay, let's see if #! works on this system..."
- echo "It's just a comment."
sharpbang=': use '
fi
fi
else
+ echo " "
echo "Your $sh doesn't grok # comments--I will strip them later on."
shsharp=false
cd ..
@@ -865,59 +960,27 @@ $eunicefix try
if ./try; then
: echo "Yup, it does."
else
- echo "Hmm. '$startsh' didn't work."
- echo "You may have to fix up the shell scripts to make sure sh runs them."
+ echo "Hmm... '$startsh' does not guarantee sh startup..."
+ echo "You may have to fix up the shell scripts to make sure $sh runs them."
fi
rm -f try
-: script used to extract .SH files with variable substitutions
-cat >extract <<EOS
-$startsh
-EOS
-cat >>extract <<'EOS'
-CONFIG=true
-echo "Doing variable substitutions on .SH files..."
-if test -f MANIFEST; then
- shlist=`awk '{print $1}' <MANIFEST | grep '\.SH'`
- : Pick up possible extension manifests.
- for dir in ext/* ; do
- if test -f $dir/MANIFEST; then
- xxx=`awk '{print $1}' < $dir/MANIFEST |
- sed -n "/\.SH$/ s@^@$dir/@p"`
- shlist="$shlist $xxx"
- fi
- done
- set x $shlist
-else
- echo "(Looking for .SH files under the current directory.)"
- set x `find . -name "*.SH" -print`
-fi
-shift
-case $# in
-0) set x *.SH; shift;;
-esac
-if test ! -f $1; then
- shift
-fi
-for file in $*; do
- case "$file" in
- */*)
- dir=`expr X$file : 'X\(.*\)/'`
- file=`expr X$file : 'X.*/\(.*\)'`
- (cd $dir && . ./$file)
- ;;
- *)
- . ./$file
- ;;
- esac
+
+: Save command line options in file UU/cmdline.opt for later use in
+: generating config.sh.
+cat > cmdline.opt <<EOSH
+# Configure command line arguments.
+config_arg0='$0'
+config_args='$*'
+config_argc=$#
+EOSH
+argn=1
+for arg in "$@"; do
+ cat >>cmdline.opt <<EOSH
+config_arg$argn='$arg'
+EOSH
+ argn=`expr $argn + 1`
done
-if test -f config_h.SH; then
- if test ! -f config.h; then
- : oops, they left it out of MANIFEST, probably, so do it anyway.
- . ./config_h.SH
- fi
-fi
-EOS
: produce awk script to parse command line options
cat >options.awk <<'EOF'
@@ -982,12 +1045,12 @@ silent=''
extractsh=''
override=''
knowitall=''
-
rm -f optdef.sh
cat >optdef.sh <<EOS
$startsh
EOS
+
: option parsing
while test $# -gt 0; do
case "$1" in
@@ -1006,11 +1069,11 @@ while test $# -gt 0; do
shift;;
-h) shift; error=true;;
-r) shift; reuseval=true;;
- -s) shift; silent=true;;
+ -s) shift; silent=true; realsilent=true;;
-E) shift; alldone=exit;;
-K) shift; knowitall=true;;
-O) shift; override=true;;
- -S) shift; extractsh=true;;
+ -S) shift; silent=true; extractsh=true;;
-D)
shift
case "$1" in
@@ -1036,7 +1099,7 @@ while test $# -gt 0; do
esac
shift
;;
- -V) echo "$me generated by metaconfig 3.0 PL60." >&2
+ -V) echo "$me generated by metaconfig 3.0 PL70." >&2
exit 0;;
--) break;;
-*) echo "$me: unknown option $1" >&2; shift; error=true;;
@@ -1071,6 +1134,17 @@ EOM
;;
esac
+: Sanity checks
+case "$fastread$alldone" in
+yescont|yesexit) ;;
+*)
+ if test ! -t 0; then
+ echo "Say 'sh Configure', not 'sh <Configure'"
+ exit 1
+ fi
+ ;;
+esac
+
exec 4>&1
case "$silent" in
true) exec 1>/dev/null;;
@@ -1080,26 +1154,6 @@ esac
touch optdef.sh
. ./optdef.sh
-case "$extractsh" in
-true)
- case "$config_sh" in
- '') config_sh='config.sh'; config='./config.sh';;
- /*) config="$config_sh";;
- *) config="./$config_sh";;
- esac
- echo " "
- echo "Fetching answers from $config_sh..."
- cd ..
- . $config
- test "$override" && . ./optdef.sh
- echo " "
- . ./UU/extract
- rm -rf UU
- echo "Done."
- exit 0
- ;;
-esac
-
: set package name
package=perl5
first=`echo $package | sed -e 's/^\(.\).*/\1/'`
@@ -1109,13 +1163,6 @@ ABYZ) spackage=`echo $first | tr '[:lower:]' '[:upper:]'`$last;;
*) spackage=`echo $first | tr '[a-z]' '[A-Z]'`$last;;
esac
-: Eunice requires " " instead of "", can you believe it
-echo " "
-: Here we go...
-echo "Beginning of configuration questions for $package."
-
-trap 'echo " "; test -d ../UU && rm -rf X $rmlist; exit 1' 1 2 3 15
-
: Some greps do not return status, grrr.
echo "grimblepritz" >grimble
if grep blurfldyick grimble >/dev/null 2>&1 ; then
@@ -1137,6 +1184,152 @@ EOSS
chmod +x contains
esac
+: Find the path to the source tree
+case "$src" in
+'') case "$0" in
+ */*) src=`echo $0 | sed -e 's%/[^/][^/]*$%%'`;;
+ *) src='.';;
+ esac;;
+esac
+case "$src" in
+'') src=/
+ rsrc=/
+ ;;
+/*) rsrc="$src";;
+*) rsrc="../$src";;
+esac
+if test -f $rsrc/Configure && \
+ $contains "^package=$package$" $rsrc/Configure >/dev/null 2>&1
+then
+ : found it, so we are ok.
+else
+ rsrc=''
+ for src in . .. ../.. ../../.. ../../../..; do
+ if test -f ../$src/Configure && \
+ $contains "^package=$package$" ../$src/Configure >/dev/null 2>&1
+ then
+ rsrc=../$src
+ break
+ fi
+ done
+fi
+case "$rsrc" in
+'')
+ cat <<EOM >&4
+
+Sorry, I can't seem to locate the source dir for $package. Please start
+Configure with an explicit path -- i.e. /some/path/Configure.
+
+EOM
+ exit 1
+ ;;
+../.) rsrc='..';;
+*)
+ echo " "
+ echo "Sources for $package found in \"$src\"." >&4
+ ;;
+esac
+
+: script used to extract .SH files with variable substitutions
+cat >extract <<'EOS'
+CONFIG=true
+echo "Doing variable substitutions on .SH files..."
+if test -f $src/MANIFEST; then
+ set x `awk '{print $1}' <$src/MANIFEST | grep '\.SH$'`
+else
+ echo "(Looking for .SH files under the source directory.)"
+ set x `(cd $src; find . -name "*.SH" -print)`
+fi
+shift
+case $# in
+0) set x `(cd $src; echo *.SH)`; shift;;
+esac
+if test ! -f $src/$1; then
+ shift
+fi
+mkdir_p='
+name=$1;
+create="";
+while test $name; do
+ if test ! -d "$name"; then
+ create="$name $create";
+ name=`echo $name | sed -e "s|^[^/]*$||"`;
+ name=`echo $name | sed -e "s|\(.*\)/.*|\1|"`;
+ else
+ name="";
+ fi;
+done;
+for file in $create; do
+ mkdir $file;
+done
+'
+for file in $*; do
+ case "$src" in
+ ".")
+ case "$file" in
+ */*)
+ dir=`expr X$file : 'X\(.*\)/'`
+ file=`expr X$file : 'X.*/\(.*\)'`
+ (cd $dir && . ./$file)
+ ;;
+ *)
+ . ./$file
+ ;;
+ esac
+ ;;
+ *)
+ case "$file" in
+ */*)
+ dir=`expr X$file : 'X\(.*\)/'`
+ file=`expr X$file : 'X.*/\(.*\)'`
+ (set x $dir; shift; eval $mkdir_p)
+ sh <$src/$dir/$file
+ ;;
+ *)
+ sh <$src/$file
+ ;;
+ esac
+ ;;
+ esac
+done
+if test -f $src/config_h.SH; then
+ if test ! -f config.h; then
+ : oops, they left it out of MANIFEST, probably, so do it anyway.
+ . $src/config_h.SH
+ fi
+fi
+EOS
+
+: extract files and exit if asked to do so
+case "$extractsh" in
+true)
+ case "$realsilent" in
+ true) ;;
+ *) exec 1>&4;;
+ esac
+ case "$config_sh" in
+ '') config_sh='config.sh';;
+ esac
+ echo " "
+ echo "Fetching answers from $config_sh..."
+ cd ..
+ . $config_sh
+ test "$override" && . ./optdef.sh
+ echo " "
+ . UU/extract
+ rm -rf UU
+ echo "Done."
+ exit 0
+ ;;
+esac
+
+: Eunice requires " " instead of "", can you believe it
+echo " "
+: Here we go...
+echo "Beginning of configuration questions for $package."
+
+trap 'echo " "; test -d ../UU && rm -rf X $rmlist; exit 1' 1 2 3 15
+
: first determine how to suppress newline on echo command
echo " "
echo "Checking echo to see how to suppress newlines..."
@@ -1158,12 +1351,13 @@ rm -f .echotmp
: Now test for existence of everything in MANIFEST
echo " "
-if test -f ../MANIFEST; then
+if test -f $rsrc/MANIFEST; then
echo "First let's make sure your kit is complete. Checking..." >&4
- awk '$1 !~ /PACK[A-Z]+/ {print $1}' ../MANIFEST | split -50
+ awk '$1 !~ /PACK[A-Z]+/ {print $1}' $rsrc/MANIFEST | split -50
rm -f missing
+ tmppwd=`pwd`
for filelist in x??; do
- (cd ..; ls `cat UU/$filelist` >/dev/null 2>>UU/missing)
+ (cd $rsrc; ls `cat $tmppwd/$filelist` >/dev/null 2>>$tmppwd/missing)
done
if test -s missing; then
cat missing >&4
@@ -1174,7 +1368,7 @@ THIS PACKAGE SEEMS TO BE INCOMPLETE.
You have the option of continuing the configuration process, despite the
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 (chip@perl.com).
+and then contact perlbug@perl.com.
EOM
echo $n "Continue? [n] $c" >&4
@@ -1190,13 +1384,37 @@ EOM
;;
esac
else
- echo "Looks good..." >&4
+ echo "Looks good..."
fi
else
echo "There is no MANIFEST file. I hope your kit is complete !"
fi
rm -f missing x??
+echo " "
+: Find the appropriate value for a newline for tr
+if test -n "$DJGPP"; then
+ trnl='\012'
+fi
+if test X"$trnl" = X; then
+ case "`echo foo|tr '\n' x 2>/dev/null`" in
+ foox) trnl='\n' ;;
+ esac
+fi
+if test X"$trnl" = X; then
+ case "`echo foo|tr '\012' x 2>/dev/null`" in
+ foox) trnl='\012' ;;
+ esac
+fi
+if test X"$trnl" = X; then
+ cat <<EOM >&2
+
+$me: Fatal Error: cannot figure out how to translate newlines with 'tr'.
+
+EOM
+ exit 1
+fi
+
: compute the number of columns on the terminal for proper question formatting
case "$COLUMNS" in
'') COLUMNS='80';;
@@ -1243,8 +1461,20 @@ while expr "X\$ans" : "X!" >/dev/null; do
read answ
set x \$xxxm
shift
- aok=''; eval ans="\\"\$answ\\"" && aok=y
+ aok=''; eval "ans=\\"\$answ\\"" && aok=y
case "\$answ" in
+ "!")
+ sh 1>&4
+ echo " "
+ $myecho
+ ;;
+ !*)
+ set x \`expr "X\$ans" : "X!\(.*\)\$"\`
+ shift
+ sh 1>&4 -c "\$*"
+ echo " "
+ $myecho
+ ;;
"\$ans")
case "\$ans" in
\\&*)
@@ -1262,25 +1492,13 @@ while expr "X\$ans" : "X!" >/dev/null; do
$myecho
ans=!
;;
- "!")
- sh 1>&4
- echo " "
- $myecho
- ;;
- !*)
- set x \`expr "X\$ans" : "X!\(.*\)\$"\`
- shift
- sh 1>&4 -c "\$*"
- echo " "
- $myecho
- ;;
esac;;
*)
case "\$aok" in
y)
echo "*** Substitution done -- please confirm."
xxxm="\$ans"
- ans=\`echo $n "\$ans$c" | tr '\012' ' '\`
+ ans=\`echo $n "\$ans$c" | tr '$trnl' ' '\`
xxxm="\$ans"
ans=!
;;
@@ -1308,7 +1526,7 @@ EOSC
test -d ../.config || mkdir ../.config
cat >../.config/README <<EOF
This directory created by Configure to save information that should
-persist across sessions.
+persist across sessions for $package.
You may safely delete it if you wish.
EOF
@@ -1317,8 +1535,8 @@ EOF
needman=true
firsttime=true
user=`(logname) 2>/dev/null`
-case "$user" in "")
- user=`whoami 2>&1` ;;
+case "$user" in
+'') user=`whoami 2>&1`;;
esac
if $contains "^$user\$" ../.config/instruct >/dev/null 2>&1; then
firsttime=false
@@ -1333,7 +1551,7 @@ if $contains "^$user\$" ../.config/instruct >/dev/null 2>&1; then
fi
if $needman; then
cat <<EOH
-
+
This installation shell script will examine your system and ask you questions
to determine how the perl5 package should be installed. If you get
stuck on a question, you may use a ! shell escape to start a subshell or
@@ -1365,7 +1583,7 @@ If you are in a hurry, you may run 'Configure -d'. This will bypass nearly all
the questions and use the computed defaults (or the previous answers if there
was already a config.sh file). Type 'Configure -h' for a list of options.
You may also start interactively and then answer '& -d' at any prompt to turn
-on the non-interactive behavior for the remainder of the execution.
+on the non-interactive behaviour for the remainder of the execution.
EOH
. ./myread
@@ -1375,7 +1593,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 (chip@perl.com) know how I blew it.
+have, let perlbug@perl.com know how I blew it.
This installation script affects things in two ways:
@@ -1424,8 +1642,12 @@ for dir in \$*; do
echo \$thisthing
exit 0
elif test -f \$dir/\$thing.exe; then
- : on Eunice apparently
- echo \$dir/\$thing
+ if test -n "$DJGPP"; then
+ echo \$dir/\$thing.exe
+ else
+ : on Eunice apparently
+ echo \$dir/\$thing
+ fi
exit 0
fi
;;
@@ -1446,6 +1668,7 @@ expr
find
grep
ls
+make
mkdir
rm
sed
@@ -1456,6 +1679,7 @@ uniq
"
trylist="
Mcc
+ar
byacc
cpp
csh
@@ -1466,10 +1690,12 @@ less
line
ln
more
+nm
nroff
perl
pg
sendmail
+tee
test
uname
zip
@@ -1477,7 +1703,19 @@ zip
pth=`echo $PATH | sed -e "s/$p_/ /g"`
pth="$pth /lib /usr/lib"
for file in $loclist; do
- xxx=`./loc $file $file $pth`
+ eval xxx=\$$file
+ case "$xxx" in
+ /*|?:[\\/]*)
+ if test -f "$xxx"; then
+ : ok
+ else
+ echo "WARNING: no $xxx -- ignoring your setting for $file." >&4
+ xxx=`./loc $file $file $pth`
+ fi
+ ;;
+ '') xxx=`./loc $file $file $pth`;;
+ *) xxx=`./loc $xxx $xxx $pth`;;
+ esac
eval $file=$xxx
eval _$file=$xxx
case "$xxx" in
@@ -1498,7 +1736,19 @@ echo " "
echo "Don't worry if any of the following aren't found..."
say=offhand
for file in $trylist; do
- xxx=`./loc $file $file $pth`
+ eval xxx=\$$file
+ case "$xxx" in
+ /*|?:[\\/]*)
+ if test -f "$xxx"; then
+ : ok
+ else
+ echo "WARNING: no $xxx -- ignoring your setting for $file." >&4
+ xxx=`./loc $file $file $pth`
+ fi
+ ;;
+ '') xxx=`./loc $file $file $pth`;;
+ *) xxx=`./loc $xxx $xxx $pth`;;
+ esac
eval $file=$xxx
eval _$file=$xxx
case "$xxx" in
@@ -1583,17 +1833,59 @@ $rm -f blurfl sym
: see whether [:lower:] and [:upper:] are supported character classes
echo " "
-up='[A-Z]'
-low='[a-z]'
case "`echo AbyZ | $tr '[:lower:]' '[:upper:]' 2>/dev/null`" in
ABYZ)
echo "Good, your tr supports [:lower:] and [:upper:] to convert case." >&4
up='[:upper:]'
low='[:lower:]'
;;
+*) # There is a discontinuity in EBCDIC between 'I' and 'J'
+ # (0xc9 and 0xd1), therefore that is a nice testing point.
+ if test "X$up" = X -o "X$low" = X; then
+ case "`echo IJ | $tr '[I-J]' '[i-j]' 2>/dev/null`" in
+ ij) up='[A-Z]'
+ low='[a-z]'
+ ;;
+ esac
+ fi
+ if test "X$up" = X -o "X$low" = X; then
+ case "`echo IJ | $tr I-J i-j 2>/dev/null`" in
+ ij) up='A-Z'
+ low='a-z'
+ ;;
+ esac
+ fi
+ if test "X$up" = X -o "X$low" = X; then
+ case "`echo IJ | od -x 2>/dev/null`" in
+ *C9D1*|*c9d1*)
+ echo "Hey, this might be EBCDIC." >&4
+ if test "X$up" = X -o "X$low" = X; then
+ case "`echo IJ | $tr '[A-IJ-RS-Z]' '[a-ij-rs-z]' 2>/dev/null`" in
+ ij) up='[A-IJ-RS-Z]'
+ low='[a-ij-rs-z]'
+ ;;
+ esac
+ fi
+ if test "X$up" = X -o "X$low" = X; then
+ case "`echo IJ | $tr A-IJ-RS-Z a-ij-rs-z 2>/dev/null`" in
+ ij) up='A-IJ-RS-Z'
+ low='a-ij-rs-z'
+ ;;
+ esac
+ fi
+ ;;
+ esac
+ fi
+esac
+case "`echo IJ | $tr \"$up\" \"$low\" 2>/dev/null`" in
+ij)
+ echo "Using $up and $low to convert case." >&4
+ ;;
*)
- echo "Your tr only supports [a-z] and [A-Z] to convert case." >&4
- ;;
+ echo "I don't know how to translate letters from upper to lower case." >&4
+ echo "Your tr is not acting any way I know of." >&4
+ exit 1
+ ;;
esac
: set up the translation script tr, must be called with ./tr of course
cat >tr <<EOSC
@@ -1611,8 +1903,10 @@ $eunicefix tr
case "$config_sh" in
'')
myuname=`( ($uname -a) 2>/dev/null || hostname) 2>&1`
+# tr '[A-Z]' '[a-z]' would not work in EBCDIC
+# because the A-Z/a-z are not consecutive.
myuname=`echo $myuname | $sed -e 's/^[^=]*=//' -e 's/\///g' | \
- ./tr '[A-Z]' '[a-z]' | tr '\012' ' '`
+ ./tr '[A-Z]' '[a-z]' | $tr $trnl ' '`
newmyuname="$myuname"
dflt=n
case "$knowitall" in
@@ -1659,13 +1953,14 @@ fi
if test ! -f config.sh; then
$cat <<EOM
-First time through, eh? I have some defaults handy for the following systems:
+First time through, eh? I have some defaults handy for some systems
+that need some extra help getting the Configure answers right:
EOM
- cd hints; ls -C *.sh | $sed 's/\.sh/ /g' >&4
+ (cd $src/hints; ls -C *.sh) | $sed 's/\.sh/ /g' >&4
dflt=''
: Half the following guesses are probably wrong... If you have better
- : tests or hints, please send them to chip@perl.com
+ : tests or hints, please send them to perlbug@perl.com
: The metaconfig authors would also appreciate a copy...
$test -f /irix && osname=irix
$test -f /xenix && osname=sco_xenix
@@ -1680,18 +1975,24 @@ EOM
$test -d /usr/apollo/bin && osname=apollo
$test -f /etc/saf/_sactab && osname=svr4
$test -d /usr/include/minix && osname=minix
- if $test -d /MachTen; then
- osname=machten
+ if $test -d /MachTen -o -d /MachTen_Folder; then
+ osname=machten
if $test -x /sbin/version; then
- osvers=`/sbin/version | $awk '{print $2}' |
+ osvers=`/sbin/version | $awk '{print $2}' |
$sed -e 's/[A-Za-z]$//'`
elif $test -x /usr/etc/version; then
- osvers=`/usr/etc/version | $awk '{print $2}' |
+ osvers=`/usr/etc/version | $awk '{print $2}' |
$sed -e 's/[A-Za-z]$//'`
else
osvers="$2.$3"
fi
fi
+ $test -f /sys/posix.dll &&
+ $test -f /usr/bin/what &&
+ set X `/usr/bin/what /sys/posix.dll` &&
+ $test "$3" = UWIN &&
+ osname=uwin &&
+ osvers="$5"
if $test -f $uname; then
set X $myuname
shift
@@ -1706,7 +2007,11 @@ EOM
[23]100) osname=mips ;;
next*) osname=next ;;
i386*)
- if $test -f /etc/kconfig; then
+ tmp=`/bin/uname -X 2>/dev/null|awk '/3\.2v[45]/{ print $(NF) }'`
+ if $test "$tmp" != "" -a "$3" = "3.2" -a -f '/etc/systemid'; then
+ osname='sco'
+ osvers=$tmp
+ elif $test -f /etc/kconfig; then
osname=isc
if test "$lns" = "ln -s"; then
osvers=4
@@ -1716,6 +2021,13 @@ EOM
osvers=2
fi
fi
+ unset tmp
+ ;;
+ pc*)
+ if test -n "$DJGPP"; then
+ osname=dos
+ osvers=djgpp
+ fi
;;
esac
@@ -1743,18 +2055,13 @@ EOM
osvers="$3"
;;
dynixptx*) osname=dynixptx
- osvers="$3"
+ osvers=`echo "$4" | $sed 's/^v//'`
;;
freebsd) osname=freebsd
osvers="$3" ;;
genix) osname=genix ;;
hp*) osname=hpux
- case "$3" in
- *.08.*) osvers=9 ;;
- *.09.*) osvers=9 ;;
- *.10.*) osvers=10 ;;
- *) osvers="$3" ;;
- esac
+ osvers=`echo "$3" | $sed 's,.*\.\([0-9]*\.[0-9]*\),\1,'`
;;
irix*) osname=irix
case "$3" in
@@ -1768,7 +2075,9 @@ EOM
*) osvers="$3" ;;
esac
;;
- netbsd*) osname=netbsd
+ MiNT) osname=mint
+ ;;
+ netbsd*) osname=netbsd
osvers="$3"
;;
news-os) osvers="$3"
@@ -1813,7 +2122,7 @@ EOM
osf1|mls+) case "$5" in
alpha)
osname=dec_osf
- osvers=`echo "$3" | sed 's/^[vt]//'`
+ osvers=`echo "$3" | sed 's/^[xvt]//'`
;;
hp*) osname=hp_osf1 ;;
mips) osname=mips_osf1 ;;
@@ -1854,11 +2163,11 @@ EOM
*) if test -f /etc/systemid; then
osname=sco
set `echo $3 | $sed 's/\./ /g'` $4
- if $test -f sco_$1_$2_$3.sh; then
+ if $test -f $src/hints/sco_$1_$2_$3.sh; then
osvers=$1.$2.$3
- elif $test -f sco_$1_$2.sh; then
+ elif $test -f $src/hints/sco_$1_$2.sh; then
osvers=$1.$2
- elif $test -f sco_$1.sh; then
+ elif $test -f $src/hints/sco_$1.sh; then
osvers=$1
fi
else
@@ -1881,12 +2190,12 @@ EOM
;;
esac
else
- if test -f /vmunix -a -f newsos4.sh; then
- (what /vmunix | ../UU/tr '[A-Z]' '[a-z]') > ../UU/kernel.what 2>&1
- if $contains news-os ../UU/kernel.what >/dev/null 2>&1; then
- osname=newsos4
+ if test -f /vmunix -a -f $src/hints/news_os.sh; then
+ (what /vmunix | UU/tr '[A-Z]' '[a-z]') > UU/kernel.what 2>&1
+ if $contains news-os UU/kernel.what >/dev/null 2>&1; then
+ osname=news_os
fi
- $rm -f ../UU/kernel.what
+ $rm -f UU/kernel.what
elif test -d c:/.; then
set X $myuname
osname=os2
@@ -1909,17 +2218,17 @@ EOM
*) case "$osvers" in
'') dflt=$file
;;
- *) if $test -f $file.sh ; then
+ *) if $test -f $src/hints/$file.sh ; then
dflt=$file
- elif $test -f $xfile.sh ; then
+ elif $test -f $src/hints/$xfile.sh ; then
dflt=$xfile
- elif $test -f $xxfile.sh ; then
+ elif $test -f $src/hints/$xxfile.sh ; then
dflt=$xxfile
- elif $test -f $xxxfile.sh ; then
+ elif $test -f $src/hints/$xxxfile.sh ; then
dflt=$xxxfile
- elif $test -f $xxxxfile.sh ; then
+ elif $test -f $src/hints/$xxxxfile.sh ; then
dflt=$xxxxfile
- elif $test -f "${osname}.sh" ; then
+ elif $test -f "$src/hints/${osname}.sh" ; then
dflt="${osname}"
else
dflt=none
@@ -1928,25 +2237,46 @@ EOM
esac
;;
esac
+ if $test -f Policy.sh ; then
+ case "$dflt" in
+ *Policy*) ;;
+ none) dflt="Policy" ;;
+ *) dflt="Policy $dflt" ;;
+ esac
+ fi
;;
*)
dflt=`echo $hintfile | $sed 's/\.sh$//'`
;;
esac
+ if $test -f Policy.sh ; then
+ $cat <<EOM
+
+There's also a Policy hint file available, which should make the
+site-specific (policy) questions easier to answer.
+EOM
+
+ fi
+
$cat <<EOM
You may give one or more space-separated answers, or "none" if appropriate.
-If your OS version has no hints, DO NOT give a wrong version -- say "none".
+A well-behaved OS will have no hints, so answering "none" or just "Policy"
+is a good thing. DO NOT give a wrong version.
EOM
+
rp="Which of these apply, if any?"
- . ../UU/myread
+ . UU/myread
tans=$ans
for file in $tans; do
- if $test -f $file.sh; then
- . ./$file.sh
- $cat $file.sh >> ../UU/config.sh
+ if $test X$file = XPolicy -a -f Policy.sh; then
+ . Policy.sh
+ $cat Policy.sh >> UU/config.sh
+ elif $test -f $src/hints/$file.sh; then
+ . $src/hints/$file.sh
+ $cat $src/hints/$file.sh >> UU/config.sh
elif $test X$tans = X -o X$tans = Xnone ; then
: nothing
else
@@ -1954,11 +2284,11 @@ EOM
echo "$file.sh does not exist"
dflt=$file
rp="hint to use instead?"
- . ../UU/myread
+ . UU/myread
for file in $ans; do
- if $test -f "$file.sh"; then
- . ./$file.sh
- $cat $file.sh >> ../UU/config.sh
+ if $test -f "$src/hints/$file.sh"; then
+ . $src/hints/$file.sh
+ $cat $src/hints/$file.sh >> UU/config.sh
elif $test X$ans = X -o X$ans = Xnone ; then
: nothing
else
@@ -1970,13 +2300,11 @@ EOM
hint=recommended
: Remember our hint file for later.
- if $test -f "$file.sh" ; then
+ if $test -f "$src/hints/$file.sh" ; then
hintfile="$file"
else
hintfile=''
fi
-
- cd ..
fi
cd UU
;;
@@ -2049,18 +2377,99 @@ none) osvers='' ;;
*) osvers="$ans" ;;
esac
-
-
: who configured the system
cf_time=`LC_ALL=C; export LC_ALL; $date 2>&1`
cf_by=`(logname) 2>/dev/null`
-case "$cf_by" in "")
+case "$cf_by" in
+"")
cf_by=`(whoami) 2>/dev/null`
- case "$cf_by" in "")
- cf_by=unknown ;;
+ case "$cf_by" in
+ "") cf_by=unknown ;;
esac ;;
esac
+: set up the script used to warn in case of inconsistency
+cat <<EOS >whoa
+$startsh
+EOS
+cat <<'EOSC' >>whoa
+dflt=y
+echo " "
+echo "*** WHOA THERE!!! ***" >&4
+echo " The $hint value for \$$var on this machine was \"$was\"!" >&4
+rp=" Keep the $hint value?"
+. ./myread
+case "$ans" in
+y) td=$was; tu=$was;;
+esac
+EOSC
+
+: function used to set $1 to $val
+setvar='var=$1; eval "was=\$$1"; td=$define; tu=$undef;
+case "$val$was" in
+$define$undef) . ./whoa; eval "$var=\$td";;
+$undef$define) . ./whoa; eval "$var=\$tu";;
+*) eval "$var=$val";;
+esac'
+
+cat <<EOM
+
+Perl can be built to take advantage of threads, on some systems.
+To do so, Configure must be run with -Dusethreads.
+
+Note that threading is a highly experimental feature, and
+some known race conditions still remain. If you choose to try
+it, be very sure to not actually deploy it for production
+purposes. README.threads has more details, and is required
+reading if you enable threads.
+EOM
+case "$usethreads" in
+$define|true|[yY]*) dflt='y';;
+*) dflt='n';;
+esac
+rp='Build a threading Perl?'
+. ./myread
+case "$ans" in
+y|Y) val="$define" ;;
+*) val="$undef" ;;
+esac
+set usethreads
+eval $setvar
+
+case "$d_oldpthreads" in
+'') : Configure tests would be welcome here. For now, assume undef.
+ val="$undef" ;;
+*) val="$d_oldpthreads" ;;
+esac
+set d_oldpthreads
+eval $setvar
+
+
+case "$usethreads" in
+"$define"|true|[yY]*)
+: Look for a hint-file generated 'call-back-unit'. If the
+: user has specified that a threading perl is to be built,
+: we may need to set or change some other defaults.
+ if $test -f usethreads.cbu; then
+ . ./usethreads.cbu
+ fi
+ case "$osname" in
+ aix|dec_osf|dos_djgpp|freebsd|hpux|irix|linux|next|openbsd|os2|solaris|vmesa)
+ # Known thread-capable platforms.
+ ;;
+ *)
+ cat >&4 <<EOM
+$osname is not known to support threads.
+Please let perlbug@perl.com know how to do that.
+
+Cannot continue, aborting.
+EOM
+ exit 1
+ ;;
+ esac # $osname
+ ;;
+esac # $usethreads
+
: determine the architecture name
echo " "
if xxx=`./loc arch blurfl $pth`; $test -f "$xxx"; then
@@ -2089,9 +2498,20 @@ case "$archname" in
esac
rp='What is your architecture name'
. ./myread
-archname="$ans"
+case "$usethreads" in
+$define) echo "Threads selected." >&4
+ case "$ans" in
+ *-thread) echo "...and architecture name already ends in -thread." >&4
+ archname="$ans"
+ ;;
+ *) archname="$ans-thread"
+ echo "...setting architecture name to $archname." >&4
+ ;;
+ esac
+ ;;
+*) archname="$ans" ;;
+esac
myarchname="$tarch"
-
: is AFS running?
echo " "
case "$afs" in
@@ -2104,7 +2524,7 @@ $undef|false) afs=false ;;
fi
;;
esac
-if test $afs = "true"; then
+if $afs; then
echo "AFS may be running... I'll be extra cautious then..." >&4
else
echo "AFS does not seem to be running..." >&4
@@ -2173,7 +2593,7 @@ orig_dflt="$dflt"
case "$fn" in
*\(*)
- expr $fn : '.*(\(.*\)).*' | tr ',' '\012' >getfile.ok
+ expr $fn : '.*(\(.*\)).*' | tr ',' $trnl >getfile.ok
fn=`echo $fn | sed 's/(.*)//'`
;;
esac
@@ -2426,12 +2846,53 @@ prefixit='case "$3" in
esac;;
esac'
+: set the base revision
+baserev=5.0
+
+: get the patchlevel
+echo " "
+echo "Getting the current patchlevel..." >&4
+if $test -r $rsrc/patchlevel.h;then
+ patchlevel=`awk '/define[ ]+PATCHLEVEL/ {print $3}' $rsrc/patchlevel.h`
+ subversion=`awk '/define[ ]+SUBVERSION/ {print $3}' $rsrc/patchlevel.h`
+else
+ patchlevel=0
+ subversion=0
+fi
+$echo $n "(You have $package" $c
+case "$package" in
+"*$baserev") ;;
+*) $echo $n " $baserev" $c ;;
+esac
+$echo $n " patchlevel $patchlevel" $c
+test 0 -eq "$subversion" || $echo $n " subversion $subversion" $c
+echo ".)"
+
+if test 0 -eq "$subversion"; then
+ version=`LC_ALL=C; export LC_ALL; \
+ echo $baserev $patchlevel | \
+ $awk '{ printf "%.3f\n", $1 + $2/1000.0 }'`
+else
+ version=`LC_ALL=C; export LC_ALL; \
+ echo $baserev $patchlevel $subversion | \
+ $awk '{ printf "%.5f\n", $1 + $2/1000.0 + $3/100000.0 }'`
+fi
+: Figure out perl API version. Perhaps this should be in patchlevel.h
+if test "$subversion" -lt 50; then
+ apiversion=`LC_ALL=C; export LC_ALL; \
+ echo $baserev $patchlevel | \
+ $awk '{ printf "%.3f\n", $1 + $2/1000.0 }'`
+else
+ apiversion="$version"
+fi
+
: 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.
+: Usual default is /usr/local/lib/perl5/$version.
+: Also allow things like /opt/perl/lib/$version, since
+: /opt/perl/lib/perl5... would be redundant.
case "$prefix" in
-*perl*) set dflt privlib lib ;;
-*) set dflt privlib lib/$package ;;
+*perl*) set dflt privlib lib/$version ;;
+*) set dflt privlib lib/$package/$version ;;
esac
eval $prefixit
$cat <<EOM
@@ -2468,28 +2929,6 @@ else
installprivlib="$privlibexp"
fi
-: set the base revision
-baserev=5.0
-
-: get the patchlevel
-echo " "
-echo "Getting the current patchlevel..." >&4
-if $test -r ../patchlevel.h;then
- patchlevel=`awk '/PATCHLEVEL/ {print $3}' ../patchlevel.h`
- subversion=`awk '/SUBVERSION/ {print $3}' ../patchlevel.h`
-else
- patchlevel=0
- subversion=0
-fi
-$echo $n "(You have $package" $c
-case "$package" in
-"*$baserev") ;;
-*) $echo $n " $baserev" $c ;;
-esac
-$echo $n " patchlevel $patchlevel" $c
-test 0 -eq "$subversion" || $echo $n " subversion $subversion" $c
-echo ".)"
-
: set the prefixup variable, to restore leading tilda escape
prefixup='case "$prefixexp" in
"$prefix") ;;
@@ -2499,28 +2938,15 @@ esac'
: determine where public architecture dependent libraries go
set archlib archlib
eval $prefixit
+: privlib default is /usr/local/lib/$package/$version
+: archlib default is /usr/local/lib/$package/$version/$archname
+: privlib may have an optional trailing /share.
+tdflt=`echo $privlib | $sed 's,/share$,,'`
+tdflt=$tdflt/$archname
case "$archlib" in
-'')
- case "$privlib" in
- '') dflt=`./loc . "." $prefixexp/lib /usr/local/lib /usr/lib /lib`
- set dflt
- eval $prefixup
+'') dflt=$tdflt
;;
- *) if test 0 -eq "$subversion"; then
- version=`LC_ALL=C; export LC_ALL; \
- echo $baserev $patchlevel | \
- $awk '{ printf "%.3f\n", $1 + $2/1000.0 }'`
- else
- version=`LC_ALL=C; export LC_ALL; \
- echo $baserev $patchlevel $subversion | \
- $awk '{ printf "%.5f\n", $1 + $2/1000.0 + $3/100000.0 }'`
- fi
- dflt="$privlib/$archname/$version"
- ;;
- esac
- ;;
-*)
- dflt="$archlib"
+*) dflt="$archlib"
;;
esac
cat <<EOM
@@ -2563,57 +2989,6 @@ else
d_archlib="$define"
fi
-: set up the script used to warn in case of inconsistency
-cat <<EOS >whoa
-$startsh
-EOS
-cat <<'EOSC' >>whoa
-dflt=y
-echo " "
-echo "*** WHOA THERE!!! ***" >&4
-echo " The $hint value for \$$var on this machine was \"$was\"!" >&4
-rp=" Keep the $hint value?"
-. ./myread
-case "$ans" in
-y) td=$was; tu=$was;;
-esac
-EOSC
-
-: function used to set $1 to $val
-setvar='var=$1; eval "was=\$$1"; td=$define; tu=$undef;
-case "$val$was" in
-$define$undef) . ./whoa; eval "$var=\$td";;
-$undef$define) . ./whoa; eval "$var=\$tu";;
-*) eval "$var=$val";;
-esac'
-
-$cat <<EOM
-
-Perl 5.004 can be compiled for binary compatibility with 5.003.
-If you decide to do so, you will be able to continue using any
-extensions that were compiled for Perl 5.003. However, binary
-compatibility forces Perl to expose some of its internal symbols
-in the same way that 5.003 did. So you may have symbol conflicts
-if you embed a binary-compatible Perl in other programs.
-
-EOM
-case "$d_bincompat3" in
-"$undef") dflt=n ;;
-*) dflt=y ;;
-esac
-rp='Binary compatibility with Perl 5.003?'
-. ./myread
-case "$ans" in
-y*) val="$define" ;;
-*) val="$undef" ;;
-esac
-set d_bincompat3
-eval $setvar
-case "$d_bincompat3" in
-"$define") bincompat3=y ;;
-*) bincompat3=n ;;
-esac
-
: make some quick guesses about what we are up against
echo " "
$echo $n "Hmm... $c"
@@ -2816,170 +3191,6 @@ esac
set d_dosuid
eval $setvar
-: determine where site specific libraries go.
-set sitelib sitelib
-eval $prefixit
-case "$sitelib" in
-'') dflt="$privlib/site_perl" ;;
-*) dflt="$sitelib" ;;
-esac
-$cat <<EOM
-
-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.
-
-EOM
-fn=d~+
-rp='Pathname for the site-specific library files?'
-. ./getfile
-if $test "X$sitelibexp" != "X$ansexp"; then
- installsitelib=''
-fi
-sitelib="$ans"
-sitelibexp="$ansexp"
-if $afs; then
- $cat <<EOM
-
-Since you are running AFS, I need to distinguish the directory in
-which site-specific files reside from the directory in which they are
-installed (and from which they are presumably copied to the former
-directory by occult means).
-
-EOM
- case "$installsitelib" in
- '') dflt=`echo $sitelibexp | sed 's#^/afs/#/afs/.#'`;;
- *) dflt="$installsitelib";;
- esac
- fn=de~
- rp='Where will site-specific files be installed?'
- . ./getfile
- installsitelib="$ans"
-else
- installsitelib="$sitelibexp"
-fi
-
-: determine where site specific architecture-dependent libraries go.
-xxx=`echo $sitelib/$archname | sed 's!^$prefix!!'`
-: xxx is usuually lib/site_perl/archname.
-set sitearch sitearch none
-eval $prefixit
-case "$sitearch" in
-'') dflt="$sitelib/$archname" ;;
-*) dflt="$sitearch" ;;
-esac
-$cat <<EOM
-
-The installation process will also create a directory for
-architecture-dependent site-specific extensions and modules.
-
-EOM
-fn=nd~+
-rp='Pathname for the site-specific architecture-dependent library files?'
-. ./getfile
-if $test "X$sitearchexp" != "X$ansexp"; then
- installsitearch=''
-fi
-sitearch="$ans"
-sitearchexp="$ansexp"
-if $afs; then
- $cat <<EOM
-
-Since you are running AFS, I need to distinguish the directory in
-which site-specific architecture-dependent library files reside from
-the directory in which they are installed (and from which they are
-presumably copied to the former directory by occult means).
-
-EOM
- case "$installsitearch" in
- '') dflt=`echo $sitearchexp | sed 's#^/afs/#/afs/.#'`;;
- *) dflt="$installsitearch";;
- esac
- fn=de~
- rp='Where will site-specific architecture-dependent files be installed?'
- . ./getfile
- installsitearch="$ans"
-else
- installsitearch="$sitearchexp"
-fi
-
-: determine where old public architecture dependent libraries might be
-case "$oldarchlib" in
-'') case "$privlib" in
- '') ;;
- *) dflt="$privlib/$archname"
- ;;
- esac
- ;;
-*) dflt="$oldarchlib"
- ;;
-esac
-if $test ! -d "$dflt/auto"; then
- dflt=none
-fi
-cat <<EOM
-
-In 5.001, Perl stored architecture-dependent library files in a directory
-with a name such as $privlib/$archname,
-and this directory contained files from the standard extensions and
-files from any additional extensions you might have added. Starting
-with version 5.002, all the architecture-dependent standard extensions
-will go into a version-specific directory such as
-$archlib,
-while locally-added extensions will go into
-$sitearch.
-
-If you wish Perl to continue to search the old architecture-dependent
-library for your local extensions, give the path to that directory.
-If you do not wish to use your old architecture-dependent library
-files, answer 'none'.
-
-EOM
-fn=dn~
-rp='Directory for your old 5.001 architecture-dependent libraries?'
-. ./getfile
-oldarchlib="$ans"
-oldarchlibexp="$ansexp"
-case "$oldarchlib" in
-''|' ') val="$undef" ;;
-*) val="$define" ;;
-esac
-set d_oldarchlib
-eval $setvar
-
-: determine where public executables go
-echo " "
-set dflt bin bin
-eval $prefixit
-fn=d~
-rp='Pathname where the public executables will reside?'
-. ./getfile
-if $test "X$ansexp" != "X$binexp"; then
- installbin=''
-fi
-bin="$ans"
-binexp="$ansexp"
-if $afs; then
- $cat <<EOM
-
-Since you are running AFS, I need to distinguish the directory in which
-executables reside from the directory in which they are installed (and from
-which they are presumably copied to the former directory by occult means).
-
-EOM
- case "$installbin" in
- '') dflt=`echo $binexp | sed 's#^/afs/#/afs/.#'`;;
- *) dflt="$installbin";;
- esac
- fn=de~
- rp='Where will public executables be installed?'
- . ./getfile
- installbin="$ans"
-else
- installbin="$binexp"
-fi
-
: determine where manual pages are on this system
echo " "
case "$sysman" in
@@ -3002,7 +3213,7 @@ fi
case "$models" in
'')
$cat >pdp11.c <<'EOP'
-main() {
+int main() {
#ifdef pdp11
exit(0);
#else
@@ -3010,7 +3221,7 @@ main() {
#endif
}
EOP
- (cc -o pdp11 pdp11.c) >/dev/null 2>&1
+ ( cc -o pdp11 pdp11.c ) >/dev/null 2>&1
if $test -f pdp11 && ./pdp11 2>/dev/null; then
dflt='unsplit split'
else
@@ -3045,6 +3256,8 @@ put the appropriate flags later when it asks you for other cc and ld flags.
Venix systems may wish to put "none" and let the compiler figure things out.
(In the following question multiple model names should be space separated.)
+The default for most systems is "none".
+
EOM
rp="Which memory models are supported?"
. ./myread
@@ -3140,6 +3353,7 @@ none)
echo "Unrecognized memory models--you may have to edit Makefile.SH" >&4
;;
esac
+$rm -f pdp11.* pdp11
: see if we need a special compiler
echo " "
@@ -3162,8 +3376,9 @@ if ./usg; then
esac;;
*) dflt="$cc";;
esac
- $cat <<'EOM'
-On some systems the default C compiler will not resolve multiple global
+ 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
@@ -3171,7 +3386,9 @@ memory model to use!) If you have the Gnu C compiler, you might wish to use
that instead.
EOM
- rp="What command will force resolution on this system?"
+ ;;
+ esac
+ rp="Use which C compiler?"
. ./myread
cc="$ans"
else
@@ -3183,6 +3400,12 @@ else
. ./myread
cc="$ans"
fi
+: 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
echo " "
echo "Checking for GNU cc in disguise and/or its version number..." >&4
$cat >gccvers.c <<EOM
@@ -3251,13 +3474,13 @@ else
fi
chmod +x mips
$eunicefix mips
-echo " "
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"
@@ -3266,6 +3489,148 @@ y) fn=d/
;;
esac
+: see how we invoke the C preprocessor
+echo " "
+echo "Now, how can we feed standard input to your C preprocessor..." >&4
+cat <<'EOT' >testcpp.c
+#define ABC abc
+#define XYZ xyz
+ABC.XYZ
+EOT
+cd ..
+if test ! -f cppstdin; then
+echo 'cat >.$$.c; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' >cppstdin
+else
+ echo "Keeping your $hint cppstdin wrapper."
+fi
+chmod 755 cppstdin
+wrapper=`pwd`/cppstdin
+ok='false'
+cd UU
+
+if $test "X$cppstdin" != "X" && \
+ $cppstdin $cppminus <testcpp.c >testcpp.out 2>&1 && \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1
+then
+ echo "You used to use $cppstdin $cppminus so we'll use that again."
+ case "$cpprun" in
+ '') echo "But let's see if we can live without a wrapper..." ;;
+ *)
+ if $cpprun $cpplast <testcpp.c >testcpp.out 2>&1 && \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1
+ then
+ echo "(And we'll use $cpprun $cpplast to preprocess directly.)"
+ ok='true'
+ else
+ echo "(However, $cpprun $cpplast does not work, let's see...)"
+ fi
+ ;;
+ esac
+else
+ case "$cppstdin" in
+ '') ;;
+ *)
+ echo "Good old $cppstdin $cppminus does not seem to be of any help..."
+ ;;
+ esac
+fi
+
+if $ok; then
+ : nothing
+elif echo 'Maybe "'"$cc"' -E" will work...'; \
+ $cc -E <testcpp.c >testcpp.out 2>&1; \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+ echo "Yup, it does."
+ x_cpp="$cc -E"
+ x_minus='';
+elif echo 'Nope...maybe "'"$cc"' -E -" will work...'; \
+ $cc -E - <testcpp.c >testcpp.out 2>&1; \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+ echo "Yup, it does."
+ x_cpp="$cc -E"
+ x_minus='-';
+elif echo 'Nope...maybe "'"$cc"' -P" will work...'; \
+ $cc -P <testcpp.c >testcpp.out 2>&1; \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+ echo "Yipee, that works!"
+ x_cpp="$cc -P"
+ x_minus='';
+elif echo 'Nope...maybe "'"$cc"' -P -" will work...'; \
+ $cc -P - <testcpp.c >testcpp.out 2>&1; \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+ echo "At long last!"
+ x_cpp="$cc -P"
+ x_minus='-';
+elif echo 'No such luck, maybe "'$cpp'" will work...'; \
+ $cpp <testcpp.c >testcpp.out 2>&1; \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+ echo "It works!"
+ x_cpp="$cpp"
+ x_minus='';
+elif echo 'Nixed again...maybe "'$cpp' -" will work...'; \
+ $cpp - <testcpp.c >testcpp.out 2>&1; \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+ echo "Hooray, it works! I was beginning to wonder."
+ x_cpp="$cpp"
+ x_minus='-';
+elif echo 'Uh-uh. Time to get fancy. Trying a wrapper...'; \
+ $wrapper <testcpp.c >testcpp.out 2>&1; \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+ x_cpp="$wrapper"
+ x_minus=''
+ echo "Eureka!"
+else
+ dflt=''
+ rp="No dice. I can't find a C preprocessor. Name one:"
+ . ./myread
+ x_cpp="$ans"
+ x_minus=''
+ $x_cpp <testcpp.c >testcpp.out 2>&1
+ if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+ echo "OK, that will do." >&4
+ else
+echo "Sorry, I can't get that to work. Go find one and rerun Configure." >&4
+ exit 1
+ fi
+fi
+
+case "$ok" in
+false)
+ cppstdin="$x_cpp"
+ cppminus="$x_minus"
+ cpprun="$x_cpp"
+ cpplast="$x_minus"
+ set X $x_cpp
+ shift
+ case "$1" in
+ "$cpp")
+ echo "Perhaps can we force $cc -E using a wrapper..."
+ if $wrapper <testcpp.c >testcpp.out 2>&1; \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1
+ then
+ echo "Yup, we can."
+ cppstdin="$wrapper"
+ cppminus='';
+ else
+ echo "Nope, we'll have to live without it..."
+ fi
+ ;;
+ esac
+ case "$cpprun" in
+ "$wrapper")
+ cpprun=''
+ cpplast=''
+ ;;
+ esac
+ ;;
+esac
+
+case "$cppstdin" in
+"$wrapper"|'cppstdin') ;;
+*) $rm -f $wrapper;;
+esac
+$rm -f testcpp.c testcpp.out
+
: Set private lib path
case "$plibpth" in
'') if ./mips; then
@@ -3312,25 +3677,6 @@ none) libpth=' ';;
*) libpth="$ans";;
esac
-: Define several unixisms. Hints files or command line options
-: can be used to override them.
-case "$ar" in
-'') ar='ar';;
-esac
-case "$lib_ext" in
-'') lib_ext='.a';;
-esac
-case "$obj_ext" in
-'') obj_ext='.o';;
-esac
-case "$path_sep" in
-'') path_sep=':';;
-esac
-: Which makefile gets called first. This is used by make depend.
-case "$firstmakefile" in
-'') firstmakefile='makefile';;
-esac
-
: compute shared library extension
case "$so" in
'')
@@ -3353,6 +3699,48 @@ rp='What is the file extension used for shared libraries?'
. ./myread
so="$ans"
+: Define several unixisms.
+: Hints files or command line option can be used to override them.
+: The convoluted testing is in case hints files set either the old
+: or the new name.
+case "$_exe" in
+'') case "$exe_ext" in
+ '') ;;
+ *) _exe="$exe_ext" ;;
+ esac
+ ;;
+esac
+case "$_a" in
+'') case "$lib_ext" in
+ '') _a='.a';;
+ *) _a="$lib_ext" ;;
+ esac
+ ;;
+esac
+case "$_o" in
+'') case "$obj_ext" in
+ '') _o='.o';;
+ *) _o="$obj_ext";;
+ esac
+ ;;
+esac
+case "$p_" in
+'') case "$path_sep" in
+ '') p_=':';;
+ *) p_="$path_sep";;
+ esac
+ ;;
+esac
+exe_ext=$_exe
+lib_ext=$_a
+obj_ext=$_o
+path_sep=$p_
+
+: Which makefile gets called first. This is used by make depend.
+case "$firstmakefile" in
+'') firstmakefile='makefile';;
+esac
+
: Looking for optional libraries
echo " "
echo "Checking for optional libraries..." >&4
@@ -3365,7 +3753,8 @@ case "$libswanted" in
esac
for thislib in $libswanted; do
- if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`; $test -f "$xxx"; then
+ if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`;
+ $test -f "$xxx" -a "X$ignore_versioned_solibs" = "X"; then
echo "Found -l$thislib (shared)."
case " $dflt " in
*"-l$thislib "*);;
@@ -3377,25 +3766,25 @@ for thislib in $libswanted; do
*"-l$thislib "*);;
*) dflt="$dflt -l$thislib";;
esac
- elif xxx=`./loc lib$thislib$lib_ext X $libpth`; $test -f "$xxx"; then
+ elif xxx=`./loc lib$thislib$_a X $libpth`; $test -f "$xxx"; then
echo "Found -l$thislib."
case " $dflt " in
*"-l$thislib "*);;
*) dflt="$dflt -l$thislib";;
esac
- elif xxx=`./loc $thislib$lib_ext X $libpth`; $test -f "$xxx"; then
+ elif xxx=`./loc $thislib$_a X $libpth`; $test -f "$xxx"; then
echo "Found -l$thislib."
case " $dflt " in
*"-l$thislib "*);;
*) dflt="$dflt -l$thislib";;
esac
- elif xxx=`./loc lib${thislib}_s$lib_ext X $libpth`; $test -f "$xxx"; then
+ elif xxx=`./loc lib${thislib}_s$_a X $libpth`; $test -f "$xxx"; then
echo "Found -l${thislib}_s."
case " $dflt " in
*"-l$thislib "*);;
*) dflt="$dflt -l${thislib}_s";;
esac
- elif xxx=`./loc Slib$thislib$lib_ext X $xlibpth`; $test -f "$xxx"; then
+ elif xxx=`./loc Slib$thislib$_a X $xlibpth`; $test -f "$xxx"; then
echo "Found -l$thislib."
case " $dflt " in
*"-l$thislib "*);;
@@ -3437,144 +3826,6 @@ none) libs=' ';;
*) libs="$ans";;
esac
-: see how we invoke the C preprocessor
-echo " "
-echo "Now, how can we feed standard input to your C preprocessor..." >&4
-cat <<'EOT' >testcpp.c
-#define ABC abc
-#define XYZ xyz
-ABC.XYZ
-EOT
-cd ..
-echo 'cat >.$$.c; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' >cppstdin
-chmod 755 cppstdin
-wrapper=`pwd`/cppstdin
-ok='false'
-cd UU
-
-if $test "X$cppstdin" != "X" && \
- $cppstdin $cppminus <testcpp.c >testcpp.out 2>&1 && \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1
-then
- echo "You used to use $cppstdin $cppminus so we'll use that again."
- case "$cpprun" in
- '') echo "But let's see if we can live without a wrapper..." ;;
- *)
- if $cpprun $cpplast <testcpp.c >testcpp.out 2>&1 && \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1
- then
- echo "(And we'll use $cpprun $cpplast to preprocess directly.)"
- ok='true'
- else
- echo "(However, $cpprun $cpplast does not work, let's see...)"
- fi
- ;;
- esac
-else
- case "$cppstdin" in
- '') ;;
- *)
- echo "Good old $cppstdin $cppminus does not seem to be of any help..."
- ;;
- esac
-fi
-
-if $ok; then
- : nothing
-elif echo 'Maybe "'"$cc"' -E" will work...'; \
- $cc -E <testcpp.c >testcpp.out 2>&1; \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
- echo "Yup, it does."
- x_cpp="$cc -E"
- x_minus='';
-elif echo 'Nope...maybe "'"$cc"' -E -" will work...'; \
- $cc -E - <testcpp.c >testcpp.out 2>&1; \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
- echo "Yup, it does."
- x_cpp="$cc -E"
- x_minus='-';
-elif echo 'Nope...maybe "'"$cc"' -P" will work...'; \
- $cc -P <testcpp.c >testcpp.out 2>&1; \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
- echo "Yipee, that works!"
- x_cpp="$cc -P"
- x_minus='';
-elif echo 'Nope...maybe "'"$cc"' -P -" will work...'; \
- $cc -P - <testcpp.c >testcpp.out 2>&1; \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
- echo "At long last!"
- x_cpp="$cc -P"
- x_minus='-';
-elif echo 'No such luck, maybe "'$cpp'" will work...'; \
- $cpp <testcpp.c >testcpp.out 2>&1; \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
- echo "It works!"
- x_cpp="$cpp"
- x_minus='';
-elif echo 'Nixed again...maybe "'$cpp' -" will work...'; \
- $cpp - <testcpp.c >testcpp.out 2>&1; \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
- echo "Hooray, it works! I was beginning to wonder."
- x_cpp="$cpp"
- x_minus='-';
-elif echo 'Uh-uh. Time to get fancy. Trying a wrapper...'; \
- $wrapper <testcpp.c >testcpp.out 2>&1; \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
- x_cpp="$wrapper"
- x_minus=''
- echo "Eureka!"
-else
- dflt=''
- rp="No dice. I can't find a C preprocessor. Name one:"
- . ./myread
- x_cpp="$ans"
- x_minus=''
- $x_cpp <testcpp.c >testcpp.out 2>&1
- if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
- echo "OK, that will do." >&4
- else
-echo "Sorry, I can't get that to work. Go find one and rerun Configure." >&4
- exit 1
- fi
-fi
-
-case "$ok" in
-false)
- cppstdin="$x_cpp"
- cppminus="$x_minus"
- cpprun="$x_cpp"
- cpplast="$x_minus"
- set X $x_cpp
- shift
- case "$1" in
- "$cpp")
- echo "Perhaps can we force $cc -E using a wrapper..."
- if $wrapper <testcpp.c >testcpp.out 2>&1; \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1
- then
- echo "Yup, we can."
- cppstdin="$wrapper"
- cppminus='';
- else
- echo "Nope, we'll have to live without it..."
- fi
- ;;
- esac
- case "$cpprun" in
- "$wrapper")
- cpprun=''
- cpplast=''
- ;;
- esac
- ;;
-esac
-
-case "$cppstdin" in
-"$wrapper") ;;
-*) $rm -f $wrapper;;
-esac
-$rm -f testcpp.c testcpp.out
-
: determine optimize, if desired, or use for debug flag also
case "$optimize" in
' '|$undef) dflt='none';;
@@ -3648,11 +3899,7 @@ if $xxx; then
esac;
fi'
-if ./osf1; then
- set signal.h __LANGUAGE_C__; eval $inctest
-else
- set signal.h LANGUAGE_C; eval $inctest
-fi
+set signal.h LANGUAGE_C; eval $inctest
case "$hint" in
none|recommended) dflt="$ccflags $dflt" ;;
@@ -3668,8 +3915,7 @@ Your C compiler may want other flags. For this question you should include
-I/whatever and -DWHATEVER flags and any other flags used by the C compiler,
but you should NOT include libraries or ld flags like -lwhatever. If you
want $package to honor its debug switch, you should include -DDEBUGGING here.
-Your C compiler might also need additional flags, such as -D_POSIX_SOURCE,
--DHIDEMYMALLOC or -DCRIPPLED_CC.
+Your C compiler might also need additional flags, such as -D_POSIX_SOURCE.
To use no flags, specify the word "none".
@@ -3715,7 +3961,7 @@ EOM
esac
if $cppstdin -DLFRULB=bar $cppflags $ftry $cppminus <cpp.c \
>cpp1.out 2>/dev/null && \
- $cpprun -DLFRULB=bar $ftry $cpplast <cpp.c \
+ $cpprun -DLFRULB=bar $cppflags $ftry $cpplast <cpp.c \
>cpp2.out 2>/dev/null && \
$contains 'foo.*xx.*bar' cpp1.out >/dev/null 2>&1 && \
$contains 'foo.*xx.*bar' cpp2.out >/dev/null 2>&1
@@ -3737,7 +3983,6 @@ EOM
esac
: flags used in final linking phase
-
case "$ldflags" in
'') if ./venix; then
dflt='-i -z'
@@ -3791,11 +4036,22 @@ rmlist="$rmlist pdp11"
: coherency check
echo " "
-echo "Checking your choice of C compiler, libs, and flags for coherency..." >&4
-set X $cc $optimize $ccflags $ldflags -o try try.c $libs
+echo "Checking your choice of C compiler and flags for coherency..." >&4
+$cat > try.c <<'EOF'
+#include <stdio.h>
+int main() { printf("Ok\n"); exit(0); }
+EOF
+set X $cc $optimize $ccflags -o try $ldflags try.c $libs
shift
-$cat >try.msg <<EOM
-I've tried to compile and run a simple program with:
+$cat >try.msg <<'EOM'
+I've tried to compile and run the following simple program:
+
+EOM
+$cat try.c >> try.msg
+
+$cat >> try.msg <<EOM
+
+I used the command:
$*
./try
@@ -3803,22 +4059,35 @@ I've tried to compile and run a simple program with:
and I got the following output:
EOM
-$cat > try.c <<'EOF'
-#include <stdio.h>
-main() { exit(0); }
-EOF
dflt=y
-if sh -c "$cc $optimize $ccflags -o try try.c $ldflags $libs" >>try.msg 2>&1; then
+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
- dflt=n
+ xxx=`./try`
+ case "$xxx" in
+ "Ok") dflt=n ;;
+ *) echo 'The program compiled OK, but produced no output.' >> try.msg
+ case " $libs " in
+ *" -lsfio "*)
+ cat >> try.msg <<'EOQS'
+If $libs contains -lsfio, and sfio is mis-configured, then it
+sometimes (apparently) runs and exits with a 0 status, but with no
+output! It may have to do with sfio's use of _exit vs. exit.
+
+EOQS
+ rp="You have a big problem. Shall I abort Configure"
+ dflt=y
+ ;;
+ esac
+ ;;
+ esac
else
echo "The program compiled OK, but exited with status $?." >>try.msg
- rp="You have a problem. Shall I abort Configure (and explain the problem)"
+ rp="You have a problem. Shall I abort Configure"
dflt=y
fi
else
echo "I can't compile the test program." >>try.msg
- rp="You have a BIG problem. Shall I abort Configure (and explain the problem)"
+ rp="You have a BIG problem. Shall I abort Configure"
dflt=y
fi
case "$dflt" in
@@ -3826,7 +4095,7 @@ y)
$cat try.msg >&4
case "$knowitall" in
'')
- echo "(The supplied flags might be incorrect with this C compiler.)"
+ echo "(The supplied flags or libraries might be incorrect.)"
;;
*) dflt=n;;
esac
@@ -3843,17 +4112,302 @@ n) echo "OK, that should do.";;
esac
$rm -f try try.* core
+: determine filename position in cpp output
+echo " "
+echo "Computing filename position in cpp output for #include directives..." >&4
+echo '#include <stdio.h>' > foo.c
+$cat >fieldn <<EOF
+$startsh
+$cppstdin $cppflags $cppminus <foo.c 2>/dev/null | \
+$grep '^[ ]*#.*stdio\.h' | \
+while read cline; do
+ pos=1
+ set \$cline
+ while $test \$# -gt 0; do
+ if $test -r \`echo \$1 | $tr -d '"'\`; then
+ echo "\$pos"
+ exit 0
+ fi
+ shift
+ pos=\`expr \$pos + 1\`
+ done
+done
+EOF
+chmod +x fieldn
+fieldn=`./fieldn`
+$rm -f foo.c fieldn
+case $fieldn in
+'') pos='???';;
+1) pos=first;;
+2) pos=second;;
+3) pos=third;;
+*) pos="${fieldn}th";;
+esac
+echo "Your cpp writes the filename in the $pos field of the line."
+
+: locate header file
+$cat >findhdr <<EOF
+$startsh
+wanted=\$1
+name=''
+if test -f $usrinc/\$wanted; then
+ echo "$usrinc/\$wanted"
+ exit 0
+fi
+awkprg='{ print \$$fieldn }'
+echo "#include <\$wanted>" > foo\$\$.c
+$cppstdin $cppminus $cppflags < foo\$\$.c 2>/dev/null | \
+$grep "^[ ]*#.*\$wanted" | \
+while read cline; do
+ name=\`echo \$cline | $awk "\$awkprg" | $tr -d '"'\`
+ case "\$name" in
+ */\$wanted) echo "\$name"; exit 0;;
+ *) name='';;
+ esac;
+done;
+$rm -f foo\$\$.c;
+case "\$name" in
+'') exit 1;;
+esac
+EOF
+chmod +x findhdr
+
+: define an alternate in-header-list? function
+inhdr='echo " "; td=$define; tu=$undef; yyy=$@;
+cont=true; xxf="echo \"<\$1> found.\" >&4";
+case $# in 2) xxnf="echo \"<\$1> NOT found.\" >&4";;
+*) xxnf="echo \"<\$1> NOT found, ...\" >&4";;
+esac;
+case $# in 4) instead=instead;; *) instead="at last";; esac;
+while $test "$cont"; do
+ xxx=`./findhdr $1`
+ var=$2; eval "was=\$$2";
+ if $test "$xxx" && $test -r "$xxx";
+ then eval $xxf;
+ eval "case \"\$$var\" in $undef) . ./whoa; esac"; eval "$var=\$td";
+ cont="";
+ else eval $xxnf;
+ eval "case \"\$$var\" in $define) . ./whoa; esac"; eval "$var=\$tu"; fi;
+ set $yyy; shift; shift; yyy=$@;
+ case $# in 0) cont="";;
+ 2) xxf="echo \"but I found <\$1> $instead.\" >&4";
+ xxnf="echo \"and I did not find <\$1> either.\" >&4";;
+ *) xxf="echo \"but I found <\$1\> instead.\" >&4";
+ xxnf="echo \"there is no <\$1>, ...\" >&4";;
+ esac;
+done;
+while $test "$yyy";
+do set $yyy; var=$2; eval "was=\$$2";
+ eval "case \"\$$var\" in $define) . ./whoa; esac"; eval "$var=\$tu";
+ set $yyy; shift; shift; yyy=$@;
+done'
+
+: see if this is a malloc.h system
+set malloc.h i_malloc
+eval $inhdr
+
+: see if stdlib is available
+set stdlib.h i_stdlib
+eval $inhdr
+
+: determine which malloc to compile in
+echo " "
+case "$usemymalloc" in
+''|[yY]*|true|$define) dflt='y' ;;
+*) dflt='n' ;;
+esac
+rp="Do you wish to attempt to use the malloc that comes with $package?"
+. ./myread
+usemymalloc="$ans"
+case "$ans" in
+y*|true)
+ usemymalloc='y'
+ mallocsrc='malloc.c'
+ mallocobj="malloc$_o"
+ d_mymalloc="$define"
+ case "$libs" in
+ *-lmalloc*)
+ : Remove malloc from list of libraries to use
+ echo "Removing unneeded -lmalloc from library list" >&4
+ set `echo X $libs | $sed -e 's/-lmalloc / /' -e 's/-lmalloc$//'`
+ shift
+ libs="$*"
+ echo "libs = $libs" >&4
+ ;;
+ esac
+ ;;
+*)
+ usemymalloc='n'
+ mallocsrc=''
+ mallocobj=''
+ d_mymalloc="$undef"
+ ;;
+esac
+
+: compute the return types of malloc and free
+echo " "
+$cat >malloc.c <<END
+#$i_malloc I_MALLOC
+#$i_stdlib I_STDLIB
+#include <stdio.h>
+#include <sys/types.h>
+#ifdef I_MALLOC
+#include <malloc.h>
+#endif
+#ifdef I_STDLIB
+#include <stdlib.h>
+#endif
+#ifdef TRY_MALLOC
+void *malloc();
+#endif
+#ifdef TRY_FREE
+void free();
+#endif
+END
+case "$malloctype" in
+'')
+ if $cc $ccflags -c -DTRY_MALLOC malloc.c >/dev/null 2>&1; then
+ malloctype='void *'
+ else
+ malloctype='char *'
+ fi
+ ;;
+esac
+echo "Your system wants malloc to return '$malloctype', it would seem." >&4
+
+case "$freetype" in
+'')
+ if $cc $ccflags -c -DTRY_FREE malloc.c >/dev/null 2>&1; then
+ freetype='void'
+ else
+ freetype='int'
+ fi
+ ;;
+esac
+echo "Your system uses $freetype free(), it would seem." >&4
+$rm -f malloc.[co]
+: Cruising for prototypes
+echo " "
+echo "Checking out function prototypes..." >&4
+$cat >prototype.c <<'EOCP'
+int main(int argc, char *argv[]) {
+ exit(0);}
+EOCP
+if $cc $ccflags -c prototype.c >prototype.out 2>&1 ; then
+ echo "Your C compiler appears to support function prototypes."
+ val="$define"
+else
+ echo "Your C compiler doesn't seem to understand function prototypes."
+ val="$undef"
+fi
+set prototype
+eval $setvar
+$rm -f prototype*
+
+case "$prototype" in
+"$define") ;;
+*) ansi2knr='ansi2knr'
+ echo " "
+ cat <<EOM >&4
+
+$me: FATAL ERROR:
+This version of $package can only be compiled by a compiler that
+understands function prototypes. Unfortunately, your C compiler
+ $cc $ccflags
+doesn't seem to understand them. Sorry about that.
+
+If GNU cc is available for your system, perhaps you could try that instead.
+
+Eventually, we hope to support building Perl with pre-ANSI compilers.
+If you would like to help in that effort, please contact <perlbug@perl.org>.
+
+Aborting Configure now.
+EOM
+ exit 2
+ ;;
+esac
+
+: determine where public executables go
+echo " "
+set dflt bin bin
+eval $prefixit
+fn=d~
+rp='Pathname where the public executables will reside?'
+. ./getfile
+if $test "X$ansexp" != "X$binexp"; then
+ installbin=''
+fi
+bin="$ans"
+binexp="$ansexp"
+if $afs; then
+ $cat <<EOM
+
+Since you are running AFS, I need to distinguish the directory in which
+executables reside from the directory in which they are installed (and from
+which they are presumably copied to the former directory by occult means).
+
+EOM
+ case "$installbin" in
+ '') dflt=`echo $binexp | sed 's#^/afs/#/afs/.#'`;;
+ *) dflt="$installbin";;
+ esac
+ fn=de~
+ rp='Where will public executables be installed?'
+ . ./getfile
+ installbin="$ans"
+else
+ installbin="$binexp"
+fi
+
+echo " "
+if test -d /usr/bin -a "X$installbin" != X/usr/bin; then
+ $cat <<EOM
+Many scripts expect to perl to be installed as /usr/bin/perl.
+I can install the perl you are about to compile also as /usr/bin/perl
+(in addition to $installbin/perl).
+EOM
+ case "$installusrbinperl" in
+ "$undef"|[nN]*) dflt='n';;
+ *) dflt='y';;
+ esac
+ rp="Do you want to install perl as /usr/bin/perl?"
+ . ./myread
+ case "$ans" in
+ [yY]*) val="$define";;
+ *) val="$undef" ;;
+ esac
+else
+ val="$undef"
+fi
+set installusrbinperl
+eval $setvar
+
+: define a shorthand compile call
+compile='
+mc_file=$1;
+shift;
+$cc $optimize $ccflags $ldflags -o ${mc_file} $* ${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;'
+
echo " "
echo "Checking for GNU C Library..." >&4
cat >gnulibc.c <<EOM
-int
-main()
+#include <stdio.h>
+int main()
{
- return __libc_main();
+#ifdef __GLIBC__
+ exit(0);
+#else
+ exit(1);
+#endif
}
EOM
-if $cc $ccflags $ldflags -o gnulibc gnulibc.c $libs >/dev/null 2>&1 && \
- ./gnulibc | $contains '^GNU C Library' >/dev/null 2>&1; then
+set gnulibc
+if eval $compile_ok && ./gnulibc; then
val="$define"
echo "You are using the GNU C Library"
else
@@ -3867,12 +4421,26 @@ 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)
+ "$define")
+ echo " "
+ echo "nm probably won't work on the GNU C Library." >&4
dflt=n
;;
- *)
- dflt=`egrep 'inlibc|csym' ../Configure | wc -l 2>/dev/null`
+ 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
@@ -3883,26 +4451,28 @@ case "$usenm" in
;;
*)
case "$usenm" in
- true) dflt=y;;
+ true|$define) dflt=y;;
*) dflt=n;;
esac
;;
esac
$cat <<EOM
-I can use 'nm' to extract the symbols from your C libraries. This is a time
-consuming task which may generate huge output on the disk (up to 3 megabytes)
-but that should make the symbols extraction faster. The alternative is to skip
-the 'nm' extraction part and to compile a small test program instead to
-determine whether each symbol is present. If you have a fast C compiler and/or
-if your 'nm' output cannot be parsed, this may be the best solution.
-You shouldn't let me use 'nm' if you have the GNU C Library.
+I can use $nm to extract the symbols from your C libraries. This
+is a time consuming task which may generate huge output on the disk (up
+to 3 megabytes) but that should make the symbols extraction faster. The
+alternative is to skip the 'nm' extraction part and to compile a small
+test program instead to determine whether each symbol is present. If
+you have a fast C compiler and/or if your 'nm' output cannot be parsed,
+this may be the best solution.
+
+You probably shouldn't let me use 'nm' if you are using the GNU C Library.
EOM
-rp='Shall I use nm to extract C symbols from the libraries?'
+rp="Shall I use $nm to extract C symbols from the libraries?"
. ./myread
case "$ans" in
-n|N) usenm=false;;
+[Nn]*) usenm=false;;
*) usenm=true;;
esac
@@ -3931,7 +4501,7 @@ esac
case "$nm_so_opt" in
'') case "$myuname" in
*linux*)
- if nm --help | $grep 'dynamic' > /dev/null 2>&1; then
+ if $nm --help | $grep 'dynamic' > /dev/null 2>&1; then
nm_so_opt='--dynamic'
fi
;;
@@ -3946,7 +4516,7 @@ echo " "
case "$libc" in
'') libc=unknown
case "$libs" in
- *-lc_s*) libc=`./loc libc_s$lib_ext $libc $libpth`
+ *-lc_s*) libc=`./loc libc_s$_a $libc $libpth`
esac
;;
esac
@@ -3964,15 +4534,15 @@ case "$libs" in
:
elif try=`./loc lib$thislib.$so X $libpth`; $test -f "$try"; then
:
- elif try=`./loc lib$thislib$lib_ext X $libpth`; $test -f "$try"; then
+ elif try=`./loc lib$thislib$_a X $libpth`; $test -f "$try"; then
:
- elif try=`./loc $thislib$lib_ext 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$lib_ext X $xlibpth`; $test -f "$try"; then
+ elif try=`./loc Slib$thislib$_a X $xlibpth`; $test -f "$try"; then
:
else
try=''
@@ -3993,18 +4563,18 @@ unknown)
: The messy sed command sorts on library version numbers.
$test -r $1 || \
set `echo blurfl; echo $xxx/libc.$so.[0-9]* | \
- tr ' ' '\012' | egrep -v '\.[A-Za-z]*$' | $sed -e '
+ 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/^.* //'`
+ sort | $sed -e 's/^.* //'`
eval set \$$#
done
$test -r $1 || set /usr/ccs/lib/libc.$so
- $test -r $1 || set /lib/libsys_s$lib_ext
- ;;
+ $test -r $1 || set /lib/libsys_s$_a
+ ;;
*)
set blurfl
;;
@@ -4022,25 +4592,25 @@ elif $test -r /lib/libc && $test -r /lib/clib; then
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$lib_ext; then
- libc=$incpath/usr/lib/libc$lib_ext;
+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$lib_ext; then
- libc=/lib/libc$lib_ext;
+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$lib_ext blurfl/dyick $libpth`; $test -r "$tans"; then
+ 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$lib_ext blurfl/dyick $xlibpth`; $test -r "$tans"; then
+ elif tans=`./loc Slibc$_a blurfl/dyick $xlibpth`; $test -r "$tans"; then
:
- elif tans=`./loc Mlibc$lib_ext blurfl/dyick $xlibpth`; $test -r "$tans"; then
+ elif tans=`./loc Mlibc$_a blurfl/dyick $xlibpth`; $test -r "$tans"; then
:
else
- tans=`./loc Llibc$lib_ext blurfl/dyick $xlibpth`
+ 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."
@@ -4059,7 +4629,7 @@ compiler, or your machine supports multiple models), you can override it here.
EOM
else
dflt=''
- echo $libpth | tr ' ' '\012' | sort | uniq > libpath
+ echo $libpth | tr ' ' $trnl | sort | uniq > libpath
cat >&4 <<EOM
I can't seem to find your C library. I've looked in the following places:
@@ -4077,7 +4647,7 @@ rp='Where is your C library?'
libc="$ans"
echo " "
-echo $libc $libnames | tr ' ' '\012' | sort | uniq > libnames
+echo $libc $libnames | tr ' ' $trnl | sort | uniq > libnames
set X `cat libnames`
shift
xxx=files
@@ -4088,15 +4658,12 @@ $sed 's/^/ /' libnames >&4
echo " "
$echo $n "This may take a while...$c" >&4
-: Linux may need the special Dynamic option to nm for shared libraries.
-: In general, this is stored in the nm_so_opt variable.
-: Unfortunately, that option may be fatal on non-shared libraries.
-for nm_libs_ext in $*; do
- case $nm_libs_ext in
- *$so*) nm $nm_so_opt $nm_opt $nm_libs_ext 2>/dev/null ;;
- *) nm $nm_opt $nm_libs_ext 2>/dev/null ;;
+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
+done >libc.tmp
$echo $n ".$c"
$grep fprintf libc.tmp > libc.ptf
@@ -4156,8 +4723,12 @@ 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
+ $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
@@ -4166,23 +4737,38 @@ else
eval $xrun
else
echo " "
- echo "nm didn't seem to work right. Trying ar instead..." >&4
+ echo "$nm didn't seem to work right. Trying $ar instead..." >&4
com=''
- if ar t $libc > libc.tmp; then
- for thisname in $libnames; do
- ar t $thisname >>libc.tmp
+ 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
+ $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 "$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
+ 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
+ $sed -e 's/.*\///' -e "s/\\$_o:.*\$//" >>libc.list
+ $ar t $thisname >>libc.tmp
done
echo "Ok." >&4
else
@@ -4196,102 +4782,12 @@ 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$/\1/p' /lib/syscalls.exp >>libc.list
+ $sed -n 's/^\([^ ]*\)[ ]*syscall[0-9]*$/\1/p' /lib/syscalls.exp >>libc.list
fi
;;
esac
$rm -f libnames libpath
-: determine filename position in cpp output
-echo " "
-echo "Computing filename position in cpp output for #include directives..." >&4
-echo '#include <stdio.h>' > foo.c
-$cat >fieldn <<EOF
-$startsh
-$cppstdin $cppflags $cppminus <foo.c 2>/dev/null | \
-$grep '^[ ]*#.*stdio\.h' | \
-while read cline; do
- pos=1
- set \$cline
- while $test \$# -gt 0; do
- if $test -r \`echo \$1 | $tr -d '"'\`; then
- echo "\$pos"
- exit 0
- fi
- shift
- pos=\`expr \$pos + 1\`
- done
-done
-EOF
-chmod +x fieldn
-fieldn=`./fieldn`
-$rm -f foo.c fieldn
-case $fieldn in
-'') pos='???';;
-1) pos=first;;
-2) pos=second;;
-3) pos=third;;
-*) pos="${fieldn}th";;
-esac
-echo "Your cpp writes the filename in the $pos field of the line."
-
-: locate header file
-$cat >findhdr <<EOF
-$startsh
-wanted=\$1
-name=''
-if test -f $usrinc/\$wanted; then
- echo "$usrinc/\$wanted"
- exit 0
-fi
-awkprg='{ print \$$fieldn }'
-echo "#include <\$wanted>" > foo\$\$.c
-$cppstdin $cppminus $cppflags < foo\$\$.c 2>/dev/null | \
-$grep "^[ ]*#.*\$wanted" | \
-while read cline; do
- name=\`echo \$cline | $awk "\$awkprg" | $tr -d '"'\`
- case "\$name" in
- */\$wanted) echo "\$name"; exit 0;;
- *) name='';;
- esac;
-done;
-$rm -f foo\$\$.c;
-case "\$name" in
-'') exit 1;;
-esac
-EOF
-chmod +x findhdr
-
-: define an alternate in-header-list? function
-inhdr='echo " "; td=$define; tu=$undef; yyy=$@;
-cont=true; xxf="echo \"<\$1> found.\" >&4";
-case $# in 2) xxnf="echo \"<\$1> NOT found.\" >&4";;
-*) xxnf="echo \"<\$1> NOT found, ...\" >&4";;
-esac;
-case $# in 4) instead=instead;; *) instead="at last";; esac;
-while $test "$cont"; do
- xxx=`./findhdr $1`
- var=$2; eval "was=\$$2";
- if $test "$xxx" && $test -r "$xxx";
- then eval $xxf;
- eval "case \"\$$var\" in $undef) . ./whoa; esac"; eval "$var=\$td";
- cont="";
- else eval $xxnf;
- eval "case \"\$$var\" in $define) . ./whoa; esac"; eval "$var=\$tu"; fi;
- set $yyy; shift; shift; yyy=$@;
- case $# in 0) cont="";;
- 2) xxf="echo \"but I found <\$1> $instead.\" >&4";
- xxnf="echo \"and I did not find <\$1> either.\" >&4";;
- *) xxf="echo \"but I found <\$1\> instead.\" >&4";
- xxnf="echo \"there is no <\$1>, ...\" >&4";;
- esac;
-done;
-while $test "$yyy";
-do set $yyy; var=$2; eval "was=\$$2";
- eval "case \"\$$var\" in $define) . ./whoa; esac"; eval "$var=\$tu";
- set $yyy; shift; shift; yyy=$@;
-done'
-
: see if dld is available
set dld.h i_dld
eval $inhdr
@@ -4317,8 +4813,8 @@ yes)
else tval=false;
fi;;
*)
- echo "main() { extern short $1$tdc; printf(\"%hd\", $1$tc); }" > t.c;
- if $cc $ccflags $ldflags -o t t.c $libs >/dev/null 2>&1;
+ 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;
@@ -4387,7 +4883,7 @@ $undef|n|false)
$define) dflt='y' ;;
esac
: Does a dl_xxx.xs file exist for this operating system
- $test -f ../$dldir/dl_${osname}.xs && dflt='y'
+ $test -f $rsrc/$dldir/dl_${osname}.xs && dflt='y'
;;
esac
rp="Do you wish to use dynamic loading?"
@@ -4397,7 +4893,7 @@ case "$ans" in
y*) usedl="$define"
case "$dlsrc" in
'')
- if $test -f ../$dldir/dl_${osname}.xs ; then
+ if $test -f $rsrc/$dldir/dl_${osname}.xs ; then
dflt="$dldir/dl_${osname}.xs"
elif $test "$d_dlopen" = "$define" ; then
dflt="$dldir/dl_dlopen.xs"
@@ -4412,15 +4908,17 @@ y*) usedl="$define"
esac
echo "The following dynamic loading files are available:"
: Can not go over to $dldir because getfile has path hard-coded in.
- cd ..; ls -C $dldir/dl*.xs; cd UU
- rp="Source file to use for dynamic loading"
- fn="fne"
- . ./getfile
+ tdir=`pwd`; cd $rsrc; $ls -C $dldir/dl*.xs; cd $tdir
+ rp="Source file to use for dynamic loading"
+ fn="fne"
+ # XXX This getfile call will fail the existence check if you try
+ # building away from $src (this is not supported yet).
+ . ./getfile
usedl="$define"
: emulate basename
dlsrc=`echo $ans | $sed -e 's@.*/\([^/]*\)$@\1@'`
- $cat << EOM
+ $cat << EOM
Some systems may require passing special flags to $cc -c to
compile modules that will be used to create a shared library.
@@ -4432,20 +4930,18 @@ EOM
'') case "$osname" in
hpux) dflt='+z' ;;
next) dflt='none' ;;
- svr4*|esix*) dflt='-Kpic' ;;
irix*) dflt='-KPIC' ;;
- solaris) case "$ccflags" in
- *-DDEBUGGING*) dflt='-KPIC' ;;
- *) dflt='-Kpic' ;;
- esac ;;
+ svr4*|esix*|solaris) dflt='-KPIC' ;;
sunos) dflt='-pic' ;;
*) dflt='none' ;;
- esac ;;
- *) case "$osname/$ccflags" in
- solaris/*-DDEBUGGING*) dflt='-fPIC' ;;
- *) dflt='-fpic' ;;
+ esac
+ ;;
+ *) case "$osname" in
+ svr4*|esix*|solaris) dflt='-fPIC' ;;
+ *) dflt='-fpic' ;;
esac ;;
esac ;;
+ ' ') dflt='none' ;;
*) dflt="$cccdlflags" ;;
esac
rp="Any special flags to pass to $cc -c to compile shared library modules?"
@@ -4466,7 +4962,7 @@ EOM
/* Test for whether ELF binaries are produced */
#include <fcntl.h>
#include <stdlib.h>
-main() {
+int main() {
char b[4];
int i = open("a.out",O_RDONLY);
if(i == -1)
@@ -4511,6 +5007,7 @@ EOM
linux|irix*) dflt='-shared' ;;
next) dflt='none' ;;
solaris) dflt='-G' ;;
+ beos) dflt='-nostart' ;;
sunos) dflt='-assert nodefinitions' ;;
svr4*|esix*) dflt="-G $ldflags" ;;
*) dflt='none' ;;
@@ -4519,21 +5016,25 @@ EOM
*) dflt="$lddlflags" ;;
esac
-: Try to guess additional flags to pick up local libraries.
-for thisflag in $ldflags; do
- case "$thisflag" in
- -L*)
- case " $dflt " in
- *" $thisflag "*) ;;
- *) dflt="$dflt $thisflag" ;;
+ : Try to guess additional flags to pick up local libraries.
+ : Be careful not to append to a plain 'none'
+ case "$dflt" in
+ none) dflt='' ;;
+ esac
+ for thisflag in $ldflags; do
+ case "$thisflag" in
+ -L*)
+ case " $dflt " in
+ *" $thisflag "*) ;;
+ *) dflt="$dflt $thisflag" ;;
+ esac
+ ;;
esac
- ;;
- esac
-done
+ done
-case "$dflt" in
-'') dflt='none' ;;
-esac
+ case "$dflt" in
+ ''|' ') dflt='none' ;;
+ esac
rp="Any special flags to pass to $ld to create a dynamically loaded library?"
. ./myread
@@ -4557,6 +5058,7 @@ EOM
sunos) dflt='none' ;;
*) dflt='none' ;;
esac ;;
+ ' ') dflt='none' ;;
*) dflt="$ccdlflags" ;;
esac
rp="Any special flags to pass to $cc to use dynamic loading?"
@@ -4582,7 +5084,7 @@ $undef)
;;
*) case "$useshrplib" in
'') case "$osname" in
- svr4*|dgux|dynixptx|esix|powerux)
+ svr4*|dgux|dynixptx|esix|powerux|beos)
dflt=y
also='Building a shared libperl is required for dynamic loading to work on your system.'
;;
@@ -4595,10 +5097,6 @@ $undef)
;;
esac
;;
- sunos)
- dflt=n
- also='Building a shared libperl will definitely not work on SunOS 4.'
- ;;
*) dflt=n
;;
esac
@@ -4612,7 +5110,7 @@ $undef)
$cat << EOM
The perl executable is normally obtained by linking perlmain.c with
-libperl${lib_ext}, any static extensions (usually just DynaLoader), and
+libperl${_a}, any static extensions (usually just DynaLoader), and
any other libraries needed on this system (such as -lm, etc.). Since
your system supports dynamic loading, it is probably possible to build
a shared libperl.$so. If you will have more than one executable linked
@@ -4630,19 +5128,10 @@ EOM
# Why does next4 have to be so different?
case "${osname}${osvers}" in
next4*) xxx='DYLD_LIBRARY_PATH' ;;
+ os2*) xxx='' ;; # Nothing special needed.
+ beos*) xxx='' ;;
*) xxx='LD_LIBRARY_PATH' ;;
esac
- $cat <<EOM >&4
-
-To build perl, you must add the current working directory to your
-$xxx environtment variable before running make. You can do
-this with
- $xxx=\`pwd\`; export $xxx
-for Bourne-style shells, or
- setenv $xxx \`pwd\`
-for Csh-style shells. You *MUST* do this before running make.
-
-EOM
;;
*) useshrplib='false' ;;
esac
@@ -4704,7 +5193,7 @@ EOM
echo "Ok, I'll use $libperl"
;;
*)
- libperl="libperl${lib_ext}"
+ libperl="libperl${_a}"
;;
esac
@@ -4714,8 +5203,8 @@ case "$shrpdir" in
*) $cat >&4 <<EOM
WARNING: Use of the shrpdir variable for the installation location of
the shared $libperl is not supported. It was never documented and
-will not work in this version. Let me (chip@perl.com) know of any
-problems this may cause.
+will not work in this version. Let perlbug@perl.com
+know of any problems this may cause.
EOM
case "$shrpdir" in
@@ -4760,6 +5249,9 @@ if "$useshrplib"; then
next)
# next doesn't like the default...
;;
+ beos)
+ # beos doesn't like the default, either.
+ ;;
*)
tmp_shrpenv="env LD_RUN_PATH=$shrpdir"
;;
@@ -4811,14 +5303,6 @@ case "$man1dir" in
lookpath="$lookpath $prefixexp/man/p_man/man1"
lookpath="$lookpath $prefixexp/man/u_man/man1"
lookpath="$lookpath $prefixexp/man/man.1"
- : If prefix contains 'perl' then we want to keep the man pages
- : under the prefix directory. Otherwise, look in a variety of
- : other possible places. This is debatable, but probably a
- : good compromise. Well, apparently not.
- : Experience has shown people expect man1dir to be under prefix,
- : so we now always put it there. Users who want other behavior
- : can answer interactively or use a command line option.
- : Does user have System V-style man paths.
case "$sysman" in
*/?_man*) dflt=`./loc . $prefixexp/l_man/man1 $lookpath` ;;
*) dflt=`./loc . $prefixexp/man/man1 $lookpath` ;;
@@ -4947,7 +5431,6 @@ case "$nroff" in
nroff)
$cat <<'EOM'
However, you don't have nroff, so they're probably useless to you.
-You can use the supplied perldoc script instead.
EOM
case "$man3dir" in
'') man3dir="none";;
@@ -4958,7 +5441,6 @@ case "$d_flexfnam" in
undef)
$cat <<'EOM'
However, your system can't handle the long file names like File::Basename.3.
-You can use the supplied perldoc script instead.
EOM
case "$man3dir" in
'') man3dir="none";;
@@ -4966,14 +5448,10 @@ EOM
esac
echo "If you don't want the manual sources installed, answer 'none'."
-: We dont use /usr/local/man/man3 because some man programs will
-: only show the /usr/local/man/man3 contents, and not the system ones,
-: thus man less will show the perl module less.pm, but not the system
-: less command. We might also conflict with TCL man pages.
-: However, something like /opt/perl/man/man3 is fine.
+prog=`echo $package | $sed 's/-*[0-9.]*$//'`
case "$man3dir" in
'') case "$prefix" in
- *perl*) dflt=`echo $man1dir |
+ *$prog*) dflt=`echo $man1dir |
$sed -e 's/man1/man3/g' -e 's/man\.1/man\.3/g'` ;;
*) dflt="$privlib/man/man3" ;;
esac
@@ -4984,7 +5462,7 @@ esac
echo " "
fn=dn+~
-rp="Where do the $spackage library man pages (source) go?"
+rp="Where do the $package library man pages (source) go?"
. ./getfile
if test "X$man3direxp" != "X$ansexp"; then
installman3dir=''
@@ -5023,7 +5501,7 @@ case "$man3dir" in
man3ext='0'
;;
*)
- rp="What suffix should be used for the $spackage library man pages?"
+ rp="What suffix should be used for the $package library man pages?"
case "$man3ext" in
'') case "$man3dir" in
*3) dflt=3 ;;
@@ -5090,6 +5568,15 @@ if $test -d /usr/etc/yp || $test -d /etc/yp; then
;;
esac
fi
+case "$hostcat" in
+'') hostcat='cat /etc/hosts';;
+esac
+case "$groupcat" in
+'') groupcat='cat /etc/group';;
+esac
+case "$passcat" in
+'') passcat='cat /etc/passwd';;
+esac
: now get the host name
echo " "
@@ -5185,15 +5672,11 @@ case "$myhostname" in
*) case "$mydomain" in
'')
{
- : If we use NIS, try ypmatch.
- : Is there some reason why this was not done before?
test "X$hostcat" = "Xypcat hosts" &&
ypmatch "$myhostname" hosts 2>/dev/null |\
$sed -e 's/[ ]*#.*//; s/$/ /' > hosts && \
$test -s hosts
} || {
- : Extract only the relevant hosts, reducing file size,
- : remove comments, insert trailing space for later use.
$hostcat | $sed -n -e "s/[ ]*#.*//; s/\$/ /
/[ ]$myhostname[ . ]/p" > hosts
}
@@ -5215,8 +5698,6 @@ case "$myhostname" in
tans=`./loc resolv.conf X /etc /usr/etc`
if $test -f "$tans"; then
echo "(Attempting domain name extraction from $tans)"
- : Why was there an Egrep here, when Sed works?
- : Look for either a search or a domain directive.
dflt=.`$sed -n -e 's/ / /g' \
-e 's/^search *\([^ ]*\).*/\1/p' $tans \
| ./tr '[A-Z]' '[a-z]' 2>/dev/null`
@@ -5458,15 +5939,107 @@ else
installscript="$scriptdirexp"
fi
+: determine where site specific libraries go.
+: Usual default is /usr/local/lib/perl5/site_perl/$apiversion
+prog=`echo $package | $sed 's/-*[0-9.]*$//'`
+case "$prefix" in
+*perl*) set dflt sitelib lib/site_$prog/$apiversion ;;
+*) set dflt sitelib lib/$package/site_$prog/$apiversion ;;
+esac
+eval $prefixit
+$cat <<EOM
+
+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.
+
+EOM
+fn=d~+
+rp='Pathname for the site-specific library files?'
+. ./getfile
+if $test "X$sitelibexp" != "X$ansexp"; then
+ installsitelib=''
+fi
+sitelib="$ans"
+sitelibexp="$ansexp"
+if $afs; then
+ $cat <<EOM
+
+Since you are running AFS, I need to distinguish the directory in
+which site-specific files reside from the directory in which they are
+installed (and from which they are presumably copied to the former
+directory by occult means).
+
+EOM
+ case "$installsitelib" in
+ '') dflt=`echo $sitelibexp | sed 's#^/afs/#/afs/.#'`;;
+ *) dflt="$installsitelib";;
+ esac
+ fn=de~
+ rp='Where will site-specific files be installed?'
+ . ./getfile
+ installsitelib="$ans"
+else
+ installsitelib="$sitelibexp"
+fi
+
+: determine where site specific architecture-dependent libraries go.
+: sitelib default is /usr/local/lib/perl5/site_perl/$apiversion
+: sitearch default is /usr/local/lib/perl5/site_perl/$apiversion/$archname
+: sitelib may have an optional trailing /share.
+tdflt=`echo $sitelib | $sed 's,/share$,,'`
+tdflt="$tdflt/$archname"
+set sitearch sitearch none
+eval $prefixit
+case "$sitearch" in
+'') dflt="$tdflt" ;;
+*) dflt="$sitearch" ;;
+esac
+$cat <<EOM
+
+The installation process will also create a directory for
+architecture-dependent site-specific extensions and modules.
+
+EOM
+fn=nd~+
+rp='Pathname for the site-specific architecture-dependent library files?'
+. ./getfile
+if $test "X$sitearchexp" != "X$ansexp"; then
+ installsitearch=''
+fi
+sitearch="$ans"
+sitearchexp="$ansexp"
+if $afs; then
+ $cat <<EOM
+
+Since you are running AFS, I need to distinguish the directory in
+which site-specific architecture-dependent library files reside from
+the directory in which they are installed (and from which they are
+presumably copied to the former directory by occult means).
+
+EOM
+ case "$installsitearch" in
+ '') dflt=`echo $sitearchexp | sed 's#^/afs/#/afs/.#'`;;
+ *) dflt="$installsitearch";;
+ esac
+ fn=de~
+ rp='Where will site-specific architecture-dependent files be installed?'
+ . ./getfile
+ installsitearch="$ans"
+else
+ installsitearch="$sitearchexp"
+fi
+
cat <<EOM
-Previous version of $package used the standard IO mechanisms as defined in
-<stdio.h>. Versions 5.003_02 and later of perl allow alternate IO
+Previous version of $package used the standard IO mechanisms as defined
+in <stdio.h>. Versions 5.003_02 and later of perl allow alternate IO
mechanisms via a "PerlIO" abstraction, but the stdio mechanism is still
-the default and is the only supported mechanism. This abstraction
-layer can use AT&T's sfio (if you already have sfio installed) or
-fall back on standard IO. This PerlIO abstraction layer is
-experimental and may cause problems with some extension modules.
+the default. This abstraction layer can use AT&T's sfio (if you already
+have sfio installed) or regular stdio. Using PerlIO with sfio may cause
+problems with some extension modules. Using PerlIO with stdio is safe,
+but it is slower than plain stdio and therefore is not the default.
If this doesn't make any sense to you, just accept the default 'n'.
EOM
@@ -5489,9 +6062,10 @@ set useperlio
eval $setvar
: Check how to convert floats to strings.
-echo " "
-echo "Checking for an efficient way to convert floats to strings."
-$cat >try.c <<'EOP'
+if test "X$d_Gconvert" = X; then
+ echo " "
+ echo "Checking for an efficient way to convert floats to strings."
+ $cat >try.c <<'EOP'
#ifdef TRY_gconvert
#define Gconvert(x,n,t,b) gconvert((x),(n),(t),(b))
char *myname = "gconvert";
@@ -5519,8 +6093,7 @@ char *got;
}
}
-int
-main()
+int main()
{
char buf[64];
buf[63] = '\0';
@@ -5550,18 +6123,18 @@ main()
exit(0);
}
EOP
-case "$d_Gconvert" in
-gconvert*) xxx_list='gconvert gcvt sprintf' ;;
-gcvt*) xxx_list='gcvt gconvert sprintf' ;;
-sprintf*) xxx_list='sprintf gconvert gcvt' ;;
-*) xxx_list='gconvert gcvt sprintf' ;;
-esac
+ case "$d_Gconvert" in
+ gconvert*) xxx_list='gconvert gcvt sprintf' ;;
+ gcvt*) xxx_list='gcvt gconvert sprintf' ;;
+ sprintf*) xxx_list='sprintf gconvert gcvt' ;;
+ *) xxx_list='gconvert gcvt sprintf' ;;
+ esac
-for xxx_convert in $xxx_list; do
+ for xxx_convert in $xxx_list; do
echo "Trying $xxx_convert"
- $rm -f try try.o
- if $cc $ccflags -DTRY_$xxx_convert $ldflags -o try \
- try.c $libs > /dev/null 2>&1 ; then
+ $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
@@ -5572,13 +6145,14 @@ for xxx_convert in $xxx_list; do
else
echo "$xxx_convert NOT found." >&4
fi
-done
+ done
-case "$xxx_convert" in
-gconvert) d_Gconvert='gconvert((x),(n),(t),(b))' ;;
-gcvt) d_Gconvert='gcvt((x),(n),(b))' ;;
-*) d_Gconvert='sprintf((b),"%.*g",(n),(x))' ;;
-esac
+ case "$xxx_convert" in
+ gconvert) d_Gconvert='gconvert((x),(n),(t),(b))' ;;
+ gcvt) d_Gconvert='gcvt((x),(n),(b))' ;;
+ *) d_Gconvert='sprintf((b),"%.*g",(n),(x))' ;;
+ esac
+fi
: Initialize h_fcntl
h_fcntl=false
@@ -5605,21 +6179,21 @@ case "$d_access" in
#ifdef I_UNISTD
#include <unistd.h>
#endif
-main() {
+int main() {
exit(R_OK);
}
EOCP
: check sys/file.h first, no particular reason here
if $test `./findhdr sys/file.h` && \
- $cc $cppflags -DI_SYS_FILE access.c -o access >/dev/null 2>&1 ; then
+ $cc $cppflags -DI_SYS_FILE -o access access.c >/dev/null 2>&1 ; then
h_sysfile=true;
echo "<sys/file.h> defines the *_OK access constants." >&4
elif $test `./findhdr fcntl.h` && \
- $cc $cppflags -DI_FCNTL access.c -o access >/dev/null 2>&1 ; then
+ $cc $cppflags -DI_FCNTL -o access access.c >/dev/null 2>&1 ; then
h_fcntl=true;
echo "<fcntl.h> defines the *_OK access constants." >&4
elif $test `./findhdr unistd.h` && \
- $cc $cppflags -DI_UNISTD access.c -o access >/dev/null 2>&1 ; then
+ $cc $cppflags -DI_UNISTD -o access access.c >/dev/null 2>&1 ; then
echo "<unistd.h> defines the *_OK access constants." >&4
else
echo "I can't find the four *_OK access constants--I'll use mine." >&4
@@ -5671,17 +6245,17 @@ eval $inhdr
set getpgrp d_getpgrp
eval $inlibc
-echo "Checking to see which flavor of getpgrp is in use . . . "
case "$d_getpgrp" in
"$define")
echo " "
+ echo "Checking to see which flavor of getpgrp is in use..."
$cat >set.c <<EOP
#$i_unistd I_UNISTD
#include <sys/types.h>
#ifdef I_UNISTD
# include <unistd.h>
#endif
-main()
+int main()
{
if (getuid() == 0) {
printf("(I see you are running Configure as super-user...)\n");
@@ -5733,17 +6307,17 @@ $rm -f set set.c
set setpgrp d_setpgrp
eval $inlibc
-echo "Checking to see which flavor of setpgrp is in use . . . "
case "$d_setpgrp" in
"$define")
echo " "
+ echo "Checking to see which flavor of setpgrp is in use..."
$cat >set.c <<EOP
#$i_unistd I_UNISTD
#include <sys/types.h>
#ifdef I_UNISTD
# include <unistd.h>
#endif
-main()
+int main()
{
if (getuid() == 0) {
printf("(I see you are running Configure as super-user...)\n");
@@ -5766,7 +6340,7 @@ EOP
echo 'You have to use setpgrp() instead of setpgrp(pid,pgrp).' >&4
val="$undef"
else
- echo "I can't seem to compile and run the test program."
+ echo "(I can't seem to compile and run the test program.)"
if ./usg; then
xxx="a USG one, i.e. you use setpgrp()."
else
@@ -5789,7 +6363,6 @@ EOP
esac
set d_bsdsetpgrp
eval $setvar
-d_bsdpgrp=$d_bsdsetpgrp
$rm -f set set.c
: see if bzero exists
set bzero d_bzero
@@ -5802,33 +6375,27 @@ case "$intsize" in
echo "Checking to see how big your integers are..." >&4
$cat >intsize.c <<'EOCP'
#include <stdio.h>
-main()
+int main()
{
printf("intsize=%d;\n", sizeof(int));
printf("longsize=%d;\n", sizeof(long));
printf("shortsize=%d;\n", sizeof(short));
- fflush(stdout);
exit(0);
}
EOCP
-# If $libs contains -lsfio, and sfio is mis-configured, then it
-# sometimes (apparently) runs and exits with a 0 status, but with no
-# output!. Thus we check with test -s whether we actually got any
-# output. I think it has to do with sfio's use of _exit vs. exit,
-# but I don't know for sure. --Andy Dougherty 1/27/97.
- if $cc $optimize $ccflags $ldflags -o intsize intsize.c $libs >/dev/null 2>&1 &&
- ./intsize > intsize.out 2>/dev/null && test -s intsize.out ; then
- eval `$cat intsize.out`
+ set intsize
+ if eval $compile_ok && ./intsize > /dev/null; then
+ eval `./intsize`
echo "Your integers are $intsize bytes long."
echo "Your long integers are $longsize bytes long."
echo "Your short integers are $shortsize bytes long."
else
$cat >&4 <<EOM
-
+!
Help! I can't compile and run the intsize test program: please enlighten me!
(This is probably a misconfiguration in your system or libraries, and
you really ought to fix it. Still, I'll try anyway.)
-
+!
EOM
dflt=4
rp="What is the size of an integer (in bytes)?"
@@ -5845,7 +6412,7 @@ EOM
fi
;;
esac
-$rm -f intsize intsize.[co] intsize.out
+$rm -f intsize intsize.*
: see if signal is declared as pointer to function returning int or void
echo " "
@@ -5855,11 +6422,14 @@ if $contains 'int.*\*[ ]*signal' $$.tmp >/dev/null 2>&1 ; then
echo "You have int (*signal())() instead of void." >&4
val="$undef"
elif $contains 'void.*\*[ ]*signal' $$.tmp >/dev/null 2>&1 ; then
- echo "You have void (*signal())() instead of int." >&4
+ echo "You have void (*signal())()." >&4
val="$define"
elif $contains 'extern[ ]*[(\*]*signal' $$.tmp >/dev/null 2>&1 ; then
echo "You have int (*signal())() instead of void." >&4
val="$undef"
+elif $contains 'void.*\*.*sig' $$.tmp >/dev/null 2>&1 ; then
+ echo "You have void (*signal())()." >&4
+ val="$define"
else
case "$d_voidsig" in
'')
@@ -5872,9 +6442,12 @@ else
*) val="$undef";;
esac;;
"$define")
- echo "As you already told me, signal handler returns void." >&4;;
- *)
- echo "As you already told me, signal handler returns int." >&4;;
+ echo "As you already told me, signal handler returns void." >&4
+ val="$define"
+ ;;
+ *) echo "As you already told me, signal handler returns int." >&4
+ val="$undef"
+ ;;
esac
fi
set d_voidsig
@@ -5888,32 +6461,44 @@ $rm -f $$.tmp
: check for ability to cast large floats to 32-bit ints.
echo " "
echo 'Checking whether your C compiler can cast large floats to int32.' >&4
-if $test "$intsize" -eq 4; then
+if $test "$intsize" -ge 4; then
xxx=int
else
xxx=long
fi
$cat >try.c <<EOCP
+#include <stdio.h>
#include <sys/types.h>
#include <signal.h>
-$signal_t blech() { exit(3); }
-main()
+$signal_t blech(s) int s; { exit(3); }
+int main()
{
$xxx i32;
- double f;
+ double f, g;
int result = 0;
+ char str[16];
signal(SIGFPE, blech);
- f = (double) 0x7fffffff;
- f = 10 * f;
- i32 = ($xxx) f;
-
+ /* Don't let compiler optimize the test away. Store the number
+ in a writable string for gcc to pass to sscanf under HP/UX.
+ */
+ sprintf(str, "2147483647");
+ sscanf(str, "%lf", &f); /* f = (double) 0x7fffffff; */
+ g = 10 * f;
+ i32 = ($xxx) g;
+
+ /* x86 processors will probably give 0x8000 0000, which is a
+ sign change. We don't want that. We want to mimic SPARC
+ behavior here, which is to preserve the sign and give
+ back 0x7fff ffff.
+ */
if (i32 != ($xxx) f)
result |= 1;
exit(result);
}
EOCP
-if $cc -o try $ccflags try.c >/dev/null 2>&1; then
+set try
+if eval $compile_ok; then
./try
yyy=$?
else
@@ -5936,20 +6521,32 @@ $rm -f try try.*
echo " "
echo 'Checking whether your C compiler can cast negative float to unsigned.' >&4
$cat >try.c <<EOCP
+#include <stdio.h>
#include <sys/types.h>
#include <signal.h>
-$signal_t blech() { exit(7); }
-$signal_t blech_in_list() { exit(4); }
+$signal_t blech(s) int s; { exit(7); }
+$signal_t blech_in_list(s) int s; { exit(4); }
unsigned long dummy_long(p) unsigned long p; { return p; }
unsigned int dummy_int(p) unsigned int p; { return p; }
unsigned short dummy_short(p) unsigned short p; { return p; }
-main()
+int main()
{
- double f = -123.;
+ double f;
unsigned long along;
unsigned int aint;
unsigned short ashort;
int result = 0;
+ char str[16];
+
+ /* Frustrate gcc-2.7.2's optimizer which failed this test with
+ a direct f = -123. assignment. gcc-2.8.0 reportedly
+ optimized the whole file away
+ */
+ /* Store the number in a writable string for gcc to pass to
+ sscanf under HP/UX.
+ */
+ sprintf(str, "-123");
+ sscanf(str, "%lf", &f); /* f = -123.; */
signal(SIGFPE, blech);
along = (unsigned long)f;
@@ -5961,7 +6558,8 @@ main()
result |= 1;
if (ashort != (unsigned short)-123)
result |= 1;
- f = (double)0x40000000;
+ sprintf(str, "1073741824.");
+ sscanf(str, "%lf", &f); /* f = (double)0x40000000; */
f = f + f;
along = 0;
along = (unsigned long)f;
@@ -5980,7 +6578,8 @@ main()
if (result)
exit(result);
signal(SIGFPE, blech_in_list);
- f = 123.;
+ sprintf(str, "123.");
+ sscanf(str, "%lf", &f); /* f = 123.; */
along = dummy_long((unsigned long)f);
aint = dummy_int((unsigned int)f);
ashort = dummy_short((unsigned short)f);
@@ -5994,7 +6593,8 @@ main()
}
EOCP
-if $cc -o try $ccflags try.c >/dev/null 2>&1; then
+set try
+if eval $compile_ok; then
./try
castflags=$?
else
@@ -6021,7 +6621,7 @@ if set vprintf val -f d_vprintf; eval $csym; $val; then
$cat >vprintf.c <<'EOF'
#include <varargs.h>
-main() { xxx("foo"); }
+int main() { xxx("foo"); }
xxx(va_alist)
va_dcl
@@ -6033,7 +6633,8 @@ va_dcl
exit((unsigned long)vsprintf(buf,"%s",args) > 10L);
}
EOF
- if $cc $ccflags vprintf.c -o vprintf >/dev/null 2>&1 && ./vprintf; then
+ set vprintf
+ if eval $compile && ./vprintf; then
echo "Your vsprintf() returns (int)." >&4
val2="$undef"
else
@@ -6068,7 +6669,7 @@ echo " "
echo 'Checking to see if your C compiler knows about "const"...' >&4
$cat >const.c <<'EOCP'
typedef struct spug { int drokk; } spug;
-main()
+int main()
{
const char *foo;
const spug y;
@@ -6091,19 +6692,19 @@ if set crypt val -f d_crypt; eval $csym; $val; then
val="$define"
cryptlib=''
else
- cryptlib=`./loc Slibcrypt$lib_ext "" $xlibpth`
+ cryptlib=`./loc Slibcrypt$_a "" $xlibpth`
if $test -z "$cryptlib"; then
- cryptlib=`./loc Mlibcrypt$lib_ext "" $xlibpth`
+ cryptlib=`./loc Mlibcrypt$_a "" $xlibpth`
else
cryptlib=-lcrypt
fi
if $test -z "$cryptlib"; then
- cryptlib=`./loc Llibcrypt$lib_ext "" $xlibpth`
+ cryptlib=`./loc Llibcrypt$_a "" $xlibpth`
else
cryptlib=-lcrypt
fi
if $test -z "$cryptlib"; then
- cryptlib=`./loc libcrypt$lib_ext "" $libpth`
+ cryptlib=`./loc libcrypt$_a "" $libpth`
else
cryptlib=-lcrypt
fi
@@ -6117,18 +6718,6 @@ fi
set d_crypt
eval $setvar
-: get csh whereabouts
-case "$csh" in
-'csh') val="$undef" ;;
-*) val="$define" ;;
-esac
-set d_csh
-eval $setvar
-: Respect a hint or command line value for full_csh.
-case "$full_csh" in
-'') full_csh=$csh ;;
-esac
-
: see if cuserid exists
set cuserid d_cuserid
eval $inlibc
@@ -6172,6 +6761,10 @@ eval $setvar
set difftime d_difftime
eval $inlibc
+: see if sys/stat.h is available
+set sys/stat.h i_sysstat
+eval $inhdr
+
: see if this is a dirent system
echo " "
if xinc=`./findhdr dirent.h`; $test "$xinc"; then
@@ -6240,6 +6833,23 @@ set d_dirnamlen
eval $setvar
$rm -f try.c
+hasfield='varname=$1; struct=$2; field=$3; shift; shift; shift;
+while $test $# -ge 2; do
+ case "$1" in
+ $define) echo "#include <$2>";;
+ esac ;
+ shift 2;
+done > try.c;
+echo "int main () { struct $struct foo; foo.$field = 0; }" >> try.c;
+if eval $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then
+ val="$define";
+else
+ val="$undef";
+fi;
+set $varname;
+eval $setvar;
+$rm -f try.c try.o'
+
: see if dlerror exists
xxx_runnm="$runnm"
runnm=false
@@ -6256,7 +6866,7 @@ $define|y|true)
$cat << EOM
On a few systems, the dynamically loaded modules that perl generates and uses
-will need a different extension then shared libs. The default will probably
+will need a different extension than shared libs. The default will probably
be appropriate.
EOM
@@ -6298,7 +6908,7 @@ $cat >fred.c<<EOM
extern int fred() ;
-main()
+int main()
{
void * handle ;
void * symbol ;
@@ -6332,9 +6942,9 @@ main()
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${obj_ext} tmp-dyna${obj_ext} > /dev/null 2>&1 &&
- $ld $lddlflags -o dyna.$dlext tmp-dyna${obj_ext} > /dev/null 2>&1 &&
- $cc $ccflags $ldflags $cccdlflags $ccdlflags fred.c -o fred $libs > /dev/null 2>&1; then
+ 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
xxx=`./fred`
case $xxx in
1) echo "Test program failed using dlopen." >&4
@@ -6360,6 +6970,22 @@ eval $setvar
set dup2 d_dup2
eval $inlibc
+: see if endhostent exists
+set endhostent d_endhent
+eval $inlibc
+
+: see if endnetent exists
+set endnetent d_endnent
+eval $inlibc
+
+: see if endprotoent exists
+set endprotoent d_endpent
+eval $inlibc
+
+: see if endservent exists
+set endservent d_endsent
+eval $inlibc
+
: Locate the flags for 'open()'
echo " "
$cat >open3.c <<'EOCP'
@@ -6370,7 +6996,7 @@ $cat >open3.c <<'EOCP'
#ifdef I_SYS_FILE
#include <sys/file.h>
#endif
-main() {
+int main() {
if(O_RDONLY);
#ifdef O_TRUNC
exit(0);
@@ -6381,7 +7007,7 @@ main() {
EOCP
: check sys/file.h first to get FREAD on Sun
if $test `./findhdr sys/file.h` && \
- $cc $ccflags "-DI_SYS_FILE" -o open3 $ldflags open3.c $libs >/dev/null 2>&1 ; then
+ set open3 -DI_SYS_FILE && eval $compile; then
h_sysfile=true;
echo "<sys/file.h> defines the O_* constants..." >&4
if ./open3; then
@@ -6392,7 +7018,7 @@ if $test `./findhdr sys/file.h` && \
val="$undef"
fi
elif $test `./findhdr fcntl.h` && \
- $cc $ccflags "-DI_FCNTL" -o open3 $ldflags open3.c $libs >/dev/null 2>&1 ; then
+ set open3 -DI_FCNTL && eval $compile; then
h_fcntl=true;
echo "<fcntl.h> defines the O_* constants..." >&4
if ./open3; then
@@ -6426,7 +7052,7 @@ case "$o_nonblock" in
'')
$cat head.c > try.c
$cat >>try.c <<'EOCP'
-main() {
+int main() {
#ifdef O_NONBLOCK
printf("O_NONBLOCK\n");
exit(0);
@@ -6442,7 +7068,8 @@ main() {
exit(0);
}
EOCP
- if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1; then
+ set try
+ if eval $compile_ok; then
o_nonblock=`./try`
case "$o_nonblock" in
'') echo "I can't figure it out, assuming O_NONBLOCK will do.";;
@@ -6466,11 +7093,13 @@ case "$eagain" in
#include <sys/types.h>
#include <signal.h>
#define MY_O_NONBLOCK $o_nonblock
+#ifndef errno /* XXX need better Configure test */
extern int errno;
+#endif
$signal_t blech(x) int x; { exit(3); }
EOCP
$cat >> try.c <<'EOCP'
-main()
+int main()
{
int pd[2];
int pu[2];
@@ -6520,7 +7149,8 @@ main()
exit(0); /* Bye bye, thank you for playing! */
}
EOCP
- if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1; then
+ set try
+ if eval $compile_ok; then
echo "$startsh" >mtry
echo "./try >try.out 2>try.ret 3>try.err || exit 4" >>mtry
chmod +x mtry
@@ -6619,14 +7249,117 @@ eval $inlibc
set fsetpos d_fsetpos
eval $inlibc
+: see if gethostbyaddr exists
+set gethostbyaddr d_gethbyaddr
+eval $inlibc
+
+: see if gethostbyname exists
+set gethostbyname d_gethbyname
+eval $inlibc
+
+: see if this is a sys/param system
+set sys/param.h i_sysparam
+eval $inhdr
+
+: see if this is a sys/mount.h system
+set sys/mount.h i_sysmount
+eval $inhdr
+
+: see if fstatfs exists
+set fstatfs d_fstatfs
+eval $inlibc
+
+: see if statfs knows about mount flags
+echo " "
+set d_statfsflags statfs f_flags $i_sysparam sys/param.h $i_sysmount sys/mount.h
+eval $hasfield
+
+: see if this is a sysstatvfs.h system
+set sys/statvfs.h i_sysstatvfs
+eval $inhdr
+
+: see if fstatvfs exists
+set fstatvfs d_fstatvfs
+eval $inlibc
+
: see if gethostent exists
set gethostent d_gethent
eval $inlibc
+hasproto='varname=$1; func=$2; shift; shift;
+while $test $# -ge 2; do
+ case "$1" in
+ $define) echo "#include <$2>";;
+ esac ;
+ shift 2;
+done > try.c;
+$cppstdin $cppflags $cppminus < try.c > tryout.c 2>/dev/null;
+if $contains "$func.*(" tryout.c >/dev/null 2>&1; then
+ echo "$func() prototype found.";
+ val="$define";
+else
+ echo "$func() prototype NOT found.";
+ val="$undef";
+fi;
+set $varname;
+eval $setvar;
+$rm -f try.c tryout.c'
+
+: see if this is a netdb.h system
+set netdb.h i_netdb
+eval $inhdr
+
+: see if prototypes for various gethostxxx netdb.h functions are available
+echo " "
+set d_gethostprotos gethostent $i_netdb netdb.h
+eval $hasproto
+
: see if getlogin exists
set getlogin d_getlogin
eval $inlibc
+: see if getnetbyaddr exists
+set getnetbyaddr d_getnbyaddr
+eval $inlibc
+
+: see if getnetbyname exists
+set getnetbyname d_getnbyname
+eval $inlibc
+
+: see if getnetent exists
+set getnetent d_getnent
+eval $inlibc
+
+: see if prototypes for various getnetxxx netdb.h functions are available
+echo " "
+set d_getnetprotos getnetent $i_netdb netdb.h
+eval $hasproto
+
+
+: see if getprotobyname exists
+set getprotobyname d_getpbyname
+eval $inlibc
+
+: see if getprotobynumber exists
+set getprotobynumber d_getpbynumber
+eval $inlibc
+
+: see if getprotoent exists
+set getprotoent d_getpent
+eval $inlibc
+
+: see if this is a mntent.h system
+set mntent.h i_mntent
+eval $inhdr
+
+: see if getmntent exists
+set getmntent d_getmntent
+eval $inlibc
+
+: see if hasmntopt exists
+set hasmntopt d_hasmntopt
+eval $inlibc
+
: see if getpgid exists
set getpgid d_getpgid
eval $inlibc
@@ -6643,6 +7376,28 @@ eval $inlibc
set getpriority d_getprior
eval $inlibc
+: see if prototypes for various getprotoxxx netdb.h functions are available
+echo " "
+set d_getprotoprotos getprotoent $i_netdb netdb.h
+eval $hasproto
+
+: see if getservbyname exists
+set getservbyname d_getsbyname
+eval $inlibc
+
+: see if getservbyport exists
+set getservbyport d_getsbyport
+eval $inlibc
+
+: see if getservent exists
+set getservent d_getsent
+eval $inlibc
+
+: see if prototypes for various getservxxx netdb.h functions are available
+echo " "
+set d_getservprotos getservent $i_netdb netdb.h
+eval $hasproto
+
: see if gettimeofday or ftime exists
set gettimeofday d_gettimeod
eval $inlibc
@@ -6666,6 +7421,10 @@ esac
set netinet/in.h i_niin sys/in.h i_sysin
eval $inhdr
+: see if arpa/inet.h has to be included
+set arpa/inet.h i_arpainet
+eval $inhdr
+
: see if htonl --and friends-- exists
val=''
set htonl val
@@ -6679,12 +7438,16 @@ $undef)
#include <sys/types.h>
#$i_niin I_NETINET_IN
#$i_sysin I_SYS_IN
+#$i_arpainet I_ARPA_INET
#ifdef I_NETINET_IN
#include <netinet/in.h>
#endif
#ifdef I_SYS_IN
#include <sys/in.h>
#endif
+#ifdef I_ARPA_INET
+#include <arpa/inet.h>
+#endif
#ifdef htonl
printf("Defined as a macro.");
#endif
@@ -6764,7 +7527,7 @@ echo " "
$cat >isascii.c <<'EOCP'
#include <stdio.h>
#include <ctype.h>
-main() {
+int main() {
int c = 'A';
if (isascii(c))
exit(0);
@@ -6772,7 +7535,8 @@ main() {
exit(1);
}
EOCP
-if $cc $ccflags $ldflags -o isascii isascii.c $libs >/dev/null 2>&1 ; then
+set isascii
+if eval $compile; then
echo "isascii() found." >&4
val="$define"
else
@@ -6787,6 +7551,38 @@ $rm -f isascii*
set killpg d_killpg
eval $inlibc
+: see if lchown exists
+echo " "
+$cat > try.c <<'EOCP'
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char lchown(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char lchown();
+int main() {
+ /* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_lchown) || defined (__stub___lchown)
+choke me
+#else
+lchown();
+#endif
+; return 0; }
+EOCP
+set try
+if eval $compile; then
+ $echo "lchown() found." >&4
+ val="$define"
+else
+ $echo "lchown() NOT found." >&4
+ val="$undef"
+fi
+set d_lchown
+eval $setvar
+
: see if link exists
set link d_link
eval $inlibc
@@ -6799,6 +7595,98 @@ eval $inlibc
set lockf d_lockf
eval $inlibc
+: check for long doubles
+echo " "
+echo $n "Checking to see if your system supports long doubles...$c" >&4
+echo 'long double foo() { long double x; x = 7.0; return x; }' > try.c
+if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then
+ val="$define"
+ echo " Yup, it does." >&4
+else
+ val="$undef"
+ echo " Nope, it doesn't." >&4
+fi
+$rm try.*
+set d_longdbl
+eval $setvar
+
+: check for length of long double
+case "${d_longdbl}${longdblsize}" in
+$define)
+ echo " "
+ $echo $n "Checking to see how big your long doubles are...$c" >&4
+ $cat >try.c <<'EOCP'
+#include <stdio.h>
+int main()
+{
+ printf("%d\n", sizeof(long double));
+}
+EOCP
+ set try
+ if eval $compile; then
+ longdblsize=`./try`
+ $echo " $longdblsize bytes." >&4
+ 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.c try
+
+: check for long long
+echo " "
+echo $n "Checking to see if your system supports long long...$c" >&4
+echo 'long long foo() { long long x; x = 7; return x; }' > try.c
+if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then
+ val="$define"
+ echo " Yup, it does." >&4
+else
+ val="$undef"
+ echo " Nope, it doesn't." >&4
+fi
+$rm try.*
+set d_longlong
+eval $setvar
+
+: check for length of long long
+case "${d_longlong}${longlongsize}" in
+$define)
+ echo " "
+ $echo $n "Checking to see how big your long longs are...$c" >&4
+ $cat >try.c <<'EOCP'
+#include <stdio.h>
+int main()
+{
+ printf("%d\n", sizeof(long long));
+}
+EOCP
+ set try
+ if eval $compile_ok; then
+ longlongsize=`./try`
+ $echo " $longlongsize bytes." >&4
+ else
+ dflt='8'
+ echo " "
+ echo "(I can't seem to compile the test program. Guessing...)"
+ rp="What is the size of a long long (in bytes)?"
+ . ./myread
+ longlongsize="$ans"
+ fi
+ if $test "X$longsize" = "X$longlongsize"; then
+ echo "(That isn't any different from an ordinary long.)"
+ fi
+ ;;
+esac
+$rm -f try.c try
+
: see if lstat exists
set lstat d_lstat
eval $inlibc
@@ -6865,6 +7753,25 @@ echo " "
case "$d_msgctl$d_msgget$d_msgsnd$d_msgrcv" in
*"$undef"*) h_msg=false;;
esac
+case "$osname" in
+freebsd)
+ case "`ipcs 2>&1`" in
+ "SVID messages"*"not configured"*)
+ echo "Your $osname does not have the msg*(2) configured." >&4
+ h_msg=false
+ val="$undef"
+ set msgctl d_msgctl
+ eval $setvar
+ set msgget d_msgget
+ eval $setvar
+ set msgsnd d_msgsnd
+ eval $setvar
+ set msgrcv d_msgrcv
+ eval $setvar
+ ;;
+ esac
+ ;;
+esac
: we could also check for sys/ipc.h ...
if $h_msg && $test `./findhdr sys/msg.h`; then
echo "You have the full msg*(2) library." >&4
@@ -6876,91 +7783,6 @@ fi
set d_msg
eval $setvar
-: see if this is a malloc.h system
-set malloc.h i_malloc
-eval $inhdr
-
-: see if stdlib is available
-set stdlib.h i_stdlib
-eval $inhdr
-
-: determine which malloc to compile in
-echo " "
-case "$usemymalloc" in
-''|y*|true) dflt='y' ;;
-n*|false) dflt='n' ;;
-*) dflt="$usemymalloc" ;;
-esac
-rp="Do you wish to attempt to use the malloc that comes with $package?"
-. ./myread
-usemymalloc="$ans"
-case "$ans" in
-y*|true)
- usemymalloc='y'
- mallocsrc='malloc.c'
- mallocobj='malloc.o'
- d_mymalloc="$define"
- case "$libs" in
- *-lmalloc*)
- : Remove malloc from list of libraries to use
- echo "Removing unneeded -lmalloc from library list" >&4
- set `echo X $libs | $sed -e 's/-lmalloc / /' -e 's/-lmalloc$//'`
- shift
- libs="$*"
- echo "libs = $libs" >&4
- ;;
- esac
- ;;
-*)
- usemymalloc='n'
- mallocsrc=''
- mallocobj=''
- d_mymalloc="$undef"
- ;;
-esac
-
-: compute the return types of malloc and free
-echo " "
-$cat >malloc.c <<END
-#$i_malloc I_MALLOC
-#$i_stdlib I_STDLIB
-#include <stdio.h>
-#include <sys/types.h>
-#ifdef I_MALLOC
-#include <malloc.h>
-#endif
-#ifdef I_STDLIB
-#include <stdlib.h>
-#endif
-#ifdef TRY_MALLOC
-void *malloc();
-#endif
-#ifdef TRY_FREE
-void free();
-#endif
-END
-case "$malloctype" in
-'')
- if $cc $ccflags -c -DTRY_MALLOC malloc.c >/dev/null 2>&1; then
- malloctype='void *'
- else
- malloctype='char *'
- fi
- ;;
-esac
-echo "Your system wants malloc to return '$malloctype', it would seem." >&4
-
-case "$freetype" in
-'')
- if $cc $ccflags -c -DTRY_FREE malloc.c >/dev/null 2>&1; then
- freetype='void'
- else
- freetype='int'
- fi
- ;;
-esac
-echo "Your system uses $freetype free(), it would seem." >&4
-$rm -f malloc.[co]
: see if nice exists
set nice d_nice
eval $inlibc
@@ -6977,12 +7799,108 @@ eval $inlibc
set poll d_poll
eval $inlibc
+
+: see whether the various POSIXish _yields exist
+$cat >try.c <<EOP
+#include <pthread.h>
+int main() {
+ YIELD();
+ exit(0);
+}
+EOP
+: see if pthread_yield exists within given cccmd,
+: if we do not usethreads this may well end up undef.
+set try -DYIELD=pthread_yield
+if eval $compile; then
+ val="$define"
+ echo 'pthread_yield() found.' >&4
+else
+ val="$undef"
+ echo 'pthread_yield() NOT found.' >&4
+fi
+set d_pthread_yield
+eval $setvar
+
+: see if sched_yield exists within given cccmd,
+: if we do not usethreads this may well end up undef.
+set try -DYIELD=sched_yield
+if eval $compile; then
+ val="$define"
+ echo 'sched_yield() found.' >&4
+else
+ val="$undef"
+ echo 'sched_yield() NOT found.' >&4
+fi
+set d_sched_yield
+eval $setvar
+$rm -f try try.*
+
+: see if this is a pthread.h system
+set pthread.h i_pthread
+eval $inhdr
+
+: see if this is a mach/cthreads.h system
+set mach/cthreads.h i_machcthreads
+eval $inhdr
+
+: test whether pthreads are created in joinable -- aka undetached -- state
+if test "X$usethreads" = "X$define" -a "X$i_pthread" = "X$define"; then
+ echo $n "Checking whether pthreads are created joinable. $c" >&4
+ $cat >try.c <<EOCP
+#include <pthread.h>
+#include <stdio.h>
+int main() {
+ pthread_attr_t attr;
+ int detachstate;
+ printf("%s\n",
+ pthread_attr_init(&attr) == 0 &&
+ pthread_attr_getdetachstate(&attr, &detachstate) == 0 &&
+ detachstate == PTHREAD_CREATE_DETACHED ?
+ "detached" : "joinable");
+ exit(0);
+}
+EOCP
+ set try
+ if eval $compile; then
+ yyy=`./try`
+ case "$yyy" in
+ detached) echo "Nope, they aren't." >&4 ;;
+ *) echo "Yup, they are." >&4 ;;
+ esac
+ else
+ echo " "
+ echo "(I can't execute the test program--assuming they are.)" >&4
+ yyy=joinable
+ fi
+ $rm -f try try.*
+ case "$yyy" in
+ detached) val="$undef" ;;
+ *) val="$define" ;;
+ esac
+ set d_pthreads_created_joinable
+ eval $setvar
+else
+ d_pthreads_created_joinable="$undef"
+fi
+
: see if this is a pwd.h system
set pwd.h i_pwd
eval $inhdr
case "$i_pwd" in
$define)
+ : see if setpwent exists
+ set setpwent d_setpwent
+ eval $inlibc
+
+ : see if getpwent exists
+ set getpwent d_getpwent
+ eval $inlibc
+
+ : see if endpwent exists
+ set endpwent d_endpwent
+ eval $inlibc
+
xxx=`./findhdr pwd.h`
$cppstdin $cppflags $cppminus < $xxx >$$.h
@@ -7034,16 +7952,37 @@ $define)
set d_pwcomment
eval $setvar
+ if $contains 'pw_gecos' $$.h >/dev/null 2>&1; then
+ val="$define"
+ else
+ val="$undef"
+ fi
+ set d_pwgecos
+ eval $setvar
+
+ if $contains 'pw_passwd' $$.h >/dev/null 2>&1; then
+ val="$define"
+ else
+ val="$undef"
+ fi
+ set d_pwpasswd
+ eval $setvar
+
$rm -f $$.h
;;
-*)
+*) # Assume all is lost as far as the d_*pw* go.
val="$undef";
+ set d_setpwent; eval $setvar
+ set d_getpwent; eval $setvar
+ set d_endpwent; eval $setvar
set d_pwquota; eval $setvar
set d_pwage; eval $setvar
set d_pwchange; eval $setvar
set d_pwclass; eval $setvar
set d_pwexpire; eval $setvar
set d_pwcomment; eval $setvar
+ set d_pwgecos; eval $setvar
+ set d_pwpasswd; eval $setvar
;;
esac
@@ -7099,15 +8038,14 @@ case "$d_bcopy" in
"$define")
echo " "
echo "Checking to see if your bcopy() can do overlapping copies..." >&4
- $cat >foo.c <<EOCP
+ $cat >try.c <<EOCP
#$i_memory I_MEMORY
#$i_stdlib I_STDLIB
#$i_string I_STRING
#$i_unistd I_UNISTD
EOCP
- $cat >>foo.c <<'EOCP'
+ $cat >>try.c <<'EOCP'
#include <stdio.h>
-
#ifdef I_MEMORY
# include <memory.h>
#endif
@@ -7122,7 +8060,7 @@ EOCP
#ifdef I_UNISTD
# include <unistd.h> /* Needed for NetBSD */
#endif
-main()
+int main()
{
char buf[128], abc[128];
char *b;
@@ -7130,8 +8068,6 @@ int len;
int off;
int align;
-/* Copy "abcde..." string to char abc[] so that gcc doesn't
- try to store the string in read-only memory. */
bcopy("abcdefghijklmnopqrstuvwxyz0123456789", abc, 36);
for (align = 7; align >= 0; align--) {
@@ -7149,9 +8085,9 @@ for (align = 7; align >= 0; align--) {
exit(0);
}
EOCP
- if $cc $optimize $ccflags $ldflags foo.c \
- -o safebcpy $libs >/dev/null 2>&1; then
- if ./safebcpy 2>/dev/null; then
+ set try
+ if eval $compile_ok; then
+ if ./try 2>/dev/null; then
echo "Yes, it can."
val="$define"
else
@@ -7168,7 +8104,7 @@ EOCP
fi
;;
esac
-$rm -f foo.* safebcpy core
+$rm -f try.* try core
set d_safebcpy
eval $setvar
@@ -7178,15 +8114,14 @@ case "$d_memcpy" in
"$define")
echo " "
echo "Checking to see if your memcpy() can do overlapping copies..." >&4
- $cat >foo.c <<EOCP
+ $cat >try.c <<EOCP
#$i_memory I_MEMORY
#$i_stdlib I_STDLIB
#$i_string I_STRING
#$i_unistd I_UNISTD
EOCP
- $cat >>foo.c <<'EOCP'
+ $cat >>try.c <<'EOCP'
#include <stdio.h>
-
#ifdef I_MEMORY
# include <memory.h>
#endif
@@ -7201,7 +8136,7 @@ EOCP
#ifdef I_UNISTD
# include <unistd.h> /* Needed for NetBSD */
#endif
-main()
+int main()
{
char buf[128], abc[128];
char *b;
@@ -7228,9 +8163,9 @@ for (align = 7; align >= 0; align--) {
exit(0);
}
EOCP
- if $cc $optimize $ccflags $ldflags foo.c \
- -o safemcpy $libs >/dev/null 2>&1; then
- if ./safemcpy 2>/dev/null; then
+ set try
+ if eval $compile_ok; then
+ if ./try 2>/dev/null; then
echo "Yes, it can."
val="$define"
else
@@ -7247,7 +8182,7 @@ EOCP
fi
;;
esac
-$rm -f foo.* safemcpy core
+$rm -f try.* try core
set d_safemcpy
eval $setvar
@@ -7256,16 +8191,15 @@ val="$undef"
case "$d_memcmp" in
"$define")
echo " "
- echo "Checking to see if your memcmp() can compare relative magnitude..." >&4
- $cat >foo.c <<EOCP
+ echo "Checking if your memcmp() can compare relative magnitude..." >&4
+ $cat >try.c <<EOCP
#$i_memory I_MEMORY
#$i_stdlib I_STDLIB
#$i_string I_STRING
#$i_unistd I_UNISTD
EOCP
- $cat >>foo.c <<'EOCP'
+ $cat >>try.c <<'EOCP'
#include <stdio.h>
-
#ifdef I_MEMORY
# include <memory.h>
#endif
@@ -7280,7 +8214,7 @@ EOCP
#ifdef I_UNISTD
# include <unistd.h> /* Needed for NetBSD */
#endif
-main()
+int main()
{
char a = -1;
char b = 0;
@@ -7289,9 +8223,9 @@ if ((a < b) && memcmp(&a, &b, 1) < 0)
exit(0);
}
EOCP
- if $cc $optimize $ccflags $ldflags foo.c \
- -o sanemcmp $libs >/dev/null 2>&1; then
- if ./sanemcmp 2>/dev/null; then
+ set try
+ if eval $compile_ok; then
+ if ./try 2>/dev/null; then
echo "Yes, it can."
val="$define"
else
@@ -7302,7 +8236,7 @@ EOCP
fi
;;
esac
-$rm -f foo.* sanemcmp core
+$rm -f try.* try core
set d_sanemcmp
eval $setvar
@@ -7328,6 +8262,23 @@ echo " "
case "$d_semctl$d_semget$d_semop" in
*"$undef"*) h_sem=false;;
esac
+case "$osname" in
+freebsd)
+ case "`ipcs 2>&1`" in
+ "SVID messages"*"not configured"*)
+ echo "Your $osname does not have the sem*(2) configured." >&4
+ h_sem=false
+ val="$undef"
+ set semctl d_semctl
+ eval $setvar
+ set semget d_semget
+ eval $setvar
+ set semop d_semop
+ eval $setvar
+ ;;
+ esac
+ ;;
+esac
: we could also check for sys/ipc.h ...
if $h_sem && $test `./findhdr sys/sem.h`; then
echo "You have the full sem*(2) library." >&4
@@ -7339,6 +8290,192 @@ fi
set d_sem
eval $setvar
+: see whether sys/sem.h defines union semun
+echo " "
+$cat > try.c <<'END'
+#include <sys/types.h>
+#include <sys/ipc.h>
+#include <sys/sem.h>
+int main () { union semun semun; semun.buf = 0; }
+END
+set try
+if eval $compile; then
+ echo "You have union semun in <sys/sem.h>." >&4
+ val="$define"
+else
+ echo "You do not have union semun in <sys/sem.h>." >&4
+ val="$undef"
+fi
+$rm -f try try.c
+set d_union_semun
+eval $setvar
+
+: see how to do semctl IPC_STAT
+case "$d_sem" in
+$define)
+ : see whether semctl IPC_STAT can use union semun
+ echo " "
+ $cat > try.h <<END
+#ifndef S_IRUSR
+# ifdef S_IREAD
+# define S_IRUSR S_IREAD
+# define S_IWUSR S_IWRITE
+# define S_IXUSR S_IEXEC
+# else
+# define S_IRUSR 0400
+# define S_IWUSR 0200
+# define S_IXUSR 0100
+# endif
+# define S_IRGRP (S_IRUSR>>3)
+# define S_IWGRP (S_IWUSR>>3)
+# define S_IXGRP (S_IXUSR>>3)
+# define S_IROTH (S_IRUSR>>6)
+# define S_IWOTH (S_IWUSR>>6)
+# define S_IXOTH (S_IXUSR>>6)
+#endif
+#ifndef S_IRWXU
+# define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR)
+# define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP)
+# define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH)
+#endif
+END
+
+ $cat > try.c <<END
+#include <sys/types.h>
+#include <sys/ipc.h>
+#include <sys/sem.h>
+#include <sys/stat.h>
+#include <stdio.h>
+#include <errno.h>
+#ifndef errno
+extern int errno;
+#endif
+#$d_union_semun HAS_UNION_SEMUN
+int main() {
+ union semun
+#ifndef HAS_UNION_SEMUN
+ {
+ int val;
+ struct semid_ds *buf;
+ unsigned short *array;
+ }
+#endif
+ arg;
+ int sem, st;
+
+#if defined(IPC_PRIVATE) && defined(S_IRWXU) && defined(S_IRWXG) && defined(S_IRWXO) && defined(IPC_CREAT)
+ sem = semget(IPC_PRIVATE, 1, S_IRWXU|S_IRWXG|S_IRWXO|IPC_CREAT);
+ if (sem > -1) {
+ struct semid_ds argbuf;
+ arg.buf = &argbuf;
+# ifdef IPC_STAT
+ st = semctl(sem, 0, IPC_STAT, arg);
+ if (st == 0)
+ printf("semun\n");
+ else
+# endif /* IPC_STAT */
+ printf("semctl IPC_STAT failed: errno = %d\n", errno);
+# ifdef IPC_RMID
+ if (semctl(sem, 0, IPC_RMID, arg) != 0)
+# endif /* IPC_RMID */
+ printf("semctl IPC_RMID failed: errno = %d\n", errno);
+ } else
+#endif /* IPC_PRIVATE && ... */
+ printf("semget failed: errno = %d\n", errno);
+ return 0;
+}
+END
+ val="$undef"
+ set try
+ if eval $compile; then
+ xxx=`./try`
+ case "$xxx" in
+ semun) val="$define" ;;
+ esac
+ fi
+ $rm -f try try.c
+ set d_semctl_semun
+ eval $setvar
+ case "$d_semctl_semun" in
+ $define)
+ echo "You can use union semun for semctl IPC_STAT." >&4
+ also='also '
+ ;;
+ *) echo "You cannot use union semun for semctl IPC_STAT." >&4
+ also=''
+ ;;
+ esac
+
+ : see whether semctl IPC_STAT can use struct semid_ds pointer
+ $cat > try.c <<'END'
+#include <sys/types.h>
+#include <sys/ipc.h>
+#include <sys/sem.h>
+#include <sys/stat.h>
+#include <stdio.h>
+#include <errno.h>
+#include "try.h"
+#ifndef errno
+extern int errno;
+#endif
+int main() {
+ struct semid_ds arg;
+ int sem, st;
+
+#if defined(IPC_PRIVATE) && defined(S_IRWXU) && defined(S_IRWXG) && defined(S_IRWXO) && defined(IPC_CREAT)
+ sem = semget(IPC_PRIVATE, 1, S_IRWXU|S_IRWXG|S_IRWXO|IPC_CREAT);
+ if (sem > -1) {
+# ifdef IPC_STAT
+ st = semctl(sem, 0, IPC_STAT, &arg);
+ if (st == 0)
+ printf("semid_ds\n");
+ else
+# endif /* IPC_STAT */
+ printf("semctl IPC_STAT failed: errno = %d\n", errno);
+# ifdef IPC_RMID
+ if (semctl(sem, 0, IPC_RMID, &arg) != 0)
+# endif /* IPC_RMID */
+ printf("semctl IPC_RMID failed: errno = %d\n", errno);
+ } else
+#endif /* IPC_PRIVATE && ... */
+ printf("semget failed: errno = %d\n", errno);
+
+ return 0;
+}
+END
+ val="$undef"
+ set try
+ if eval $compile; then
+ xxx=`./try`
+ case "$xxx" in
+ semid_ds) val="$define" ;;
+ esac
+ fi
+ $rm -f try try.c
+ set d_semctl_semid_ds
+ eval $setvar
+ case "$d_semctl_semid_ds" in
+ $define)
+ echo "You can ${also}use struct semid_ds* for semctl IPC_STAT." >&4
+ ;;
+ *) echo "You cannot use struct semid_ds* for semctl IPC_STAT." >&4
+ ;;
+ esac
+ $rm -f try.h
+ ;;
+*) val="$undef"
+
+ # We do not have the full sem*(2) library, so assume we can not
+ # use either.
+
+ set d_semctl_semun
+ eval $setvar
+
+ set d_semctl_semid_ds
+ eval $setvar
+ ;;
+esac
+
: see if setegid exists
set setegid d_setegid
eval $inlibc
@@ -7347,6 +8484,10 @@ eval $inlibc
set seteuid d_seteuid
eval $inlibc
+: see if sethostent exists
+set sethostent d_sethent
+eval $inlibc
+
: see if setlinebuf exists
set setlinebuf d_setlinebuf
eval $inlibc
@@ -7355,6 +8496,14 @@ eval $inlibc
set setlocale d_setlocale
eval $inlibc
+: see if setnetent exists
+set setnetent d_setnent
+eval $inlibc
+
+: see if setprotoent exists
+set setprotoent d_setpent
+eval $inlibc
+
: see if setpgid exists
set setpgid d_setpgid
eval $inlibc
@@ -7387,10 +8536,18 @@ eval $inlibc
set setruid d_setruid
eval $inlibc
+: see if setservent exists
+set setservent d_setsent
+eval $inlibc
+
: see if setsid exists
set setsid d_setsid
eval $inlibc
+: see if setvbuf exists
+set setvbuf d_setvbuf
+eval $inlibc
+
: see if sfio.h is available
set sfio.h i_sfio
eval $inhdr
@@ -7495,6 +8652,25 @@ echo " "
case "$d_shmctl$d_shmget$d_shmat$d_shmdt" in
*"$undef"*) h_shm=false;;
esac
+case "$osname" in
+freebsd)
+ case "`ipcs 2>&1`" in
+ "SVID shared memory"*"not configured"*)
+ echo "But your $osname does not have the shm*(2) configured." >&4
+ h_shm=false
+ val="$undef"
+ set shmctl d_shmctl
+ evat $setvar
+ set shmget d_shmget
+ evat $setvar
+ set shmat d_shmat
+ evat $setvar
+ set shmdt d_shmdt
+ evat $setvar
+ ;;
+ esac
+ ;;
+esac
: we could also check for sys/ipc.h ...
if $h_shm && $test `./findhdr sys/shm.h`; then
echo "You have the full shm*(2) library." >&4
@@ -7510,44 +8686,38 @@ echo " "
: see if we have sigaction
if set sigaction val -f d_sigaction; eval $csym; $val; then
echo 'sigaction() found.' >&4
- val="$define"
-else
- echo 'sigaction NOT found.' >&4
- val="$undef"
-fi
-
-$cat > set.c <<'EOP'
-/* Solaris 2.5_x86 with SunWorks Pro C 3.0.1 doesn't have a complete
- sigaction structure if compiled with cc -Xc. This compile test
- will fail then. <doughera@lafcol.lafayette.edu>
-*/
+ $cat > try.c <<'EOP'
#include <stdio.h>
#include <sys/types.h>
#include <signal.h>
-main()
+int main()
{
struct sigaction act, oact;
}
EOP
-
-if $cc $ccflags $ldflags -o set set.c $libs >/dev/null 2>&1; then
- :
+ set try
+ if eval $compile_ok; then
+ val="$define"
+ else
+ echo "But you don't seem to have a useable struct sigaction." >&4
+ val="$undef"
+ fi
else
- echo "But you don't seem to have a useable struct sigaction." >&4
+ echo 'sigaction NOT found.' >&4
val="$undef"
fi
set d_sigaction; eval $setvar
-$rm -f set set.o set.c
+$rm -f try try$_o try.c
: see if sigsetjmp exists
echo " "
case "$d_sigsetjmp" in
'')
- $cat >set.c <<'EOP'
+ $cat >try.c <<'EOP'
#include <setjmp.h>
sigjmp_buf env;
int set = 1;
-main()
+int main()
{
if (sigsetjmp(env,1))
exit(set);
@@ -7556,8 +8726,9 @@ main()
exit(1);
}
EOP
- if $cc $ccflags $ldflags -o set set.c $libs > /dev/null 2>&1 ; then
- if ./set >/dev/null 2>&1; then
+ set try
+ if eval $compile; then
+ if ./try >/dev/null 2>&1; then
echo "POSIX sigsetjmp found." >&4
val="$define"
else
@@ -7581,7 +8752,7 @@ EOM
esac
set d_sigsetjmp
eval $setvar
-$rm -f set.c set
+$rm -f try.c try
socketlib=''
sockethdr=''
@@ -7604,27 +8775,33 @@ else
: we will have to assume that it supports the 4.2 BSD interface
d_oldsock="$undef"
else
- echo "You don't have Berkeley networking in libc$lib_ext..." >&4
- if test -f /usr/lib/libnet$lib_ext; then
- ( (nm $nm_opt /usr/lib/libnet$lib_ext | eval $nm_extract) || \
- ar t /usr/lib/libnet$lib_ext) 2>/dev/null >> libc.list
- if $contains socket libc.list >/dev/null 2>&1; then
- echo "...but the Wollongong group seems to have hacked it in." >&4
- socketlib="-lnet"
- sockethdr="-I/usr/netinclude"
- d_socket="$define"
- if $contains setsockopt libc.list >/dev/null 2>&1; then
- d_oldsock="$undef"
- else
- echo "...using the old 4.1c interface, rather than 4.2" >&4
- d_oldsock="$define"
+ echo "You don't have Berkeley networking in libc$_a..." >&4
+ for net in net socket
+ do
+ if test -f /usr/lib/lib$net$_a; then
+ ( ($nm $nm_opt /usr/lib/lib$net$_a | eval $nm_extract) || \
+ $ar t /usr/lib/lib$net$_a) 2>/dev/null >> libc.list
+ if $contains socket libc.list >/dev/null 2>&1; then
+ d_socket="$define"
+ case "$net" in
+ net)
+ echo "...but the Wollongong group seems to have hacked it in." >&4
+ socketlib="-lnet"
+ sockethdr="-I/usr/netinclude"
+ ;;
+ esac
+ echo "Found Berkeley sockets interface in lib$net." >& 4
+ if $contains setsockopt libc.list >/dev/null 2>&1; then
+ d_oldsock="$undef"
+ else
+ echo "...using the old 4.1c interface, rather than 4.2" >&4
+ d_oldsock="$define"
+ fi
+ break
fi
- else
- echo "or even in libnet$lib_ext, which is peculiar." >&4
- d_socket="$undef"
- d_oldsock="$undef"
fi
- else
+ done
+ if test "X$d_socket" != "X$define"; then
echo "or anywhere else I see." >&4
d_socket="$undef"
d_oldsock="$undef"
@@ -7638,21 +8815,8 @@ eval $inlibc
: see if stat knows about block sizes
echo " "
-xxx=`./findhdr sys/stat.h`
-if $contains 'st_blocks;' "$xxx" >/dev/null 2>&1 ; then
- if $contains 'st_blksize;' "$xxx" >/dev/null 2>&1 ; then
- echo "Your stat() knows about block sizes." >&4
- val="$define"
- else
- echo "Your stat() doesn't know about block sizes." >&4
- val="$undef"
- fi
-else
- echo "Your stat() doesn't know about block sizes." >&4
- val="$undef"
-fi
-set d_statblks
-eval $setvar
+set d_statblks stat st_blocks $i_sysstat sys/stat.h
+eval $hasfield
: see if _ptr and _cnt from stdio act std
echo " "
@@ -7702,7 +8866,7 @@ $cat >try.c <<EOP
#include <stdio.h>
#define FILE_ptr(fp) $stdio_ptr
#define FILE_cnt(fp) $stdio_cnt
-main() {
+int main() {
FILE *fp = fopen("try.c", "r");
char c = getc(fp);
if (
@@ -7714,7 +8878,8 @@ main() {
}
EOP
val="$undef"
-if $cc $ccflags $ldflags -o try try.c $libs >/dev/null 2>&1; then
+set try
+if eval $compile; then
if ./try; then
echo "Your stdio acts pretty std."
val="$define"
@@ -7744,7 +8909,6 @@ esac
set d_stdio_cnt_lval
eval $setvar
-
: see if _base is also standard
val="$undef"
case "$d_stdstdio" in
@@ -7753,7 +8917,7 @@ $define)
#include <stdio.h>
#define FILE_base(fp) $stdio_base
#define FILE_bufsiz(fp) $stdio_bufsiz
-main() {
+int main() {
FILE *fp = fopen("try.c", "r");
char c = getc(fp);
if (
@@ -7764,7 +8928,8 @@ main() {
exit(1);
}
EOP
- if $cc $ccflags $ldflags -o try try.c $libs > /dev/null 2>&1; then
+ set try
+ if eval $compile; then
if ./try; then
echo "And its _base field acts std."
val="$define"
@@ -7788,7 +8953,7 @@ eval $inlibc
echo " "
echo "Checking to see if your C compiler can copy structs..." >&4
$cat >try.c <<'EOCP'
-main()
+int main()
{
struct blurfl {
int dyick;
@@ -7810,39 +8975,41 @@ $rm -f try.*
: see if strerror and/or sys_errlist[] exist
echo " "
-if set strerror val -f d_strerror; eval $csym; $val; then
+if test "X$d_strerror" = X -o "X$d_syserrlst" = X; then
+ if set strerror val -f d_strerror; eval $csym; $val; then
echo 'strerror() found.' >&4
d_strerror="$define"
d_strerrm='strerror(e)'
if set sys_errlist val -a d_syserrlst; eval $csym; $val; then
- echo "(You also have sys_errlist[], so we could roll our own strerror.)"
- d_syserrlst="$define"
+ echo "(You also have sys_errlist[], so we could roll our own strerror.)"
+ d_syserrlst="$define"
else
- echo "(Since you don't have sys_errlist[], sterror() is welcome.)"
- d_syserrlst="$undef"
+ echo "(Since you don't have sys_errlist[], sterror() is welcome.)"
+ d_syserrlst="$undef"
fi
-elif xxx=`./findhdr string.h`; test "$xxx" || xxx=`./findhdr strings.h`; \
+ elif xxx=`./findhdr string.h`; test "$xxx" || xxx=`./findhdr strings.h`; \
$contains '#[ ]*define.*strerror' "$xxx" >/dev/null 2>&1; then
echo 'strerror() found in string header.' >&4
d_strerror="$define"
d_strerrm='strerror(e)'
if set sys_errlist val -a d_syserrlst; eval $csym; $val; then
- echo "(Most probably, strerror() uses sys_errlist[] for descriptions.)"
- d_syserrlst="$define"
+ echo "(Most probably, strerror() uses sys_errlist[] for descriptions.)"
+ d_syserrlst="$define"
else
- echo "(You don't appear to have any sys_errlist[], how can this be?)"
- d_syserrlst="$undef"
+ echo "(You don't appear to have any sys_errlist[], how can this be?)"
+ d_syserrlst="$undef"
fi
-elif set sys_errlist val -a d_syserrlst; eval $csym; $val; then
+ elif set sys_errlist val -a d_syserrlst; eval $csym; $val; then
echo "strerror() not found, but you have sys_errlist[] so we'll use that." >&4
d_strerror="$undef"
d_syserrlst="$define"
d_strerrm='((e)<0||(e)>=sys_nerr?"unknown":sys_errlist[e])'
-else
+ else
echo 'strerror() and sys_errlist[] NOT found.' >&4
d_strerror="$undef"
d_syserrlst="$undef"
d_strerrm='"unknown"'
+ fi
fi
: see if strtod exists
@@ -7897,6 +9064,9 @@ case "$varval" in
for inc in $inclist; do
echo "#include <$inc>" >>temp.c;
done;
+ echo "#ifdef $type" >> temp.c;
+ echo "printf(\"We have $type\");" >> temp.c;
+ echo "#endif" >> temp.c;
$cppstdin $cppflags $cppminus < temp.c >temp.E 2>/dev/null;
if $contains $type temp.E >/dev/null 2>&1; then
eval "$var=\$type";
@@ -7907,6 +9077,37 @@ case "$varval" in
*) eval "$var=\$varval";;
esac'
+: define an is-a-typedef? function that prompts if the type is not available.
+typedef_ask='type=$1; var=$2; def=$3; shift; shift; shift; inclist=$@;
+case "$inclist" in
+"") inclist="sys/types.h";;
+esac;
+eval "varval=\$$var";
+case "$varval" in
+"")
+ $rm -f temp.c;
+ for inc in $inclist; do
+ echo "#include <$inc>" >>temp.c;
+ done;
+ echo "#ifdef $type" >> temp.c;
+ echo "printf(\"We have $type\");" >> temp.c;
+ echo "#endif" >> temp.c;
+ $cppstdin $cppflags $cppminus < temp.c >temp.E 2>/dev/null;
+ echo " " ;
+ echo "$rp" | $sed -e "s/What is/Looking for/" -e "s/?/./";
+ if $contains $type temp.E >/dev/null 2>&1; then
+ echo "$type found." >&4;
+ eval "$var=\$type";
+ else
+ echo "$type NOT found." >&4;
+ dflt="$def";
+ . ./myread ;
+ eval "$var=\$ans";
+ fi;
+ $rm -f temp.?;;
+*) eval "$var=\$varval";;
+esac'
+
: see if this is a sys/times.h system
set sys/times.h i_systimes
eval $inhdr
@@ -7920,13 +9121,9 @@ if set times val -f d_times; eval $csym; $val; then
case "$i_systimes" in
"$define") inc='sys/times.h';;
esac
+ rp="What is the type returned by times() on this system?"
set clock_t clocktype long stdio.h sys/types.h $inc
- eval $typedef
- dflt="$clocktype"
- echo " "
- rp="What type is returned by times() on this system?"
- . ./myread
- clocktype="$ans"
+ eval $typedef_ask
else
echo 'times() NOT found, hope that will do.' >&4
d_times="$undef"
@@ -8009,7 +9206,16 @@ $define)
false) dflt='n';;
*) dflt='y';;
esac
- rp="Some systems have problems with vfork(). Do you want to use it?"
+ cat <<'EOM'
+
+Perl can only use a vfork() that doesn't suffer from strict
+restrictions on calling functions or modifying global data in
+the child. For example, glibc-2.1 contains such a vfork()
+that is unsuitable. If your system provides a proper fork()
+call, chances are that you do NOT want perl to use vfork().
+
+EOM
+ rp="Do you still want to use vfork()?"
. ./myread
case "$ans" in
y|Y) ;;
@@ -8035,6 +9241,10 @@ eval $inhdr
set sys/ndir.h i_sysndir
eval $inhdr
+: see if sys/types.h has to be included
+set sys/types.h i_systypes
+eval $inhdr
+
: see if closedir exists
set closedir d_closedir
eval $inlibc
@@ -8047,7 +9257,11 @@ case "$d_closedir" in
#$i_dirent I_DIRENT /**/
#$i_sysdir I_SYS_DIR /**/
#$i_sysndir I_SYS_NDIR /**/
+#$i_systypes I_SYS_TYPES /**/
+#if defined(I_SYS_TYPES)
+#include <sys/types.h>
+#endif
#if defined(I_DIRENT)
#include <dirent.h>
#if defined(NeXT) && defined(I_SYS_DIR) /* NeXT needs dirent + sys/dir.h */
@@ -8068,7 +9282,8 @@ case "$d_closedir" in
#endif
int main() { return closedir(opendir(".")); }
EOM
- if $cc $ccflags $ldflags -o closedir closedir.c $libs > /dev/null 2>&1; then
+ set closedir
+ if eval $compile_ok; then
if ./closedir > /dev/null 2>&1 ; then
echo "Yes, it does."
val="$undef"
@@ -8092,7 +9307,7 @@ $rm -f closedir*
echo " "
echo 'Checking to see if your C compiler knows about "volatile"...' >&4
$cat >try.c <<'EOCP'
-main()
+int main()
{
typedef struct _goo_struct goo_struct;
goo_struct * volatile goo = ((goo_struct *)0);
@@ -8151,12 +9366,13 @@ struct foobar {
char foo;
double bar;
} try;
-main()
+int main()
{
printf("%d\n", (char *)&try.bar - (char *)&try.foo);
}
EOCP
- if $cc $ccflags try.c -o try >/dev/null 2>&1; then
+ set try
+ if eval $compile_ok; then
dflt=`./try`
else
dflt='8'
@@ -8185,7 +9401,7 @@ I'm now running the test program...
EOM
$cat >try.c <<'EOCP'
#include <stdio.h>
-main()
+int main()
{
int i;
union {
@@ -8204,7 +9420,8 @@ main()
}
EOCP
xxx_prompt=y
- if $cc $ccflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
+ set try
+ if eval $compile && ./try > /dev/null; then
dflt=`./try`
case "$dflt" in
[1-4][1-4][1-4][1-4]|12345678|87654321)
@@ -8245,11 +9462,11 @@ ACAT(Cir,cus)
EOCP
$cppstdin $cppflags $cppminus <cpp_stuff.c >cpp_stuff.out 2>&1
if $contains 'Circus' cpp_stuff.out >/dev/null 2>&1; then
- echo "Oh! Smells like ANSI's been here."
+ echo "Oh! Smells like ANSI's been here." >&4
echo "We can catify or stringify, separately or together!"
cpp_stuff=42
elif $contains 'Reiser' cpp_stuff.out >/dev/null 2>&1; then
- echo "Ah, yes! The good old days!"
+ echo "Ah, yes! The good old days!" >&4
echo "However, in the good old days we don't know how to stringify and"
echo "catify at the same time."
cpp_stuff=1
@@ -8268,7 +9485,7 @@ eval $inhdr
case "$i_db" in
$define)
- : Check db version. We can not use version 2.
+ : Check db version.
echo " "
echo "Checking Berkeley DB version ..." >&4
$cat >try.c <<EOCP
@@ -8279,15 +9496,41 @@ $define)
#include <sys/types.h>
#include <stdio.h>
#include <db.h>
-main()
+int main()
{
-#ifdef DB_VERSION_MAJOR /* DB version >= 2: not yet. */
- printf("You have Berkeley DB Version %d.%d\n",
- DB_VERSION_MAJOR, DB_VERSION_MINOR);
- printf("Perl currently only supports up to version 1.86.\n");
- exit(2);
+#ifdef DB_VERSION_MAJOR /* DB version >= 2 */
+ int Major, Minor, Patch ;
+ unsigned long Version ;
+ (void)db_version(&Major, &Minor, &Patch) ;
+ printf("You have Berkeley DB Version 2 or greater\n");
+
+ printf("db.h is from Berkeley DB Version %d.%d.%d\n",
+ DB_VERSION_MAJOR, DB_VERSION_MINOR, DB_VERSION_PATCH);
+ printf("libdb is from Berkeley DB Version %d.%d.%d\n",
+ Major, Minor, Patch) ;
+
+ /* check that db.h & libdb are compatible */
+ if (DB_VERSION_MAJOR != Major || DB_VERSION_MINOR != Minor || DB_VERSION_PATCH != Patch) {
+ printf("db.h and libdb are incompatible\n") ;
+ exit(3);
+ }
+
+ printf("db.h and libdb are compatible\n") ;
+
+ Version = DB_VERSION_MAJOR * 1000000 + DB_VERSION_MINOR * 1000
+ + DB_VERSION_PATCH ;
+
+ /* needs to be >= 2.3.4 */
+ if (Version < 2003004) {
+ /* if (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && DB_VERSION_PATCH < 5) { */
+ printf("but Perl needs Berkeley DB 2.3.4 or greater\n") ;
+ exit(2);
+ }
+
+ exit(0);
#else
#if defined(_DB_H_) && defined(BTREEMAGIC) && defined(HASHMAGIC)
+ printf("You have Berkeley DB Version 1\n");
exit(0); /* DB version < 2: the coast is clear. */
#else
exit(1); /* <db.h> not Berkeley DB? */
@@ -8295,8 +9538,9 @@ main()
#endif
}
EOCP
- if $cc $optimize $ccflags $ldflags -o try try.c $libs && ./try; then
- echo 'Looks OK. (Perl supports up to version 1.86).' >&4
+ set try
+ if eval $compile && ./try; then
+ echo 'Looks OK.' >&4
else
echo "I can't use Berkeley DB with your <db.h>. I'll disable Berkeley DB." >&4
i_db=$undef
@@ -8327,16 +9571,19 @@ define)
#endif
#include <sys/types.h>
#include <db.h>
+
+#ifndef DB_VERSION_MAJOR
u_int32_t hash_cb (ptr, size)
const void *ptr;
size_t size;
{
}
HASHINFO info;
-main()
+int main()
{
info.hash = hash_cb;
}
+#endif
EOCP
if $cc $ccflags -c try.c >try.out 2>&1 ; then
if $contains warning try.out >>/dev/null 2>&1 ; then
@@ -8347,6 +9594,7 @@ EOCP
else
: XXX Maybe we should just give up here.
db_hashtype=u_int32_t
+ $cat try.out >&4
echo "Help: I can't seem to compile the db test program." >&4
echo "Something's wrong, but I'll assume you use $db_hashtype." >&4
fi
@@ -8356,7 +9604,6 @@ EOCP
*) db_hashtype=u_int32_t
;;
esac
-
case "$i_db" in
define)
: Check the return type needed for prefix
@@ -8369,16 +9616,19 @@ define)
#endif
#include <sys/types.h>
#include <db.h>
+
+#ifndef DB_VERSION_MAJOR
size_t prefix_cb (key1, key2)
const DBT *key1;
const DBT *key2;
{
}
BTREEINFO info;
-main()
+int main()
{
info.prefix = prefix_cb;
}
+#endif
EOCP
if $cc $ccflags -c try.c >try.out 2>&1 ; then
if $contains warning try.out >>/dev/null 2>&1 ; then
@@ -8389,6 +9639,7 @@ EOCP
else
db_prefixtype='size_t'
: XXX Maybe we should just give up here.
+ $cat try.out >&4
echo "Help: I can't seem to compile the db test program." >&4
echo "Something's wrong, but I'll assume you use $db_prefixtype." >&4
fi
@@ -8402,15 +9653,6 @@ esac
: check for void type
echo " "
echo "Checking to see how well your C compiler groks the void type..." >&4
-echo " "
-$cat >&4 <<EOM
- Support flag bits are:
- 1: basic void declarations.
- 2: arrays of pointers to functions returning void.
- 4: operations between pointers to and addresses of void functions.
- 8: generic void pointers.
-EOM
-echo " "
case "$voidflags" in
'')
$cat >try.c <<'EOCP'
@@ -8435,11 +9677,11 @@ sub() {
#endif
exit(0);
}
-main() { sub(); }
+int main() { sub(); }
EOCP
if $cc $ccflags -c -DTRY=$defvoidused try.c >.out 2>&1 ; then
voidflags=$defvoidused
- echo "It appears to support void to the level $package wants ($defvoidused)."
+ echo "Good. It appears to support void to the level $package wants.">&4
if $contains warning .out >/dev/null 2>&1; then
echo "However, you might get some warnings that look like this:"
$cat .out
@@ -8483,10 +9725,15 @@ echo "Hmm, your compiler has some difficulty with void. Checking further..." >&4
fi
fi
esac
-: Only prompt user if support does not match the level we want
case "$voidflags" in
"$defvoidused") ;;
-*)
+*) $cat >&4 <<'EOM'
+ Support flag bits are:
+ 1: basic void declarations.
+ 2: arrays of pointers to functions returning void.
+ 4: operations between pointers to and addresses of void functions.
+ 8: generic void pointers.
+EOM
dflt="$voidflags";
rp="Your void support flags add up to what?"
. ./myread
@@ -8495,19 +9742,88 @@ case "$voidflags" in
esac
$rm -f try.* .out
-: see what type file positions are declared as in the library
-set fpos_t fpostype long stdio.h sys/types.h
-eval $typedef
+: check for length of double
echo " "
-dflt="$fpostype"
+case "$doublesize" in
+'')
+ $echo $n "Checking to see how big your double precision numbers are...$c" >&4
+ $cat >try.c <<'EOCP'
+#include <stdio.h>
+int main()
+{
+ printf("%d\n", sizeof(double));
+}
+EOCP
+ set try
+ if eval $compile_ok; then
+ doublesize=`./try`
+ $echo " $doublesize bytes." >&4
+ 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
+
+echo " "
+echo "Determining whether or not we are on an EBCDIC system..." >&4
+$cat >tebcdic.c <<EOM
+int main()
+{
+ if ('M'==0xd4) return 0;
+ return 1;
+}
+EOM
+val=$undef
+set tebcdic
+if eval $compile_ok; then
+ if ./tebcdic; then
+ echo "You have EBCDIC." >&4
+ val="$define"
+ else
+ echo "Nope, no EBCDIC. Assuming ASCII or some ISO Latin." >&4
+ fi
+else
+ echo "I'm unable to compile the test program." >&4
+ echo "I'll assume ASCII or some ISO Latin." >&4
+fi
+$rm -f tebcdic.c tebcdic
+set ebcdic
+eval $setvar
+
+: see what type file positions are declared as in the library
rp="What is the type for file position used by fsetpos()?"
-. ./myread
-fpostype="$ans"
+set fpos_t fpostype long stdio.h sys/types.h
+eval $typedef_ask
+
+: get csh whereabouts
+case "$csh" in
+'csh') val="$undef" ;;
+*) val="$define" ;;
+esac
+set d_csh
+eval $setvar
+: Respect a hint or command line value for full_csh.
+case "$full_csh" in
+'') full_csh=$csh ;;
+esac
: Store the full pathname to the sed program for use in the C program
full_sed=$sed
+: Store the full pathname to the ar program for use in the Makefile.SH
+: Respect a hint or command line value for full_ar.
+case "$full_ar" in
+'') full_ar=$ar ;;
+esac
+
: see what type gids are declared as in the kernel
+echo " "
+echo "Looking for the type for group ids returned by getgid()."
set gid_t gidtype xxx stdio.h sys/types.h
eval $typedef
case "$gidtype" in
@@ -8521,10 +9837,13 @@ xxx)
;;
*) dflt="$gidtype";;
esac
-echo " "
-rp="What is the type for group ids returned by getgid()?"
-. ./myread
-gidtype="$ans"
+case "$gidtype" in
+gid_t) echo "gid_t found." ;;
+*) rp="What is the type for group ids returned by getgid()?"
+ . ./myread
+ gidtype="$ans"
+ ;;
+esac
: see if getgroups exists
set getgroups d_getgrps
@@ -8534,6 +9853,7 @@ eval $inlibc
set setgroups d_setgrps
eval $inlibc
+
: Find type of 2nd arg to 'getgroups()' and 'setgroups()'
echo " "
case "$d_getgrps$d_setgrps" in
@@ -8543,11 +9863,11 @@ case "$d_getgrps$d_setgrps" in
*) dflt="$groupstype" ;;
esac
$cat <<EOM
-What is the type of the second argument to getgroups() and setgroups()?
+What type of pointer is the second argument to getgroups() and setgroups()?
Usually this is the same as group ids, $gidtype, but not always.
EOM
- rp='What type is the second argument to getgroups() and setgroups()?'
+ rp='What type pointer is the second argument to getgroups() and setgroups()?'
. ./myread
groupstype="$ans"
;;
@@ -8555,59 +9875,208 @@ EOM
esac
: see what type lseek is declared as in the kernel
+rp="What is the type used for lseek's offset on this system?"
set off_t lseektype long stdio.h sys/types.h
-eval $typedef
-echo " "
-dflt="$lseektype"
-rp="What type is lseek's offset on this system declared as?"
-. ./myread
-lseektype="$ans"
+eval $typedef_ask
echo " "
-case "$make" in
-'')
- make=`./loc make make $pth`
- case "$make" in
- /*) echo make is in $make. ;;
- ?:[\\/]*) echo make is in $make. ;;
- *) echo "I don't know where 'make' is, and my life depends on it." >&4
- echo "Go find a make program or fix your PATH setting!" >&4
- exit 1
- ;;
- esac
- ;;
-*) echo make is in $make. ;;
-esac
-
-$echo $n "Checking if your $make program sets \$(MAKE)... $c" >&4
+echo "Checking if your $make program sets \$(MAKE)..." >&4
case "$make_set_make" in
'')
$sed 's/^X //' > testmake.mak << 'EOF'
Xall:
-X @echo 'ac_maketemp="$(MAKE)"'
+X @echo 'maketemp="$(MAKE)"'
EOF
- : GNU make sometimes prints "make[1]: Entering...", which would confuse us.
case "`$make -f testmake.mak 2>/dev/null`" in
- *ac_maketemp=*) make_set_make='#' ;;
+ *maketemp=*) make_set_make='#' ;;
*) make_set_make="MAKE=$make" ;;
esac
$rm -f testmake.mak
;;
esac
case "$make_set_make" in
-'#') echo "Yup, it does." >&4 ;;
-*) echo "Nope, it doesn't." >&4 ;;
+'#') echo "Yup, it does.";;
+*) echo "Nope, it doesn't.";;
esac
: see what type is used for mode_t
+rp="What is the type used for file modes for system calls (e.g. fchmod())?"
set mode_t modetype int stdio.h sys/types.h
-eval $typedef
-dflt="$modetype"
-echo " "
-rp="What type is used for file modes?"
-. ./myread
-modetype="$ans"
+eval $typedef_ask
+
+: define a fucntion to check prototypes
+$cat > protochk <<EOSH
+$startsh
+cc="$cc"
+optimize="$optimize"
+ccflags="$ccflags"
+prototype="$prototype"
+define="$define"
+rm=$rm
+EOSH
+
+$cat >> protochk <<'EOSH'
+
+$rm -f try.c
+foo="$1"
+shift
+while test $# -ge 2; do
+ case "$1" in
+ $define) echo "#include <$2>" >> try.c ;;
+ literal) echo "$2" >> try.c ;;
+ esac
+ shift 2
+done
+test "$prototype" = "$define" && echo '#define CAN_PROTOTYPE' >> try.c
+cat >> try.c <<'EOCP'
+#ifdef CAN_PROTOTYPE
+#define _(args) args
+#else
+#define _(args) ()
+#endif
+EOCP
+echo "$foo" >> try.c
+echo 'int no_real_function_has_this_name _((void)) { return 0; }' >> try.c
+$cc $optimize $ccflags -c try.c > /dev/null 2>&1
+status=$?
+$rm -f try.[co]
+exit $status
+EOSH
+chmod +x protochk
+$eunicefix protochk
+
+: see what type is used for size_t
+rp="What is the type used for the length parameter for string functions?"
+set size_t sizetype 'unsigned int' stdio.h sys/types.h
+eval $typedef_ask
+
+: check for type of arguments to gethostbyaddr.
+if test "X$netdb_host_type" = X -o "X$netdb_hlen_type" = X; then
+ case "$d_gethbyaddr" in
+ $define)
+ $cat <<EOM
+
+Checking to see what type of arguments are accepted by gethostbyaddr().
+EOM
+ hdrs="$define sys/types.h
+ $d_socket sys/socket.h
+ $i_niin netinet/in.h
+ $i_netdb netdb.h
+ $i_unistd unistd.h"
+ : The first arg can 'char *' or 'void *'
+ : The second arg is some of integral type
+ for xxx in in_addr_t 'const void *' 'const char *' 'void *' 'char *'; do
+ for yyy in size_t long int; do
+ case "$netdb_host_type" in
+ '') try="extern struct hostent *gethostbyaddr($xxx, $yyy, int);"
+ if ./protochk "$try" $hdrs; then
+ echo "Your system accepts $xxx for the first arg."
+ echo "...and $yyy for the second arg."
+ netdb_host_type="$xxx"
+ netdb_hlen_type="$yyy"
+ fi
+ ;;
+ esac
+ done
+ done
+ : In case none of those worked, prompt the user.
+ case "$netdb_host_type" in
+ '') rp='What is the type for the 1st argument to gethostbyaddr?'
+ dflt='char *'
+ . ./myread
+ netdb_host_type=$ans
+ rp='What is the type for the 2nd argument to gethostbyaddr?'
+ dflt="$sizetype"
+ . ./myread
+ netdb_hlen_type=$ans
+ ;;
+ esac
+ ;;
+ *) : no gethostbyaddr, so pick harmless defaults
+ netdb_host_type='char *'
+ netdb_hlen_type="$sizetype"
+ ;;
+ esac
+ # Remove the "const" if needed. -- but then we'll have a
+ # prototype clash!
+ # netdb_host_type=`echo "$netdb_host_type" | sed 's/^const //'`
+fi
+
+: check for type of argument to gethostbyname.
+if test "X$netdb_name_type" = X ; then
+ case "$d_gethbyname" in
+ $define)
+ $cat <<EOM
+
+Checking to see what type of argument is accepted by gethostbyname().
+EOM
+ hdrs="$define sys/types.h
+ $d_socket sys/socket.h
+ $i_niin netinet/in.h
+ $i_netdb netdb.h
+ $i_unistd unistd.h"
+ for xxx in "const char *" "char *"; do
+ case "$netdb_name_type" in
+ '') try="extern struct hostent *gethostbyname($xxx);"
+ if ./protochk "$try" $hdrs; then
+ echo "Your system accepts $xxx."
+ netdb_name_type="$xxx"
+ fi
+ ;;
+ esac
+ done
+ : In case none of those worked, prompt the user.
+ case "$netdb_name_type" in
+ '') rp='What is the type for the 1st argument to gethostbyname?'
+ dflt='char *'
+ . ./myread
+ netdb_name_type=$ans
+ ;;
+ esac
+ ;;
+ *) : no gethostbyname, so pick harmless default
+ netdb_name_type='char *'
+ ;;
+ esac
+fi
+: check for type of 1st argument to getnetbyaddr.
+if test "X$netdb_net_type" = X ; then
+ case "$d_getnbyaddr" in
+ $define)
+ $cat <<EOM
+
+Checking to see what type of 1st argument is accepted by getnetbyaddr().
+EOM
+ hdrs="$define sys/types.h
+ $d_socket sys/socket.h
+ $i_niin netinet/in.h
+ $i_netdb netdb.h
+ $i_unistd unistd.h"
+ for xxx in in_addr_t "unsigned long" long "unsigned int" int; do
+ case "$netdb_net_type" in
+ '') try="extern struct netent *getnetbyaddr($xxx, int);"
+ if ./protochk "$try" $hdrs; then
+ echo "Your system accepts $xxx."
+ netdb_net_type="$xxx"
+ fi
+ ;;
+ esac
+ done
+ : In case none of those worked, prompt the user.
+ case "$netdb_net_type" in
+ '') rp='What is the type for the 1st argument to getnetbyaddr?'
+ dflt='long'
+ . ./myread
+ netdb_net_type=$ans
+ ;;
+ esac
+ ;;
+ *) : no getnetbyaddr, so pick harmless default
+ netdb_net_type='long'
+ ;;
+ esac
+fi
: locate the preferred pager for this system
case "$pager" in
'')
@@ -8633,23 +10102,43 @@ rp='What pager is used on your system?'
. ./getfile
pager="$ans"
-: Cruising for prototypes
+: see what type pids are declared as in the kernel
+rp="What is the type of process ids on this system?"
+set pid_t pidtype int stdio.h sys/types.h
+eval $typedef_ask
+
+: check for length of pointer
echo " "
-echo "Checking out function prototypes..." >&4
-$cat >prototype.c <<'EOCP'
-main(int argc, char *argv[]) {
- exit(0);}
+case "$ptrsize" in
+'')
+ $echo $n "Checking to see how big your pointers are...$c" >&4
+ if test "$voidflags" -gt 7; then
+ echo '#define VOID_PTR char *' > try.c
+ else
+ echo '#define VOID_PTR void *' > try.c
+ fi
+ $cat >>try.c <<'EOCP'
+#include <stdio.h>
+int main()
+{
+ printf("%d\n", sizeof(VOID_PTR));
+ exit(0);
+}
EOCP
-if $cc $ccflags -c prototype.c >prototype.out 2>&1 ; then
- echo "Your C compiler appears to support function prototypes."
- val="$define"
-else
- echo "Your C compiler doesn't seem to understand function prototypes."
- val="$undef"
-fi
-set prototype
-eval $setvar
-$rm -f prototype*
+ set try
+ if eval $compile_ok; then
+ ptrsize=`./try`
+ $echo " $ptrsize bytes." >&4
+ else
+ dflt='4'
+ echo "(I can't seem to compile the test program. Guessing...)" >&4
+ rp="What is the size of a pointer (in bytes)?"
+ . ./myread
+ ptrsize="$ans"
+ fi
+ ;;
+esac
+$rm -f try.c try
: check for size of random number generator
echo " "
@@ -8668,7 +10157,7 @@ case "$randbits" in
#endif
EOCP
$cat >>try.c <<'EOCP'
-main()
+int main()
{
register int i;
register unsigned long tmp;
@@ -8681,11 +10170,11 @@ main()
for (i = 0; max; i++)
max /= 2;
printf("%d\n",i);
- fflush(stdout);
}
EOCP
- if $cc $ccflags $ldflags -o try try.c $libs >/dev/null 2>&1 ; then
- dflt=`try`
+ set try
+ if eval $compile_ok; then
+ dflt=`./try$_exe`
else
dflt='?'
echo "(I can't seem to compile the test program...)"
@@ -8698,7 +10187,7 @@ esac
rp='How many bits does your rand() function produce?'
. ./myread
randbits="$ans"
-$rm -f try.c try.o try
+$rm -f try.* try
: see if ar generates random libraries by itself
echo " "
@@ -8706,23 +10195,23 @@ echo "Checking how to generate random libraries on your machine..." >&4
echo 'int bar1() { return bar2(); }' > bar1.c
echo 'int bar2() { return 2; }' > bar2.c
$cat > foo.c <<'EOP'
-main() { printf("%d\n", bar1()); exit(0); }
+int main() { printf("%d\n", bar1()); exit(0); }
EOP
$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$lib_ext bar2.o bar1.o >/dev/null 2>&1
-if $cc $ccflags $ldflags -o foobar foo.o bar$lib_ext $libs > /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 &&
./foobar >/dev/null 2>&1; then
- echo "ar appears to generate random libraries itself."
+ echo "$ar appears to generate random libraries itself."
orderlib=false
ranlib=":"
-elif ar ts bar$lib_ext >/dev/null 2>&1 &&
- $cc $ccflags $ldflags -o foobar foo.o bar$lib_ext $libs > /dev/null 2>&1 &&
+elif $ar ts bar$_a >/dev/null 2>&1 &&
+ $cc $ccflags $ldflags -o foobar 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'."
+ echo "a table of contents needs to be added with '$ar ts'."
orderlib=false
- ranlib="ar ts"
+ ranlib="$ar ts"
else
case "$ranlib" in
:) ranlib='';;
@@ -8749,9 +10238,10 @@ eval $inhdr
: see if we should include time.h, sys/time.h, or both
echo " "
-echo "Testing to see if we should include <time.h>, <sys/time.h> or both." >&4
-$echo $n "I'm now running the test program...$c"
-$cat >try.c <<'EOCP'
+if test "X$timeincl" = X; then
+ echo "Testing to see if we should include <time.h>, <sys/time.h> or both." >&4
+ $echo $n "I'm now running the test program...$c"
+ $cat >try.c <<'EOCP'
#include <sys/types.h>
#ifdef I_TIME
#include <time.h>
@@ -8765,7 +10255,7 @@ $cat >try.c <<'EOCP'
#ifdef I_SYSSELECT
#include <sys/select.h>
#endif
-main()
+int main()
{
struct tm foo;
#ifdef S_TIMEVAL
@@ -8783,19 +10273,18 @@ main()
exit(1);
}
EOCP
-flags=''
-for s_timezone in '-DS_TIMEZONE' ''; do
-sysselect=''
-for s_timeval in '-DS_TIMEVAL' ''; do
-for i_systimek in '' '-DSYSTIMEKERNEL'; do
-for i_time in '' '-DI_TIME'; do
-for i_systime in '-DI_SYSTIME' ''; do
+ flags=''
+ for s_timezone in '-DS_TIMEZONE' ''; do
+ sysselect=''
+ for s_timeval in '-DS_TIMEVAL' ''; do
+ for i_systimek in '' '-DSYSTIMEKERNEL'; do
+ for i_time in '' '-DI_TIME'; do
+ for i_systime in '-DI_SYSTIME' ''; do
case "$flags" in
'') $echo $n ".$c"
- if $cc $ccflags \
- $i_time $i_systime $i_systimek $sysselect $s_timeval $s_timezone \
- try.c -o try >/dev/null 2>&1 ; then
- set X $i_time $i_systime $i_systimek $sysselect $s_timeval
+ set try $i_time $i_systime $i_systimek $sysselect $s_timeval $s_timezone
+ if eval $compile; then
+ set X $i_time $i_systime $i_systimek $sysselect $s_timeval
shift
flags="$*"
echo " "
@@ -8803,32 +10292,33 @@ for i_systime in '-DI_SYSTIME' ''; do
fi
;;
esac
-done
-done
-done
-done
-done
-timeincl=''
-echo " "
-case "$flags" in
-*SYSTIMEKERNEL*) i_systimek="$define"
+ done
+ done
+ done
+ done
+ done
+ timeincl=''
+ echo " "
+ case "$flags" in
+ *SYSTIMEKERNEL*) i_systimek="$define"
timeincl=`./findhdr sys/time.h`
echo "We'll include <sys/time.h> with KERNEL defined." >&4;;
-*) i_systimek="$undef";;
-esac
-case "$flags" in
-*I_TIME*) i_time="$define"
+ *) i_systimek="$undef";;
+ esac
+ case "$flags" in
+ *I_TIME*) i_time="$define"
timeincl=`./findhdr time.h`" $timeincl"
echo "We'll include <time.h>." >&4;;
-*) i_time="$undef";;
-esac
-case "$flags" in
-*I_SYSTIME*) i_systime="$define"
+ *) i_time="$undef";;
+ esac
+ case "$flags" in
+ *I_SYSTIME*) i_systime="$define"
timeincl=`./findhdr sys/time.h`" $timeincl"
echo "We'll include <sys/time.h>." >&4;;
-*) i_systime="$undef";;
-esac
-$rm -f try.c try
+ *) i_systime="$undef";;
+ esac
+ $rm -f try.c try
+fi
: check for fd_set items
$cat <<EOM
@@ -8849,7 +10339,7 @@ $cat >fd_set.c <<EOCP
#ifdef I_SYS_SELECT
#include <sys/select.h>
#endif
-main() {
+int main() {
fd_set fds;
#ifdef TRYBITS
@@ -8863,7 +10353,8 @@ main() {
#endif
}
EOCP
-if $cc $ccflags -DTRYBITS fd_set.c -o fd_set >fd_set.out 2>&1 ; then
+set fd_set -DTRYBITS
+if eval $compile; then
d_fds_bits="$define"
d_fd_set="$define"
echo "Well, your system knows about the normal fd_set typedef..." >&4
@@ -8880,7 +10371,8 @@ else
$cat <<'EOM'
Hmm, your compiler has some difficulty with fd_set. Checking further...
EOM
- if $cc $ccflags fd_set.c -o fd_set >fd_set.out 2>&1 ; then
+ set fd_set
+ if eval $compile; then
d_fds_bits="$undef"
d_fd_set="$define"
echo "Well, your system has some sort of fd_set available..." >&4
@@ -8902,73 +10394,146 @@ EOM
fi
$rm -f fd_set*
-
-: check for type of arguments to select. This will only really
-: work if the system supports prototypes and provides one for
-: select.
-case "$d_select" in
-$define)
- : Make initial guess
- case "$selecttype" in
- ''|' ')
- case "$d_fd_set" in
- $define) xxx='fd_set *' ;;
- *) xxx='int *' ;;
+: check for type of arguments to select.
+case "$selecttype" in
+'') case "$d_select" in
+ $define)
+ $cat <<EOM
+Checking to see what type of arguments are accepted by select().
+EOM
+ hdrs="$define sys/types.h
+ $i_systime sys/time.h
+ $i_sysselct sys/select.h
+ $d_socket sys/socket.h"
+ : The first arg can be int, unsigned, or size_t
+ : The last arg may or may not be 'const'
+ val=''
+ : void pointer has been seen but using that
+ : breaks the selectminbits test
+ for xxx in 'fd_set *' 'int *'; do
+ for nfd in 'int' 'size_t' 'unsigned' 'unsigned long'; do
+ for tmo in 'struct timeval *' 'const struct timeval *'; do
+ case "$val" in
+ '') try="extern select _(($nfd, $xxx, $xxx, $xxx, $tmo));"
+ if ./protochk "$try" $hdrs; then
+ echo "Your system accepts $xxx."
+ val="$xxx"
+ fi
+ ;;
+ esac
+ done
+ done
+ done
+ case "$val" in
+ '') rp='What is the type for the 2nd, 3rd, and 4th arguments to select?'
+ case "$d_fd_set" in
+ $define) dflt="fd_set *" ;;
+ *) dflt="int *" ;;
+ esac
+ . ./myread
+ val=$ans
+ ;;
esac
+ selecttype="$val"
;;
- *) xxx="$selecttype"
+ *) : no select, so pick a harmless default
+ selecttype='int *'
;;
esac
- : backup guess
- case "$xxx" in
- 'fd_set *') yyy='int *' ;;
- 'int *') yyy='fd_set *' ;;
- esac
+ ;;
+esac
- $cat <<EOM
+: check for the select 'width'
+case "$selectminbits" in
+'') case "$d_select" in
+ $define)
+ $cat <<EOM
-Checking to see what type of arguments are expected by select().
+Checking to see on how many bits at a time your select() operates...
EOM
- $cat >try.c <<EOCP
-#$i_systime I_SYS_TIME
-#$i_sysselct I_SYS_SELECT
-#$d_socket HAS_SOCKET
+ $cat >try.c <<EOCP
#include <sys/types.h>
-#ifdef HAS_SOCKET
-#include <sys/socket.h> /* Might include <sys/bsdtypes.h> */
+#$i_time I_TIME
+#$i_systime I_SYS_TIME
+#$i_systimek I_SYS_TIME_KERNEL
+#ifdef I_TIME
+# include <time.h>
#endif
#ifdef I_SYS_TIME
-#include <sys/time.h>
+# ifdef I_SYS_TIME_KERNEL
+# define KERNEL
+# endif
+# include <sys/time.h>
+# ifdef I_SYS_TIME_KERNEL
+# undef KERNEL
+# endif
#endif
+#$i_sysselct I_SYS_SELECT
#ifdef I_SYS_SELECT
#include <sys/select.h>
#endif
-main()
-{
- int width;
- Select_fd_set_t readfds;
- Select_fd_set_t writefds;
- Select_fd_set_t exceptfds;
- struct timeval timeout;
- select(width, readfds, writefds, exceptfds, &timeout);
- exit(0);
+#include <stdio.h>
+$selecttype b;
+#define S sizeof(*(b))
+#define MINBITS 64
+#define NBYTES (S * 8 > MINBITS ? S : MINBITS/8)
+#define NBITS (NBYTES * 8)
+int main() {
+ char s[NBYTES];
+ struct timeval t;
+ int i;
+ FILE* fp;
+ int fd;
+
+ fclose(stdin);
+ fp = fopen("try.c", "r");
+ if (fp == 0)
+ exit(1);
+ fd = fileno(fp);
+ if (fd < 0)
+ exit(2);
+ b = ($selecttype)s;
+ for (i = 0; i < NBITS; i++)
+ FD_SET(i, b);
+ t.tv_sec = 0;
+ t.tv_usec = 0;
+ select(fd + 1, b, 0, 0, &t);
+ for (i = NBITS - 1; i > fd && FD_ISSET(i, b); i--);
+ printf("%d\n", i + 1);
+ return 0;
}
EOCP
- if $cc $ccflags -c -DSelect_fd_set_t="$xxx" try.c >/dev/null 2>&1 ; then
- selecttype="$xxx"
- echo "Your system uses $xxx for the arguments to select." >&4
- elif $cc $ccflags -c -DSelect_fd_set_t="$yyy" try.c >/dev/null 2>&1 ; then
- selecttype="$yyy"
- echo "Your system uses $yyy for the arguments to select." >&4
- else
- rp='What is the type for the 2nd, 3rd, and 4th arguments to select?'
- dflt="$xxx"
- . ./myread
- selecttype="$ans"
- fi
- $rm -f try.[co]
- ;;
-*) selecttype='int *'
+ set try
+ if eval $compile_ok; then
+ selectminbits=`./try`
+ case "$selectminbits" in
+ '') cat >&4 <<EOM
+Cannot figure out on how many bits at a time your select() operates.
+I'll play safe and guess it is 32 bits.
+EOM
+ selectminbits=32
+ bits="32 bits"
+ ;;
+ 1) bits="1 bit" ;;
+ *) bits="$selectminbits bits" ;;
+ esac
+ echo "Your select() operates on $bits at a time." >&4
+ else
+ rp='What is the minimum number of bits your select() operates on?'
+ case "$byteorder" in
+ 1234|12345678) dflt=32 ;;
+ *) dflt=1 ;;
+ esac
+ . ./myread
+ val=$ans
+ selectminbits="$val"
+ fi
+ $rm -f try.* try
+ ;;
+ *) : no select, so pick a harmless default
+ selectminbits='32'
+ ;;
+ esac
;;
esac
@@ -9003,9 +10568,10 @@ xxx="$xxx LOST PHONE PIPE POLL PROF PWR QUIT SEGV STKFLT STOP SYS TERM TRAP"
xxx="$xxx TSTP TTIN TTOU URG USR1 USR2 USR3 USR4 VTALRM"
xxx="$xxx WINCH WIND WINDOW XCPU XFSZ"
: generate a few handy files for later
-$cat > signal.c <<'EOP'
+$cat > signal.c <<'EOCP'
#include <sys/types.h>
#include <signal.h>
+#include <stdio.h>
int main() {
/* Strange style to avoid deeply-nested #if/#else/#endif */
@@ -9060,8 +10626,11 @@ int main() {
printf("NSIG %d\n", NSIG);
-EOP
-echo $xxx | $tr ' ' '\012' | $sort | $uniq | $awk '
+#ifndef JUST_NSIG
+
+EOCP
+
+echo $xxx | $tr ' ' $trnl | $sort | $uniq | $awk '
{
printf "#ifdef SIG"; printf $1; printf "\n"
printf "printf(\""; printf $1; printf " %%d\\n\",SIG";
@@ -9069,6 +10638,7 @@ echo $xxx | $tr ' ' '\012' | $sort | $uniq | $awk '
printf "#endif\n"
}
END {
+ printf "#endif /* JUST_NSIG */\n";
printf "}\n";
}
' >>signal.c
@@ -9105,42 +10675,95 @@ END {
EOP
$cat >signal_cmd <<EOS
$startsh
-$test -s signal.lst && exit 0
-if $cc $ccflags $ldflags signal.c -o signal >/dev/null 2>&1; then
- ./signal | $sort -n +1 | $uniq | $awk -f signal.awk >signal.lst
+if $test -s signal.lst; then
+ echo "Using your existing signal.lst file"
+ exit 0
+fi
+xxx="$xxx"
+EOS
+$cat >>signal_cmd <<'EOS'
+
+set signal
+if eval $compile_ok; then
+ ./signal$_exe | $sort -n +1 | $uniq | $awk -f signal.awk >signal.lst
else
- echo "(I can't seem be able to compile the test program -- Guessing)"
+ echo "(I can't seem be able to compile the whole test program)" >&4
+ echo "(I'll try it in little pieces.)" >&4
+ set signal -DJUST_NSIG
+ if eval $compile_ok; then
+ ./signal$_exe > signal.nsg
+ $cat signal.nsg
+ else
+ echo "I can't seem to figure out how many signals you have." >&4
+ echo "Guessing 50." >&4
+ echo 'NSIG 50' > signal.nsg
+ fi
+ : Now look at all the signal names, one at a time.
+ for xx in `echo $xxx | $tr ' ' $trnl | $sort | $uniq`; do
+ $cat > signal.c <<EOCP
+#include <sys/types.h>
+#include <signal.h>
+#include <stdio.h>
+int main() {
+printf("$xx %d\n", SIG${xx});
+return 0;
+}
+EOCP
+ set signal
+ if eval $compile; then
+ echo "SIG${xx} found."
+ ./signal$_exe >> signal.ls1
+ else
+ echo "SIG${xx} NOT found."
+ fi
+ done
+ if $test -s signal.ls1; then
+ $cat signal.nsg signal.ls1 |
+ $sort -n +1 | $uniq | $awk -f signal.awk >signal.lst
+ fi
+
+fi
+if $test -s signal.lst; then
+ :
+else
+ echo "(AAK! I can't compile the test programs -- Guessing)" >&4
echo 'kill -l' >signal
- set X \`csh -f <signal\`
+ set X `csh -f <signal`
$rm -f signal
shift
- case \$# in
+ case $# in
0) set HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM;;
esac
- echo \$@ | $tr ' ' '\012' | \
- $awk '{ printf \$1; printf " %d\n", ++s; }' >signal.lst
+ echo $@ | $tr ' ' $trnl | \
+ $awk '{ printf $1; printf " %d\n", ++s; }' >signal.lst
fi
-$rm -f signal.c signal signal.o
+$rm -f signal.c signal$_exe signal$_o signal.nsg signal.ls1
EOS
chmod a+x signal_cmd
$eunicefix signal_cmd
: generate list of signal names
echo " "
-case "$sig_name" in
-'') sig_num='' ;;
-esac
-case "$sig_num" in
-'') sig_name='' ;;
+case "$sig_name_init" in
+'') doinit=yes ;;
+*) case "$sig_num_init" in
+ ''|*,*) doinit=yes ;;
+ esac ;;
esac
-case "$sig_name" in
-'')
+case "$doinit" in
+yes)
echo "Generating a list of signal names and numbers..." >&4
- ./signal_cmd
+ . ./signal_cmd
sig_name=`$awk '{printf "%s ", $1}' signal.lst`
sig_name="ZERO $sig_name"
+ sig_name_init=`$awk 'BEGIN { printf "\"ZERO\", " }
+ { printf "\"%s\", ", $1 }
+ END { printf "0\n" }' signal.lst`
sig_num=`$awk '{printf "%d ", $2}' signal.lst`
sig_num="0 $sig_num"
+ sig_num_init=`$awk 'BEGIN { printf "0, " }
+ { printf "%d, ", $2}
+ END { printf "0\n"}' signal.lst`
;;
esac
echo "The following signals are available:"
@@ -9161,15 +10784,6 @@ echo $sig_name | $awk \
}'
$rm -f signal signal.c signal.awk signal.lst signal_cmd
-: see what type is used for size_t
-set size_t sizetype 'unsigned int' stdio.h sys/types.h
-eval $typedef
-dflt="$sizetype"
-echo " "
-rp="What type is used for the length parameter for string functions?"
-. ./myread
-sizetype="$ans"
-
: see what type is used for signed size_t
set ssize_t ssizetype int stdio.h sys/types.h
eval $typedef
@@ -9179,7 +10793,7 @@ $cat > ssize.c <<EOM
#include <sys/types.h>
#define Size_t $sizetype
#define SSize_t $dflt
-main()
+int main()
{
if (sizeof(Size_t) == sizeof(SSize_t))
printf("$dflt\n");
@@ -9187,23 +10801,16 @@ main()
printf("int\n");
else
printf("long\n");
- fflush(stdout);
exit(0);
}
EOM
echo " "
-# If $libs contains -lsfio, and sfio is mis-configured, then it
-# sometimes (apparently) runs and exits with a 0 status, but with no
-# output!. Thus we check with test -s whether we actually got any
-# output. I think it has to do with sfio's use of _exit vs. exit,
-# but I don't know for sure. --Andy Dougherty 1/27/97.
-if $cc $optimize $ccflags $ldflags -o ssize ssize.c $libs > /dev/null 2>&1 &&
- ./ssize > ssize.out 2>/dev/null && test -s ssize.out ; then
- ssizetype=`$cat ssize.out`
+set ssize
+if eval $compile_ok && ./ssize > /dev/null; then
+ ssizetype=`./ssize`
echo "I'll be using $ssizetype for functions returning a byte count." >&4
else
$cat >&4 <<EOM
-
Help! I can't compile and run the ssize_t test program: please enlighten me!
(This is probably a misconfiguration in your system or libraries, and
you really ought to fix it. Still, I'll try anyway.)
@@ -9216,7 +10823,7 @@ EOM
. ./myread
ssizetype="$ans"
fi
-$rm -f ssize ssize.[co] ssize.out
+$rm -f ssize ssize.*
: see what type of char stdio uses.
echo " "
@@ -9230,25 +10837,25 @@ fi
: see if time exists
echo " "
-if set time val -f d_time; eval $csym; $val; then
+if test "X$d_time" = X -o X"$timetype" = X; then
+ if set time val -f d_time; eval $csym; $val; then
echo 'time() found.' >&4
val="$define"
+ rp="What is the type returned by time() on this system?"
set time_t timetype long stdio.h sys/types.h
- eval $typedef
- dflt="$timetype"
- echo " "
- rp="What type is returned by time() on this system?"
- . ./myread
- timetype="$ans"
-else
+ eval $typedef_ask
+ else
echo 'time() not found, hope that will do.' >&4
val="$undef"
timetype='int';
+ fi
+ set d_time
+ eval $setvar
fi
-set d_time
-eval $setvar
: see what type uids are declared as in the kernel
+echo " "
+echo "Looking for the type for user ids returned by getuid()."
set uid_t uidtype xxx stdio.h sys/types.h
eval $typedef
case "$uidtype" in
@@ -9262,10 +10869,13 @@ xxx)
;;
*) dflt="$uidtype";;
esac
-echo " "
-rp="What is the type for user ids returned by getuid()?"
-. ./myread
-uidtype="$ans"
+case "$uidtype" in
+uid_t) echo "uid_t found." ;;
+*) rp="What is the type for user ids returned by getuid()?"
+ . ./myread
+ uidtype="$ans"
+ ;;
+esac
: see if dbm.h is available
: see if dbmclose exists
@@ -9354,6 +10964,42 @@ eval $setvar
set grp.h i_grp
eval $inhdr
+case "$i_grp" in
+$define)
+ : see if setgrent exists
+ set setgrent d_setgrent
+ eval $inlibc
+
+ : see if getgrent exists
+ set getgrent d_getgrent
+ eval $inlibc
+
+ : see if endgrent exists
+ set endgrent d_endgrent
+ eval $inlibc
+
+ xxx=`./findhdr grp.h`
+ $cppstdin $cppflags $cppminus < $xxx >$$.h
+
+ if $contains 'gr_passwd' $$.h >/dev/null 2>&1; then
+ val="$define"
+ else
+ val="$undef"
+ fi
+ set d_grpasswd
+ eval $setvar
+
+ $rm -f $$.h
+ ;;
+*) # Assume all is lost as far as the d_*gr* go.
+ val="$undef";
+ set d_setgrent; eval $setvar
+ set d_getgrent; eval $setvar
+ set d_endgrent; eval $setvar
+ set d_grpasswd; eval $setvar
+ ;;
+esac
+
: see if locale.h is available
set locale.h i_locale
eval $inhdr
@@ -9414,7 +11060,7 @@ eval $setvar
: get C preprocessor symbols handy
echo " "
$echo $n "Hmm... $c"
-echo $al | $tr ' ' '\012' >Cppsym.know
+echo $al | $tr ' ' $trnl >Cppsym.know
$cat <<EOSS >Cppsym
$startsh
case "\$1" in
@@ -9441,7 +11087,7 @@ esac
case \$# in
0) exit 1;;
esac
-echo \$* | $tr ' ' '\012' | $sed -e 's/\(.*\)/\\
+echo \$* | $tr ' ' '$trnl' | $sed -e 's/\(.*\)/\\
#ifdef \1\\
exit 0; _ _ _ _\1\\ \1\\
#endif\\
@@ -9463,12 +11109,16 @@ $eunicefix Cppsym
./Cppsym -l $al | $sort | $grep -v '^$' >Cppsym.true
: now check the C compiler for additional symbols
+postprocess_cc_v=''
+case "$osname" in
+aix) postprocess_cc_v="|$tr , ' '" ;;
+esac
$cat >ccsym <<EOS
$startsh
$cat >tmp.c <<EOF
extern int foo;
EOF
-for i in \`$cc -v -c tmp.c 2>&1\`
+for i in \`$cc -v -c tmp.c 2>&1 $postprocess_cc_v\`
do
case "\$i" in
-D*) echo "\$i" | $sed 's/^-D//';;
@@ -9477,9 +11127,16 @@ do
done
$rm -f try.c
EOS
+unset postprocess_cc_v
chmod +x ccsym
$eunicefix ccsym
-./ccsym | $sort | $uniq >ccsym.raw
+./ccsym > ccsym1.raw
+if $test -s ccsym1.raw; then
+ $sort ccsym1.raw | $uniq >ccsym.raw
+else
+ mv ccsym1.raw ccsym.raw
+fi
+
$awk '/\=/ { print $0; next }
{ print $0"=1" }' ccsym.raw >ccsym.list
$awk '{ print $0"=1" }' Cppsym.true >ccsym.true
@@ -9487,12 +11144,15 @@ $comm -13 ccsym.true ccsym.list >ccsym.own
$comm -12 ccsym.true ccsym.list >ccsym.com
$comm -23 ccsym.true ccsym.list >ccsym.cpp
also=''
-symbols='symbols'
if $test -z ccsym.raw; then
echo "Your C compiler doesn't seem to define any symbol!" >&4
echo " "
echo "However, your C preprocessor defines the following ones:"
$cat Cppsym.true
+ ccsymbols=''
+ cppsymbols=`$cat Cppsym.true`
+ cppsymbols=`echo $cppsymbols`
+ cppccsymbols="$cppsymbols"
else
if $test -s ccsym.com; then
echo "Your C compiler and pre-processor define these symbols:"
@@ -9500,20 +11160,26 @@ else
also='also '
symbols='ones'
$test "$silent" || sleep 1
+ cppccsymbols=`$cat ccsym.com`
+ cppccsymbols=`echo $cppccsymbols`
fi
if $test -s ccsym.cpp; then
$test "$also" && echo " "
- echo "Your C pre-processor ${also}defines the following $symbols:"
+ echo "Your C pre-processor ${also}defines the following symbols:"
$sed -e 's/\(.*\)=.*/\1/' ccsym.cpp
also='further '
$test "$silent" || sleep 1
+ cppsymbols=`$cat ccsym.cpp`
+ cppsymbols=`echo $cppsymbols`
fi
if $test -s ccsym.own; then
$test "$also" && echo " "
- echo "Your C compiler ${also}defines the following cpp variables:"
+ 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
$test "$silent" || sleep 1
+ ccsymbols=`$cat ccsym.own`
+ ccsymbols=`echo $ccsymbols`
fi
fi
$rm -f ccsym*
@@ -9627,7 +11293,7 @@ if $cc -c $ccflags -D\$1 varargs.c >/dev/null 2>&1; then
else
echo "false"
fi
-$rm -f varargs.o
+$rm -f varargs$_o
EOP
chmod +x varargs
@@ -9696,22 +11362,10 @@ fi
set i_sysioctl
eval $setvar
-: see if this is a sys/param system
-set sys/param.h i_sysparam
-eval $inhdr
-
: see if sys/resource.h has to be included
set sys/resource.h i_sysresrc
eval $inhdr
-: see if sys/stat.h is available
-set sys/stat.h i_sysstat
-eval $inhdr
-
-: see if sys/types.h has to be included
-set sys/types.h i_systypes
-eval $inhdr
-
: see if this is a sys/un.h system
set sys/un.h i_sysun
eval $inhdr
@@ -9761,78 +11415,121 @@ eval $setvar
echo " "
echo "Looking for extensions..." >&4
-cd ../ext
+tdir=`pwd`
+cd $rsrc/ext
: If we are using the old config.sh, known_extensions may contain
: old or inaccurate or duplicate values.
known_extensions=''
+nonxs_extensions=''
: We do not use find because it might not be available.
: We do not just use MANIFEST because the user may have dropped
: some additional extensions into the source tree and expect them
: to be built.
for xxx in * ; do
- case "$xxx" in
- DynaLoader) ;;
- *) if $test -f $xxx/$xxx.xs; then
- known_extensions="$known_extensions $xxx"
- else
- if $test -d $xxx; then
- cd $xxx
- for yyy in * ; do
- if $test -f $yyy/$yyy.xs; then
- known_extensions="$known_extensions $xxx/$yyy"
- fi
- done
- cd ..
- fi
- fi ;;
- esac
+ case "$xxx" in
+ DynaLoader|dynaload) ;;
+ *) if $test -f $xxx/$xxx.xs; then
+ known_extensions="$known_extensions $xxx"
+ elif $test -f $xxx/Makefile.PL; then
+ nonxs_extensions="$nonxs_extensions $xxx"
+ else
+ if $test -d $xxx; then
+ # Look for nested extensions, eg. Devel/Dprof.
+ cd $xxx
+ for yyy in * ; do
+ if $test -f $yyy/$yyy.xs; then
+ known_extensions="$known_extensions $xxx/$yyy"
+ elif $test -f $yyy/Makefile.PL; then
+ nonxs_extensions="$nonxs_extensions $xxx/$yyy"
+ fi
+ done
+ cd ..
+ fi
+ fi
+ ;;
+ esac
done
+set X $nonxs_extensions
+shift
+nonxs_extensions="$*"
set X $known_extensions
shift
known_extensions="$*"
-cd ../UU
+cd $tdir
: Now see which are supported on this system.
avail_ext=''
for xxx in $known_extensions ; do
- case "$xxx" in
- DB_File) case "$i_db" in
- $define) avail_ext="$avail_ext $xxx" ;;
- esac
- ;;
- GDBM_File) case "$i_gdbm" in
- $define) avail_ext="$avail_ext $xxx" ;;
- esac
- ;;
- NDBM_File) case "$i_ndbm" in
- $define) avail_ext="$avail_ext $xxx" ;;
- esac
- ;;
- ODBM_File) case "${i_dbm}${i_rpcsvcdbm}" in
- *"${define}"*) avail_ext="$avail_ext $xxx" ;;
- esac
- ;;
- POSIX) case "$useposix" in
- true|define|y) avail_ext="$avail_ext $xxx" ;;
- esac
- ;;
- Opcode) case "$useopcode" in
- true|define|y) avail_ext="$avail_ext $xxx" ;;
- esac
- ;;
- Socket) case "$d_socket" in
- $define) avail_ext="$avail_ext $xxx" ;;
- esac
- ;;
- *) avail_ext="$avail_ext $xxx"
- ;;
- esac
+ case "$xxx" in
+ DB_File|db_file)
+ case "$i_db" in
+ $define) avail_ext="$avail_ext $xxx" ;;
+ esac
+ ;;
+ GDBM_File|gdbm_fil)
+ case "$i_gdbm" in
+ $define) avail_ext="$avail_ext $xxx" ;;
+ esac
+ ;;
+ NDBM_File|ndbm_fil)
+ case "$i_ndbm" in
+ $define) avail_ext="$avail_ext $xxx" ;;
+ esac
+ ;;
+ ODBM_File|odbm_fil)
+ case "${i_dbm}${i_rpcsvcdbm}" in
+ *"${define}"*) avail_ext="$avail_ext $xxx" ;;
+ esac
+ ;;
+ POSIX|posix)
+ case "$useposix" in
+ true|define|y) avail_ext="$avail_ext $xxx" ;;
+ esac
+ ;;
+ Opcode|opcode)
+ case "$useopcode" in
+ true|define|y) avail_ext="$avail_ext $xxx" ;;
+ esac
+ ;;
+ Socket|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" ;;
+ esac
+ ;;
+ IPC/SysV|ipc/sysv)
+ : XXX Do we need a useipcsysv variable here
+ case "${d_msg}${d_sem}${d_shm}" in
+ *"${define}"*) avail_ext="$avail_ext $xxx" ;;
+ esac
+ ;;
+ *) avail_ext="$avail_ext $xxx"
+ ;;
+ esac
done
set X $avail_ext
shift
avail_ext="$*"
+: Now see which nonxs extensions are supported on this system.
+: For now assume all are.
+nonxs_ext=''
+for xxx in $nonxs_extensions ; do
+ case "$xxx" in
+ *) nonxs_ext="$nonxs_ext $xxx"
+ ;;
+ esac
+done
+
+set X $nonxs_ext
+shift
+nonxs_ext="$*"
+
case $usedl in
$define)
$cat <<EOM
@@ -9840,11 +11537,28 @@ A number of extensions are supplied with $package. You may choose to
compile these extensions for dynamic loading (the default), compile
them into the $package executable (static loading), or not include
them at all. Answer "none" to include no extensions.
+Note that DynaLoader is always built and need not be mentioned here.
EOM
case "$dynamic_ext" in
'') dflt="$avail_ext" ;;
- *) dflt="$dynamic_ext" ;;
+ *) dflt="$dynamic_ext"
+ # Perhaps we are reusing an old out-of-date config.sh.
+ case "$hint" in
+ previous)
+ if test X"$dynamic_ext" != X"$avail_ext"; then
+ $cat <<EOM
+NOTICE: Your previous config.sh list may be incorrect.
+The extensions now available to you are
+ ${avail_ext}
+but the default list from your previous config.sh is
+ ${dynamic_ext}
+
+EOM
+ fi
+ ;;
+ esac
+ ;;
esac
case "$dflt" in
'') dflt=none;;
@@ -9888,13 +11602,30 @@ EOM
$cat <<EOM
A number of extensions are supplied with $package. Answer "none"
to include no extensions.
+Note that DynaLoader is always built and need not be mentioned here.
EOM
case "$static_ext" in
'') dflt="$avail_ext" ;;
- *) dflt="$static_ext" ;;
- esac
+ *) dflt="$static_ext"
+ # Perhaps we are reusing an old out-of-date config.sh.
+ case "$hint" in
+ previous)
+ if test X"$static_ext" != X"$avail_ext"; then
+ $cat <<EOM
+NOTICE: Your previous config.sh list may be incorrect.
+The extensions now available to you are
+ ${avail_ext}
+but the default list from your previous config.sh is
+ ${static_ext}
+EOM
+ fi
+ ;;
+ esac
+ ;;
+ esac
+ : Exclude those that are not xs extensions
case "$dflt" in
'') dflt=none;;
esac
@@ -9907,7 +11638,7 @@ EOM
;;
esac
-set X $dynamic_ext $static_ext
+set X $dynamic_ext $static_ext $nonxs_ext
shift
extensions="$*"
@@ -9954,7 +11685,9 @@ case "$d_portable" in
echo " "
echo "Stripping down executable paths..." >&4
for file in $loclist $trylist; do
- eval $file="\$file"
+ if test X$file != Xln -a X$file != Xar -o X$osname != Xos2; then
+ eval $file="\$file"
+ fi
done
;;
esac
@@ -9965,15 +11698,17 @@ echo "Creating config.sh..." >&4
$spitshell <<EOT >config.sh
$startsh
#
-# This file was produced by running the Configure script. It holds all
-# the definitions figured out by Configure. Should you modify any of
-# these values, do not forget to propagate your changes by running
-# "Configure -S"; or, equivalently, you may run each .SH file yourself.
+# This file was produced by running the Configure script. It holds all the
+# definitions figured out by Configure. Should you modify one of these values,
+# do not forget to propagate your changes by running "Configure -der". You may
+# instead choose to run each of the .SH files by yourself, or "Configure -S".
#
+# Package name : $package
+# Source directory : $src
# Configuration time: $cf_time
-# Configured by: $cf_by
-# Target system: $myuname
+# Configured by : $cf_by
+# Target system : $myuname
Author='$Author'
Date='$Date'
@@ -9986,9 +11721,14 @@ RCSfile='$RCSfile'
Revision='$Revision'
Source='$Source'
State='$State'
+_a='$_a'
+_exe='$_exe'
+_o='$_o'
afs='$afs'
alignbytes='$alignbytes'
+ansi2knr='$ansi2knr'
aphostname='$aphostname'
+apiversion='$apiversion'
ar='$ar'
archlib='$archlib'
archlibexp='$archlibexp'
@@ -9998,7 +11738,6 @@ awk='$awk'
baserev='$baserev'
bash='$bash'
bin='$bin'
-bincompat3='$bincompat3'
binexp='$binexp'
bison='$bison'
byacc='$byacc'
@@ -10010,6 +11749,7 @@ cc='$cc'
cccdlflags='$cccdlflags'
ccdlflags='$ccdlflags'
ccflags='$ccflags'
+ccsymbols='$ccsymbols'
cf_by='$cf_by'
cf_email='$cf_email'
cf_time='$cf_time'
@@ -10029,6 +11769,8 @@ cpplast='$cpplast'
cppminus='$cppminus'
cpprun='$cpprun'
cppstdin='$cppstdin'
+cppsymbols='$cppsymbols'
+cppccsymbols='$cppccsymbols'
cryptlib='$cryptlib'
csh='$csh'
d_Gconvert='$d_Gconvert'
@@ -10038,10 +11780,8 @@ d_archlib='$d_archlib'
d_attribut='$d_attribut'
d_bcmp='$d_bcmp'
d_bcopy='$d_bcopy'
-d_bincompat3='$d_bincompat3'
d_bsd='$d_bsd'
d_bsdgetpgrp='$d_bsdgetpgrp'
-d_bsdpgrp='$d_bsdpgrp'
d_bsdsetpgrp='$d_bsdsetpgrp'
d_bzero='$d_bzero'
d_casti32='$d_casti32'
@@ -10063,6 +11803,12 @@ d_dlopen='$d_dlopen'
d_dlsymun='$d_dlsymun'
d_dosuid='$d_dosuid'
d_dup2='$d_dup2'
+d_endgrent='$d_endgrent'
+d_endhent='$d_endhent'
+d_endnent='$d_endnent'
+d_endpent='$d_endpent'
+d_endpwent='$d_endpwent'
+d_endsent='$d_endsent'
d_eofnblk='$d_eofnblk'
d_eunice='$d_eunice'
d_fchmod='$d_fchmod'
@@ -10077,27 +11823,52 @@ d_flock='$d_flock'
d_fork='$d_fork'
d_fpathconf='$d_fpathconf'
d_fsetpos='$d_fsetpos'
+d_fstatfs='$d_fstatfs'
+d_statfsflags='$d_statfsflags'
+d_fstatvfs='$d_fstatvfs'
+d_getmntent='$d_getmntent'
+d_hasmntopt='$d_hasmntopt'
d_ftime='$d_ftime'
+d_getgrent='$d_getgrent'
d_getgrps='$d_getgrps'
-d_setgrps='$d_setgrps'
+d_gethbyaddr='$d_gethbyaddr'
+d_gethbyname='$d_gethbyname'
d_gethent='$d_gethent'
d_gethname='$d_gethname'
+d_gethostprotos='$d_gethostprotos'
d_getlogin='$d_getlogin'
+d_getnbyaddr='$d_getnbyaddr'
+d_getnbyname='$d_getnbyname'
+d_getnent='$d_getnent'
+d_getnetprotos='$d_getnetprotos'
+d_getpbyname='$d_getpbyname'
+d_getpbynumber='$d_getpbynumber'
+d_getpent='$d_getpent'
d_getpgid='$d_getpgid'
d_getpgrp2='$d_getpgrp2'
d_getpgrp='$d_getpgrp'
d_getppid='$d_getppid'
d_getprior='$d_getprior'
+d_getprotoprotos='$d_getprotoprotos'
+d_getpwent='$d_getpwent'
+d_getsbyname='$d_getsbyname'
+d_getsbyport='$d_getsbyport'
+d_getsent='$d_getsent'
+d_getservprotos='$d_getservprotos'
d_gettimeod='$d_gettimeod'
d_gnulibc='$d_gnulibc'
+d_grpasswd='$d_grpasswd'
d_htonl='$d_htonl'
d_index='$d_index'
d_inetaton='$d_inetaton'
d_isascii='$d_isascii'
d_killpg='$d_killpg'
+d_lchown='$d_lchown'
d_link='$d_link'
d_locconv='$d_locconv'
d_lockf='$d_lockf'
+d_longdbl='$d_longdbl'
+d_longlong='$d_longlong'
d_lstat='$d_lstat'
d_mblen='$d_mblen'
d_mbstowcs='$d_mbstowcs'
@@ -10116,7 +11887,7 @@ d_msgrcv='$d_msgrcv'
d_msgsnd='$d_msgsnd'
d_mymalloc='$d_mymalloc'
d_nice='$d_nice'
-d_oldarchlib='$d_oldarchlib'
+d_oldpthreads='$d_oldpthreads'
d_oldsock='$d_oldsock'
d_open3='$d_open3'
d_pathconf='$d_pathconf'
@@ -10125,12 +11896,16 @@ d_phostname='$d_phostname'
d_pipe='$d_pipe'
d_poll='$d_poll'
d_portable='$d_portable'
+d_pthread_yield='$d_pthread_yield'
+d_pthreads_created_joinable='$d_pthreads_created_joinable'
d_pwage='$d_pwage'
d_pwchange='$d_pwchange'
d_pwclass='$d_pwclass'
d_pwcomment='$d_pwcomment'
d_pwexpire='$d_pwexpire'
+d_pwgecos='$d_pwgecos'
d_pwquota='$d_pwquota'
+d_pwpasswd='$d_pwpasswd'
d_readdir='$d_readdir'
d_readlink='$d_readlink'
d_rename='$d_rename'
@@ -10139,27 +11914,38 @@ d_rmdir='$d_rmdir'
d_safebcpy='$d_safebcpy'
d_safemcpy='$d_safemcpy'
d_sanemcmp='$d_sanemcmp'
+d_sched_yield='$d_sched_yield'
d_seekdir='$d_seekdir'
d_select='$d_select'
d_sem='$d_sem'
d_semctl='$d_semctl'
+d_semctl_semid_ds='$d_semctl_semid_ds'
+d_semctl_semun='$d_semctl_semun'
d_semget='$d_semget'
d_semop='$d_semop'
d_setegid='$d_setegid'
d_seteuid='$d_seteuid'
+d_setgrent='$d_setgrent'
+d_setgrps='$d_setgrps'
+d_sethent='$d_sethent'
d_setlinebuf='$d_setlinebuf'
d_setlocale='$d_setlocale'
+d_setnent='$d_setnent'
+d_setpent='$d_setpent'
d_setpgid='$d_setpgid'
d_setpgrp2='$d_setpgrp2'
d_setpgrp='$d_setpgrp'
d_setprior='$d_setprior'
+d_setpwent='$d_setpwent'
d_setregid='$d_setregid'
d_setresgid='$d_setresgid'
d_setresuid='$d_setresuid'
d_setreuid='$d_setreuid'
d_setrgid='$d_setrgid'
d_setruid='$d_setruid'
+d_setsent='$d_setsent'
d_setsid='$d_setsid'
+d_setvbuf='$d_setvbuf'
d_sfio='$d_sfio'
d_shm='$d_shm'
d_shmat='$d_shmat'
@@ -10201,6 +11987,7 @@ d_truncate='$d_truncate'
d_tzname='$d_tzname'
d_umask='$d_umask'
d_uname='$d_uname'
+d_union_semun='$d_union_semun'
d_vfork='$d_vfork'
d_void_closedir='$d_void_closedir'
d_voidsig='$d_voidsig'
@@ -10219,8 +12006,10 @@ defvoidused='$defvoidused'
direntrytype='$direntrytype'
dlext='$dlext'
dlsrc='$dlsrc'
+doublesize='$doublesize'
dynamic_ext='$dynamic_ext'
eagain='$eagain'
+ebcdic='$ebcdic'
echo='$echo'
egrep='$egrep'
emacs='$emacs'
@@ -10233,9 +12022,9 @@ firstmakefile='$firstmakefile'
flex='$flex'
fpostype='$fpostype'
freetype='$freetype'
+full_ar='$full_ar'
full_csh='$full_csh'
full_sed='$full_sed'
-gcc='$gcc'
gccversion='$gccversion'
gidtype='$gidtype'
glibpth='$glibpth'
@@ -10248,6 +12037,7 @@ h_sysfile='$h_sysfile'
hint='$hint'
hostcat='$hostcat'
huge='$huge'
+i_arpainet='$i_arpainet'
i_bsdioctl='$i_bsdioctl'
i_db='$i_db'
i_dbm='$i_dbm'
@@ -10261,12 +12051,16 @@ i_grp='$i_grp'
i_limits='$i_limits'
i_locale='$i_locale'
i_malloc='$i_malloc'
+i_machcthreads='$i_machcthreads'
i_math='$i_math'
i_memory='$i_memory'
+i_mntent='$i_mntent'
i_ndbm='$i_ndbm'
+i_netdb='$i_netdb'
i_neterrno='$i_neterrno'
i_niin='$i_niin'
i_pwd='$i_pwd'
+i_pthread='$i_pthread'
i_rpcsvcdbm='$i_rpcsvcdbm'
i_sfio='$i_sfio'
i_sgtty='$i_sgtty'
@@ -10279,12 +12073,14 @@ i_sysfile='$i_sysfile'
i_sysfilio='$i_sysfilio'
i_sysin='$i_sysin'
i_sysioctl='$i_sysioctl'
+i_sysmount='$i_sysmount'
i_sysndir='$i_sysndir'
i_sysparam='$i_sysparam'
i_sysresrc='$i_sysresrc'
i_sysselct='$i_sysselct'
i_syssockio='$i_syssockio'
i_sysstat='$i_sysstat'
+i_sysstatvfs='$i_sysstatvfs'
i_systime='$i_systime'
i_systimek='$i_systimek'
i_systimes='$i_systimes'
@@ -10300,6 +12096,7 @@ i_values='$i_values'
i_varargs='$i_varargs'
i_varhdr='$i_varhdr'
i_vfork='$i_vfork'
+ignore_versioned_solibs='$ignore_versioned_solibs'
incpath='$incpath'
inews='$inews'
installarchlib='$installarchlib'
@@ -10310,6 +12107,7 @@ installprivlib='$installprivlib'
installscript='$installscript'
installsitearch='$installsitearch'
installsitelib='$installsitelib'
+installusrbinperl='$installusrbinperl'
intsize='$intsize'
known_extensions='$known_extensions'
ksh='$ksh'
@@ -10331,6 +12129,8 @@ ln='$ln'
lns='$lns'
locincpth='$locincpth'
loclibpth='$loclibpth'
+longdblsize='$longdblsize'
+longlongsize='$longlongsize'
longsize='$longsize'
lp='$lp'
lpr='$lpr'
@@ -10362,13 +12162,17 @@ mydomain='$mydomain'
myhostname='$myhostname'
myuname='$myuname'
n='$n'
+netdb_hlen_type='$netdb_hlen_type'
+netdb_host_type='$netdb_host_type'
+netdb_name_type='$netdb_name_type'
+netdb_net_type='$netdb_net_type'
+nm='$nm'
nm_opt='$nm_opt'
nm_so_opt='$nm_so_opt'
+nonxs_ext='$nonxs_ext'
nroff='$nroff'
o_nonblock='$o_nonblock'
obj_ext='$obj_ext'
-oldarchlib='$oldarchlib'
-oldarchlibexp='$oldarchlibexp'
optimize='$optimize'
orderlib='$orderlib'
osname='$osname'
@@ -10383,6 +12187,7 @@ perladmin='$perladmin'
perlpath='$perlpath'
pg='$pg'
phostname='$phostname'
+pidtype='$pidtype'
plibpth='$plibpth'
pmake='$pmake'
pr='$pr'
@@ -10391,6 +12196,7 @@ prefixexp='$prefixexp'
privlib='$privlib'
privlibexp='$privlibexp'
prototype='$prototype'
+ptrsize='$ptrsize'
randbits='$randbits'
ranlib='$ranlib'
rd_nodata='$rd_nodata'
@@ -10400,6 +12206,7 @@ runnm='$runnm'
scriptdir='$scriptdir'
scriptdirexp='$scriptdirexp'
sed='$sed'
+selectminbits='$selectminbits'
selecttype='$selecttype'
sendmail='$sendmail'
sh='$sh'
@@ -10410,7 +12217,9 @@ shortsize='$shortsize'
shrpenv='$shrpenv'
shsharp='$shsharp'
sig_name='$sig_name'
+sig_name_init='$sig_name_init'
sig_num='$sig_num'
+sig_num_init='$sig_num_init'
signal_t='$signal_t'
sitearch='$sitearch'
sitearchexp='$sitearchexp'
@@ -10427,6 +12236,7 @@ sort='$sort'
spackage='$spackage'
spitshell='$spitshell'
split='$split'
+src='$src'
ssizetype='$ssizetype'
startperl='$startperl'
startsh='$startsh'
@@ -10435,6 +12245,7 @@ stdchar='$stdchar'
stdio_base='$stdio_base'
stdio_bufsiz='$stdio_bufsiz'
stdio_cnt='$stdio_cnt'
+stdio_filbuf='$stdio_filbuf'
stdio_ptr='$stdio_ptr'
strings='$strings'
submit='$submit'
@@ -10443,11 +12254,13 @@ sysman='$sysman'
tail='$tail'
tar='$tar'
tbl='$tbl'
+tee='$tee'
test='$test'
timeincl='$timeincl'
timetype='$timetype'
touch='$touch'
tr='$tr'
+trnl='$trnl'
troff='$troff'
uidtype='$uidtype'
uname='$uname'
@@ -10460,9 +12273,11 @@ useperlio='$useperlio'
useposix='$useposix'
usesfio='$usesfio'
useshrplib='$useshrplib'
+usethreads='$usethreads'
usevfork='$usevfork'
usrinc='$usrinc'
uuname='$uuname'
+version='$version'
vi='$vi'
voidflags='$voidflags'
xlibpth='$xlibpth'
@@ -10470,9 +12285,12 @@ zcat='$zcat'
zip='$zip'
EOT
+: Add in command line options if available
+$test -f UU/cmdline.opt && $cat UU/cmdline.opt >> config.sh
+
: add special variables
-$test -f patchlevel.h && \
-awk '/^#define/ {printf "%s=%s\n",$2,$3}' patchlevel.h >>config.sh
+$test -f $src/patchlevel.h && \
+awk '/^#define/ {printf "%s=%s\n",$2,$3}' $src/patchlevel.h >>config.sh
echo "CONFIG=true" >>config.sh
: propagate old symbols
@@ -10566,6 +12384,22 @@ else
echo "Done."
fi
+if $test -f Policy.sh; then
+ $cat <<EOM
+
+If you compile $package on a different machine or from a different object
+directory, copy the Policy.sh file from this object directory to the
+new one before you run Configure -- this will help you with most of
+the policy defaults.
+
+EOM
+fi
+if $test -f config.msg; then
+ echo "Hmm. I also noted the following information while running:"
+ echo " "
+ $cat config.msg >&4
+ $rm -f config.msg
+fi
$rm -f kit*isdone ark*isdone
$rm -rf UU
diff --git a/gnu/usr.bin/perl/EXTERN.h b/gnu/usr.bin/perl/EXTERN.h
index 228ed524065..66aeb9f6521 100644
--- a/gnu/usr.bin/perl/EXTERN.h
+++ b/gnu/usr.bin/perl/EXTERN.h
@@ -1,6 +1,6 @@
/* EXTERN.h
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -18,12 +18,16 @@
#undef EXTCONST
#undef dEXTCONST
#if defined(VMS) && !defined(__GNUC__)
+ /* Suppress portability warnings from DECC for VMS-specific extensions */
+# ifdef __DECC
+# pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT)
+# endif
# define EXT globalref
# define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare
# define EXTCONST globalref
# define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly
#else
-# if (defined(_MSC_VER) && defined(_WIN32)) || (defined(__BORLANDC__) && defined(__WIN32__))
+# if defined(WIN32) && !defined(PERL_STATIC_SYMS) && !defined(__GNUC__) && !defined(PERL_OBJECT)
# ifdef PERLDLL
# define EXT extern __declspec(dllexport)
# define dEXT
diff --git a/gnu/usr.bin/perl/INSTALL b/gnu/usr.bin/perl/INSTALL
index 488a1ce870a..c5e04cb4c57 100644
--- a/gnu/usr.bin/perl/INSTALL
+++ b/gnu/usr.bin/perl/INSTALL
@@ -6,7 +6,7 @@ Install - Build and Installation guide for perl5.
The basic steps to build and install perl5 on a Unix system are:
- rm -f config.sh
+ rm -f config.sh Policy.sh
sh Configure
make
make test
@@ -48,12 +48,45 @@ If there is a hint file for your system (in the hints/ directory) you
should also read that hint file for specific information for your
system. (Unixware users should use the svr4.sh hint file.)
+=head1 WARNING: This version is not binary compatible with Perl 5.004.
+
+Starting with Perl 5.004_50 there were many deep and far-reaching changes
+to the language internals. If you have dynamically loaded extensions
+that you built under perl 5.003 or 5.004, you can continue to use them
+with 5.004, but you will need to rebuild and reinstall those extensions
+to use them 5.005. See the discussions below on
+L<"Coexistence with earlier versions of perl5"> and
+L<"Upgrading from 5.004 to 5.005"> for more details.
+
+The standard extensions supplied with Perl will be handled automatically.
+
+In a related issue, old extensions may possibly be affected by the
+changes in the Perl language in the current release. Please see
+pod/perldelta.pod for a description of what's changed.
+
+=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).
+Another alternative may be to use a tool like C<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
+in the Perl sources. C<ansi2knr> is usually found as part of the freely
+available C<Ghostscript> distribution. Another similar tool is
+C<unprotoize>, distributed with GCC. Since C<unprotoize> requires GCC to
+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
+followed. This will enable us to officially support this option.
+
=head1 Space Requirements
-The complete perl5 source tree takes up about 7 MB of disk space. The
-complete tree after completing make takes roughly 15 MB, though the
+The complete perl5 source tree takes up about 10 MB of disk space. The
+complete tree after completing make takes roughly 20 MB, though the
actual total is likely to be quite system-dependent. The installation
-directories need something on the order of 7 MB, though again that
+directories need something on the order of 10 MB, though again that
value is system-dependent.
=head1 Start with a Fresh Distribution
@@ -61,13 +94,20 @@ value is system-dependent.
If you have built perl before, you should clean out the build directory
with the command
+ make distclean
+
+or
+
make realclean
-The results of a Configure run are stored in the config.sh file. If
-you are upgrading from a previous version of perl, or if you change
-systems or compilers or make other significant changes, or if you are
-experiencing difficulties building perl, you should probably not
-re-use your old config.sh. Simply remove it or rename it, e.g.
+The only difference between the two is that make distclean also removes
+your old config.sh and Policy.sh files.
+
+The results of a Configure run are stored in the config.sh and Policy.sh
+files. If you are upgrading from a previous version of perl, or if you
+change systems or compilers or make other significant changes, or if
+you are experiencing difficulties building perl, you should probably
+not re-use your old config.sh. Simply remove it or rename it, e.g.
mv config.sh config.sh.old
@@ -82,18 +122,23 @@ Similarly, if you used a shared libperl.so (see below) with version
numbers, you will probably want to adjust them as well.
Also, be careful to check your architecture name. Some Linux systems
-(such as Debian) use i386, while others may use i486 or i586. If you
-pick up a precompiled binary, it might not use the same name.
+(such as Debian) use i386, while others may use i486, i586, or i686.
+If you pick up a precompiled binary, it might not use the same name.
In short, if you wish to use your old config.sh, I recommend running
Configure interactively rather than blindly accepting the defaults.
+If your reason to reuse your old config.sh is to save your
+particular installation choices, then you can probably achieve the
+same effect by using the new Policy.sh file. See the section on
+L<"Site-wide Policy settings"> below.
+
=head1 Run Configure
Configure will figure out various things about your system. Some
things Configure will figure out for itself, other things it will ask
you about. To accept the default, just press RETURN. The default
-is almost always ok. At any Configure prompt, you can type &-d
+is almost always okay. At any Configure prompt, you can type &-d
and Configure will use the defaults from then on.
After it runs, Configure will perform variable substitution on all the
@@ -130,6 +175,18 @@ NOTE: You must not specify an installation directory that is below
your perl source directory. If you do, installperl will attempt
infinite recursion.
+It may seem obvious to say, but Perl is useful only when users can
+easily find it. It's often a good idea to have both /usr/bin/perl and
+/usr/local/bin/perl be symlinks to the actual binary. Be especially
+careful, however, of overwriting a version of perl supplied by your
+vendor. In any case, system administrators are strongly encouraged to
+put (symlinks to) perl and its accompanying utilities, such as perldoc,
+into a directory typically found along a user's PATH, or in another
+obvious and convenient place.
+
+You can use "Configure -Uinstallusrbinperl" which causes installperl
+to skip installing perl also as /usr/bin/perl.
+
By default, Configure will compile perl to use dynamic loading if
your system supports it. If you want to force perl to be compiled
statically, you can either choose this when Configure prompts you or
@@ -147,34 +204,33 @@ For my Solaris system, I usually use
=head2 GNU-style configure
If you prefer the GNU-style configure command line interface, you can
-use the supplied configure command, e.g.
+use the supplied configure.gnu command, e.g.
- CC=gcc ./configure
+ CC=gcc ./configure.gnu
-The configure script emulates a few of the more common configure
+The configure.gnu script emulates a few of the more common configure
options. Try
- ./configure --help
+ ./configure.gnu --help
for a listing.
Cross compiling is not supported.
-For systems that do not distinguish the files "Configure" and
-"configure", Perl includes a copy of configure named
-configure.gnu.
+(The file is called configure.gnu to avoid problems on systems
+that would not distinguish the files "Configure" and "configure".)
=head2 Extensions
By default, Configure will offer to build every extension which appears
to be supported. For example, Configure will offer to build GDBM_File
only if it is able to find the gdbm library. (See examples below.)
-DynaLoader, Fcntl, and IO are always built by default. Configure does
-not contain code to test for POSIX compliance, so POSIX is always built
-by default as well. If you wish to skip POSIX, you can set the
-Configure variable useposix=false either in a hint file or from the
-Configure command line. Similarly, the Opcode extension is always built
-by default, but you can skip it by setting the Configure variable
+B, DynaLoader, Fcntl, IO, and attrs are always built by default.
+Configure does not contain code to test for POSIX compliance, so POSIX
+is always built by default as well. If you wish to skip POSIX, you can
+set the Configure variable useposix=false either in a hint file or from
+the Configure command line. Similarly, the Opcode extension is always
+built by default, but you can skip it by setting the Configure variable
useopcode=false either in a hint file for from the command line.
You can learn more about each of these extensions by consulting the
@@ -188,6 +244,7 @@ version. (Configure will suggest this as the default.)
In summary, here are the Configure command-line variables you can set
to turn off each extension:
+ B (Always included by default)
DB_File i_db
DynaLoader (Must always be included as a static extension)
Fcntl (Always included by default)
@@ -199,6 +256,8 @@ to turn off each extension:
SDBM_File (Always included by default)
Opcode useopcode
Socket d_socket
+ Threads usethreads
+ attrs (Always included by default)
Thus to skip the NDBM_File extension, you can use
@@ -210,10 +269,14 @@ library.
Of course, you may always run Configure interactively and select only
the extensions you want.
-Note: The DB_File module will only work with version 1.x of
-Berkeley DB. Once Berkeley DB version 2 is released, DB_File will be
-upgraded to work with it. Configure will automatically detect this
-for you and refuse to try to build DB_File with version 2.
+Note: The DB_File module will only work with version 1.x of Berkeley
+DB or newer releases of version 2. Configure will automatically detect
+this for you and refuse to try to build DB_File with version 2.
+
+If you re-use your old config.sh but change your system (e.g. by
+adding libgdbm) Configure will still offer your old choices of extensions
+for the default answer, but it will also point out the discrepancy to
+you.
Finally, if you have dynamic loading (most modern Unix systems do)
remember that these extensions do not increase the size of your perl
@@ -273,7 +336,7 @@ This should actually work if you have gdbm installed in any of
=item gdbm in /usr/you
Suppose you have gdbm installed in some place other than /usr/local/,
-but you still want Configure to find it. To be specific, assume you
+but you still want Configure to find it. To be specific, assume you
have /usr/you/include/gdbm.h and /usr/you/lib/libgdbm.a. You
still have to add -I/usr/you/include to cc flags, but you have to take
an extra step to help Configure find libgdbm.a. Specifically, when
@@ -312,19 +375,24 @@ everything where you want it. At any point during the Configure
process, you can answer a question with &-d and Configure
will use the defaults from then on.
-By default, Configure uses the following directories for
-library files (archname is a string like sun4-sunos, determined
-by Configure)
+By default, Configure will use the following directories for library files
+for 5.005 (archname is a string like sun4-sunos, determined by Configure).
+
+ Configure variable Default value
+ $archlib /usr/local/lib/perl5/5.005/archname
+ $privlib /usr/local/lib/perl5/5.005
+ $sitearch /usr/local/lib/perl5/site_perl/5.005/archname
+ $sitelib /usr/local/lib/perl5/site_perl/5.005
- /usr/local/lib/perl5/archname/5.004
- /usr/local/lib/perl5/
- /usr/local/lib/perl5/site_perl/archname
- /usr/local/lib/perl5/site_perl
+Some users prefer to append a "/share" to $privlib and $sitelib
+to emphasize that those directories can be shared among different
+architectures.
-and the following directories for manual pages:
+By default, Configure will use the following directories for manual pages:
- /usr/local/man/man1
- /usr/local/lib/perl5/man/man3
+ Configure variable Default value
+ $man1dir /usr/local/man/man1
+ $man3dir /usr/local/lib/perl5/man/man3
(Actually, Configure recognizes the SVR3-style
/usr/local/man/l_man/man1 directories, if present, and uses those
@@ -348,32 +416,32 @@ Some users also prefer to use a .3pm suffix. You can do that with
If you specify a prefix that contains the string "perl", then the
directory structure is simplified. For example, if you Configure with
--Dprefix=/opt/perl, then the defaults are
+-Dprefix=/opt/perl, then the defaults for 5.005 are
- /opt/perl/lib/archname/5.004
- /opt/perl/lib
- /opt/perl/lib/site_perl/archname
- /opt/perl/lib/site_perl
+ Configure variable Default value
+ $archlib /opt/perl/lib/5.005/archname
+ $privlib /opt/perl/lib/5.005
+ $sitearch /opt/perl/lib/site_perl/5.005/archname
+ $sitelib /opt/perl/lib/site_perl/5.005
- /opt/perl/man/man1
- /opt/perl/man/man3
+ $man1dir /opt/perl/man/man1
+ $man3dir /opt/perl/man/man3
The perl executable will search the libraries in the order given
above.
-The directories site_perl and site_perl/archname are empty, but are
-intended to be used for installing local or site-wide extensions. Perl
-will automatically look in these directories. Previously, most sites
-just put their local extensions in with the standard distribution.
+The directories under site_perl are empty, but are intended to be used
+for installing local or site-wide extensions. Perl will automatically
+look in these directories.
-In order to support using things like #!/usr/local/bin/perl5.004 after
+In order to support using things like #!/usr/local/bin/perl5.005 after
a later version is released, architecture-dependent libraries are
stored in a version-specific directory, such as
-/usr/local/lib/perl5/archname/5.004/. In Perl 5.000 and 5.001, these
-files were just stored in /usr/local/lib/perl5/archname/. If you will
-not be using 5.001 binaries, you can delete the standard extensions from
-the /usr/local/lib/perl5/archname/ directory. Locally-added extensions
-can be moved to the site_perl and site_perl/archname directories.
+/usr/local/lib/perl5/archname/5.005/.
+
+Further details about the installation directories, maintenance and
+development subversions, and about supporting multiple versions are
+discussed in L<"Coexistence with earlier versions of perl5"> below.
Again, these are just the defaults, and can be changed as you run
Configure.
@@ -415,27 +483,55 @@ Then, you can Configure and install in the usual way:
make test
make install
+Beware, though, that if you go to try to install new add-on
+extensions, they too will get installed in under '/tmp/perl5' if you
+follow this example. The next section shows one way of dealing with
+that problem.
+
=head2 Creating an installable tar archive
If you need to install perl on many identical systems, it is
convenient to compile it once and create an archive that can be
-installed on multiple systems. Here's one way to do that:
+installed on multiple systems. Suppose, for example, that you want to
+create an archive that can be installed in /opt/perl.
+Here's one way to do that:
# Set up config.over to install perl into a different directory,
# e.g. /tmp/perl5 (see previous part).
- sh Configure -des
+ sh Configure -Dprefix=/opt/perl -des
make
make test
- make install
+ make install # This will install everything into /tmp/perl5.
cd /tmp/perl5
- # Edit lib/<archname>/<version>/Config.pm to change all the
+ # Edit $archlib/Config.pm and $archlib/.packlist to change all the
# install* variables back to reflect where everything will
- # really be installed.
+ # really be installed. (That is, change /tmp/perl5 to /opt/perl
+ # everywhere in those files.)
+ # Check the scripts in $scriptdir to make sure they have the correct
+ # #!/wherever/perl line.
tar cvf ../perl5-archive.tar .
# Then, on each machine where you want to install perl,
- cd /usr/local # Or wherever you specified as $prefix
+ cd /opt/perl # Or wherever you specified as $prefix
tar xvf perl5-archive.tar
+=head2 Site-wide Policy settings
+
+After Configure runs, it stores a number of common site-wide "policy"
+answers (such as installation directories and the local perl contact
+person) in the Policy.sh file. If you want to build perl on another
+system using the same policy defaults, simply copy the Policy.sh file
+to the new system and Configure will use it along with the appropriate
+hint file for your system.
+
+Alternatively, if you wish to change some or all of those policy
+answers, you should
+
+ rm -f Policy.sh
+
+to ensure that Configure doesn't re-use them.
+
+Further information is in the Policy_sh.SH file itself.
+
=head2 Configure-time Options
There are several different ways to Configure and build perl for your
@@ -443,41 +539,18 @@ system. For most users, the defaults are sensible and will work.
Some users, however, may wish to further customize perl. Here are
some of the main things you can change.
-=head2 Binary Compatibility With Earlier Versions of Perl 5
-
-If you have dynamically loaded extensions that you built under
-perl 5.003 and that you wish to continue to use with perl 5.004, then you
-need to ensure that 5.004 remains binary compatible with 5.003.
-
-Starting with Perl 5.003, all functions in the Perl C source code have
-been protected by default by the prefix Perl_ (or perl_) so that you
-may link with third-party libraries without fear of namespace
-collisions. This change broke compatibility with version 5.002, so
-installing 5.003 or 5.004 over 5.002 or earlier will force you to
-re-build and install all of your dynamically loadable extensions.
-(The standard extensions supplied with Perl are handled
-automatically). You can turn off this namespace protection by adding
--DNO_EMBED to your ccflags variable in config.sh.
+=head2 Threads
-Perl 5.003's namespace protection was incomplete, but this has
-been fixed in 5.004. However, some sites may need to maintain
-complete binary compatibility with Perl 5.003. If you are building
-Perl for such a site, then when Configure asks if you want binary
-compatibility, answer "y".
+On some platforms, perl5.005 can be compiled with experimental support
+for threads. To enable this, read the file README.threads, and then
+try:
-On the other hand, if you are embedding perl into another application
-and want the maximum namespace protection, then you probably ought to
-answer "n" when Configure asks if you want binary compatibility, or
-disable it from the Configure command line with
+ sh Configure -Dusethreads
- sh Configure -Ud_bincompat3
+Currently, you need to specify -Dusethreads on the Configure command
+line so that the hint files can make appropriate adjustments.
-The default answer of "y" to maintain binary compatibility is probably
-appropriate for almost everyone.
-
-In a related issue, old extensions may possibly be affected by the
-changes in the Perl language in the current release. Please see
-pod/perldelta.pod for a description of what's changed.
+The default is to compile without thread support.
=head2 Selecting File IO mechanisms
@@ -510,8 +583,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, and work is in progress to make
-it more easily buildable by adding Configure support.
+A (fairly old) version of sfio is in CPAN.
You select this option by
@@ -544,8 +616,7 @@ portable version of this may eventually make its way into Configure.)
fi
If you have this problem, the fix is to go back to your sfio sources
-and correct iffe's guess about atexit (or whatever is appropriate for
-your platform.)
+and correct iffe's guess about atexit.
There also might be a more recent release of Sfio that fixes your
problem.
@@ -606,9 +677,24 @@ You can elect to build a shared libperl by
sh Configure -Duseshrplib
-To actually build perl, you must add the current working directory to your
-LD_LIBRARY_PATH environment variable before running make. You can do
-this with
+To build a shared libperl, the environment variable controlling shared
+library search (LD_LIBRARY_PATH in most systems, DYLD_LIBRARY_PATH for
+NeXTSTEP/OPENSTEP, LIBRARY_PATH for BeOS) must be set up to include
+the Perl build directory because that's where the shared libperl will
+be created. Configure arranges Makefile to have the correct shared
+library search settings.
+
+However, there are some special cases where manually setting the
+shared library path might be required. For example, if you want to run
+something like the following with the newly-built but not-yet-installed
+./perl:
+
+ cd t; ./perl misc/failing_test.t
+or
+ ./perl -Ilib ~/my_mission_critical_test
+
+then you need to set up the shared library path explicitly.
+You can do this with
LD_LIBRARY_PATH=`pwd`:$LD_LIBRARY_PATH; export LD_LIBRARY_PATH
@@ -616,9 +702,13 @@ for Bourne-style shells, or
setenv LD_LIBRARY_PATH `pwd`
-for Csh-style shells. You *MUST* do this before running make.
-Folks running NeXT OPENSTEP must substitute DYLD_LIBRARY_PATH for
-LD_LIBRARY_PATH above.
+for Csh-style shells. (This procedure may also be needed if for some
+unexpected reason Configure fails to set up Makefile correctly.)
+
+You can often recognize failures to build/use a shared libperl from error
+messages complaining about a missing libperl.so (or libperl.sl in HP-UX),
+for example:
+18126:./miniperl: /sbin/loader: Fatal Error: cannot map libperl.so
There is also an potential problem with the shared perl library if you
want to have more than one "flavor" of the same version of perl (e.g.
@@ -647,9 +737,12 @@ Perl relies heavily on malloc(3) to grow data structures as needed, so
perl's performance can be noticeably affected by the performance of
the malloc function on your system.
-The perl source is shipped with a version of malloc that is very fast
-but somewhat wasteful of space. On the other hand, your system's
-malloc() function is probably a bit slower but also a bit more frugal.
+The perl source is shipped with a version of malloc that is very fast but
+somewhat wasteful of space. On the other hand, your system's malloc
+function may be a bit slower but also a bit more frugal. However,
+as of 5.004_68, perl's malloc has been optimized for the typical
+requests from perl, so there's a chance that it may be both faster and
+use less memory.
For many uses, speed is probably the most important consideration, so
the default behavior (for most systems) is to use the malloc supplied
@@ -657,8 +750,8 @@ with perl. However, if you will be running very large applications
(e.g. Tk or PDL) or if your system already has an excellent malloc, or
if you are experiencing difficulties with extensions that use
third-party libraries that call malloc, then you might wish to use
-your system's malloc. (Or, you might wish to explore the experimental
-malloc flags discussed below.)
+your system's malloc. (Or, you might wish to explore the malloc flags
+discussed below.)
To build without perl's malloc, you can use the Configure command
@@ -668,43 +761,23 @@ or you can answer 'n' at the appropriate interactive Configure prompt.
=head2 Malloc Performance Flags
-If you are using Perl's malloc, you may add one or
-more of the following items to your cflags config.sh variable
-to change its behavior in potentially useful ways. You can find out
-more about these flags by reading the malloc.c source.
-In a future version of perl, these might be enabled by default.
+If you are using Perl's malloc, you may add one or more of the following
+items to your ccflags config.sh variable to change its behavior. You can
+find out more about these and other flags by reading the commentary near
+the top of the malloc.c source. The defaults should be fine for
+nearly everyone.
=over 4
-=item -DPERL_EMERGENCY_SBRK
-
-If PERL_EMERGENCY_SBRK is defined, running out of memory need not be a
-fatal error: a memory pool can allocated by assigning to the special
-variable $^M. See perlvar(1) for more details.
-
-=item -DPACK_MALLOC
-
-If PACK_MALLOC is defined, malloc.c uses a slightly different
-algorithm for small allocations (up to 64 bytes long). Such small
-allocations are quite common in typical Perl scripts.
-
-The expected memory savings (with 8-byte alignment in $alignbytes) is
-about 20% for typical Perl usage. The expected slowdown due to the
-additional malloc overhead is in fractions of a percent. (It is hard
-to measure because of the effect of the saved memory on speed).
+=item -DNO_FANCY_MALLOC
-=item -DTWO_POT_OPTIMIZE
+Undefined by default. Defining it returns malloc to the version used
+in Perl 5.004.
-If TWO_POT_OPTIMIZE is defined, malloc.c uses a slightly different
-algorithm for large allocations that are close to a power of two
-(starting with 16K). Such allocations are typical for big hashes and
-special-purpose scripts, especially image processing. If you will be
-manipulating very large blocks with sizes close to powers of two, it
-might be wise to define this macro.
+=item -DPLAIN_MALLOC
-The expected saving of memory is 0-100% (100% in applications which
-require most memory in such 2**n chunks). The expected slowdown is
-negligible.
+Undefined by default. Defining it in addition to NO_FANCY_MALLOC returns
+malloc to the version used in Perl version 5.000.
=back
@@ -719,7 +792,7 @@ you probably want to do
This will do two independent things: First, it will force compilation
to use cc -g so that you can use your system's debugger on the
executable. (Note: Your system may actually require something like
-cc -g2. Check you man pages for cc(1) and also any hint file for your
+cc -g2. Check your man pages for cc(1) and also any hint file for your
system.) Second, it will add -DDEBUGGING to your ccflags variable in
config.sh so that you can use B<perl -D> to access perl's internal
state. (Note: Configure will only add -DDEBUGGING by
@@ -741,17 +814,6 @@ you can change a number of factors in the way perl is built
by adding appropriate -D directives to your ccflags variable in
config.sh.
-For example, you can replace the rand() and srand() functions in the
-perl source by any other random number generator by a trick such as the
-following:
-
- sh Configure -Dccflags='-Drand=random -Dsrand=srandom'
-
-or by adding -Drand=random and -Dsrand=srandom to your ccflags
-at the appropriate Configure prompt. (Note: Although this worked for
-me, it might not work for you if your system's header files give
-different prototypes for rand() and random() or srand() and srandom().)
-
You should also run Configure interactively to verify that a hint file
doesn't inadvertently override your ccflags setting. (Hints files
shouldn't do that, but some might.)
@@ -782,9 +844,10 @@ in the hints/ directory. If one of them matches your system, Configure
will offer to use that hint file.
Several of the hint files contain additional important information.
-If you have any problems, it is a good idea to read the relevant hint
-file for further information. See hints/solaris_2.sh for an
-extensive example.
+If you have any problems, it is a good idea to read the relevant hint file
+for further information. See hints/solaris_2.sh for an extensive example.
+More information about writing good hints is in the hints/README.hints
+file.
=item *** WHOA THERE!!! ***
@@ -809,7 +872,8 @@ system.
For example, suppose you have added libgdbm.a to your system
and you decide to reconfigure perl to use GDBM_File. When you run
Configure again, you will need to add -lgdbm to the list of libraries.
-Now, Configure will find your gdbm library and will issue a message:
+Now, Configure will find your gdbm include file and library and will
+issue a message:
*** WHOA THERE!!! ***
The previous value for $i_gdbm on this machine was "undef"!
@@ -868,20 +932,58 @@ toke.c and put the command optimize='-g' before the ;; . You
can also edit cflags directly, but beware that your changes will be
lost the next time you run Configure.
-To change the C flags for all the files, edit config.sh
-and change either $ccflags or $optimize,
-and then re-run
+To explore various ways of changing ccflags from within a hint file,
+see the file hints/README.hints.
+
+To change the C flags for all the files, edit config.sh and change either
+$ccflags or $optimize, and then re-run
sh Configure -S
make depend
=item No sh
-If you don't have sh, you'll have to copy the sample file config_H to
-config.h and edit the config.h to reflect your system's peculiarities.
+If you don't have sh, you'll have to copy the sample file Porting/config_H
+to config.h and edit the config.h to reflect your system's peculiarities.
You'll probably also have to extensively modify the extension building
mechanism.
+=item Environment variable clashes
+
+Configure uses a CONFIG variable that is reported to cause trouble on
+ReliantUnix 5.44. If your system sets this variable, you can try
+unsetting it before you run Configure. Configure should eventually
+be fixed to avoid polluting the namespace of the environment.
+
+=item Digital UNIX/Tru64 UNIX and BIN_SH
+
+In Digital UNIX/Tru64 UNIX Configure might abort with
+
+Build a threading Perl? [n]
+Configure[2437]: Syntax error at line 1 : `config.sh' is not expected.
+
+This indicates that Configure is being run with a broken Korn shell
+(even though you think you are using a Bourne shell by using
+"sh Configure" or "./Configure"). The Korn shell bug has been reported
+to Compaq as of February 1999 but in the meanwhile, the reason ksh is
+being used is that you have the environment variable BIN_SH set to
+'xpg4'. This causes /bin/sh to delegate its duties to /bin/posix/sh
+(a ksh). Unset the environment variable and rerun Configure.
+
+=item HP-UX 11, pthreads, and libgdbm
+
+If you are running Configure with -Dusethreads in HP-UX 11, be warned
+that POSIX threads and libgdbm (the GNU dbm library) compiled before
+HP-UX 11 do not mix. This will cause a basic test run by Configure to
+fail
+
+Pthread internal error: message: __libc_reinit() failed, file: ../pthreads/pthread.c, line: 1096
+Return Pointer is 0xc082bf33
+sh: 5345 Quit(coredump)
+
+and Configure will give up. The cure is to recompile and install
+libgdbm under HP-UX 11.
+
=item Porting information
Specific information for the OS/2, Plan9, VMS and Win32 ports is in the
@@ -897,14 +999,12 @@ various other operating systems.
=head1 make depend
-This will look for all the includes.
-The output is stored in makefile. The only difference between
-Makefile and makefile is the dependencies at the bottom of
-makefile. If you have to make any changes, you should edit
-makefile, not Makefile since the Unix make command reads
-makefile first. (On non-Unix systems, the output may be stored in
-a different file. Check the value of $firstmakefile in your config.sh
-if in doubt.)
+This will look for all the includes. The output is stored in makefile.
+The only difference between Makefile and makefile is the dependencies at
+the bottom of makefile. If you have to make any changes, you should edit
+makefile, not Makefile since the Unix make command reads makefile first.
+(On non-Unix systems, the output may be stored in a different file.
+Check the value of $firstmakefile in your config.sh if in doubt.)
Configure will offer to do this step for you, so it isn't listed
explicitly above.
@@ -932,40 +1032,51 @@ for further tips and information.
If you can successfully build miniperl, but the process crashes
during the building of extensions, you should run
- make minitest
+ make minitest
to test your version of miniperl.
=item locale
-If you have any locale-related environment variables set, try
-unsetting them. I have some reports that some versions of IRIX hang
-while running B<./miniperl configpm> with locales other than the C
-locale. See the discussion under L<make test> below about locales.
+If you have any locale-related environment variables set, try unsetting
+them. I have some reports that some versions of IRIX hang while
+running B<./miniperl configpm> with locales other than the C locale.
+See the discussion under L<"make test"> below about locales and the
+whole L<"Locale problems"> section in the file pod/perllocale.pod.
+The latter is especially useful if you see something like this
+
+ perl: warning: Setting locale failed.
+ perl: warning: Please check that your locale settings:
+ LC_ALL = "En_US",
+ LANG = (unset)
+ are supported and installed on your system.
+ perl: warning: Falling back to the standard locale ("C").
+
+at Perl startup.
=item malloc duplicates
-If you get duplicates upon linking for malloc et al, add -DHIDEMYMALLOC
-or -DEMBEDMYMALLOC to your ccflags variable in config.sh.
+If you get duplicates upon linking for malloc et al, add -DEMBEDMYMALLOC
+to your ccflags variable in config.sh.
=item varargs
If you get varargs problems with gcc, be sure that gcc is installed
-correctly. When using gcc, you should probably have i_stdarg='define'
-and i_varargs='undef' in config.sh. The problem is usually solved by
-running fixincludes correctly. If you do change config.sh, don't
-forget to propagate your changes (see
-L<"Propagating your changes to config.sh"> below).
+correctly and that you are not passing -I/usr/include to gcc. When using
+gcc, you should probably have i_stdarg='define' and i_varargs='undef'
+in config.sh. The problem is usually solved by running fixincludes
+correctly. If you do change config.sh, don't forget to propagate
+your changes (see L<"Propagating your changes to config.sh"> below).
See also the L<"vsprintf"> item below.
-=item croak
+=item util.c
If you get error messages such as the following (the exact line
-numbers will vary in different versions of perl):
+numbers and function name may vary in different versions of perl):
- util.c: In function `Perl_croak':
- util.c:962: number of arguments doesn't match prototype
- proto.h:45: prototype declaration
+ util.c: In function `Perl_form':
+ util.c:1107: number of arguments doesn't match prototype
+ proto.h:125: prototype declaration
it might well be a symptom of the gcc "varargs problem". See the
previous L<"varargs"> item.
@@ -1032,6 +1143,14 @@ or by answering the nm extraction question interactively.
If you have previously run Configure, you should not reuse your old
config.sh.
+=item umask not found
+
+If the build processes encounters errors relating to umask(), the problem
+is probably that Configure couldn't find your umask() system call.
+Check your config.sh. You should have d_umask='define'. If you don't,
+this is probably the L<"nm extraction"> problem discussed above. Also,
+try reading the hints file for your system for further information.
+
=item vsprintf
If you run into problems with vsprintf in compiling util.c, the
@@ -1043,15 +1162,15 @@ d_vprintf in config.sh. If your system has vprintf, it should be:
d_vprintf='define'
If Configure guessed wrong, it is likely that Configure guessed wrong
-on a number of other common functions too. You are probably better off
-re-running Configure without using nm extraction (see previous item).
+on a number of other common functions too. This is probably
+the L<"nm extraction"> problem discussed above.
=item do_aspawn
If you run into problems relating to do_aspawn or do_spawn, the
problem is probably that Configure failed to detect your system's
-fork() function. Follow the procedure in the previous items
-on L<"vsprintf"> and L<"nm extraction">.
+fork() function. Follow the procedure in the previous item
+on L<"nm extraction">.
=item __inet_* errors
@@ -1072,7 +1191,7 @@ optimizer. Edit config.sh and change the line
optimize='-O'
-to something like
+to
optimize=' '
@@ -1091,7 +1210,8 @@ indigestion easily.
If you have missing routines, you probably need to add some library or
other, or you need to undefine some feature that Configure thought was
there but is defective or incomplete. Look through config.h for
-likely suspects.
+likely suspects. If Configure guessed wrong on a number of functions,
+you might have the L<"nm extraction"> problem discussed above.
=item toke.c
@@ -1147,6 +1267,32 @@ Old versions of the DB library (including the DB library which comes
with FreeBSD 2.1) had broken handling of recno databases with modified
bval settings. Upgrade your DB library or OS.
+=item Bad arg length for semctl, is XX, should be ZZZ
+
+If you get this error message from the lib/ipc_sysv test, your System
+V IPC may be broken. The XX typically is 20, and that is what ZZZ
+also should be. Consider upgrading your OS, or reconfiguring your OS
+to include the System V semaphores.
+
+=item lib/ipc_sysv........semget: No space left on device
+
+Either your account or the whole system has run out of semaphores. Or
+both. Either list the semaphores with "ipcs" and remove the unneeded
+ones (which ones these are depends on your system and applications)
+with "ipcrm -s SEMAPHORE_ID_HERE" or configure more semaphores to your
+system.
+
+=item GNU binutils
+
+If you mix GNU binutils (nm, ld, ar) with equivalent vendor-supplied
+tools you may be in for some trouble. For example creating archives
+with an old GNU 'ar' and then using a new current vendor-supplied 'ld'
+may lead into linking problems. Either recompile your GNU binutils
+under your current operating system release, or modify your PATH not
+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 Miscellaneous
Some additional things that have been reported for either perl4 or perl5:
@@ -1157,10 +1303,20 @@ NCR Tower 32 (OS 2.01.01) may need -W2,-Sl,2000 and #undef MKDIR.
UTS may need one or more of -DCRIPPLED_CC, -K or -g, and undef LSTAT.
+FreeBSD can fail the lib/ipc_sysv.t test if SysV IPC has not been
+configured to the kernel. Perl tries to detect this, though, and
+you will get a message telling what to do.
+
If you get syntax errors on '(', try -DCRIPPLED_CC.
Machines with half-implemented dbm routines will need to #undef I_ODBM
+HP-UX 11 Y2K patch "Y2K-1100 B.11.00.B0125 HP-UX Core OS Year 2000
+Patch Bundle" has been reported to break the io/fs test #18 which
+tests whether utime() can change timestamps. The Y2K patch seems to
+break utime() so that over NFS the timestamps do not get changed
+(on local filesystems utime() still works).
+
=back
=head1 make test
@@ -1174,6 +1330,8 @@ Note that you can't run the tests in background if this disables
opening of /dev/tty. You can use 'make test-notty' in that case but
a few tty tests will be skipped.
+=head2 What if make test doesn't work?
+
If make test bombs out, just cd to the t directory and run ./TEST
by hand to see if it makes any difference. If individual tests
bomb, you can run them by hand, e.g.,
@@ -1191,6 +1349,10 @@ complicated constructs).
You should also read the individual tests to see if there are any helpful
comments that apply to your system.
+=over 4
+
+=item locale
+
Note: One possible reason for errors is that some external programs
may be broken due to the combination of your environment and the way
B<make test> exercises them. For example, this may happen if you have
@@ -1214,6 +1376,26 @@ things like: exec, `backquoted command`, system, open("|...") or
open("...|"). All these mean that Perl is trying to run some
external program.
+=item Out of memory
+
+On some systems, particularly those with smaller amounts of RAM, some
+of the tests in t/op/pat.t may fail with an "Out of memory" message.
+Specifically, in perl5.004_64, tests 74 and 78 have been reported to
+fail on some systems. On my SparcStation IPC with 8 MB of RAM, test 78
+will fail if the system is running any other significant tasks at the
+same time.
+
+Try stopping other jobs on the system and then running the test by itself:
+
+ cd t; ./perl op/pat.t
+
+to see if you have any better luck. If your perl still fails this
+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.
+
+=back
+
=head1 make install
This will put perl into the public directory you specified to
@@ -1223,6 +1405,16 @@ pages, however. You may need to be root to run B<make install>. If you
are not root, you must own the directories in question and you should
ignore any messages about chown not working.
+=head2 Installing perl under different names
+
+If you want to install perl under a name other than "perl" (for example,
+when installing perl with special features enabled, such as debugging),
+indicate the alternate name on the "make install" line, such as:
+
+ make install PERLNAME=myperl
+
+=head2 Installed files
+
If you want to see exactly what will happen without installing
anything, you can run
@@ -1263,9 +1455,11 @@ make install will install the following:
Installperl will also create the library directories $siteperl and
$sitearch listed in config.sh. Usually, these are something like
- /usr/local/lib/perl5/site_perl/
- /usr/local/lib/perl5/site_perl/$archname
-where $archname is something like sun4-sunos. These directories
+
+ /usr/local/lib/perl5/site_perl/5.005
+ /usr/local/lib/perl5/site_perl/5.005/archname
+
+where archname is something like sun4-sunos. These directories
will be used for installing extensions.
Perl's *.h header files and the libperl.a library are also installed
@@ -1275,37 +1469,60 @@ program even if the Perl source is no longer available.
=head1 Coexistence with earlier versions of perl5
-You can safely install the current version of perl5 and still run scripts
-under the old binaries for versions 5.003 and later ONLY. Instead of
-starting your script with #!/usr/local/bin/perl, just start it with
-#!/usr/local/bin/perl5.003 (or whatever version you want to run.)
-If you want to retain a version of Perl 5 prior to 5.003, you'll
-need to install the current version in a separate directory tree,
-since some of the architecture-independent library files have changed
-in incompatible ways.
-
-The old architecture-dependent files are stored in a version-specific
-directory (such as /usr/local/lib/perl5/sun4-sunos/5.003) so that they
-will still be accessible even after a later version is installed.
-(Note: Perl 5.000 and 5.001 did not put their architecture-dependent
-libraries in a version-specific directory. They are simply in
-/usr/local/lib/perl5/$archname. If you will not be using 5.000 or
-5.001, you may safely remove those files.)
-
-In general, the standard library files in /usr/local/lib/perl5 should
-be usable by all versions of perl5. However, the diagnostics.pm module
-uses the /usr/local/lib/perl5/pod/perldiag.pod documentation file, so
-the C<use diagnostics;> pragma and the splain script will only identify
-and explain any warnings or errors that the most recently-installed
-version of perl can generate.
-
-Most extensions will probably not need to be recompiled to use with a newer
-version of perl. If you do run into problems, and you want to continue
-to use the old version of perl along with your extension, simply move
-those extension files to the appropriate version directory, such as
-/usr/local/lib/perl/archname/5.003. Then Perl 5.003 will find your
-files in the 5.003 directory, and newer versions of perl will find your
-newer extension in the site_perl directory.
+WARNING: The upgrade from 5.004_0x to 5.005 is going to be a bit
+tricky. See L<"Upgrading from 5.004 to 5.005"> below.
+
+In general, you can usually safely upgrade from one version of Perl (e.g.
+5.004_04) to another similar version (e.g. 5.004_05) without re-compiling
+all of your add-on extensions. You can also safely leave the old version
+around in case the new version causes you problems for some reason.
+For example, if you want to be sure that your script continues to run
+with 5.004_04, simply replace the '#!/usr/local/bin/perl' line at the
+top of the script with the particular version you want to run, e.g.
+#!/usr/local/bin/perl5.00404.
+
+Most extensions will probably not need to be recompiled to use
+with a newer version of perl. Here is how it is supposed to work.
+(These examples assume you accept all the Configure defaults.)
+
+The directories searched by version 5.005 will be
+
+ Configure variable Default value
+ $archlib /usr/local/lib/perl5/5.005/archname
+ $privlib /usr/local/lib/perl5/5.005
+ $sitearch /usr/local/lib/perl5/site_perl/5.005/archname
+ $sitelib /usr/local/lib/perl5/site_perl/5.005
+
+while the directories searched by version 5.005_01 will be
+
+ $archlib /usr/local/lib/perl5/5.00501/archname
+ $privlib /usr/local/lib/perl5/5.00501
+ $sitearch /usr/local/lib/perl5/site_perl/5.005/archname
+ $sitelib /usr/local/lib/perl5/site_perl/5.005
+
+When you install an add-on extension, it gets installed into $sitelib (or
+$sitearch if it is architecture-specific). This directory deliberately
+does NOT include the sub-version number (01) so that both 5.005 and
+5.005_01 can use the extension. Only when a perl version changes to
+break backwards compatibility will the default suggestions for the
+$sitearch and $sitelib version numbers be increased.
+
+However, if you do run into problems, and you want to continue to use the
+old version of perl along with your extension, move those extension files
+to the appropriate version directory, such as $privlib (or $archlib).
+(The extension's .packlist file lists the files installed with that
+extension. For the Tk extension, for example, the list of files installed
+is in $sitearch/auto/Tk/.packlist.) Then use your newer version of perl
+to rebuild and re-install the extension into $sitelib. This way, Perl
+5.005 will find your files in the 5.005 directory, and newer versions
+of perl will find your newer extension in the $sitelib directory.
+(This is also why perl searches the site-specific libraries last.)
+
+Alternatively, if you are willing to reinstall all your extensions
+every time you upgrade perl, then you can include the subversion
+number in $sitearch and $sitelib when you run Configure.
+
+=head2 Maintaining completely separate versions
Many users prefer to keep all versions of perl in completely
separate directories. One convenient way to do this is by
@@ -1317,11 +1534,24 @@ and adding /opt/perl5.004/bin to the shell PATH variable. Such users
may also wish to add a symbolic link /usr/local/bin/perl so that
scripts can still start with #!/usr/local/bin/perl.
+Others might share a common directory for maintenance sub-versions
+(e.g. 5.004 for all 5.004_0x versions), but change directory with
+each major version.
+
If you are installing a development subversion, you probably ought to
seriously consider using a separate directory, since development
subversions may not have all the compatibility wrinkles ironed out
yet.
+=head2 Upgrading from 5.004 to 5.005
+
+Extensions built and installed with versions of perl prior to 5.004_50
+will need to be recompiled to be used with 5.004_50 and later. You will,
+however, be able to continue using 5.004 even after you install 5.005.
+The 5.004 binary will still be able to find the extensions built under
+5.004; the 5.005 binary will look in the new $sitearch and $sitelib
+directories, and will not find them.
+
=head1 Coexistence with perl4
You can safely install perl5 even if you want to keep perl4 around.
@@ -1342,11 +1572,8 @@ for possible problems running perl4 scripts under perl5.
Some perl scripts need to be able to obtain information from
the system header files. This command will convert the most commonly used
header files in /usr/include into files that can be easily interpreted
-by perl. These files will be placed in the architectural library directory
-you specified to Configure; by default this is
-/usr/local/lib/perl5/ARCH/VERSION, where ARCH is your architecture
-(such as sun4-solaris) and VERSION is the version of perl you are
-building (for example, 5.004).
+by perl. These files will be placed in the architecture-dependent library
+($archlib) directory you specified to Configure.
Note: Due to differences in the C and perl languages, the
conversion of the header files is not perfect. You will probably have
@@ -1392,31 +1619,32 @@ available in TeX format. Type
=head1 Reporting Problems
-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 an accurate description of your problem.
+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
+an accurate description of your problem.
-Please include the output of the ./myconfig shell script
-that comes with the distribution. Alternatively, you can use the
-perlbug program that comes with the perl distribution,
-but you need to have perl compiled and installed before you can use it.
+Please include the output of the ./myconfig shell script that comes with
+the distribution. Alternatively, you can use the perlbug program that
+comes with the perl distribution, but you need to have perl compiled
+before you can use it. (If you have not installed it yet, you need to
+run C<./perl -Ilib utils/perlbug> instead of a plain C<perlbug>.)
-You might also find helpful information in the Porting
-directory of the perl distribution.
+You might also find helpful information in the Porting directory of the
+perl distribution.
=head1 DOCUMENTATION
-Read the manual entries before running perl. The main documentation is
-in the pod/ subdirectory and should have been installed during the
+Read the manual entries before running perl. The main documentation
+is in the pod/ subdirectory and should have been installed during the
build process. Type B<man perl> to get started. Alternatively, you
-can type B<perldoc perl> to use the supplied perldoc script. This
-is sometimes useful for finding things in the library modules.
+can type B<perldoc perl> to use the supplied perldoc script. This is
+sometimes useful for finding things in the library modules.
Under UNIX, you can produce a documentation book in postscript form,
-along with its table of contents, by going to the pod/ subdirectory
-and running (either):
+along with its table of contents, by going to the pod/ subdirectory and
+running (either):
./roffitall -groff # If you have GNU groff installed
./roffitall -psroff # If you have psroff
@@ -1425,20 +1653,28 @@ This will leave you with two postscript files ready to be printed.
(You may need to fix the roffitall command to use your local troff
set-up.)
-Note that you must have performed the installation already before
-running the above, since the script collects the installed files to
-generate the documentation.
+Note that you must have performed the installation already before running
+the above, since the script collects the installed files to generate
+the documentation.
=head1 AUTHOR
-Original author: Andy Dougherty doughera@lafcol.lafayette.edu ,
-borrowing very heavily from the original README by Larry Wall,
-with lots of helpful feedback and additions from the
-perl5-porters@perl.org folks.
+Original author: Andy Dougherty doughera@lafayette.edu , borrowing very
+heavily from the original README by Larry Wall, with lots of helpful
+feedback and additions from the perl5-porters@perl.org folks.
-If you have problems or questions, please see L<"Reporting Problems">
-above.
+If you have problems, corrections, or questions, please see
+L<"Reporting Problems"> above.
+
+=head1 REDISTRIBUTION
+
+This document is part of the Perl package and may be distributed under
+the same terms as perl itself.
+
+If you are distributing a modified version of perl (perhaps as part of
+a larger package) please do modify these installation instructions and
+the contact information to match your distribution.
=head1 LAST MODIFIED
-$Id: INSTALL,v 1.28 1997/10/10 16:50:59 doughera Released $
+$Id: INSTALL,v 1.42 1998/07/15 18:04:44 doughera Released $
diff --git a/gnu/usr.bin/perl/INTERN.h b/gnu/usr.bin/perl/INTERN.h
index ba71c2f7adf..118e47ca185 100644
--- a/gnu/usr.bin/perl/INTERN.h
+++ b/gnu/usr.bin/perl/INTERN.h
@@ -1,6 +1,6 @@
/* INTERN.h
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -18,16 +18,27 @@
#undef EXTCONST
#undef dEXTCONST
#if defined(VMS) && !defined(__GNUC__)
+ /* Suppress portability warnings from DECC for VMS-specific extensions */
+# ifdef __DECC
+# pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT)
+# endif
# define EXT globaldef {"$GLOBAL_RW_VARS"} noshare
# define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare
# define EXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly
# define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly
#else
+# ifdef __cplusplus
+# define EXT
+# define dEXT
+# define EXTCONST extern const
+# define dEXTCONST const
+#else
# define EXT
# define dEXT
# define EXTCONST const
# define dEXTCONST const
#endif
+#endif
#undef INIT
#define INIT(x) = x
diff --git a/gnu/usr.bin/perl/MANIFEST b/gnu/usr.bin/perl/MANIFEST
index 26a54094aff..f42a8323266 100644
--- a/gnu/usr.bin/perl/MANIFEST
+++ b/gnu/usr.bin/perl/MANIFEST
@@ -4,8 +4,7 @@ Changes5.000 Differences between 4.x and 5.000
Changes5.001 Differences between 5.000 and 5.001
Changes5.002 Differences between 5.001 and 5.002
Changes5.003 Differences between 5.002 and 5.003
-configure Crude emulation of GNU configure
-configure.gnu Copy of configure (for case-insensitive systems)
+Changes5.004 Differences between 5.003 and 5.004
Configure Portability tool
Copying The GNU General Public License
EXTERN.h Included before foreign .h files
@@ -13,27 +12,57 @@ INSTALL Detailed installation instructions
INTERN.h Included before domestic .h files
MANIFEST This list of files
Makefile.SH A script that generates Makefile
+objXSUB.h Scoping macros for Perl Object in extensions
+Policy_sh.SH Hold site-wide preferences between Configure runs.
+Porting/Contract Social contract for contributed modules in Perl core
Porting/Glossary Glossary of config.sh variables
+Porting/config.sh Sample config.sh
+Porting/config_H Sample config.h
+Porting/findvars Find occurrences of words
+Porting/fixCORE Find and fix modules that generate warnings
+Porting/fixvars Find undeclared variables with C compiler and fix em
+Porting/genlog Generate formatted changelogs by querying p4d
Porting/makerel Release making utility
+Porting/p4d2p Generate standard patches from p4 diffs
+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
README The Instructions
README.amiga Notes about AmigaOS port
+README.apollo Notes about Apollo DomainOS port
+README.beos Notes about BeOS port
README.cygwin32 Notes about Cygwin32 port
+README.dos Notes about dos/djgpp port
+README.hpux Notes about HP-UX port
+README.hurd Notes about GNU/Hurd port
+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.qnx Notes about QNX port
+README.threads Notes about multithreading
README.vms Notes about VMS port
+README.vos Notes about Stratus VOS port
README.win32 Notes about Win32 port
Todo The Wishlist
+Todo-5.005 What needs doing before 5.005 release
+XSlock.h Include file for extensions built with PERL_OBJECT defined
XSUB.h Include file for extension subroutines
+apollo/netinet/in.h Apollo DomainOS port: C header file frontend
av.c Array value code
av.h Array value header
+beos/nm.c BeOS port
+bytecode.h Bytecode header for compiler
+bytecode.pl Produces byterun.h, byterun.c and ext/B/Asmdata.pm
+byterun.c Runtime support for compiler-generated bytecode
+byterun.h Header for byterun.c
+cc_runtime.h Macros need by runtime of compiler-generated code
cflags.SH A script that emits C compilation flags per file
-compat3.sym List of symbols for binary-compatibility with 5.003
-config_H Sample config.h
config_h.SH Produces config.h
configpm Produces lib/Config.pm
+configure.com Configure-equivalent for VMS
+configure.gnu Crude emulation of GNU configure
cop.h Control operator header
cv.h Code value header
cygwin32/cw32imp.h Cygwin32 port
@@ -42,18 +71,26 @@ cygwin32/ld2 Cygwin32 port
cygwin32/perlgcc Cygwin32 port
cygwin32/perlld Cygwin32 port
deb.c Debugging routines
+djgpp/config.over DOS/DJGPP port
+djgpp/configure.bat DOS/DJGPP port
+djgpp/djgpp.c DOS/DJGPP port
+djgpp/djgppsed.sh DOS/DJGPP port
+djgpp/fixpmain DOS/DJGPP port
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
+eg/cgi/caution.xbm CGI example
eg/cgi/clickable_image.cgi CGI example
eg/cgi/cookie.cgi CGI example
eg/cgi/crash.cgi CGI example
eg/cgi/customize.cgi CGI example
eg/cgi/diff_upload.cgi CGI example
+eg/cgi/dna.small.gif.uu Small image for CGI examples
eg/cgi/file_upload.cgi CGI example
eg/cgi/frameset.cgi CGI example
eg/cgi/index.html Index page for CGI examples
@@ -62,6 +99,7 @@ eg/cgi/javascript.cgi CGI example
eg/cgi/monty.cgi CGI example
eg/cgi/multiple_forms.cgi CGI example
eg/cgi/nph-clock.cgi CGI example
+eg/cgi/nph-multipart.cgi CGI example
eg/cgi/popup.cgi CGI example
eg/cgi/save_state.cgi CGI example
eg/cgi/tryit.cgi CGI example
@@ -109,31 +147,81 @@ eg/van/vanish A program to put files in a trashcan
eg/who A sample who program
eg/wrapsuid A setuid script wrapper generator
emacs/cperl-mode.el An alternate perl-mode
+emacs/ptags Creates smart TAGS file
embed.h Maps symbols to safer names
embed.pl Produces embed.h
+embedvar.h C namespace management
+ext/B/B.pm Compiler backend support functions and methods
+ext/B/B.xs Compiler backend external subroutines
+ext/B/B/Asmdata.pm Compiler backend data for assembler
+ext/B/B/Assembler.pm Compiler backend assembler support functions
+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/Debug.pm Compiler Debug backend
+ext/B/B/Deparse.pm Compiler Deparse backend
+ext/B/B/Disassembler.pm Compiler Disassembler backend
+ext/B/B/Lint.pm Compiler Lint backend
+ext/B/B/Showlex.pm Compiler Showlex backend
+ext/B/B/Stackobj.pm Compiler stack objects support functions
+ext/B/B/Terse.pm Compiler Terse backend
+ext/B/B/Xref.pm Compiler Xref backend
+ext/B/B/assemble Assemble compiler bytecode
+ext/B/B/cc_harness Simplistic wrapper for using -MO=CC compiler
+ext/B/B/disassemble Disassemble compiler bytecode output
+ext/B/B/makeliblinks Make a simplistic XSUB .so symlink tree for compiler
+ext/B/Makefile.PL Compiler backend makefile writer
+ext/B/NOTES Compiler backend notes
+ext/B/O.pm Compiler front-end module (-MO=...)
+ext/B/README Compiler backend README
+ext/B/TESTS Compiler backend test data
+ext/B/Todo Compiler backend Todo list
+ext/B/byteperl.c Bytecode runner
+ext/B/ramblings/cc.notes Compiler ramblings: notes on CC backend
+ext/B/ramblings/curcop.runtime Compiler ramblings: notes on curcop use
+ext/B/ramblings/flip-flop Compiler ramblings: notes on flip-flop
+ext/B/ramblings/magic Compiler ramblings: notes on magic
+ext/B/ramblings/reg.alloc Compiler ramblings: register allocation
+ext/B/ramblings/runtime.porting Compiler ramblings: porting PP enging
+ext/B/typemap Compiler backend interface types
+ext/DB_File/Changes Berkeley DB extension change log
ext/DB_File/DB_File.pm Berkeley DB extension Perl module
ext/DB_File/DB_File.xs Berkeley DB extension external subroutines
ext/DB_File/DB_File_BS Berkeley DB extension mkbootstrap fodder
ext/DB_File/Makefile.PL Berkeley DB extension makefile writer
+ext/DB_File/dbinfo Berkeley DB database version checker
+ext/DB_File/hints/dynixptx.pl Hints for DB_File for named architecture
ext/DB_File/typemap Berkeley DB extension interface types
-ext/DynaLoader/DynaLoader.pm Dynamic Loader perl module
+ext/Data/Dumper/Changes Data pretty printer, changelog
+ext/Data/Dumper/Dumper.pm Data pretty printer, module
+ext/Data/Dumper/Dumper.xs Data pretty printer, externals
+ext/Data/Dumper/Makefile.PL Data pretty printer, makefile writer
+ext/Data/Dumper/Todo Data pretty printer, futures
+ext/DynaLoader/DynaLoader_pm.PL Dynamic Loader perl module
ext/DynaLoader/Makefile.PL Dynamic Loader makefile writer
ext/DynaLoader/README Dynamic Loader notes and intro
ext/DynaLoader/dl_aix.xs AIX implementation
+ext/DynaLoader/dl_beos.xs BeOS implementation
ext/DynaLoader/dl_cygwin32.xs Cygwin32 implementation
ext/DynaLoader/dl_dld.xs GNU dld style implementation
ext/DynaLoader/dl_dlopen.xs BSD/SunOS4&5 dlopen() style implementation
ext/DynaLoader/dl_hpux.xs HP-UX implementation
+ext/DynaLoader/dl_mpeix.xs MPE/iX implementation
ext/DynaLoader/dl_next.xs Next implementation
ext/DynaLoader/dl_none.xs Stub implementation
ext/DynaLoader/dl_vms.xs VMS implementation
ext/DynaLoader/dlutils.c Dynamic loader utilities for dl_*.xs files
+ext/Errno/ChangeLog Errno perl module change log
+ext/Errno/Errno_pm.PL Errno perl module create script
+ext/Errno/Makefile.PL Errno extension makefile writer
ext/Fcntl/Fcntl.pm Fcntl extension Perl module
ext/Fcntl/Fcntl.xs Fcntl extension external subroutines
ext/Fcntl/Makefile.PL Fcntl extension makefile writer
ext/GDBM_File/GDBM_File.pm GDBM extension Perl module
ext/GDBM_File/GDBM_File.xs GDBM extension external subroutines
ext/GDBM_File/Makefile.PL GDBM extension makefile writer
+ext/GDBM_File/hints/sco.pl Hint for GDBM_File for named architecture
ext/GDBM_File/typemap GDBM extension interface types
ext/IO/IO.pm Top-level interface to IO::* classes
ext/IO/IO.xs IO extension external subroutines
@@ -145,6 +233,16 @@ ext/IO/lib/IO/Pipe.pm IO::Pipe extension Perl module
ext/IO/lib/IO/Seekable.pm IO::Seekable extension Perl module
ext/IO/lib/IO/Select.pm IO::Select extension Perl module
ext/IO/lib/IO/Socket.pm IO::Socket extension Perl module
+ext/IPC/SysV/ChangeLog IPC::SysV extension Perl module
+ext/IPC/SysV/MANIFEST IPC::SysV extension Perl module
+ext/IPC/SysV/Makefile.PL IPC::SysV extension Perl module
+ext/IPC/SysV/Msg.pm IPC::SysV extension Perl module
+ext/IPC/SysV/README IPC::SysV extension Perl module
+ext/IPC/SysV/Semaphore.pm IPC::SysV extension Perl module
+ext/IPC/SysV/SysV.pm IPC::SysV extension Perl module
+ext/IPC/SysV/SysV.xs IPC::SysV extension Perl module
+ext/IPC/SysV/t/msg.t IPC::SysV extension Perl module
+ext/IPC/SysV/t/sem.t IPC::SysV extension Perl module
ext/NDBM_File/Makefile.PL NDBM extension makefile writer
ext/NDBM_File/NDBM_File.pm NDBM extension Perl module
ext/NDBM_File/NDBM_File.xs NDBM extension external subroutines
@@ -172,7 +270,15 @@ ext/POSIX/Makefile.PL POSIX extension makefile writer
ext/POSIX/POSIX.pm POSIX extension Perl module
ext/POSIX/POSIX.pod POSIX extension documentation
ext/POSIX/POSIX.xs POSIX extension external subroutines
+ext/POSIX/hints/bsdos.pl Hint for POSIX for named architecture
+ext/POSIX/hints/dynixptx.pl Hint for POSIX for named architecture
+ext/POSIX/hints/freebsd.pl Hint for POSIX for named architecture
+ext/POSIX/hints/linux.pl Hint for POSIX for named architecture
+ext/POSIX/hints/mint.pl Hint for POSIX for named architecture
+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/typemap POSIX extension interface types
ext/SDBM_File/Makefile.PL SDBM extension makefile writer
ext/SDBM_File/SDBM_File.pm SDBM extension Perl module
@@ -206,8 +312,42 @@ 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/Thread/Makefile.PL Thread extension makefile writer
+ext/Thread/Notes Thread notes
+ext/Thread/README Thread README
+ext/Thread/Thread.pm Thread extension Perl module
+ext/Thread/Thread.xs Thread extension external subroutines
+ext/Thread/Thread/Queue.pm Thread synchronised queue objects
+ext/Thread/Thread/Semaphore.pm Thread semaphore objects
+ext/Thread/Thread/Signal.pm Start a thread to run signal handlers
+ext/Thread/Thread/Specific.pm Thread specific data access
+ext/Thread/create.t Test thread creation
+ext/Thread/die.t Test thread die()
+ext/Thread/die2.t Test thread die() differently
+ext/Thread/io.t Test threads doing simple I/O
+ext/Thread/join.t Test thread joining
+ext/Thread/join2.t Test thread joining differently
+ext/Thread/list.t Test getting list of all threads
+ext/Thread/lock.t Test lock primitive
+ext/Thread/queue.t Test Thread::Queue module
+ext/Thread/specific.t Test thread-specific user data
+ext/Thread/sync.t Test thread synchronisation
+ext/Thread/sync2.t Test thread synchronisation
+ext/Thread/typemap Thread extension interface types
+ext/Thread/unsync.t Test thread implicit synchronisation
+ext/Thread/unsync2.t Test thread implicit synchronisation
+ext/Thread/unsync3.t Test thread implicit synchronisation
+ext/Thread/unsync4.t Test thread implicit synchronisation
+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/mpeix.pl Hints for re for named architecture
+ext/re/re.pm re extension Perl module
+ext/re/re.xs re extension external subroutines
ext/util/make_ext Used by Makefile to execute extension Makefiles
ext/util/mkbootstrap Turns ext/*/*_BS into bootstrap info
+fakethr.h Fake threads header
form.h Public declarations for the above
global.sym Symbols that need hiding when embedded
globals.c File to declare global symbols (for shared library)
@@ -234,6 +374,7 @@ hints/altos486.sh Hints for named architecture
hints/amigaos.sh Hints for named architecture
hints/apollo.sh Hints for named architecture
hints/aux_3.sh Hints for named architecture
+hints/beos.sh Hints for named architecture
hints/broken-db.msg Warning message for systems with broken DB library
hints/bsdos.sh Hints for named architecture
hints/convexos.sh Hints for named architecture
@@ -242,6 +383,7 @@ hints/cygwin32.sh Hints for named architecture
hints/dcosx.sh Hints for named architecture
hints/dec_osf.sh Hints for named architecture
hints/dgux.sh Hints for named architecture
+hints/dos_djgpp.sh Hints for named architecture
hints/dynix.sh Hints for named architecture
hints/dynixptx.sh Hints for named architecture
hints/epix.sh Hints for named architecture
@@ -249,6 +391,7 @@ hints/esix4.sh Hints for named architecture
hints/fps.sh Hints for named architecture
hints/freebsd.sh Hints for named architecture
hints/genix.sh Hints for named architecture
+hints/gnu.sh Hints for named architecture
hints/greenhills.sh Hints for named architecture
hints/hpux.sh Hints for named architecture
hints/i386.sh Hints for named architecture
@@ -263,6 +406,7 @@ hints/linux.sh Hints for named architecture
hints/lynxos.sh Hints for named architecture
hints/machten.sh Hints for named architecture
hints/machten_2.sh Hints for named architecture
+hints/mint.sh Hints for named architecture
hints/mips.sh Hints for named architecture
hints/mpc.sh Hints for named architecture
hints/mpeix.sh Hints for named architecture
@@ -272,6 +416,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/openbsd.sh Hints for named architecture
hints/opus.sh Hints for named architecture
hints/os2.sh Hints for named architecture
hints/os390.sh Hints for named architecture
@@ -297,22 +442,24 @@ hints/unicosmk.sh Hints for named architecture
hints/unisysdynix.sh Hints for named architecture
hints/utekv.sh Hints for named architecture
hints/uts.sh Hints for named architecture
+hints/uwin.sh Hints for named architecture
hv.c Hash value code
hv.h Hash value header
installhtml Perl script to install html files for pods
installman Perl script to install man pages for pods
installperl Perl script to do "make install" dirty work
-interp.sym Interpreter specific symbols to hide in a struct
+intrpvar.h Variables held in each interpreter instance
+iperlsys.h Perl's interface to the system
keywords.h The keyword numbers
keywords.pl Program to write keywords.h
lib/AnyDBM_File.pm Perl module to emulate dbmopen
lib/AutoLoader.pm Autoloader base class
lib/AutoSplit.pm Split up autoload functions
lib/Benchmark.pm Measure execution time
-lib/Bundle/CPAN.pm The CPAN bundle
lib/CGI.pm Web server interface ("Common Gateway Interface")
lib/CGI/Apache.pm Support for Apache's Perl module
lib/CGI/Carp.pm Log server errors with helpful context
+lib/CGI/Cookie.pm Interface to Netscape Cookies
lib/CGI/Fast.pm Support for FastCGI (persistent server process)
lib/CGI/Push.pm Support for server push
lib/CGI/Switch.pm Simple interface for multiple server types
@@ -322,14 +469,16 @@ lib/CPAN/Nox.pm Runs CPAN while avoiding compiled extensions
lib/Carp.pm Error message base class
lib/Class/Struct.pm Declare struct-like datatypes as Perl classes
lib/Cwd.pm Various cwd routines (getcwd, fastcwd, chdir)
-lib/Devel/SelfStubber.pm Generate stubs for SelfLoader.pm
+lib/Devel/SelfStubber.pm Generate stubs for SelfLoader.pm
lib/DirHandle.pm like FileHandle only for directories
+lib/Dumpvalue.pm Screen dump of perl values
lib/English.pm Readable aliases for short variables
lib/Env.pm Map environment into ordinary variables
lib/Exporter.pm Exporter base class
lib/ExtUtils/Command.pm Utilities for Make on non-UNIX platforms
lib/ExtUtils/Embed.pm Utilities for embedding Perl in C programs
lib/ExtUtils/Install.pm Handles 'make install' on extensions
+lib/ExtUtils/Installed.pm Information on installed extensions
lib/ExtUtils/Liblist.pm Locates libraries
lib/ExtUtils/MM_OS2.pm MakeMaker methods for OS/2
lib/ExtUtils/MM_Unix.pm MakeMaker base class for Unix
@@ -339,9 +488,12 @@ lib/ExtUtils/MakeMaker.pm Write Makefiles for extensions
lib/ExtUtils/Manifest.pm Utilities to write MANIFEST files
lib/ExtUtils/Mkbootstrap.pm Writes a bootstrap file (see MakeMaker)
lib/ExtUtils/Mksymlists.pm Writes a linker options file for extensions
+lib/ExtUtils/Packlist.pm Manipulates .packlist files
+lib/ExtUtils/inst Give information about installed extensions
lib/ExtUtils/testlib.pm Fixes up @INC to use just-built extension
lib/ExtUtils/typemap Extension interface types
lib/ExtUtils/xsubpp External subroutine preprocessor
+lib/Fatal.pm Make errors in functions/builtins fatal
lib/File/Basename.pm Emulate the basename program
lib/File/CheckTree.pm Perl module supporting wholesale file mode validation
lib/File/Compare.pm Emulation of cmp command
@@ -349,6 +501,12 @@ lib/File/Copy.pm Emulation of cp command
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/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/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
@@ -380,12 +538,15 @@ lib/Sys/Syslog.pm Perl module supporting syslogging
lib/Term/Cap.pm Perl module supporting termcap usage
lib/Term/Complete.pm A command completion subroutine
lib/Term/ReadLine.pm Stub readline library
+lib/Test.pm A simple framework for writing test scripts
lib/Test/Harness.pm A test harness
lib/Text/Abbrev.pm An abbreviation table builder
lib/Text/ParseWords.pm Perl module to split words on arbitrary delimiter
lib/Text/Soundex.pm Perl module to implement Soundex
lib/Text/Tabs.pm Do expand and unexpand
lib/Text/Wrap.pm Paragraph formatter
+lib/Tie/Array.pm Base class for tied arrays
+lib/Tie/Handle.pm Base class for tied handles
lib/Tie/Hash.pm Base class for tied hashes
lib/Tie/RefHash.pm Base class for tied hashes with references as keys
lib/Tie/Scalar.pm Base class for tied scalars
@@ -406,7 +567,7 @@ lib/bigint.pl An arbitrary precision integer arithmetic package
lib/bigrat.pl An arbitrary precision rational arithmetic package
lib/blib.pm For "use blib"
lib/cacheout.pl Manages output filehandles when you need too many
-lib/chat2.pl Obsolete ipc library (use Comm.pm etc instead)
+lib/chat2.pl Obsolete ipc library (use Comm.pm etc instead)
lib/complete.pl A command completion subroutine
lib/constant.pm For "use constant"
lib/ctime.pl A ctime workalike
@@ -415,6 +576,7 @@ lib/dotsh.pl Code to "dot" in a shell script
lib/dumpvar.pl A variable dumper
lib/exceptions.pl catch and throw routines
lib/fastcwd.pl a faster but more dangerous getcwd
+lib/fields.pm Set up object field names for pseudo-hash-using classes
lib/find.pl A find emulator--used by find2perl
lib/finddepth.pl A depth-first find emulator--used by find2perl
lib/flush.pl Routines to do single flush
@@ -454,9 +616,20 @@ mg.c Magic code
mg.h Magic header
minimod.pl Writes lib/ExtUtils/Miniperl.pm
miniperlmain.c Basic perl w/o dynamic loading or extensions
+mint/errno.h MiNT port
+mint/Makefile MiNT port
+mint/pwd.c MiNT port
+mint/README MiNT port
+mint/stdio.h MiNT port
+mint/sys/time.h MiNT port
+mint/time.h MiNT port
+mpeix/mpeixish.h MPE/iX port
+mpeix/nm MPE/iX port
+mpeix/relink MPE/iX port
mv-if-diff Script to mv a file if it changed
myconfig Prints summary of the current configuration
nostdio.h Cause compile error on stdio calls
+objpp.h Scoping macros for Perl Object
op.c Opcode syntax tree code
op.h Opcode syntax tree header
opcode.h Automatically generated opcode header
@@ -501,20 +674,23 @@ os2/diff.configure Patches to Configure
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/os2ish.h Header for OS/2
+os2/os2thread.h pthread-like typedefs
os2/perl2cmd.pl Corrects installed binaries under OS/2
patchlevel.h The current patch level of perl
perl.c main()
perl.h Global declarations
perl_exp.SH Creates list of exported symbols for AIX
perlio.c C code for PerlIO abstraction
-perlio.h Interface to PerlIO abstraction
+perlio.h compatibility stub
perlio.sym Symbols for PerlIO abstraction
perlsdio.h Fake stdio using perlio
perlsfio.h Prototype sfio mapping for PerlIO
perlsh A poor man's perl shell
+perlvars.h Global variables
perly.c A byacc'ed perly.y
-perly.c.diff Fixup perly.c to allow recursion
+perly_c.diff Fixup perly.c to allow recursion
perly.fixer A program to remove yacc stack limitations
perly.h The header file for perly.c
perly.y Yacc grammar for perl
@@ -544,6 +720,7 @@ pod/perlcall.pod Callback info
pod/perldata.pod Data structure info
pod/perldebug.pod Debugger info
pod/perldelta.pod Changes since last version
+pod/perl5004delta.pod Changes from 5.003 to 5.004
pod/perldiag.pod Diagnostic info
pod/perldsc.pod Data Structures Cookbook
pod/perlembed.pod Embedding info
@@ -560,21 +737,27 @@ pod/perlfaq9.pod Frequently Asked Questions, Part 9
pod/perlform.pod Format info
pod/perlfunc.pod Function info
pod/perlguts.pod Internals info
+pod/perlhist.pod Perl history info
pod/perlipc.pod IPC info
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.pod Module policy info
pod/perlobj.pod Object info
pod/perlop.pod Operator info
+pod/perlopentut.pod open() tutorial
pod/perlpod.pod Pod info
+pod/perlport.pod Portability guide
pod/perlre.pod Regular expression info
pod/perlref.pod References info
+pod/perlreftut.pod References tutorial
pod/perlrun.pod Execution info
pod/perlsec.pod Security info
pod/perlstyle.pod Style info
pod/perlsub.pod Subroutine info
pod/perlsyn.pod Syntax info
+pod/perlthrtut.pod Threads tutorial
pod/perltie.pod Tieing an object class into a simple variable
pod/perltoc.pod Table of Contents info
pod/perltoot.pod Tom's object-oriented tutorial
@@ -594,14 +777,18 @@ pp.c Push/Pop code
pp.h Push/Pop code defs
pp_ctl.c Push/Pop code for control flow
pp_hot.c Push/Pop code for heavily used opcodes
+pp_proto.h C++ definitions for Push/Pop code
pp_sys.c Push/Pop code for system interaction
proto.h Prototypes
qnx/ar QNX implementation of "ar" utility
qnx/cpp QNX implementation of preprocessor filter
regcomp.c Regular expression compiler
regcomp.h Private declarations for above
+regcomp.pl Builder of regnodes.h
+regcomp.sym Data for regnodes.h
regexec.c Regular expression evaluator
regexp.h Public declarations for the above
+regnodes.h Description of nodes of RE engine
run.c The interpreter loop
scope.c Scope entry and exit code
scope.h Scope entry and exit header
@@ -613,6 +800,7 @@ t/base/cond.t See if conditionals work
t/base/if.t See if if works
t/base/lex.t See if lexical items work
t/base/pat.t See if pattern matching works
+t/base/rs.t See if record-read works
t/base/term.t See if various terms work
t/cmd/elsif.t See if else-if works
t/cmd/for.t See if for loops work
@@ -629,6 +817,7 @@ t/comp/multiline.t See if multiline strings work
t/comp/package.t See if packages work
t/comp/proto.t See if function prototypes work
t/comp/redef.t See if we get correct warnings on redefined subs
+t/comp/require.t See if require works
t/comp/script.t See if script invokation works
t/comp/term.t See if more terms work
t/comp/use.t See if pragmas work
@@ -637,6 +826,7 @@ t/io/argv.t See if ARGV stuff works
t/io/dup.t See if >& works right
t/io/fs.t See if directory manipulations work
t/io/inplace.t See if inplace editing works
+t/io/iprefix.t See if inplace editing works with prefixes
t/io/pipe.t See if secure pipes work
t/io/print.t See if print commands work
t/io/read.t See if read works
@@ -647,6 +837,10 @@ t/lib/autoloader.t See if AutoLoader works
t/lib/basename.t See if File::Basename works
t/lib/bigint.t See if bigint.pl works
t/lib/bigintpm.t See if BigInt.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-request.t See if CGI.pm works
t/lib/checktree.t See if File::CheckTree works
t/lib/complex.t See if Math::Complex works
t/lib/db-btree.t See if DB_File works
@@ -654,16 +848,25 @@ t/lib/db-hash.t See if DB_File works
t/lib/db-recno.t See if DB_File works
t/lib/dirhand.t See if DirHandle works
t/lib/dosglob.t See if File::DosGlob works
+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/errno.t See if Errno works
+t/lib/fatal.t See if Fatal works
+t/lib/fields.t See if base/fields works
t/lib/filecache.t See if FileCache works
t/lib/filecopy.t See if File::Copy works
t/lib/filefind.t See if File::Find works
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/gdbm.t See if GDBM_File works
t/lib/getopt.t See if Getopt::Std and 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
t/lib/hostname.t See if Sys::Hostname works
t/lib/io_dup.t See if dup()-related methods from IO work
t/lib/io_pipe.t See if pipe()-related methods from IO work
@@ -673,6 +876,7 @@ t/lib/io_taint.t See if the untaint method from IO works
t/lib/io_tell.t See if seek()/tell()-related methods from IO work
t/lib/io_udp.t See if UDP socket-related methods from IO work
t/lib/io_xs.t See if XSUB methods from IO work
+t/lib/ipc_sysv.t See if IPC::SysV works
t/lib/ndbm.t See if NDBM_File works
t/lib/odbm.t See if ODBM_File works
t/lib/opcode.t See if Opcode works
@@ -680,6 +884,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/ph.t See if h2ph works
t/lib/posix.t See if POSIX works
t/lib/safe1.t See if Safe works
t/lib/safe2.t See if Safe works
@@ -690,7 +895,12 @@ 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/texttabs.t See if Text::Tabs works
-t/lib/textwrap.t See if Text::Wrap works
+t/lib/textfill.t See if Text::Wrap::fill works
+t/lib/textwrap.t See if Text::Wrap::wrap works
+t/lib/thread.t Basic test of threading (skipped if no threads)
+t/lib/tie-push.t Test for Tie::Array
+t/lib/tie-stdarray.t Test for Tie::StdArray
+t/lib/tie-stdpush.t Test for Tie::StdArray
t/lib/timelocal.t See if Time::Local works
t/lib/trig.t See if Math::Trig works
t/op/append.t See if . works
@@ -698,12 +908,17 @@ t/op/arith.t See if arithmetic works
t/op/array.t See if array operations work
t/op/assignwarn.t See if OP= operators warn correctly for undef targets
t/op/auto.t See if autoincrement et all work
+t/op/avhv.t See if pseudo-hashes work
t/op/bop.t See if bitops 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/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
t/op/delete.t See if delete works
+t/op/die.t See if die works
+t/op/die_exit.t See if die and exit status interaction works
t/op/do.t See if subroutines work
t/op/each.t See if hash iterators work
t/op/eval.t See if eval operator works
@@ -713,8 +928,11 @@ t/op/flip.t See if range operator works
t/op/fork.t See if fork works
t/op/glob.t See if <*> works
t/op/goto.t See if goto works
+t/op/goto_xs.t See if "goto &sub" works on XSUBs
+t/op/grep.t See if grep() and map() work
t/op/groups.t See if $( works
t/op/gv.t See if typeglobs work
+t/op/hashwarn.t See if warnings for bad hash assignments work
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
@@ -726,10 +944,12 @@ 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/nothread.t local @_ test which does not work threaded
t/op/oct.t See if oct and hex work
t/op/ord.t See if ord works
t/op/pack.t See if pack and unpack work
t/op/pat.t See if esoteric patterns work
+t/op/pos.t See if pos works
t/op/push.t See if push and pop work
t/op/quotemeta.t See if quotemeta works
t/op/rand.t See if rand works
@@ -740,10 +960,12 @@ t/op/readdir.t See if readdir() works
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/repeat.t See if x 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
+t/op/splice.t See if splice works
t/op/split.t See if split works
t/op/sprintf.t See if sprintf works
t/op/stat.t See if stat works
@@ -753,11 +975,15 @@ t/op/substr.t See if substr works
t/op/sysio.t See if sysread and syswrite work
t/op/taint.t See if tainting works
t/op/tie.t See if tie/untie functions work
+t/op/tiearray.t See if tie for arrays works
+t/op/tiehandle.t See if tie for handles works
t/op/time.t See if time functions work
+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/vec.t See if vectors work
+t/op/wantarray.t See if wantarray works
t/op/write.t See if write works
t/pragma/constant.t See if compile-time constants work
t/pragma/locale.t See if locale support (i18n and l10n) works
@@ -770,6 +996,9 @@ t/pragma/subs.t See if subroutine pseudo-importation works
t/pragma/warn-1global Tests of global warnings for warning.t
t/pragma/warning.t See if warning controls work
taint.c Tainting code
+thrdvar.h Per-thread variables
+thread.h Threading header
+thread.sym Symbols for threads
toke.c The tokener
universal.c The default UNIVERSAL package methods
unixish.h Defines that are assumed on Unix
@@ -780,11 +1009,11 @@ utils/c2ph.PL program to translate dbx stabs to perl
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/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
utils/pl2pm.PL A pl to pm translator
utils/splain.PL Stand-alone version of diagnostics.pm
-vms/config.vms default config.h for VMS
-vms/descrip.mms MM[SK] description file for build
+vms/descrip_mms.template Template MM[SK] description file for build
vms/ext/DCLsym/0README.txt ReadMe file for VMS::DCLsym
vms/ext/DCLsym/DCLsym.pm Perl access to CLI symbols
vms/ext/DCLsym/DCLsym.xs Perl access to CLI symbols
@@ -800,38 +1029,54 @@ vms/ext/XSSymSet.pm manage linker symbols when building extensions
vms/ext/filespec.t See if VMS::Filespec funtions work
vms/ext/vmsish.pm Control VMS-specific behavior of Perl core
vms/ext/vmsish.t Tests for vmsish.pm
-vms/fndvers.com parse Perl version from patchlevel.h
vms/gen_shrfls.pl generate options files and glue for shareable image
vms/genconfig.pl retcon config.sh from config.h
vms/genopt.com hack to write options files in case of broken makes
vms/make_command.com record MM[SK] command used to build Perl
vms/mms2make.pl convert descrip.mms to make syntax
+vms/munchconfig.c performs shell $var substitution for VMS
vms/myconfig.com record local configuration info for bug report
vms/perlvms.pod VMS-specific additions to Perl documentation
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/writemain.pl Generate perlmain.c from miniperlmain.c+extensions
+vos/build.cm VOS command macro to build Perl
+vos/Changes Changes made to port Perl to the VOS operating system
+vos/compile_perl.cm VOS commnad macro to build multiple version of Perl
+vos/config.h config.h for VOS
+vos/config_h.SH_orig config_h.SH at the time config.h was created
+vos/perl.bind VOS bind control file
+vos/test_vos_dummies.c Test program for "vos_dummies.c"
+vos/vos_accept.c Wrapper to fixup nonstandard VOS _accept function
+vos/vos_dummies.c Wrappers to soak up undefined functions
+vos/vosish.h VOS-specific header file
+win32/GenCAPI.pl Win32 port for C API with PERL_OBJECT
win32/Makefile Win32 makefile for NMAKE (Visual C++ build)
win32/TEST Win32 port
win32/autosplit.pl Win32 port
win32/bin/network.pl Win32 port
+win32/bin/perlglob.pl Win32 globbing
win32/bin/pl2bat.pl wrap perl scripts into batch files
win32/bin/runperl.pl run perl script via batch file namesake
win32/bin/search.pl Win32 port
win32/bin/webget.pl Win32 port
win32/bin/www.pl Win32 port
win32/config.bc Win32 base line config.sh (Borland C++ build)
+win32/config.gc Win32 base line config.sh (mingw32/gcc build)
win32/config.vc Win32 base line config.sh (Visual C++ build)
win32/config_H.bc Win32 config header (Borland C++ build)
+win32/config_H.gc Win32 config header (GNU build)?
win32/config_H.vc Win32 config header (Visual C++ build)
win32/config_h.PL Perl code to convert Win32 config.sh to config.h
win32/config_sh.PL Perl code to update Win32 config.sh from Makefile
+win32/des_fcrypt.patch Win32 port
win32/dl_win32.xs Win32 port
win32/genxsdef.pl Win32 port
win32/include/arpa/inet.h Win32 port
@@ -843,16 +1088,17 @@ win32/makefile.mk Win32 makefile for DMAKE (BC++, VC++ builds)
win32/makemain.pl Win32 port
win32/makeperldef.pl Win32 port
win32/perlglob.c Win32 port
+win32/perlhost.h Perl host implementation
win32/perllib.c Win32 port
win32/pod.mak Win32 port
win32/runperl.c Win32 port
win32/splittree.pl Win32 port
win32/win32.c Win32 port
win32/win32.h Win32 port
-win32/win32io.c Win32 port
-win32/win32io.h Win32 port
win32/win32iop.h Win32 port
win32/win32sck.c Win32 port
+win32/win32thread.c Win32 functions for threads
+win32/win32thread.h Win32 port mapping to threads
writemain.SH Generate perlmain.c from miniperlmain.c+extensions
x2p/EXTERN.h Same as above
x2p/INTERN.h Same as above
diff --git a/gnu/usr.bin/perl/Makefile.SH b/gnu/usr.bin/perl/Makefile.SH
index f2a4a9fbc70..61f01b5aee9 100644
--- a/gnu/usr.bin/perl/Makefile.SH
+++ b/gnu/usr.bin/perl/Makefile.SH
@@ -25,8 +25,13 @@ esac
linklibperl='$(LIBPERL)'
shrpldflags='$(LDDLFLAGS)'
+ldlibpth=''
case "$useshrplib" in
true)
+ # Prefix all runs of 'miniperl' and 'perl' with
+ # $ldlibpth so that ./perl finds *this* libperl.so.
+ ldlibpth="LD_LIBRARY_PATH=`pwd`:$LD_LIBRARY_PATH"
+
pldlflags="$cccdlflags"
# NeXT-4 specific stuff. Can't we do this in the hint file?
case "${osname}${osvers}" in
@@ -35,10 +40,20 @@ true)
lddlflags="-dynamic -undefined warning -framework System \
-compatibility_version 1 -current_version $patchlevel \
-prebind -seg1addr 0x27000000 -install_name \$(shrpdir)/\$@"
+ # NeXT uses a different name.
+ ldlibpth="DYLD_LIBRARY_PATH=`pwd`:$DYLD_LIBRARY_PATH"
+ ;;
+ beos*) ldlibpth="LIBRARY_PATH=`pwd`:$LIBRARY_PATH"
;;
- sunos*|freebsd[23]*|netbsd*)
+ os2*) # OS/2 doesn't need anything special for LD_LIBRARY_PATH.
+ ldlibpth=''
+ ;;
+ sunos*)
linklibperl="-lperl"
;;
+ netbsd*|freebsd[234]*)
+ linklibperl="-L. -lperl"
+ ;;
aix*)
shrpldflags="-H512 -T512 -bhalt:4 -bM:SRE -bE:perl.exp"
case "$osvers" in
@@ -75,6 +90,12 @@ for f in $static_ext; do
static_list="$static_list lib/auto/$f/$base\$(LIB_EXT)"
done
+nonxs_list=' '
+for f in $nonxs_ext; do
+ base=`echo "$f" | sed 's/.*\///'`
+ nonxs_list="$nonxs_list ext/$f/pm_to_blib"
+done
+
echo "Extracting Makefile (with variable substitutions)"
$spitshell >Makefile <<!GROK!THIS!
# Makefile.SH
@@ -124,9 +145,14 @@ LIBPERL = $libperl
LLIBPERL= $linklibperl
SHRPENV = $shrpenv
+# The following is used to include the current directory in
+# LD_LIBRARY_PATH if you are building a shared libperl.so.
+LDLIBPTH = $ldlibpth
+
dynamic_ext = $dynamic_list
static_ext = $static_list
-ext = \$(dynamic_ext) \$(static_ext)
+nonxs_ext = $nonxs_list
+ext = \$(dynamic_ext) \$(static_ext) \$(nonxs_ext)
DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT)
libs = $libs $cryptlib
@@ -139,13 +165,12 @@ shellflags = $shellflags
# do it for you.
$make_set_make
-# These variables will be used in a future version to make
-# the make file more portable to non-unix systems.
-AR = $ar
-EXE_EXT = $exe_ext
-LIB_EXT = $lib_ext
-OBJ_EXT = $obj_ext
-PATH_SEP = $path_sep
+# These variables may need to be manually set for non-Unix systems.
+AR = $full_ar
+EXE_EXT = $_exe
+LIB_EXT = $_a
+OBJ_EXT = $_o
+PATH_SEP = $p_
FIRSTMAKEFILE = $firstmakefile
@@ -157,6 +182,9 @@ ARCHOBJS = $archobjs
# grrr
SHELL = $sh
+# how to tr(anslate) newlines
+TRNL = '$trnl'
+
!GROK!THIS!
## In the following dollars and backticks do not need the extra backslash.
@@ -186,16 +214,17 @@ addedbyconf = UU $(shextract) $(plextract) pstruct
h1 = EXTERN.h INTERN.h XSUB.h av.h config.h cop.h cv.h dosish.h
h2 = embed.h form.h gv.h handy.h hv.h keywords.h mg.h op.h
h3 = opcode.h patchlevel.h perl.h perly.h pp.h proto.h regcomp.h
-h4 = regexp.h scope.h sv.h unixish.h util.h perlio.h
-h = $(h1) $(h2) $(h3) $(h4)
+h4 = regexp.h scope.h sv.h unixish.h util.h iperlsys.h thread.h
+h5 = bytecode.h byterun.h
+h = $(h1) $(h2) $(h3) $(h4) $(h5)
-c1 = $(mallocsrc) av.c scope.c op.c doop.c doio.c dump.c hv.c mg.c
+c1 = $(mallocsrc) av.c scope.c op.c doop.c doio.c dump.c hv.c mg.c byterun.c
c2 = perl.c perly.c pp.c pp_hot.c pp_ctl.c pp_sys.c regcomp.c regexec.c
c3 = gv.c sv.c taint.c toke.c util.c deb.c run.c universal.c globals.c perlio.c
c = $(c1) $(c2) $(c3) miniperlmain.c perlmain.c
-obj1 = $(mallocobj) gv$(OBJ_EXT) toke$(OBJ_EXT) perly$(OBJ_EXT) op$(OBJ_EXT) regcomp$(OBJ_EXT) dump$(OBJ_EXT) util$(OBJ_EXT) mg$(OBJ_EXT)
+obj1 = $(mallocobj) gv$(OBJ_EXT) toke$(OBJ_EXT) perly$(OBJ_EXT) op$(OBJ_EXT) regcomp$(OBJ_EXT) dump$(OBJ_EXT) util$(OBJ_EXT) mg$(OBJ_EXT) byterun$(OBJ_EXT)
obj2 = hv$(OBJ_EXT) av$(OBJ_EXT) run$(OBJ_EXT) pp_hot$(OBJ_EXT) sv$(OBJ_EXT) pp$(OBJ_EXT) scope$(OBJ_EXT) pp_ctl$(OBJ_EXT) pp_sys$(OBJ_EXT)
obj3 = doop$(OBJ_EXT) doio$(OBJ_EXT) regexec$(OBJ_EXT) taint$(OBJ_EXT) deb$(OBJ_EXT) universal$(OBJ_EXT) globals$(OBJ_EXT) perlio$(OBJ_EXT)
@@ -216,14 +245,21 @@ lintflags = -hbvxac
.c$(OBJ_EXT):
$(CCCMD) $(PLDLFLAGS) $*.c
-all: $(FIRSTMAKEFILE) miniperl $(private) $(plextract) $(public) $(dynamic_ext)
- @echo " "; echo " Everything is up to date."
+all: $(FIRSTMAKEFILE) miniperl $(private) $(plextract) $(public) $(dynamic_ext) $(nonxs_ext)
+ @echo " ";
+ @echo " Everything is up to date. 'make test' to run test suite."
+
+compile: all
+ echo "testing compilation" > testcompile;
+ cd utils; $(MAKE) compile;
+ cd x2p; $(MAKE) compile;
+ cd pod; $(MAKE) compile;
translators: miniperl lib/Config.pm FORCE
- @echo " "; echo " Making x2p stuff"; cd x2p; $(MAKE) all
+ @echo " "; echo " Making x2p stuff"; cd x2p; $(LDLIBPTH) $(MAKE) all
utilities: miniperl lib/Config.pm FORCE
- @echo " "; echo " Making utilities"; cd utils; $(MAKE) all
+ @echo " "; echo " Making utilities"; cd utils; $(LDLIBPTH) $(MAKE) all
# This is now done by installman only if you actually want the man pages.
@@ -272,6 +308,7 @@ $(LIBPERL): $& perl$(OBJ_EXT) $(obj)
case "$osname" in
aix)
$spitshell >>Makefile <<'!NO!SUBS!'
+ rm -f libperl$(OBJ_EXT)
mv $@ libperl$(OBJ_EXT)
$(AR) qv $(LIBPERL) libperl$(OBJ_EXT)
!NO!SUBS!
@@ -299,20 +336,20 @@ $(LIBPERL): $& perl$(OBJ_EXT) $(obj)
# The Module used here must not depend on Config or any extensions.
miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL)
- $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) $(LLIBPERL) $(libs)
- @./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest
+ $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) $(LLIBPERL) $(libs)
+ $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest
perl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
- $(SHRPENV) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+ $(SHRPENV) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
pureperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
- $(SHRPENV) purify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o pureperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+ $(SHRPENV) $(LDLIBPTH) purify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o pureperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
purecovperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
- $(SHRPENV) purecov $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o purecovperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+ $(SHRPENV) $(LDLIBPTH) purecov $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o purecovperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
quantperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
- $(SHRPENV) quantify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o quantperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+ $(SHRPENV) $(LDLIBPTH) quantify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o quantperl 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"
@@ -320,7 +357,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
- $(SHRPENV) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o suidperl perlmain$(OBJ_EXT) sperl$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+ $(SHRPENV) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o suidperl perlmain$(OBJ_EXT) sperl$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
!NO!SUBS!
@@ -340,34 +377,46 @@ sperl$(OBJ_EXT): perl.c perly.h patchlevel.h $(h)
preplibrary: miniperl lib/Config.pm $(plextract)
@sh ./makedir lib/auto
@echo " AutoSplitting perl library"
- @./miniperl -Ilib -e 'use AutoSplit; \
+ $(LDLIBPTH) ./miniperl -Ilib -e 'use AutoSplit; \
autosplit_lib_modules(@ARGV)' lib/*.pm lib/*/*.pm
# Take care to avoid modifying lib/Config.pm without reason
# (If trying to create a new port and having problems with the configpm script,
# try 'make minitest' and/or commenting out the tests at the end of configpm.)
lib/Config.pm: config.sh miniperl configpm
- ./miniperl configpm tmp
- sh mv-if-diff tmp lib/Config.pm
+ $(LDLIBPTH) ./miniperl configpm tmp
+ sh mv-if-diff tmp $@
lib/ExtUtils/Miniperl.pm: miniperlmain.c miniperl minimod.pl lib/Config.pm
- ./miniperl minimod.pl > tmp && mv tmp $@
+ $(LDLIBPTH) ./miniperl minimod.pl > tmp
+ sh mv-if-diff tmp $@
-$(plextract): miniperl lib/Config.pm
- ./miniperl -Ilib $@.PL
+lib/re.pm: ext/re/re.pm
+ rm -f $@
+ cat ext/re/re.pm > $@
+$(plextract): miniperl lib/Config.pm lib/re.pm
+ $(LDLIBPTH) ./miniperl -Ilib $@.PL
+
install: all install.perl install.man
install.perl: all installperl
- ./perl installperl
+ if [ -n "$(COMPILE)" ]; \
+ then \
+ cd utils; $(MAKE) compile; \
+ cd ../x2p; $(MAKE) compile; \
+ cd ../pod; $(MAKE) compile; \
+ else :; \
+ fi
+ $(LDLIBPTH) ./perl installperl
install.man: all installman
- ./perl installman
+ $(LDLIBPTH) ./perl installman
# XXX Experimental. Hardwired values, but useful for testing.
# Eventually Configure could ask for some of these values.
install.html: all installhtml
- ./perl installhtml \
+ $(LDLIBPTH) ./perl installhtml \
--podroot=. --podpath=. --recurse \
--htmldir=$(privlib)/html \
--htmlroot=$(privlib)/html \
@@ -405,10 +454,20 @@ perly.c: perly.y
perly.h: perly.y
-@sh -c true
-# The following three header files are generated automatically
+# No compat3.sym here since and including the 5.004_50.
+# No interp.sym since 5.005_03.
+SYM = global.sym perlio.sym thread.sym
+
+SYMH = perlvars.h thrdvar.h
+
+# The following files are generated automatically
# keywords.h: keywords.pl
# opcode.h: opcode.pl
-# embed.h: embed.pl global.sym interp.sym
+# embed.h: embed.pl global.sym
+# byterun.h: bytecode.pl
+# byterun.c: bytecode.pl
+# lib/B/Asmdata.pm: bytecode.pl
+# regnodes.h: regcomp.pl
# The correct versions should be already supplied with the perl kit,
# in case you don't have perl available.
# To force them to run, type
@@ -417,11 +476,13 @@ regen_headers: FORCE
perl keywords.pl
perl opcode.pl
perl embed.pl
+ perl bytecode.pl
+ perl regcomp.pl
# Extensions:
-# Names added to $(dynamic_ext) or $(static_ext) will automatically
-# get built. There should ordinarily be no need to change any of
-# this part of makefile.
+# Names added to $(dynamic_ext) or $(static_ext) or $(nonxs_ext) will
+# automatically get built. There should ordinarily be no need to change
+# any of this part of makefile.
#
# The dummy dependency is a place holder in case $(dynamic_ext) or
# $(static_ext) is empty.
@@ -429,21 +490,24 @@ regen_headers: FORCE
# DynaLoader may be needed for extensions that use Makefile.PL.
$(DYNALOADER): miniperl preplibrary FORCE
- @sh ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
+ @$(LDLIBPTH) sh ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
d_dummy $(dynamic_ext): miniperl preplibrary $(DYNALOADER) FORCE
- @sh ext/util/make_ext dynamic $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
+ @$(LDLIBPTH) sh ext/util/make_ext dynamic $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
s_dummy $(static_ext): miniperl preplibrary $(DYNALOADER) FORCE
- @sh ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
+ @$(LDLIBPTH) sh ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
+
+n_dummy $(nonxs_ext): miniperl preplibrary $(DYNALOADER) FORCE
+ @$(LDLIBPTH) sh ext/util/make_ext nonxs $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
clean: _tidy _mopup
realclean: _cleaner _mopup
- @echo "Note that make realclean does not delete config.sh"
+ @echo "Note that make realclean does not delete config.sh or Policy.sh"
clobber: _cleaner _mopup
- rm -f config.sh cppstdin
+ rm -f config.sh cppstdin Policy.sh
distclean: clobber
@@ -459,9 +523,10 @@ _tidy:
-cd pod; $(MAKE) clean
-cd utils; $(MAKE) clean
-cd x2p; $(MAKE) clean
- -@for x in $(DYNALOADER) $(dynamic_ext) $(static_ext) ; do \
+ -@for x in $(DYNALOADER) $(dynamic_ext) $(static_ext) $(nonxs_ext) ; do \
sh ext/util/make_ext clean $$x MAKE=$(MAKE) ; \
done
+ rm -f testcompile compilelog
# Do not 'make _cleaner' directly.
_cleaner:
@@ -469,7 +534,7 @@ _cleaner:
-cd pod; $(MAKE) realclean
-cd utils; $(MAKE) realclean
-cd x2p; $(MAKE) realclean
- -@for x in $(DYNALOADER) $(dynamic_ext) $(static_ext) ; do \
+ -@for x in $(DYNALOADER) $(dynamic_ext) $(static_ext) $(nonxs_ext) ; do \
sh ext/util/make_ext realclean $$x MAKE=$(MAKE) ; \
done
rm -f *.orig */*.orig *~ */*~ core t/core t/c t/perl
@@ -480,6 +545,7 @@ _cleaner:
rm -f lib/.exists
rm -f h2ph.man pstruct
rm -rf .config
+ rm -f testcompile compilelog
# The following lint has practically everything turned on. Unfortunately,
# you have to wade through a lot of mumbo jumbo that can't be suppressed.
@@ -501,7 +567,8 @@ $(FIRSTMAKEFILE): README $(MAKEDEPEND)
config.h: config_h.SH config.sh
$(SHELL) config_h.SH
-perl.exp: perl_exp.SH config.sh
+# This is an AIXism.
+perl.exp: perl_exp.SH config.sh $(SYM) $(SYMH)
$(SHELL) perl_exp.SH
# When done, touch perlmain.c so that it doesn't get remade each time.
@@ -514,42 +581,48 @@ depend: makedepend
makedepend: makedepend.SH config.sh
sh ./makedepend.SH
-test-prep: miniperl perl preplibrary $(dynamic_ext)
+test-prep: miniperl perl preplibrary utilities $(dynamic_ext) $(nonxs_ext)
cd t && (rm -f perl$(EXE_EXT); $(LNS) ../perl$(EXE_EXT) perl$(EXE_EXT))
test check: test-prep
- cd t && ./perl TEST </dev/tty
+ cd t && $(LDLIBPTH) ./perl TEST </dev/tty
# For testing without a tty or controling terminal. See t/op/stat.t
test-notty: test-prep
- cd t && PERL_SKIP_TTY_TEST=1 ./perl TEST
+ cd t && PERL_SKIP_TTY_TEST=1 $(LDLIBPTH) ./perl TEST
# Can't depend on lib/Config.pm because that might be where miniperl
# is crashing.
-minitest: miniperl
+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)) \
- && ./perl TEST base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t </dev/tty
+ && $(LDLIBPTH) ./perl TEST base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t </dev/tty
# Handy way to run perlbug -ok without having to install and run the
# installed perlbug. We don't re-run the tests here - we trust the user.
# Please *don't* use this unless all tests pass.
-# If you want to report test failures, just use "perlbug -Ilib".
-ok:
- ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)'
+# If you want to report test failures, use "make nok" instead.
+ok: utilities
+ $(LDLIBPTH) ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)'
+
+okfile: utilities
+ $(LDLIBPTH) ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)' -F perl.ok
+
+nok: utilities
+ $(LDLIBPTH) ./perl -Ilib utils/perlbug -nok -s '(UNINSTALLED)'
clist: $(c)
- echo $(c) | tr ' ' '\012' >.clist
+ echo $(c) | tr ' ' $(TRNL) >.clist
hlist: $(h)
- echo $(h) | tr ' ' '\012' >.hlist
+ echo $(h) | tr ' ' $(TRNL) >.hlist
shlist: $(sh)
- echo $(sh) | tr ' ' '\012' >.shlist
+ echo $(sh) | tr ' ' $(TRNL) >.shlist
pllist: $(pl)
- echo $(pl) | tr ' ' '\012' >.pllist
+ echo $(pl) | tr ' ' $(TRNL) >.pllist
Makefile: Makefile.SH ./config.sh
$(SHELL) Makefile.SH
@@ -557,6 +630,14 @@ Makefile: Makefile.SH ./config.sh
distcheck: FORCE
perl '-MExtUtils::Manifest=&fullcheck' -e 'fullcheck()'
+elc: emacs/cperl-mode.elc
+
+emacs/cperl-mode.elc: emacs/cperl-mode.el
+ -cd emacs; emacs -batch -q -no-site-file -f batch-byte-compile cperl-mode.el
+
+etags: emacs/cperl-mode.elc
+ sh emacs/ptags
+
# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
# If this runs make out of memory, delete /usr/include lines.
!NO!SUBS!
@@ -569,3 +650,70 @@ case `pwd` in
;;
esac
$rm -f $firstmakefile
+
+# Now do any special processing required before building.
+
+case "$ebcdic" in
+$define)
+ xxx=''
+ echo "This is an EBCDIC system, checking if any parser files need regenerating." >&4
+case "$osname" in
+os390)
+ rm -f y.tab.c y.tab.h
+ yacc -d perly.y >/dev/null 2>&1
+ if cmp -s y.tab.c perly.c; then
+ rm -f y.tab.c
+ else
+ echo "perly.y -> perly.c" >&2
+ mv -f y.tab.c perly.c
+ chmod u+w 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
+ xxx="$xxx perly.c"
+ fi
+ if cmp -s y.tab.h perly.h; then
+ rm -f y.tab.h
+ else
+ echo "perly.y -> perly.h" >&2
+ mv -f y.tab.h perly.h
+ xxx="$xxx perly.h"
+ fi
+ if cd x2p
+ then
+ rm -f y.tab.c y.tab.h
+ yacc a2p.y >/dev/null 2>&1
+ if cmp -s y.tab.c a2p.c
+ then
+ rm -f y.tab.c
+ else
+ echo "a2p.y -> a2p.c" >&2
+ 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/y\.tab/a2p/g' a2p.c >a2p.tmp && mv a2p.tmp a2p.c
+ xxx="$xxx a2p.c"
+ fi
+ # In case somebody yacc -d:ed the a2p.y.
+ if test -f y.tab.h
+ then
+ if cmp -s y.tab.h a2p.h
+ then
+ rm -f y.tab.h
+ else
+ echo "a2p.h -> a2p.h" >&2
+ mv -f y.tab.h a2p.h
+ xxx="$xxx a2p.h"
+ fi
+ fi
+ cd ..
+ fi
+ ;;
+*)
+ echo "'$osname' is an EBCDIC system I don't know that well." >&4
+ ;;
+esac
+ case "$xxx" in
+ '') echo "No parser files were regenerated. That's okay." >&2 ;;
+ esac
+ ;;
+esac
diff --git a/gnu/usr.bin/perl/Porting/Glossary b/gnu/usr.bin/perl/Porting/Glossary
index c71c199ec4b..52b560e1018 100644
--- a/gnu/usr.bin/perl/Porting/Glossary
+++ b/gnu/usr.bin/perl/Porting/Glossary
@@ -1,14 +1,60 @@
This file contains a description of all the shell variables whose value is
determined by the Configure script. Variables intended for use in C
-programs (e.g. I_UNISTD) are already described in config_h.SH.
+programs (e.g. I_UNISTD) are already described in config_h.SH. [`configpm'
+generates pod documentation for Config.pm from this file--please try to keep
+the formatting regular.]
+
+Mcc (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the Mcc program. After Configure runs,
+ the value is reset to a plain "Mcc" and is not useful.
+
+_a (Unix.U):
+ This variable defines the extension used for ordinary libraries.
+ For unix, it is '.a'. The '.' is included. Other possible
+ values include '.lib'.
+
+_exe (Unix.U):
+ This variable defines the extension used for executable files.
+ For unix it is empty. Other possible values include '.exe'.
+
+_o (Unix.U):
+ This variable defines the extension used for object files.
+ For unix, it is '.o'. The '.' is included. Other possible
+ values include '.obj'.
+
+afs (afs.U):
+ This variable is set to 'true' if AFS (Andrew File System) is used
+ on the system, 'false' otherwise. It is possible to override this
+ with a hint value or command line option, but you'd better know
+ what you are doing.
alignbytes (alignbytes.U):
This variable holds the number of bytes required to align a
double. Usual values are 2, 4 and 8.
-ar (Unix.U):
- This variable defines the command to use to create an archive
- library. For unix, it is 'ar'.
+ansi2knr (ansi2knr.U):
+ This variable is set if the user needs to run ansi2knr.
+ Currently, this is not supported, so we just abort.
+
+aphostname (d_gethname.U):
+ Thie variable contains the command which can be used to compute the
+ host name. The command is fully qualified by its absolute path, to make
+ it safe when used by a process with super-user privileges.
+
+apiversion (patchlevel.U):
+ This is a number which identifies the lowest version of perl
+ to have an API (for XS extensions) compatible with the present
+ version. For example, for 5.005_01, the apiversion should be
+ 5.005, since 5.005_01 should be binary compatible with 5.005.
+ This should probably be incremented manually somehow, perhaps
+ from patchlevel.h. For now, we'll guess maintenance subversions
+ will retain binary compatibility.
+
+ar (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the ar program. After Configure runs,
+ the value is reset to a plain "ar" and is not useful.
archlib (archlib.U):
This variable holds the name of the directory in which the user wants
@@ -21,6 +67,10 @@ archlibexp (archlib.U):
This variable is the same as the archlib variable, but is
filename expanded at configuration time, for convenient use.
+archname (archname.U):
+ This variable is a short name to characterize the current
+ architecture. It is used mainly to construct the default archlib.
+
archobjs (Unix.U):
This variable defines any additional objects that must be linked
in with the program on this architecture. On unix, it is usually
@@ -28,15 +78,36 @@ archobjs (Unix.U):
or other facilities. For perl on OS/2, for example, this would
include os2/os2.obj.
+awk (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the awk program. After Configure runs,
+ the value is reset to a plain "awk" and is not useful.
+
+baserev (baserev.U):
+ The base revision level of this package, from the .package file.
+
+bash (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
bin (bin.U):
This variable holds the name of the directory in which the user wants
to put publicly executable images for the package in question. It
is most often a local directory such as /usr/local/bin. Programs using
this variable must be prepared to deal with ~name substitution.
-bincompat3 (bincompat3.U):
- This variable contains y if Perl 5.004 should be binary-compatible
- with Perl 5.003.
+binexp (bin.U):
+ This is the same as the bin variable, but is filename expanded at
+ configuration time, for use in your makefiles.
+
+bison (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+byacc (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the byacc program. After Configure runs,
+ the value is reset to a plain "byacc" and is not useful.
byteorder (byteorder.U):
This variable holds the byte order. In the following, larger digits
@@ -57,20 +128,25 @@ castflags (d_castneg.U):
2 = couldn't cast >= 0x80000000
4 = couldn't cast in argument expression list
+cat (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the cat program. After Configure runs,
+ the value is reset to a plain "cat" and is not useful.
+
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', 'Mcc', 'cc -M', and 'gcc'.
cccdlflags (dlsrc.U):
This variable contains any special flags that might need to be
- passed with cc -c to compile modules to be used to create a shared
- library that will be used for dynamic loading. For hpux, this
+ passed with 'cc -c' to compile modules to be used to create a shared
+ library that will be used for dynamic loading. For hpux, this
should be +z. It is up to the makefile to use it.
ccdlflags (dlsrc.U):
This variable contains any special flags that might need to be
- passed to cc to link with a shared library for dynamic loading.
+ passed to cc to link with a shared library for dynamic loading.
It is up to the makefile to use it. For sunos 4.1, it should
be empty.
@@ -78,14 +154,70 @@ ccflags (ccflags.U):
This variable contains any additional C compiler flags desired by
the user. It is up to the Makefile to use this.
+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.
+
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.
+cf_email (cf_email.U):
+ Electronic mail address of the person who ran Configure. This can be
+ used by units that require the user's e-mail, like MailList.U.
+
cf_time (cf_who.U):
Holds the output of the "date" command when the configuration file was
produced. This is used to tag both config.sh and config_h.SH.
+chgrp (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+chmod (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+chown (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+clocktype (d_times.U):
+ This variable holds the type returned by times(). It can be long,
+ or clock_t on BSD sites (in which case <sys/types.h> should be
+ included).
+
+comm (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the comm program. After Configure runs,
+ the value is reset to a plain "comm" and is not useful.
+
+compress (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+contains (contains.U):
+ This variable holds the command to do a grep with a proper return
+ status. On most sane systems it is simply "grep". On insane systems
+ it is a grep followed by a cat followed by a test. This variable
+ is primarily for the use of other Configure units.
+
+cp (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the cp program. After Configure runs,
+ the value is reset to a plain "cp" and is not useful.
+
+cpio (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+cpp (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the cpp program. After Configure runs,
+ the value is reset to a plain "cpp" and is not useful.
+
cpp_stuff (cpp_stuff.U):
This variable contains an identification of the catenation mechanism
used by the C preprocessor.
@@ -94,23 +226,52 @@ cppflags (ccflags.U):
This variable holds the flags that will be passed to the C pre-
processor. It is up to the Makefile to use it.
+cpplast (cppstdin.U):
+ This variable has the same functionality as cppminus, only it applies to
+ cpprun and not cppstdin.
+
cppminus (cppstdin.U):
This variable contains the second part of the string which will invoke
the C preprocessor on the standard input and produce to standard
output. This variable will have the value "-" if cppstdin needs a minus
to specify standard input, otherwise the value is "".
+cpprun (cppstdin.U):
+ This variable contains the command which will invoke a C preprocessor
+ on standard input and put the output to stdout. It is guaranteed not
+ to be a wrapper and may be a null string if no preprocessor can be
+ made directly available. This preprocessor might be different from the
+ one used by the C compiler. Don't forget to append cpplast after the
+ preprocessor options.
+
cppstdin (cppstdin.U):
This variable contains the command which will invoke the C
preprocessor on standard input and put the output to stdout.
It is primarily used by other Configure units that ask about
preprocessor symbols.
+cppsymbols (Cppsym.U):
+ The variable contains the symbols defined by the C preprocessor
+ alone. The symbols defined by cc or by cc when it calls cpp are
+ not in this list, see ccsymbols and cppccsymbols.
+ The list is a space-separated list of symbol=value tokens.
+
+cppccsymbols (Cppsym.U):
+ The variable contains the symbols defined by the C compiler when
+ when it calls cpp. The symbols defined by the cc alone or cpp
+ alone are not in this list, see ccsymbols and cppsymbols.
+ The list is a space-separated list of symbol=value tokens.
+
cryptlib (d_crypt.U):
This variable holds -lcrypt or the path to a libcrypt.a archive if
the crypt() function is not defined in the standard C library. It is
up to the Makefile to use this.
+csh (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the csh program. After Configure runs,
+ the value is reset to a plain "csh" and is not useful.
+
d_Gconvert (d_gconvert.U):
This variable holds what Gconvert is defined as to convert
floating point numbers into strings. It could be 'gconvert'
@@ -129,6 +290,11 @@ d_archlib (archlib.U):
of architecture-dependent library files for $package. If
$archlib is the same as $privlib, then this is set to undef.
+d_attribut (d_attribut.U):
+ This variable conditionally defines HASATTRIBUTE, which
+ indicates the C compiler can check for function attributes,
+ such as printf formats.
+
d_bcmp (d_bcmp.U):
This variable conditionally defines the HAS_BCMP symbol if
the bcmp() routine is available to compare strings.
@@ -137,20 +303,14 @@ d_bcopy (d_bcopy.U):
This variable conditionally defines the HAS_BCOPY symbol if
the bcopy() routine is available to copy strings.
-d_bincompat3 (bincompat3.U):
- This variable conditionally defines BINCOMPAT3 so that embed.h
- can take special action if Perl 5.004 should be binary-compatible
- with Perl 5.003.
+d_bsd (Guess.U):
+ This symbol conditionally defines the symbol BSD when running on a
+ BSD system.
d_bsdgetpgrp (d_getpgrp.U):
This variable conditionally defines USE_BSD_GETPGRP if
getpgrp needs one arguments whereas USG one needs none.
-d_bsdpgrp (d_setpgrp.U):
- This variable conditionally defines USE_BSDPGRP if the notion of
- process group is the BSD one. This means setpgrp needs two arguments
- whereas USG one needs none.
-
d_bsdsetpgrp (d_setpgrp.U):
This variable conditionally defines USE_BSD_SETPGRP if
setpgrp needs two arguments whereas USG one needs none.
@@ -186,6 +346,10 @@ d_chsize (d_chsize.U):
indicates to the C program that the chsize() routine is available
to truncate files. You might need a -lx to get this routine.
+d_closedir (d_closedir.U):
+ This variable conditionally defines HAS_CLOSEDIR if closedir() is
+ available.
+
d_const (d_const.U):
This variable conditionally defines the HASCONST symbol, which
indicates to the C program that this C compiler knows about the
@@ -223,6 +387,10 @@ d_dlerror (d_dlerror.U):
This variable conditionally defines the HAS_DLERROR symbol, which
indicates to the C program that the dlerror() routine is available.
+d_dlopen (d_dlopen.U):
+ This variable conditionally defines the HAS_DLOPEN symbol, which
+ indicates to the C program that the dlopen() routine is available.
+
d_dlsymun (d_dlsymun.U):
This variable conditionally defines DLSYM_NEEDS_UNDERSCORE, which
indicates that we need to prepend an underscore to the symbol
@@ -237,10 +405,40 @@ d_dup2 (d_dup2.U):
This variable conditionally defines HAS_DUP2 if dup2() is
available to duplicate file descriptors.
+d_endgrent (d_endgrent.U):
+ This variable conditionally defines the HAS_ENDGRENT symbol, which
+ indicates to the C program that the endgrent() routine is available
+ for sequential access of the group database.
+
+d_endhent (d_endhent.U):
+ This variable conditionally defines HAS_ENDHOSTENT if endhostent() is
+ available to close whatever was being used for host queries.
+
+d_endnent (d_endnent.U):
+ This variable conditionally defines HAS_ENDNETENT if endnetent() is
+ available to close whatever was being used for network queries.
+
+d_endpent (d_endpent.U):
+ This variable conditionally defines HAS_ENDPROTOENT if endprotoent() is
+ available to close whatever was being used for protocol queries.
+
+d_endpwent (d_endpwent.U):
+ This variable conditionally defines the HAS_ENDPWENT symbol, which
+ indicates to the C program that the endpwent() routine is available
+ for sequential access of the passwd database.
+
+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_eofnblk (nblock_io.U):
This variable conditionally defines EOF_NONBLOCK if EOF can be seen
when reading from a non-blocking I/O source.
+d_eunice (Guess.U):
+ This variable conditionally defines the symbols EUNICE and VAX, which
+ alerts the C program that it must deal with ideosyncracies of VMS.
+
d_fchmod (d_fchmod.U):
This variable conditionally defines the HAS_FCHMOD symbol, which
indicates to the C program that the fchmod() routine is available
@@ -255,6 +453,22 @@ d_fcntl (d_fcntl.U):
This variable conditionally defines the HAS_FCNTL symbol, and indicates
whether the fcntl() function exists
+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
+ manipulate an fd_set.
+
+d_fd_set (d_fd_set.U):
+ This variable contains the eventual value of the HAS_FD_SET symbol,
+ which indicates if your C compiler knows about the fd_set typedef.
+
+d_fds_bits (d_fd_set.U):
+ This variable contains the eventual value of the HAS_FDS_BITS symbol,
+ which indicates if your fd_set typedef contains the fds_bits member.
+ If you have an fd_set typedef, but the dweebs who installed it did
+ a half-fast job and neglected to provide the macros to manipulate
+ an fd_set, HAS_FDS_BITS will let us know how to fix the gaffe.
+
d_fgetpos (d_fgetpos.U):
This variable conditionally defines HAS_FGETPOS if fgetpos() is
available to get the file position indicator.
@@ -281,39 +495,114 @@ d_fsetpos (d_fsetpos.U):
This variable conditionally defines HAS_FSETPOS if fsetpos() is
available to set the file position indicator.
+d_fstatfs (d_statfs.U):
+ This variable conditionally defines the HAS_FSTATFS symbol, which
+ indicates to the C program that the fstatfs() routine is available.
+
+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_ftime (d_ftime.U):
- This variable conditionally defines the HAS_FTIME symbol, which
- indicates that the ftime() routine exists. The ftime() routine is
- basically a sub-second accuracy clock.
+ This variable conditionally defines the HAS_FTIME symbol, which indicates
+ that the ftime() routine exists. The ftime() routine is basically
+ a sub-second accuracy clock.
+
+d_getgrent (d_getgrent.U):
+ This variable conditionally defines the HAS_GETGRENT symbol, which
+ indicates to the C program that the getgrent() routine is available
+ for sequential access of the group database.
+
+d_getgrps (d_getgrps.U):
+ This variable conditionally defines the HAS_GETGROUPS symbol, which
+ indicates to the C program that the getgroups() routine is available
+ to get the list of process groups.
+
+d_gethbyaddr (d_gethbyad.U):
+ This variable conditionally defines the HAS_GETHOSTBYADDR symbol, which
+ indicates to the C program that the gethostbyaddr() routine is available
+ to look up hosts by their IP addresses.
+
+d_gethbyname (d_gethbynm.U):
+ This variable conditionally defines the HAS_GETHOSTBYNAME symbol, which
+ indicates to the C program that the gethostbyname() routine is available
+ to look up host names in some data base or other.
d_gethent (d_gethent.U):
This variable conditionally defines HAS_GETHOSTENT if gethostent() is
- available to dup file descriptors.
+ available to look up host names in some data base or another.
-d_gettimeod (d_ftime.U):
- This variable conditionally defines the HAS_GETTIMEOFDAY symbol, which
- indicates that the gettimeofday() system call exists (to obtain a
- sub-second accuracy clock).
+d_gethname (d_gethname.U):
+ This variable conditionally defines the HAS_GETHOSTNAME symbol, which
+ indicates to the C program that the gethostname() routine may be
+ used to derive the host name.
+
+d_gethostprotos (d_gethostprotos.U):
+ This variable conditionally defines the HAS_GETHOST_PROTOS symbol,
+ which indicates to the C program that <netdb.h> supplies
+ prototypes for the various gethost*() functions.
+ See also netdbtype.U for probing for various netdb types.
d_getlogin (d_getlogin.U):
This variable conditionally defines the HAS_GETLOGIN symbol, which
indicates to the C program that the getlogin() routine is available
to get the login name.
+d_getmntent (d_getmntent.U):
+ This variable conditionally defines the HAS_GETMNTENT symbol, which
+ indicates to the C program that the getmntent() routine is available
+ to iterate through mounted files.
+
+d_getnbyaddr (d_getnbyad.U):
+ This variable conditionally defines the HAS_GETNETBYADDR symbol, which
+ indicates to the C program that the getnetbyaddr() routine is available
+ to look up networks by their IP addresses.
+
+d_getnbyname (d_getnbynm.U):
+ This variable conditionally defines the HAS_GETNETBYNAME symbol, which
+ indicates to the C program that the getnetbyname() routine is available
+ to look up networks by their names.
+
+d_getnent (d_getnent.U):
+ This variable conditionally defines HAS_GETNETENT if getnetent() is
+ available to look up network names in some data base or another.
+
+d_getnetprotos (d_getnetprotos.U):
+ This variable conditionally defines the HAS_GETNET_PROTOS symbol,
+ which indicates to the C program that <netdb.h> supplies
+ prototypes for the various getnet*() functions.
+ See also netdbtype.U for probing for various netdb types.
+
+d_getpbyname (d_getprotby.U):
+ This variable conditionally defines the HAS_GETPROTOBYNAME
+ symbol, which indicates to the C program that the
+ getprotobyname() routine is available to look up protocols
+ by their name.
+
+d_getpbynumber (d_getprotby.U):
+ This variable conditionally defines the HAS_GETPROTOBYNUMBER
+ symbol, which indicates to the C program that the
+ getprotobynumber() routine is available to look up protocols
+ by their number.
+
+d_getpent (d_getpent.U):
+ This variable conditionally defines HAS_GETPROTOENT if getprotoent() is
+ available to look up protocols in some data base or another.
+
d_getpgid (d_getpgid.U):
This variable conditionally defines the HAS_GETPGID symbol, which
indicates to the C program that the getpgid(pid) function
is available to get the process group id.
-d_getpgrp (d_getpgrp.U):
- This variable conditionally defines HAS_GETPGRP if getpgrp() is
- available to get the current process group.
-
d_getpgrp2 (d_getpgrp2.U):
This variable conditionally defines the HAS_GETPGRP2 symbol, which
indicates to the C program that the getpgrp2() (as in DG/UX) routine
is available to get the current process group.
+d_getpgrp (d_getpgrp.U):
+ This variable conditionally defines HAS_GETPGRP if getpgrp() is
+ available to get the current process group.
+
d_getppid (d_getppid.U):
This variable conditionally defines the HAS_GETPPID symbol, which
indicates to the C program that the getppid() routine is available
@@ -323,6 +612,56 @@ d_getprior (d_getprior.U):
This variable conditionally defines HAS_GETPRIORITY if getpriority()
is available to get a process's priority.
+d_getprotoprotos (d_getprotoprotos.U):
+ This variable conditionally defines the HAS_GETPROTO_PROTOS symbol,
+ which indicates to the C program that <netdb.h> supplies
+ prototypes for the various getproto*() functions.
+ See also netdbtype.U for probing for various netdb types.
+
+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
+ for sequential access of the passwd database.
+
+d_getsbyname (d_getsrvby.U):
+ This variable conditionally defines the HAS_GETSERVBYNAME
+ symbol, which indicates to the C program that the
+ getservbyname() routine is available to look up services
+ by their name.
+
+d_getsbyport (d_getsrvby.U):
+ This variable conditionally defines the HAS_GETSERVBYPORT
+ symbol, which indicates to the C program that the
+ getservbyport() routine is available to look up services
+ by their port.
+
+d_getsent (d_getsent.U):
+ This variable conditionally defines HAS_GETSERVENT if getservent() is
+ available to look up network services in some data base or another.
+
+d_getservprotos (d_getservprotos.U):
+ This variable conditionally defines the HAS_GETSERV_PROTOS symbol,
+ which indicates to the C program that <netdb.h> supplies
+ prototypes for the various getserv*() functions.
+ See also netdbtype.U for probing for various netdb types.
+
+d_gettimeod (d_ftime.U):
+ This variable conditionally defines the HAS_GETTIMEOFDAY symbol, which
+ indicates that the gettimeofday() system call exists (to obtain a
+ sub-second accuracy clock). You should probably include <sys/resource.h>.
+
+d_gnulibc (d_gnulibc.U):
+ Defined if we're dealing with the GNU C Library.
+
+d_grpasswd (i_grp.U):
+ This variable conditionally defines GRPASSWD, which indicates
+ that struct group in <grp.h> contains gr_passwd.
+
+d_hasmntopt (d_hasmntopt.U):
+ This variable conditionally defines the HAS_HASMNTOPT symbol, which
+ indicates to the C program that the hasmntopt() routine is available
+ to query the mount options of file systems.
+
d_htonl (d_htonl.U):
This variable conditionally defines HAS_HTONL if htonl() and its
friends are available to do network order byte swapping.
@@ -345,6 +684,11 @@ d_killpg (d_killpg.U):
indicates to the C program that the killpg() routine is available
to kill process groups.
+d_lchown (d_lchown.U):
+ This variable conditionally defines the HAS_LCHOWN symbol, which
+ indicates to the C program that the lchown() routine is available
+ to operate on a symbolic link (instead of following the link).
+
d_link (d_link.U):
This variable conditionally defines HAS_LINK if link() is
available to create hard links.
@@ -357,6 +701,14 @@ d_lockf (d_lockf.U):
This variable conditionally defines HAS_LOCKF if lockf() is
available to do file locking.
+d_longdbl (d_longdbl.U):
+ This variable conditionally defines HAS_LONG_DOUBLE if
+ the long double type is supported.
+
+d_longlong (d_longlong.U):
+ This variable conditionally defines HAS_LONG_LONG if
+ the long long type is supported.
+
d_lstat (d_lstat.U):
This variable conditionally defines HAS_LSTAT if lstat() is
available to do file stats on symbolic links.
@@ -413,6 +765,22 @@ d_msg (d_msg.U):
This variable conditionally defines the HAS_MSG symbol, which
indicates that the entire msg*(2) library is present.
+d_msgctl (d_msgctl.U):
+ This variable conditionally defines the HAS_MSGCTL symbol, which
+ indicates to the C program that the msgctl() routine is available.
+
+d_msgget (d_msgget.U):
+ This variable conditionally defines the HAS_MSGGET symbol, which
+ indicates to the C program that the msgget() routine is available.
+
+d_msgrcv (d_msgrcv.U):
+ This variable conditionally defines the HAS_MSGRCV symbol, which
+ indicates to the C program that the msgrcv() routine is available.
+
+d_msgsnd (d_msgsnd.U):
+ This variable conditionally defines the HAS_MSGSND symbol, which
+ indicates to the C program that the msgsnd() routine is available.
+
d_mymalloc (mallocsrc.U):
This variable conditionally defines MYMALLOC in case other parts
of the source want to take special action if MYMALLOC is used.
@@ -422,10 +790,15 @@ d_nice (d_nice.U):
This variable conditionally defines the HAS_NICE symbol, which
indicates to the C program that the nice() routine is available.
-d_oldarchlib (oldarchlib.U):
- This variable conditionally defines OLDARCHLIB to hold the pathname
- of architecture-dependent library files for a previous
- version of $package.
+d_oldpthreads (usethreads.U):
+ This variable conditionally defines the OLD_PTHREADS_API symbol,
+ and indicates that Perl should be built to use the old
+ draft POSIX threads API. This is only potneially meaningful if
+ usethreads is set.
+
+d_oldsock (d_socket.U):
+ This variable conditionally defines the OLDSOCKET symbol, which
+ indicates that the BSD socket interface is based on 4.1c and not 4.2.
d_open3 (d_open3.U):
This variable conditionally defines the HAS_OPEN3 manifest constant,
@@ -443,6 +816,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_phostname (d_gethname.U):
+ This variable conditionally defines the PHOSTNAME symbol, which
+ contains the shell command which, when fed to popen(), may be
+ used to derive the host name.
+
d_pipe (d_pipe.U):
This variable conditionally defines the HAS_PIPE symbol, which
indicates to the C program that the pipe() routine is available
@@ -453,28 +831,51 @@ d_poll (d_poll.U):
indicates to the C program that the poll() routine is available
to poll active file descriptors.
+d_portable (d_portable.U):
+ This variable conditionally defines the PORTABLE symbol, which
+ indicates to the C program that it should not assume that it is
+ running on the machine it was compiled on.
+
+d_pthread_yield (d_pthread_y.U):
+ This variable conditionally defines the HAS_PTHREAD_YIELD
+ symbol if the pthread_yield routine is available to yield
+ the execution of the current thread.
+
+d_pthreads_created_joinable (d_pthreadj.U):
+ This variable conditionally defines the PTHREADS_CREATED_JOINABLE
+ symbol if pthreads are created in the joinable (aka undetached)
+ state.
+
d_pwage (i_pwd.U):
- This varaible conditionally defines PWAGE, which indicates
+ This variable conditionally defines PWAGE, which indicates
that struct passwd contains pw_age.
d_pwchange (i_pwd.U):
- This varaible conditionally defines PWCHANGE, which indicates
+ This variable conditionally defines PWCHANGE, which indicates
that struct passwd contains pw_change.
d_pwclass (i_pwd.U):
- This varaible conditionally defines PWCLASS, which indicates
+ This variable conditionally defines PWCLASS, which indicates
that struct passwd contains pw_class.
d_pwcomment (i_pwd.U):
- This varaible conditionally defines PWCOMMENT, which indicates
+ This variable conditionally defines PWCOMMENT, which indicates
that struct passwd contains pw_comment.
d_pwexpire (i_pwd.U):
- This varaible conditionally defines PWEXPIRE, which indicates
+ This variable conditionally defines PWEXPIRE, which indicates
that struct passwd contains pw_expire.
+d_pwgecos (i_pwd.U):
+ This variable conditionally defines PWGECOS, which indicates
+ that struct passwd contains pw_gecos.
+
+d_pwpasswd (i_pwd.U):
+ This variable conditionally defines PWPASSWD, which indicates
+ that struct passwd contains pw_passwd.
+
d_pwquota (i_pwd.U):
- This varaible conditionally defines PWQUOTA, which indicates
+ This variable conditionally defines PWQUOTA, which indicates
that struct passwd contains pw_quota.
d_readdir (d_readdir.U):
@@ -512,6 +913,11 @@ 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_sched_yield (d_pthread_y.U):
+ This variable conditionally defines the HAS_SCHED_YIELD
+ symbol if the sched_yield routine is available to yield
+ the execution of the current thread.
+
d_seekdir (d_readdir.U):
This variable conditionally defines HAS_SEEKDIR if seekdir() is
available.
@@ -525,6 +931,26 @@ d_sem (d_sem.U):
This variable conditionally defines the HAS_SEM symbol, which
indicates that the entire sem*(2) library is present.
+d_semctl (d_semctl.U):
+ This variable conditionally defines the HAS_SEMCTL symbol, which
+ indicates to the C program that the semctl() routine is available.
+
+d_semctl_semid_ds (d_union_senum.U):
+ This variable conditionally defines USE_SEMCTL_SEMID_DS, which
+ indicates that struct semid_ds * is to be used for semctl IPC_STAT.
+
+d_semctl_semun (d_union_senum.U):
+ This variable conditionally defines USE_SEMCTL_SEMUN, which
+ indicates that union semun is to be used for semctl IPC_STAT.
+
+d_semget (d_semget.U):
+ This variable conditionally defines the HAS_SEMGET symbol, which
+ indicates to the C program that the semget() routine is available.
+
+d_semop (d_semop.U):
+ This variable conditionally defines the HAS_SEMOP symbol, which
+ indicates to the C program that the semop() routine is available.
+
d_setegid (d_setegid.U):
This variable conditionally defines the HAS_SETEGID symbol, which
indicates to the C program that the setegid() routine is available
@@ -535,6 +961,20 @@ d_seteuid (d_seteuid.U):
indicates to the C program that the seteuid() routine is available
to change the effective uid of the current program.
+d_setgrent (d_setgrent.U):
+ This variable conditionally defines the HAS_SETGRENT symbol, which
+ indicates to the C program that the setgrent() routine is available
+ for initializing sequential access to the group database.
+
+d_setgrps (d_setgrps.U):
+ This variable conditionally defines the HAS_SETGROUPS symbol, which
+ indicates to the C program that the setgroups() routine is available
+ to set the list of process groups.
+
+d_sethent (d_sethent.U):
+ This variable conditionally defines HAS_SETHOSTENT if sethostent() is
+ available.
+
d_setlinebuf (d_setlnbuf.U):
This variable conditionally defines the HAS_SETLINEBUF symbol, which
indicates to the C program that the setlinebuf() routine is available
@@ -545,24 +985,36 @@ d_setlocale (d_setlocale.U):
This variable conditionally defines HAS_SETLOCALE if setlocale() is
available to handle locale-specific ctype implementations.
-d_setpgid (d_setpgid.U):
- This variable conditionally defines the HAS_SETPGID symbol, which
- indicates to the C program that the setpgid(pid, gpid) function
- is available to set the process group id.
+d_setnent (d_setnent.U):
+ This variable conditionally defines HAS_SETNETENT if setnetent() is
+ available.
-d_setpgrp (d_setpgrp.U):
- This variable conditionally defines HAS_SETPGRP if setpgrp() is
- available to set the current process group.
+d_setpent (d_setpent.U):
+ This variable conditionally defines HAS_SETPROTOENT if setprotoent() is
+ available.
+
+d_setpgid (d_setpgid.U):
+ This variable conditionally defines the HAS_SETPGID symbol if the
+ setpgid(pid, gpid) function is available to set process group ID.
d_setpgrp2 (d_setpgrp2.U):
This variable conditionally defines the HAS_SETPGRP2 symbol, which
indicates to the C program that the setpgrp2() (as in DG/UX) routine
is available to set the current process group.
+d_setpgrp (d_setpgrp.U):
+ This variable conditionally defines HAS_SETPGRP if setpgrp() is
+ available to set the current process group.
+
d_setprior (d_setprior.U):
This variable conditionally defines HAS_SETPRIORITY if setpriority()
is available to set a process's priority.
+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
+ for initializing sequential access to the passwd database.
+
d_setregid (d_setregid.U):
This variable conditionally defines HAS_SETREGID if setregid() is
available to change the real and effective gid of the current
@@ -593,10 +1045,19 @@ d_setruid (d_setruid.U):
indicates to the C program that the setruid() routine is available
to change the real uid of the current program.
+d_setsent (d_setsent.U):
+ This variable conditionally defines HAS_SETSERVENT if setservent() is
+ available.
+
d_setsid (d_setsid.U):
This variable conditionally defines HAS_SETSID if setsid() is
available to set the process group ID.
+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
+ to change buffering on an open stdio stream.
+
d_sfio (d_sfio.U):
This variable conditionally defines the USE_SFIO symbol,
and indicates whether sfio is available (and should be used).
@@ -605,11 +1066,27 @@ d_shm (d_shm.U):
This variable conditionally defines the HAS_SHM symbol, which
indicates that the entire shm*(2) library is present.
+d_shmat (d_shmat.U):
+ This variable conditionally defines the HAS_SHMAT symbol, which
+ indicates to the C program that the shmat() routine is available.
+
d_shmatprototype (d_shmat.U):
This variable conditionally defines the HAS_SHMAT_PROTOTYPE
symbol, which indicates that sys/shm.h has a prototype for
shmat.
+d_shmctl (d_shmctl.U):
+ This variable conditionally defines the HAS_SHMCTL symbol, which
+ indicates to the C program that the shmctl() routine is available.
+
+d_shmdt (d_shmdt.U):
+ This variable conditionally defines the HAS_SHMDT symbol, which
+ indicates to the C program that the shmdt() routine is available.
+
+d_shmget (d_shmget.U):
+ This variable conditionally defines the HAS_SHMGET symbol, which
+ indicates to the C program that the shmget() routine is available.
+
d_sigaction (d_sigaction.U):
This variable conditionally defines the HAS_SIGACTION symbol, which
indicates that the Vr4 sigaction() routine is available.
@@ -631,6 +1108,16 @@ d_statblks (d_statblks.U):
This variable conditionally defines USE_STAT_BLOCKS if this system
has a stat structure declaring st_blksize and st_blocks.
+d_statfsflags (d_statfs.U):
+ This variable conditionally defines the HAS_STRUCT_STATFS_FLAGS
+ symbol, which indicates to struct statfs from has f_flags member.
+ This kind of struct statfs is coming from sys/mount.h (BSD),
+ not from sys/statfs.h (SYSV).
+
+d_statvfs (d_statvfs.U):
+ This variable conditionally defines the HAS_STATVFS symbol, which
+ indicates to the C program that the statvfs() routine is available.
+
d_stdio_cnt_lval (d_stdstdio.U):
This variable conditionally defines STDIO_CNT_LVALUE if the
FILE_cnt macro can be used as an lvalue.
@@ -709,6 +1196,10 @@ d_sysconf (d_sysconf.U):
indicates to the C program that the sysconf() routine is available
to determine system related limits and options.
+d_sysernlst (d_strerror.U):
+ This variable conditionally defines HAS_SYS_ERRNOLIST if sys_errnolist[]
+ is available to translate error numbers to the symbolic name.
+
d_syserrlst (d_strerror.U):
This variable conditionally defines HAS_SYS_ERRLIST if sys_errlist[] is
available to translate error numbers to strings.
@@ -731,6 +1222,11 @@ d_telldir (d_readdir.U):
This variable conditionally defines HAS_TELLDIR if telldir() is
available.
+d_time (d_time.U):
+ This variable conditionally defines the HAS_TIME symbol, which indicates
+ that the time() routine exists. The time() routine is normaly
+ provided on UNIX systems.
+
d_times (d_times.U):
This variable conditionally defines the HAS_TIMES symbol, which indicates
that the times() routine exists. The times() routine is normaly
@@ -754,6 +1250,10 @@ d_uname (d_gethname.U):
indicates to the C program that the uname() routine may be
used to derive the host name.
+d_union_semun (d_union_senum.U):
+ This variable conditionally defines HAS_UNION_SEMUN if the
+ union semun is defined by including <sys/sem.h>.
+
d_vfork (d_vfork.U):
This variable conditionally defines the HAS_VFORK symbol, which
indicates the vfork() routine is available.
@@ -762,6 +1262,17 @@ d_void_closedir (d_closedir.U):
This variable conditionally defines VOID_CLOSEDIR if closedir()
does not return a value.
+d_voidsig (d_voidsig.U):
+ This variable conditionally defines VOIDSIG if this system
+ declares "void (*signal(...))()" in signal.h. The old way was to
+ declare it as "int (*signal(...))()".
+
+d_voidtty (i_sysioctl.U):
+ This variable conditionally defines USE_IOCNOTTY to indicate that the
+ ioctl() call with TIOCNOTTY should be used to void tty association.
+ Otherwise (on USG probably), it is enough to close the standard file
+ decriptors and do a setpgrp().
+
d_volatile (d_volatile.U):
This variable conditionally defines the HASVOLATILE symbol, which
indicates to the C program that this C compiler knows about the
@@ -790,6 +1301,15 @@ d_wctomb (d_wctomb.U):
indicates to the C program that the wctomb() routine is available
to convert a wide character to a multibyte.
+d_xenix (Guess.U):
+ This variable conditionally defines the symbol XENIX, which alerts
+ the C program that it runs under Xenix.
+
+date (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the date program. After Configure runs,
+ the value is reset to a plain "date" and is not useful.
+
db_hashtype (i_db.U):
This variable contains the type of the hash structure element
in the <db.h> header file. In older versions of DB, it was
@@ -813,8 +1333,12 @@ dlsrc (dlsrc.U):
This variable contains the name of the dynamic loading file that
will be used with the package.
+doublesize (doublesize.U):
+ This variable contains the value of the DOUBLESIZE symbol, which
+ indicates to the C program how many bytes there are in a double.
+
dynamic_ext (Extensions.U):
- This variable holds a list of extension files we want to
+ This variable holds a list of XS extension files we want to
link dynamically into the package. It is used by Makefile.
eagain (nblock_io.U):
@@ -822,14 +1346,49 @@ eagain (nblock_io.U):
data is present on the file and non-blocking I/O was enabled (otherwise,
read() blocks naturally).
+ebcdic (ebcdic.U):
+ This variable conditionally defines EBCDIC if this
+ system uses EBCDIC encoding. Among other things, this
+ means that the character ranges are not contiguous.
+ See trnl.U
+
+echo (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the echo program. After Configure runs,
+ the value is reset to a plain "echo" and is not useful.
+
+egrep (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the egrep program. After Configure runs,
+ the value is reset to a plain "egrep" and is not useful.
+
+emacs (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
eunicefix (Init.U):
When running under Eunice this variable contains a command which will
convert a shell script to the proper form of text file for it to be
executable by the shell. On other systems it is a no-op.
exe_ext (Unix.U):
- This variable defines the extension used for executable files.
- For unix it is empty. Other possible values include '.exe'.
+ This is an old synonym for _exe.
+
+expr (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the expr program. After Configure runs,
+ the value is reset to a plain "expr" and is not useful.
+
+extensions (Extensions.U):
+ This variable holds a list of all extension files (both XS and
+ non-xs linked into the package. It is propagated to Config.pm
+ and is typically used to test whether a particular extesion
+ is available.
+
+find (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the find program. After Configure runs,
+ the value is reset to a plain "find" and is not useful.
firstmakefile (Unix.U):
This variable defines the first file searched by make. On unix,
@@ -837,6 +1396,10 @@ firstmakefile (Unix.U):
it might be something else. This is only used to deal with
convoluted make depend tricks.
+flex (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
fpostype (fpostype.U):
This variable defines Fpos_t to be something like fpost_t, long,
uint, or whatever type is used to declare file positions in libc.
@@ -845,6 +1408,11 @@ freetype (mallocsrc.U):
This variable contains the return type of free(). It is usually
void, but occasionally int.
+full_ar (Loc_ar.U):
+ This variable contains the full pathname to 'ar', whether or
+ not the user has specified 'portability'. This is only used
+ in the Makefile.SH.
+
full_csh (d_csh.U):
This variable contains the full pathname to 'csh', whether or
not the user has specified 'portability'. This is only used
@@ -859,21 +1427,87 @@ full_sed (Loc_sed.U):
can share this executable will have the same full pathname to
'sed.'
+gccversion (cc.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.
+
gidtype (gidtype.U):
This variable defines Gid_t to be something like gid_t, int,
ushort, or whatever type is used to declare the return type
of getgid(). Typically, it is the type of group ids in the kernel.
+grep (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the grep program. After Configure runs,
+ the value is reset to a plain "grep" and is not useful.
+
+groupcat (nis.U):
+ This variable contains a command that produces the text of the
+ /etc/group file. This is normally "cat /etc/group", but can be
+ "ypcat group" when NIS is used.
+
groupstype (groupstype.U):
This variable defines Groups_t to be something like gid_t, int,
ushort, or whatever type is used for the second argument to
- getgroups(). Usually, this is the same of gidtype, but
- sometimes it isn't.
+ getgroups() and setgroups(). Usually, this is the same as
+ gidtype (gid_t), but sometimes it isn't.
+
+gzip (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the gzip program. After Configure runs,
+ the value is reset to a plain "gzip" and is not useful.
+
+h_fcntl (h_fcntl.U):
+ This is variable gets set in various places to tell i_fcntl that
+ <fcntl.h> should be included.
+
+h_sysfile (h_sysfile.U):
+ This is variable gets set in various places to tell i_sys_file that
+ <sys/file.h> should be included.
+
+hint (Oldconfig.U):
+ Gives the type of hints used for previous answers. May be one of
+ "default", "recommended" or "previous".
+
+hostcat (nis.U):
+ This variable contains a command that produces the text of the
+ /etc/hosts file. This is normally "cat /etc/hosts", but can be
+ "ypcat hosts" when NIS is used.
+
+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.
+
+i_arpainet (i_arpainet.U):
+ This variable conditionally defines the I_ARPA_INET symbol,
+ and indicates whether a C program should include <arpa/inet.h>.
+
+i_bsdioctl (i_sysioctl.U):
+ This variable conditionally defines the I_SYS_BSDIOCTL symbol, which
+ indicates to the C program that <sys/bsdioctl.h> exists and should
+ be included.
+
+i_db (i_db.U):
+ This variable conditionally defines the I_DB symbol, and indicates
+ whether a C program may include Berkeley's DB include file <db.h>.
+
+i_dbm (i_dbm.U):
+ This variable conditionally defines the I_DBM symbol, which
+ indicates to the C program that <dbm.h> exists and should
+ be included.
i_dirent (i_dirent.U):
This variable conditionally defines I_DIRENT, which indicates
to the C program that it should include <dirent.h>.
+i_dld (i_dld.U):
+ This variable conditionally defines the I_DLD symbol, which
+ indicates to the C program that <dld.h> (GNU dynamic loading)
+ exists and should be included.
+
i_dlfcn (i_dlfcn.U):
This variable conditionally defines the I_DLFCN symbol, which
indicates to the C program that <dlfcn.h> exists and should
@@ -888,6 +1522,11 @@ i_float (i_float.U):
whether a C program may include <float.h> to get symbols like DBL_MAX
or DBL_MIN, i.e. machine dependent floating point values.
+i_gdbm (i_gdbm.U):
+ This variable conditionally defines the I_GDBM symbol, which
+ indicates to the C program that <gdbm.h> exists and should
+ be included.
+
i_grp (i_grp.U):
This variable conditionally defines the I_GRP symbol, and indicates
whether a C program should include <grp.h>.
@@ -901,6 +1540,14 @@ i_locale (i_locale.U):
This variable conditionally defines the I_LOCALE symbol,
and indicates whether a C program should include <locale.h>.
+i_machcthr (i_machcthr.U):
+ This variable conditionally defines the I_MACH_CTHREADS symbol,
+ and indicates whether a C program should include <mach/cthreads.h>.
+
+i_malloc (i_malloc.U):
+ This variable conditionally defines the I_MALLOC symbol, and indicates
+ whether a C program should include <malloc.h>.
+
i_math (i_math.U):
This variable conditionally defines the I_MATH symbol, and indicates
whether a C program may include <math.h>.
@@ -909,6 +1556,19 @@ i_memory (i_memory.U):
This variable conditionally defines the I_MEMORY symbol, and indicates
whether a C program should include <memory.h>.
+i_mntent (i_mntent.U):
+ This variable conditionally defines the I_MNTENT symbol, and indicates
+ whether a C program should include <mntent.h>.
+
+i_ndbm (i_ndbm.U):
+ This variable conditionally defines the I_NDBM symbol, which
+ indicates to the C program that <ndbm.h> exists and should
+ be included.
+
+i_netdb (i_netdb.U):
+ This variable conditionally defines the I_NETDB symbol, and indicates
+ whether a C program should include <netdb.h>.
+
i_neterrno (i_neterrno.U):
This variable conditionally defines the I_NET_ERRNO symbol, which
indicates to the C program that <net/errno.h> exists and should
@@ -964,11 +1624,25 @@ i_sysfile (i_sysfile.U):
This variable conditionally defines the I_SYS_FILE symbol, and indicates
whether a C program should include <sys/file.h> to get R_OK and friends.
+i_sysfilio (i_sysioctl.U):
+ This variable conditionally defines the I_SYS_FILIO symbol, which
+ indicates to the C program that <sys/filio.h> exists and should
+ be included in preference to <sys/ioctl.h>.
+
+i_sysin (i_niin.U):
+ This variable conditionally defines I_SYS_IN, which indicates
+ to the C program that it should include <sys/in.h> instead of
+ <netinet/in.h>.
+
i_sysioctl (i_sysioctl.U):
This variable conditionally defines the I_SYS_IOCTL symbol, which
indicates to the C program that <sys/ioctl.h> exists and should
be included.
+i_sysmount (i_sysmount.U):
+ This variable conditionally defines the I_SYSMOUNT symbol,
+ and indicates whether a C program should include <sys/mount.h>.
+
i_sysndir (i_sysndir.U):
This variable conditionally defines the I_SYS_NDIR symbol, and indicates
whether a C program should include <sys/ndir.h>.
@@ -986,10 +1660,23 @@ i_sysselct (i_sysselct.U):
to the C program that it should include <sys/select.h> in order to
get the definition of struct timeval.
+i_syssockio (i_sysioctl.U):
+ This variable conditionally defines I_SYS_SOCKIO to indicate to the
+ C program that socket ioctl codes may be found in <sys/sockio.h>
+ instead of <sys/ioctl.h>.
+
i_sysstat (i_sysstat.U):
This variable conditionally defines the I_SYS_STAT symbol,
and indicates whether a C program should include <sys/stat.h>.
+i_sysstatfs (i_sysstatfs.U):
+ This variable conditionally defines the I_SYSSTATFS symbol,
+ and indicates whether a C program should include <sys/statfs.h>.
+
+i_sysstatvfs (i_sysstatvfs.U):
+ This variable conditionally defines the I_SYSSTATVFS symbol,
+ and indicates whether a C program should include <sys/statvfs.h>.
+
i_systime (i_time.U):
This variable conditionally defines I_SYS_TIME, which indicates
to the C program that it should include <sys/time.h>.
@@ -1055,20 +1742,78 @@ i_vfork (i_vfork.U):
This variable conditionally defines the I_VFORK symbol, and indicates
whether a C program should include vfork.h.
+ignore_versioned_solibs (libs.U):
+ This variable should be non-empty if non-versioned shared
+ libraries (libfoo.so.x.y) are to be ignored (because they
+ cannot be linked against).
+
+incpath (usrinc.U):
+ This variable must preceed the normal include path to get hte
+ right one, as in "$incpath/usr/include" or "$incpath/usr/lib".
+ Value can be "" or "/bsd43" on mips.
+
+inews (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+installarchlib (archlib.U):
+ This variable is really the same as archlibexp but may differ on
+ those systems using AFS. For extra portability, only this variable
+ should be used in makefiles.
+
installbin (bin.U):
This variable is the same as binexp unless AFS is running in which case
the user is explicitely prompted for it. This variable should always
be used in your makefiles for maximum portability.
+installman1dir (man1dir.U):
+ This variable is really the same as man1direxp, unless you are using
+ AFS in which case it points to the read/write location whereas
+ man1direxp only points to the read-only access location. For extra
+ portability, you should only use this variable within your makefiles.
+
+installman3dir (man3dir.U):
+ This variable is really the same as man3direxp, unless you are using
+ AFS in which case it points to the read/write location whereas
+ man3direxp only points to the read-only access location. For extra
+ portability, you should only use this variable within your makefiles.
+
installprivlib (privlib.U):
This variable is really the same as privlibexp but may differ on
those systems using AFS. For extra portability, only this variable
should be used in makefiles.
+installscript (scriptdir.U):
+ This variable is usually the same as scriptdirexp, unless you are on
+ a system running AFS, in which case they may differ slightly. You
+ should always use this variable within your makefiles for portability.
+
+installsitearch (sitearch.U):
+ This variable is really the same as sitearchexp but may differ on
+ those systems using AFS. For extra portability, only this variable
+ should be used in makefiles.
+
+installsitelib (sitelib.U):
+ This variable is really the same as sitelibexp but may differ on
+ those systems using AFS. For extra portability, only this variable
+ should be used in makefiles.
+
+installusrbinperl (instubperl.U):
+ This variable tells whether Perl should be installed also as
+ /usr/bin/perl in addition to
+ $installbin/perl
+
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 integer.
+ This variable contains the value of the INTSIZE symbol, which
+ indicates to the C program how many bytes there are in an int.
+
+known_extensions (Extensions.U):
+ This variable holds a list of all XS extensions included in
+ the package.
+
+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
@@ -1085,16 +1830,22 @@ lddlflags (dlsrc.U):
This variable contains any special flags that might need to be
passed to $ld to create a shared library suitable for dynamic
loading. It is up to the makefile to use it. For hpux, it
- should be -b. For sunos 4.1, it is empty.
+ should be '-b'. For sunos 4.1, it is empty.
ldflags (ccflags.U):
This variable contains any additional C loader flags desired by
the user. It is up to the Makefile to use this.
+less (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the less program. After Configure runs,
+ the value is reset to a plain "less" and is not useful.
+
lib_ext (Unix.U):
- This variable defines the extension used for ordinary libraries.
- For unix, it is '.a'. The '.' is included. Other possible
- values include '.lib'.
+ This is an old synonym for _a.
+
+libc (libc.U):
+ This variable contains the location of the C library.
libperl (libperl.U):
The perl executable is obtained by linking perlmain.c with
@@ -1104,39 +1855,108 @@ libperl (libperl.U):
the user wishes to build a perl executable with a shared
library.
+libpth (libpth.U):
+ This variable holds the general path used to find libraries. It is
+ intended to be used by other units.
+
libs (libs.U):
This variable holds the additional libraries we want to use.
It is up to the Makefile to deal with it.
+libswanted (Myinit.U):
+ This variable holds a list of all the libraries we want to
+ search. The order is chosen to pick up the c library
+ ahead of ucb or bsd libraries for SVR4.
+
+line (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the line program. After Configure runs,
+ the value is reset to a plain "line" and is not useful.
+
+lint (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+lkflags (ccflags.U):
+ This variable contains any additional C partial linker flags desired by
+ the user. It is up to the Makefile to use this.
+
+ln (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the ln program. After Configure runs,
+ the value is reset to a plain "ln" and is not useful.
+
lns (lns.U):
This variable holds the name of the command to make
symbolic links (if they are supported). It can be used
in the Makefile. It is either 'ln -s' or 'ln'
+locincpth (ccflags.U):
+ This variable contains a list of additional directories to be
+ searched by the compiler. The appropriate '-I' directives will
+ be added to ccflags. This is intended to simplify setting
+ local directories from the Configure command line.
+ It's not much, but it parallels the loclibpth stuff in libpth.U.
+
+loclibpth (libpth.U):
+ This variable holds the paths used to find local libraries. It is
+ prepended to libpth, and is intended to be easily set from the
+ command line.
+
+longdblsize (d_longdbl.U):
+ This variable contains the value of the LONG_DOUBLESIZE symbol, which
+ indicates to the C program how many bytes there are in a long double,
+ if this system supports long doubles.
+
+longlongsize (d_longlong.U):
+ This variable contains the value of the LONGLONGSIZE symbol, which
+ indicates to the C program how many bytes there are in a long long,
+ if this system supports long long.
+
longsize (intsize.U):
- This variable contains the value of the LONGSIZE symbol,
- which indicates to the C program how many bytes there are
- in a long integer.
+ This variable contains the value of the LONGSIZE symbol, which
+ indicates to the C program how many bytes there are in a long.
+
+lp (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+lpr (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+ls (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the ls program. After Configure runs,
+ the value is reset to a plain "ls" and is not useful.
lseektype (lseektype.U):
This variable defines lseektype to be something like off_t, long,
or whatever type is used to declare lseek offset's type in the
kernel (which also appears to be lseek's return type).
-make (make.U):
- This variable sets the path to the 'make' command. It is
- here rather than in Loc.U so that users can override it
- with Configure -Dmake=pmake, or equivalent.
+mail (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+mailx (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+make (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the make program. After Configure runs,
+ the value is reset to a plain "make" and is not useful.
make_set_make (make.U):
Some versions of 'make' set the variable MAKE. Others do not.
This variable contains the string to be included in Makefile.SH
so that MAKE is set if needed, and not if not needed.
Possible values are:
- make_set_make='#' # If your make program handles this for you,
- make_set_make=$make # if it doesn't.
+ make_set_make='#' # If your make program handles this for you,
+ make_set_make="MAKE=$make" # if it doesn't.
I used a comment character so that we can distinguish a
- 'set' value (from a previous config.sh or Configure -D option)
+ 'set' value (from a previous config.sh or Configure '-D' option)
from an uncomputed value.
mallocobj (mallocsrc.U):
@@ -1160,6 +1980,10 @@ man1dir (man1dir.U):
Makefile.SH to get the value of this into the proper command.
You must be prepared to do the ~name expansion yourself.
+man1direxp (man1dir.U):
+ This variable is the same as the man1dir variable, but is filename
+ expanded at configuration time, for convenient use in makefiles.
+
man1ext (man1dir.U):
This variable contains the extension that the manual page should
have: one of 'n', 'l', or '1'. The Makefile must supply the '.'.
@@ -1171,55 +1995,181 @@ man3dir (man3dir.U):
Makefile.SH to get the value of this into the proper command.
You must be prepared to do the ~name expansion yourself.
+man3direxp (man3dir.U):
+ This variable is the same as the man3dir variable, but is filename
+ expanded at configuration time, for convenient use in makefiles.
+
man3ext (man3dir.U):
This variable contains the extension that the manual page should
have: one of 'n', 'l', or '3'. The Makefile must supply the '.'.
See man3dir.
+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".
+
+mkdir (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the mkdir program. After Configure runs,
+ the value is reset to a plain "mkdir" and is not useful.
+
+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
modes for system calls.
+more (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the more program. After Configure runs,
+ the value is reset to a plain "more" and is not useful.
+
+mv (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+myarchname (archname.U):
+ This variable holds the architecture name computed by Configure in
+ a previous run. It is not intended to be perused by any user and
+ should never be set in a hint file.
+
+mydomain (myhostname.U):
+ This variable contains the eventual value of the MYDOMAIN symbol,
+ which is the domain of the host the program is going to run on.
+ The domain must be appended to myhostname to form a complete host name.
+ The dot comes with mydomain, and need not be supplied by the program.
+
+myhostname (myhostname.U):
+ This variable contains the eventual value of the MYHOSTNAME symbol,
+ which is the name of the host the program is going to run on.
+ The domain is not kept with hostname, but must be gotten from mydomain.
+ The dot comes with mydomain, and need not be supplied by the program.
+
+myuname (Oldconfig.U):
+ The output of 'uname -a' if available, otherwise the hostname. On Xenix,
+ pseudo variables assignments in the output are stripped, thank you. The
+ whole thing is then lower-cased.
+
n (n.U):
- This variable contains the -n flag if that is what causes the echo
+ This variable contains the '-n' flag if that is what causes the echo
command to suppress newline. Otherwise it is null. Correct usage is
$echo $n "prompt for a question: $c".
+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.
+ This is only useful if you have gethostbyaddr(), naturally.
+
+netdb_host_type (netdbtype.U):
+ This variable holds the type used for the 1st argument to
+ gethostbyaddr(). Usually, this is char * or void *, possibly
+ with or without a const prefix.
+ This is only useful if you have gethostbyaddr(), naturally.
+
+netdb_name_type (netdbtype.U):
+ This variable holds the type used for the argument to
+ gethostbyname(). Usually, this is char * or const char *.
+ This is only useful if you have gethostbyname(), naturally.
+
+netdb_net_type (netdbtype.U):
+ This variable holds the type used for the 1st argument to
+ getnetbyaddr(). Usually, this is int or long.
+ This is only useful if you have getnetbyaddr(), naturally.
+
+nm (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the nm program. After Configure runs,
+ the value is reset to a plain "nm" and is not useful.
+
+nm_opt (usenm.U):
+ This variable holds the options that may be necessary for nm.
+
+nm_so_opt (usenm.U):
+ This variable holds the options that may be necessary for nm
+ to work on a shared library but that can not be used on an
+ archive library. Currently, this is only used by Linux, where
+ nm --dynamic is *required* to get symbols from an ELF library which
+ has been stripped, but nm --dynamic is *fatal* on an archive library.
+ Maybe Linux should just always set usenm=false.
+
+nonxs_ext (Extensions.U):
+ This variable holds a list of all non-xs extensions included
+ in the package. All of them will be built.
+
+nroff (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the nroff program. After Configure runs,
+ the value is reset to a plain "nroff" and is not useful.
+
o_nonblock (nblock_io.U):
This variable bears the symbol value to be used during open() or fcntl()
to turn on non-blocking I/O for a file descriptor. If you wish to switch
between blocking and non-blocking, you may try ioctl(FIOSNBIO) instead,
but that is only supported by some devices.
-oldarchlib (oldarchlib.U):
- This variable holds the name of the directory in which perl5.000
- and perl5.001 stored
- architecture-dependent public library files.
-
-oldarchlibexp (oldarchlib.U):
- This variable is the same as the oldarchlib variable, but is
- filename expanded at configuration time, for convenient use.
+obj_ext (Unix.U):
+ This is an old synonym for _o.
optimize (ccflags.U):
This variable contains any optimizer/debugger flag that should be used.
It is up to the Makefile to use it.
+orderlib (orderlib.U):
+ This variable is "true" if the components of libraries must be ordered
+ (with `lorder $* | tsort`) before placing them in an archive. Set to
+ "false" if ranlib or ar can generate random libraries.
+
osname (Oldconfig.U):
This variable contains the operating system name (e.g. sunos,
solaris, hpux, etc.). It can be useful later on for setting
defaults. Any spaces are replaced with underscores. It is set
to a null string if we can't figure it out.
+osvers (Oldconfig.U):
+ This variable contains the operating system version (e.g.
+ 4.1.3, 5.2, etc.). It is primarily used for helping select
+ an appropriate hints file, but might be useful elsewhere for
+ setting defaults. It is set to '' if we can't figure it out.
+ We try to be flexible about how much of the version number
+ to keep, e.g. if 4.1.1, 4.1.2, and 4.1.3 are essentially the
+ 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.
+
+package (package.U):
+ This variable contains the name of the package being constructed.
+ It is primarily intended for the use of later Configure units.
+
pager (pager.U):
This variable contains the name of the preferred pager on the system.
Usual values are (the full pathnames of) more, less, pg, or cat.
+passcat (nis.U):
+ This variable contains a command that produces the text of the
+ /etc/passwd file. This is normally "cat /etc/passwd", but can be
+ "ypcat passwd" when NIS is used.
+
+patchlevel (patchlevel.U):
+ The patchlevel level of this package.
+ The value of patchlevel comes from the patchlevel.h file.
+
path_sep (Unix.U):
- This variable defines the character used to separate elements in
- the shell's PATH environment variable. On Unix, it is ':'.
- This is probably identical to Head.U's p_ variable and can
- probably be dropped.
+ This is an old synonym for p_ in Head.U, the character
+ used to separate elements in the command shell search PATH.
+
+perl (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the perl program. After Configure runs,
+ the value is reset to a plain "perl" and is not useful.
perladmin (perladmin.U):
Electronic mail address of the perl5 administrator.
@@ -1229,6 +2179,34 @@ perlpath (perlpath.U):
which contains the name of the perl interpreter to be used in
shell scripts and in the "eval 'exec'" idiom.
+pg (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the pg program. After Configure runs,
+ the value is reset to a plain "pg" and is not useful.
+
+phostname (myhostname.U):
+ This variable contains the eventual value of the PHOSTNAME symbol,
+ which is a command that can be fed to popen() to get the host name.
+ The program should probably not presume that the domain is or isn't
+ there already.
+
+pidtype (pidtype.U):
+ This variable defines PIDTYPE to be something like pid_t, int,
+ ushort, or whatever type is used to declare process ids in the kernel.
+
+plibpth (libpth.U):
+ Holds the private path used by Configure to find out the libraries.
+ Its value is prepend to libpth. This variable takes care of special
+ machines, like the mips. Usually, it should be empty.
+
+pmake (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+pr (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
prefix (prefix.U):
This variable holds the name of the directory below which the
user will install the package. Usually, this is /usr/local, and
@@ -1236,6 +2214,10 @@ prefix (prefix.U):
man pages in /usr/local/man, etc. It is only used to set defaults
for things in bin.U, mansrc.U, privlib.U, or scriptdir.U.
+prefixexp (prefix.U):
+ This variable holds the full absolute path of the directory below
+ which the user will install the package. Derived from prefix.
+
privlib (privlib.U):
This variable contains the eventual value of the PRIVLIB symbol,
which is the name of the private library for this package. It may
@@ -1250,6 +2232,10 @@ prototype (prototype.U):
This variable holds the eventual value of CAN_PROTOTYPE, which
indicates the C compiler can handle funciton prototypes.
+ptrsize (ptrsize.U):
+ This variable contains the value of the PTRSIZE symbol, which
+ indicates to the C program how many bytes there are in a pointer.
+
randbits (randbits.U):
This variable contains the eventual value of the RANDBITS symbol,
which indicates to the C program how many bits of random number
@@ -1266,6 +2252,20 @@ rd_nodata (nblock_io.U):
used, which is a shame because you cannot make the difference between
no data and an EOF.. Sigh!
+rm (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the rm program. After Configure runs,
+ the value is reset to a plain "rm" and is not useful.
+
+rmail (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+runnm (usenm.U):
+ This variable contains 'true' or 'false' depending whether the
+ nm extraction should be performed or not, according to the value
+ of usenm and the flags on the Configure command line.
+
scriptdir (scriptdir.U):
This variable holds the name of the directory in which the user wants
to put publicly scripts for the package in question. It is either
@@ -1273,30 +2273,58 @@ scriptdir (scriptdir.U):
mounted across different architectures, like /usr/share. Programs
must be prepared to deal with ~name expansion.
+scriptdirexp (scriptdir.U):
+ This variable is the same as scriptdir, but is filename expanded
+ at configuration time, for programs not wanting to bother with it.
+
+sed (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the sed program. After Configure runs,
+ the value is reset to a plain "sed" and is not useful.
+
+selectminbits (selectminbits.U):
+ This variable holds the minimum number of bits operated by select.
+ That is, if you do select(n, ...), how many bits at least will be
+ cleared in the masks if some activity is detected. Usually this
+ is either n or 32*ceil(n/32), especially many little-endians do
+ the latter. This is only useful if you have select(), naturally.
+
selecttype (selecttype.U):
This variable holds the type used for the 2nd, 3rd, and 4th
arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET
is defined, and 'int *' otherwise. This is only useful if you
have select(), naturally.
+sendmail (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the sendmail program. After Configure runs,
+ the value is reset to a plain "sendmail" and is not useful.
+
sh (sh.U):
This variable contains the full pathname of the shell used
on this system to execute Bourne shell scripts. Usually, this will be
/bin/sh, though it's possible that some systems will have /bin/ksh,
/bin/pdksh, /bin/ash, /bin/bash, or even something such as
D:/bin/sh.exe.
- This unit comes before Options.U, so you can't set sh with a -D
+ This unit comes before Options.U, so you can't set sh with a '-D'
option, though you can override this (and startsh)
- with -O -Dsh=/bin/whatever -Dstartsh=whatever
+ with '-O -Dsh=/bin/whatever -Dstartsh=whatever'
+
+shar (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+sharpbang (spitshell.U):
+ This variable contains the string #! if this system supports that
+ construct.
shmattype (d_shmat.U):
This symbol contains the type of pointer returned by shmat().
It can be 'void *' or 'char *'.
shortsize (intsize.U):
- This variable contains the value of the SHORTSIZE symbol,
- which indicates to the C program how many bytes there are
- in a short integer.
+ This variable contains the value of the SHORTSIZE symbol which
+ indicates to the C program how many bytes there are in a short.
shrpenv (libperl.U):
If the user builds a shared libperl.so, then we need to tell the
@@ -1314,14 +2342,34 @@ shrpenv (libperl.U):
as -R $archlibexp/CORE (Solaris, NetBSD) or -Wl,-rpath
$archlibexp/CORE (Linux).
+shsharp (spitshell.U):
+ This variable tells further Configure units whether your sh can
+ handle # comments.
+
sig_name (sig_name.U):
This variable holds the signal names, space separated. The leading
- SIG in signals name is removed. See sig_num.
+ SIG in signal name is removed. A ZERO is prepended to the
+ list. This is currently not used.
+
+sig_name_init (sig_name.U):
+ This variable holds the signal names, enclosed in double quotes and
+ separated by commas, suitable for use in the SIG_NAME definition
+ below. A "ZERO" is prepended to the list, and the list is
+ terminated with a plain 0. The leading SIG in signal names
+ is removed. See sig_num.
sig_num (sig_name.U):
- This variable holds the signal numbers, space separated. Those numbers
- correspond to the value of the signal listed in the same place within
- the sig_name list.
+ This variable holds the signal numbers, comma separated. A 0 is
+ prepended to the list (corresponding to the fake SIGZERO), and
+ the list is terminated with a 0. Those numbers correspond to
+ the value of the signal listed in the same place within the
+ sig_name list.
+
+sig_num_init (sig_name.U):
+ This variable holds the signal numbers, enclosed in double quotes and
+ separated by commas, suitable for use in the SIG_NUM definition
+ below. A "ZERO" is prepended to the list, and the list is
+ terminated with a plain 0.
signal_t (d_voidsig.U):
This variable holds the type of the signal handler (void or int).
@@ -1351,14 +2399,42 @@ sizetype (sizetype.U):
unsigned long, or whatever type is used to declare length
parameters for string functions.
+sleep (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+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'.
+
+sockethdr (d_socket.U):
+ This variable has any cpp '-I' flags needed for socket support.
+
+socketlib (d_socket.U):
+ This variable has the names of any libraries needed for socket support.
+
+sort (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the sort program. After Configure runs,
+ the value is reset to a plain "sort" and is not useful.
+
+spackage (package.U):
+ This variable contains the name of the package being constructed,
+ with the first letter uppercased, i.e. suitable for starting
+ sentences.
+
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.
+ 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
@@ -1366,6 +2442,11 @@ split (models.U):
machines that support separation of instruction and data space. It is
up to the Makefile to use this.
+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.
+
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
@@ -1377,7 +2458,7 @@ startperl (startperl.U):
script to make sure (hopefully) that it runs with perl and not some
shell. Of course, that leading line must be followed by the classical
perl idiom:
- eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
+ eval 'exec perl -S $0 ${1+"$@"}'
if $running_under_some_shell;
to guarantee perl startup should the shell execute the script. Note
that this magic incatation is not understood by csh.
@@ -1388,33 +2469,206 @@ startsh (startsh.U):
other shell.
static_ext (Extensions.U):
- This variable holds a list of extension files we want to
+ This variable holds a list of XS extension files we want to
link statically into the package. It is used by Makefile.
stdchar (stdchar.U):
This variable conditionally defines STDCHAR to be the type of char
used in stdio.h. It has the values "unsigned char" or "char".
+stdio_base (d_stdstdio.U):
+ This variable defines how, given a FILE pointer, fp, to access the
+ _base field (or equivalent) of stdio.h's FILE structure. This will
+ be used to define the macro FILE_base(fp).
+
+stdio_bufsiz (d_stdstdio.U):
+ This variable defines how, given a FILE pointer, fp, to determine
+ the number of bytes store in the I/O buffer pointer to by the
+ _base field (or equivalent) of stdio.h's FILE structure. This will
+ be used to define the macro FILE_bufsiz(fp).
+
+stdio_cnt (d_stdstdio.U):
+ This variable defines how, given a FILE pointer, fp, to access the
+ _cnt field (or equivalent) of stdio.h's FILE structure. This will
+ be used to define the macro FILE_cnt(fp).
+
+stdio_filbuf (d_stdstdio.U):
+ This variable defines how, given a FILE pointer, fp, to tell
+ stdio to refill it's internal buffers (?). This will
+ be used to define the macro FILE_filbuf(fp).
+
+stdio_ptr (d_stdstdio.U):
+ This variable defines how, given a FILE pointer, fp, to access the
+ _ptr field (or equivalent) of stdio.h's FILE structure. This will
+ be used to define the macro FILE_ptr(fp).
+
+strings (i_string.U):
+ This variable holds the full path of the string header that will be
+ used. Typically /usr/include/string.h or /usr/include/strings.h.
+
+submit (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+subversion (patchlevel.U):
+ The subversion level of this package.
+ The value of subversion comes from the patchlevel.h file.
+ This is unique to perl.
+
+sysman (sysman.U):
+ This variable holds the place where the manual is located on this
+ system. It is not the place where the user wants to put his manual
+ pages. Rather it is the place where Configure may look to find manual
+ for unix commands (section 1 of the manual usually). See mansrc.
+
+tail (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+tar (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+tbl (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+tee (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the tee program. After Configure runs,
+ the value is reset to a plain "tee" and is not useful.
+
+test (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the test program. After Configure runs,
+ the value is reset to a plain "test" and is not useful.
+
+timeincl (i_time.U):
+ This variable holds the full path of the included time header(s).
+
timetype (d_time.U):
This variable holds the type returned by time(). It can be long,
or time_t on BSD sites (in which case <sys/types.h> should be
included). Anyway, the type Time_t should be used.
+touch (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the touch program. After Configure runs,
+ the value is reset to a plain "touch" and is not useful.
+
+tr (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the tr program. After Configure runs,
+ the value is reset to a plain "tr" and is not useful.
+
+trnl (trnl.U):
+ This variable contains the value to be passed to the tr(1)
+ command to transliterate a newline. Typical values are
+ '\012' and '\n'. This is needed for EBCDIC systems where
+ newline is not necessarily '\012'.
+
+troff (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
uidtype (uidtype.U):
This variable defines Uid_t to be something like uid_t, int,
ushort, or whatever type is used to declare user ids in the kernel.
+uname (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the uname program. After Configure runs,
+ the value is reset to a plain "uname" and is not useful.
+
+uniq (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the uniq program. After Configure runs,
+ the value is reset to a plain "uniq" and is not useful.
+
+usedl (dlsrc.U):
+ This variable indicates if the the system supports dynamic
+ loading of some sort. See also dlsrc and dlobj.
+
+usemymalloc (mallocsrc.U):
+ This variable contains y if the malloc that comes with this package
+ is desired over the system's version of malloc. People often include
+ special versions of malloc for effiency, but such versions are often
+ less portable. See also mallocsrc and mallocobj.
+ If this is 'y', then -lmalloc is removed from $libs.
+
+usenm (usenm.U):
+ This variable contains 'true' or 'false' depending whether the
+ nm extraction is wanted or not.
+
+useopcode (Extensions.U):
+ This variable holds either 'true' or 'false' to indicate
+ whether the Opcode extension should be used. The sole
+ use for this currently is to allow an easy mechanism
+ for users to skip the Opcode extension from the Configure
+ command line.
+
useperlio (useperlio.U):
This variable conditionally defines the USE_PERLIO symbol,
and indicates that the PerlIO abstraction should be
used throughout.
+useposix (Extensions.U):
+ This variable holds either 'true' or 'false' to indicate
+ whether the POSIX extension should be used. The sole
+ use for this currently is to allow an easy mechanism
+ for hints files to indicate that POSIX will not compile
+ on a particular system.
+
+usesfio (d_sfio.U):
+ This variable is set to true when the user agrees to use sfio.
+ It is set to false when sfio is not available or when the user
+ explicitely requests not to use sfio. It is here primarily so
+ that command-line settings can override the auto-detection of
+ d_sfio without running into a "WHOA THERE".
+
useshrplib (libperl.U):
This variable is set to 'yes' if the user wishes
to build a shared libperl, and 'no' otherwise.
+usethreads (usethreads.U):
+ This variable conditionally defines the USE_THREADS symbol,
+ and indicates that Perl should be built to use threads.
+
+usevfork (d_vfork.U):
+ This variable is set to true when the user accepts to use vfork.
+ It is set to false when no vfork is available or when the user
+ explicitely requests not to use vfork.
+
+usrinc (usrinc.U):
+ This variable holds the path of the include files, which is
+ usually /usr/include. It is mainly used by other Configure units.
+
+uuname (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+version (patchlevel.U):
+ The full version number of this package. This combines
+ baserev, patchlevel, and subversion to get the full
+ version number, including any possible subversions. Care
+ is taken to use the C locale in order to get something
+ like 5.004 instead of 5,004. This is unique to perl.
+
+vi (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
voidflags (voidflags.U):
This variable contains the eventual value of the VOIDFLAGS symbol,
which indicates how much support of the void type is given by this
compiler. See VOIDFLAGS for more info.
+zcat (Loc.U):
+ This variable is defined but not used by Configure.
+ The value is a plain '' and is not useful.
+
+zip (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the zip program. After Configure runs,
+ the value is reset to a plain "zip" and is not useful.
+
diff --git a/gnu/usr.bin/perl/Porting/makerel b/gnu/usr.bin/perl/Porting/makerel
index f719a5e9361..f2e1f9750b2 100644
--- a/gnu/usr.bin/perl/Porting/makerel
+++ b/gnu/usr.bin/perl/Porting/makerel
@@ -17,20 +17,35 @@ $relroot = ".."; # XXX make an option
die "Must be in root of the perl source tree.\n"
unless -f "./MANIFEST" and -f "patchlevel.h";
-$patchlevel_h = `grep '#define ' patchlevel.h`;
+open PATCHLEVEL,"<patchlevel.h" or die;
+my @patchlevel_h = <PATCHLEVEL>;
+close PATCHLEVEL;
+my $patchlevel_h = join "", grep { /^#define/ } @patchlevel_h;
print $patchlevel_h;
$patchlevel = $1 if $patchlevel_h =~ /PATCHLEVEL\s+(\d+)/;
$subversion = $1 if $patchlevel_h =~ /SUBVERSION\s+(\d+)/;
-die "Unable to parse patchlevel.h" unless $subversion > 0;
+die "Unable to parse patchlevel.h" unless $subversion >= 0;
$vers = sprintf("5.%03d", $patchlevel);
-$vers.= sprintf( "_%02d", $subversion) if $subversion;
+$vms_vers = sprintf("5_%03d", $patchlevel);
+if ($subversion) {
+ $vers.= sprintf( "_%02d", $subversion);
+ $vms_vers.= sprintf( "%02d", $subversion);
+} else {
+ $vms_vers.= " ";
+}
-$perl = "perl$vers";
-$reldir = "$relroot/$perl";
-$reldir .= "-$ARGV[0]" if $ARGV[0];
+# fetch list of local patches
+my (@local_patches, @lpatch_tags, $lpatch_tags);
+@local_patches = grep { /^static.*local_patches/../^};/ } @patchlevel_h;
+@local_patches = grep { !/^\s*,?NULL/ } @local_patches;
+@lpatch_tags = map { /^\s*,"(\w+)/ } @local_patches;
+$lpatch_tags = join "-", @lpatch_tags;
-print "\nMaking a release for $perl in $reldir\n\n";
+$perl = "perl$vers";
+$reldir = "$perl";
+$reldir .= "-$lpatch_tags" if $lpatch_tags;
+print "\nMaking a release for $perl in $relroot/$reldir\n\n";
print "Cross-checking the MANIFEST...\n";
($missfile, $missentry) = fullcheck();
@@ -46,16 +61,34 @@ if ("@$missentry" =~ m/\.orig\b/) {
die "Aborted.\n" if @$missentry or @$missfile;
print "\n";
+# VMS no longer has hardcoded version numbers descrip.mms
+#print "Updating VMS version specific files with $vms_vers...\n";
+#system("perl -pi -e 's/^\QPERL_VERSION = \E\d\_\d+(\s*\#)/PERL_VERSION = $vms_vers$1/' vms/descrip.mms");
+
+
+
+print "Creating $relroot/$reldir release directory...\n";
+die "$relroot/$reldir release directory already exists\n" if -e "$relroot/$reldir";
+die "$relroot/$reldir.tar.gz release file already exists\n" if -e "$relroot/$reldir.tar.gz";
+mkdir("$relroot/$reldir", 0755) or die "mkdir $relroot/$reldir: $!\n";
+print "\n";
+
+
+print "Copying files to release directory...\n";
+# ExtUtils::Manifest maniread does not preserve the order
+$cmd = "awk '{print \$1}' MANIFEST | cpio -pdm $relroot/$reldir";
+system($cmd) == 0 or die "$cmd failed";
+print "\n";
+
+chdir "$relroot/$reldir" or die $!;
print "Setting file permissions...\n";
system("find . -type f -print | xargs chmod -w");
system("find . -type d -print | xargs chmod g-s");
system("find t -name '*.t' -print | xargs chmod +x");
-system("chmod +w configure"); # special case (see pumpkin.pod)
-@exe = qw(
+my @exe = qw(
Configure
configpm
- configure
embed.pl
installperl
installman
@@ -68,32 +101,28 @@ system("chmod +w configure"); # special case (see pumpkin.pod)
*.SH
vms/ext/Stdio/test.pl
vms/ext/filespec.t
- vms/fndvers.com
x2p/*.SH
Porting/patchls
Porting/makerel
);
system("chmod +x @exe");
-print "\n";
-
-
-print "Creating $reldir release directory...\n";
-die "$reldir release directory already exists\n" if -e "../$perl";
-die "$reldir.tar.gz release file already exists\n" if -e "../$reldir.tar.gz";
-mkdir($reldir, 0755) or die "mkdir $reldir: $!\n";
-print "\n";
-
-print "Copying files to release directory...\n";
-# ExtUtils::Manifest maniread does not preserve the order
-$cmd = "awk '{print \$1}' MANIFEST | cpio -pdm $reldir";
-system($cmd) == 0 or die "$cmd failed";
+print "Adding CRs to DOSish files...\n";
+my @crlf = qw(
+ djgpp/configure.bat
+ README.dos
+ README.win32
+ win32/Makefile
+ win32/makefile.mk
+);
+system("perl -pi -e 's/\$/\\r/' @crlf");
print "\n";
-chdir $relroot or die $!;
+chdir ".." or die $!;
print "Creating and compressing the tar file...\n";
-$cmd = "tar cf - $perl | gzip --best > $perl.tar.gz";
+my $src = (-e $perl) ? $perl : 'perl'; # 'perl' in maint branch
+$cmd = "tar cf - $reldir | gzip --best > $reldir.tar.gz";
system($cmd) == 0 or die "$cmd failed";
print "\n";
diff --git a/gnu/usr.bin/perl/Porting/patchls b/gnu/usr.bin/perl/Porting/patchls
index 1d4bd5ac400..38c4dd1f473 100644
--- a/gnu/usr.bin/perl/Porting/patchls
+++ b/gnu/usr.bin/perl/Porting/patchls
@@ -17,10 +17,10 @@ use Text::Tabs qw(expand unexpand);
use strict;
use vars qw($VERSION);
-$VERSION = 2.04;
+$VERSION = 2.08;
sub usage {
-die q{
+die qq{
patchls [options] patchfile [ ... ]
-h no filename headers (like grep), only the listing.
@@ -30,13 +30,20 @@ die q{
-m print formatted Meta-information (Subject,From,Msg-ID etc).
-p N strip N levels of directory Prefix (like patch), else automatic.
-v more verbose (-d for noisy debugging).
+ -n give a count of the number of patches applied to a file if >1.
-f F only list patches which patch files matching regexp F
- (F has $ appended unless it contains a /).
+ (F has \$ appended unless it contains a /).
+ -e Expect patched files to Exist (relative to current directory)
+ Will print warnings for files which don't. Also affects -4 option.
other options for special uses:
-I just gather and display summary Information about the patches.
-4 write to stdout the PerForce commands to prepare for patching.
+ -5 like -4 but add "|| exit 1" after each command
-M T Like -m but only output listed meta tags (eg -M 'Title From')
-W N set wrap width to N (defaults to 70, use 0 for no wrap)
+ -X list patchfiles that may clash (i.e. patch the same file)
+
+ patchls version $VERSION by Tim Bunce
}
}
@@ -44,40 +51,75 @@ $::opt_p = undef; # undef != 0
$::opt_d = 0;
$::opt_v = 0;
$::opt_m = 0;
+$::opt_n = 0;
$::opt_i = 0;
$::opt_h = 0;
$::opt_l = 0;
$::opt_c = 0;
$::opt_f = '';
+$::opt_e = 0;
# special purpose options
$::opt_I = 0;
$::opt_4 = 0; # output PerForce commands to prepare for patching
+$::opt_5 = 0;
$::opt_M = ''; # like -m but only output these meta items (-M Title)
$::opt_W = 70; # set wrap width columns (see Text::Wrap module)
+$::opt_C = 0; # 'Chip' mode (handle from/tags/article/bug files) undocumented
+$::opt_X = 0; # list patchfiles that patch the same file
usage unless @ARGV;
-getopts("mihlvc4p:f:IM:W:") or usage;
+getopts("dmnihlvecC45Xp:f:IM:W:") or usage;
$columns = $::opt_W || 9999999;
$::opt_m = 1 if $::opt_M;
-my @show_meta = split(' ', $::opt_M || 'Title From Msg-ID');
+$::opt_4 = 1 if $::opt_5;
+$::opt_i = 1 if $::opt_X;
+
+# see get_meta_info()
+my @show_meta = split(' ', $::opt_M || 'Title From Msg-ID Files');
+my %show_meta = map { ($_,1) } @show_meta;
my %cat_title = (
'BUILD' => 'BUILD PROCESS',
'CORE' => 'CORE LANGUAGE',
'DOC' => 'DOCUMENTATION',
- 'LIB' => 'LIBRARY AND EXTENSIONS',
+ 'LIB' => 'LIBRARY',
'PORT1' => 'PORTABILITY - WIN32',
'PORT2' => 'PORTABILITY - GENERAL',
'TEST' => 'TESTS',
'UTIL' => 'UTILITIES',
'OTHER' => 'OTHER CHANGES',
+ 'EXT' => 'EXTENSIONS',
+ 'UNKNOWN' => 'UNKNOWN - NO FILES PATCH',
);
-my %ls;
+
+sub get_meta_info {
+ my $ls = shift;
+ local($_) = shift;
+ if (/^From:\s+(.*\S)/i) {;
+ my $from = $1; # temporary measure for Chip Salzenberg
+ $from =~ s/chip\@(atlantic\.net|perlsupport\.com)/chip\@pobox.com/;
+ $from =~ s/\(Tim Bunce\) \(Tim Bunce\)/(Tim Bunce)/;
+ $ls->{From}{$from} = 1
+ }
+ if (/^Subject:\s+(?:Re: )?(.*\S)/i) {
+ my $title = $1;
+ $title =~ s/\[(PATCH|PERL)[\w\. ]*\]:?//g;
+ $title =~ s/\b(PATCH|PERL)[\w\.]*://g;
+ $title =~ s/\bRe:\s+/ /g;
+ $title =~ s/\s+/ /g;
+ $title =~ s/^\s*(.*?)\s*$/$1/g;
+ $ls->{Title}{$title} = 1;
+ }
+ $ls->{'Msg-ID'}{$1}=1 if /^Message-Id:\s+(.*\S)/i;
+ $ls->{Date}{$1}=1 if /^Date:\s+(.*\S)/i;
+ $ls->{$1}{$2}=1 if $::opt_M && /^([-\w]+):\s+(.*\S)/;
+}
+
# Style 1:
# *** perl-5.004/embed.h Sat May 10 03:39:32 1997
@@ -97,10 +139,16 @@ my %ls;
# Variation:
# Index: embed.h
-my($in, $prevline, $prevtype, $ls);
-my(@removed, @added);
+my %ls;
+
+my $in;
+my $ls;
+my $prevline = '';
+my $prevtype = '';
+my (@removed, @added);
my $prologue = 1; # assume prologue till patch or /^exit\b/ seen
+
foreach my $argv (@ARGV) {
$in = $argv;
unless (open F, "<$in") {
@@ -119,25 +167,24 @@ foreach my $argv (@ARGV) {
push @removed, $1 if /^rm\s+(?:-f)?\s*(\S+)/;
$prologue = 0 if /^exit\b/;
}
- next unless $::opt_m;
- $ls->{From}{$1}=1,next if /^From:\s+(.*\S)/i;
- $ls->{Title}{$1}=1,next if /^Subject:\s+(?:Re: )?(.*\S)/i;
- $ls->{'Msg-ID'}{$1}=1,next if /^Message-Id:\s+(.*\S)/i;
- $ls->{Date}{$1}=1,next if /^Date:\s+(.*\S)/i;
- $ls->{$1}{$2}=1,next if /^([-\w]+):\s+(.*\S)/;
+ get_meta_info($ls, $_) if $::opt_m;
next;
}
$type = $1;
next if /^--- [0-9,]+ ----$/ || /^\*\*\* [0-9,]+ \*\*\*\*$/;
$prologue = 0;
- print "Last: $prevline","This: ${_}Got: $1\n\n" if $::opt_d;
+ print "Last: $prevline","This: ${_}Got: $type\n\n" if $::opt_d;
# Some patches have Index lines but not diff headers
# Patch copes with this, so must we. It's also handy for
# documenting manual changes by simply adding Index: lines
- # to the file which describes the problem bing fixed.
- add_file($ls, $1), next if /^Index:\s+(\S+)/;
+ # to the file which describes the problem being fixed.
+ if (/^Index:\s+(.*)/) {
+ my $f;
+ foreach $f (split(/ /, $1)) { add_file($ls, $f) }
+ next;
+ }
if ( ($type eq '---' and $prevtype eq '***') # Style 1
or ($type eq '+++' and $prevtype eq '---') # Style 2
@@ -152,9 +199,32 @@ foreach my $argv (@ARGV) {
}
continue {
$prevline = $_;
- $prevtype = $type;
+ $prevtype = $type || '';
$type = '';
}
+
+ # special mode for patch sets from Chip
+ if ($in =~ m:[\\/]patch$:) {
+ my $is_chip;
+ my $chip;
+ my $dir; ($dir = $in) =~ s:[\\/]patch$::;
+ if (!$ls->{From} && (open(CHIP,"$dir/article") || open(CHIP,"$dir/bug"))) {
+ get_meta_info($ls, $_) while (<CHIP>);
+ $is_chip = 1;
+ }
+ if (open CHIP,"<$dir/from") {
+ chop($chip = <CHIP>);
+ $ls->{From} = { $chip => 1 };
+ $is_chip = 1;
+ }
+ if (open CHIP,"<$dir/tag") {
+ chop($chip = <CHIP>);
+ $ls->{Title} = { $chip => 1 };
+ $is_chip = 1;
+ }
+ $ls->{From} = { "Chip Salzenberg" => 1 } if $is_chip && !$ls->{From};
+ }
+
# if we don't have a title for -m then use the file name
$ls->{Title}{$in}=1 if $::opt_m
and !$ls->{Title} and $ls->{out};
@@ -170,13 +240,15 @@ print scalar(@ARGV)." files read.\n" if $::opt_v and @ARGV > 1;
my @ls = values %ls;
if ($::opt_f) { # filter out patches based on -f <regexp>
- my $out;
$::opt_f .= '$' unless $::opt_f =~ m:/:;
@ls = grep {
- my @out = keys %{$_->{out}};
my $match = 0;
- for $out (@out) {
- ++$match if $out =~ m/$::opt_f/o;
+ if ($_->{is_in}) {
+ my @out = keys %{ $_->{out} };
+ $match=1 if grep { m/$::opt_f/o } @out;
+ }
+ else {
+ $match=1 if $_->{in} =~ m/$::opt_f/o;
}
$match;
} @ls;
@@ -190,35 +262,54 @@ if ($::opt_f) { # filter out patches based on -f <regexp>
# --- Handle special modes ---
if ($::opt_4) {
- print map { "p4 delete $_\n" } @removed if @removed;
- print map { "p4 add $_\n" } @added if @added;
- my @patches = grep { $_->{is_in} } @ls;
+ my $tail = ($::opt_5) ? "|| exit 1" : "";
+ print map { "p4 delete $_$tail\n" } @removed if @removed;
+ print map { "p4 add $_$tail\n" } @added if @added;
+ my @patches = sort grep { $_->{is_in} } @ls;
+ my @no_outs = grep { keys %{$_->{out}} == 0 } @patches;
+ warn "Warning: Some files contain no patches:",
+ join("\n\t", '', map { $_->{in} } @no_outs), "\n" if @no_outs;
my %patched = map { ($_, 1) } map { keys %{$_->{out}} } @patches;
delete @patched{@added};
my @patched = sort keys %patched;
- print map { "p4 edit $_\n" } @patched if @patched;
- exit 0;
+ foreach(@patched) {
+ my $edit = ($::opt_e && !-f $_) ? "add " : "edit";
+ print "p4 $edit $_$tail\n";
+ }
+ exit 0 unless $::opt_C;
}
+
if ($::opt_I) {
my $n_patches = 0;
my($in,$out);
my %all_out;
+ my @no_outs;
foreach $in (@ls) {
next unless $in->{is_in};
++$n_patches;
my @outs = keys %{$in->{out}};
+ push @no_outs, $in unless @outs;
@all_out{@outs} = ($in->{in}) x @outs;
}
my @all_out = sort keys %all_out;
my @missing = grep { ! -f $_ } @all_out;
print "$n_patches patch files patch ".@all_out." files (".@missing." missing)\n";
+ print @no_outs." patch files don't contain patches.\n" if @no_outs;
print "(use -v to list patches which patch 'missing' files)\n"
- if @missing && !$::opt_v;
+ if (@missing || @no_outs) && !$::opt_v;
+ if ($::opt_v and @no_outs) {
+ print "Patch files which don't contain patches:\n";
+ foreach $out (@no_outs) {
+ printf " %-20s\n", $out->{in};
+ }
+ }
if ($::opt_v and @missing) {
print "Missing files:\n";
foreach $out (@missing) {
- printf " %-20s\t%s\n", $out, $all_out{$out};
+ printf " %-20s\t", $out unless $::opt_h;
+ print $all_out{$out} unless $::opt_l;
+ print "\n";
}
}
print "Added files: @added\n" if @added;
@@ -229,6 +320,7 @@ if ($::opt_I) {
unless ($::opt_c and $::opt_m) {
foreach $ls (@ls) {
next unless ($::opt_i) ? $ls->{is_out} : $ls->{is_in};
+ next if $::opt_X and keys %{$ls->{out}} <= 1;
list_files_by_patch($ls);
}
}
@@ -263,10 +355,13 @@ exit 0;
sub add_file {
my $ls = shift;
+ print "add_file '$_[0]'\n" if $::opt_d;
my $out = trim_name(shift);
$ls->{out}->{$out} = 1;
+ warn "$out patched but not present\n" if $::opt_e && !-f $out;
+
# do the -i inverse as well, even if we're not doing -i
my $i = $ls{$out} ||= {
is_out => 1,
@@ -308,7 +403,8 @@ sub list_files_by_patch {
my @list = sort keys %{$ls->{$meta}};
push @meta, sprintf "%7s: ", $meta;
if ($meta eq 'Title') {
- @list = map { s/\[?PATCH\]?:?\s*//g; "\"$_\""; } @list
+ @list = map { "\"$_\""; } @list;
+ push @list, "#$1" if $::opt_C && $ls->{in} =~ m:\b(\w\d+)/patch$:;
}
elsif ($meta eq 'From') {
# fix-up bizzare addresses from japan and ibm :-)
@@ -328,17 +424,27 @@ sub list_files_by_patch {
$name = "\n$name" if @meta and $name;
}
# don't print the header unless the file contains something interesting
- return if !@meta and !$ls->{out};
- print("$ls->{in}\n"),return if $::opt_l; # -l = no listing
+ return if !@meta and !$ls->{out} and !$::opt_v;
+ if ($::opt_l) { # -l = no listing, just names
+ print "$ls->{in}";
+ my $n = keys %{ $ls->{out} };
+ print " ($n patches)" if $::opt_n and $n>1;
+ print "\n";
+ return;
+ }
# a twisty maze of little options
my $cat = ($ls->{category} and !$::opt_m) ? "\t$ls->{category}" : "";
print "$name$cat: " unless ($::opt_h and !$::opt_v) or !"$name$cat";
print join('',"\n",@meta) if @meta;
+ return if $::opt_m && !$show_meta{Files};
my @v = sort PATORDER keys %{ $ls->{out} };
- my $v = "@v\n";
+ my $n = @v;
+ my $v = "@v";
print $::opt_m ? " Files: ".my_wrap(""," ",$v) : $v;
+ print " ($n patches)" if $::opt_n and $n>1;
+ print "\n";
}
@@ -364,8 +470,10 @@ sub categorize_files {
if m:^(cygwin32|os2|plan9|qnx|vms)/:
or m:^(hints|Porting|ext/DynaLoader)/:
or m:^README\.:;
+ $c{EXT} += 10,next
+ if m:^(ext|lib/ExtUtils)/:;
$c{LIB} += 10,next
- if m:^(lib|ext)/:;
+ if m:^(lib)/:;
$c{'CORE'} += 15,next
if m:^[^/]+[\._]([chH]|sym|pl)$:;
$c{BUILD} += 10,next
@@ -391,7 +499,7 @@ sub categorize_files {
}
else {
my($c, $v) = %c;
- $c ||= 'OTHER'; $v ||= 0;
+ $c ||= 'UNKNOWN'; $v ||= 0;
print " ".@$files." patches: $c: $v\n" if $verb;
return $c;
}
diff --git a/gnu/usr.bin/perl/Porting/pumpkin.pod b/gnu/usr.bin/perl/Porting/pumpkin.pod
index 6706c6c3c42..335e49f2733 100644
--- a/gnu/usr.bin/perl/Porting/pumpkin.pod
+++ b/gnu/usr.bin/perl/Porting/pumpkin.pod
@@ -113,6 +113,8 @@ patch' entry in patchlevel.h.
Watch for announcements of maintenance subversions in
comp.lang.perl.announce.
+The first rule of maintenance work is "First, do no harm."
+
=head2 Why such a complicated scheme?
Two reasons, really. At least.
@@ -217,9 +219,16 @@ patch these directly; patch the data files instead.
F<Configure> and F<config_h.SH> are also automatically generated by
B<metaconfig>. In general, you should patch the metaconfig units
-instead of patching these files directly. However, minor changes to
+instead of patching these files directly. However, very minor changes to
F<Configure> may be made in between major sync-ups with the metaconfig
-units, which tends to be complicated operations.
+units, which tends to be complicated operations. But be careful, this
+can quickly spiral out of control. Running metaconfig is not really
+hard.
+
+Finally, the sample files in the F<Porting/> subdirectory are
+generated automatically by the script F<U/mksample> included
+with the metaconfig units. See L<"run metaconfig"> below for
+information on obtaining the metaconfig units.
=head1 How to Make a Distribution
@@ -273,16 +282,16 @@ change the appropriate metaconfig units instead, and regenerate Configure.
metaconfig -m
-will regenerate Configure and config_h.SH. More information on
-obtaining and running metaconfig is in the F<U/README> file that comes
-with Perl's metaconfig units. Perl's metaconfig units should be
-available the same place you found this file. On CPAN, look under my
-directory F<authors/id/ANDYD/> for a file such as F<5.003_07-02.U.tar.gz>.
-That file should be unpacked in your main perl source directory. It
-contains the files needed to run B<metaconfig> to reproduce Perl's
-Configure script. (Those units are for 5.003_07. There have been
-changes since then; please contact me if you want more recent
-versions, and I will try to point you in the right direction.)
+will regenerate Configure and config_h.SH. Much more information
+on obtaining and running metaconfig is in the F<U/README> file
+that comes with Perl's metaconfig units. Perl's metaconfig units
+should be available on CPAN. A set of units that will work with
+perl5.005 is in the file F<mc_units-5.005_00-01.tar.gz> under
+http://www.perl.com/CPAN/authors/id/ANDYD/ . The mc_units tar file
+should be unpacked in your main perl source directory. Note: those
+units were for use with 5.005. There may have been changes since then.
+Check for later versions or contact perl5-porters@perl.org to obtain a
+pointer to the current version.
Alternatively, do consider if the F<*ish.h> files might be a better
place for your changes.
@@ -297,17 +306,7 @@ program for this. You can also use
Both commands will also list extra files in the directory that are not
listed in MANIFEST.
-The MANIFEST is normally sorted, with one exception. Perl includes
-both a F<Configure> script and a F<configure> script. The
-F<configure> script is a front-end to the main F<Configure>, but
-is there to aid folks who use autoconf-generated F<configure> files
-for other software. The problem is that F<Configure> and F<configure>
-are the same on case-insensitive file systems, so I deliberately put
-F<configure> first in the MANIFEST so that the extraction of
-F<Configure> will overwrite F<configure> and leave you with the
-correct script. (The F<configure> script must also have write
-permission for this to work, so it's the only file in the distribution
-I normally have with write permission.)
+The MANIFEST is normally sorted.
If you are using metaconfig to regenerate Configure, then you should note
that metaconfig actually uses MANIFEST.new, so you want to be sure
@@ -320,14 +319,15 @@ learned how to use the full suite of tools in the dist distribution.
All the tests in the t/ directory ought to be executable. The
main makefile used to do a 'chmod t/*/*.t', but that resulted in
a self-modifying distribution--something some users would strongly
-prefer to avoid. Probably, the F<t/TEST> script should check for this
-and do the chmod if needed, but it doesn't currently.
+prefer to avoid. The F<t/TEST> script will check for this
+and do the chmod if needed, but the tests still ought to be
+executable.
In all, the following files should probably be executable:
Configure
configpm
- configure
+ configure.gnu
embed.pl
installperl
installman
@@ -340,7 +340,6 @@ In all, the following files should probably be executable:
*.SH
vms/ext/Stdio/test.pl
vms/ext/filespec.t
- vms/fndvers.com
x2p/*.SH
Other things ought to be readable, at least :-).
@@ -355,18 +354,43 @@ permissions for system files; something like that might be appropriate.
=head2 Run Configure
This will build a config.sh and config.h. You can skip this if you haven't
-changed Configure or config_h.SH at all.
-
-=head2 Update config_H
-
-The config_H file is provided to help those folks who can't run Configure.
-It is important to keep it up-to-date. If you have changed config_h.SH,
-those changes must be reflected in config_H as well. (The name config_H was
-chosen to 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 vms/config.vms and
+changed Configure or config_h.SH at all. I use the following command
+
+ sh Configure -Dprefix=/opt/perl -Doptimize=-O -Dusethreads \
+ -Dcf_by='yourname' \
+ -Dcf_email='yourname@yourhost.yourplace.com' \
+ -Dperladmin='yourname@yourhost.yourplace.com' \
+ -Dmydomain='.yourplace.com' \
+ -Dmyhostname='yourhost' \
+ -des
+
+=head2 Update Porting/config.sh and Porting/config_H
+
+[XXX
+This section needs revision. We're currently working on easing
+the task of keeping the vms, win32, and plan9 config.sh info
+up-to-date. The plan is to use keep up-to-date 'canned' config.sh
+files in the appropriate subdirectories and then generate 'canned'
+config.h files for vms, win32, etc. from the generic config.sh file.
+This is to ease maintenance. When Configure gets updated, the parts
+sometimes get scrambled around, and the changes in config_H can
+sometimes be very hard to follow. config.sh, on the other hand, can
+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.)
+XXX]
+
+The Porting/config.sh and Porting/config_H files are provided to
+help those folks who can't run Configure. It is important to keep
+them up-to-date. If you have changed config_h.SH, those changes must
+be reflected in config_H as well. (The name config_H was chosen to
+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
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
@@ -389,13 +413,13 @@ task.
Some additional notes from Larry on this:
-Don't forget to regenerate perly.c.diff.
+Don't forget to regenerate perly_c.diff.
byacc -d perly.y
mv y.tab.c perly.c
- patch perly.c <perly.c.diff
+ patch perly.c <perly_c.diff
# manually apply any failed hunks
- diff -c2 perly.c.orig perly.c >perly.c.diff
+ diff -c2 perly.c.orig perly.c >perly_c.diff
One chunk of lines that often fails begins with
@@ -467,6 +491,23 @@ ought to go in the Changes file or whether they ought to be available
separately in the patch file (or both). There is no disagreement that
detailed descriptions ought to be easily available somewhere.
+=head2 Todo
+
+The F<Todo> file contains a roughly-catgorized unordered list of
+aspects of Perl that could use enhancement, features that could be
+added, areas that could be cleaned up, and so on. During your term as
+pumpkin-holder, you will probably address some of these issues, and
+perhaps identify others which, while you decide not to address them
+this time around, may be tackled in the future. Update the file
+reflect the situation as it stands when you hand over the pumpkin.
+
+You might like, early in your pumpkin-holding career, to see if you
+can find champions for partiticular issues on the to-do list: an issue
+owned is an issue more likely to be resolved.
+
+There are also some more porting-specific L<Todo> items later in this
+file.
+
=head2 OS/2-specific updates
In the os2 directory is F<diff.configure>, a set of OS/2-specific
@@ -1030,6 +1071,62 @@ distribution modules. If you do
then perl.c will put /my/override ahead of ARCHLIB and PRIVLIB.
+=head2 Shared libperl.so location
+
+Why isn't the shared libperl.so installed in /usr/lib/ along
+with "all the other" shared libraries? Instead, it is installed
+in $archlib, which is typically something like
+
+ /usr/local/lib/perl5/archname/5.00404
+
+and is architecture- and version-specific.
+
+The basic reason why a shared libperl.so gets put in $archlib is so that
+you can have more than one version of perl on the system at the same time,
+and have each refer to its own libperl.so.
+
+Three examples might help. All of these work now; none would work if you
+put libperl.so in /usr/lib.
+
+=over
+
+=item 1.
+
+Suppose you want to have both threaded and non-threaded perl versions
+around. Configure will name both perl libraries "libperl.so" (so that
+you can link to them with -lperl). The perl binaries tell them apart
+by having looking in the appropriate $archlib directories.
+
+=item 2.
+
+Suppose you have perl5.004_04 installed and you want to try to compile
+it again, perhaps with different options or after applying a patch.
+If you already have libperl.so installed in /usr/lib/, then it may be
+either difficult or impossible to get ld.so to find the new libperl.so
+that you're trying to build. If, instead, libperl.so is tucked away in
+$archlib, then you can always just change $archlib in the current perl
+you're trying to build so that ld.so won't find your old libperl.so.
+(The INSTALL file suggests you do this when building a debugging perl.)
+
+=item 3.
+
+The shared perl library is not a "well-behaved" shared library with
+proper major and minor version numbers, so you can't necessarily
+have perl5.004_04 and perl5.004_05 installed simultaneously. Suppose
+perl5.004_04 were to install /usr/lib/libperl.so.4.4, and perl5.004_05
+were to install /usr/lib/libperl.so.4.5. Now, when you try to run
+perl5.004_04, ld.so might try to load libperl.so.4.5, since it has
+the right "major version" number. If this works at all, it almost
+certainly defeats the reason for keeping perl5.004_04 around. Worse,
+with development subversions, you certaily can't guarantee that
+libperl.so.4.4 and libperl.so.4.55 will be compatible.
+
+Anyway, all this leads to quite obscure failures that are sure to drive
+casual users crazy. Even experienced users will get confused :-). Upon
+reflection, I'd say leave libperl.so in $archlib.
+
+=back
+
=head1 Upload Your Work to CPAN
You can upload your work to CPAN if you have a CPAN id. Check out
@@ -1073,12 +1170,23 @@ described in F<INSTALL>. AFS users also are treated specially.
We should probably duplicate the metaconfig prefix stuff for an
install prefix.
-=item Configure -Dsrcdir=/blah/blah
+=item Configure -Dsrc=/blah/blah
We should be able to emulate B<configure --srcdir>. Tom Tromey
tromey@creche.cygnus.com has submitted some patches to
-the dist-users mailing list along these lines. Eventually, they ought
-to get folded back into the main distribution.
+the dist-users mailing list along these lines. They have been folded
+back into the main distribution, but various parts of the perl
+Configure/build/install process still assume src='.'.
+
+=item Directory for vendor-supplied modules?
+
+If a vendor supplies perl, but wants to leave $siteperl and $sitearch
+for the local user to use, where should the vendor put vendor-supplied
+modules (such as Tk.so?) If the vendor puts them in $archlib, then
+they need to be updated each time the perl version is updated.
+Perhaps we need a set of libries $vendorperl and $vendorarch that
+track $apiversion (like the $sitexxx directories do) rather than
+just $version (like the main perl directory).
=item Hint file fixes
@@ -1090,6 +1198,47 @@ Configure so that most of them aren't needed.
Some of the hint file information (particularly dynamic loading stuff)
ought to be fed back into the main metaconfig distribution.
+=item Catch GNU Libc "Stub" functions
+
+Some functions (such as lchown()) are present in libc, but are
+unimplmented. That is, they always fail and set errno=ENOSYS.
+
+Thomas Bushnell provided the following sample code and the explanation
+that follows:
+
+ /* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char FOO(); below. */
+ #include <assert.h>
+ /* Override any gcc2 internal prototype to avoid an error. */
+ /* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+ char FOO();
+
+ int main() {
+
+ /* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+ #if defined (__stub_FOO) || defined (__stub___FOO)
+ choke me
+ #else
+ FOO();
+ #endif
+
+ ; return 0; }
+
+The choice of <assert.h> is essentially arbitrary. The GNU libc
+macros are found in <gnu/stubs.h>. You can include that file instead
+of <assert.h> (which itself includes <gnu/stubs.h>) if you test for
+its existence first. <assert.h> is assumed to exist on every system,
+which is why it's used here. Any GNU libc header file will include
+the stubs macros. If either __stub_NAME or __stub___NAME is defined,
+then the function doesn't actually exist. Tests using <assert.h> work
+on every system around.
+
+The declaration of FOO is there to override builtin prototypes for
+ANSI C functions.
+
=back
=head2 Probably good ideas waiting for round tuits
@@ -1135,12 +1284,6 @@ Get some of the Macintosh stuff folded back into the main distribution.
Maybe include a replacement function that doesn't lose data in rare
cases of coercion between string and numerical values.
-=item long long
-
-Can we support C<long long> on systems where C<long long> is larger
-than what we've been using for C<IV>? What if you can't C<sprintf>
-a C<long long>?
-
=item Improve makedepend
The current makedepend process is clunky and annoyingly slow, but it
@@ -1177,4 +1320,4 @@ All opinions expressed herein are those of the authorZ<>(s).
=head1 LAST MODIFIED
-$Id: pumpkin.pod,v 1.13 1997/08/28 18:26:40 doughera Released $
+$Id: pumpkin.pod,v 1.22 1998/07/22 16:33:55 doughera Released $
diff --git a/gnu/usr.bin/perl/README b/gnu/usr.bin/perl/README
index 83b9ab578f9..e3ccad49bc0 100644
--- a/gnu/usr.bin/perl/README
+++ b/gnu/usr.bin/perl/README
@@ -1,7 +1,7 @@
Perl Kit, Version 5.0
- Copyright 1989-1997, Larry Wall
+ Copyright 1989-1999, Larry Wall
All rights reserved.
This program is free software; you can redistribute it and/or modify
@@ -22,8 +22,8 @@
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., 675 Mass Ave, Cambridge, MA 02139, USA.
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
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
@@ -76,11 +76,10 @@ or if you have any problems building.)
2) Read the manual entries before running perl.
3) IMPORTANT! Help save the world! Communicate any problems and suggested
-patches to me, larry@wall.org (Larry Wall), 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.
+patches to perlbug@perl.com 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.
If you've succeeded in compiling perl, the perlbug script in the utils/
subdirectory can be used to help mail in a bug report.
diff --git a/gnu/usr.bin/perl/README.os2 b/gnu/usr.bin/perl/README.os2
index 667423c382a..409c7745914 100644
--- a/gnu/usr.bin/perl/README.os2
+++ b/gnu/usr.bin/perl/README.os2
@@ -112,6 +112,7 @@ Contents
- Threading
- Calls to external programs
- Memory allocation
+ - Threads
AUTHOR
SEE ALSO
@@ -305,10 +306,86 @@ sh-syntax shell installed (see L<"Pdksh">,
L<"Frequently asked questions">), and perl should be able to find it
(see L<"PERL_SH_DIR">).
-The only cases when the shell is not used is the multi-argument
-system() (see L<perlfunc/system>)/exec() (see L<perlfunc/exec>), and
-one-argument version thereof without redirection and shell
-meta-characters.
+The cases when the shell is used are:
+
+=over
+
+=item 1
+
+One-argument system() (see L<perlfunc/system>), exec() (see L<perlfunc/exec>)
+with redirection or shell meta-characters;
+
+=item 2
+
+Pipe-open (see L<perlfunc/open>) with the command which contains redirection
+or shell meta-characters;
+
+=item 3
+
+Backticks C<``> (see L<perlop/"I/O Operators">) with the command which contains
+redirection or shell meta-characters;
+
+=item 4
+
+If the executable called by system()/exec()/pipe-open()/C<``> is a script
+with the "magic" C<#!> line or C<extproc> line which specifies shell;
+
+=item 5
+
+If the executable called by system()/exec()/pipe-open()/C<``> is a script
+without "magic" line, and C<$ENV{EXECSHELL}> is set to shell;
+
+=item 6
+
+If the executable called by system()/exec()/pipe-open()/C<``> is not
+found;
+
+=item 7
+
+For globbing (see L<perlfunc/glob>, L<perlop/"I/O Operators">).
+
+=back
+
+For the sake of speed for a common case, in the above algorithms
+backslashes in the command name are not considered as shell metacharacters.
+
+Perl starts scripts which begin with cookies
+C<extproc> or C<#!> directly, without an intervention of shell. Perl uses the
+same algorithm to find the executable as F<pdksh>: if the path
+on C<#!> line does not work, and contains C</>, then the executable
+is searched in F<.> and on C<PATH>. To find arguments for these scripts
+Perl uses a different algorithm than F<pdksh>: up to 3 arguments are
+recognized, and trailing whitespace is stripped.
+
+If a script
+does not contain such a cooky, then to avoid calling F<sh.exe>, Perl uses
+the same algorithm as F<pdksh>: if C<$ENV{EXECSHELL}> is set, the
+script is given as the first argument to this command, if not set, then
+C<$ENV{COMSPEC} /c> is used (or a hardwired guess if C<$ENV{COMSPEC}> is
+not set).
+
+If starting scripts directly, Perl will use exactly the same algorithm as for
+the search of script given by B<-S> command-line option: it will look in
+the current directory, then on components of C<$ENV{PATH}> using the
+following order of appended extensions: no extension, F<.cmd>, F<.btm>,
+F<.bat>, F<.pl>.
+
+Note that Perl will start to look for scripts only if OS/2 cannot start the
+specified application, thus C<system 'blah'> will not look for a script if
+there is an executable file F<blah.exe> I<anywhere> on C<PATH>.
+
+Note also that executable files on OS/2 can have an arbitrary extension,
+but F<.exe> will be automatically appended if no dot is present in the name.
+The workaround as as simple as that: since F<blah.> and F<blah> denote the
+same file, to start an executable residing in file F<n:/bin/blah> (no
+extension) give an argument C<n:/bin/blah.> to system().
+
+The last note is that currently it is not straightforward to start PM
+programs from VIO (=text-mode) Perl process and visa versa. Either ensure
+that shell will be used, as in C<system 'cmd /c epm'>, or start it using
+optional arguments to system() documented in C<OS2::Process> module. This
+is considered a bug and should be fixed soon.
+
=head1 Frequently asked questions
@@ -660,6 +737,9 @@ check use
). You need the latest version of F<pdksh> installed as F<sh.exe>.
+Check that you have B<BSD> libraries and headers installed, and -
+optionally - Berkeley DB headers and libraries, and crypt.
+
Possible locations to get this from are
ftp://hobbes.nmsu.edu/os2/unix/
@@ -745,6 +825,22 @@ compatibility with XFree86-OS/2). Get a corrected one from
ftp://ftp.math.ohio-state.edu/pub/users/ilya/os2/db_mt.zip
+To make C<-p> filetest work, one may also need to apply the following patch
+to EMX headers:
+
+ --- /emx/include/sys/stat.h.orig Thu May 23 13:48:16 1996
+ +++ /emx/include/sys/stat.h Sun Jul 12 14:11:32 1998
+ @@ -53,7 +53,7 @@ struct stat
+ #endif
+
+ #if !defined (S_IFMT)
+ -#define S_IFMT 0160000 /* Mask for file type */
+ +#define S_IFMT 0170000 /* Mask for file type */
+ #define S_IFIFO 0010000 /* Pipe */
+ #define S_IFCHR 0020000 /* Character device */
+ #define S_IFDIR 0040000 /* Directory */
+
+
=head2 Hand-editing
You may look into the file F<./hints/os2.sh> and correct anything
@@ -780,55 +876,73 @@ F<POSIX.c>.
=head2 Testing
+If you haven't yet moved perl.dll onto LIBPATH, do it now (alternatively, if
+you have a previous perl installation you'd rather not disrupt until this one
+is installed, copy perl.dll to the t directory).
+
Now run
make test
-Some tests (4..6) should fail. Some perl invocations should end in a
-segfault (system error C<SYS3175>). To get finer error reports,
+All tests should succeed (with some of them skipped). Note that on one
+of the systems I see intermittent failures of F<io/pipe.t> subtest 9.
+Any help to track what happens with this test is appreciated.
- cd t
- perl harness
+Some tests may generate extra messages similar to
-The report you get may look like
+=over 4
- Failed Test Status Wstat Total Fail Failed List of failed
- ---------------------------------------------------------------
- io/fs.t 26 11 42.31% 2-5, 7-11, 18, 25
- lib/io_pipe.t 3 768 6 ?? % ??
- lib/io_sock.t 3 768 5 ?? % ??
- op/stat.t 56 5 8.93% 3-4, 20, 35, 39
- Failed 4/140 test scripts, 97.14% okay. 27/2937 subtests failed, 99.08% okay.
+=item A lot of C<bad free>
-Note that using `make test' target two more tests may fail: C<op/exec:1>
-because of (mis)feature of pdksh, and C<lib/posix:15>, which checks
-that the buffers are not flushed on C<_exit> (this is a bug in the test
-which assumes that tty output is buffered).
+in database tests related to Berkeley DB. This is a confirmed bug of
+DB. You may disable this warnings, see L<"PERL_BADFREE">.
-I submitted a patch to EMX which makes it possible to fork() with EMX
-dynamic libraries loaded, which makes F<lib/io*> tests pass. This means
-that soon the number of failing tests may decrease yet more.
+There is not much we can do with it (but apparently it does not cause
+any real error with data).
+
+=item Process terminated by SIGTERM/SIGINT
+
+This is a standard message issued by OS/2 applications. *nix
+applications die in silence. It is considered a feature. One can
+easily disable this by appropriate sighandlers.
-However, the test F<lib/io_udp.t> is disabled, since it never terminates, I
-do not know why. Comments/fixes welcome.
+However the test engine bleeds these message to screen in unexpected
+moments. Two messages of this kind I<should> be present during
+testing.
-The reasons for failed tests are:
+=back
-=over 8
+Two F<lib/io_*> tests may generate popups (system error C<SYS3175>),
+but should succeed anyway. This is due to a bug of EMX related to
+fork()ing with dynamically loaded libraries.
-=item F<io/fs.t>
+I submitted a patch to EMX which makes it possible to fork() with EMX
+dynamic libraries loaded, which makes F<lib/io*> tests pass without
+skipping offended tests. This means that soon the number of skipped tests
+may decrease yet more.
+
+To get finer test reports, call
+
+ perl t/harness
-Checks I<file system> operations. Tests:
+The report with F<io/pipe.t> failing may look like this:
-=over 10
+ Failed Test Status Wstat Total Fail Failed List of failed
+ ------------------------------------------------------------
+ io/pipe.t 12 1 8.33% 9
+ 7 tests skipped, plus 56 subtests skipped.
+ Failed 1/195 test scripts, 99.49% okay. 1/6542 subtests failed, 99.98% okay.
+
+The reasons for most important skipped tests are:
-=item 2-5, 7-11
+=over 8
-Check C<link()> and C<inode count> - nonesuch under OS/2.
+=item F<op/fs.t>
=item 18
-Checks C<atime> and C<mtime> of C<stat()> - I could not understand this test.
+Checks C<atime> and C<mtime> of C<stat()> - unfortunately, HPFS
+provides only 2sec time granularity (for compatibility with FAT?).
=item 25
@@ -853,64 +967,24 @@ Checks C<stat()>. Tests:
=over 4
-=item 3
-
-Checks C<inode count> - nonesuch under OS/2.
-
=item 4
-Checks C<mtime> and C<ctime> of C<stat()> - I could not understand this test.
-
-=item 20
-
-Checks C<-x> - determined by the file extension only under OS/2.
-
-=item 35
-
-Needs F</usr/bin>.
-
-=item 39
-
-Checks C<-t> of F</dev/null>. Should not fail!
-
-=back
+Checks C<atime> and C<mtime> of C<stat()> - unfortunately, HPFS
+provides only 2sec time granularity (for compatibility with FAT?).
=back
-In addition to errors, you should get a lot of warnings.
-
-=over 4
-
-=item A lot of `bad free'
-
-in databases related to Berkeley DB. This is a confirmed bug of
-DB. You may disable this warnings, see L<"PERL_BADFREE">.
-
-=item Process terminated by SIGTERM/SIGINT
-
-This is a standard message issued by OS/2 applications. *nix
-applications die in silence. It is considered a feature. One can
-easily disable this by appropriate sighandlers.
-
-However the test engine bleeds these message to screen in unexpected
-moments. Two messages of this kind I<should> be present during
-testing.
+=item F<lib/io_udp.t>
-=item F<*/sh.exe>: ln: not found
-
-=item C<ls>: /dev: No such file or directory
-
-The last two should be self-explanatory. The test suite discovers that
-the system it runs on is not I<that much> *nixish.
+It never terminates, apparently some bug in storing the last socket from
+which we obtained a message.
=back
-A lot of `bad free'... in databases, bug in DB confirmed on other
-platforms. You may disable it by setting PERL_BADFREE environment variable
-to 1.
-
=head2 Installing the built perl
+If you haven't yet moved perl.dll onto LIBPATH, do it now.
+
Run
make install
@@ -969,9 +1043,9 @@ You have a very old pdksh. See L<Prerequisites>.
You do not have MT-safe F<db.lib>. See L<Prerequisites>.
-=head2 Problems with tr
+=head2 Problems with tr or sed
-reported with very old version of tr.
+reported with very old version of tr and sed.
=head2 Some problem (forget which ;-)
@@ -1008,8 +1082,9 @@ if script was started via cmd.exe).
=head2 Additional modules:
-L<OS2::Process>, L<OS2::REXX>, L<OS2::PrfDB>, L<OS2::ExtAttr>. This
-modules provide access to additional numeric argument for C<system>,
+L<OS2::Process>, L<OS2::REXX>, L<OS2::PrfDB>, L<OS2::ExtAttr>. These
+modules provide access to additional numeric argument for C<system>
+and to the list of the running processes,
to DLLs having functions with REXX signature and to REXX runtime, to
OS/2 databases in the F<.INI> format, and to Extended Attributes.
@@ -1378,7 +1453,7 @@ caching DLLs.
=head2 Threading
As of release 5.003_01 perl is linked to multithreaded CRT
-DLL. Perl itself is not multithread-safe, as is not perl
+DLL. If perl itself is not compiled multithread-enabled, so will not be perl
malloc(). However, extensions may use multiple thread on their own
risk.
@@ -1392,7 +1467,7 @@ external program I<via shell>, the F<f:/bin/sh.exe> will be called, or
whatever is the override, see L<"PERL_SH_DIR">.
Thus means that you need to get some copy of a F<sh.exe> as well (I
-use one from pdksh). The drive F: above is set up automatically during
+use one from pdksh). The drive F<F:> above is set up automatically during
the build to a correct value on the builder machine, but is
overridable at runtime,
@@ -1434,17 +1509,25 @@ If you have some working code for C<OS2::Cmd>, please send it to me,
I will include it into distribution. I have no need for such a module, so
cannot test it.
+For the details of the current situation with calling external programs,
+see L<Starting OS/2 (and DOS) programs under Perl>.
+
+=over
+
+=item
+
+External scripts may be called by name. Perl will try the same extensions
+as when processing B<-S> command-line switch.
+
+=back
+
=head2 Memory allocation
Perl uses its own malloc() under OS/2 - interpreters are usually malloc-bound
-for speed, but perl is not, since its malloc is lightning-fast.
-Unfortunately, it is also quite frivolous with memory usage as well.
-
-Since kitchen-top machines are usually low on memory, perl is compiled with
-all the possible memory-saving options. This probably makes perl's
-malloc() as greedy with memory as the neighbor's malloc(), but still
-much quickier. Note that this is true only for a "typical" usage,
-it is possible that the perl malloc will be worse for some very special usage.
+for speed, but perl is not, since its malloc is lightning-fast.
+Perl-memory-usage-tuned benchmarks show that Perl's malloc is 5 times quickier
+than EMX one. I do not have convincing data about memory footpring, but
+a (pretty random) benchmark showed that Perl one is 5% better.
Combination of perl's malloc() and rigid DLL name resolution creates
a special problem with library functions which expect their return value to
@@ -1453,6 +1536,31 @@ such functions, system memory-allocation functions are still available with
the prefix C<emx_> added. (Currently only DLL perl has this, it should
propagate to F<perl_.exe> shortly.)
+=head2 Threads
+
+One can build perl with thread support enabled by providing C<-D usethreads>
+option to F<Configure>. Currently OS/2 support of threads is very
+preliminary.
+
+Most notable problems:
+
+=over
+
+=item C<COND_WAIT>
+
+may have a race condition. Needs a reimplementation (in terms of chaining
+waiting threads, with linker list stored in per-thread structure?).
+
+=item F<os2.c>
+
+has a couple of static variables used in OS/2-specific functions. (Need to be
+moved to per-thread structure, or serialized?)
+
+=back
+
+Note that these problems should not discourage experimenting, since they
+have a low probability of affecting small programs.
+
=cut
OS/2 extensions
diff --git a/gnu/usr.bin/perl/README.vms b/gnu/usr.bin/perl/README.vms
index 4b8c29d3458..e2c0e0832ef 100644
--- a/gnu/usr.bin/perl/README.vms
+++ b/gnu/usr.bin/perl/README.vms
@@ -1,6 +1,21 @@
-Last Revised 11-September-1997 by Dan Sugalski <sugalsd@lbcc.cc.or.us>
+Last Revised 01-March-1999 by Dan Sugalski <sugalskd@ous.edu>
Originally by Charles Bailey <bailey@newman.upenn.edu>
+* Important safety tip
+
+The build and install procedures have changed significantly from the 5.004
+releases! Make sure you read the "Building Perl" and "Installing Perl"
+sections before you build or install.
+
+Also note that, as of 5.005, an ANSI C compliant compiler is required to
+build Perl. Vax C is *not* ANSI compliant, as it died a natural death some
+time before the standard was set. Therefore Vax C will not compile perl
+5.005. Sorry about that.
+
+If you're stuck without Dec C (the Vax C license should be good for Dec C,
+but the media charges might prohibit an upgrade), consider getting Gnu C
+instead.
+
* Intro
The VMS port of Perl is as functionally complete as any other Perl port
@@ -16,7 +31,7 @@ could use modules implementing useful VMS system services, so if you'd like
to lend a hand we'd love to have you. Join the Perl Porting Team Now!
The current sources and build procedures have been tested on a VAX using
-VaxC and Dec C, and on an AXP using Dec C. If you run into problems with
+Dec C, and on an AXP using Dec C. If you run into problems with
other compilers, please let us know.
There are issues with varions versions of Dec C, so if you're not running a
@@ -26,84 +41,75 @@ document.
* Other required software
In addition to VMS, you'll need:
- 1) A C compiler. Dec C for AXP, or VAX C, Dec C, or gcc for the
- VAX.
+ 1) A C compiler. Dec C or gcc for AXP or the VAX.
2) A make tool. Dec's MMS (v2.6 or later), or MadGoat's free MMS
analog MMK (available from ftp.madgoat.com/madgoat) both work
just fine. Gnu Make might work, but it's been so long since
anyone's tested it that we're not sure. MMK's free, though, so
go ahead and use that.
+You may also want to have on hand:
+ 1) UNZIP.EXE for VMS available from a number of web/ftp sites.
+ http://www.cdrom.com/pub/infozip/UnZip.html
+ http://www.openvms.digital.com/cd/INFO-ZIP/
+ ftp://ftp.digital.com/pub/VMS/
+ ftp://ftp.openvms.digital.com/
+ ftp://ftp.madgoat.com/madgoat/
+ ftp://ftp.wku.edu/vms/
+ 2) GUNZIP/GZIP.EXE for VMS available from a number of web/ftp sites.
+ http://www.fsf.org/order/ftp.html
+ ftp://ftp.uu.net/archive/systems/gnu/diffutils*.tar.gz
+ ftp://gatekeeper.dec.com/pub/GNU/diffutils*.tar.gz
+ ftp://ftp.gnu.org/pub/gnu/diffutils*.tar.gz
+ http://www.openvms.digital.com/cd/GZIP/
+ ftp://ftp.digital.com/pub/VMS/
+ 3) VMS TAR also available from a number of web/ftp sites.
+ ftp://ftp.lp.se/vms/
+ http://www.openvms.digital.com/cd/VMSTAR/
+ ftp://ftp.digital.com/pub/VMS/
+Please note that UNZIP and GUNZIP are not the same thing (they work with
+different formats). Most of the useful files from CPAN (the Comprehensive
+Perl Archive Network) are in .tar.gz format (this includes copies of the
+source code for perl as well as modules and scripts that you may wish to
+add later) hence you probably want to have GUNZIP.EXE and VMSTAR.EXE on
+your VMS machine.
If you want to include socket support, you'll need a TCP stack and either
Dec C, or socket libraries. See the Socket Support topic for more details.
-* Compiling Perl
-
->From the top level of the Perl source directory, do this:
-
-MMS/DESCRIP=[.VMS]DESCRIP.MMS
-
-If you're on an Alpha, add /Macro=("__AXP__=1","decc=1")
-If you're using Dec C as your C compiler (you are on all alphas), add
-/Macro=("decc=1")
-If Vac C is your default C compiler and you want to use Dec C, add
-/Macro=("CC=CC/DECC") (Don't forget the /macro=("decc=1")
-If Dec C is your default C compiler and you want to use Vax C, add
-/Macro=("CC=CC/VAXC")
-If you want Socket support and are using the SOCKETSHR socket library, add
-/Macro=("SOCKETSHR_SOCKETS=1")
-If you want Socket support and are using the Dec C RTL socket interface
-(You must be using Dec C for this), add /Macro=("DECC_SOCKETS=1")
-
-If you have multiple /macro= items, combine them together in one /Macro=()
-switch, with all the options inside the parentheses separated by commas.
-
-Samples:
-
-VMS AXP, with Socketshr sockets:
-
-$MMS/DESCRIP=[.VMS]DESCRIP.MMS/Macro=("decc=1","__AXP__=1","SOCKETSHR_SOCKETS=1")
+* Building Perl
-VMS AXP with no sockets
+Building perl has two steps, configuration and compilation.
-$MMS/DESCRIP=[.VMS]DESCRIP.MMS/Macro=("decc=1","__AXP__=1")
+To configure perl (a necessary first step), issue the command
-VMS AXP with the Dec C RTL sockets
+@CONFIGURE
-$MMS/DESCRIP=[.VMS]/Macro=("decc=1","__AXP__=1","DECC_SOCKETS=1")
+from the top of an unpacked perl directory. You'll be asked a series of
+questions, and the answers to them (along with the capabilities of your C
+compiler and network stack) will determine how perl's built.
-VMS VAX with default system compiler, no sockets
-
-$MMS/DESCRIP=[.VMS]DESCRIP.MMS
-
-VMS VAX with Dec C compiler, no sockets
-
-$MMS/DESCRIP=[.VMS]DESCRIP.MMS/Macro=("CC=CC/DECC","decc=1")
-
-VMS VAX with Dec C compiler, Dec C RTL sockets
-
-$MMS/DESCRIP=[.VMS]DESCRIP.MMS/Macro=("CC=CC/DECC","decc=1","DECC_SOCKETS=1")
-
-VMS VAX with Dec C compiler, Socketshr sockets
-
-$MMS/DESCRIP=[.VMS]DESCRIP.MMS/Macro=("CC=CC/DECC","decc=1","SOCKETSHR_SOCKETS=1")
-
-Using Dec C is recommended over Vax C. The compiler is newer, and
-supported. (Vax C was decommisioned around 1993) Various older versions had
-some gotchas, so if you're using a version older than 5.2, check the Dec C
-Issues section.
-
-We'll also point out that Dec C will get you at least a ten-fold increase
-in line-oriented IO over Vax C. The optimizer is amazingly better, too. If
-you can use Dec C, then you *really*, *really* should.
+If you've got multiple C compilers installed, you'll have your choice of
+which one to use. Various older versions of Dec C had some gotchas, so if
+you're using a version older than 5.2, check the Dec C Issues section.
+The configuration script will print out, at the very end, the MMS or MMK
+command you need to compile perl. Issue it (exactly as printed) to start
+the build.
Once you issue your MMS command, sit back and wait. Perl should build and
link without a problem. If it doesn't, check the Gotchas to watch out for
section. If that doesn't help, send some mail to the VMSPERL mailing list.
Instructions are in the Mailing Lists section.
+As a handy shortcut, the command:
+
+@CONFIGURE "-des"
+
+(note the quotation marks and case) will choose reasonable defaults. (It
+takes Dec C over Gnu C, Dec C sockets over SOCKETSHR sockets, and either
+over no sockets)
+
* Testing Perl
Once Perl has built cleanly, you need to test it to make sure things work.
@@ -116,11 +122,11 @@ compile Perl and add the word "test" to the end, like this:
Compile Command:
-$MMS/DESCRIP=[.VMS]DESCRIP.MMS/Macro=("__AXP__=1","decc=1","DECCRTL_SOCKETS=1")
+$MMS
Test Command:
-$MMS/DESCRIP=[.VMS]DESCRIP.MMS/Macro=("__AXP__=1","decc=1","DECCRTL_SOCKETS=1") test
+$MMS test
MMS will run all the tests. This may take some time, as there are a lot of
tests. If any tests fail, there will be a note made on-screen. At the end
@@ -129,7 +135,7 @@ the time taken will be displayed.
If any tests fail, it means something's wrong with Perl. If the test suite
hangs (some tests can take upwards of two or three minutes, or more if
-you're on an especially slow machine, depending on you machine speed, so
+you're on an especially slow machine, depending on your machine speed, so
don't be hasty), then the test *after* the last one displayed failed. Don't
install Perl unless you're confident that you're OK. Regardless of how
confident you are, make a bug report to the VMSPerl mailing list.
@@ -137,16 +143,14 @@ confident you are, make a bug report to the VMSPerl mailing list.
If one or more tests fail, you can get more info on the failure by issuing
this command sequence:
-$ SET DEFAULT [.T]
-$ @[-.VMS]TEST .typ -v [.subdir]test.T
+$ @[.VMS]TEST .typ "-v" [.subdir]test.T
where ".typ" is the file type of the Perl images you just built (if you
didn't do anything special, use .EXE), and "[.subdir]test.T" is the test
that failed. For example, with a normal Perl build, if the test indicated
that [.op]time failed, then you'd do this:
-$ SET DEFAULT [.T]
-$ @[-.VMS]TEST .EXE -v [.OP]TIME.T
+$ @[.VMS]TEST .EXE "-v" [.OP]TIME.T
When you send in a bug report for failed tests, please include the output
from this command, which is run from the main source directory:
@@ -155,6 +159,9 @@ MCR []MINIPERL "-V"
Note that "-V" really is a capital V in double quotes. This will dump out a
couple of screens worth of config info, and can help us diagnose the problem.
+If (and only if) that did not work then try enclosing the output of:
+
+@[.vms]myconfig
* Cleaning up and starting fresh
@@ -164,11 +171,11 @@ compile and add "realclean" at the end, like this:
Compile Command:
-$MMS/DESCRIP=[.VMS]DESCRIP.MMS/Macro=("__AXP__=1","decc=1","DECCRTL_SOCKETS=1")
+$MMS
Cleanup Command:
-$MMS/DESCRIP=[.VMS]DESCRIP.MMS/Macro=("__AXP__=1","decc=1","DECCRTL_SOCKETS=1") realclean
+$MMS realclean
If you don't do this, things may behave erratically. They might not, too,
so it's best to be sure and do it.
@@ -176,54 +183,79 @@ so it's best to be sure and do it.
* Installing Perl
There are several steps you need to take to get Perl installed and
-running. At some point we'll have a working install in DESCRIP.MMS, but for
-right now the procedure's manual, and goes like this.
+running.
1) Create a directory somewhere and define the concealed logical PERL_ROOT
to point to it. For example, DEFINE/TRANS=(CONC,TERM) PERL_ROOT dka200:[perl.]
-2) Copy perl.exe into PERL_ROOT:[000000]
+2) Run the install script via:
+
+MMS install
-3) Copy everything in [.LIB] and [.UTILS] (including all the
-subdirectories!) to PERL_ROOT:[LIB] and PERL_ROOT:[UTILS].
+or
-4) Either copy PERLSHR.EXE to SYS$SHARE, or to somewhere globally accessble
-and define the logical PERLSHR to point to it (DEFINE PERLSHR
-PERL_ROOT:[000000]PERLSHR.EXE or something like that). The PerlShr image
-should have W:RE protections on it. (Just W:E triggers increased security in
-the image activator. Not a huge problem, but Perl will need to have any
-other shared image it accesses INSTALLed. It's a huge pain, so don't unless
-you know what you're doing)
+MMK install
-5) Either define the symbol PERL somewhere, such as
+If for some reason it complains about target INSTALL being up to date,
+throw a /FORCE switch on the MMS or MMK command.
+
+The script [.VMS]PERL_SETUP.COM that is written by CONFIGURE.COM
+will take care of most of the following:
+
+3) Either define the symbol PERL somewhere, such as
SYS$MANAGER:SYLOGIN.COM, to be "PERL :== $PERL_ROOT:[000000]PERL.EXE", or
-install Perl into DCLTABLES.EXE )Check out the section "Installing Perl
+install Perl into DCLTABLES.EXE (Check out the section "Installing Perl
into DCLTABLES" for more info), or put the image in a directory that's in
your DCL$PATH (if you're using VMS 6.2 or higher).
-6) Optionally define the command PERLDOC as
-PERLDOC :== $PERL_ROOT:[000000]PERL PERL_ROOT:[LIB.POD]PERLDOC.COM -T
+4) Either define the logical name PERLSHR somewhere
+(such as in PERL_SETUP.COM) like so:
+DEFINE/NOLOG PERLSHR PERL_ROOT:[000000]PERLSHR.EXE
+or copy perl_root:[000000]perlshr.exe sys$share:.
-7) Optionally define the command PERLBUG (the Perl bug report generator) as
-PERLBUG :== $PERL_ROOT:[000000]PERL PERL_ROOT:[LIB]PERLBUG.COM"
+5) Optionally define the command PERLDOC as
+PERLDOC == "$PERL_ROOT:[000000]PERL PERL_ROOT:[LIB.POD]PERLDOC.COM -t"
+Note that if you wish to use most as a pager please see
+ftp://space.mit.edu/pub/davis/ for both most and slang (or perhaps
+ftp://ftp.wku.edu/vms/narnia/most.zip ).
-* Installing Perl into DCLTABLES
+6) Optionally define the command PERLBUG (the Perl bug report generator) as
+PERLBUG == "$PERL_ROOT:[000000]PERL PERL_ROOT:[LIB]PERLBUG.COM"
-Courtesy of Brad Hughes:
+7) Optionally define the command POD2MAN (Converts POD files to nroff
+source suitable for converting to man pages. Also quiets complaints during
+module builds) as
-Put the following, modified to reflect where your .exe is, in PERL.CLD:
+DEFINE/NOLOG POD2MAN PERL_ROOT:[LIB.POD]POD2MAN.COM
+POD2MAN == "$PERL_ROOT:[000000]PERL POD2MAN"
-define verb perl
-image perl_root:[exe]perl.exe
-cliflags (foreign)
+8) Optionally define the command POD2TEXT (Converts POD files to text,
+which is required for perldoc -f to work properly) as
+
+DEFINE/NOLOG POD2TEXT PERL_ROOT:[LIB.POD]POD2TEXT.COM
+POD2TEXT == "$PERL_ROOT:[000000]PERL POD2TEXT"
+
+In all these cases, if you've got PERL defined as a foreign command, you
+can replace $PERL_ROOT:[000000]PERL with ''perl'. If you've installed perl
+into DCLTABLES, replace it with just perl.
+
+* Installing Perl into DCLTABLES
-and then
+Execute the following command file to define PERL as a DCL command.
+You'll need CMKRNL priv to install the new dcltables.exe.
+$ create perl.cld
+!
+! modify to reflect location of your perl.exe
+!
+define verb perl
+ image perl_root:[000000]perl.exe
+ cliflags (foreign)
+$!
$ set command perl /table=sys$common:[syslib]dcltables.exe -
/output=sys$common:[syslib]dcltables.exe
$ install replace sys$common:[syslib]dcltables.exe
-
-and you don't need perl :== $perl_root:[exe]perl.exe.
+$ exit
* Changing compile-time things
@@ -239,20 +271,44 @@ unnecessary.
The one exception is the various *DIR install locations. Changing those
requires changes in genconfig.pl as well. Be really careful if you need to
-change these,a s they can cause some fairly subtle problems.
+change these, as they can cause some fairly subtle problems.
+
+* INSTALLing images
+
+On systems that are using perl quite a bit, and particularly those with
+minimal RAM, you can boost the performance of perl by INSTALLing it as
+a known image. PERLSHR.EXE is typically larger than 1500 blocks
+and that is a reasonably large amount of IO to load each time perl is
+invoked.
+
+ INSTALL ADD PERLSHR/SHARE
+
+should be enough for PERLSHR.EXE (/share implies /header and /open),
+while /HEADER should do for PERL.EXE (perl.exe is not a shared image).
+
+If your code 'use's modules, check to see if there's an executable for
+them, too. In the base perl build, POSIX, IO, Fcntl, Opcode, SDBM_File,
+DCLsym, and Stdio all have shared images that can be installed /SHARE.
+
+How much of a win depends on your memory situation, but if you're firing
+off perl with any regularity (like more than once every 20 seconds or so)
+it's probably a win.
+
+While there is code in perl to remove privileges as it runs you are advised
+to NOT INSTALL PERL.EXE with PRIVs!
* Extra things in the Perl distribution
In addition to the standard stuff that gets installed, there are two
optional extensions, DCLSYM and STDIO, that are handy. Instructions for
these two modules are in [.VMS.EXT.DCLSYM] and [.VMS.EXT.STDIO],
-respectively.
+respectively. They are built automatically for versions of perl >= 5.005.
* Socket Support
Perl includes a number of functions for IP sockets, which are available if
-you choose to compile Perl with socket support. (See the section Compiling
-Perl for more info on selecting a socket stack) Since IP networking is an
+you choose to compile Perl with socket support (see the section Compiling
+Perl for more info on selecting a socket stack). Since IP networking is an
optional addition to VMS, there are several different IP stacks
available. How well integrated they are into the system depends on the
stack, your version of VMS, and the version of your C compiler.
@@ -278,22 +334,22 @@ If you come across what you think might be a bug in Perl, please report
it. There's a script in PERL_ROOT:[UTILS], perlbug, that walks you through
the process of creating a bug report. This script includes details of your
installation, and is very handy. Completed bug reports should go to
-PERLBUG@PERL.COM.
+perlbug@perl.com.
* Gotchas to watch out for
Probably the single biggest gotcha in compiling Perl is giving the wrong
-switches to MMS/MMK when you build. If Perl's building oddly, double-check
-your switches. If you're on a VAX, be sure to add a /Macro=("decc=1") if
-you're using Dec C, and if you're on an alpha and using MMS, you'll need a
-/Macro=("__AXP__=1")
+switches to MMS/MMK when you build. Use *exactly* what the configure script
+prints!
The next big gotcha is directory depth. Perl can create directories four
and five levels deep during the build, so you don't have to be too deep to
start to hit the RMS 8 level point. It's best to do a
$DEFINE/TRANS=(CONC,TERM) PERLSRC disk:[dir.dir.dir.perldir.]" (note the
trailing period) and $SET DEFAULT PERLSRC:[000000] before building. Perl
-modules can be just as bad (or worse), so watch out for them, too.
+modules can be just as bad (or worse), so watch out for them, too. The
+configuration script will warn if it thinks you're too deep (at least on
+versions of VMS prior to 7.2).
Finally, the third thing that bites people is leftover pieces from a failed
build. If things go wrong, make sure you do a "(MMK|MMS|make) realclean"
@@ -330,12 +386,10 @@ message with just the words SUBSCRIBE VMSPERL in the body of the message.
The VMSPERL mailing list address is VMSPERL@NEWMAN.UPENN.EDU. Any mail
sent there gets echoed to all subscribers of the list.
-The Perl5-Porters list is for anyone involved in porting Perl to a
-platform. This includes you, if you want to participate. It's a high-volume
-list (60-100 messages a day during active development times), so be sure
-you want to be there. The subscription address is
-Perl5-Porters-request@perl.org. Send a message with just the word SUBSCRIBE
-in the body. The posting address is Perl5-Porters@perl.org.
+To unsubscribe from VMSPERL send the message UNSUBSCRIBE VMSPERL to
+VMSPERL-REQUEST@NEWMAN.UPENN.EDU. Be sure to do so from the subscribed
+account that you are cancelling.
+
* Acknowledgements
@@ -355,16 +409,16 @@ missed someone. That said, special thanks are due to the following:
for the getredirection() code
Rich Salz <rsalz@bbn.com>
for readdir() and related routines
- Peter Prymmer <pvhp@lns62.lns.cornell.edu)
+ Peter Prymmer <pvhp@forte.com> or <pvhp@lns62.lns.cornell.edu>
for extensive testing, as well as development work on
configuration and documentation for VMS Perl,
- Dan Sugalski <sugalsd@stargate.lbcc.cc.or.us>
+ Dan Sugalski <sugalskd@ous.edu>
for extensive contributions to recent version support,
development of VMS-specific extensions, and dissemination
of information about VMS Perl,
the Stanford Synchrotron Radiation Laboratory and the
Laboratory of Nuclear Studies at Cornell University for
- the the opportunity to test and develop for the AXP,
+ the opportunity to test and develop for the AXP,
and to the entire VMSperl group for useful advice and suggestions. In
addition the perl5-porters deserve credit for their creativity and
willingness to work with the VMS newcomers. Finally, the greatest debt of
@@ -373,367 +427,3 @@ have made our sleepless nights possible.
Thanks,
The VMSperl group
-
-
----------------------------------------------------------------------------
-[Here's the pre-5.004_04 version of README.vms, for the record.]
-
-Last revised: 19-Jan-1996 by Charles Bailey bailey@genetics.upenn.edu
-
-The VMS port of Perl is still under development. At this time, the Perl
-binaries built under VMS handle internal operations properly, for the most
-part, as well as most of the system calls which have close equivalents under
-VMS. There are still some incompatibilities in process handling (e.g the
-fork/exec model for creating subprocesses doesn't do what you might expect
-under Unix), and there remain some file handling differences from Unix. Over
-the longer term, we'll try to get many of the useful VMS system services
-integrated as well, depending on time and people available. Of course, if
-you'd like to add something yourself, or join the porting team, we'd love to
-have you!
-
-The current sources and build procedures have been tested on a VAX using VAXC
-and DECC, and on an AXP using DECC. If you run into problems with other
-compilers, please let us know.
-
-Note to DECC users: Some early versions of the DECCRTL contained a few bugs
-which affect Perl performance:
- - Newlines are lost on I/O through pipes, causing lines to run together.
- This shows up as RMS RTB errors when reading from a pipe. You can
- work around this by having one process write data to a file, and
- then having the other read the file, instead of the pipe. This is
- fixed in version 4 of DECC.
- - The modf() routine returns a non-integral value for some values above
- INT_MAX; the Perl "int" operator will return a non-integral value in
- these cases. This is fixed in version 4 of DECC.
- - On the AXP, if SYSNAM privilege is enabled, the CRTL chdir() routine
- changes the process default device and directory permanently, even
- though the call specified that the change should not persist after
- Perl exited. This is fixed by DEC CSC patch AXPACRT04_061.
-
-* Other software required
-
-At the moment, in addition to basic VMS, you'll need two things:
- - a C compiler: VAXC, DECC, or gcc for the VAX; DECC for the AXP
- - a make tool: DEC's MMS (version 2.6 or later) or the free analog MMK
- (available from ftp.spc.edu), or a standard make utility (e.g. GNU make,
- also available from ftp.spc.edu).
-In addition, you may include socket support if you have an IP stack running
-on your system. See the topic "Socket support" for more information.
-
-* Socket support
-
-Perl includes a number of IP socket routines among its builtin functions,
-which are available if you choose to compile Perl with socket support. Since
-IP networking is an optional addition to VMS, there are several different IP
-stacks available, so it's difficult to automate the process of building Perl
-with socket support in a way which will work on all systems.
-
-By default, Perl is built without IP socket support. If you define the macro
-SOCKET when invoking MMK, however, socket support will be included. As
-distributed, Perl for VMS includes support for the SOCKETSHR socket library,
-which is layered on MadGoat software's vendor-independent NETLIB interface.
-This provides support for all socket calls used by Perl except the
-[g|s]etnet*() routines, which are replaced for the moment by stubs which
-generate a fatal error if a Perl script attempts to call one of these routines.
-Both SOCKETSHR and NETLIB are available from MadGoat ftp sites, such as
-ftp.spc.edu or ftp.wku.edu.
-
-You can link Perl directly to your TCP/IP stack's library, *as long as* it
-supplies shims for stdio routines which will properly handle both sockets and
-normal file descriptors. This is necessary because Perl does not distinguish
-between the two, and will try to make normal stdio calls such as read() and
-getc() on socket file descriptors. If you'd like to link Perl directly to
-your IP stack, then make the following changes:
- - In Descrip.MMS, locate the section beginning with .ifdef SOCKET, and
- change the SOCKLIB macro so that it translates to the filespec of your
- IP stack's socket library. This will be added to the RTL options file.
- - Edit the file SockAdapt.H in the [.VMS] subdirectory so that it
- includes the Socket.H, In.H, Inet.H, NetDb.H, and, if necessary,
- Errno.H header files for your IP stack, or so that it declares the
- standard TCP/IP constants and data structures appropriately. (See
- the distributed copy of SockAdapt.H for a collection of the structures
- needed by Perl itself, and [.ext.Socket]Socket.xs for a list of the
- constants used by the Socket extension, if you elect to built it.)
- You should also define any logical names necessary for your C compiler
- to find these files before invoking MM[KS] to build Perl.
- - Edit the file SockAdapt.C in the [.VMS] subdirectory so that it
- contains routines which substitute for any IP library routines
- required by Perl which your IP stack does not provide. This may
- require a little trial and error; we'll try to compile a complete
- list soon of socket routines required by Perl.
-
-
-* Building Perl under VMS
-
-Since you're reading this, presumably you've unpacked the Perl distribution
-into its directory tree, in which you will find a [.vms] subdirectory below
-the directory in which this file is found. If this isn't the case, then you'll
-need to unpack the distribution properly, or manually edit Descrip.MMS or
-the VMS Makefile to alter directory paths as necessary. (I'd advise using the
-`normal' directory tree, at least for the first time through.) This
-subdirectory contains several files, among which are the following:
- Config.VMS - A template Config.H set up for VMS.
- Descrip.MMS - The MMS/MMK dependency file for building Perl
- GenConfig.Pl - A Perl script to generate Config.SH retrospectively
- from Config.VMS, since the Configure shell script which
- normally generates Config.SH doesn't run under VMS.
- GenOpt.Com - A little DCL procedure used to write some linker options
- files, since not all make utilities can do this easily.
- Gen_ShrFls.Pl - A Perl script which generates linker options files and
- MACRO declarations for PerlShr.Exe.
- Makefile - The make dependency file for building Perl
- MMS2Make.Pl - A Perl script used to generate Makefile from Descrip.MMS
- PerlVMS.pod - Documentation for VMS-specific behavior of Perl
- Perly_[CH].VMS - Versions of the byacc output from Perl's grammar,
- modified to include VMS-specific C compiler options
- SockAdapt.[CH] - C source code used to integrate VMS TCP/IP support
- Test.Com - DCL driver for Perl regression tests
- VMSish.H - C header file containing VMS-specific definitions
- VMS.C - C source code for VMS-specific routines
- VMS_Yfix.Pl - Perl script to convert Perly.[CH] to Perly_[CH].VMS
- WriteMain.Pl - Perl script to generate Perlmain.C
-The [.Ext...] directories contain VMS-specific extensions distributed with
-Perl. There may also be other files in [.VMS...] pertaining to features under
-development; for the most part, you can ignore them. Note that packages in
-[.ext.*] are not built with Perl by default; you build the ones you want
-once the basic Perl build is complete (see the perlvms docs for instructions
-on building extensions.)
-
-Config.VMS and Decrip.MMS/Makefile are set up to build a version of Perl which
-includes all features known to work when this release was assembled. If you
-have code at your site which would support additional features (e.g. emulation
-of Unix system calls), feel free to make the appropriate changes to these
-files. (Note: Do not use or edit config.h in the main Perl source directory;
-it is superseded by the current Config.VMS during the build.) You may also
-wish to make site-specific changes to Descrip.MMS or Makefile to reflect local
-conventions for naming of files, etc.
-
-There are several pieces of system-specific information which become part of
-the Perl Config extension. Under VMS, the data for Config are generated by the
-script GenConfig.Pl in the [.VMS] subdirectory. It tries to ascertain the
-necessary information from various files, or from the system itself, and
-generally does the right thing. There is a list of hard-coded values at the
-end of this script which specifies items that are correct for most VMS systems,
-but may be incorrect for you, if your site is set up in an unusual fashion. If
-you're familiar with Perl's Config extension, feel free to edit these values as
-necessary. If this doesn't mean much to you, don't worry -- the information is
-probably correct, and even if it's not, none of these parameters affect your
-ability to build or run Perl. You'll only get the wrong answer if you ask for
-it specifically from Config.
-
-Examine the information at the beginning of Descrip.MMS for information about
-specifying alternate C compilers or building a version of Perl with debugging
-support. For instance, if you want to use DECC, you'll need to include the
-/macro="decc=1" qualifier to MMK (If you're using make, these options are not
-supported.) If you're on an AXP system, define the macro __AXP__ (MMK does
-this for you), and DECC will automatically be selected.
-
-To start the build, set default to the main source directory. Since
-Descrip.MMS assumes that VMS commands have their usual meaning, and makes use
-of command-line macros, you may want to be certain that you haven't defined DCL
-symbols which would interfere with the build. Then, if you are using MMS or
-MMK, say
-$ MMS/Descrip=[.VMS] ! or MMK
-(N.B. If you are using MMS, you must use version 2.6 or later; a bug in
-earlier versions produces malformed cc command lines.) If you are using a
-version of make, say
-$ Make -f [.VMS]Makefile
-Note that the Makefile doesn't support conditional compilation, is
-set up to use VAXC on a VAX, and does not include socket support. You can
-either edit the Makefile by hand, using Descrip.MMS as a guide, or use the
-Makefile to build Miniperl.Exe, and then run the Perl script MMS2Make.pl,
-found in the [.VMS] subdirectory, to generate a new Makefile with the options
-appropriate to your site.
-
-If you are using MM[SK], and you decide to rebuild Perl with a different set
-of parameters (e.g. changing the C compiler, or adding socket support), be
-sure to say
-$ MMK/Descrip=[.VMS] realclean
-first, in order to remove files generated during the previous build. If
-you omit this step, you risk ending up with a copy of Perl which
-composed partially of old files and partially of new ones, which may lead
-to strange effects when you try to run Perl.
-
-A bug in some early versions of the DECC RTL on the AXP causes newlines
-to be lost when writing to a pipe. A different bug in some patched versions
-of DECC 4.0 for VAX can also scramble preprocessor output. Finally, gcc 2.7.2
-has yet another preprocessor bug, which causes line breaks to be inserted
-into the output at inopportune times. Each of these bugs causes Gen_ShrFls.pl
-to fail, since it can't parse the preprocessor output to identify global
-variables and routines. This problem is generally manifested as missing
-global symbols when linking PerlShr.Exe or Perl.Exe. You can work around
-it by defining the macro PIPES_BROKEN when you invoke MMS or MMK.
-
-
-This will build the following files:
- Miniperl.Exe - a stand-alone version of without any extensions.
- Miniperl has all the intrinsic capabilities of Perl,
- but cannot make use of the DynaLoader or any
- extensions which use XS code.
- PerlShr.Exe - a shareable image containing most of Perl's internal
- routines and global variables. Perl.Exe is linked to
- this image, as are all dynamic extensions, so everyone's
- using the same set of global variables and routines.
- Perl.Exe - the main Perl executable image. It's contains the
- main() routine, plus code for any statically linked
- extensions.
- PerlShr_Attr.Opt - A linker options file which specifies psect attributes
- matching those in PerlShr.Exe. It should be used when
- linking images against PerlShr.Exe
- PerlShr_Bld.Opt - A linker options file which specifies various things
- used to build PerlShr.Exe. It should be used when
- rebuilding PerlShr.Exe via MakeMaker-produced
- Descrip.MMS files for static extensions.
- c2ph - Perl program which generates template code to access
- C struct members from Perl.
- h2ph - Perl program which generates template code to access
- #defined constants in a C header file from Perl,
- using the "old-style" interface. (Largely supplanted
- by h2xs.)
- h2xs - Perl program which generates template files for creating
- XSUB extensions, optionally beginning with the #defined
- constants in a C header file.
- [.lib.pod]perldoc - A Perl program which locates and displays documentation
- for Perl and its extensions.
- [.Lib]Config.pm - the Perl extension which saves configuration information
- about Perl and your system.
- [.Lib]DynaLoader.pm - The Perl extension which performs dynamic linking of
- shareable images for extensions.
- Several subdirectories under [.Lib] containing preprocessed files or
- site-specific files.
-There are, of course, a number of other files created for use during the build.
-Once you've got the binaries built, you may wish to `build' the `tidy' or
-`clean' targets to remove extra files.
-
-If you run into problems during the build, you can get help from the VMSPerl
-or perl5-porters mailing lists (see below). When you report the problem,
-please include the following information:
- - The version of Perl you're trying to build. Please include any
- "letter" patchlevel, in addition to the version number. If the
- build successfully created Miniperl.Exe, you can check this by
- saying '$ MCR Sys$Disk:[]Miniperl -v'. Also, please mention
- where you obtained the distribution kit; in particular, note
- whether you were using a basic Perl kit or the VMS test kit
- (see below).
- - The exact command you issued to build Perl.
- - A copy of all error messages which were generated during the build.
- Please include enough of the build log to establish the context of
- the error messages.
- - A summary of your configuration. If the build progressed far enough
- to generate Miniperl.Exe and [.Lib]Config.pm, you can obtain this
- by saying '$ MCR Sys$Disk:[]Miniperl "-V"' (note the "" around -V).
- If not, then you can say '$ MMK/Descrip=[.VMS] printconfig' to
- produce the summary.
-This may sound like a lot of information to send, but it'll often make
-it easier for someone to spot the problem, instead of having to give
-a spectrum of possibilities.
-
-
-
-* Installing Perl once it's built
-
-Once the build is complete, you'll need to do the following:
- - Put PerlShr.Exe in a common directory, and make it world-readable.
- If you place it in a location other than Sys$Share, you'll need to
- define the logical name PerlShr to point to the image. (If you're
- installing on a VMScluster, be sure that each node is using the
- copy of PerlShr you expect [e.g. if you put PerlShr.Exe in Sys$Share,
- do they all share Sys$Share?]).
- - Put Perl.Exe in a common directory, and make it world-executable.
- - Define a foreign command to invoke Perl, using a statement like
- $ Perl == "$dev:[dir]Perl.Exe"
- - Create a world-readable directory tree for Perl library modules,
- scripts, and what-have-you, and define PERL_ROOT as a rooted logical
- name pointing to the top of this tree (i.e. if your Perl files were
- going to live in DKA1:[Util.Perl5...], then you should
- $ Define/Translation=Concealed Perl_Root DKA1:[Util.Perl5.]
- (Be careful to follow the rules for rooted logical names; in particular,
- remember that a rooted logical name cannot have as its device portion
- another rooted logical name - you've got to supply the actual device name
- and directory path to the root directory.)
- - Place the files from the [.lib...] directory tree in the distribution
- package into a [.lib...] directory tree off the root directory described
- above.
- - Most of the Perl documentation lives in the [.pod] subdirectory, and
- is written in a simple markup format which can be easily read. In this
- directory as well are pod2man and pod2html translators to reformat the
- docs for common display engines; a pod2hlp translator is under development.
- These files are copied to [.lib.pod] during the installation.
- - Define a foreign command to execute perldoc, such as
- $ Perldoc == "''Perl' Perl_Root:[lib.pod]Perldoc -t"
- This will allow users to retrieve documentation using Perldoc. For
- more details, say "perldoc perldoc".
-That's it.
-
-If you run into a bug in Perl, please submit a bug report. The PerlBug
-program, found in the [.lib] directory, will walk you through the process
-of assembling the necessary information into a bug report, and sending
-of to the Perl bug reporting address, perlbug@perl.com.
-
-* For more information
-
-If you're interested in more information on Perl in general, you may wish to
-consult the Usenet newsgroups comp.lang.perl.announce and comp.lang.perl.misc.
-The FAQ for these groups provides pointers to other online sources of
-information, as well as books describing Perl in depth.
-
-If you're interested in up-to-date information on Perl development and
-internals, you might want to subscribe to the perl5-porters mailing list. You
-can do this by sending a message to perl5-porters-request@nicoh.com, containing
-the single line
-subscribe perl5-porters
-This is a high-volume list at the moment (>50 messages/day).
-
-If you're interested in ongoing information about the VMS port, you can
-subscribe to the VMSPerl mailing list by sending a request to
-vmsperl-request@genetics.upenn.edu, containing the single line
-subscribe VMSPerl
-as the body of the message. And, as always, we welcome any help or code you'd
-like to offer - you can send mail to bailey@genetics.upenn.edu or directly to
-the VMSPerl list at vmsperl@genetics.upenn.edu.
-
-Finally, if you'd like to try out the latest changes to VMS Perl, you can
-retrieve a test distribution kit by anonymous ftp from genetics.upenn.edu, in
-the file [.perl5]perl5_ppp_yymmddx.zip, where "ppp" is the current Perl
-patchlevel, and "yymmddx" is a sequence number indicating the date that
-particular kit was assembled. In order to make retrieval convenient, this
-kit is also available by the name Perl5_VMSTest.Zip. These test kits contain
-"unofficial" patches from the perl5-porters group, test patches for important
-bugs, and VMS-specific fixes and improvements which have occurred since the
-last Perl release. Most of these changes will be incorporated in the next
-release of Perl, but until Larry Wall's looked at them and said they're OK,
-none of them should be considered official.
-
-Good luck using Perl. Please let us know how it works for you - we can't
-guarantee that we'll be able to fix bugs quickly, but we'll try, and we'd
-certainly like to know they're out there.
-
-
-* Acknowledgements
-
-There are, of course, far too many people involved in the porting and testing
-of Perl to mention everyone who deserves it, so please forgive us if we've
-missed someone. That said, special thanks are due to the following:
- Tim Adye <T.J.Adye@rl.ac.uk>
- for the VMS emulations of getpw*()
- David Denholm <denholm@conmat.phys.soton.ac.uk>
- for extensive testing and provision of pipe and SocketShr code,
- Mark Pizzolato <mark@infocomm.com>
- for the getredirection() code
- Rich Salz <rsalz@bbn.com>
- for readdir() and related routines
- Peter Prymmer <pvhp@lns62.lns.cornell.edu)
- for extensive testing, as well as development work on
- configuration and documentation for VMS Perl,
- the Stanford Synchrotron Radiation Laboratory and the
- Laboratory of Nuclear Studies at Cornell University for
- the the opportunity to test and develop for the AXP,
-and to the entire VMSperl group for useful advice and suggestions. In addition
-the perl5-porters, especially Andy Dougherty <doughera@lafcol.lafayette.edu>
-and Tim Bunce <Tim.Bunce@ig.co.uk>, deserve credit for their creativity and
-willingness to work with the VMS newcomers. Finally, the greatest debt of
-gratitude is due to Larry Wall <larry@wall.org>, for having the ideas which
-have made our sleepless nights possible.
-
-Thanks,
-The VMSperl group
diff --git a/gnu/usr.bin/perl/README.win32 b/gnu/usr.bin/perl/README.win32
index 1f8dd07f5f6..69004adb5d3 100644
--- a/gnu/usr.bin/perl/README.win32
+++ b/gnu/usr.bin/perl/README.win32
@@ -1,583 +1,758 @@
-If you read this file _as_is_, just ignore the funny characters you
-see. It is written in the POD format (see pod/perlpod.pod) which is
-specially designed to be readable as is.
-
-=head1 NAME
-
-perlwin32 - Perl under Win32
-
-=head1 SYNOPSIS
-
-These are instructions for building Perl under Windows NT (versions
-3.51 or 4.0), using Visual C++ (versions 2.0 through 5.0) or Borland
-C++ (version 5.x). Currently, this port may also build under Windows95,
-but you can expect problems stemming from the unmentionable command
-shell that infests that platform. Note this caveat is only about
-B<building> perl. Once built, you should be able to B<use> it on
-either Win32 platform (modulo the problems arising from the inferior
-command shell).
-
-=head1 DESCRIPTION
-
-Before you start, you should glance through the README file
-found in the top-level directory where the Perl distribution
-was extracted. Make sure you read and understand the terms under
-which this software is being distributed.
-
-Also make sure you read L<BUGS AND CAVEATS> below for the
-known limitations of this port.
-
-The INSTALL file in the perl top-level has much information that is
-only relevant to people building Perl on Unix-like systems. In
-particular, you can safely ignore any information that talks about
-"Configure".
-
-You may also want to look at two other options for building
-a perl that will work on Windows NT: the README.cygwin32 and
-README.os2 files, which each give a different set of rules to build
-a Perl that will work on Win32 platforms. Those two methods will
-probably enable you to build a more Unix-compatible perl, but you
-will also need to download and use various other build-time and
-run-time support software described in those files.
-
-This set of instructions is meant to describe a so-called "native"
-port of Perl to Win32 platforms. The resulting Perl requires no
-additional software to run (other than what came with your operating
-system). Currently, this port is capable of using either the
-Microsoft Visual C++ compiler, or the Borland C++ compiler. The
-ultimate goal is to support the other major compilers that can
-generally be used to build Win32 applications.
-
-This port currently supports MakeMaker (the set of modules that
-is used to build extensions to perl). Therefore, you should be
-able to build and install most extensions found in the CPAN sites.
-See L<Usage Hints> below for general hints about this.
-
-=head2 Setting Up
-
-=over 4
-
-=item Command Shell
-
-Use the default "cmd" shell that comes with NT. In particular, do
-*not* use the 4DOS/NT shell. The Makefile has commands that are not
-compatible with that shell. The Makefile also has known
-incompatibilites with the default shell that comes with Windows95,
-so building under Windows95 should be considered "unsupported".
-
-=item Borland C++
-
-If you are using the Borland compiler, you will need dmake, a freely
-available make that has very nice macro features and parallelability.
-(The make that Borland supplies is seriously crippled, and will not
-work for MakeMaker builds--if you *have* to bug someone about this,
-I suggest you bug Borland to fix their make :)
-
-A port of dmake for win32 platforms is available from
-"http://www-personal.umich.edu/~gsar/dmake-4.0-win32.tar.gz".
-Fetch and install dmake somewhere on your path. Also make sure you
-copy the Borland dmake.ini file to some location where you keep
-*.ini files. If you use the binary that comes with the above port, you
-will need to set INIT in your environment to the directory where you
-put the dmake.ini file.
-
-=item Microsoft Visual C++
-
-The NMAKE that comes with Visual C++ will suffice for building.
-If you did not choose to always initialize the Visual C++ compilation
-environment variables when you installed Visual C++ on your system, you
-will need to run the VCVARS32.BAT file usually found somewhere like
-C:\MSDEV4.2\BIN. This will set your build environment.
-
-You can also use dmake to build using Visual C++, provided: you
-copied the dmake.ini for Visual C++; set INIT to point to the
-directory where you put it, as above; and edit win32/config.vc
-and change "make=nmake" to "make=dmake". The last step is only
-essential if you want to use dmake to be your default make for
-building extensions using MakeMaker.
-
-=item Permissions
-
-Depending on how you extracted the distribution, you have to make sure
-some of the files are writable by you. The easiest way to make sure of
-this is to execute:
-
- attrib -R *.* /S
-
-from the perl toplevel directory. You don't I<have> to do this if you
-used the right tools to extract the files in the standard distribution,
-but it doesn't hurt to do so.
-
-=back
-
-=head2 Building
-
-=over 4
-
-=item *
-
-Make sure you are in the "win32" subdirectory under the perl toplevel.
-This directory contains a "Makefile" that will work with
-versions of NMAKE that come with Visual C++ ver. 2.0 and above, and
-a dmake "makefile.mk" that will work for both Borland and Visual C++
-builds. The defaults in the dmake makefile are setup to build using the
-Borland compiler.
-
-=item *
-
-Edit the Makefile (or makefile.mk, if using dmake) and change the values
-of INST_DRV and INST_TOP if you want perl to be installed in a location
-other than "C:\PERL". If you are using Visual C++ ver. 2.0, uncomment
-the line that sets "CCTYPE=MSVC20".
-
-You will also have to make sure CCHOME points to wherever you installed
-your compiler.
-
-=item *
-
-Type "nmake" (or "dmake" if you are using that make).
-
-This should build everything. Specifically, it will create perl.exe,
-perl.dll, and perlglob.exe at the perl toplevel, and various other
-extension dll's under the lib\auto directory. If the build fails for
-any reason, make sure you have done the previous steps correctly.
-
-The build process may produce "harmless" compiler warnings (more or
-less copiously, depending on how picky your compiler gets). The
-maintainers are aware of these warnings, thankyouverymuch. :)
-
-When building using Visual C++, a perl95.exe will also get built. This
-executable is only needed on Windows95, and should be used instead of
-perl.exe, and then only if you want sockets to work properly on Windows95.
-This is necessitated by a bug in the Microsoft C Runtime that cannot be
-worked around in the "normal" perl.exe. Again, if this bugs you, please
-bug Microsoft :). perl95.exe gets built with its own private copy of the
-C Runtime that is not accessible to extensions (which see the DLL version
-of the CRT). Be aware, therefore, that this perl95.exe will have
-esoteric problems with extensions like perl/Tk that themselves use the C
-Runtime heavily, or want to free() pointers malloc()-ed by perl.
-
-You can avoid the perl95.exe problems completely if you use Borland
-C++ for building perl (perl95.exe is not needed and will not be built
-in that case).
-
-=back
-
-=head2 Testing
-
-Type "nmake test" (or "dmake test"). This will run most of the tests from
-the testsuite (many tests will be skipped, and but no test should fail).
-
-If some tests do fail, it may be because you are using a different command
-shell than the native "cmd.exe".
-
-If you used the Borland compiler, you may see a failure in op/taint.t
-arising from the inability to find the Borland Runtime DLLs on the system
-default path. You will need to copy the DLLs reported by the messages
-from where Borland chose to install it, into the Windows system directory
-(usually somewhere like C:\WINNT\SYSTEM32), and rerun the test.
-
-Please report any other failures as described under L<BUGS AND CAVEATS>.
-
-=head2 Installation
-
-Type "nmake install" (or "dmake install"). This will put the newly
-built perl and the libraries under "C:\perl" (actually whatever you set
-C<INST_TOP> to in the Makefile). It will also install the pod
-documentation under C<$INST_TOP\lib\pod> and HTML versions of the same
-under C<$INST_TOP\lib\pod\html>. To use the Perl you just installed,
-set your PATH environment variable to "C:\perl\bin" (or C<$INST_TOP\bin>,
-if you changed the default as above).
-
-=head2 Usage Hints
-
-=over 4
-
-=item Environment Variables
-
-The installation paths that you set during the build get compiled
-into perl, so you don't have to do anything additional to start
-using that perl (except add its location to your PATH variable).
-
-If you put extensions in unusual places, you can set PERL5LIB
-to a list of paths separated by semicolons where you want perl
-to look for libraries. Look for descriptions of other environment
-variables you can set in the perlrun podpage.
-
-Sometime in the future, some of the configuration information
-for perl will be moved into the Windows registry.
-
-=item File Globbing
-
-By default, perl spawns an external program to do file globbing.
-The install process installs both a perlglob.exe and a perlglob.bat
-that perl can use for this purpose. Note that with the default
-installation, perlglob.exe will be found by the system before
-perlglob.bat.
-
-perlglob.exe relies on the argv expansion done by the C Runtime of
-the particular compiler you used, and therefore behaves very
-differently depending on the Runtime used to build it. To preserve
-compatiblity, perlglob.bat (a perl script/module that can be
-used portably) is installed. Besides being portable, perlglob.bat
-also offers enhanced globbing functionality.
-
-If you want perl to use perlglob.bat instead of perlglob.exe, just
-delete perlglob.exe from the install location (or move it somewhere
-perl cannot find). Using File::DosGlob.pm (which is the same
-as perlglob.bat) to override the internal CORE::glob() works about 10
-times faster than spawing perlglob.exe, and you should take this
-approach when writing new modules. See File::DosGlob for details.
-
-=item Using perl from the command line
-
-If you are accustomed to using perl from various command-line
-shells found in UNIX environments, you will be less than pleased
-with what Windows NT offers by way of a command shell.
-
-The crucial thing to understand about the "cmd" shell (which is
-the default on Windows NT) is that it does not do any wildcard
-expansions of command-line arguments (so wildcards need not be
-quoted). It also provides only rudimentary quoting. The only
-(useful) quote character is the double quote ("). It can be used to
-protect spaces in arguments and other special characters. The
-Windows NT documentation has almost no description of how the
-quoting rules are implemented, but here are some general observations
-based on experiments: The shell breaks arguments at spaces and
-passes them to programs in argc/argv. Doublequotes can be used
-to prevent arguments with spaces in them from being split up.
-You can put a double quote in an argument by escaping it with
-a backslash and enclosing the whole argument within double quotes.
-The backslash and the pair of double quotes surrounding the
-argument will be stripped by the shell.
-
-The file redirection characters "<", ">", and "|" cannot be quoted
-by double quotes (there are probably more such). Single quotes
-will protect those three file redirection characters, but the
-single quotes don't get stripped by the shell (just to make this
-type of quoting completely useless). The caret "^" has also
-been observed to behave as a quoting character (and doesn't get
-stripped by the shell also).
-
-Here are some examples of usage of the "cmd" shell:
-
-This prints two doublequotes:
-
- perl -e "print '\"\"' "
-
-This does the same:
-
- perl -e "print \"\\\"\\\"\" "
-
-This prints "bar" and writes "foo" to the file "blurch":
-
- perl -e "print 'foo'; print STDERR 'bar'" > blurch
-
-This prints "foo" ("bar" disappears into nowhereland):
-
- perl -e "print 'foo'; print STDERR 'bar'" 2> nul
-
-This prints "bar" and writes "foo" into the file "blurch":
-
- perl -e "print 'foo'; print STDERR 'bar'" 1> blurch
-
-This pipes "foo" to the "less" pager and prints "bar" on the console:
-
- perl -e "print 'foo'; print STDERR 'bar'" | less
-
-This pipes "foo\nbar\n" to the less pager:
-
- perl -le "print 'foo'; print STDERR 'bar'" 2>&1 | less
-
-This pipes "foo" to the pager and writes "bar" in the file "blurch":
-
- perl -e "print 'foo'; print STDERR 'bar'" 2> blurch | less
-
-
-Discovering the usefulness of the "command.com" shell on Windows95
-is left as an exercise to the reader :)
-
-=item Building Extensions
-
-The Comprehensive Perl Archive Network (CPAN) offers a wealth
-of extensions, some of which require a C compiler to build.
-Look in http://www.perl.com/ for more information on CPAN.
-
-Most extensions (whether they require a C compiler or not) can
-be built, tested and installed with the standard mantra:
-
- perl Makefile.PL
- $MAKE
- $MAKE test
- $MAKE install
-
-where $MAKE stands for NMAKE or DMAKE. Some extensions may not
-provide a testsuite (so "$MAKE test" may not do anything, or fail),
-but most serious ones do.
-
-If a module implements XSUBs, you will need one of the supported
-C compilers. You must make sure you have set up the environment for
-the compiler for command-line compilation.
-
-If a module does not build for some reason, look carefully for
-why it failed, and report problems to the module author. If
-it looks like the extension building support is at fault, report
-that with full details of how the build failed using the perlbug
-utility.
-
-=item Win32 Specific Extensions
-
-A number of extensions specific to the Win32 platform are available
-from CPAN. You may find that many of these extensions are meant to
-be used under the Activeware port of Perl, which used to be the only
-native port for the Win32 platform. Since the Activeware port does not
-have adequate support for Perl's extension building tools, these
-extensions typically do not support those tools either, and therefore
-cannot be built using the generic steps shown in the previous section.
-
-To ensure smooth transitioning of existing code that uses the
-Activeware port, there is a bundle of Win32 extensions that contains
-all of the Activeware extensions and most other Win32 extensions from
-CPAN in source form, along with many added bugfixes, and with MakeMaker
-support. This bundle is available at:
-
- http://www.perl.com/CPAN/authors/id/GSAR/libwin32-0.08.tar.gz
-
-See the README in that distribution for building and installation
-instructions. Look for later versions that may be available at the
-same location.
-
-It is expected that authors of Win32 specific extensions will begin
-distributing their work in MakeMaker compatible form subsequent to
-the 5.004 release of perl, at which point the need for a dedicated
-bundle such as the above should diminish.
-
-=item Running Perl Scripts
-
-Perl scripts on UNIX use the "#!" (a.k.a "shebang") line to
-indicate to the OS that it should execute the file using perl.
-Win32 has no comparable means to indicate arbitrary files are
-executables.
-
-Instead, all available methods to execute plain text files on
-Win32 rely on the file "extension". There are three methods
-to use this to execute perl scripts:
-
-=over 8
-
-=item 1
-
-There is a facility called "file extension associations" that will
-work in Windows NT 4.0. This can be manipulated via the two
-commands "assoc" and "ftype" that come standard with Windows NT
-4.0. Type "ftype /?" for a complete example of how to set this
-up for perl scripts (Say what? You thought Windows NT wasn't
-perl-ready? :).
-
-=item 2
-
-Since file associations don't work everywhere, and there are
-reportedly bugs with file associations where it does work, the
-old method of wrapping the perl script to make it look like a
-regular batch file to the OS, may be used. The install process
-makes available the "pl2bat.bat" script which can be used to wrap
-perl scripts into batch files. For example:
-
- pl2bat foo.pl
-
-will create the file "FOO.BAT". Note "pl2bat" strips any
-.pl suffix and adds a .bat suffix to the generated file.
-
-If you use the 4DOS/NT or similar command shell, note that
-"pl2bat" uses the "%*" variable in the generated batch file to
-refer to all the command line arguments, so you may need to make
-sure that construct works in batch files. As of this writing,
-4DOS/NT users will need a "ParameterChar = *" statement in their
-4NT.INI file, or will need to execute "setdos /p*" in the 4DOS/NT
-startup file to enable this to work.
-
-=item 3
-
-Using "pl2bat" has a few problems: the file name gets changed,
-so scripts that rely on C<$0> to find what they must do may not
-run properly; running "pl2bat" replicates the contents of the
-original script, and so this process can be maintenance intensive
-if the originals get updated often. A different approach that
-avoids both problems is possible.
-
-A script called "runperl.bat" is available that can be copied
-to any filename (along with the .bat suffix). For example,
-if you call it "foo.bat", it will run the file "foo" when it is
-executed. Since you can run batch files on Win32 platforms simply
-by typing the name (without the extension), this effectively
-runs the file "foo", when you type either "foo" or "foo.bat".
-With this method, "foo.bat" can even be in a different location
-than the file "foo", as long as "foo" is available somewhere on
-the PATH. If your scripts are on a filesystem that allows symbolic
-links, you can even avoid copying "runperl.bat".
-
-Here's a diversion: copy "runperl.bat" to "runperl", and type
-"runperl". Explain the observed behavior, or lack thereof. :)
-Hint: .gnidnats llits er'uoy fi ,"lrepnur" eteled :tniH
-
-=back
-
-=item Miscellaneous Things
-
-A full set of HTML documentation is installed, so you should be
-able to use it if you have a web browser installed on your
-system.
-
-C<perldoc> is also a useful tool for browsing information contained
-in the documentation, especially in conjunction with a pager
-like C<less> (recent versions of which have Win32 support). You may
-have to set the PAGER environment variable to use a specific pager.
-"perldoc -f foo" will print information about the perl operator
-"foo".
-
-If you find bugs in perl, you can run C<perlbug> to create a
-bug report (you may have to send it manually if C<perlbug> cannot
-find a mailer on your system).
-
-=back
-
-=head1 BUGS AND CAVEATS
-
-This port should be considered beta quality software at the present
-time because some details are still in flux and there may be
-changes in any of these areas: build process, installation structure,
-supported utilities/modules, and supported perl functionality.
-In particular, functionality specific to the Win32 environment may
-ultimately be supported as either core modules or extensions. The
-beta status implies, among other things, that you should be prepared
-to recompile extensions when binary incompatibilites arise due to
-changes in the internal structure of the code.
-
-An effort has been made to ensure that the DLLs produced by the two
-supported compilers are compatible with each other (despite the
-best efforts of the compiler vendors). Extension binaries produced
-by one compiler should also coexist with a perl binary built by
-a different compiler. In order to accomplish this, PERL.DLL provides
-a layer of runtime code that uses the C Runtime that perl was compiled
-with. Extensions which include "perl.h" will transparently access
-the functions in this layer, thereby ensuring that both perl and
-extensions use the same runtime functions.
-
-If you have had prior exposure to Perl on Unix platforms, you will notice
-this port exhibits behavior different from what is documented. Most of the
-differences fall under one of these categories. We do not consider
-any of them to be serious limitations (especially when compared to the
-limited nature of some of the Win32 OSes themselves :)
-
-=over 8
-
-=item *
-
-C<stat()> and C<lstat()> functions may not behave as documented. They
-may return values that bear no resemblance to those reported on Unix
-platforms, and some fields (like the the one for inode) may be completely
-bogus.
-
-=item *
-
-The following functions are currently unavailable: C<fork()>,
-C<dump()>, C<chown()>, C<link()>, C<symlink()>, C<chroot()>,
-C<setpgrp()>, C<getpgrp()>, C<setpriority()>, C<getpriority()>,
-C<syscall()>, C<fcntl()>. This list is possibly very incomplete.
-
-=item *
-
-crypt() is not available due to silly export restrictions. It may
-become available when the laws change. Meanwhile, look in CPAN for
-extensions that provide it.
-
-=item *
-
-Various C<socket()> related calls are supported, but they may not
-behave as on Unix platforms.
-
-=item *
-
-The four-argument C<select()> call is only supported on sockets.
-
-=item *
-
-C<$?> ends up with the exitstatus of the subprocess (this is different
-from Unix, where the exitstatus is actually given by "$? >> 8").
-Failure to spawn() the subprocess is indicated by setting $? to
-"255<<8". This is subject to change.
-
-=item *
-
-Building modules available on CPAN is mostly supported, but this
-hasn't been tested much yet. Expect strange problems, and be
-prepared to deal with the consequences.
-
-=item *
-
-C<utime()>, C<times()> and process-related functions may not
-behave as described in the documentation, and some of the
-returned values or effects may be bogus.
-
-=item *
-
-Signal handling may not behave as on Unix platforms (where it
-doesn't exactly "behave", either :). For instance, calling C<die()>
-or C<exit()> from signal handlers will cause an exception, since most
-implementations of C<signal()> on Win32 are severely crippled.
-Thus, signals may work only for simple things like setting a flag
-variable in the handler. Using signals under this port should
-currently be considered unsupported.
-
-=item *
-
-File globbing may not behave as on Unix platforms. In particular,
-if you don't use perlglob.bat for globbing, it will understand
-wildcards only in the filename component (and not in the pathname).
-In other words, something like "print <*/*.pl>" will not print all the
-perl scripts in all the subdirectories one level under the current one
-(like it does on UNIX platforms). perlglob.exe is also dependent on
-the particular implementation of wildcard expansion in the vendor
-libraries used to build it (which varies wildly at the present time).
-Using perlglob.bat (or File::DosGlob) avoids these limitations, but
-still only provides DOS semantics (read "warts") for globbing.
-
-=back
-
-Please send detailed descriptions of any problems and solutions that
-you may find to <F<perlbug@perl.com>>, along with the output produced
-by C<perl -V>.
-
-=head1 AUTHORS
-
-=over 4
-
-Gary Ng E<lt>71564.1743@CompuServe.COME<gt>
-
-Gurusamy Sarathy E<lt>gsar@umich.eduE<gt>
-
-Nick Ing-Simmons E<lt>nick@ni-s.u-net.comE<gt>
-
-=back
-
-This document is maintained by Gurusamy Sarathy.
-
-=head1 SEE ALSO
-
-L<perl>
-
-=head1 HISTORY
-
-This port was originally contributed by Gary Ng around 5.003_24,
-and borrowed from the Hip Communications port that was available
-at the time.
-
-Nick Ing-Simmons and Gurusamy Sarathy have made numerous and
-sundry hacks since then.
-
-Borland support was added in 5.004_01 (Gurusamy Sarathy).
-
-Last updated: 25 July 1997
-
-=cut
-
+If you read this file _as_is_, just ignore the funny characters you
+see. It is written in the POD format (see pod/perlpod.pod) which is
+specially designed to be readable as is.
+
+=head1 NAME
+
+perlwin32 - Perl under Win32
+
+=head1 SYNOPSIS
+
+These are instructions for building Perl under Windows NT (versions
+3.51 or 4.0). Currently, this port is reported to build
+under Windows95 using the 4DOS shell--the default shell that infests
+Windows95 will not work (see below). Note this caveat is only about
+B<building> perl. Once built, you should be able to B<use> it on
+either Win32 platform (modulo the problems arising from the inferior
+command shell).
+
+=head1 DESCRIPTION
+
+Before you start, you should glance through the README file
+found in the top-level directory where the Perl distribution
+was extracted. Make sure you read and understand the terms under
+which this software is being distributed.
+
+Also make sure you read L<BUGS AND CAVEATS> below for the
+known limitations of this port.
+
+The INSTALL file in the perl top-level has much information that is
+only relevant to people building Perl on Unix-like systems. In
+particular, you can safely ignore any information that talks about
+"Configure".
+
+You may also want to look at two other options for building
+a perl that will work on Windows NT: the README.cygwin32 and
+README.os2 files, which each give a different set of rules to build
+a Perl that will work on Win32 platforms. Those two methods will
+probably enable you to build a more Unix-compatible perl, but you
+will also need to download and use various other build-time and
+run-time support software described in those files.
+
+This set of instructions is meant to describe a so-called "native"
+port of Perl to Win32 platforms. The resulting Perl requires no
+additional software to run (other than what came with your operating
+system). Currently, this port is capable of using one of the
+following compilers:
+
+ Borland C++ version 5.02 or later
+ Microsoft Visual C++ version 4.2 or later
+ Mingw32 with EGCS versions 1.0.2, 1.1
+ Mingw32 with GCC version 2.8.1
+
+The last two of these are high quality freeware compilers. Support
+for them is still experimental.
+
+This port currently supports MakeMaker (the set of modules that
+is used to build extensions to perl). Therefore, you should be
+able to build and install most extensions found in the CPAN sites.
+See L<Usage Hints> below for general hints about this.
+
+=head2 Setting Up
+
+=over 4
+
+=item Command Shell
+
+Use the default "cmd" shell that comes with NT. Some versions of the
+popular 4DOS/NT shell have incompatibilities that may cause you trouble.
+If the build fails under that shell, try building again with the cmd
+shell. The Makefile also has known incompatibilites with the "command.com"
+shell that comes with Windows95, so building under Windows95 should
+be considered "unsupported". However, there have been reports of successful
+build attempts using 4DOS/NT version 6.01 under Windows95, using dmake, but
+your mileage may vary.
+
+The surest way to build it is on WindowsNT, using the cmd shell.
+
+Make sure the path to the build directory does not contain spaces. The
+build usually works in this circumstance, but some tests will fail.
+
+=item Borland C++
+
+If you are using the Borland compiler, you will need dmake, a freely
+available make that has very nice macro features and parallelability.
+(The make that Borland supplies is seriously crippled, and will not
+work for MakeMaker builds.)
+
+A port of dmake for win32 platforms is available from:
+
+ http://www-personal.umich.edu/~gsar/dmake-4.1-win32.zip
+
+Fetch and install dmake somewhere on your path (follow the instructions
+in the README.NOW file).
+
+=item Microsoft Visual C++
+
+The NMAKE that comes with Visual C++ will suffice for building.
+You will need to run the VCVARS32.BAT file usually found somewhere
+like C:\MSDEV4.2\BIN. This will set your build environment.
+
+You can also use dmake to build using Visual C++, provided:
+you set OSRELEASE to "microsft" (or whatever the directory name
+under which the Visual C dmake configuration lives) in your environment,
+and edit win32/config.vc to change "make=nmake" into "make=dmake". The
+latter step is only essential if you want to use dmake as your default
+make for building extensions using MakeMaker.
+
+=item Mingw32 with EGCS or GCC
+
+ECGS binaries can be downloaded from:
+
+ ftp://ftp.xraylith.wisc.edu/pub/khan/gnu-win32/mingw32/
+
+GCC-2.8.1 binaries are available from:
+
+ http://agnes.dida.physik.uni-essen.de/~janjaap/mingw32/
+
+You only need either one of those, not both. Both bundles come with
+Mingw32 libraries and headers. While both of them work to build perl,
+the EGCS binaries are currently favored by the maintainers, since they
+come with more up-to-date Mingw32 libraries.
+
+Make sure you install the binaries as indicated in the web sites
+above. You will need to set up a few environment variables (usually
+run from a batch file).
+
+You also need dmake. See L</"Borland C++"> above on how to get it.
+
+=back
+
+=head2 Building
+
+=over 4
+
+=item *
+
+Make sure you are in the "win32" subdirectory under the perl toplevel.
+This directory contains a "Makefile" that will work with
+versions of NMAKE that come with Visual C++, and a dmake "makefile.mk"
+that will work for all supported compilers. The defaults in the dmake
+makefile are setup to build using the Borland compiler.
+
+=item *
+
+Edit the makefile.mk (or Makefile, if using nmake) and change the values
+of INST_DRV and INST_TOP. You can also enable various build
+flags.
+
+Beginning with version 5.005, there is experimental support for building
+a perl interpreter that supports the Perl Object abstraction (courtesy
+ActiveState Tool Corp.) PERL_OBJECT uses C++, and the binaries are
+therefore incompatible with the regular C build. However, the
+PERL_OBJECT build does provide something called the C-API, for linking
+it with extensions that won't compile under PERL_OBJECT. Using the C_API
+is typically requested through:
+
+ perl Makefile.PL CAPI=TRUE
+
+PERL_OBJECT requires VC++ 5.0 (Service Pack 3 recommended) or later. It
+is not yet supported under GCC or EGCS. WARNING: Binaries built with
+PERL_OBJECT enabled are B<not> compatible with binaries built without.
+Perl installs PERL_OBJECT binaries under a distinct architecture name,
+so they B<can> coexist, though.
+
+Beginning with version 5.005, there is experimental support for building
+a perl interpreter that is capable of native threading. Binaries built
+with thread support enabled are also incompatible with the vanilla C
+build. WARNING: Binaries built with threads enabled are B<not> compatible
+with binaries built without. Perl installs threads enabled binaries under
+a distinct architecture name, so they B<can> coexist, though.
+
+At the present time, you cannot enable both threading and PERL_OBJECT.
+You can get only one of them in a Perl interpreter.
+
+If you have either the source or a library that contains des_fcrypt(),
+enable the appropriate option in the makefile. des_fcrypt() is not
+bundled with the distribution due to US Government restrictions
+on the export of cryptographic software. Nevertheless, this routine
+is part of the "libdes" library (written by Ed Young) which is widely
+available worldwide, usually along with SSLeay (for example:
+"ftp://fractal.mta.ca/pub/crypto/SSLeay/DES/"). Set CRYPT_SRC to the
+name of the file that implements des_fcrypt(). Alternatively, if
+you have built a library that contains des_fcrypt(), you can set
+CRYPT_LIB to point to the library name. The location above contains
+many versions of the "libdes" library, all with slightly different
+implementations of des_fcrypt(). Older versions have a single,
+self-contained file (fcrypt.c) that implements crypt(), so they may be
+easier to use. A patch against the fcrypt.c found in libdes-3.06 is
+in des_fcrypt.patch.
+
+Perl will also build without des_fcrypt(), but the crypt() builtin will
+fail at run time.
+
+You will also have to make sure CCHOME points to wherever you installed
+your compiler.
+
+The default value for CCHOME in the makefiles for Visual C++
+may not be correct for some versions. Make sure the default exists
+and is valid.
+
+Other options are explained in the makefiles. Be sure to read the
+instructions carefully.
+
+=item *
+
+Type "dmake" (or "nmake" if you are using that make).
+
+This should build everything. Specifically, it will create perl.exe,
+perl.dll (or perlcore.dll), and perlglob.exe at the perl toplevel, and
+various other extension dll's under the lib\auto directory. If the build
+fails for any reason, make sure you have done the previous steps correctly.
+
+The build process may produce "harmless" compiler warnings (more or
+less copiously, depending on how picky your compiler gets). The
+maintainers are aware of these warnings, thankyouverymuch. :)
+
+When building using Visual C++, a perl95.exe will also get built. This
+executable is only needed on Windows95, and should be used instead of
+perl.exe, and then only if you want sockets to work properly on Windows95.
+This is necessitated by a bug in the Microsoft C Runtime that cannot be
+worked around in the "normal" perl.exe. perl95.exe gets built with its
+own private copy of the C Runtime that is not accessible to extensions
+(which see the DLL version of the CRT). Be aware, therefore, that this
+perl95.exe will have esoteric problems with extensions like perl/Tk that
+themselves use the C Runtime heavily, or want to free() pointers
+malloc()-ed by perl.
+
+You can avoid the perl95.exe problems completely if you either enable
+USE_PERLCRT with Visual C++, or use Borland C++ for building perl. In
+those cases, perl95.exe is not needed and will not be built.
+
+=back
+
+=head2 Testing
+
+Type "dmake test" (or "nmake test"). This will run most of the tests from
+the testsuite (many tests will be skipped, and but no test should fail).
+
+If some tests do fail, it may be because you are using a different command
+shell than the native "cmd.exe", or because you are building from a path
+that contains spaces. So don't do that.
+
+If you are running the tests from a emacs shell window, you may see
+failures in op/stat.t. Run "dmake test-notty" in that case.
+
+If you're using the Borland compiler, you may see a failure in op/taint.t
+arising from the inability to find the Borland Runtime DLLs on the system
+default path. You will need to copy the DLLs reported by the messages
+from where Borland chose to install it, into the Windows system directory
+(usually somewhere like C:\WINNT\SYSTEM32), and rerun the test.
+
+The Visual C runtime apparently has a bug that causes posix.t to fail
+test#2. This usually happens only if you extracted the files in text
+mode. Enable the USE_PERLCRT option in the Makefile to fix this bug.
+
+Please report any other failures as described under L<BUGS AND CAVEATS>.
+
+=head2 Installation
+
+Type "dmake install" (or "nmake install"). This will put the newly
+built perl and the libraries under whatever C<INST_TOP> points to in the
+Makefile. It will also install the pod documentation under
+C<$INST_TOP\$VERSION\lib\pod> and HTML versions of the same under
+C<$INST_TOP\$VERSION\lib\pod\html>. To use the Perl you just installed,
+you will need to add two components to your PATH environment variable,
+C<$INST_TOP\$VERSION\bin>, and C<$INST_TOP\$VERSION\bin\$ARCHNAME>.
+For example:
+
+ set PATH c:\perl\5.005\bin;c:\perl\5.005\bin\MSWin32-x86;%PATH%
+
+
+=head2 Usage Hints
+
+=over 4
+
+=item Environment Variables
+
+The installation paths that you set during the build get compiled
+into perl, so you don't have to do anything additional to start
+using that perl (except add its location to your PATH variable).
+
+If you put extensions in unusual places, you can set PERL5LIB
+to a list of paths separated by semicolons where you want perl
+to look for libraries. Look for descriptions of other environment
+variables you can set in L<perlrun>.
+
+You can also control the shell that perl uses to run system() and
+backtick commands via PERL5SHELL. See L<perlrun>.
+
+Perl does not depend on the registry, but it can look up certain default
+values if you choose to put them there. Perl attempts to read entries from
+C<HKEY_CURRENT_USER\Software\Perl> and C<HKEY_LOCAL_MACHINE\Software\Perl>.
+Entries in the former override entries in the latter. One or more of the
+following entries (of type REG_SZ or REG_EXPAND_SZ) may be set:
+
+ lib-$] version-specific path to add to @INC
+ lib path to add to @INC
+ sitelib-$] version-specific path to add to @INC
+ sitelib path to add to @INC
+ PERL* fallback for all %ENV lookups that begin with "PERL"
+
+Note the C<$]> in the above is not literal. Substitute whatever version
+of perl you want to honor that entry, e.g. C<5.00502>. Paths must be
+separated with semicolons, as usual on win32.
+
+=item File Globbing
+
+By default, perl spawns an external program to do file globbing.
+The install process installs both a perlglob.exe and a perlglob.bat
+that perl can use for this purpose. Note that with the default
+installation, perlglob.exe will be found by the system before
+perlglob.bat.
+
+perlglob.exe relies on the argv expansion done by the C Runtime of
+the particular compiler you used, and therefore behaves very
+differently depending on the Runtime used to build it. To preserve
+compatiblity, perlglob.bat (a perl script that can be used portably)
+is installed. Besides being portable, perlglob.bat also offers
+enhanced globbing functionality.
+
+If you want perl to use perlglob.bat instead of perlglob.exe, just
+delete perlglob.exe from the install location (or move it somewhere
+perl cannot find). Using File::DosGlob.pm (which implements the core
+functionality of perlglob.bat) to override the internal CORE::glob()
+works about 10 times faster than spawing perlglob.exe, and you should
+take this approach when writing new modules. See File::DosGlob for
+details.
+
+=item Using perl from the command line
+
+If you are accustomed to using perl from various command-line
+shells found in UNIX environments, you will be less than pleased
+with what Windows NT offers by way of a command shell.
+
+The crucial thing to understand about the "cmd" shell (which is
+the default on Windows NT) is that it does not do any wildcard
+expansions of command-line arguments (so wildcards need not be
+quoted). It also provides only rudimentary quoting. The only
+(useful) quote character is the double quote ("). It can be used to
+protect spaces in arguments and other special characters. The
+Windows NT documentation has almost no description of how the
+quoting rules are implemented, but here are some general observations
+based on experiments: The shell breaks arguments at spaces and
+passes them to programs in argc/argv. Doublequotes can be used
+to prevent arguments with spaces in them from being split up.
+You can put a double quote in an argument by escaping it with
+a backslash and enclosing the whole argument within double quotes.
+The backslash and the pair of double quotes surrounding the
+argument will be stripped by the shell.
+
+The file redirection characters "<", ">", and "|" cannot be quoted
+by double quotes (there are probably more such). Single quotes
+will protect those three file redirection characters, but the
+single quotes don't get stripped by the shell (just to make this
+type of quoting completely useless). The caret "^" has also
+been observed to behave as a quoting character (and doesn't get
+stripped by the shell also).
+
+Here are some examples of usage of the "cmd" shell:
+
+This prints two doublequotes:
+
+ perl -e "print '\"\"' "
+
+This does the same:
+
+ perl -e "print \"\\\"\\\"\" "
+
+This prints "bar" and writes "foo" to the file "blurch":
+
+ perl -e "print 'foo'; print STDERR 'bar'" > blurch
+
+This prints "foo" ("bar" disappears into nowhereland):
+
+ perl -e "print 'foo'; print STDERR 'bar'" 2> nul
+
+This prints "bar" and writes "foo" into the file "blurch":
+
+ perl -e "print 'foo'; print STDERR 'bar'" 1> blurch
+
+This pipes "foo" to the "less" pager and prints "bar" on the console:
+
+ perl -e "print 'foo'; print STDERR 'bar'" | less
+
+This pipes "foo\nbar\n" to the less pager:
+
+ perl -le "print 'foo'; print STDERR 'bar'" 2>&1 | less
+
+This pipes "foo" to the pager and writes "bar" in the file "blurch":
+
+ perl -e "print 'foo'; print STDERR 'bar'" 2> blurch | less
+
+
+Discovering the usefulness of the "command.com" shell on Windows95
+is left as an exercise to the reader :)
+
+=item Building Extensions
+
+The Comprehensive Perl Archive Network (CPAN) offers a wealth
+of extensions, some of which require a C compiler to build.
+Look in http://www.perl.com/ for more information on CPAN.
+
+Most extensions (whether they require a C compiler or not) can
+be built, tested and installed with the standard mantra:
+
+ perl Makefile.PL
+ $MAKE
+ $MAKE test
+ $MAKE install
+
+where $MAKE is whatever 'make' program you have configured perl to
+use. Use "perl -V:make" to find out what this is. Some extensions
+may not provide a testsuite (so "$MAKE test" may not do anything, or
+fail), but most serious ones do.
+
+It is important that you use a supported 'make' program, and
+ensure Config.pm knows about it. If you don't have nmake, you can
+either get dmake from the location mentioned earlier, or get an
+old version of nmake reportedly available from:
+
+ ftp://ftp.microsoft.com/Softlib/MSLFILES/nmake15.exe
+
+Another option is to use the make written in Perl, available from
+CPAN:
+
+ http://www.perl.com/CPAN/authors/id/NI-S/Make-0.03.tar.gz
+
+Note that MakeMaker actually emits makefiles with different syntax
+depending on what 'make' it thinks you are using. Therefore, it is
+important that one of the following values appears in Config.pm:
+
+ make='nmake' # MakeMaker emits nmake syntax
+ make='dmake' # MakeMaker emits dmake syntax
+ any other value # MakeMaker emits generic make syntax
+ (e.g GNU make, or Perl make)
+
+If the value doesn't match the 'make' program you want to use,
+edit Config.pm to fix it.
+
+If a module implements XSUBs, you will need one of the supported
+C compilers. You must make sure you have set up the environment for
+the compiler for command-line compilation.
+
+If a module does not build for some reason, look carefully for
+why it failed, and report problems to the module author. If
+it looks like the extension building support is at fault, report
+that with full details of how the build failed using the perlbug
+utility.
+
+=item Command-line Wildcard Expansion
+
+The default command shells on DOS descendant operating systems (such
+as they are) usually do not expand wildcard arguments supplied to
+programs. They consider it the application's job to handle that.
+This is commonly achieved by linking the application (in our case,
+perl) with startup code that the C runtime libraries usually provide.
+However, doing that results in incompatible perl versions (since the
+behavior of the argv expansion code differs depending on the
+compiler, and it is even buggy on some compilers). Besides, it may
+be a source of frustration if you use such a perl binary with an
+alternate shell that *does* expand wildcards.
+
+Instead, the following solution works rather well. The nice things
+about it: 1) you can start using it right away 2) it is more powerful,
+because it will do the right thing with a pattern like */*/*.c
+3) you can decide whether you do/don't want to use it 4) you can
+extend the method to add any customizations (or even entirely
+different kinds of wildcard expansion).
+
+ C:\> copy con c:\perl\lib\Wild.pm
+ # Wild.pm - emulate shell @ARGV expansion on shells that don't
+ use File::DosGlob;
+ @ARGV = map {
+ my @g = File::DosGlob::glob($_) if /[*?]/;
+ @g ? @g : $_;
+ } @ARGV;
+ 1;
+ ^Z
+ C:\> set PERL5OPT=-MWild
+ C:\> perl -le "for (@ARGV) { print }" */*/perl*.c
+ p4view/perl/perl.c
+ p4view/perl/perlio.c
+ p4view/perl/perly.c
+ perl5.005/win32/perlglob.c
+ perl5.005/win32/perllib.c
+ perl5.005/win32/perlglob.c
+ perl5.005/win32/perllib.c
+ perl5.005/win32/perlglob.c
+ perl5.005/win32/perllib.c
+
+Note there are two distinct steps there: 1) You'll have to create
+Wild.pm and put it in your perl lib directory. 2) You'll need to
+set the PERL5OPT environment variable. If you want argv expansion
+to be the default, just set PERL5OPT in your default startup
+environment.
+
+If you are using the Visual C compiler, you can get the C runtime's
+command line wildcard expansion built into perl binary. The resulting
+binary will always expand unquoted command lines, which may not be
+what you want if you use a shell that does that for you. The expansion
+done is also somewhat less powerful than the approach suggested above.
+
+=item Win32 Specific Extensions
+
+A number of extensions specific to the Win32 platform are available
+from CPAN. You may find that many of these extensions are meant to
+be used under the Activeware port of Perl, which used to be the only
+native port for the Win32 platform. Since the Activeware port does not
+have adequate support for Perl's extension building tools, these
+extensions typically do not support those tools either, and therefore
+cannot be built using the generic steps shown in the previous section.
+
+To ensure smooth transitioning of existing code that uses the
+ActiveState port, there is a bundle of Win32 extensions that contains
+all of the ActiveState extensions and most other Win32 extensions from
+CPAN in source form, along with many added bugfixes, and with MakeMaker
+support. This bundle is available at:
+
+ http://www.perl.com/CPAN/authors/id/GSAR/libwin32-0.14.zip
+
+See the README in that distribution for building and installation
+instructions. Look for later versions that may be available at the
+same location.
+
+=item Running Perl Scripts
+
+Perl scripts on UNIX use the "#!" (a.k.a "shebang") line to
+indicate to the OS that it should execute the file using perl.
+Win32 has no comparable means to indicate arbitrary files are
+executables.
+
+Instead, all available methods to execute plain text files on
+Win32 rely on the file "extension". There are three methods
+to use this to execute perl scripts:
+
+=over 8
+
+=item 1
+
+There is a facility called "file extension associations" that will
+work in Windows NT 4.0. This can be manipulated via the two
+commands "assoc" and "ftype" that come standard with Windows NT
+4.0. Type "ftype /?" for a complete example of how to set this
+up for perl scripts (Say what? You thought Windows NT wasn't
+perl-ready? :).
+
+=item 2
+
+Since file associations don't work everywhere, and there are
+reportedly bugs with file associations where it does work, the
+old method of wrapping the perl script to make it look like a
+regular batch file to the OS, may be used. The install process
+makes available the "pl2bat.bat" script which can be used to wrap
+perl scripts into batch files. For example:
+
+ pl2bat foo.pl
+
+will create the file "FOO.BAT". Note "pl2bat" strips any
+.pl suffix and adds a .bat suffix to the generated file.
+
+If you use the 4DOS/NT or similar command shell, note that
+"pl2bat" uses the "%*" variable in the generated batch file to
+refer to all the command line arguments, so you may need to make
+sure that construct works in batch files. As of this writing,
+4DOS/NT users will need a "ParameterChar = *" statement in their
+4NT.INI file, or will need to execute "setdos /p*" in the 4DOS/NT
+startup file to enable this to work.
+
+=item 3
+
+Using "pl2bat" has a few problems: the file name gets changed,
+so scripts that rely on C<$0> to find what they must do may not
+run properly; running "pl2bat" replicates the contents of the
+original script, and so this process can be maintenance intensive
+if the originals get updated often. A different approach that
+avoids both problems is possible.
+
+A script called "runperl.bat" is available that can be copied
+to any filename (along with the .bat suffix). For example,
+if you call it "foo.bat", it will run the file "foo" when it is
+executed. Since you can run batch files on Win32 platforms simply
+by typing the name (without the extension), this effectively
+runs the file "foo", when you type either "foo" or "foo.bat".
+With this method, "foo.bat" can even be in a different location
+than the file "foo", as long as "foo" is available somewhere on
+the PATH. If your scripts are on a filesystem that allows symbolic
+links, you can even avoid copying "runperl.bat".
+
+Here's a diversion: copy "runperl.bat" to "runperl", and type
+"runperl". Explain the observed behavior, or lack thereof. :)
+Hint: .gnidnats llits er'uoy fi ,"lrepnur" eteled :tniH
+
+=back
+
+=item Miscellaneous Things
+
+A full set of HTML documentation is installed, so you should be
+able to use it if you have a web browser installed on your
+system.
+
+C<perldoc> is also a useful tool for browsing information contained
+in the documentation, especially in conjunction with a pager
+like C<less> (recent versions of which have Win32 support). You may
+have to set the PAGER environment variable to use a specific pager.
+"perldoc -f foo" will print information about the perl operator
+"foo".
+
+If you find bugs in perl, you can run C<perlbug> to create a
+bug report (you may have to send it manually if C<perlbug> cannot
+find a mailer on your system).
+
+=back
+
+=head1 BUGS AND CAVEATS
+
+An effort has been made to ensure that the DLLs produced by the two
+supported compilers are compatible with each other (despite the
+best efforts of the compiler vendors). Extension binaries produced
+by one compiler should also coexist with a perl binary built by
+a different compiler. In order to accomplish this, PERL.DLL provides
+a layer of runtime code that uses the C Runtime that perl was compiled
+with. Extensions which include "perl.h" will transparently access
+the functions in this layer, thereby ensuring that both perl and
+extensions use the same runtime functions.
+
+If you have had prior exposure to Perl on Unix platforms, you will notice
+this port exhibits behavior different from what is documented. Most of the
+differences fall under one of these categories. We do not consider
+any of them to be serious limitations (especially when compared to the
+limited nature of some of the Win32 OSes themselves :)
+
+=over 8
+
+=item *
+
+C<stat()> and C<lstat()> functions may not behave as documented. They
+may return values that bear no resemblance to those reported on Unix
+platforms, and some fields (like the the one for inode) may be completely
+bogus.
+
+=item *
+
+The following functions are currently unavailable: C<fork()>,
+C<dump()>, C<chown()>, C<link()>, C<symlink()>, C<chroot()>,
+C<setpgrp()> and related security functions, C<setpriority()>,
+C<getpriority()>, C<syscall()>, C<fcntl()>, C<getpw*()>,
+C<msg*()>, C<shm*()>, C<sem*()>, C<alarm()>, C<socketpair()>,
+C<*netent()>, C<*protoent()>, C<*servent()>, C<*hostent()>,
+C<getnetby*()>.
+This list is possibly incomplete.
+
+=item *
+
+Various C<socket()> related calls are supported, but they may not
+behave as on Unix platforms.
+
+=item *
+
+The four-argument C<select()> call is only supported on sockets.
+
+=item *
+
+The C<ioctl()> call is only supported on sockets (where it provides the
+functionality of ioctlsocket() in the Winsock API).
+
+=item *
+
+Failure to spawn() a subprocess is indicated by setting $? to "255 << 8".
+C<$?> is set in a way compatible with Unix (i.e. the exitstatus of the
+subprocess is obtained by "$? >> 8", as described in the documentation).
+
+=item *
+
+You can expect problems building modules available on CPAN if you
+build perl itself with -DUSE_THREADS. These problems should be resolved
+as we get closer to 5.005.
+
+=item *
+
+C<utime()>, C<times()> and process-related functions may not
+behave as described in the documentation, and some of the
+returned values or effects may be bogus.
+
+=item *
+
+Signal handling may not behave as on Unix platforms (where it
+doesn't exactly "behave", either :). For instance, calling C<die()>
+or C<exit()> from signal handlers will cause an exception, since most
+implementations of C<signal()> on Win32 are severely crippled.
+Thus, signals may work only for simple things like setting a flag
+variable in the handler. Using signals under this port should
+currently be considered unsupported.
+
+=item *
+
+C<kill()> is implemented, but doesn't have the semantics of
+C<raise()>, i.e. it doesn't send a signal to the identified process
+like it does on Unix platforms. Instead it immediately calls
+C<TerminateProcess(process,signal)>. Thus the signal argument is
+used to set the exit-status of the terminated process. This behavior
+may change in future.
+
+=item *
+
+File globbing may not behave as on Unix platforms. In particular,
+if you don't use perlglob.bat for globbing, it will understand
+wildcards only in the filename component (and not in the pathname).
+In other words, something like "print <*/*.pl>" will not print all the
+perl scripts in all the subdirectories one level under the current one
+(like it does on UNIX platforms). perlglob.exe is also dependent on
+the particular implementation of wildcard expansion in the vendor
+libraries used to build it (which varies wildly at the present time).
+Using perlglob.bat (or File::DosGlob) avoids these limitations, but
+still only provides DOS semantics (read "warts") for globbing.
+
+=back
+
+Please send detailed descriptions of any problems and solutions that
+you may find to <F<perlbug@perl.com>>, along with the output produced
+by C<perl -V>.
+
+=head1 AUTHORS
+
+=over 4
+
+Gary Ng E<lt>71564.1743@CompuServe.COME<gt>
+
+Gurusamy Sarathy E<lt>gsar@umich.eduE<gt>
+
+Nick Ing-Simmons E<lt>nick@ni-s.u-net.comE<gt>
+
+=back
+
+This document is maintained by Gurusamy Sarathy.
+
+=head1 SEE ALSO
+
+L<perl>
+
+=head1 HISTORY
+
+This port was originally contributed by Gary Ng around 5.003_24,
+and borrowed from the Hip Communications port that was available
+at the time.
+
+Nick Ing-Simmons and Gurusamy Sarathy have made numerous and
+sundry hacks since then.
+
+Borland support was added in 5.004_01 (Gurusamy Sarathy).
+
+GCC/mingw32 support was added in 5.005 (Nick Ing-Simmons).
+
+Support for PERL_OBJECT was added in 5.005 (ActiveState Tool Corp).
+
+Last updated: 18 January 1999
+
+=cut
+
diff --git a/gnu/usr.bin/perl/Todo b/gnu/usr.bin/perl/Todo
index 627045c9520..5867c406805 100644
--- a/gnu/usr.bin/perl/Todo
+++ b/gnu/usr.bin/perl/Todo
@@ -10,9 +10,8 @@ Would be nice to have
lexperl
Bundled perl preprocessor
Use posix calls internally where possible
- gettimeofday
+ gettimeofday (possibly best left for a module?)
format BOTTOM
- -iprefix.
-i rename file only when successfully changed
All ARGV input should act like <>
report HANDLE [formats].
@@ -21,6 +20,10 @@ Would be nice to have
reference to compiled regexp
lexically scoped functions: my sub foo { ... }
lvalue functions
+ regression/sanity tests for suidperl
+ Full 64 bit support (i.e. "long long")
+ Generalise Errno way of extracting cpp symbols and use that in
+ Errno and Fcntl (ExtUtils::CppSymbol?)
Possible pragmas
debugger
@@ -30,7 +33,6 @@ Optimizations
constant function cache
switch structures
eval qw() at compile time
- foreach (1..1000000)
foreach(reverse...)
Set KEEP on constant split
Cache eval tree (unless lexical outer scope used (mark in &compiling?))
@@ -45,7 +47,6 @@ Optimizations
Vague possibilities
ref function in list context
- data prettyprint function? (or is it, as I suspect, a lib routine?)
make tr/// return histogram in list context?
Loop control on do{} et al
Explicit switch statements
@@ -54,5 +55,4 @@ Vague possibilities
structured types
autocroak?
Modifiable $1 et al
- substr EXPR,OFFSET,LENGTH,STRING
diff --git a/gnu/usr.bin/perl/XSUB.h b/gnu/usr.bin/perl/XSUB.h
index 0b82a270b46..a6577d8fdcf 100644
--- a/gnu/usr.bin/perl/XSUB.h
+++ b/gnu/usr.bin/perl/XSUB.h
@@ -1,30 +1,48 @@
-#define ST(off) stack_base[ax + (off)]
+#define ST(off) PL_stack_base[ax + (off)]
#ifdef CAN_PROTOTYPE
+#ifdef PERL_OBJECT
+#define XS(name) void name(CV* cv, CPerlObj* pPerl)
+#else
#define XS(name) void name(CV* cv)
+#endif
#else
#define XS(name) void name(cv) CV* cv;
#endif
#define dXSARGS \
dSP; dMARK; \
- I32 ax = mark - stack_base + 1; \
+ I32 ax = mark - PL_stack_base + 1; \
I32 items = sp - mark
#define XSANY CvXSUBANY(cv)
#define dXSI32 I32 ix = XSANY.any_i32
-#define XSRETURN(off) stack_sp = stack_base + ax + ((off) - 1); return
+#ifdef __cplusplus
+# define XSINTERFACE_CVT(ret,name) ret (*name)(...)
+#else
+# define XSINTERFACE_CVT(ret,name) ret (*name)()
+#endif
+#define dXSFUNCTION(ret) XSINTERFACE_CVT(ret,XSFUNCTION)
+#define XSINTERFACE_FUNC(ret,cv,f) ((XSINTERFACE_CVT(ret,))(f))
+#define XSINTERFACE_FUNC_SET(cv,f) \
+ CvXSUBANY(cv).any_dptr = (void (*) _((void*)))(f)
+
+#define XSRETURN(off) \
+ STMT_START { \
+ PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
+ return; \
+ } STMT_END
/* Simple macros to put new mortal values onto the stack. */
/* Typically used to return values from XS functions. */
#define XST_mIV(i,v) (ST(i) = sv_2mortal(newSViv(v)) )
#define XST_mNV(i,v) (ST(i) = sv_2mortal(newSVnv(v)) )
#define XST_mPV(i,v) (ST(i) = sv_2mortal(newSVpv(v,0)))
-#define XST_mNO(i) (ST(i) = &sv_no )
-#define XST_mYES(i) (ST(i) = &sv_yes )
-#define XST_mUNDEF(i) (ST(i) = &sv_undef)
+#define XST_mNO(i) (ST(i) = &PL_sv_no )
+#define XST_mYES(i) (ST(i) = &PL_sv_yes )
+#define XST_mUNDEF(i) (ST(i) = &PL_sv_undef)
#define XSRETURN_IV(v) STMT_START { XST_mIV(0,v); XSRETURN(1); } STMT_END
#define XSRETURN_NV(v) STMT_START { XST_mNV(0,v); XSRETURN(1); } STMT_END
@@ -39,21 +57,101 @@
#ifdef XS_VERSION
# define XS_VERSION_BOOTCHECK \
STMT_START { \
- char *vn = "", *module = SvPV(ST(0),na); \
+ SV *tmpsv; STRLEN n_a; \
+ char *vn = Nullch, *module = SvPV(ST(0),n_a); \
if (items >= 2) /* version supplied as bootstrap arg */ \
- Sv = ST(1); \
+ tmpsv = ST(1); \
else { \
/* XXX GV_ADDWARN */ \
- Sv = perl_get_sv(form("%s::%s", module, \
+ tmpsv = perl_get_sv(form("%s::%s", module, \
vn = "XS_VERSION"), FALSE); \
- if (!Sv || !SvOK(Sv)) \
- Sv = perl_get_sv(form("%s::%s", module, \
+ if (!tmpsv || !SvOK(tmpsv)) \
+ tmpsv = perl_get_sv(form("%s::%s", module, \
vn = "VERSION"), FALSE); \
} \
- if (Sv && (!SvOK(Sv) || strNE(XS_VERSION, SvPV(Sv, na)))) \
- croak("%s object version %s does not match $%s::%s %_", \
- module, XS_VERSION, module, vn, Sv); \
+ if (tmpsv && (!SvOK(tmpsv) || strNE(XS_VERSION, SvPV(tmpsv, n_a)))) \
+ croak("%s object version %s does not match %s%s%s%s %_", \
+ module, XS_VERSION, \
+ vn ? "$" : "", vn ? module : "", vn ? "::" : "", \
+ vn ? vn : "bootstrap parameter", tmpsv); \
} STMT_END
#else
# define XS_VERSION_BOOTCHECK
#endif
+
+#ifdef PERL_CAPI
+# define VTBL_sv get_vtbl(want_vtbl_sv)
+# define VTBL_env get_vtbl(want_vtbl_env)
+# define VTBL_envelem get_vtbl(want_vtbl_envelem)
+# define VTBL_sig get_vtbl(want_vtbl_sig)
+# define VTBL_sigelem get_vtbl(want_vtbl_sigelem)
+# define VTBL_pack get_vtbl(want_vtbl_pack)
+# define VTBL_packelem get_vtbl(want_vtbl_packelem)
+# define VTBL_dbline get_vtbl(want_vtbl_dbline)
+# define VTBL_isa get_vtbl(want_vtbl_isa)
+# define VTBL_isaelem get_vtbl(want_vtbl_isaelem)
+# define VTBL_arylen get_vtbl(want_vtbl_arylen)
+# define VTBL_glob get_vtbl(want_vtbl_glob)
+# define VTBL_mglob get_vtbl(want_vtbl_mglob)
+# define VTBL_nkeys get_vtbl(want_vtbl_nkeys)
+# define VTBL_taint get_vtbl(want_vtbl_taint)
+# define VTBL_substr get_vtbl(want_vtbl_substr)
+# define VTBL_vec get_vtbl(want_vtbl_vec)
+# define VTBL_pos get_vtbl(want_vtbl_pos)
+# define VTBL_bm get_vtbl(want_vtbl_bm)
+# define VTBL_fm get_vtbl(want_vtbl_fm)
+# define VTBL_uvar get_vtbl(want_vtbl_uvar)
+# define VTBL_defelem get_vtbl(want_vtbl_defelem)
+# define VTBL_regexp get_vtbl(want_vtbl_regexp)
+# ifdef USE_LOCALE_COLLATE
+# define VTBL_collxfrm get_vtbl(want_vtbl_collxfrm)
+# endif
+# ifdef OVERLOAD
+# define VTBL_amagic get_vtbl(want_vtbl_amagic)
+# define VTBL_amagicelem get_vtbl(want_vtbl_amagicelem)
+# endif
+#else
+# define VTBL_sv &vtbl_sv
+# define VTBL_env &vtbl_env
+# define VTBL_envelem &vtbl_envelem
+# define VTBL_sig &vtbl_sig
+# define VTBL_sigelem &vtbl_sigelem
+# define VTBL_pack &vtbl_pack
+# define VTBL_packelem &vtbl_packelem
+# define VTBL_dbline &vtbl_dbline
+# define VTBL_isa &vtbl_isa
+# define VTBL_isaelem &vtbl_isaelem
+# define VTBL_arylen &vtbl_arylen
+# define VTBL_glob &vtbl_glob
+# define VTBL_mglob &vtbl_mglob
+# define VTBL_nkeys &vtbl_nkeys
+# define VTBL_taint &vtbl_taint
+# define VTBL_substr &vtbl_substr
+# define VTBL_vec &vtbl_vec
+# define VTBL_pos &vtbl_pos
+# define VTBL_bm &vtbl_bm
+# define VTBL_fm &vtbl_fm
+# define VTBL_uvar &vtbl_uvar
+# define VTBL_defelem &vtbl_defelem
+# define VTBL_regexp &vtbl_regexp
+# ifdef USE_LOCALE_COLLATE
+# define VTBL_collxfrm &vtbl_collxfrm
+# endif
+# ifdef OVERLOAD
+# define VTBL_amagic &vtbl_amagic
+# define VTBL_amagicelem &vtbl_amagicelem
+# endif
+#endif
+
+#ifdef PERL_OBJECT
+#include "objXSUB.h"
+#ifndef NO_XSLOCKS
+#ifdef WIN32
+#include "XSlock.h"
+#endif /* WIN32 */
+#endif /* NO_XSLOCKS */
+#else
+#ifdef PERL_CAPI
+#include "perlCAPI.h"
+#endif
+#endif /* PERL_OBJECT */
diff --git a/gnu/usr.bin/perl/av.c b/gnu/usr.bin/perl/av.c
index 4a87eaf2b51..76527579030 100644
--- a/gnu/usr.bin/perl/av.c
+++ b/gnu/usr.bin/perl/av.c
@@ -1,6 +1,6 @@
/* av.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -16,48 +16,70 @@
#include "perl.h"
void
-av_reify(av)
-AV* av;
+av_reify(AV *av)
{
I32 key;
SV* sv;
if (AvREAL(av))
return;
+#ifdef DEBUGGING
+ if (SvTIED_mg((SV*)av, 'P'))
+ warn("av_reify called on tied array");
+#endif
key = AvMAX(av) + 1;
- while (key > AvFILL(av) + 1)
- AvARRAY(av)[--key] = &sv_undef;
+ while (key > AvFILLp(av) + 1)
+ AvARRAY(av)[--key] = &PL_sv_undef;
while (key) {
sv = AvARRAY(av)[--key];
assert(sv);
- if (sv != &sv_undef)
+ if (sv != &PL_sv_undef) {
+ dTHR;
(void)SvREFCNT_inc(sv);
+ }
}
key = AvARRAY(av) - AvALLOC(av);
while (key)
- AvALLOC(av)[--key] = &sv_undef;
+ AvALLOC(av)[--key] = &PL_sv_undef;
+ AvREIFY_off(av);
AvREAL_on(av);
}
void
-av_extend(av,key)
-AV *av;
-I32 key;
+av_extend(AV *av, I32 key)
{
+ dTHR; /* only necessary if we have to extend stack */
+ MAGIC *mg;
+ if (mg = SvTIED_mg((SV*)av, 'P')) {
+ dSP;
+ ENTER;
+ SAVETMPS;
+ PUSHSTACKi(PERLSI_MAGIC);
+ PUSHMARK(SP);
+ EXTEND(SP,2);
+ PUSHs(SvTIED_obj((SV*)av, mg));
+ PUSHs(sv_2mortal(newSViv(key+1)));
+ PUTBACK;
+ perl_call_method("EXTEND", G_SCALAR|G_DISCARD);
+ POPSTACK;
+ FREETMPS;
+ LEAVE;
+ return;
+ }
if (key > AvMAX(av)) {
SV** ary;
I32 tmp;
I32 newmax;
if (AvALLOC(av) != AvARRAY(av)) {
- ary = AvALLOC(av) + AvFILL(av) + 1;
+ ary = AvALLOC(av) + AvFILLp(av) + 1;
tmp = AvARRAY(av) - AvALLOC(av);
- Move(AvARRAY(av), AvALLOC(av), AvFILL(av)+1, SV*);
+ Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
AvMAX(av) += tmp;
SvPVX(av) = (char*)AvALLOC(av);
if (AvREAL(av)) {
while (tmp)
- ary[--tmp] = &sv_undef;
+ ary[--tmp] = &PL_sv_undef;
}
if (key > AvMAX(av) - 10) {
@@ -71,9 +93,15 @@ I32 key;
U32 bytes;
#endif
+#if defined(MYMALLOC) && !defined(PURIFY) && !defined(LEAKTEST)
+ newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1;
+
+ if (key <= newmax)
+ goto resized;
+#endif
newmax = key + AvMAX(av) / 5;
resize:
-#ifdef STRANGE_MALLOC
+#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
Renew(AvALLOC(av),newmax+1, SV*);
#else
bytes = (newmax + 1) * sizeof(SV*);
@@ -87,32 +115,31 @@ I32 key;
newmax = tmp - 1;
New(2,ary, newmax+1, SV*);
Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
- if (AvMAX(av) > 64 && !nice_chunk) {
- nice_chunk = (char*)AvALLOC(av);
- nice_chunk_size = (AvMAX(av) + 1) * sizeof(SV*);
- }
+ if (AvMAX(av) > 64)
+ offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
else
Safefree(AvALLOC(av));
AvALLOC(av) = ary;
#endif
+ resized:
ary = AvALLOC(av) + AvMAX(av) + 1;
tmp = newmax - AvMAX(av);
- if (av == curstack) { /* Oops, grew stack (via av_store()?) */
- stack_sp = AvALLOC(av) + (stack_sp - stack_base);
- stack_base = AvALLOC(av);
- stack_max = stack_base + newmax;
+ if (av == PL_curstack) { /* Oops, grew stack (via av_store()?) */
+ PL_stack_sp = AvALLOC(av) + (PL_stack_sp - PL_stack_base);
+ PL_stack_base = AvALLOC(av);
+ PL_stack_max = PL_stack_base + newmax;
}
}
else {
- newmax = key < 4 ? 4 : key;
+ newmax = key < 3 ? 3 : key;
New(2,AvALLOC(av), newmax+1, SV*);
ary = AvALLOC(av) + 1;
tmp = newmax;
- AvALLOC(av)[0] = &sv_undef; /* For the stacks */
+ AvALLOC(av)[0] = &PL_sv_undef; /* For the stacks */
}
if (AvREAL(av)) {
while (tmp)
- ary[--tmp] = &sv_undef;
+ ary[--tmp] = &PL_sv_undef;
}
SvPVX(av) = (char*)AvALLOC(av);
@@ -122,40 +149,36 @@ I32 key;
}
SV**
-av_fetch(av,key,lval)
-register AV *av;
-I32 key;
-I32 lval;
+av_fetch(register AV *av, I32 key, I32 lval)
{
SV *sv;
if (!av)
return 0;
+ if (key < 0) {
+ key += AvFILL(av) + 1;
+ if (key < 0)
+ return 0;
+ }
+
if (SvRMAGICAL(av)) {
if (mg_find((SV*)av,'P')) {
+ dTHR;
sv = sv_newmortal();
mg_copy((SV*)av, sv, 0, key);
- Sv = sv;
- return &Sv;
+ PL_av_fetch_sv = sv;
+ return &PL_av_fetch_sv;
}
}
- if (key < 0) {
- key += AvFILL(av) + 1;
- if (key < 0)
- return 0;
- }
- else if (key > AvFILL(av)) {
+ if (key > AvFILLp(av)) {
if (!lval)
return 0;
- if (AvREALISH(av))
- sv = NEWSV(5,0);
- else
- sv = sv_newmortal();
+ sv = NEWSV(5,0);
return av_store(av,key,sv);
}
- if (AvARRAY(av)[key] == &sv_undef) {
+ if (AvARRAY(av)[key] == &PL_sv_undef) {
emptyness:
if (lval) {
sv = NEWSV(6,0);
@@ -166,60 +189,63 @@ I32 lval;
else if (AvREIFY(av)
&& (!AvARRAY(av)[key] /* eg. @_ could have freed elts */
|| SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) {
- AvARRAY(av)[key] = &sv_undef; /* 1/2 reify */
+ AvARRAY(av)[key] = &PL_sv_undef; /* 1/2 reify */
goto emptyness;
}
return &AvARRAY(av)[key];
}
SV**
-av_store(av,key,val)
-register AV *av;
-I32 key;
-SV *val;
+av_store(register AV *av, I32 key, SV *val)
{
SV** ary;
+ U32 fill;
+
if (!av)
return 0;
if (!val)
- val = &sv_undef;
-
- if (SvRMAGICAL(av)) {
- if (mg_find((SV*)av,'P')) {
- if (val != &sv_undef)
- mg_copy((SV*)av, val, 0, key);
- return 0;
- }
- }
+ val = &PL_sv_undef;
if (key < 0) {
key += AvFILL(av) + 1;
if (key < 0)
return 0;
}
+
if (SvREADONLY(av) && key >= AvFILL(av))
croak(no_modify);
+
+ if (SvRMAGICAL(av)) {
+ if (mg_find((SV*)av,'P')) {
+ if (val != &PL_sv_undef) {
+ mg_copy((SV*)av, val, 0, key);
+ }
+ return 0;
+ }
+ }
+
if (!AvREAL(av) && AvREIFY(av))
av_reify(av);
if (key > AvMAX(av))
av_extend(av,key);
ary = AvARRAY(av);
- if (AvFILL(av) < key) {
+ if (AvFILLp(av) < key) {
if (!AvREAL(av)) {
- if (av == curstack && key > stack_sp - stack_base)
- stack_sp = stack_base + key; /* XPUSH in disguise */
+ dTHR;
+ if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
+ PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */
do
- ary[++AvFILL(av)] = &sv_undef;
- while (AvFILL(av) < key);
+ ary[++AvFILLp(av)] = &PL_sv_undef;
+ while (AvFILLp(av) < key);
}
- AvFILL(av) = key;
+ AvFILLp(av) = key;
}
else if (AvREAL(av))
SvREFCNT_dec(ary[key]);
ary[key] = val;
if (SvSMAGICAL(av)) {
- if (val != &sv_undef) {
+ if (val != &PL_sv_undef) {
MAGIC* mg = SvMAGIC(av);
sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
}
@@ -229,7 +255,7 @@ SV *val;
}
AV *
-newAV()
+newAV(void)
{
register AV *av;
@@ -238,14 +264,12 @@ newAV()
AvREAL_on(av);
AvALLOC(av) = 0;
SvPVX(av) = 0;
- AvMAX(av) = AvFILL(av) = -1;
+ AvMAX(av) = AvFILLp(av) = -1;
return av;
}
AV *
-av_make(size,strp)
-register I32 size;
-register SV **strp;
+av_make(register I32 size, register SV **strp)
{
register AV *av;
register I32 i;
@@ -258,7 +282,7 @@ register SV **strp;
New(4,ary,size,SV*);
AvALLOC(av) = ary;
SvPVX(av) = (char*)ary;
- AvFILL(av) = size - 1;
+ AvFILLp(av) = size - 1;
AvMAX(av) = size - 1;
for (i = 0; i < size; i++) {
assert (*strp);
@@ -271,9 +295,7 @@ register SV **strp;
}
AV *
-av_fake(size,strp)
-register I32 size;
-register SV **strp;
+av_fake(register I32 size, register SV **strp)
{
register AV *av;
register SV** ary;
@@ -285,7 +307,7 @@ register SV **strp;
Copy(strp,ary,size,SV*);
AvFLAGS(av) = AVf_REIFY;
SvPVX(av) = (char*)ary;
- AvFILL(av) = size - 1;
+ AvFILLp(av) = size - 1;
AvMAX(av) = size - 1;
while (size--) {
assert (*strp);
@@ -296,8 +318,7 @@ register SV **strp;
}
void
-av_clear(av)
-register AV *av;
+av_clear(register AV *av)
{
register I32 key;
SV** ary;
@@ -307,46 +328,58 @@ register AV *av;
warn("Attempt to clear deleted array");
}
#endif
- if (!av || AvMAX(av) < 0)
+ if (!av)
return;
/*SUPPRESS 560*/
+ if (SvREADONLY(av))
+ croak(no_modify);
+
+ /* Give any tie a chance to cleanup first */
+ if (SvRMAGICAL(av))
+ mg_clear((SV*)av);
+
+ if (AvMAX(av) < 0)
+ return;
+
if (AvREAL(av)) {
ary = AvARRAY(av);
- key = AvFILL(av) + 1;
+ key = AvFILLp(av) + 1;
while (key) {
SvREFCNT_dec(ary[--key]);
- ary[key] = &sv_undef;
+ ary[key] = &PL_sv_undef;
}
}
if (key = AvARRAY(av) - AvALLOC(av)) {
AvMAX(av) += key;
SvPVX(av) = (char*)AvALLOC(av);
}
- AvFILL(av) = -1;
+ AvFILLp(av) = -1;
- if (SvRMAGICAL(av))
- mg_clear((SV*)av);
}
void
-av_undef(av)
-register AV *av;
+av_undef(register AV *av)
{
register I32 key;
if (!av)
return;
/*SUPPRESS 560*/
+
+ /* Give any tie a chance to cleanup first */
+ if (SvTIED_mg((SV*)av, 'P'))
+ av_fill(av, -1); /* mg_clear() ? */
+
if (AvREAL(av)) {
- key = AvFILL(av) + 1;
+ key = AvFILLp(av) + 1;
while (key)
SvREFCNT_dec(AvARRAY(av)[--key]);
}
Safefree(AvALLOC(av));
AvALLOC(av) = 0;
SvPVX(av) = 0;
- AvMAX(av) = AvFILL(av) = -1;
+ AvMAX(av) = AvFILLp(av) = -1;
if (AvARYLEN(av)) {
SvREFCNT_dec(AvARYLEN(av));
AvARYLEN(av) = 0;
@@ -354,44 +387,93 @@ register AV *av;
}
void
-av_push(av,val)
-register AV *av;
-SV *val;
-{
+av_push(register AV *av, SV *val)
+{
+ MAGIC *mg;
if (!av)
return;
- av_store(av,AvFILL(av)+1,val);
+ if (SvREADONLY(av))
+ croak(no_modify);
+
+ if (mg = SvTIED_mg((SV*)av, 'P')) {
+ dSP;
+ PUSHSTACKi(PERLSI_MAGIC);
+ PUSHMARK(SP);
+ EXTEND(SP,2);
+ PUSHs(SvTIED_obj((SV*)av, mg));
+ PUSHs(val);
+ PUTBACK;
+ ENTER;
+ perl_call_method("PUSH", G_SCALAR|G_DISCARD);
+ LEAVE;
+ POPSTACK;
+ return;
+ }
+ av_store(av,AvFILLp(av)+1,val);
}
SV *
-av_pop(av)
-register AV *av;
+av_pop(register AV *av)
{
SV *retval;
+ MAGIC* mg;
if (!av || AvFILL(av) < 0)
- return &sv_undef;
+ return &PL_sv_undef;
if (SvREADONLY(av))
croak(no_modify);
- retval = AvARRAY(av)[AvFILL(av)];
- AvARRAY(av)[AvFILL(av)--] = &sv_undef;
+ if (mg = SvTIED_mg((SV*)av, 'P')) {
+ dSP;
+ PUSHSTACKi(PERLSI_MAGIC);
+ PUSHMARK(SP);
+ XPUSHs(SvTIED_obj((SV*)av, mg));
+ PUTBACK;
+ ENTER;
+ if (perl_call_method("POP", G_SCALAR)) {
+ retval = newSVsv(*PL_stack_sp--);
+ } else {
+ retval = &PL_sv_undef;
+ }
+ LEAVE;
+ POPSTACK;
+ return retval;
+ }
+ retval = AvARRAY(av)[AvFILLp(av)];
+ AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
if (SvSMAGICAL(av))
mg_set((SV*)av);
return retval;
}
void
-av_unshift(av,num)
-register AV *av;
-register I32 num;
+av_unshift(register AV *av, register I32 num)
{
register I32 i;
- register SV **sstr,**dstr;
+ register SV **ary;
+ MAGIC* mg;
if (!av || num <= 0)
return;
if (SvREADONLY(av))
croak(no_modify);
+
+ if (mg = SvTIED_mg((SV*)av, 'P')) {
+ dSP;
+ PUSHSTACKi(PERLSI_MAGIC);
+ PUSHMARK(SP);
+ EXTEND(SP,1+num);
+ PUSHs(SvTIED_obj((SV*)av, mg));
+ while (num-- > 0) {
+ PUSHs(&PL_sv_undef);
+ }
+ PUTBACK;
+ ENTER;
+ perl_call_method("UNSHIFT", G_SCALAR|G_DISCARD);
+ LEAVE;
+ POPSTACK;
+ return;
+ }
+
if (!AvREAL(av) && AvREIFY(av))
av_reify(av);
i = AvARRAY(av) - AvALLOC(av);
@@ -401,84 +483,174 @@ register I32 num;
num -= i;
AvMAX(av) += i;
- AvFILL(av) += i;
+ AvFILLp(av) += i;
SvPVX(av) = (char*)(AvARRAY(av) - i);
}
if (num) {
- av_extend(av,AvFILL(av)+num);
- AvFILL(av) += num;
- dstr = AvARRAY(av) + AvFILL(av);
- sstr = dstr - num;
-#ifdef BUGGY_MSC5
- # pragma loop_opt(off) /* don't loop-optimize the following code */
-#endif /* BUGGY_MSC5 */
- for (i = AvFILL(av) - num; i >= 0; --i) {
- *dstr-- = *sstr--;
-#ifdef BUGGY_MSC5
- # pragma loop_opt() /* loop-optimization back to command-line setting */
-#endif /* BUGGY_MSC5 */
- }
- while (num)
- AvARRAY(av)[--num] = &sv_undef;
+ i = AvFILLp(av);
+ av_extend(av, i + num);
+ AvFILLp(av) += num;
+ ary = AvARRAY(av);
+ Move(ary, ary + num, i + 1, SV*);
+ do {
+ ary[--num] = &PL_sv_undef;
+ } while (num);
}
}
SV *
-av_shift(av)
-register AV *av;
+av_shift(register AV *av)
{
SV *retval;
+ MAGIC* mg;
if (!av || AvFILL(av) < 0)
- return &sv_undef;
+ return &PL_sv_undef;
if (SvREADONLY(av))
croak(no_modify);
+ if (mg = SvTIED_mg((SV*)av, 'P')) {
+ dSP;
+ PUSHSTACKi(PERLSI_MAGIC);
+ PUSHMARK(SP);
+ XPUSHs(SvTIED_obj((SV*)av, mg));
+ PUTBACK;
+ ENTER;
+ if (perl_call_method("SHIFT", G_SCALAR)) {
+ retval = newSVsv(*PL_stack_sp--);
+ } else {
+ retval = &PL_sv_undef;
+ }
+ LEAVE;
+ POPSTACK;
+ return retval;
+ }
retval = *AvARRAY(av);
if (AvREAL(av))
- *AvARRAY(av) = &sv_undef;
+ *AvARRAY(av) = &PL_sv_undef;
SvPVX(av) = (char*)(AvARRAY(av) + 1);
AvMAX(av)--;
- AvFILL(av)--;
+ AvFILLp(av)--;
if (SvSMAGICAL(av))
mg_set((SV*)av);
return retval;
}
I32
-av_len(av)
-register AV *av;
+av_len(register AV *av)
{
return AvFILL(av);
}
void
-av_fill(av, fill)
-register AV *av;
-I32 fill;
+av_fill(register AV *av, I32 fill)
{
+ MAGIC *mg;
if (!av)
croak("panic: null array");
if (fill < 0)
fill = -1;
+ if (mg = SvTIED_mg((SV*)av, 'P')) {
+ dSP;
+ ENTER;
+ SAVETMPS;
+ PUSHSTACKi(PERLSI_MAGIC);
+ PUSHMARK(SP);
+ EXTEND(SP,2);
+ PUSHs(SvTIED_obj((SV*)av, mg));
+ PUSHs(sv_2mortal(newSViv(fill+1)));
+ PUTBACK;
+ perl_call_method("STORESIZE", G_SCALAR|G_DISCARD);
+ POPSTACK;
+ FREETMPS;
+ LEAVE;
+ return;
+ }
if (fill <= AvMAX(av)) {
- I32 key = AvFILL(av);
+ I32 key = AvFILLp(av);
SV** ary = AvARRAY(av);
if (AvREAL(av)) {
while (key > fill) {
SvREFCNT_dec(ary[key]);
- ary[key--] = &sv_undef;
+ ary[key--] = &PL_sv_undef;
}
}
else {
while (key < fill)
- ary[++key] = &sv_undef;
+ ary[++key] = &PL_sv_undef;
}
- AvFILL(av) = fill;
+ AvFILLp(av) = fill;
if (SvSMAGICAL(av))
mg_set((SV*)av);
}
else
- (void)av_store(av,fill,&sv_undef);
+ (void)av_store(av,fill,&PL_sv_undef);
+}
+
+
+/* AVHV: Support for treating arrays as if they were hashes. The
+ * first element of the array should be a hash reference that maps
+ * hash keys to array indices.
+ */
+
+STATIC I32
+avhv_index_sv(SV* sv)
+{
+ I32 index = SvIV(sv);
+ if (index < 1)
+ croak("Bad index while coercing array into hash");
+ return index;
+}
+
+HV*
+avhv_keys(AV *av)
+{
+ SV **keysp = av_fetch(av, 0, FALSE);
+ if (keysp) {
+ SV *sv = *keysp;
+ if (SvGMAGICAL(sv))
+ mg_get(sv);
+ if (SvROK(sv)) {
+ sv = SvRV(sv);
+ if (SvTYPE(sv) == SVt_PVHV)
+ return (HV*)sv;
+ }
+ }
+ croak("Can't coerce array into hash");
+ return Nullhv;
+}
+
+SV**
+avhv_fetch_ent(AV *av, SV *keysv, I32 lval, U32 hash)
+{
+ SV **indsvp;
+ HV *keys = avhv_keys(av);
+ HE *he;
+
+ he = hv_fetch_ent(keys, keysv, FALSE, hash);
+ if (!he)
+ croak("No such array field");
+ return av_fetch(av, avhv_index_sv(HeVAL(he)), lval);
+}
+
+bool
+avhv_exists_ent(AV *av, SV *keysv, U32 hash)
+{
+ HV *keys = avhv_keys(av);
+ return hv_exists_ent(keys, keysv, hash);
+}
+
+HE *
+avhv_iternext(AV *av)
+{
+ HV *keys = avhv_keys(av);
+ return hv_iternext(keys);
+}
+
+SV *
+avhv_iterval(AV *av, register HE *entry)
+{
+ SV *sv = hv_iterval(avhv_keys(av), entry);
+ return *av_fetch(av, avhv_index_sv(sv), TRUE);
}
diff --git a/gnu/usr.bin/perl/av.h b/gnu/usr.bin/perl/av.h
index a8dc60b4cde..bef763d3b17 100644
--- a/gnu/usr.bin/perl/av.h
+++ b/gnu/usr.bin/perl/av.h
@@ -1,6 +1,6 @@
/* av.h
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -9,8 +9,8 @@
struct xpvav {
char* xav_array; /* pointer to first array element */
- SSize_t xav_fill;
- SSize_t xav_max;
+ SSize_t xav_fill; /* Index of last element present */
+ SSize_t xav_max; /* Number of elements for which array has space */
IV xof_off; /* ptr is incremented by offset */
double xnv_nv; /* numeric value, if any */
MAGIC* xmg_magic; /* magic for scalar array */
@@ -30,7 +30,7 @@ struct xpvav {
#define AvARRAY(av) ((SV**)((XPVAV*) SvANY(av))->xav_array)
#define AvALLOC(av) ((XPVAV*) SvANY(av))->xav_alloc
#define AvMAX(av) ((XPVAV*) SvANY(av))->xav_max
-#define AvFILL(av) ((XPVAV*) SvANY(av))->xav_fill
+#define AvFILLp(av) ((XPVAV*) SvANY(av))->xav_fill
#define AvARYLEN(av) ((XPVAV*) SvANY(av))->xav_arylen
#define AvFLAGS(av) ((XPVAV*) SvANY(av))->xav_flags
@@ -45,4 +45,7 @@ struct xpvav {
#define AvREUSED_off(av) (AvFLAGS(av) &= ~AVf_REUSED)
#define AvREALISH(av) (AvFLAGS(av) & (AVf_REAL|AVf_REIFY))
+
+#define AvFILL(av) ((SvRMAGICAL((SV *) (av))) \
+ ? mg_size((SV *) av) : AvFILLp(av))
diff --git a/gnu/usr.bin/perl/cflags.SH b/gnu/usr.bin/perl/cflags.SH
index 39e96cc1ee1..8a1ba8295c8 100644
--- a/gnu/usr.bin/perl/cflags.SH
+++ b/gnu/usr.bin/perl/cflags.SH
@@ -88,6 +88,7 @@ for file do
POSIX) ;;
SDBM_File) ;;
av) ;;
+ byterun) ;;
deb) ;;
dl) ;;
doio) ;;
@@ -123,6 +124,7 @@ for file do
optimize="$optdebug"
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"'
diff --git a/gnu/usr.bin/perl/compat3.sym b/gnu/usr.bin/perl/compat3.sym
deleted file mode 100644
index db53dd67bef..00000000000
--- a/gnu/usr.bin/perl/compat3.sym
+++ /dev/null
@@ -1,46 +0,0 @@
-# Global symbols that should handled differently when Perl 5.004 is
-# compiled for binary compatibility with version 5.003.
-
-# Variables from "interp.sym" that _should_ be hidden.
-
-curcop
-curcopdb
-envgv
-siggv
-tainting
-
-# Variables from "global.sym" that should _not_ be hidden.
-
-Error
-block_type
-comppad_name_floor
-debug
-nice_chunk
-nice_chunk_size
-no_myglob
-no_symref
-no_wrongref
-pad_reset_pending
-padix_floor
-regflags
-warn_uninit
-
-# Functions from "global.sym" that should _not_ be hidden.
-
-SvIV
-SvNV
-SvTRUE
-SvUV
-boot_core_UNIVERSAL
-do_undump
-safecalloc
-safefree
-safemalloc
-saferealloc
-safexcalloc
-safexfree
-safexmalloc
-safexrealloc
-save_iv
-sv_pvn
-yydestruct
diff --git a/gnu/usr.bin/perl/config.sh.OpenBSD b/gnu/usr.bin/perl/config.sh.OpenBSD
deleted file mode 100644
index cce2422320a..00000000000
--- a/gnu/usr.bin/perl/config.sh.OpenBSD
+++ /dev/null
@@ -1,543 +0,0 @@
-#!/bin/sh
-# $OpenBSD: config.sh.OpenBSD,v 1.15 1998/05/11 20:43:31 millert Exp $
-#
-# This file was produced by running the Configure script. It holds all
-# the definitions figured out by Configure. Should you modify any of
-# these values, do not forget to propagate your changes by running
-# "Configure -S"; or, equivalently, you may run each .SH file yourself.
-#
-
-# Configuration time: Tue Nov 25 19:39:46 MST 1997
-# Configured by: root
-# Target system: openbsd
-
-#
-# NOTE: This script does run time substitions when being used by Configure!
-#
-
-case "`arch |cut -f2 -d.`" in
-"alpha") _dynaload=0;;
-"pmax") _dynaload=0;;
-"mips") _dynaload=0;;
-"powerpc") _dynaload=0;;
-"vax") _dynaload=0;;
-*) _dynaload=1;;
-esac
-
-Author=''
-Date='$Date'
-Header=''
-Id='$Id'
-Locker=''
-Log='$Log'
-Mcc='Mcc'
-RCSfile='$RCSfile'
-Revision='$Revision'
-Source=''
-State=''
-afs='false'
-alignbytes=''
-aphostname=''
-ar='ar'
-archlib="/usr/lib/perl5/`arch |cut -f2 -d.`-openbsd/5.00404"
-archlibexp="/usr/lib/perl5/`arch |cut -f2 -d.`-openbsd/5.00404"
-archname="`arch |cut -f2 -d.`-openbsd"
-archobjs=''
-awk='awk'
-baserev='5.0'
-bash=''
-bin='/usr/bin'
-binexp='/usr/bin'
-bison=''
-byacc='yacc'
-byteorder=''
-c=''
-castflags='0'
-cat='cat'
-cc='cc'
-cccdlflags='-DPIC -fPIC '
-ccdlflags=' '
-ccflags='-DSTRUCT_TM_HASZONE'
-cf_by='root'
-cf_email='root@localhost'
-cf_time='Tue Nov 25 19:39:46 MST 1997'
-chgrp=''
-chmod=''
-chown=''
-clocktype='clock_t'
-comm='comm'
-compress=''
-contains='grep'
-cp='cp'
-cpio=''
-cpp='cpp'
-cpp_stuff='42'
-cppflags=''
-cpplast='-'
-cppminus='-'
-cpprun='cc -E'
-cppstdin='cc -E'
-cryptlib=''
-csh='csh'
-d_Gconvert=''
-d_access='define'
-d_alarm='define'
-d_archlib='define'
-d_attribut='define'
-d_bcmp='define'
-d_bcopy='define'
-d_bsd='define'
-d_bsdgetpgrp='undef'
-d_bsdpgrp='define'
-d_bsdsetpgrp='define'
-d_bzero='define'
-d_casti32='define'
-d_castneg='define'
-d_charvspr='undef'
-d_chown='define'
-d_chroot='define'
-d_chsize='undef'
-d_closedir='define'
-d_const='define'
-d_crypt='define'
-d_csh='define'
-d_cuserid='undef'
-d_dbl_dig='define'
-d_difftime='define'
-d_dirnamlen='define'
-if [ $_dynaload -ne 0 ]; then
- d_dlerror='define'
- d_dlopen='define'
- d_dlsymun='define'
-else
- d_dlerror='undef'
- d_dlopen='undef'
- d_dlsymun='undef'
-fi
-d_dosuid='undef'
-d_dup2='define'
-d_eofnblk='define'
-d_eunice='undef'
-d_fchmod='define'
-d_fchown='define'
-d_fcntl='define'
-d_fd_macros='define'
-d_fd_set='define'
-d_fds_bits='define'
-d_fgetpos='define'
-d_flexfnam='define'
-d_flock='define'
-d_fork='define'
-d_fpathconf='define'
-d_fsetpos='define'
-d_ftime='undef'
-d_getgrps='define'
-d_setgrps='define'
-d_gethent='undef'
-d_gethname='undef'
-d_getlogin='define'
-d_getpgid='define'
-d_getpgrp2='undef'
-d_getpgrp='define'
-d_getppid='define'
-d_getprior='define'
-d_gettimeod='define'
-d_gnulibc='undef'
-d_htonl='define'
-d_index='undef'
-d_inetaton='define'
-d_isascii='define'
-d_killpg='define'
-d_link='define'
-d_locconv='define'
-d_lockf='define'
-d_lstat='define'
-d_mblen='define'
-d_mbstowcs='define'
-d_mbtowc='define'
-d_memcmp='define'
-d_memcpy='define'
-d_memmove='define'
-d_memset='define'
-d_mkdir='define'
-d_mkfifo='define'
-d_mktime='define'
-d_msg='define'
-d_msgctl='define'
-d_msgget='define'
-d_msgrcv='define'
-d_msgsnd='define'
-d_mymalloc='undef'
-d_nice='define'
-d_oldarchlib='undef'
-d_oldsock='undef'
-d_open3='define'
-d_pathconf='define'
-d_pause='define'
-d_phostname='undef'
-d_pipe='define'
-d_poll='define'
-d_portable='define'
-d_pwage='undef'
-d_pwchange='define'
-d_pwclass='define'
-d_pwcomment='undef'
-d_pwexpire='define'
-d_pwquota='undef'
-d_readdir='define'
-d_readlink='define'
-d_rename='define'
-d_rewinddir='define'
-d_rmdir='define'
-d_safebcpy='define'
-d_safemcpy='define'
-d_sanemcmp='define'
-d_seekdir='define'
-d_select='define'
-d_sem='define'
-d_semctl='define'
-d_semget='define'
-d_semop='define'
-d_setegid='define'
-d_seteuid='define'
-d_setlinebuf='define'
-d_setlocale='define'
-d_setpgid='define'
-d_setpgrp2='undef'
-d_setpgrp='define'
-d_setprior='define'
-d_setregid='undef'
-d_setresgid='undef'
-d_setresuid='undef'
-d_setreuid='undef'
-d_setrgid='undef'
-d_setruid='undef'
-d_setsid='define'
-d_sfio='undef'
-d_shm='define'
-d_shmat='define'
-d_shmatprototype='define'
-d_shmctl='define'
-d_shmdt='define'
-d_shmget='define'
-d_sigaction='define'
-d_sigsetjmp='define'
-d_socket='define'
-d_sockpair='define'
-d_statblks='define'
-d_stdio_cnt_lval='undef'
-d_stdio_ptr_lval='undef'
-d_stdiobase='undef'
-d_stdstdio='undef'
-d_strchr='define'
-d_strcoll='define'
-d_strctcpy='define'
-d_strerrm='strerror(e)'
-d_strerror='define'
-d_strtod='define'
-d_strtol='define'
-d_strtoul='define'
-d_strxfrm='define'
-d_suidsafe='define'
-d_symlink='define'
-d_syscall='define'
-d_sysconf='define'
-d_sysernlst=''
-d_syserrlst='define'
-d_system='define'
-d_tcgetpgrp='define'
-d_tcsetpgrp='define'
-d_telldir='define'
-d_time='define'
-d_times='define'
-d_truncate='define'
-d_tzname='define'
-d_umask='define'
-d_uname='define'
-d_vfork='define'
-d_void_closedir='undef'
-d_voidsig='define'
-d_voidtty=''
-d_volatile='define'
-d_vprintf='define'
-d_wait4='define'
-d_waitpid='define'
-d_wcstombs='define'
-d_wctomb='define'
-d_xenix='undef'
-date='date'
-db_hashtype='u_int32_t'
-db_prefixtype='size_t'
-defvoidused='15'
-direntrytype='struct dirent'
-if [ $_dynaload -ne 0 ]; then
- dlext='so'
- dlsrc='dl_dlopen.xs'
- dynamic_ext='DB_File Fcntl IO NDBM_File Opcode POSIX SDBM_File Socket'
-else
- dlext=''
- dlsrc='dl_none.xs'
- dynamic_ext=''
-fi
-eagain='EAGAIN'
-echo='echo'
-egrep='egrep'
-emacs=''
-eunicefix=':'
-exe_ext=''
-expr='expr'
-extensions='DB_File Fcntl IO NDBM_File Opcode POSIX SDBM_File Socket'
-find='find'
-firstmakefile='makefile'
-flex=''
-fpostype='fpos_t'
-freetype='void'
-full_csh='/bin/csh'
-full_sed='/usr/bin/sed'
-gcc=''
-gccversion='2.8.1'
-gidtype='gid_t'
-glibpth='/usr/shlib /shlib /usr/lib/pa1.1 /usr/lib/large /lib /usr/lib /usr/lib/386 /lib/386 /lib/large /usr/lib/small /lib/small /usr/ccs/lib /usr/ucblib '
-grep='grep'
-groupcat=''
-groupstype='gid_t'
-h_fcntl='false'
-h_sysfile='true'
-hint='previous'
-hostcat=''
-huge=''
-i_bsdioctl=''
-i_db='define'
-i_dbm='undef'
-i_dirent='define'
-i_dld='undef'
-if [ $_dynaload -ne 0 ]; then
- i_dlfcn='define'
-else
- i_dlfcn='undef'
-fi
-i_fcntl='undef'
-i_float='define'
-i_gdbm='undef'
-i_grp='define'
-i_limits='define'
-i_locale='define'
-i_malloc='define'
-i_math='define'
-i_memory='undef'
-i_ndbm='define'
-i_neterrno='undef'
-i_niin='define'
-i_pwd='define'
-i_rpcsvcdbm='undef'
-i_sfio='undef'
-i_sgtty='undef'
-i_stdarg='define'
-i_stddef='define'
-i_stdlib='define'
-i_string='define'
-i_sysdir='define'
-i_sysfile='define'
-i_sysfilio='define'
-i_sysin='undef'
-i_sysioctl='define'
-i_sysndir='undef'
-i_sysparam='define'
-i_sysresrc='define'
-i_sysselct='define'
-i_syssockio=''
-i_sysstat='define'
-i_systime='define'
-i_systimek='undef'
-i_systimes='define'
-i_systypes='define'
-i_sysun='define'
-i_syswait='define'
-i_termio='undef'
-i_termios='define'
-i_time='undef'
-i_unistd='define'
-i_utime='define'
-i_varargs='undef'
-i_values='undef'
-i_varhdr='stdarg.h'
-i_vfork='undef'
-incpath=''
-inews=''
-installarchlib="/usr/lib/perl5/`arch |cut -f2 -d.`-openbsd/5.00404"
-installbin='/usr/bin'
-installman1dir=''
-installman3dir=''
-installprivlib='/usr/lib/perl5'
-installscript='/usr/bin'
-installsitearch="/usr/lib/perl5/site_perl/`arch |cut -f2 -d.`-openbsd"
-installsitelib='/usr/lib/perl5/site_perl'
-intsize='4'
-known_extensions='DB_File Fcntl GDBM_File IO NDBM_File ODBM_File Opcode POSIX SDBM_File Socket'
-ksh=''
-large=''
-ld='ld'
-lddlflags='-Bforcearchive -Bshareable '
-ldflags=''
-less='less'
-lib_ext='.a'
-libc='/usr/lib/libc.a'
-libperl='libperl.a'
-libpth='/usr/lib'
-libs='-lm -lc'
-libswanted='sfio net socket inet nsl nm ndbm gdbm dbm db malloc dl dld ld sun m c cposix posix ndir dir crypt ucb bsd BSD PW x'
-line='line'
-lint=''
-lkflags=''
-ln='ln'
-lns='/bin/ln -s'
-locincpth=''
-loclibpth=''
-
-case "`arch |cut -f2 -d.`" in
-"alpha") longsize='8';;
-*) longsize='4';;
-esac
-
-lp=''
-lpr=''
-ls='ls'
-lseektype='off_t'
-mail=''
-mailx=''
-make='/usr/bin/make'
-make_set_make='#'
-mallocobj=''
-mallocsrc=''
-malloctype='void *'
-man1dir=' '
-man1direxp=''
-man1ext='0'
-man3dir=' '
-man3direxp=''
-man3ext='0'
-medium=''
-mips=''
-mips_type=''
-mkdir='mkdir'
-models='none'
-modetype='mode_t'
-more='more'
-mv=''
-myarchname="`arch |cut -f2 -d.`-openbsd"
-mydomain=''
-myhostname=''
-myuname='openbsd'
-n='-n'
-nm_opt=''
-nm_so_opt=''
-nroff='nroff'
-o_nonblock='O_NONBLOCK'
-obj_ext='.o'
-oldarchlib=''
-oldarchlibexp=''
-optimize='-O2'
-orderlib='false'
-osname='openbsd'
-osvers="`uname -r`"
-package='perl5'
-pager='/usr/bin/less'
-passcat=''
-patchlevel='4'
-path_sep=':'
-perl='perl'
-perladmin='root@localhost'
-perlpath='/usr/bin/perl'
-pg='pg'
-phostname='hostname'
-plibpth=''
-pmake=''
-pr=''
-prefix='/usr'
-prefixexp='/usr'
-privlib='/usr/lib/perl5'
-privlibexp='/usr/lib/perl5'
-prototype='define'
-randbits='31'
-ranlib='/usr/bin/ranlib'
-rd_nodata='-1'
-rm='rm'
-rmail=''
-runnm='true'
-scriptdir='/usr/bin'
-scriptdirexp='/usr/bin'
-sed='sed'
-selecttype='fd_set *'
-sendmail='sendmail'
-sh='/bin/sh'
-shar=''
-sharpbang='#!'
-shmattype='char *'
-shortsize='2'
-shrpenv=''
-shsharp='true'
-sig_name='ZERO HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM URG STOP TSTP CONT CHLD TTIN TTOU IO XCPU XFSZ VTALRM PROF WINCH INFO USR1 USR2 IOT '
-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 6 '
-signal_t='void'
-sitearch="/usr/lib/perl5/site_perl/`arch |cut -f2 -d.`-openbsd"
-sitearchexp="/usr/lib/perl5/site_perl/`arch |cut -f2 -d.`-openbsd"
-sitelib='/usr/lib/perl5/site_perl'
-sitelibexp='/usr/lib/perl5/site_perl'
-sizetype='size_t'
-sleep=''
-smail=''
-small=''
-so='so'
-sockethdr=''
-socketlib=''
-sort='sort'
-spackage='Perl5'
-spitshell='cat'
-split=''
-ssizetype='ssize_t'
-startperl='#!/usr/bin/perl'
-startsh='#!/bin/sh'
-static_ext=' '
-stdchar='char'
-stdio_base='((fp)->_base)'
-stdio_bufsiz='((fp)->_cnt + (fp)->_ptr - (fp)->_base)'
-stdio_cnt='((fp)->_cnt)'
-stdio_ptr='((fp)->_ptr)'
-strings='/usr/include/string.h'
-submit=''
-subversion='4'
-sysman='/usr/share/man/man1'
-tail=''
-tar=''
-tbl=''
-test='test'
-timeincl='/usr/include/sys/time.h '
-timetype='time_t'
-touch='touch'
-tr='tr'
-troff=''
-uidtype='uid_t'
-uname='uname'
-uniq='uniq'
-if [ $_dynaload -ne 0 ]; then
- usedl='define'
-else
- usedl='undef'
-fi
-usemymalloc='n'
-usenm='true'
-useposix='true'
-usesfio='false'
-useshrplib='false'
-usevfork='true'
-usrinc='/usr/include'
-uuname=''
-vi=''
-voidflags='15'
-xlibpth=''
-zcat=''
-PATCHLEVEL=4
-SUBVERSION=4
-CONFIG=true
-# Variables propagated from previous config.sh file.
-pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"'
diff --git a/gnu/usr.bin/perl/config_H b/gnu/usr.bin/perl/config_H
deleted file mode 100644
index 8d320cb5e10..00000000000
--- a/gnu/usr.bin/perl/config_H
+++ /dev/null
@@ -1,1781 +0,0 @@
-/* This file (config_H) is a sample config.h file. If you are unable
- to successfully run Configure, copy this file to config.h and
- edit it to suit your system.
-*/
-/*
- * This file was produced by running the config_h.SH script, which
- * gets its values from config.sh, which is generally produced by
- * running Configure.
- *
- * Feel free to modify any of this as the need arises. Note, however,
- * that running config_h.SH again will wipe out any changes you've made.
- * For a more permanent change edit config.sh and rerun config_h.SH.
- *
- * $Id: config_H,v 1.2 1997/11/30 07:48:22 millert Exp $
- */
-
-/* Configuration time: Wed Sep 11 15:24:25 EDT 1996
- * Configured by: doughera
- * Target system: sunos fractal 5.5 generic i86pc i386 i86pc
- */
-
-#ifndef _config_h_
-#define _config_h_
-
-/* MEM_ALIGNBYTES:
- * This symbol contains the number of bytes required to align a
- * double. Usual values are 2, 4 and 8.
- */
-#define MEM_ALIGNBYTES 4 /**/
-
-/* ARCHNAME:
- * This symbol holds a string representing the architecture name.
- * It may be used to construct an architecture-dependant pathname
- * where library files may be held under a private library, for
- * instance.
- */
-#define ARCHNAME "unknown" /**/
-
-/* BIN:
- * This symbol holds the path of the bin directory where the package will
- * be installed. Program must be prepared to deal with ~name substitution.
- */
-/* BIN_EXP:
- * This symbol is the filename expanded version of the BIN symbol, for
- * programs that do not want to deal with that at run-time.
- */
-#define BIN "/opt/perl/bin" /**/
-#define BIN_EXP "/opt/perl/bin" /**/
-
-/* CAT2:
- * This macro catenates 2 tokens together.
- */
-/* STRINGIFY:
- * This macro surrounds its token with double quotes.
- */
-#if 42 == 1
-#define CAT2(a,b)a/**/b
-#define CAT3(a,b,c)a/**/b/**/c
-#define CAT4(a,b,c,d)a/**/b/**/c/**/d
-#define CAT5(a,b,c,d,e)a/**/b/**/c/**/d/**/e
-#define STRINGIFY(a)"a"
- /* If you can get stringification with catify, tell me how! */
-#endif
-#if 42 == 42
-#define CAT2(a,b)a ## b
-#define CAT3(a,b,c)a ## b ## c
-#define CAT4(a,b,c,d)a ## b ## c ## d
-#define CAT5(a,b,c,d,e)a ## b ## c ## d ## e
-#define StGiFy(a)# a
-#define STRINGIFY(a)StGiFy(a)
-#define SCAT2(a,b)StGiFy(a) StGiFy(b)
-#define SCAT3(a,b,c)StGiFy(a) StGiFy(b) StGiFy(c)
-#define SCAT4(a,b,c,d)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d)
-#define SCAT5(a,b,c,d,e)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d) StGiFy(e)
-#endif
-#ifndef CAT2
-#include "Bletch: How does this C preprocessor catenate tokens?"
-#endif
-
-/* CPPSTDIN:
- * This symbol contains the first part of the string which will invoke
- * the C preprocessor on the standard input and produce to standard
- * output. Typical value of "cc -E" or "/lib/cpp", but it can also
- * call a wrapper. See CPPRUN.
- */
-/* CPPMINUS:
- * This symbol contains the second part of the string which will invoke
- * the C preprocessor on the standard input and produce to standard
- * output. This symbol will have the value "-" if CPPSTDIN needs a minus
- * to specify standard input, otherwise the value is "".
- */
-#define CPPSTDIN "cc -E"
-#define CPPMINUS "-"
-
-/* HAS_ALARM:
- * This symbol, if defined, indicates that the alarm routine is
- * available.
- */
-#define HAS_ALARM /**/
-
-/* HASATTRIBUTE:
- * This symbol indicates the C compiler can check for function attributes,
- * such as printf formats. This is normally only supported by GNU cc.
- */
-/*#define HASATTRIBUTE / **/
-#ifndef HASATTRIBUTE
-#define __attribute__(_arg_)
-#endif
-
-/* HAS_BCMP:
- * This symbol is defined if the bcmp() routine is available to
- * compare blocks of memory.
- */
-#define HAS_BCMP /**/
-
-/* HAS_BCOPY:
- * This symbol is defined if the bcopy() routine is available to
- * copy blocks of memory.
- */
-#define HAS_BCOPY /**/
-
-/* HAS_BZERO:
- * This symbol is defined if the bzero() routine is available to
- * set a memory block to 0.
- */
-#define HAS_BZERO /**/
-
-/* CASTI32:
- * This symbol is defined if the C compiler can cast negative
- * or large floating point numbers to 32-bit ints.
- */
-#define CASTI32 /**/
-
-/* CASTNEGFLOAT:
- * This symbol is defined if the C compiler can cast negative
- * numbers to unsigned longs, ints and shorts.
- */
-/* CASTFLAGS:
- * This symbol contains flags that say what difficulties the compiler
- * has casting odd floating values to unsigned long:
- * 0 = ok
- * 1 = couldn't cast < 0
- * 2 = couldn't cast >= 0x80000000
- * 4 = couldn't cast in argument expression list
- */
-#define CASTNEGFLOAT /**/
-#define CASTFLAGS 0 /**/
-
-/* HAS_CHOWN:
- * This symbol, if defined, indicates that the chown routine is
- * available.
- */
-#define HAS_CHOWN /**/
-
-/* HAS_CHROOT:
- * This symbol, if defined, indicates that the chroot routine is
- * available.
- */
-#define HAS_CHROOT /**/
-
-/* HAS_CHSIZE:
- * This symbol, if defined, indicates that the chsize routine is available
- * to truncate files. You might need a -lx to get this routine.
- */
-/*#define HAS_CHSIZE / **/
-
-/* VOID_CLOSEDIR:
- * This symbol, if defined, indicates that the closedir() routine
- * does not return a value.
- */
-/*#define VOID_CLOSEDIR / **/
-
-/* HASCONST:
- * This symbol, if defined, indicates that this C compiler knows about
- * the const type. There is no need to actually test for that symbol
- * within your programs. The mere use of the "const" keyword will
- * trigger the necessary tests.
- */
-#define HASCONST /**/
-#ifndef HASCONST
-#define const
-#endif
-
-/* HAS_CRYPT:
- * This symbol, if defined, indicates that the crypt routine is available
- * to encrypt passwords and the like.
- */
-#define HAS_CRYPT /**/
-
-/* HAS_CUSERID:
- * This symbol, if defined, indicates that the cuserid routine is
- * available to get character login names.
- */
-#define HAS_CUSERID /**/
-
-/* HAS_DBL_DIG:
- * This symbol, if defined, indicates that this system's <float.h>
- * or <limits.h> defines the symbol DBL_DIG, which is the number
- * of significant digits in a double precision number. If this
- * symbol is not defined, a guess of 15 is usually pretty good.
- */
-#define HAS_DBL_DIG /* */
-
-/* HAS_DIFFTIME:
- * This symbol, if defined, indicates that the difftime routine is
- * available.
- */
-#define HAS_DIFFTIME /**/
-
-/* HAS_DLERROR:
- * This symbol, if defined, indicates that the dlerror routine is
- * available to return a string describing the last error that
- * occurred from a call to dlopen(), dlclose() or dlsym().
- */
-#define HAS_DLERROR /**/
-
-/* HAS_DUP2:
- * This symbol, if defined, indicates that the dup2 routine is
- * available to duplicate file descriptors.
- */
-#define HAS_DUP2 /**/
-
-/* HAS_FCHMOD:
- * This symbol, if defined, indicates that the fchmod routine is available
- * to change mode of opened files. If unavailable, use chmod().
- */
-#define HAS_FCHMOD /**/
-
-/* HAS_FCHOWN:
- * This symbol, if defined, indicates that the fchown routine is available
- * to change ownership of opened files. If unavailable, use chown().
- */
-#define HAS_FCHOWN /**/
-
-/* HAS_FCNTL:
- * This symbol, if defined, indicates to the C program that
- * the fcntl() function exists.
- */
-#define HAS_FCNTL /**/
-
-/* HAS_FGETPOS:
- * This symbol, if defined, indicates that the fgetpos routine is
- * available to get the file position indicator, similar to ftell().
- */
-#define HAS_FGETPOS /**/
-
-/* FLEXFILENAMES:
- * This symbol, if defined, indicates that the system supports filenames
- * longer than 14 characters.
- */
-#define FLEXFILENAMES /**/
-
-/* HAS_FLOCK:
- * This symbol, if defined, indicates that the flock routine is
- * available to do file locking.
- */
-/*#define HAS_FLOCK / **/
-
-/* HAS_FORK:
- * This symbol, if defined, indicates that the fork routine is
- * available.
- */
-#define HAS_FORK /**/
-
-/* HAS_FSETPOS:
- * This symbol, if defined, indicates that the fsetpos routine is
- * available to set the file position indicator, similar to fseek().
- */
-#define HAS_FSETPOS /**/
-
-/* HAS_GETTIMEOFDAY:
- * This symbol, if defined, indicates that the gettimeofday() system
- * call is available for a sub-second accuracy clock. Usually, the file
- * <sys/resource.h> needs to be included (see I_SYS_RESOURCE).
- * The type "Timeval" should be used to refer to "struct timeval".
- */
-/*#define HAS_GETTIMEOFDAY / **/
-#ifdef HAS_GETTIMEOFDAY
-#define Timeval struct timeval /* Structure used by gettimeofday() */
-#endif
-
-/* HAS_GETGROUPS:
- * This symbol, if defined, indicates that the getgroups() routine is
- * available to get the list of process groups. If unavailable, multiple
- * groups are probably not supported.
- */
-/* HAS_SETGROUPS:
- * This symbol, if defined, indicates that the setgroups() routine is
- * available to set the list of process groups. If unavailable, multiple
- * groups are probably not supported.
- */
-#define HAS_GETGROUPS /**/
-#define HAS_SETGROUPS /**/
-
-/* HAS_GETHOSTENT:
- * This symbol, if defined, indicates that the gethostent routine is
- * available to lookup host names in some data base or other.
- */
-#define HAS_GETHOSTENT /**/
-
-/* HAS_UNAME:
- * This symbol, if defined, indicates that the C program may use the
- * uname() routine to derive the host name. See also HAS_GETHOSTNAME
- * and PHOSTNAME.
- */
-#define HAS_UNAME /**/
-
-/* HAS_GETLOGIN:
- * This symbol, if defined, indicates that the getlogin routine is
- * available to get the login name.
- */
-#define HAS_GETLOGIN /**/
-
-/* HAS_GETPGRP2:
- * This symbol, if defined, indicates that the getpgrp2() (as in DG/UX)
- * routine is available to get the current process group.
- */
-/*#define HAS_GETPGRP2 / **/
-
-/* HAS_GETPPID:
- * This symbol, if defined, indicates that the getppid routine is
- * available to get the parent process ID.
- */
-#define HAS_GETPPID /**/
-
-/* HAS_GETPRIORITY:
- * This symbol, if defined, indicates that the getpriority routine is
- * available to get a process's priority.
- */
-#define HAS_GETPRIORITY /**/
-
-/* HAS_HTONL:
- * This symbol, if defined, indicates that the htonl() routine (and
- * friends htons() ntohl() ntohs()) are available to do network
- * order byte swapping.
- */
-/* HAS_HTONS:
- * This symbol, if defined, indicates that the htons() routine (and
- * friends htonl() ntohl() ntohs()) are available to do network
- * order byte swapping.
- */
-/* HAS_NTOHL:
- * This symbol, if defined, indicates that the ntohl() routine (and
- * friends htonl() htons() ntohs()) are available to do network
- * order byte swapping.
- */
-/* HAS_NTOHS:
- * This symbol, if defined, indicates that the ntohs() routine (and
- * friends htonl() htons() ntohl()) are available to do network
- * order byte swapping.
- */
-#define HAS_HTONL /**/
-#define HAS_HTONS /**/
-#define HAS_NTOHL /**/
-#define HAS_NTOHS /**/
-
-/* HAS_ISASCII:
- * This manifest constant lets the C program know that isascii
- * is available.
- */
-#define HAS_ISASCII /**/
-
-/* HAS_KILLPG:
- * This symbol, if defined, indicates that the killpg routine is available
- * to kill process groups. If unavailable, you probably should use kill
- * with a negative process number.
- */
-#define HAS_KILLPG /**/
-
-/* HAS_LINK:
- * This symbol, if defined, indicates that the link routine is
- * available to create hard links.
- */
-#define HAS_LINK /**/
-
-/* HAS_LOCALECONV:
- * This symbol, if defined, indicates that the localeconv routine is
- * available for numeric and monetary formatting conventions.
- */
-#define HAS_LOCALECONV /**/
-
-/* HAS_LOCKF:
- * This symbol, if defined, indicates that the lockf routine is
- * available to do file locking.
- */
-#define HAS_LOCKF /**/
-
-/* HAS_LSTAT:
- * This symbol, if defined, indicates that the lstat routine is
- * available to do file stats on symbolic links.
- */
-#define HAS_LSTAT /**/
-
-/* HAS_MBLEN:
- * This symbol, if defined, indicates that the mblen routine is available
- * to find the number of bytes in a multibye character.
- */
-#define HAS_MBLEN /**/
-
-/* HAS_MBSTOWCS:
- * This symbol, if defined, indicates that the mbstowcs routine is
- * available to covert a multibyte string into a wide character string.
- */
-#define HAS_MBSTOWCS /**/
-
-/* HAS_MBTOWC:
- * This symbol, if defined, indicates that the mbtowc routine is available
- * to covert a multibyte to a wide character.
- */
-#define HAS_MBTOWC /**/
-
-/* HAS_MEMCMP:
- * This symbol, if defined, indicates that the memcmp routine is available
- * to compare blocks of memory.
- */
-#define HAS_MEMCMP /**/
-
-/* HAS_MEMCPY:
- * This symbol, if defined, indicates that the memcpy routine is available
- * to copy blocks of memory.
- */
-#define HAS_MEMCPY /**/
-
-/* HAS_MEMMOVE:
- * This symbol, if defined, indicates that the memmove routine is available
- * to copy potentially overlapping blocks of memory. This should be used
- * only when HAS_SAFE_BCOPY is not defined. If neither is there, roll your
- * own version.
- */
-#define HAS_MEMMOVE /**/
-
-/* HAS_MEMSET:
- * This symbol, if defined, indicates that the memset routine is available
- * to set blocks of memory.
- */
-#define HAS_MEMSET /**/
-
-/* HAS_MKDIR:
- * This symbol, if defined, indicates that the mkdir routine is available
- * to create directories. Otherwise you should fork off a new process to
- * exec /bin/mkdir.
- */
-#define HAS_MKDIR /**/
-
-/* HAS_MKFIFO:
- * This symbol, if defined, indicates that the mkfifo routine is
- * available to create FIFOs. Otherwise, mknod should be able to
- * do it for you. However, if mkfifo is there, mknod might require
- * super-user privileges which mkfifo will not.
- */
-#define HAS_MKFIFO /**/
-
-/* HAS_MKTIME:
- * This symbol, if defined, indicates that the mktime routine is
- * available.
- */
-#define HAS_MKTIME /**/
-
-/* HAS_MSG:
- * This symbol, if defined, indicates that the entire msg*(2) library is
- * supported (IPC mechanism based on message queues).
- */
-#define HAS_MSG /**/
-
-/* HAS_NICE:
- * This symbol, if defined, indicates that the nice routine is
- * available.
- */
-#define HAS_NICE /**/
-
-/* HAS_OPEN3:
- * This manifest constant lets the C program know that the three
- * argument form of open(2) is available.
- */
-#define HAS_OPEN3 /**/
-
-/* HAS_PATHCONF:
- * This symbol, if defined, indicates that pathconf() is available
- * to determine file-system related limits and options associated
- * with a given filename.
- */
-/* HAS_FPATHCONF:
- * This symbol, if defined, indicates that pathconf() is available
- * to determine file-system related limits and options associated
- * with a given open file descriptor.
- */
-#define HAS_PATHCONF /**/
-#define HAS_FPATHCONF /**/
-
-/* HAS_PAUSE:
- * This symbol, if defined, indicates that the pause routine is
- * available to suspend a process until a signal is received.
- */
-#define HAS_PAUSE /**/
-
-/* HAS_PIPE:
- * This symbol, if defined, indicates that the pipe routine is
- * available to create an inter-process channel.
- */
-#define HAS_PIPE /**/
-
-/* HAS_POLL:
- * This symbol, if defined, indicates that the poll routine is
- * available to poll active file descriptors.
- */
-#define HAS_POLL /**/
-
-/* HAS_READDIR:
- * This symbol, if defined, indicates that the readdir routine is
- * available to read directory entries. You may have to include
- * <dirent.h>. See I_DIRENT.
- */
-#define HAS_READDIR /**/
-
-/* HAS_SEEKDIR:
- * This symbol, if defined, indicates that the seekdir routine is
- * available. You may have to include <dirent.h>. See I_DIRENT.
- */
-#define HAS_SEEKDIR /**/
-
-/* HAS_TELLDIR:
- * This symbol, if defined, indicates that the telldir routine is
- * available. You may have to include <dirent.h>. See I_DIRENT.
- */
-#define HAS_TELLDIR /**/
-
-/* HAS_REWINDDIR:
- * This symbol, if defined, indicates that the rewinddir routine is
- * available. You may have to include <dirent.h>. See I_DIRENT.
- */
-#define HAS_REWINDDIR /**/
-
-/* HAS_READLINK:
- * This symbol, if defined, indicates that the readlink routine is
- * available to read the value of a symbolic link.
- */
-#define HAS_READLINK /**/
-
-/* HAS_RENAME:
- * This symbol, if defined, indicates that the rename routine is available
- * to rename files. Otherwise you should do the unlink(), link(), unlink()
- * trick.
- */
-#define HAS_RENAME /**/
-
-/* HAS_RMDIR:
- * This symbol, if defined, indicates that the rmdir routine is
- * available to remove directories. Otherwise you should fork off a
- * new process to exec /bin/rmdir.
- */
-#define HAS_RMDIR /**/
-
-/* HAS_SAFE_BCOPY:
- * This symbol, if defined, indicates that the bcopy routine is available
- * to copy potentially overlapping memory blocks. Otherwise you should
- * probably use memmove() or memcpy(). If neither is defined, roll your
- * own version.
- */
-#define HAS_SAFE_BCOPY /**/
-
-/* HAS_SAFE_MEMCPY:
- * This symbol, if defined, indicates that the memcpy routine is available
- * to copy potentially overlapping memory blocks. Otherwise you should
- * probably use memmove() or memcpy(). If neither is defined, roll your
- * own version.
- */
-/*#define HAS_SAFE_MEMCPY / **/
-
-/* HAS_SANE_MEMCMP:
- * This symbol, if defined, indicates that the memcmp routine is available
- * and can be used to compare relative magnitudes of chars with their high
- * bits set. If it is not defined, roll your own version.
- */
-/*#define HAS_SANE_MEMCMP / **/
-
-/* HAS_SELECT:
- * This symbol, if defined, indicates that the select routine is
- * available to select active file descriptors. If the timeout field
- * is used, <sys/time.h> may need to be included.
- */
-#define HAS_SELECT /**/
-
-/* HAS_SEM:
- * This symbol, if defined, indicates that the entire sem*(2) library is
- * supported.
- */
-#define HAS_SEM /**/
-
-/* HAS_SETEGID:
- * This symbol, if defined, indicates that the setegid routine is available
- * to change the effective gid of the current program.
- */
-#define HAS_SETEGID /**/
-
-/* HAS_SETEUID:
- * This symbol, if defined, indicates that the seteuid routine is available
- * to change the effective uid of the current program.
- */
-#define HAS_SETEUID /**/
-
-/* HAS_SETLINEBUF:
- * This symbol, if defined, indicates that the setlinebuf routine is
- * available to change stderr or stdout from block-buffered or unbuffered
- * to a line-buffered mode.
- */
-#define HAS_SETLINEBUF /**/
-
-/* HAS_SETLOCALE:
- * This symbol, if defined, indicates that the setlocale routine is
- * available to handle locale-specific ctype implementations.
- */
-#define HAS_SETLOCALE /**/
-
-/* HAS_SETPGRP2:
- * This symbol, if defined, indicates that the setpgrp2() (as in DG/UX)
- * routine is available to set the current process group.
- */
-/*#define HAS_SETPGRP2 / **/
-
-/* HAS_SETPRIORITY:
- * This symbol, if defined, indicates that the setpriority routine is
- * available to set a process's priority.
- */
-#define HAS_SETPRIORITY /**/
-
-/* HAS_SETREGID:
- * This symbol, if defined, indicates that the setregid routine is
- * available to change the real and effective gid of the current
- * process.
- */
-/* HAS_SETRESGID:
- * This symbol, if defined, indicates that the setresgid routine is
- * available to change the real, effective and saved gid of the current
- * process.
- */
-#define HAS_SETREGID /**/
-/*#define HAS_SETRESGID / **/
-
-/* HAS_SETREUID:
- * This symbol, if defined, indicates that the setreuid routine is
- * available to change the real and effective uid of the current
- * process.
- */
-/* HAS_SETRESUID:
- * This symbol, if defined, indicates that the setresuid routine is
- * available to change the real, effective and saved uid of the current
- * process.
- */
-#define HAS_SETREUID /**/
-/*#define HAS_SETRESUID / **/
-
-/* HAS_SETRGID:
- * This symbol, if defined, indicates that the setrgid routine is available
- * to change the real gid of the current program.
- */
-/*#define HAS_SETRGID / **/
-
-/* HAS_SETRUID:
- * This symbol, if defined, indicates that the setruid routine is available
- * to change the real uid of the current program.
- */
-/*#define HAS_SETRUID / **/
-
-/* HAS_SETSID:
- * This symbol, if defined, indicates that the setsid routine is
- * available to set the process group ID.
- */
-#define HAS_SETSID /**/
-
-/* HAS_SHM:
- * This symbol, if defined, indicates that the entire shm*(2) library is
- * supported.
- */
-#define HAS_SHM /**/
-
-/* Shmat_t:
- * This symbol holds the return type of the shmat() system call.
- * Usually set to 'void *' or 'char *'.
- */
-/* HAS_SHMAT_PROTOTYPE:
- * This symbol, if defined, indicates that the sys/shm.h includes
- * a prototype for shmat(). Otherwise, it is up to the program to
- * guess one. Shmat_t shmat _((int, Shmat_t, int)) is a good guess,
- * but not always right so it should be emitted by the program only
- * when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs.
- */
-#define Shmat_t void * /**/
-#define HAS_SHMAT_PROTOTYPE /**/
-
-/* HAS_SIGACTION:
- * This symbol, if defined, indicates that Vr4's sigaction() routine
- * is available.
- */
-#define HAS_SIGACTION /**/
-
-/* HAS_SOCKET:
- * This symbol, if defined, indicates that the BSD socket interface is
- * supported.
- */
-/* HAS_SOCKETPAIR:
- * This symbol, if defined, indicates that the BSD socketpair() call is
- * supported.
- */
-#define HAS_SOCKET /**/
-#define HAS_SOCKETPAIR /**/
-
-/* USE_STAT_BLOCKS:
- * This symbol is defined if this system has a stat structure declaring
- * st_blksize and st_blocks.
- */
-#define USE_STAT_BLOCKS /**/
-
-/* USE_STDIO_PTR:
- * This symbol is defined if the _ptr and _cnt fields (or similar)
- * of the stdio FILE structure can be used to access the stdio buffer
- * for a file handle. If this is defined, then the FILE_ptr(fp)
- * and FILE_cnt(fp) macros will also be defined and should be used
- * to access these fields.
- */
-/* FILE_ptr:
- * This macro is used to access the _ptr field (or equivalent) of the
- * FILE structure pointed to by its argument. This macro will always be
- * defined if USE_STDIO_PTR is defined.
- */
-/* STDIO_PTR_LVALUE:
- * This symbol is defined if the FILE_ptr macro can be used as an
- * lvalue.
- */
-/* FILE_cnt:
- * This macro is used to access the _cnt field (or equivalent) of the
- * FILE structure pointed to by its argument. This macro will always be
- * defined if USE_STDIO_PTR is defined.
- */
-/* STDIO_CNT_LVALUE:
- * This symbol is defined if the FILE_cnt macro can be used as an
- * lvalue.
- */
-#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 /**/
-#endif
-
-/* USE_STDIO_BASE:
- * This symbol is defined if the _base field (or similar) of the
- * stdio FILE structure can be used to access the stdio buffer for
- * a file handle. If this is defined, then the FILE_base(fp) macro
- * will also be defined and should be used to access this field.
- * Also, the FILE_bufsiz(fp) macro will be defined and should be used
- * to determine the number of bytes in the buffer. USE_STDIO_BASE
- * will never be defined unless USE_STDIO_PTR is.
- */
-/* FILE_base:
- * This macro is used to access the _base field (or equivalent) of the
- * FILE structure pointed to by its argument. This macro will always be
- * defined if USE_STDIO_BASE is defined.
- */
-/* FILE_bufsiz:
- * This macro is used to determine the number of bytes in the I/O
- * buffer pointed to by _base field (or equivalent) of the FILE
- * structure pointed to its argument. This macro will always be defined
- * if USE_STDIO_BASE is defined.
- */
-#define USE_STDIO_BASE /**/
-#ifdef USE_STDIO_BASE
-#define FILE_base(fp) ((fp)->_base)
-#define FILE_bufsiz(fp) ((fp)->_cnt + (fp)->_ptr - (fp)->_base)
-#endif
-
-/* HAS_STRCHR:
- * This symbol is defined to indicate that the strchr()/strrchr()
- * functions are available for string searching. If not, try the
- * index()/rindex() pair.
- */
-/* HAS_INDEX:
- * This symbol is defined to indicate that the index()/rindex()
- * functions are available for string searching.
- */
-#define HAS_STRCHR /**/
-/*#define HAS_INDEX / **/
-
-/* HAS_STRCOLL:
- * This symbol, if defined, indicates that the strcoll routine is
- * available to compare strings using collating information.
- */
-#define HAS_STRCOLL /**/
-
-/* USE_STRUCT_COPY:
- * This symbol, if defined, indicates that this C compiler knows how
- * to copy structures. If undefined, you'll need to use a block copy
- * routine of some sort instead.
- */
-#define USE_STRUCT_COPY /**/
-
-/* HAS_STRERROR:
- * This symbol, if defined, indicates that the strerror routine is
- * available to translate error numbers to strings. See the writeup
- * of Strerror() in this file before you try to define your own.
- */
-/* HAS_SYS_ERRLIST:
- * This symbol, if defined, indicates that the sys_errlist array is
- * available to translate error numbers to strings. The extern int
- * sys_nerr gives the size of that table.
- */
-/* Strerror:
- * This preprocessor symbol is defined as a macro if strerror() is
- * not available to translate error numbers to strings but sys_errlist[]
- * array is there.
- */
-#define HAS_STRERROR /**/
-#define HAS_SYS_ERRLIST /**/
-#define Strerror(e) strerror(e)
-
-/* HAS_STRTOD:
- * This symbol, if defined, indicates that the strtod routine is
- * available to provide better numeric string conversion than atof().
- */
-#define HAS_STRTOD /**/
-
-/* HAS_STRTOL:
- * This symbol, if defined, indicates that the strtol routine is available
- * to provide better numeric string conversion than atoi() and friends.
- */
-#define HAS_STRTOL /**/
-
-/* HAS_STRTOUL:
- * This symbol, if defined, indicates that the strtoul routine is
- * available to provide conversion of strings to unsigned long.
- */
-#define HAS_STRTOUL /**/
-
-/* HAS_STRXFRM:
- * This symbol, if defined, indicates that the strxfrm() routine is
- * available to transform strings.
- */
-#define HAS_STRXFRM /**/
-
-/* HAS_SYMLINK:
- * This symbol, if defined, indicates that the symlink routine is available
- * to create symbolic links.
- */
-#define HAS_SYMLINK /**/
-
-/* HAS_SYSCALL:
- * This symbol, if defined, indicates that the syscall routine is
- * available to call arbitrary system calls. If undefined, that's tough.
- */
-#define HAS_SYSCALL /**/
-
-/* HAS_SYSCONF:
- * This symbol, if defined, indicates that sysconf() is available
- * to determine system related limits and options.
- */
-#define HAS_SYSCONF /**/
-
-/* HAS_SYSTEM:
- * This symbol, if defined, indicates that the system routine is
- * available to issue a shell command.
- */
-#define HAS_SYSTEM /**/
-
-/* HAS_TCGETPGRP:
- * This symbol, if defined, indicates that the tcgetpgrp routine is
- * available to get foreground process group ID.
- */
-#define HAS_TCGETPGRP /**/
-
-/* HAS_TCSETPGRP:
- * This symbol, if defined, indicates that the tcsetpgrp routine is
- * available to set foreground process group ID.
- */
-#define HAS_TCSETPGRP /**/
-
-/* Time_t:
- * This symbol holds the type returned by time(). It can be long,
- * or time_t on BSD sites (in which case <sys/types.h> should be
- * included).
- */
-#define Time_t time_t /* Time type */
-
-/* HAS_TIMES:
- * This symbol, if defined, indicates that the times() routine exists.
- * Note that this became obsolete on some systems (SUNOS), which now
- * use getrusage(). It may be necessary to include <sys/times.h>.
- */
-#define HAS_TIMES /**/
-
-/* HAS_TRUNCATE:
- * This symbol, if defined, indicates that the truncate routine is
- * available to truncate files.
- */
-#define HAS_TRUNCATE /**/
-
-/* HAS_TZNAME:
- * This symbol, if defined, indicates that the tzname[] array is
- * available to access timezone names.
- */
-#define HAS_TZNAME /**/
-
-/* HAS_UMASK:
- * This symbol, if defined, indicates that the umask routine is
- * available to set and get the value of the file creation mask.
- */
-#define HAS_UMASK /**/
-
-/* HAS_VFORK:
- * This symbol, if defined, indicates that vfork() exists.
- */
-/*#define HAS_VFORK / **/
-
-/* Signal_t:
- * This symbol's value is either "void" or "int", corresponding to the
- * appropriate return type of a signal handler. Thus, you can declare
- * a signal handler using "Signal_t (*handler)()", and define the
- * handler using "Signal_t handler(sig)".
- */
-#define Signal_t void /* Signal handler's return type */
-
-/* HASVOLATILE:
- * This symbol, if defined, indicates that this C compiler knows about
- * the volatile declaration.
- */
-#define HASVOLATILE /**/
-#ifndef HASVOLATILE
-#define volatile
-#endif
-
-/* HAS_VPRINTF:
- * This symbol, if defined, indicates that the vprintf routine is available
- * to printf with a pointer to an argument list. If unavailable, you
- * may need to write your own, probably in terms of _doprnt().
- */
-/* USE_CHAR_VSPRINTF:
- * This symbol is defined if this system has vsprintf() returning type
- * (char*). The trend seems to be to declare it as "int vsprintf()". It
- * is up to the package author to declare vsprintf correctly based on the
- * symbol.
- */
-#define HAS_VPRINTF /**/
-/*#define USE_CHAR_VSPRINTF / **/
-
-/* HAS_WAIT4:
- * This symbol, if defined, indicates that wait4() exists.
- */
-#define HAS_WAIT4 /**/
-
-/* HAS_WAITPID:
- * This symbol, if defined, indicates that the waitpid routine is
- * available to wait for child process.
- */
-#define HAS_WAITPID /**/
-
-/* HAS_WCSTOMBS:
- * This symbol, if defined, indicates that the wcstombs routine is
- * available to convert wide character strings to multibyte strings.
- */
-#define HAS_WCSTOMBS /**/
-
-/* HAS_WCTOMB:
- * This symbol, if defined, indicates that the wctomb routine is available
- * to covert a wide character to a multibyte.
- */
-#define HAS_WCTOMB /**/
-
-/* Fpos_t:
- * This symbol holds the type used to declare file positions in libc.
- * It can be fpos_t, long, uint, etc... It may be necessary to include
- * <sys/types.h> to get any typedef'ed information.
- */
-#define Fpos_t fpos_t /* File position type */
-
-/* Gid_t:
- * This symbol holds the return type of getgid() and the type of
- * argument to setrgid() and related functions. Typically,
- * it is the type of group ids in the kernel. It can be int, ushort,
- * uid_t, etc... It may be necessary to include <sys/types.h> to get
- * any typedef'ed information.
- */
-#define Gid_t gid_t /* Type for getgid(), etc... */
-
-/* Groups_t:
- * This symbol holds the type used for the second argument to
- * [gs]etgroups(). Usually, this is the same of gidtype, but
- * sometimes it isn't. It can be int, ushort, uid_t, etc...
- * It may be necessary to include <sys/types.h> to get any
- * typedef'ed information. This is only required if you have
- * getgroups() or setgroups().
- */
-#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
-#define Groups_t gid_t /* Type for 2nd arg to [gs]etgroups() */
-#endif
-
-/* DB_Prefix_t:
- * This symbol contains the type of the prefix structure element
- * in the <db.h> header file. In older versions of DB, it was
- * int, while in newer ones it is u_int32_t.
- */
-/* DB_Hash_t:
- * This symbol contains the type of the prefix structure element
- * in the <db.h> header file. In older versions of DB, it was
- * int, while in newer ones it is size_t.
- */
-#define DB_Hash_t int /**/
-#define DB_Prefix_t int /**/
-
-/* I_DIRENT:
- * This symbol, if defined, indicates to the C program that it should
- * include <dirent.h>. Using this symbol also triggers the definition
- * of the Direntry_t define which ends up being 'struct dirent' or
- * 'struct direct' depending on the availability of <dirent.h>.
- */
-/* DIRNAMLEN:
- * This symbol, if defined, indicates to the C program that the length
- * of directory entry names is provided by a d_namlen field. Otherwise
- * you need to do strlen() on the d_name field.
- */
-/* Direntry_t:
- * This symbol is set to 'struct direct' or 'struct dirent' depending on
- * whether dirent is available or not. You should use this pseudo type to
- * portably declare your directory entries.
- */
-#define I_DIRENT /**/
-/*#define DIRNAMLEN / **/
-#define Direntry_t struct dirent
-
-/* I_DLFCN:
- * This symbol, if defined, indicates that <dlfcn.h> exists and should
- * be included.
- */
-#define I_DLFCN /**/
-
-/* I_FCNTL:
- * This manifest constant tells the C program to include <fcntl.h>.
- */
-#define I_FCNTL /**/
-
-/* I_FLOAT:
- * This symbol, if defined, indicates to the C program that it should
- * include <float.h> to get definition of symbols like DBL_MAX or
- * DBL_MIN, i.e. machine dependent floating point values.
- */
-#define I_FLOAT /**/
-
-/* I_GRP:
- * This symbol, if defined, indicates to the C program that it should
- * include <grp.h>.
- */
-#define I_GRP /**/
-
-/* I_LIMITS:
- * This symbol, if defined, indicates to the C program that it should
- * include <limits.h> to get definition of symbols like WORD_BIT or
- * LONG_MAX, i.e. machine dependant limitations.
- */
-#define I_LIMITS /**/
-
-/* I_MATH:
- * This symbol, if defined, indicates to the C program that it should
- * include <math.h>.
- */
-#define I_MATH /**/
-
-/* I_MEMORY:
- * This symbol, if defined, indicates to the C program that it should
- * include <memory.h>.
- */
-/*#define I_MEMORY / **/
-
-/* I_NDBM:
- * This symbol, if defined, indicates that <ndbm.h> exists and should
- * be included.
- */
-#define I_NDBM /**/
-
-/* I_NET_ERRNO:
- * This symbol, if defined, indicates that <net/errno.h> exists and
- * should be included.
- */
-/*#define I_NET_ERRNO / **/
-
-/* I_NETINET_IN:
- * This symbol, if defined, indicates to the C program that it should
- * include <netinet/in.h>. Otherwise, you may try <sys/in.h>.
- */
-#define I_NETINET_IN /**/
-
-/* I_PWD:
- * This symbol, if defined, indicates to the C program that it should
- * include <pwd.h>.
- */
-/* PWQUOTA:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_quota.
- */
-/* PWAGE:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_age.
- */
-/* PWCHANGE:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_change.
- */
-/* PWCLASS:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_class.
- */
-/* PWEXPIRE:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_expire.
- */
-/* PWCOMMENT:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_comment.
- */
-#define I_PWD /**/
-/*#define PWQUOTA / **/
-#define PWAGE /**/
-/*#define PWCHANGE / **/
-/*#define PWCLASS / **/
-/*#define PWEXPIRE / **/
-#define PWCOMMENT /**/
-
-/* I_STDDEF:
- * This symbol, if defined, indicates that <stddef.h> exists and should
- * be included.
- */
-#define I_STDDEF /**/
-
-/* I_STDLIB:
- * This symbol, if defined, indicates that <stdlib.h> exists and should
- * be included.
- */
-#define I_STDLIB /**/
-
-/* I_STRING:
- * This symbol, if defined, indicates to the C program that it should
- * include <string.h> (USG systems) instead of <strings.h> (BSD systems).
- */
-#define I_STRING /**/
-
-/* I_SYS_DIR:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/dir.h>.
- */
-/*#define I_SYS_DIR / **/
-
-/* I_SYS_FILE:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/file.h> to get definition of R_OK and friends.
- */
-/*#define I_SYS_FILE / **/
-
-/* I_SYS_IOCTL:
- * This symbol, if defined, indicates that <sys/ioctl.h> exists and should
- * be included. Otherwise, include <sgtty.h> or <termio.h>.
- */
-#define I_SYS_IOCTL /**/
-
-/* I_SYS_NDIR:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/ndir.h>.
- */
-/*#define I_SYS_NDIR / **/
-
-/* I_SYS_PARAM:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/param.h>.
- */
-#define I_SYS_PARAM /**/
-
-/* I_SYS_RESOURCE:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/resource.h>.
- */
-#define I_SYS_RESOURCE /**/
-
-/* I_SYS_SELECT:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/select.h> in order to get definition of struct timeval.
- */
-#define I_SYS_SELECT /**/
-
-/* I_SYS_TIMES:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/times.h>.
- */
-#define I_SYS_TIMES /**/
-
-/* I_SYS_TYPES:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/types.h>.
- */
-#define I_SYS_TYPES /**/
-
-/* I_SYS_UN:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/un.h> to get UNIX domain socket definitions.
- */
-#define I_SYS_UN /**/
-
-/* I_SYS_WAIT:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/wait.h>.
- */
-#define I_SYS_WAIT /**/
-
-/* I_TERMIO:
- * This symbol, if defined, indicates that the program should include
- * <termio.h> rather than <sgtty.h>. There are also differences in
- * the ioctl() calls that depend on the value of this symbol.
- */
-/* I_TERMIOS:
- * This symbol, if defined, indicates that the program should include
- * the POSIX termios.h rather than sgtty.h or termio.h.
- * There are also differences in the ioctl() calls that depend on the
- * value of this symbol.
- */
-/* I_SGTTY:
- * This symbol, if defined, indicates that the program should include
- * <sgtty.h> rather than <termio.h>. There are also differences in
- * the ioctl() calls that depend on the value of this symbol.
- */
-/*#define I_TERMIO / **/
-#define I_TERMIOS /**/
-/*#define I_SGTTY / **/
-
-/* I_TIME:
- * This symbol, if defined, indicates to the C program that it should
- * include <time.h>.
- */
-/* I_SYS_TIME:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/time.h>.
- */
-/* I_SYS_TIME_KERNEL:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/time.h> with KERNEL defined.
- */
-/*#define I_TIME / **/
-#define I_SYS_TIME /**/
-/*#define I_SYS_TIME_KERNEL / **/
-
-/* I_UNISTD:
- * This symbol, if defined, indicates to the C program that it should
- * include <unistd.h>.
- */
-#define I_UNISTD /**/
-
-/* I_UTIME:
- * This symbol, if defined, indicates to the C program that it should
- * include <utime.h>.
- */
-#define I_UTIME /**/
-
-/* I_STDARG:
- * This symbol, if defined, indicates that <stdarg.h> exists and should
- * be included.
- */
-/* I_VARARGS:
- * This symbol, if defined, indicates to the C program that it should
- * include <varargs.h>.
- */
-#define I_STDARG /**/
-/*#define I_VARARGS / **/
-
-/* I_VFORK:
- * This symbol, if defined, indicates to the C program that it should
- * include vfork.h.
- */
-/*#define I_VFORK / **/
-
-/* INTSIZE:
- * This symbol contains the value of sizeof(int) so that the C
- * preprocessor can make decisions based on it.
- */
-/* LONGSIZE:
- * This symbol contains the value of sizeof(long) so that the C
- * preprocessor can make decisions based on it.
- */
-/* SHORTSIZE:
- * This symbol contains the value of sizeof(short) so that the C
- * preprocessor can make decisions based on it.
- */
-#define INTSIZE 4 /**/
-#define LONGSIZE 4 /**/
-#define SHORTSIZE 2 /**/
-
-/* Off_t:
- * This symbol holds the type used to declare offsets in the kernel.
- * It can be int, long, off_t, etc... It may be necessary to include
- * <sys/types.h> to get any typedef'ed information.
- */
-#define Off_t off_t /* <offset> type */
-
-/* Mode_t:
- * This symbol holds the type used to declare file modes
- * for systems calls. It is usually mode_t, but may be
- * int or unsigned short. It may be necessary to include <sys/types.h>
- * to get any typedef'ed information.
- */
-#define Mode_t mode_t /* file mode parameter for system calls */
-
-/* VAL_O_NONBLOCK:
- * This symbol is to be used during open() or fcntl(F_SETFL) to turn on
- * non-blocking I/O for the file descriptor. Note that there is no way
- * back, i.e. you cannot turn it blocking again this way. If you wish to
- * alternatively switch between blocking and non-blocking, use the
- * ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
- */
-/* VAL_EAGAIN:
- * This symbol holds the errno error code set by read() when no data was
- * present on the non-blocking file descriptor.
- */
-/* RD_NODATA:
- * This symbol holds the return code from read() when no data is present
- * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
- * not defined, then you can't distinguish between no data and EOF by
- * issuing a read(). You'll have to find another way to tell for sure!
- */
-/* EOF_NONBLOCK:
- * This symbol, if defined, indicates to the C program that a read() on
- * a non-blocking file descriptor will return 0 on EOF, and not the value
- * held in RD_NODATA (-1 usually, in that case!).
- */
-#define VAL_O_NONBLOCK O_NONBLOCK
-#define VAL_EAGAIN EAGAIN
-#define RD_NODATA -1
-#define EOF_NONBLOCK
-
-/* CAN_PROTOTYPE:
- * If defined, this macro indicates that the C compiler can handle
- * function prototypes.
- */
-/* _:
- * This macro is used to declare function parameters for folks who want
- * to make declarations with prototypes using a different style than
- * the above macros. Use double parentheses. For example:
- *
- * int main _((int argc, char *argv[]));
- */
-#define CAN_PROTOTYPE /**/
-#ifdef CAN_PROTOTYPE
-#define _(args) args
-#else
-#define _(args) ()
-#endif
-
-/* RANDBITS:
- * This symbol contains the number of bits of random number the rand()
- * function produces. Usual values are 15, 16, and 31.
- */
-#define RANDBITS 15 /**/
-
-/* Select_fd_set_t:
- * This symbol holds the type used for the 2nd, 3rd, and 4th
- * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET
- * is defined, and 'int *' otherwise. This is only useful if you
- * have select(), of course.
- */
-#define Select_fd_set_t fd_set * /**/
-
-/* Size_t:
- * This symbol holds the type used to declare length parameters
- * for string functions. It is usually size_t, but may be
- * unsigned long, int, etc. It may be necessary to include
- * <sys/types.h> to get any typedef'ed information.
- */
-#define Size_t size_t /* length paramater for string functions */
-
-/* SSize_t:
- * This symbol holds the type used by functions that return
- * a count of bytes or an error condition. It must be a signed type.
- * It is usually ssize_t, but may be long or int, etc.
- * It may be necessary to include <sys/types.h> or <unistd.h>
- * to get any typedef'ed information.
- * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
- */
-#define SSize_t ssize_t /* signed count of bytes */
-
-/* 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 /**/
-
-/* Uid_t:
- * This symbol holds the type used to declare user ids in the kernel.
- * It can be int, ushort, uid_t, etc... It may be necessary to include
- * <sys/types.h> to get any typedef'ed information.
- */
-#define Uid_t uid_t /* UID type */
-
-/* LOC_SED:
- * This symbol holds the complete pathname to the sed program.
- */
-#define LOC_SED "/bin/sed" /**/
-
-/* OSNAME:
- * This symbol contains the name of the operating system, as determined
- * by Configure. You shouldn't rely on it too much; the specific
- * feature tests from Configure are generally more reliable.
- */
-#define OSNAME "solaris" /**/
-
-/* ARCHLIB:
- * This variable, if defined, holds the name of the directory in
- * which the user wants to put architecture-dependent public
- * library files for perl5. It is most often a local directory
- * such as /usr/local/lib. Programs using this variable must be
- * prepared to deal with filename expansion. If ARCHLIB is the
- * same as PRIVLIB, it is not defined, since presumably the
- * program already searches PRIVLIB.
- */
-/* ARCHLIB_EXP:
- * 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/i86pc-solaris/5.00305" /**/
-#define ARCHLIB_EXP "/opt/perl/lib/i86pc-solaris/5.00305" /**/
-
-/* BINCOMPAT3:
- * This symbol, if defined, indicates that Perl 5.004 should be
- * binary-compatible with Perl 5.003.
- */
-#define BINCOMPAT3 /**/
-
-/* BYTEORDER:
- * This symbol holds the hexadecimal constant defined in byteorder,
- * i.e. 0x1234 or 0x4321, etc...
- * On NeXT 4 (and greater), you can build "Fat" Multiple Architecture
- * Binaries (MAB) on either big endian or little endian machines.
- * The endian-ness is available at compile-time. This only matters
- * for perl, where the config.h can be generated and installed on
- * one system, and used by a different architecture to build an
- * extension. Older versions of NeXT that might not have
- * defined either *_ENDIAN__ were all on Motorola 680x0 series,
- * so the default case (for NeXT) is big endian to catch them.
- * This might matter for NeXT 3.0.
- */
-#ifndef NeXT
-#define BYTEORDER 0x1234 /* large digits for MSB */
-#else /* NeXT */
-#ifdef __LITTLE_ENDIAN__
-#define BYTEORDER 0x1234
-#else /* __BIG_ENDIAN__ */
-#define BYTEORDER 0x4321
-#endif /* ENDIAN CHECK */
-#endif /* NeXT */
-
-/* CSH:
- * This symbol, if defined, indicates that the C-shell exists.
- * If defined, contains the full pathname of csh.
- */
-#define CSH "/bin/csh" /**/
-
-/* DLSYM_NEEDS_UNDERSCORE:
- * This symbol, if defined, indicates that we need to prepend an
- * underscore to the symbol name before calling dlsym(). This only
- * makes sense if you *have* dlsym, which we will presume is the
- * case if you're using dl_dlopen.xs.
- */
-/*#define DLSYM_NEEDS_UNDERSCORE / **/
-
-/* SETUID_SCRIPTS_ARE_SECURE_NOW:
- * This symbol, if defined, indicates that the bug that prevents
- * setuid scripts from being secure is not present in this kernel.
- */
-/* DOSUID:
- * This symbol, if defined, indicates that the C program should
- * check the script that it is executing for setuid/setgid bits, and
- * attempt to emulate setuid/setgid on systems that have disabled
- * setuid #! scripts because the kernel can't do it securely.
- * It is up to the package designer to make sure that this emulation
- * is done securely. Among other things, it should do an fstat on
- * the script it just opened to make sure it really is a setuid/setgid
- * script, it should make sure the arguments passed correspond exactly
- * to the argument on the #! line, and it should not trust any
- * subprocesses to which it must pass the filename rather than the
- * file descriptor of the script to be executed.
- */
-#define SETUID_SCRIPTS_ARE_SECURE_NOW /**/
-/*#define DOSUID / **/
-
-/* Gconvert:
- * This preprocessor macro is defined to convert a floating point
- * number to a string without a trailing decimal point. This
- * emulates the behavior of sprintf("%g"), but is sometimes much more
- * efficient. If gconvert() is not available, but gcvt() drops the
- * trailing decimal point, then gcvt() is used. If all else fails,
- * a macro using sprintf("%g") is used. Arguments for the Gconvert
- * macro are: value, number of digits, whether trailing zeros should
- * be retained, and the output buffer.
- * Possible values are:
- * d_Gconvert='gconvert((x),(n),(t),(b))'
- * d_Gconvert='gcvt((x),(n),(b))'
- * d_Gconvert='sprintf((b),"%.*g",(n),(x))'
- * The last two assume trailing zeros should not be kept.
- */
-#define Gconvert(x,n,t,b) gconvert((x),(n),(t),(b))
-
-/* HAS_GETPGID:
- * This symbol, if defined, indicates to the C program that
- * the getpgid(pid) function is available to get the
- * process group id.
- */
-#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_INET_ATON:
- * This symbol, if defined, indicates to the C program that the
- * inet_aton() function is available to parse IP address "dotted-quad"
- * strings.
- */
-#define HAS_INET_ATON /**/
-
-/* HAS_SETPGID:
- * This symbol, if defined, indicates to the C program that
- * the setpgid(pid, gpid) function is available to set the
- * process group id.
- */
-#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.
- */
-/* USE_BSDPGRP:
- * This symbol, if defined, indicates that the BSD notion of process
- * group is to be used. For instance, you have to say setpgrp(pid, pgrp)
- * instead of the USG setpgrp(). This should be obsolete since
- * there are systems which have BSD-ish setpgrp but USG-ish getpgrp.
- */
-#define HAS_SETPGRP /**/
-/*#define USE_BSD_SETPGRP / **/
-/*#define USE_BSDPGRP / **/
-
-/* USE_SFIO:
- * This symbol, if defined, indicates that sfio should
- * be used.
- */
-/*#define USE_SFIO / **/
-
-/* Sigjmp_buf:
- * This is the buffer type to be used with Sigsetjmp and Siglongjmp.
- */
-/* Sigsetjmp:
- * This macro is used in the same way as sigsetjmp(), but will invoke
- * traditional setjmp() if sigsetjmp isn't available.
- * See HAS_SIGSETJMP.
- */
-/* Siglongjmp:
- * This macro is used in the same way as siglongjmp(), but will invoke
- * traditional longjmp() if siglongjmp isn't available.
- * See HAS_SIGSETJMP.
- */
-#define HAS_SIGSETJMP /**/
-#ifdef HAS_SIGSETJMP
-#define Sigjmp_buf sigjmp_buf
-#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask))
-#define Siglongjmp(buf,retval) siglongjmp((buf),(retval))
-#else
-#define Sigjmp_buf jmp_buf
-#define Sigsetjmp(buf,save_mask) setjmp((buf))
-#define Siglongjmp(buf,retval) longjmp((buf),(retval))
-#endif
-
-/* USE_DYNAMIC_LOADING:
- * This symbol, if defined, indicates that dynamic loading of
- * some sort is available.
- */
-#define USE_DYNAMIC_LOADING /**/
-
-/* I_DBM:
- * This symbol, if defined, indicates that <dbm.h> exists and should
- * be included.
- */
-/* I_RPCSVC_DBM:
- * This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and
- * should be included.
- */
-/*#define I_DBM / **/
-#define I_RPCSVC_DBM /**/
-
-/* I_LOCALE:
- * This symbol, if defined, indicates to the C program that it should
- * include <locale.h>.
- */
-#define I_LOCALE /**/
-
-/* I_SFIO:
- * This symbol, if defined, indicates to the C program that it should
- * include <sfio.h>.
- */
-/*#define I_SFIO / **/
-
-/* I_SYS_STAT:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/stat.h>.
- */
-#define I_SYS_STAT /**/
-
-/* I_VALUES:
- * This symbol, if defined, indicates to the C program that it should
- * include <values.h> to get definition of symbols like MINFLOAT or
- * MAXLONG, i.e. machine dependant limitations. Probably, you
- * should use <limits.h> instead, if it is available.
- */
-#define I_VALUES /**/
-
-/* Free_t:
- * This variable contains the return type of free(). It is usually
- * void, but occasionally int.
- */
-/* Malloc_t:
- * This symbol is the type of pointer returned by malloc and realloc.
- */
-#define Malloc_t void * /**/
-#define Free_t void /**/
-
-/* MYMALLOC:
- * This symbol, if defined, indicates that we're using our own malloc.
- */
-#define MYMALLOC /**/
-
-/* OLDARCHLIB:
- * This variable, if defined, holds the name of the directory in
- * which the user has perl5.000 or perl5.001 architecture-dependent
- * public library files for perl5. For the most part, these
- * files will work with 5.002 (and later), but that is not
- * guaranteed.
- */
-/* OLDARCHLIB_EXP:
- * This symbol contains the ~name expanded version of OLDARCHLIB, to be
- * used in programs that are not prepared to deal with ~ expansion at
- * run-time.
- */
-/*#define OLDARCHLIB "" / **/
-/*#define OLDARCHLIB_EXP "" / **/
-
-/* PRIVLIB:
- * This symbol contains the name of the private library for this package.
- * The library is private in the sense that it needn't be in anyone's
- * execution path, but it should be accessible by the world. The program
- * should be prepared to do ~ expansion.
- */
-/* PRIVLIB_EXP:
- * 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" /**/
-#define PRIVLIB_EXP "/opt/perl/lib" /**/
-
-/* SH_PATH:
- * This symbol contains the full pathname to the shell used on this
- * on this system to execute Bourne shell scripts. Usually, this will be
- * /bin/sh, though it's possible that some systems will have /bin/ksh,
- * /bin/pdksh, /bin/ash, /bin/bash, or even something such as
- * D:/bin/sh.exe.
- */
-#define SH_PATH "/bin/sh" /**/
-
-/* SIG_NAME:
- * This symbol contains a list of signal names in order of
- * signal number. This is intended
- * to be used as a static array initialization, like this:
- * char *sig_name[] = { SIG_NAME };
- * The signals in the list are separated with commas, and each signal
- * is surrounded by double quotes. There is no leading SIG in the signal
- * name, i.e. SIGQUIT is known as "QUIT".
- * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn,
- * etc., where nn is the actual signal number (e.g. NUM37).
- * The signal number for sig_name[i] is stored in sig_num[i].
- * The last element is 0 to terminate the list with a NULL. This
- * corresponds to the 0 at the end of the sig_num list.
- */
-/* SIG_NUM:
- * This symbol contains a list of signal numbers, in the same order as the
- * SIG_NAME list. It is suitable for static array initialization, as in:
- * int sig_num[] = { SIG_NUM };
- * The signals in the list are separated with commas, and the indices
- * within that list and the SIG_NAME list match, so it's easy to compute
- * the signal name from a number or vice versa at the price of a small
- * dynamic linear lookup.
- * Duplicates are allowed, but are moved to the end of the list.
- * The signal number corresponding to sig_name[i] is sig_number[i].
- * if (i < NSIG) then sig_number[i] == i.
- * The last element is 0, corresponding to the 0 at the end of
- * the sig_name list.
- */
-#define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","ABRT","EMT","FPE","KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM","USR1","USR2","CHLD","PWR","WINCH","URG","IO","STOP","TSTP","CONT","TTIN","TTOU","VTALRM","PROF","XCPU","XFSZ","WAITING","LWP","FREEZE","THAW","CANCEL","RTMIN","NUM38","NUM39","NUM40","NUM41","NUM42","NUM43","RTMAX","IOT","CLD","POLL",0 /**/
-#define 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,6,18,22,0 /**/
-
-/* SITEARCH:
- * This symbol contains the name of the private library for this package.
- * The library is private in the sense that it needn't be in anyone's
- * execution path, but it should be accessible by the world. The program
- * should be prepared to do ~ expansion.
- * The standard distribution will put nothing in this directory.
- * Individual sites may place their own extensions and modules in
- * this directory.
- */
-/* SITEARCH_EXP:
- * 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/i86pc-solaris" /**/
-#define SITEARCH_EXP "/opt/perl/lib/site_perl/i86pc-solaris" /**/
-
-/* SITELIB:
- * This symbol contains the name of the private library for this package.
- * The library is private in the sense that it needn't be in anyone's
- * execution path, but it should be accessible by the world. The program
- * should be prepared to do ~ expansion.
- * The standard distribution will put nothing in this directory.
- * Individual sites may place their own extensions and modules in
- * this directory.
- */
-/* SITELIB_EXP:
- * This symbol contains the ~name expanded version of SITELIB, to be used
- * in programs that are not prepared to deal with ~ expansion at run-time.
- */
-#define SITELIB "/opt/perl/lib/site_perl" /**/
-#define SITELIB_EXP "/opt/perl/lib/site_perl" /**/
-
-/* STARTPERL:
- * This variable contains the string to put in front of a perl
- * script to make sure (one hopes) that it runs with perl and not
- * some shell.
- */
-#define STARTPERL "#!/opt/perl/bin/perl" /**/
-
-/* USE_PERLIO:
- * This symbol, if defined, indicates that the PerlIO abstraction should
- * be used throughout. If not defined, stdio should be
- * used in a fully backward compatible manner.
- */
-/*#define USE_PERLIO / **/
-
-/* VOIDFLAGS:
- * This symbol indicates how much support of the void type is given by this
- * compiler. What various bits mean:
- *
- * 1 = supports declaration of void
- * 2 = supports arrays of pointers to functions returning void
- * 4 = supports comparisons between pointers to void functions and
- * addresses of void functions
- * 8 = suports declaration of generic void pointers
- *
- * The package designer should define VOIDUSED to indicate the requirements
- * of the package. This can be done either by #defining VOIDUSED before
- * including config.h, or by defining defvoidused in Myinit.U. If the
- * latter approach is taken, only those flags will be tested. If the
- * level of void support necessary is not present, defines void to int.
- */
-#ifndef VOIDUSED
-#define VOIDUSED 15
-#endif
-#define VOIDFLAGS 15
-#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
-#define void int /* is void to be avoided? */
-#define M_VOID /* Xenix strikes again */
-#endif
-
-#endif
diff --git a/gnu/usr.bin/perl/config_h.SH b/gnu/usr.bin/perl/config_h.SH
index cfae03ad990..0b42d2928d3 100644
--- a/gnu/usr.bin/perl/config_h.SH
+++ b/gnu/usr.bin/perl/config_h.SH
@@ -25,47 +25,24 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
* that running config_h.SH again will wipe out any changes you've made.
* For a more permanent change edit config.sh and rerun config_h.SH.
*
- * \$Id: Config_h.U,v 3.0.1.4 1995/09/25 09:10:49 ram Exp $
+ * \$Id: Config_h.U,v 3.0.1.5 1997/02/28 14:57:43 ram Exp $
*/
-/* Configuration time: $cf_time
- * Configured by: $cf_by
- * Target system: $myuname
+/*
+ * Package name : $package
+ * Source directory : $src
+ * Configuration time: $cf_time
+ * Configured by : $cf_by
+ * Target system : $myuname
*/
#ifndef _config_h_
#define _config_h_
-/* MEM_ALIGNBYTES:
- * This symbol contains the number of bytes required to align a
- * double. Usual values are 2, 4 and 8.
- * On NeXT starting with 3.2, you can build "Fat" Multiple Architecture
- * Binaries (MAB) for targets with varying alignment. This only matters
- * for perl, where the config.h can be generated and installed on one
- * system, and used by a different architecture to build an extension.
- * The default is eight, for safety.
- */
-#ifndef NeXT
-#define MEM_ALIGNBYTES $alignbytes /**/
-#else /* NeXT */
-#ifdef __m68k__
-#define MEM_ALIGNBYTES 2
-#else
-#ifdef __i386__
-#define MEM_ALIGNBYTES 4
-#else /* __hppa__, __sparc__ and default for unknown architectures */
-#define MEM_ALIGNBYTES 8
-#endif /* __i386__ */
-#endif /* __m68k__ */
-#endif /* NeXT */
-
-/* ARCHNAME:
- * This symbol holds a string representing the architecture name.
- * It may be used to construct an architecture-dependant pathname
- * where library files may be held under a private library, for
- * instance.
+/* LOC_SED:
+ * This symbol holds the complete pathname to the sed program.
*/
-#define ARCHNAME "$archname" /**/
+#define LOC_SED "$full_sed" /**/
/* BIN:
* This symbol holds the path of the bin directory where the package will
@@ -78,36 +55,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
#define BIN "$bin" /**/
#define BIN_EXP "$binexp" /**/
-/* CAT2:
- * This macro catenates 2 tokens together.
- */
-/* STRINGIFY:
- * This macro surrounds its token with double quotes.
- */
-#if $cpp_stuff == 1
-#define CAT2(a,b)a/**/b
-#define CAT3(a,b,c)a/**/b/**/c
-#define CAT4(a,b,c,d)a/**/b/**/c/**/d
-#define CAT5(a,b,c,d,e)a/**/b/**/c/**/d/**/e
-#define STRINGIFY(a)"a"
- /* If you can get stringification with catify, tell me how! */
-#endif
-#if $cpp_stuff == 42
-#define CAT2(a,b)a ## b
-#define CAT3(a,b,c)a ## b ## c
-#define CAT4(a,b,c,d)a ## b ## c ## d
-#define CAT5(a,b,c,d,e)a ## b ## c ## d ## e
-#define StGiFy(a)# a
-#define STRINGIFY(a)StGiFy(a)
-#define SCAT2(a,b)StGiFy(a) StGiFy(b)
-#define SCAT3(a,b,c)StGiFy(a) StGiFy(b) StGiFy(c)
-#define SCAT4(a,b,c,d)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d)
-#define SCAT5(a,b,c,d,e)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d) StGiFy(e)
-#endif
-#ifndef CAT2
-#include "Bletch: How does this C preprocessor catenate tokens?"
-#endif
-
/* CPPSTDIN:
* This symbol contains the first part of the string which will invoke
* the C preprocessor on the standard input and produce to standard
@@ -156,27 +103,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$d_bzero HAS_BZERO /**/
-/* CASTI32:
- * This symbol is defined if the C compiler can cast negative
- * or large floating point numbers to 32-bit ints.
- */
-#$d_casti32 CASTI32 /**/
-
-/* CASTNEGFLOAT:
- * This symbol is defined if the C compiler can cast negative
- * numbers to unsigned longs, ints and shorts.
- */
-/* CASTFLAGS:
- * This symbol contains flags that say what difficulties the compiler
- * has casting odd floating values to unsigned long:
- * 0 = ok
- * 1 = couldn't cast < 0
- * 2 = couldn't cast >= 0x80000000
- * 4 = couldn't cast in argument expression list
- */
-#$d_castneg CASTNEGFLOAT /**/
-#define CASTFLAGS $castflags /**/
-
/* HAS_CHOWN:
* This symbol, if defined, indicates that the chown routine is
* available.
@@ -195,12 +121,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$d_chsize HAS_CHSIZE /**/
-/* VOID_CLOSEDIR:
- * This symbol, if defined, indicates that the closedir() routine
- * does not return a value.
- */
-#$d_void_closedir VOID_CLOSEDIR /**/
-
/* HASCONST:
* This symbol, if defined, indicates that this C compiler knows about
* the const type. There is no need to actually test for that symbol
@@ -245,6 +165,26 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$d_dlerror HAS_DLERROR /**/
+/* SETUID_SCRIPTS_ARE_SECURE_NOW:
+ * This symbol, if defined, indicates that the bug that prevents
+ * setuid scripts from being secure is not present in this kernel.
+ */
+/* DOSUID:
+ * This symbol, if defined, indicates that the C program should
+ * check the script that it is executing for setuid/setgid bits, and
+ * attempt to emulate setuid/setgid on systems that have disabled
+ * setuid #! scripts because the kernel can't do it securely.
+ * It is up to the package designer to make sure that this emulation
+ * is done securely. Among other things, it should do an fstat on
+ * the script it just opened to make sure it really is a setuid/setgid
+ * script, it should make sure the arguments passed correspond exactly
+ * to the argument on the #! line, and it should not trust any
+ * subprocesses to which it must pass the filename rather than the
+ * file descriptor of the script to be executed.
+ */
+#$d_suidsafe SETUID_SCRIPTS_ARE_SECURE_NOW /**/
+#$d_dosuid DOSUID /**/
+
/* HAS_DUP2:
* This symbol, if defined, indicates that the dup2 routine is
* available to duplicate file descriptors.
@@ -299,6 +239,54 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$d_fsetpos HAS_FSETPOS /**/
+/* I_SYS_MOUNT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/mount.h>.
+ */
+#$i_sysmount I_SYS_MOUNT /**/
+
+/* HAS_FSTATFS:
+ * This symbol, if defined, indicates that the fstatfs routine is
+ * available to stat the filesystem of a file descriptor.
+ */
+#$d_fstatfs HAS_FSTATFS /**/
+
+/* HAS_STRUCT_STATFS_FLAGS:
+ * This symbol, if defined, indicates that the struct statfs has
+ * the f_flags member for mount flags.
+ */
+#$d_statfsflags HAS_STRUCT_STATFS_FLAGS /**/
+
+/* I_SYS_STATVFS:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/statvfs.h>.
+ */
+#$i_sysstatvfs I_SYS_STATVFS /**/
+
+/* HAS_FSTATVFS:
+ * This symbol, if defined, indicates that the fstatvfs routine is
+ * available to stat the filesystem of a file descriptor.
+ */
+#$d_fstatvfs HAS_FSTATVFS /**/
+
+/* I_MNTENT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <mntent.h>.
+ */
+#$i_mntent I_MNTENT /**/
+
+/* HAS_GETMNTENT:
+ * This symbol, if defined, indicates that the getmntent routine is
+ * available to lookup mount entries in some data base or other.
+ */
+#$d_getmntent HAS_GETMNTENT /**/
+
+/* HAS_HASMNTOPT:
+ * This symbol, if defined, indicates that the hasmntopt routine is
+ * available to query mount entries returned by getmntent.
+ */
+#$d_hasmntopt HAS_HASMNTOPT /**/
+
/* HAS_GETTIMEOFDAY:
* This symbol, if defined, indicates that the gettimeofday() system
* call is available for a sub-second accuracy clock. Usually, the file
@@ -315,19 +303,7 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
* available to get the list of process groups. If unavailable, multiple
* groups are probably not supported.
*/
-/* HAS_SETGROUPS:
- * This symbol, if defined, indicates that the setgroups() routine is
- * available to set the list of process groups. If unavailable, multiple
- * groups are probably not supported.
- */
#$d_getgrps HAS_GETGROUPS /**/
-#$d_setgrps HAS_SETGROUPS /**/
-
-/* HAS_GETHOSTENT:
- * This symbol, if defined, indicates that the gethostent routine is
- * available to lookup host names in some data base or other.
- */
-#$d_gethent HAS_GETHOSTENT /**/
/* HAS_UNAME:
* This symbol, if defined, indicates that the C program may use the
@@ -342,6 +318,24 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$d_getlogin HAS_GETLOGIN /**/
+/* HAS_GETPGID:
+ * This symbol, if defined, indicates to the C program that
+ * the getpgid(pid) function is available to get the
+ * process group id.
+ */
+#$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.
@@ -385,11 +379,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
#$d_htonl HAS_NTOHL /**/
#$d_htonl HAS_NTOHS /**/
-/* HAS_ISASCII:
- * This manifest constant lets the C program know that isascii
- * is available.
+/* HAS_INET_ATON:
+ * This symbol, if defined, indicates to the C program that the
+ * inet_aton() function is available to parse IP address "dotted-quad"
+ * strings.
*/
-#$d_isascii HAS_ISASCII /**/
+#$d_inetaton HAS_INET_ATON /**/
/* HAS_KILLPG:
* This symbol, if defined, indicates that the killpg routine is available
@@ -499,12 +494,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$d_nice HAS_NICE /**/
-/* HAS_OPEN3:
- * This manifest constant lets the C program know that the three
- * argument form of open(2) is available.
- */
-#$d_open3 HAS_OPEN3 /**/
-
/* HAS_PATHCONF:
* This symbol, if defined, indicates that pathconf() is available
* to determine file-system related limits and options associated
@@ -532,7 +521,8 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
/* HAS_POLL:
* This symbol, if defined, indicates that the poll routine is
- * available to poll active file descriptors.
+ * available to poll active file descriptors. You may safely
+ * include <poll.h> when this symbol is defined.
*/
#$d_poll HAS_POLL /**/
@@ -581,29 +571,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$d_rmdir HAS_RMDIR /**/
-/* HAS_SAFE_BCOPY:
- * This symbol, if defined, indicates that the bcopy routine is available
- * to copy potentially overlapping memory blocks. Otherwise you should
- * probably use memmove() or memcpy(). If neither is defined, roll your
- * own version.
- */
-#$d_safebcpy HAS_SAFE_BCOPY /**/
-
-/* HAS_SAFE_MEMCPY:
- * This symbol, if defined, indicates that the memcpy routine is available
- * to copy potentially overlapping memory blocks. Otherwise you should
- * probably use memmove() or memcpy(). If neither is defined, roll your
- * own version.
- */
-#$d_safemcpy HAS_SAFE_MEMCPY /**/
-
-/* HAS_SANE_MEMCMP:
- * This symbol, if defined, indicates that the memcmp routine is available
- * and can be used to compare relative magnitudes of chars with their high
- * bits set. If it is not defined, roll your own version.
- */
-#$d_sanemcmp HAS_SANE_MEMCMP /**/
-
/* HAS_SELECT:
* This symbol, if defined, indicates that the select routine is
* available to select active file descriptors. If the timeout field
@@ -642,6 +609,24 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$d_setlocale HAS_SETLOCALE /**/
+/* HAS_SETPGID:
+ * This symbol, if defined, indicates that the setpgid(pid, gpid)
+ * routine is available to set process group ID.
+ */
+#$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.
@@ -718,88 +703,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
#define Shmat_t $shmattype /**/
#$d_shmatprototype HAS_SHMAT_PROTOTYPE /**/
-/* HAS_SIGACTION:
- * This symbol, if defined, indicates that Vr4's sigaction() routine
- * is available.
- */
-#$d_sigaction HAS_SIGACTION /**/
-
-/* HAS_SOCKET:
- * This symbol, if defined, indicates that the BSD socket interface is
- * supported.
- */
-/* HAS_SOCKETPAIR:
- * This symbol, if defined, indicates that the BSD socketpair() call is
- * supported.
- */
-#$d_socket HAS_SOCKET /**/
-#$d_sockpair HAS_SOCKETPAIR /**/
-
/* USE_STAT_BLOCKS:
* This symbol is defined if this system has a stat structure declaring
* st_blksize and st_blocks.
*/
#$d_statblks USE_STAT_BLOCKS /**/
-/* USE_STDIO_PTR:
- * This symbol is defined if the _ptr and _cnt fields (or similar)
- * of the stdio FILE structure can be used to access the stdio buffer
- * for a file handle. If this is defined, then the FILE_ptr(fp)
- * and FILE_cnt(fp) macros will also be defined and should be used
- * to access these fields.
- */
-/* FILE_ptr:
- * This macro is used to access the _ptr field (or equivalent) of the
- * FILE structure pointed to by its argument. This macro will always be
- * defined if USE_STDIO_PTR is defined.
- */
-/* STDIO_PTR_LVALUE:
- * This symbol is defined if the FILE_ptr macro can be used as an
- * lvalue.
- */
-/* FILE_cnt:
- * This macro is used to access the _cnt field (or equivalent) of the
- * FILE structure pointed to by its argument. This macro will always be
- * defined if USE_STDIO_PTR is defined.
- */
-/* STDIO_CNT_LVALUE:
- * This symbol is defined if the FILE_cnt macro can be used as an
- * lvalue.
- */
-#$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 /**/
-#endif
-
-/* USE_STDIO_BASE:
- * This symbol is defined if the _base field (or similar) of the
- * stdio FILE structure can be used to access the stdio buffer for
- * a file handle. If this is defined, then the FILE_base(fp) macro
- * will also be defined and should be used to access this field.
- * Also, the FILE_bufsiz(fp) macro will be defined and should be used
- * to determine the number of bytes in the buffer. USE_STDIO_BASE
- * will never be defined unless USE_STDIO_PTR is.
- */
-/* FILE_base:
- * This macro is used to access the _base field (or equivalent) of the
- * FILE structure pointed to by its argument. This macro will always be
- * defined if USE_STDIO_BASE is defined.
- */
-/* FILE_bufsiz:
- * This macro is used to determine the number of bytes in the I/O
- * buffer pointed to by _base field (or equivalent) of the FILE
- * structure pointed to its argument. This macro will always be defined
- * if USE_STDIO_BASE is defined.
- */
-#$d_stdiobase USE_STDIO_BASE /**/
-#ifdef USE_STDIO_BASE
-#define FILE_base(fp) $stdio_base
-#define FILE_bufsiz(fp) $stdio_bufsiz
-#endif
-
/* HAS_STRCHR:
* This symbol is defined to indicate that the strchr()/strrchr()
* functions are available for string searching. If not, try the
@@ -904,20 +813,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$d_tcsetpgrp HAS_TCSETPGRP /**/
-/* Time_t:
- * This symbol holds the type returned by time(). It can be long,
- * or time_t on BSD sites (in which case <sys/types.h> should be
- * included).
- */
-#define Time_t $timetype /* Time type */
-
-/* HAS_TIMES:
- * This symbol, if defined, indicates that the times() routine exists.
- * Note that this became obsolete on some systems (SUNOS), which now
- * use getrusage(). It may be necessary to include <sys/times.h>.
- */
-#$d_times HAS_TIMES /**/
-
/* HAS_TRUNCATE:
* This symbol, if defined, indicates that the truncate routine is
* available to truncate files.
@@ -941,14 +836,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$d_vfork HAS_VFORK /**/
-/* Signal_t:
- * This symbol's value is either "void" or "int", corresponding to the
- * appropriate return type of a signal handler. Thus, you can declare
- * a signal handler using "Signal_t (*handler)()", and define the
- * handler using "Signal_t handler(sig)".
- */
-#define Signal_t $signal_t /* Signal handler's return type */
-
/* HASVOLATILE:
* This symbol, if defined, indicates that this C compiler knows about
* the volatile declaration.
@@ -958,20 +845,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
#define volatile
#endif
-/* HAS_VPRINTF:
- * This symbol, if defined, indicates that the vprintf routine is available
- * to printf with a pointer to an argument list. If unavailable, you
- * may need to write your own, probably in terms of _doprnt().
- */
-/* USE_CHAR_VSPRINTF:
- * This symbol is defined if this system has vsprintf() returning type
- * (char*). The trend seems to be to declare it as "int vsprintf()". It
- * is up to the package author to declare vsprintf correctly based on the
- * symbol.
- */
-#$d_vprintf HAS_VPRINTF /**/
-#$d_charvspr USE_CHAR_VSPRINTF /**/
-
/* HAS_WAIT4:
* This symbol, if defined, indicates that wait4() exists.
*/
@@ -995,46 +868,28 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$d_wctomb HAS_WCTOMB /**/
-/* Fpos_t:
- * This symbol holds the type used to declare file positions in libc.
- * It can be fpos_t, long, uint, etc... It may be necessary to include
- * <sys/types.h> to get any typedef'ed information.
+/* EBCDIC:
+ * This symbol, if defined, indicates that this system uses
+ * EBCDIC encoding.
*/
-#define Fpos_t $fpostype /* File position type */
+#$ebcdic EBCDIC /**/
-/* Gid_t:
- * This symbol holds the return type of getgid() and the type of
- * argument to setrgid() and related functions. Typically,
- * it is the type of group ids in the kernel. It can be int, ushort,
- * uid_t, etc... It may be necessary to include <sys/types.h> to get
- * any typedef'ed information.
- */
-#define Gid_t $gidtype /* Type for getgid(), etc... */
-
-/* Groups_t:
- * This symbol holds the type used for the second argument to
- * [gs]etgroups(). Usually, this is the same of gidtype, but
- * sometimes it isn't. It can be int, ushort, uid_t, etc...
- * It may be necessary to include <sys/types.h> to get any
- * typedef'ed information. This is only required if you have
- * getgroups() or setgroups().
+/* I_ARPA_INET:
+ * This symbol, if defined, indicates that <arpa/inet.h> exists and should
+ * be included.
*/
-#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
-#define Groups_t $groupstype /* Type for 2nd arg to [gs]etgroups() */
-#endif
+#$i_arpainet I_ARPA_INET /**/
-/* DB_Prefix_t:
- * This symbol contains the type of the prefix structure element
- * in the <db.h> header file. In older versions of DB, it was
- * int, while in newer ones it is u_int32_t.
+/* I_DBM:
+ * This symbol, if defined, indicates that <dbm.h> exists and should
+ * be included.
*/
-/* DB_Hash_t:
- * This symbol contains the type of the prefix structure element
- * in the <db.h> header file. In older versions of DB, it was
- * int, while in newer ones it is size_t.
+/* I_RPCSVC_DBM:
+ * This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and
+ * should be included.
*/
-#define DB_Hash_t $db_hashtype /**/
-#define DB_Prefix_t $db_prefixtype /**/
+#$i_dbm I_DBM /**/
+#$i_rpcsvcdbm I_RPCSVC_DBM /**/
/* I_DIRENT:
* This symbol, if defined, indicates to the C program that it should
@@ -1078,7 +933,27 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
* This symbol, if defined, indicates to the C program that it should
* include <grp.h>.
*/
+/* GRPASSWD:
+ * This symbol, if defined, indicates to the C program that struct group
+ * contains gr_passwd.
+ */
+/* HAS_SETGRENT:
+ * This symbol, if defined, indicates that the getgrent routine is
+ * available for initializing sequential access of the group database.
+ */
+/* HAS_GETGRENT:
+ * This symbol, if defined, indicates that the getgrent routine is
+ * available for sequential access of the group database.
+ */
+/* HAS_ENDGRENT:
+ * This symbol, if defined, indicates that the getgrent routine is
+ * available for finalizing sequential access of the group database.
+ */
#$i_grp I_GRP /**/
+#$d_grpasswd GRPASSWD /**/
+#$d_setgrent HAS_SETGRENT /**/
+#$d_getgrent HAS_GETGRENT /**/
+#$d_endgrent HAS_ENDGRENT /**/
/* I_LIMITS:
* This symbol, if defined, indicates to the C program that it should
@@ -1087,6 +962,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$i_limits I_LIMITS /**/
+/* I_LOCALE:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <locale.h>.
+ */
+#$i_locale I_LOCALE /**/
+
/* I_MATH:
* This symbol, if defined, indicates to the C program that it should
* include <math.h>.
@@ -1117,41 +998,11 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$i_niin I_NETINET_IN /**/
-/* I_PWD:
+/* I_SFIO:
* This symbol, if defined, indicates to the C program that it should
- * include <pwd.h>.
- */
-/* PWQUOTA:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_quota.
- */
-/* PWAGE:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_age.
- */
-/* PWCHANGE:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_change.
- */
-/* PWCLASS:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_class.
- */
-/* PWEXPIRE:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_expire.
- */
-/* PWCOMMENT:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_comment.
+ * include <sfio.h>.
*/
-#$i_pwd I_PWD /**/
-#$d_pwquota PWQUOTA /**/
-#$d_pwage PWAGE /**/
-#$d_pwchange PWCHANGE /**/
-#$d_pwclass PWCLASS /**/
-#$d_pwexpire PWEXPIRE /**/
-#$d_pwcomment PWCOMMENT /**/
+#$i_sfio I_SFIO /**/
/* I_STDDEF:
* This symbol, if defined, indicates that <stddef.h> exists and should
@@ -1213,6 +1064,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$i_sysselct I_SYS_SELECT /**/
+/* I_SYS_STAT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/stat.h>.
+ */
+#$i_sysstat I_SYS_STAT /**/
+
/* I_SYS_TIMES:
* This symbol, if defined, indicates to the C program that it should
* include <sys/times.h>.
@@ -1257,22 +1114,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
#$i_termios I_TERMIOS /**/
#$i_sgtty I_SGTTY /**/
-/* I_TIME:
- * This symbol, if defined, indicates to the C program that it should
- * include <time.h>.
- */
-/* I_SYS_TIME:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/time.h>.
- */
-/* I_SYS_TIME_KERNEL:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/time.h> with KERNEL defined.
- */
-#$i_time I_TIME /**/
-#$i_systime I_SYS_TIME /**/
-#$i_systimek I_SYS_TIME_KERNEL /**/
-
/* I_UNISTD:
* This symbol, if defined, indicates to the C program that it should
* include <unistd.h>.
@@ -1285,6 +1126,14 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$i_utime I_UTIME /**/
+/* I_VALUES:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <values.h> to get definition of symbols like MINFLOAT or
+ * MAXLONG, i.e. machine dependant limitations. Probably, you
+ * should use <limits.h> instead, if it is available.
+ */
+#$i_values I_VALUES /**/
+
/* I_STDARG:
* This symbol, if defined, indicates that <stdarg.h> exists and should
* be included.
@@ -1302,64 +1151,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$i_vfork I_VFORK /**/
-/* INTSIZE:
- * This symbol contains the value of sizeof(int) so that the C
- * preprocessor can make decisions based on it.
- */
-/* LONGSIZE:
- * This symbol contains the value of sizeof(long) so that the C
- * preprocessor can make decisions based on it.
- */
-/* SHORTSIZE:
- * This symbol contains the value of sizeof(short) so that the C
- * preprocessor can make decisions based on it.
- */
-#define INTSIZE $intsize /**/
-#define LONGSIZE $longsize /**/
-#define SHORTSIZE $shortsize /**/
-
-/* Off_t:
- * This symbol holds the type used to declare offsets in the kernel.
- * It can be int, long, off_t, etc... It may be necessary to include
- * <sys/types.h> to get any typedef'ed information.
- */
-#define Off_t $lseektype /* <offset> type */
-
-/* Mode_t:
- * This symbol holds the type used to declare file modes
- * for systems calls. It is usually mode_t, but may be
- * int or unsigned short. It may be necessary to include <sys/types.h>
- * to get any typedef'ed information.
- */
-#define Mode_t $modetype /* file mode parameter for system calls */
-
-/* VAL_O_NONBLOCK:
- * This symbol is to be used during open() or fcntl(F_SETFL) to turn on
- * non-blocking I/O for the file descriptor. Note that there is no way
- * back, i.e. you cannot turn it blocking again this way. If you wish to
- * alternatively switch between blocking and non-blocking, use the
- * ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
- */
-/* VAL_EAGAIN:
- * This symbol holds the errno error code set by read() when no data was
- * present on the non-blocking file descriptor.
- */
-/* RD_NODATA:
- * This symbol holds the return code from read() when no data is present
- * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
- * not defined, then you can't distinguish between no data and EOF by
- * issuing a read(). You'll have to find another way to tell for sure!
- */
-/* EOF_NONBLOCK:
- * This symbol, if defined, indicates to the C program that a read() on
- * a non-blocking file descriptor will return 0 on EOF, and not the value
- * held in RD_NODATA (-1 usually, in that case!).
- */
-#define VAL_O_NONBLOCK $o_nonblock
-#define VAL_EAGAIN $eagain
-#define RD_NODATA $rd_nodata
-#$d_eofnblk EOF_NONBLOCK
-
/* CAN_PROTOTYPE:
* If defined, this macro indicates that the C compiler can handle
* function prototypes.
@@ -1378,37 +1169,14 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
#define _(args) ()
#endif
-/* RANDBITS:
- * This symbol contains the number of bits of random number the rand()
- * function produces. Usual values are 15, 16, and 31.
- */
-#define RANDBITS $randbits /**/
-
-/* Select_fd_set_t:
- * This symbol holds the type used for the 2nd, 3rd, and 4th
- * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET
- * is defined, and 'int *' otherwise. This is only useful if you
- * have select(), of course.
- */
-#define Select_fd_set_t $selecttype /**/
-
-/* Size_t:
- * This symbol holds the type used to declare length parameters
- * for string functions. It is usually size_t, but may be
- * unsigned long, int, etc. It may be necessary to include
- * <sys/types.h> to get any typedef'ed information.
- */
-#define Size_t $sizetype /* length paramater for string functions */
-
-/* SSize_t:
- * This symbol holds the type used by functions that return
- * a count of bytes or an error condition. It must be a signed type.
- * It is usually ssize_t, but may be long or int, etc.
- * It may be necessary to include <sys/types.h> or <unistd.h>
- * to get any typedef'ed information.
- * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
+/* SH_PATH:
+ * This symbol contains the full pathname to the shell used on this
+ * on this system to execute Bourne shell scripts. Usually, this will be
+ * /bin/sh, though it's possible that some systems will have /bin/ksh,
+ * /bin/pdksh, /bin/ash, /bin/bash, or even something such as
+ * D:/bin/sh.exe.
*/
-#define SSize_t $ssizetype /* signed count of bytes */
+#define SH_PATH "$sh" /**/
/* STDCHAR:
* This symbol is defined to be the type of char used in stdio.h.
@@ -1416,46 +1184,16 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#define STDCHAR $stdchar /**/
-/* Uid_t:
- * This symbol holds the type used to declare user ids in the kernel.
- * It can be int, ushort, uid_t, etc... It may be necessary to include
- * <sys/types.h> to get any typedef'ed information.
- */
-#define Uid_t $uidtype /* UID type */
-
-/* LOC_SED:
- * This symbol holds the complete pathname to the sed program.
- */
-#define LOC_SED "$full_sed" /**/
-
-/* OSNAME:
- * This symbol contains the name of the operating system, as determined
- * by Configure. You shouldn't rely on it too much; the specific
- * feature tests from Configure are generally more reliable.
- */
-#define OSNAME "$osname" /**/
-
-/* ARCHLIB:
- * This variable, if defined, holds the name of the directory in
- * which the user wants to put architecture-dependent public
- * library files for $package. It is most often a local directory
- * such as /usr/local/lib. Programs using this variable must be
- * prepared to deal with filename expansion. If ARCHLIB is the
- * same as PRIVLIB, it is not defined, since presumably the
- * program already searches PRIVLIB.
- */
-/* ARCHLIB_EXP:
- * 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.
- */
-#$d_archlib ARCHLIB "$archlib" /**/
-#$d_archlib ARCHLIB_EXP "$archlibexp" /**/
-
-/* BINCOMPAT3:
- * This symbol, if defined, indicates that Perl 5.004 should be
- * binary-compatible with Perl 5.003.
+/* MEM_ALIGNBYTES:
+ * This symbol contains the number of bytes required to align a
+ * double. Usual values are 2, 4 and 8.
+ * On NeXT starting with 3.2, you can build "Fat" Multiple Architecture
+ * Binaries (MAB) for targets with varying alignment. This only matters
+ * for perl, where the config.h can be generated and installed on one
+ * system, and used by a different architecture to build an extension.
+ * The default is eight, for safety.
*/
-#$d_bincompat3 BINCOMPAT3 /**/
+#define MEM_ALIGNBYTES $alignbytes /**/
/* BYTEORDER:
* This symbol holds the hexadecimal constant defined in byteorder,
@@ -1480,39 +1218,32 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
#endif /* ENDIAN CHECK */
#endif /* NeXT */
-/* CSH:
- * This symbol, if defined, indicates that the C-shell exists.
- * If defined, contains the full pathname of csh.
+/* CASTI32:
+ * This symbol is defined if the C compiler can cast negative
+ * or large floating point numbers to 32-bit ints.
*/
-#$d_csh CSH "$full_csh" /**/
+#$d_casti32 CASTI32 /**/
-/* DLSYM_NEEDS_UNDERSCORE:
- * This symbol, if defined, indicates that we need to prepend an
- * underscore to the symbol name before calling dlsym(). This only
- * makes sense if you *have* dlsym, which we will presume is the
- * case if you're using dl_dlopen.xs.
+/* CASTNEGFLOAT:
+ * This symbol is defined if the C compiler can cast negative
+ * numbers to unsigned longs, ints and shorts.
*/
-#$d_dlsymun DLSYM_NEEDS_UNDERSCORE /**/
-
-/* SETUID_SCRIPTS_ARE_SECURE_NOW:
- * This symbol, if defined, indicates that the bug that prevents
- * setuid scripts from being secure is not present in this kernel.
+/* CASTFLAGS:
+ * This symbol contains flags that say what difficulties the compiler
+ * has casting odd floating values to unsigned long:
+ * 0 = ok
+ * 1 = couldn't cast < 0
+ * 2 = couldn't cast >= 0x80000000
+ * 4 = couldn't cast in argument expression list
*/
-/* DOSUID:
- * This symbol, if defined, indicates that the C program should
- * check the script that it is executing for setuid/setgid bits, and
- * attempt to emulate setuid/setgid on systems that have disabled
- * setuid #! scripts because the kernel can't do it securely.
- * It is up to the package designer to make sure that this emulation
- * is done securely. Among other things, it should do an fstat on
- * the script it just opened to make sure it really is a setuid/setgid
- * script, it should make sure the arguments passed correspond exactly
- * to the argument on the #! line, and it should not trust any
- * subprocesses to which it must pass the filename rather than the
- * file descriptor of the script to be executed.
+#$d_castneg CASTNEGFLOAT /**/
+#define CASTFLAGS $castflags /**/
+
+/* VOID_CLOSEDIR:
+ * This symbol, if defined, indicates that the closedir() routine
+ * does not return a value.
*/
-#$d_suidsafe SETUID_SCRIPTS_ARE_SECURE_NOW /**/
-#$d_dosuid DOSUID /**/
+#$d_void_closedir VOID_CLOSEDIR /**/
/* Gconvert:
* This preprocessor macro is defined to convert a floating point
@@ -1531,62 +1262,58 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#define Gconvert(x,n,t,b) $d_Gconvert
-/* HAS_GETPGID:
+/* HAS_GNULIBC:
* This symbol, if defined, indicates to the C program that
- * the getpgid(pid) function is available to get the
- * process group id.
- */
-#$d_getpgid HAS_GETPGID /**/
-
-/* HAS_GETPGRP:
- * This symbol, if defined, indicates that the getpgrp routine is
- * available to get the current process group.
+ * the GNU C library is being used.
*/
-/* USE_BSD_GETPGRP:
- * This symbol, if defined, indicates that getpgrp needs one
- * arguments whereas USG one needs none.
+#$d_gnulibc HAS_GNULIBC /**/
+/* HAS_ISASCII:
+ * This manifest constant lets the C program know that isascii
+ * is available.
*/
-#$d_getpgrp HAS_GETPGRP /**/
-#$d_bsdgetpgrp USE_BSD_GETPGRP /**/
+#$d_isascii HAS_ISASCII /**/
-/* HAS_INET_ATON:
- * This symbol, if defined, indicates to the C program that the
- * inet_aton() function is available to parse IP address "dotted-quad"
- * strings.
+/* 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_inetaton HAS_INET_ATON /**/
+#$d_lchown HAS_LCHOWN /**/
-/* HAS_SETPGID:
- * This symbol, if defined, indicates to the C program that
- * the setpgid(pid, gpid) function is available to set the
- * process group id.
+/* HAS_OPEN3:
+ * This manifest constant lets the C program know that the three
+ * argument form of open(2) is available.
*/
-#$d_setpgid HAS_SETPGID /**/
+#$d_open3 HAS_OPEN3 /**/
-/* HAS_SETPGRP:
- * This symbol, if defined, indicates that the setpgrp routine is
- * available to set the current process group.
+/* HAS_SAFE_BCOPY:
+ * This symbol, if defined, indicates that the bcopy routine is available
+ * to copy potentially overlapping memory blocks. Otherwise you should
+ * probably use memmove() or memcpy(). If neither is defined, roll your
+ * own version.
*/
-/* 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_safebcpy HAS_SAFE_BCOPY /**/
+
+/* HAS_SAFE_MEMCPY:
+ * This symbol, if defined, indicates that the memcpy routine is available
+ * to copy potentially overlapping memory blocks. Otherwise you should
+ * probably use memmove() or memcpy(). If neither is defined, roll your
+ * own version.
*/
-/* USE_BSDPGRP:
- * This symbol, if defined, indicates that the BSD notion of process
- * group is to be used. For instance, you have to say setpgrp(pid, pgrp)
- * instead of the USG setpgrp(). This should be obsolete since
- * there are systems which have BSD-ish setpgrp but USG-ish getpgrp.
+#$d_safemcpy HAS_SAFE_MEMCPY /**/
+
+/* HAS_SANE_MEMCMP:
+ * This symbol, if defined, indicates that the memcmp routine is available
+ * and can be used to compare relative magnitudes of chars with their high
+ * bits set. If it is not defined, roll your own version.
*/
-#$d_setpgrp HAS_SETPGRP /**/
-#$d_bsdsetpgrp USE_BSD_SETPGRP /**/
-#$d_bsdpgrp USE_BSDPGRP /**/
+#$d_sanemcmp HAS_SANE_MEMCMP /**/
-/* USE_SFIO:
- * This symbol, if defined, indicates that sfio should
- * be used.
+/* HAS_SIGACTION:
+ * This symbol, if defined, indicates that Vr4's sigaction() routine
+ * is available.
*/
-#$d_sfio USE_SFIO /**/
+#$d_sigaction HAS_SIGACTION /**/
/* Sigjmp_buf:
* This is the buffer type to be used with Sigsetjmp and Siglongjmp.
@@ -1612,48 +1339,483 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
#define Siglongjmp(buf,retval) longjmp((buf),(retval))
#endif
-/* USE_DYNAMIC_LOADING:
- * This symbol, if defined, indicates that dynamic loading of
- * some sort is available.
+/* USE_STDIO_PTR:
+ * This symbol is defined if the _ptr and _cnt fields (or similar)
+ * of the stdio FILE structure can be used to access the stdio buffer
+ * for a file handle. If this is defined, then the FILE_ptr(fp)
+ * and FILE_cnt(fp) macros will also be defined and should be used
+ * to access these fields.
*/
-#$usedl USE_DYNAMIC_LOADING /**/
+/* FILE_ptr:
+ * This macro is used to access the _ptr field (or equivalent) of the
+ * FILE structure pointed to by its argument. This macro will always be
+ * defined if USE_STDIO_PTR is defined.
+ */
+/* STDIO_PTR_LVALUE:
+ * This symbol is defined if the FILE_ptr macro can be used as an
+ * lvalue.
+ */
+/* FILE_cnt:
+ * This macro is used to access the _cnt field (or equivalent) of the
+ * FILE structure pointed to by its argument. This macro will always be
+ * defined if USE_STDIO_PTR is defined.
+ */
+/* STDIO_CNT_LVALUE:
+ * This symbol is defined if the FILE_cnt macro can be used as an
+ * lvalue.
+ */
+#$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 /**/
+#endif
-/* I_DBM:
- * This symbol, if defined, indicates that <dbm.h> exists and should
- * be included.
+/* USE_STDIO_BASE:
+ * This symbol is defined if the _base field (or similar) of the
+ * stdio FILE structure can be used to access the stdio buffer for
+ * a file handle. If this is defined, then the FILE_base(fp) macro
+ * will also be defined and should be used to access this field.
+ * Also, the FILE_bufsiz(fp) macro will be defined and should be used
+ * to determine the number of bytes in the buffer. USE_STDIO_BASE
+ * will never be defined unless USE_STDIO_PTR is.
*/
-/* I_RPCSVC_DBM:
- * This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and
- * should be included.
+/* FILE_base:
+ * This macro is used to access the _base field (or equivalent) of the
+ * FILE structure pointed to by its argument. This macro will always be
+ * defined if USE_STDIO_BASE is defined.
*/
-#$i_dbm I_DBM /**/
-#$i_rpcsvcdbm I_RPCSVC_DBM /**/
+/* FILE_bufsiz:
+ * This macro is used to determine the number of bytes in the I/O
+ * buffer pointed to by _base field (or equivalent) of the FILE
+ * structure pointed to its argument. This macro will always be defined
+ * if USE_STDIO_BASE is defined.
+ */
+#$d_stdiobase USE_STDIO_BASE /**/
+#ifdef USE_STDIO_BASE
+#define FILE_base(fp) $stdio_base
+#define FILE_bufsiz(fp) $stdio_bufsiz
+#endif
-/* I_LOCALE:
- * This symbol, if defined, indicates to the C program that it should
- * include <locale.h>.
+/* HAS_VPRINTF:
+ * This symbol, if defined, indicates that the vprintf routine is available
+ * to printf with a pointer to an argument list. If unavailable, you
+ * may need to write your own, probably in terms of _doprnt().
*/
-#$i_locale I_LOCALE /**/
+/* USE_CHAR_VSPRINTF:
+ * This symbol is defined if this system has vsprintf() returning type
+ * (char*). The trend seems to be to declare it as "int vsprintf()". It
+ * is up to the package author to declare vsprintf correctly based on the
+ * symbol.
+ */
+#$d_vprintf HAS_VPRINTF /**/
+#$d_charvspr USE_CHAR_VSPRINTF /**/
-/* I_SFIO:
- * This symbol, if defined, indicates to the C program that it should
- * include <sfio.h>.
+/* DOUBLESIZE:
+ * This symbol contains the size of a double, so that the C preprocessor
+ * can make decisions based on it.
*/
-#$i_sfio I_SFIO /**/
+#define DOUBLESIZE $doublesize /**/
-/* I_SYS_STAT:
+/* I_TIME:
* This symbol, if defined, indicates to the C program that it should
- * include <sys/stat.h>.
+ * include <time.h>.
*/
-#$i_sysstat I_SYS_STAT /**/
+/* I_SYS_TIME:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/time.h>.
+ */
+/* I_SYS_TIME_KERNEL:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/time.h> with KERNEL defined.
+ */
+#$i_time I_TIME /**/
+#$i_systime I_SYS_TIME /**/
+#$i_systimek I_SYS_TIME_KERNEL /**/
-/* I_VALUES:
+/* INTSIZE:
+ * This symbol contains the value of sizeof(int) so that the C
+ * preprocessor can make decisions based on it.
+ */
+/* LONGSIZE:
+ * This symbol contains the value of sizeof(long) so that the C
+ * preprocessor can make decisions based on it.
+ */
+/* SHORTSIZE:
+ * This symbol contains the value of sizeof(short) so that the C
+ * preprocessor can make decisions based on it.
+ */
+#define INTSIZE $intsize /**/
+#define LONGSIZE $longsize /**/
+#define SHORTSIZE $shortsize /**/
+
+/* VAL_O_NONBLOCK:
+ * This symbol is to be used during open() or fcntl(F_SETFL) to turn on
+ * non-blocking I/O for the file descriptor. Note that there is no way
+ * back, i.e. you cannot turn it blocking again this way. If you wish to
+ * alternatively switch between blocking and non-blocking, use the
+ * ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
+ */
+/* VAL_EAGAIN:
+ * This symbol holds the errno error code set by read() when no data was
+ * present on the non-blocking file descriptor.
+ */
+/* RD_NODATA:
+ * This symbol holds the return code from read() when no data is present
+ * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
+ * not defined, then you can't distinguish between no data and EOF by
+ * issuing a read(). You'll have to find another way to tell for sure!
+ */
+/* EOF_NONBLOCK:
+ * This symbol, if defined, indicates to the C program that a read() on
+ * a non-blocking file descriptor will return 0 on EOF, and not the value
+ * held in RD_NODATA (-1 usually, in that case!).
+ */
+#define VAL_O_NONBLOCK $o_nonblock
+#define VAL_EAGAIN $eagain
+#define RD_NODATA $rd_nodata
+#$d_eofnblk EOF_NONBLOCK
+
+/* PTRSIZE:
+ * This symbol contains the size of a pointer, so that the C preprocessor
+ * can make decisions based on it. It will be sizeof(void *) if
+ * the compiler supports (void *); otherwise it will be
+ * sizeof(char *).
+ */
+#define PTRSIZE $ptrsize /**/
+
+/* RANDBITS:
+ * This symbol contains the number of bits of random number the rand()
+ * function produces. Usual values are 15, 16, and 31.
+ */
+#define RANDBITS $randbits /**/
+
+/* SSize_t:
+ * This symbol holds the type used by functions that return
+ * a count of bytes or an error condition. It must be a signed type.
+ * It is usually ssize_t, but may be long or int, etc.
+ * It may be necessary to include <sys/types.h> or <unistd.h>
+ * to get any typedef'ed information.
+ * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
+ */
+#define SSize_t $ssizetype /* signed count of bytes */
+
+/* OSNAME:
+ * This symbol contains the name of the operating system, as determined
+ * by Configure. You shouldn't rely on it too much; the specific
+ * feature tests from Configure are generally more reliable.
+ */
+#define OSNAME "$osname" /**/
+
+/* CAT2:
+ * This macro catenates 2 tokens together.
+ */
+/* STRINGIFY:
+ * This macro surrounds its token with double quotes.
+ */
+#if $cpp_stuff == 1
+#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 CAT2(a,b)a ## b
+#define StGiFy(a)# a
+#define STRINGIFY(a)StGiFy(a)
+#endif
+#if $cpp_stuff != 1 && $cpp_stuff != 42
+#include "Bletch: How does this C preprocessor catenate tokens?"
+#endif
+
+/* CSH:
+ * This symbol, if defined, contains the full pathname of csh.
+ */
+#$d_csh HAS_CSH /**/
+#ifdef HAS_CSH
+#define CSH "$full_csh" /**/
+#endif
+
+/* HAS_ENDHOSTENT:
+ * This symbol, if defined, indicates that the endhostent() routine is
+ * available to close whatever was being used for host queries.
+ */
+#$d_endhent HAS_ENDHOSTENT /**/
+
+/* HAS_ENDNETENT:
+ * This symbol, if defined, indicates that the endnetent() routine is
+ * available to close whatever was being used for network queries.
+ */
+#$d_endnent HAS_ENDNETENT /**/
+
+/* HAS_ENDPROTOENT:
+ * This symbol, if defined, indicates that the endprotoent() routine is
+ * available to close whatever was being used for protocol queries.
+ */
+#$d_endpent HAS_ENDPROTOENT /**/
+
+/* HAS_ENDSERVENT:
+ * This symbol, if defined, indicates that the endservent() routine is
+ * available to close whatever was being used for service queries.
+ */
+#$d_endsent HAS_ENDSERVENT /**/
+
+/* HAS_GETHOSTBYADDR:
+ * This symbol, if defined, indicates that the gethostbyaddr() routine is
+ * available to look up hosts by their IP addresses.
+ */
+#$d_gethbyaddr HAS_GETHOSTBYADDR /**/
+
+/* HAS_GETHOSTBYNAME:
+ * This symbol, if defined, indicates that the gethostbyname() routine is
+ * available to look up host names in some data base or other.
+ */
+#$d_gethbyname HAS_GETHOSTBYNAME /**/
+
+/* HAS_GETHOSTENT:
+ * This symbol, if defined, indicates that the gethostent() routine is
+ * available to look up host names in some data base or another.
+ */
+#$d_gethent HAS_GETHOSTENT /**/
+
+/* HAS_GETNETBYADDR:
+ * This symbol, if defined, indicates that the getnetbyaddr() routine is
+ * available to look up networks by their IP addresses.
+ */
+#$d_getnbyaddr HAS_GETNETBYADDR /**/
+
+/* HAS_GETNETBYNAME:
+ * This symbol, if defined, indicates that the getnetbyname() routine is
+ * available to look up networks by their names.
+ */
+#$d_getnbyname HAS_GETNETBYNAME /**/
+
+/* HAS_GETNETENT:
+ * This symbol, if defined, indicates that the getnetent() routine is
+ * available to look up network names in some data base or another.
+ */
+#$d_getnent HAS_GETNETENT /**/
+
+/* HAS_GETPROTOENT:
+ * This symbol, if defined, indicates that the getprotoent() routine is
+ * available to look up protocols in some data base or another.
+ */
+#$d_getpent HAS_GETPROTOENT /**/
+
+/* HAS_GETPROTOBYNAME:
+ * This symbol, if defined, indicates that the getprotobyname()
+ * routine is available to look up protocols by their name.
+ */
+/* HAS_GETPROTOBYNUMBER:
+ * This symbol, if defined, indicates that the getprotobynumber()
+ * routine is available to look up protocols by their number.
+ */
+#$d_getpbyname HAS_GETPROTOBYNAME /**/
+#$d_getpbynumber HAS_GETPROTOBYNUMBER /**/
+
+/* HAS_GETSERVENT:
+ * This symbol, if defined, indicates that the getservent() routine is
+ * available to look up network services in some data base or another.
+ */
+#$d_getsent HAS_GETSERVENT /**/
+
+/* HAS_GETSERVBYNAME:
+ * This symbol, if defined, indicates that the getservbyname()
+ * routine is available to look up services by their name.
+ */
+/* HAS_GETSERVBYPORT:
+ * This symbol, if defined, indicates that the getservbyport()
+ * routine is available to look up services by their port.
+ */
+#$d_getsbyname HAS_GETSERVBYNAME /**/
+#$d_getsbyport HAS_GETSERVBYPORT /**/
+
+/* HAS_LONG_DOUBLE:
+ * This symbol will be defined if the C compiler supports long
+ * doubles.
+ */
+/* LONG_DOUBLESIZE:
+ * This symbol contains the size of a long double, so that the
+ * C preprocessor can make decisions based on it. It is only
+ * defined if the system supports long doubles.
+ */
+#$d_longdbl HAS_LONG_DOUBLE /**/
+#ifdef HAS_LONG_DOUBLE
+#define LONG_DOUBLESIZE $longdblsize /**/
+#endif
+
+/* HAS_LONG_LONG:
+ * This symbol will be defined if the C compiler supports
+ * long long.
+ */
+/* LONGLONGSIZE:
+ * This symbol contains the size of a long long, so that the
+ * C preprocessor can make decisions based on it. It is only
+ * defined if the system supports long long.
+ */
+#$d_longlong HAS_LONG_LONG /**/
+#ifdef HAS_LONG_LONG
+#define LONGLONGSIZE $longlongsize /**/
+#endif
+
+/* HAS_SETGROUPS:
+ * This symbol, if defined, indicates that the setgroups() routine is
+ * available to set the list of process groups. If unavailable, multiple
+ * groups are probably not supported.
+ */
+#$d_setgrps HAS_SETGROUPS /**/
+
+/* HAS_SETHOSTENT:
+ * This symbol, if defined, indicates that the sethostent() routine is
+ * available.
+ */
+#$d_sethent HAS_SETHOSTENT /**/
+
+/* HAS_SETNETENT:
+ * This symbol, if defined, indicates that the setnetent() routine is
+ * available.
+ */
+#$d_setnent HAS_SETNETENT /**/
+
+/* HAS_SETPROTOENT:
+ * This symbol, if defined, indicates that the setprotoent() routine is
+ * available.
+ */
+#$d_setpent HAS_SETPROTOENT /**/
+
+/* HAS_SETSERVENT:
+ * This symbol, if defined, indicates that the setservent() routine is
+ * available.
+ */
+#$d_setsent HAS_SETSERVENT /**/
+
+/* HAS_SETVBUF:
+ * This symbol, if defined, indicates that the setvbuf routine is
+ * available to change buffering on an open stdio stream.
+ * to a line-buffered mode.
+ */
+#$d_setvbuf HAS_SETVBUF /**/
+
+/* HAS_SOCKET:
+ * This symbol, if defined, indicates that the BSD socket interface is
+ * supported.
+ */
+/* HAS_SOCKETPAIR:
+ * This symbol, if defined, indicates that the BSD socketpair() call is
+ * supported.
+ */
+#$d_socket HAS_SOCKET /**/
+#$d_sockpair HAS_SOCKETPAIR /**/
+
+/* HAS_UNION_SEMUN:
+ * This symbol, if defined, indicates that the union semun is
+ * defined by including <sys/sem.h>. If not, the user code
+ * probably needs to define it as:
+ * union semun {
+ * int val;
+ * struct semid_ds *buf;
+ * unsigned short *array;
+ * }
+ */
+/* USE_SEMCTL_SEMUN:
+ * This symbol, if defined, indicates that union semun is
+ * used for semctl IPC_STAT.
+ */
+/* USE_SEMCTL_SEMID_DS:
+ * This symbol, if defined, indicates that struct semid_ds * is
+ * used for semctl IPC_STAT.
+ */
+#$d_union_semun HAS_UNION_SEMUN /**/
+#$d_semctl_semun USE_SEMCTL_SEMUN /**/
+#$d_semctl_semid_ds USE_SEMCTL_SEMID_DS /**/
+
+/* Signal_t:
+ * This symbol's value is either "void" or "int", corresponding to the
+ * appropriate return type of a signal handler. Thus, you can declare
+ * a signal handler using "Signal_t (*handler)()", and define the
+ * handler using "Signal_t handler(sig)".
+ */
+#define Signal_t $signal_t /* Signal handler's return type */
+
+/* Groups_t:
+ * This symbol holds the type used for the second argument to
+ * getgroups() and setgropus(). Usually, this is the same as
+ * gidtype (gid_t) , but sometimes it isn't.
+ * It can be int, ushort, uid_t, etc...
+ * It may be necessary to include <sys/types.h> to get any
+ * typedef'ed information. This is only required if you have
+ * getgroups() or setgropus()..
+ */
+#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
+#define Groups_t $groupstype /* Type for 2nd arg to [sg]etgroups() */
+#endif
+
+/* I_NETDB:
+ * This symbol, if defined, indicates that <netdb.h> exists and
+ * should be included.
+ */
+#$i_netdb I_NETDB /**/
+
+/* I_PWD:
* This symbol, if defined, indicates to the C program that it should
- * include <values.h> to get definition of symbols like MINFLOAT or
- * MAXLONG, i.e. machine dependant limitations. Probably, you
- * should use <limits.h> instead, if it is available.
+ * include <pwd.h>.
*/
-#$i_values I_VALUES /**/
+/* PWQUOTA:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_quota.
+ */
+/* PWAGE:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_age.
+ */
+/* PWCHANGE:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_change.
+ */
+/* PWCLASS:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_class.
+ */
+/* PWEXPIRE:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_expire.
+ */
+/* PWCOMMENT:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_comment.
+ */
+/* PWGECOS:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_gecos.
+ */
+/* PWPASSWD:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_passwd.
+ */
+/* HAS_SETPWENT:
+ * This symbol, if defined, indicates that the getpwrent routine is
+ * available for initializing sequential access of the passwd database.
+ */
+/* HAS_GETPWENT:
+ * This symbol, if defined, indicates that the getpwent routine is
+ * available for sequential access of the password database.
+ */
+/* HAS_ENDPWENT:
+ * This symbol, if defined, indicates that the getpwent routine is
+ * available for finalizing sequential access of the passwd database.
+ */
+#$i_pwd I_PWD /**/
+#$d_pwquota PWQUOTA /**/
+#$d_pwage PWAGE /**/
+#$d_pwchange PWCHANGE /**/
+#$d_pwclass PWCLASS /**/
+#$d_pwexpire PWEXPIRE /**/
+#$d_pwcomment PWCOMMENT /**/
+#$d_pwgecos PWGECOS /**/
+#$d_pwpasswd PWPASSWD /**/
+#$d_setpwent HAS_SETPWENT /**/
+#$d_getpwent HAS_GETPWENT /**/
+#$d_endpwent HAS_ENDPWENT /**/
/* Free_t:
* This variable contains the return type of free(). It is usually
@@ -1670,43 +1832,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$d_mymalloc MYMALLOC /**/
-/* OLDARCHLIB:
- * This variable, if defined, holds the name of the directory in
- * which the user has perl5.000 or perl5.001 architecture-dependent
- * public library files for $package. For the most part, these
- * files will work with 5.002 (and later), but that is not
- * guaranteed.
- */
-/* OLDARCHLIB_EXP:
- * This symbol contains the ~name expanded version of OLDARCHLIB, to be
- * used in programs that are not prepared to deal with ~ expansion at
- * run-time.
- */
-#$d_oldarchlib OLDARCHLIB "$oldarchlib" /**/
-#$d_oldarchlib OLDARCHLIB_EXP "$oldarchlibexp" /**/
-
-/* PRIVLIB:
- * This symbol contains the name of the private library for this package.
- * The library is private in the sense that it needn't be in anyone's
- * execution path, but it should be accessible by the world. The program
- * should be prepared to do ~ expansion.
- */
-/* PRIVLIB_EXP:
- * 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 "$privlib" /**/
-#define PRIVLIB_EXP "$privlibexp" /**/
-
-/* SH_PATH:
- * This symbol contains the full pathname to the shell used on this
- * on this system to execute Bourne shell scripts. Usually, this will be
- * /bin/sh, though it's possible that some systems will have /bin/ksh,
- * /bin/pdksh, /bin/ash, /bin/bash, or even something such as
- * D:/bin/sh.exe.
- */
-#define SH_PATH "$sh" /**/
-
/* SIG_NAME:
* This symbol contains a list of signal names in order of
* signal number. This is intended
@@ -1735,8 +1860,104 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
* The last element is 0, corresponding to the 0 at the end of
* the sig_name list.
*/
-#define SIG_NAME "`echo $sig_name | sed 's/ /","/g'`",0 /**/
-#define SIG_NUM `echo $sig_num 0 | sed 's/ /,/g'` /**/
+#define SIG_NAME $sig_name_init /**/
+#define SIG_NUM $sig_num_init /**/
+
+/* VOIDFLAGS:
+ * This symbol indicates how much support of the void type is given by this
+ * compiler. What various bits mean:
+ *
+ * 1 = supports declaration of void
+ * 2 = supports arrays of pointers to functions returning void
+ * 4 = supports comparisons between pointers to void functions and
+ * addresses of void functions
+ * 8 = suports declaration of generic void pointers
+ *
+ * The package designer should define VOIDUSED to indicate the requirements
+ * of the package. This can be done either by #defining VOIDUSED before
+ * including config.h, or by defining defvoidused in Myinit.U. If the
+ * latter approach is taken, only those flags will be tested. If the
+ * level of void support necessary is not present, defines void to int.
+ */
+#ifndef VOIDUSED
+#define VOIDUSED $defvoidused
+#endif
+#define VOIDFLAGS $voidflags
+#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
+#define void int /* is void to be avoided? */
+#define M_VOID /* Xenix strikes again */
+#endif
+
+/* ARCHLIB:
+ * This variable, if defined, holds the name of the directory in
+ * which the user wants to put architecture-dependent public
+ * library files for $package. It is most often a local directory
+ * such as /usr/local/lib. Programs using this variable must be
+ * prepared to deal with filename expansion. If ARCHLIB is the
+ * same as PRIVLIB, it is not defined, since presumably the
+ * program already searches PRIVLIB.
+ */
+/* ARCHLIB_EXP:
+ * 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.
+ */
+#$d_archlib ARCHLIB "$archlib" /**/
+#$d_archlib ARCHLIB_EXP "$archlibexp" /**/
+
+/* DLSYM_NEEDS_UNDERSCORE:
+ * This symbol, if defined, indicates that we need to prepend an
+ * underscore to the symbol name before calling dlsym(). This only
+ * makes sense if you *have* dlsym, which we will presume is the
+ * case if you're using dl_dlopen.xs.
+ */
+#$d_dlsymun DLSYM_NEEDS_UNDERSCORE /**/
+
+/* USE_SFIO:
+ * This symbol, if defined, indicates that sfio should
+ * be used.
+ */
+#$d_sfio USE_SFIO /**/
+
+/* USE_DYNAMIC_LOADING:
+ * This symbol, if defined, indicates that dynamic loading of
+ * some sort is available.
+ */
+#$usedl USE_DYNAMIC_LOADING /**/
+
+/* DB_Prefix_t:
+ * This symbol contains the type of the prefix structure element
+ * in the <db.h> header file. In older versions of DB, it was
+ * int, while in newer ones it is u_int32_t.
+ */
+/* DB_Hash_t:
+ * This symbol contains the type of the prefix structure element
+ * in the <db.h> header file. In older versions of DB, it was
+ * int, while in newer ones it is size_t.
+ */
+#define DB_Hash_t $db_hashtype /**/
+#define DB_Prefix_t $db_prefixtype /**/
+
+/* PRIVLIB:
+ * This symbol contains the name of the private library for this package.
+ * The library is private in the sense that it needn't be in anyone's
+ * execution path, but it should be accessible by the world. The program
+ * should be prepared to do ~ expansion.
+ */
+/* PRIVLIB_EXP:
+ * 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 "$privlib" /**/
+#define PRIVLIB_EXP "$privlibexp" /**/
+
+/* SELECT_MIN_BITS:
+ * This symbol holds the minimum number of bits operated by select.
+ * That is, if you do select(n, ...), how many bits at least will be
+ * cleared in the masks if some activity is detected. Usually this
+ * is either n or 32*ceil(n/32), especially many little-endians do
+ * the latter. This is only useful if you have select(), naturally.
+ */
+#define SELECT_MIN_BITS $selectminbits /**/
/* SITEARCH:
* This symbol contains the name of the private library for this package.
@@ -1784,30 +2005,183 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$useperlio USE_PERLIO /**/
-/* VOIDFLAGS:
- * This symbol indicates how much support of the void type is given by this
- * compiler. What various bits mean:
- *
- * 1 = supports declaration of void
- * 2 = supports arrays of pointers to functions returning void
- * 4 = supports comparisons between pointers to void functions and
- * addresses of void functions
- * 8 = suports declaration of generic void pointers
- *
- * The package designer should define VOIDUSED to indicate the requirements
- * of the package. This can be done either by #defining VOIDUSED before
- * including config.h, or by defining defvoidused in Myinit.U. If the
- * latter approach is taken, only those flags will be tested. If the
- * level of void support necessary is not present, defines void to int.
+/* HAS_GETHOST_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for gethostent(), gethostbyname(), and
+ * gethostbyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
*/
-#ifndef VOIDUSED
-#define VOIDUSED $defvoidused
-#endif
-#define VOIDFLAGS $voidflags
-#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
-#define void int /* is void to be avoided? */
-#define M_VOID /* Xenix strikes again */
-#endif
+#$d_gethostprotos HAS_GETHOST_PROTOS /**/
+
+/* HAS_GETNET_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for getnetent(), getnetbyname(), and
+ * getnetbyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+#$d_getnetprotos HAS_GETNET_PROTOS /**/
+
+/* HAS_GETPROTO_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for getprotoent(), getprotobyname(), and
+ * getprotobyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+#$d_getprotoprotos HAS_GETPROTO_PROTOS /**/
+
+/* HAS_GETSERV_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for getservent(), getservbyname(), and
+ * getservbyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+#$d_getservprotos HAS_GETSERV_PROTOS /**/
+
+/* Netdb_host_t:
+ * This symbol holds the type used for the 1st argument
+ * to gethostbyaddr().
+ */
+/* Netdb_hlen_t:
+ * This symbol holds the type used for the 2nd argument
+ * to gethostbyaddr().
+ */
+/* Netdb_name_t:
+ * This symbol holds the type used for the argument to
+ * gethostbyname().
+ */
+/* Netdb_net_t:
+ * This symbol holds the type used for the 1st argument to
+ * getnetbyaddr().
+ */
+#define Netdb_host_t $netdb_host_type /**/
+#define Netdb_hlen_t $netdb_hlen_type /**/
+#define Netdb_name_t $netdb_name_type /**/
+#define Netdb_net_t $netdb_net_type /**/
+
+/* Select_fd_set_t:
+ * This symbol holds the type used for the 2nd, 3rd, and 4th
+ * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET
+ * is defined, and 'int *' otherwise. This is only useful if you
+ * have select(), of course.
+ */
+#define Select_fd_set_t $selecttype /**/
+
+/* ARCHNAME:
+ * This symbol holds a string representing the architecture name.
+ * It may be used to construct an architecture-dependant pathname
+ * where library files may be held under a private library, for
+ * instance.
+ */
+#define ARCHNAME "$archname" /**/
+
+/* I_MACH_CTHREADS:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <mach/cthreads.h>.
+ */
+#$i_machcthreads I_MACH_CTHREADS /**/
+
+/* I_PTHREAD:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <pthread.h>.
+ */
+#$i_pthread I_PTHREAD /**/
+
+/* HAS_PTHREAD_YIELD:
+ * This symbol, if defined, indicates that the pthread_yield
+ * routine is available to yield the execution of the current
+ * thread.
+ */
+/* HAS_SCHED_YIELD:
+ * This symbol, if defined, indicates that the sched_yield
+ * routine is available to yield the execution of the current
+ * thread.
+ */
+#$d_pthread_yield HAS_PTHREAD_YIELD /**/
+#$d_sched_yield HAS_SCHED_YIELD /**/
+
+/* PTHREADS_CREATED_JOINABLE:
+ * This symbol, if defined, indicates that pthreads are created
+ * in the joinable (aka undetached) state.
+ */
+#$d_pthreads_created_joinable PTHREADS_CREATED_JOINABLE /**/
+
+/* USE_THREADS:
+ * This symbol, if defined, indicates that Perl should
+ * be built to use threads.
+ */
+/* OLD_PTHREADS_API:
+ * This symbol, if defined, indicates that Perl should
+ * be built to use the old draft POSIX threads API.
+ */
+#$usethreads USE_THREADS /**/
+#$d_oldpthreads OLD_PTHREADS_API /**/
+
+/* Time_t:
+ * This symbol holds the type returned by time(). It can be long,
+ * or time_t on BSD sites (in which case <sys/types.h> should be
+ * included).
+ */
+#define Time_t $timetype /* Time type */
+
+/* HAS_TIMES:
+ * This symbol, if defined, indicates that the times() routine exists.
+ * Note that this became obsolete on some systems (SUNOS), which now
+ * use getrusage(). It may be necessary to include <sys/times.h>.
+ */
+#$d_times HAS_TIMES /**/
+
+/* Fpos_t:
+ * This symbol holds the type used to declare file positions in libc.
+ * It can be fpos_t, long, uint, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+#define Fpos_t $fpostype /* File position type */
+
+/* Gid_t:
+ * This symbol holds the return type of getgid() and the type of
+ * argument to setrgid() and related functions. Typically,
+ * it is the type of group ids in the kernel. It can be int, ushort,
+ * uid_t, etc... It may be necessary to include <sys/types.h> to get
+ * any typedef'ed information.
+ */
+#define Gid_t $gidtype /* Type for getgid(), etc... */
+
+/* Off_t:
+ * This symbol holds the type used to declare offsets in the kernel.
+ * It can be int, long, off_t, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+#define Off_t $lseektype /* <offset> type */
+
+/* Mode_t:
+ * This symbol holds the type used to declare file modes
+ * for systems calls. It is usually mode_t, but may be
+ * int or unsigned short. It may be necessary to include <sys/types.h>
+ * to get any typedef'ed information.
+ */
+#define Mode_t $modetype /* file mode parameter for system calls */
+
+/* Pid_t:
+ * This symbol holds the type used to declare process ids in the kernel.
+ * It can be int, uint, pid_t, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+#define Pid_t $pidtype /* PID type */
+
+/* Size_t:
+ * This symbol holds the type used to declare length parameters
+ * for string functions. It is usually size_t, but may be
+ * unsigned long, int, etc. It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+#define Size_t $sizetype /* length paramater for string functions */
+
+/* Uid_t:
+ * This symbol holds the type used to declare user ids in the kernel.
+ * It can be int, ushort, uid_t, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+#define Uid_t $uidtype /* UID type */
#endif
!GROK!THIS!
diff --git a/gnu/usr.bin/perl/configpm b/gnu/usr.bin/perl/configpm
index 0c6a9650728..ba07f14a878 100644
--- a/gnu/usr.bin/perl/configpm
+++ b/gnu/usr.bin/perl/configpm
@@ -1,6 +1,7 @@
#!./miniperl -w
-$config_pm = $ARGV[0] || 'lib/Config.pm';
+my $config_pm = $ARGV[0] || 'lib/Config.pm';
+my $glossary = $ARGV[1] || 'Porting/Glossary';
@ARGV = "./config.sh";
# list names to put first (and hence lookup fastest)
@@ -45,17 +46,19 @@ while (<>) {
next if m:^#!/bin/sh:;
# Catch CONFIG=true and PATCHLEVEL=n line from Configure.
s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/;
- unless ($in_v or m/^(\w+)='(.*\n)/){
+ # We can delimit things in config.sh with either ' or ".
+ unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
push(@non_v, "#$_"); # not a name='value' line
next;
}
+ $quote = $2;
if ($in_v) { $val .= $_; }
- else { ($name,$val) = ($1,$2); }
- $in_v = $val !~ /'\n/;
+ else { ($name,$val) = ($1,$3); }
+ $in_v = $val !~ /$quote\n/;
next if $in_v;
if ($extensions{$name}) { s,/,::,g }
- if (!$fast{$name}){ push(@v_others, "$name='$val"); next; }
- push(@v_fast,"$name='$val");
+ if (!$fast{$name}){ push(@v_others, "$name=$quote$val"); next; }
+ push(@v_fast,"$name=$quote$val");
}
foreach(@non_v){ print CONFIG $_ }
@@ -95,17 +98,41 @@ sub FETCH {
return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]});
# Search for it in the big string
- my($value, $start, $marker);
- $marker = "$_[1]='";
+ my($value, $start, $marker, $quote_type);
+ $marker = "$_[1]=";
+ $quote_type = "'";
# return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
- $start = index($config_sh, "\n$marker");
+ # 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) { $start = length($marker) }
- else { $start += length($marker) + 1 }
+ 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, qq('\n), $start) - $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 = sprintf($value) if $quote_type eq '"';
$value = undef if $value eq 'undef'; # So we can say "if $Config{'foo'}".
$_[0]->{$_[1]} = $value; # cache it
return $value;
@@ -121,7 +148,9 @@ sub FIRSTKEY {
}
sub NEXTKEY {
- my $pos = index($config_sh, qq('\n), $prevpos) + 2;
+ # Find out how the current key's quoted so we can skip to its end.
+ my $quote = substr($config_sh, index($config_sh, "=", $prevpos)+1, 1);
+ my $pos = index($config_sh, qq($quote\n), $prevpos) + 2;
my $len = index($config_sh, "=", $pos) - $pos;
$prevpos = $pos;
$len > 0 ? substr($config_sh, $pos, $len) : undef;
@@ -131,7 +160,9 @@ sub EXISTS {
# exists($_[0]->{$_[1]}) or $config_sh =~ m/^$_[1]=/m;
exists($_[0]->{$_[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
+ index($config_sh, "\n$_[1]=\"") != -1 or
+ substr($config_sh, 0, length($_[1])+2) eq "$_[1]=\"";
}
sub STORE { die "\%Config::Config is read-only\n" }
@@ -278,6 +309,79 @@ The Config module is installed into the architecture and version
specific library directory ($Config{installarchlib}) and it checks the
perl version number when loaded.
+The values stored in config.sh may be either single-quoted or
+double-quoted. Double-quoted strings are handy for those cases where you
+need to include escape sequences in the strings. To avoid runtime variable
+interpolation, any C<$> and C<@> characters are replaced by C<\$> and
+C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
+or C<\@> in double-quoted strings unless you're willing to deal with the
+consequences. (The slashes will end up escaped and the C<$> or C<@> will
+trigger variable interpolation)
+
+=head1 GLOSSARY
+
+Most C<Config> variables are determined by the C<Configure> script
+on platforms supported by it (which is most UNIX platforms). Some
+platforms have custom-made C<Config> variables, and may thus not have
+some of the variables described below, or may have extraneous variables
+specific to that particular port. See the port specific documentation
+in such cases.
+
+ENDOFTAIL
+
+open(GLOS, "<$glossary") or die "Can't open $glossary: $!";
+%seen = ();
+$text = 0;
+$/ = '';
+
+sub process {
+ s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m;
+ my $c = substr $1, 0, 1;
+ unless ($seen{$c}++) {
+ print CONFIG <<EOF if $text;
+=back
+
+EOF
+ print CONFIG <<EOF;
+=head2 $c
+
+=over
+
+EOF
+ $text = 1;
+ }
+ s/n't/n\00t/g; # leave can't, won't etc untouched
+ s/^\t\s+(.*)/\n\t$1\n/gm; # Indented lines ===> paragraphs
+ s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
+ s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
+ s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
+ s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
+ s{
+ (?<! [\w./<\'\"] ) # Only standalone file names
+ (?! e \. g \. ) # Not e.g.
+ (?! \. \. \. ) # Not ...
+ (?! \d ) # Not 5.004
+ ( [\w./]* [./] [\w./]* ) # Require . or / inside
+ (?<! \. (?= \s ) ) # Do not include trailing dot
+ (?! [\w/] ) # Include all of it
+ }
+ (F<$1>)xg; # /usr/local
+ s/((?<=\s)~\w*)/F<$1>/g; # ~name
+ s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
+ s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
+ s/n[\0]t/n't/g; # undo can't, won't damage
+}
+
+<GLOS>; # Skip the preamble
+while (<GLOS>) {
+ process;
+ print CONFIG;
+}
+
+print CONFIG <<'ENDOFTAIL';
+
+=back
+
=head1 NOTE
This module contains a good example of how to use tie to implement a
@@ -289,6 +393,7 @@ outside of it.
ENDOFTAIL
close(CONFIG);
+close(GLOS);
# Now do some simple tests on the Config.pm file we have created
unshift(@INC,'lib');
diff --git a/gnu/usr.bin/perl/configure b/gnu/usr.bin/perl/configure
deleted file mode 100644
index fa01c454514..00000000000
--- a/gnu/usr.bin/perl/configure
+++ /dev/null
@@ -1,127 +0,0 @@
-#! /bin/sh
-#
-# $Id: configure,v 1.2 1997/11/30 07:48:25 millert Exp $
-#
-# GNU configure-like front end to metaconfig's Configure.
-#
-# Written by Andy Dougherty <doughera@lafcol.lafayette.edu>
-# and Matthew Green <mrg@mame.mu.oz.au>.
-#
-# Reformatted and modified for inclusion in the dist-3.0 package by
-# Raphael Manfredi <ram@hptnos02.grenoble.hp.com>.
-#
-# This script belongs to the public domain and may be freely redistributed.
-#
-# The remaining of this leading shell comment may be removed if you
-# include this script in your own package.
-#
-# $Log: configure,v $
-# Revision 1.2 1997/11/30 07:48:25 millert
-# perl 5.004_04
-#
-# Revision 3.0.1.1 1995/07/25 14:16:21 ram
-# patch56: created
-#
-
-(exit $?0) || exec sh $0 $argv:q
-
-case "$0" in
-*configure)
- if cmp $0 `echo $0 | sed -e s/configure/Configure/` >/dev/null; then
- echo "Your configure and Configure scripts seem to be identical."
- echo "This can happen on filesystems that aren't fully case sensitive."
- echo "You'll have to explicitly extract Configure and run that."
- exit 1
- fi
- ;;
-esac
-
-opts=''
-verbose=''
-create='-e'
-while test $# -gt 0; do
- case $1 in
- --help)
- cat <<EOM
-Usage: configure [options]
-This is GNU configure-like front end for a metaconfig-generated Configure.
-It emulates the following GNU configure options (must be fully spelled out):
- --help
- --no-create
- --prefix=PREFIX
- --cache-file (ignored)
- --quiet
- --silent
- --verbose
- --version
-
-And it honours these environment variables: CC, CFLAGS and DEFS.
-EOM
- exit 0
- ;;
- --no-create)
- create='-E'
- shift
- ;;
- --prefix=*)
- arg=`echo $1 | sed 's/--prefix=/-Dprefix=/'`
- opts="$opts $arg"
- shift
- ;;
- --cache-file=*)
- shift # Just ignore it.
- ;;
- --quiet|--silent)
- exec >/dev/null 2>&1
- shift
- ;;
- --verbose)
- verbose=true
- shift
- ;;
- --version)
- copt="$copt -V"
- shift
- ;;
- --*)
- opt=`echo $1 | sed 's/=.*//'`
- echo "This GNU configure front end does not understand $opt"
- exit 1
- ;;
- *)
- opts="$opts $1"
- shift
- ;;
- esac
-done
-
-case "$CC" in
-'') ;;
-*) opts="$opts -Dcc='$CC'";;
-esac
-
-# Join DEFS and CFLAGS together.
-ccflags=''
-case "$DEFS" in
-'') ;;
-*) ccflags=$DEFS;;
-esac
-case "$CFLAGS" in
-'') ;;
-*) ccflags="$ccflags $CFLAGS";;
-esac
-case "$ccflags" in
-'') ;;
-*) opts="$opts -Dccflags='$ccflags'";;
-esac
-
-# Don't use -s if they want verbose mode
-case "$verbose" in
-'') copt="$copt -ds";;
-*) copt="$copt -d";;
-esac
-
-set X sh Configure $copt $create $opts
-shift
-echo "$@"
-exec "$@"
diff --git a/gnu/usr.bin/perl/cop.h b/gnu/usr.bin/perl/cop.h
index baedc5a52d1..7d6730fb966 100644
--- a/gnu/usr.bin/perl/cop.h
+++ b/gnu/usr.bin/perl/cop.h
@@ -1,6 +1,6 @@
/* cop.h
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -28,7 +28,9 @@ struct block_sub {
CV * cv;
GV * gv;
GV * dfoutgv;
+#ifndef USE_THREADS
AV * savearray;
+#endif /* USE_THREADS */
AV * argarray;
U16 olddepth;
U8 hasargs;
@@ -43,7 +45,7 @@ struct block_sub {
cx->blk_sub.cv = cv; \
cx->blk_sub.gv = gv; \
cx->blk_sub.hasargs = 0; \
- cx->blk_sub.dfoutgv = defoutgv; \
+ cx->blk_sub.dfoutgv = PL_defoutgv; \
(void)SvREFCNT_inc(cx->blk_sub.dfoutgv)
#define POPSUB(cx) \
@@ -54,11 +56,19 @@ struct block_sub {
#define POPSUB1(cx) \
cxsub = cx->blk_sub; /* because DESTROY may clobber *cx */
+#ifdef USE_THREADS
+#define POPSAVEARRAY() NOOP
+#else
+#define POPSAVEARRAY() \
+ STMT_START { \
+ SvREFCNT_dec(GvAV(PL_defgv)); \
+ GvAV(PL_defgv) = cxsub.savearray; \
+ } STMT_END
+#endif /* USE_THREADS */
+
#define POPSUB2() \
if (cxsub.hasargs) { \
- /* put back old @_ */ \
- SvREFCNT_dec(GvAV(defgv)); \
- GvAV(defgv) = cxsub.savearray; \
+ POPSAVEARRAY(); \
/* destroy arg array */ \
av_clear(cxsub.argarray); \
AvREAL_off(cxsub.argarray); \
@@ -82,16 +92,16 @@ struct block_eval {
};
#define PUSHEVAL(cx,n,fgv) \
- cx->blk_eval.old_in_eval = in_eval; \
- cx->blk_eval.old_op_type = op->op_type; \
+ cx->blk_eval.old_in_eval = PL_in_eval; \
+ cx->blk_eval.old_op_type = PL_op->op_type; \
cx->blk_eval.old_name = n; \
- cx->blk_eval.old_eval_root = eval_root; \
- cx->blk_eval.cur_text = linestr;
+ cx->blk_eval.old_eval_root = PL_eval_root; \
+ cx->blk_eval.cur_text = PL_linestr;
#define POPEVAL(cx) \
- in_eval = cx->blk_eval.old_in_eval; \
+ PL_in_eval = cx->blk_eval.old_in_eval; \
optype = cx->blk_eval.old_op_type; \
- eval_root = cx->blk_eval.old_eval_root;
+ PL_eval_root = cx->blk_eval.old_eval_root;
/* loop context */
struct block_loop {
@@ -104,12 +114,13 @@ struct block_loop {
SV * itersave;
SV * iterlval;
AV * iterary;
- I32 iterix;
+ IV iterix;
+ IV itermax;
};
#define PUSHLOOP(cx, ivar, s) \
- cx->blk_loop.label = curcop->cop_label; \
- cx->blk_loop.resetsp = s - stack_base; \
+ cx->blk_loop.label = PL_curcop->cop_label; \
+ cx->blk_loop.resetsp = s - PL_stack_base; \
cx->blk_loop.redo_op = cLOOP->op_redoop; \
cx->blk_loop.next_op = cLOOP->op_nextop; \
cx->blk_loop.last_op = cLOOP->op_lastop; \
@@ -126,15 +137,15 @@ struct block_loop {
#define POPLOOP1(cx) \
cxloop = cx->blk_loop; /* because DESTROY may clobber *cx */ \
- newsp = stack_base + cxloop.resetsp;
+ newsp = PL_stack_base + cxloop.resetsp;
#define POPLOOP2() \
SvREFCNT_dec(cxloop.iterlval); \
if (cxloop.itervar) { \
- SvREFCNT_dec(*cxloop.itervar); \
+ sv_2mortal(*cxloop.itervar); \
*cxloop.itervar = cxloop.itersave; \
} \
- if (cxloop.iterary && cxloop.iterary != curstack) \
+ if (cxloop.iterary && cxloop.iterary != PL_curstack) \
SvREFCNT_dec(cxloop.iterary);
/* context common to subroutines, evals and loops */
@@ -167,34 +178,35 @@ struct block {
/* Enter a block. */
#define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix], \
cx->cx_type = t, \
- cx->blk_oldsp = sp - stack_base, \
- cx->blk_oldcop = curcop, \
- cx->blk_oldmarksp = markstack_ptr - markstack, \
- cx->blk_oldscopesp = scopestack_ix, \
- cx->blk_oldretsp = retstack_ix, \
- cx->blk_oldpm = curpm, \
+ cx->blk_oldsp = sp - PL_stack_base, \
+ cx->blk_oldcop = PL_curcop, \
+ cx->blk_oldmarksp = PL_markstack_ptr - PL_markstack, \
+ cx->blk_oldscopesp = PL_scopestack_ix, \
+ cx->blk_oldretsp = PL_retstack_ix, \
+ cx->blk_oldpm = PL_curpm, \
cx->blk_gimme = gimme; \
DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Entering block %ld, type %s\n", \
- (long)cxstack_ix, block_type[t]); )
+ (long)cxstack_ix, block_type[CxTYPE(cx)]); )
/* Exit a block (RETURN and LAST). */
#define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--], \
- newsp = stack_base + cx->blk_oldsp, \
- curcop = cx->blk_oldcop, \
- markstack_ptr = markstack + cx->blk_oldmarksp, \
- scopestack_ix = cx->blk_oldscopesp, \
- retstack_ix = cx->blk_oldretsp, \
- pm = cx->blk_oldpm, \
- gimme = cx->blk_gimme; \
+ newsp = PL_stack_base + cx->blk_oldsp, \
+ PL_curcop = cx->blk_oldcop, \
+ PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
+ PL_scopestack_ix = cx->blk_oldscopesp, \
+ PL_retstack_ix = cx->blk_oldretsp, \
+ pm = cx->blk_oldpm, \
+ gimme = cx->blk_gimme; \
DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Leaving block %ld, type %s\n", \
- (long)cxstack_ix+1,block_type[cx->cx_type]); )
+ (long)cxstack_ix+1,block_type[CxTYPE(cx)]); )
/* Continue a block elsewhere (NEXT and REDO). */
-#define TOPBLOCK(cx) cx = &cxstack[cxstack_ix], \
- stack_sp = stack_base + cx->blk_oldsp, \
- markstack_ptr = markstack + cx->blk_oldmarksp, \
- scopestack_ix = cx->blk_oldscopesp, \
- retstack_ix = cx->blk_oldretsp
+#define TOPBLOCK(cx) cx = &cxstack[cxstack_ix], \
+ PL_stack_sp = PL_stack_base + cx->blk_oldsp, \
+ PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
+ PL_scopestack_ix = cx->blk_oldscopesp, \
+ PL_retstack_ix = cx->blk_oldretsp, \
+ PL_curpm = cx->blk_oldpm
/* substitution context */
struct subst {
@@ -250,12 +262,14 @@ struct subst {
rxres_free(&cx->sb_rxres)
struct context {
- I32 cx_type; /* what kind of context this is */
+ U32 cx_type; /* what kind of context this is */
union {
struct block cx_blk;
struct subst cx_subst;
} cx_u;
};
+
+#define CXTYPEMASK 0xff
#define CXt_NULL 0
#define CXt_SUB 1
#define CXt_EVAL 2
@@ -263,6 +277,12 @@ struct context {
#define CXt_SUBST 4
#define CXt_BLOCK 5
+/* private flags for CXt_EVAL */
+#define CXp_REAL 0x00000100 /* truly eval'', not a lookalike */
+
+#define CxTYPE(c) ((c)->cx_type & CXTYPEMASK)
+#define CxREALEVAL(c) (((c)->cx_type & (CXt_EVAL|CXp_REAL)) == (CXt_EVAL|CXp_REAL))
+
#define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
/* "gimme" values */
@@ -275,3 +295,83 @@ struct context {
#define G_EVAL 4 /* Assume eval {} around subroutine call. */
#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. */
+
+/* Support for switching (stack and block) contexts.
+ * This ensures magic doesn't invalidate local stack and cx pointers.
+ */
+
+#define PERLSI_UNKNOWN -1
+#define PERLSI_UNDEF 0
+#define PERLSI_MAIN 1
+#define PERLSI_MAGIC 2
+#define PERLSI_SORT 3
+#define PERLSI_SIGNAL 4
+#define PERLSI_OVERLOAD 5
+#define PERLSI_DESTROY 6
+#define PERLSI_WARNHOOK 7
+#define PERLSI_DIEHOOK 8
+#define PERLSI_REQUIRE 9
+
+struct stackinfo {
+ AV * si_stack; /* stack for current runlevel */
+ PERL_CONTEXT * si_cxstack; /* context stack for runlevel */
+ I32 si_cxix; /* current context index */
+ I32 si_cxmax; /* maximum allocated index */
+ I32 si_type; /* type of runlevel */
+ struct stackinfo * si_prev;
+ struct stackinfo * si_next;
+ I32 * si_markbase; /* where markstack begins for us.
+ * currently used only with DEBUGGING,
+ * but not #ifdef-ed for bincompat */
+};
+
+typedef struct stackinfo PERL_SI;
+
+#define cxstack (PL_curstackinfo->si_cxstack)
+#define cxstack_ix (PL_curstackinfo->si_cxix)
+#define cxstack_max (PL_curstackinfo->si_cxmax)
+
+#ifdef DEBUGGING
+# define SET_MARKBASE PL_curstackinfo->si_markbase = PL_markstack_ptr
+#else
+# define SET_MARKBASE NOOP
+#endif
+
+#define PUSHSTACKi(type) \
+ STMT_START { \
+ PERL_SI *next = PL_curstackinfo->si_next; \
+ if (!next) { \
+ next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1); \
+ next->si_prev = PL_curstackinfo; \
+ PL_curstackinfo->si_next = next; \
+ } \
+ next->si_type = type; \
+ next->si_cxix = -1; \
+ AvFILLp(next->si_stack) = 0; \
+ SWITCHSTACK(PL_curstack,next->si_stack); \
+ PL_curstackinfo = next; \
+ SET_MARKBASE; \
+ } STMT_END
+
+#define PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN)
+
+#define POPSTACK \
+ STMT_START { \
+ PERL_SI *prev = PL_curstackinfo->si_prev; \
+ if (!prev) { \
+ PerlIO_printf(PerlIO_stderr(), "panic: POPSTACK\n"); \
+ my_exit(1); \
+ } \
+ SWITCHSTACK(PL_curstack,prev->si_stack); \
+ /* don't free prev here, free them all at the END{} */ \
+ PL_curstackinfo = prev; \
+ } STMT_END
+
+#define POPSTACK_TO(s) \
+ STMT_START { \
+ while (PL_curstack != s) { \
+ dounwind(-1); \
+ POPSTACK; \
+ } \
+ } STMT_END
diff --git a/gnu/usr.bin/perl/cv.h b/gnu/usr.bin/perl/cv.h
index 262d44c6357..9605135ffc0 100644
--- a/gnu/usr.bin/perl/cv.h
+++ b/gnu/usr.bin/perl/cv.h
@@ -1,6 +1,6 @@
/* cv.h
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -21,14 +21,18 @@ struct xpvcv {
HV * xcv_stash;
OP * xcv_start;
OP * xcv_root;
- void (*xcv_xsub) _((CV*));
+ void (*xcv_xsub) _((CV* _CPERLproto));
ANY xcv_xsubany;
GV * xcv_gv;
GV * xcv_filegv;
long xcv_depth; /* >= 2 indicates recursive call */
AV * xcv_padlist;
CV * xcv_outside;
- U8 xcv_flags;
+#ifdef USE_THREADS
+ perl_mutex *xcv_mutexp;
+ struct perl_thread *xcv_owner; /* current owner thread */
+#endif /* USE_THREADS */
+ cv_flags_t xcv_flags;
};
#define Nullcv Null(CV*)
@@ -43,15 +47,21 @@ struct xpvcv {
#define CvDEPTH(sv) ((XPVCV*)SvANY(sv))->xcv_depth
#define CvPADLIST(sv) ((XPVCV*)SvANY(sv))->xcv_padlist
#define CvOUTSIDE(sv) ((XPVCV*)SvANY(sv))->xcv_outside
+#ifdef USE_THREADS
+#define CvMUTEXP(sv) ((XPVCV*)SvANY(sv))->xcv_mutexp
+#define CvOWNER(sv) ((XPVCV*)SvANY(sv))->xcv_owner
+#endif /* USE_THREADS */
#define CvFLAGS(sv) ((XPVCV*)SvANY(sv))->xcv_flags
-#define CVf_CLONE 0x01 /* anon CV uses external lexicals */
-#define CVf_CLONED 0x02 /* a clone of one of those */
-#define CVf_ANON 0x04 /* CvGV() can't be trusted */
-#define CVf_OLDSTYLE 0x08
-#define CVf_UNIQUE 0x10 /* can't be cloned */
-#define CVf_NODEBUG 0x20 /* no DB::sub indirection for this CV
+#define CVf_CLONE 0x0001 /* anon CV uses external lexicals */
+#define CVf_CLONED 0x0002 /* a clone of one of those */
+#define CVf_ANON 0x0004 /* CvGV() can't be trusted */
+#define CVf_OLDSTYLE 0x0008
+#define CVf_UNIQUE 0x0010 /* can't be cloned */
+#define CVf_NODEBUG 0x0020 /* no DB::sub indirection for this CV
(esp. useful for special XSUBs) */
+#define CVf_METHOD 0x0040 /* CV is explicitly marked as a method */
+#define CVf_LOCKED 0x0080 /* CV locks itself or first arg on entry */
#define CvCLONE(cv) (CvFLAGS(cv) & CVf_CLONE)
#define CvCLONE_on(cv) (CvFLAGS(cv) |= CVf_CLONE)
@@ -76,3 +86,20 @@ struct xpvcv {
#define CvNODEBUG(cv) (CvFLAGS(cv) & CVf_NODEBUG)
#define CvNODEBUG_on(cv) (CvFLAGS(cv) |= CVf_NODEBUG)
#define CvNODEBUG_off(cv) (CvFLAGS(cv) &= ~CVf_NODEBUG)
+
+#define CvMETHOD(cv) (CvFLAGS(cv) & CVf_METHOD)
+#define CvMETHOD_on(cv) (CvFLAGS(cv) |= CVf_METHOD)
+#define CvMETHOD_off(cv) (CvFLAGS(cv) &= ~CVf_METHOD)
+
+#define CvLOCKED(cv) (CvFLAGS(cv) & CVf_LOCKED)
+#define CvLOCKED_on(cv) (CvFLAGS(cv) |= CVf_LOCKED)
+#define CvLOCKED_off(cv) (CvFLAGS(cv) &= ~CVf_LOCKED)
+
+#define CvEVAL(cv) (CvUNIQUE(cv) && !SvFAKE(cv))
+#define CvEVAL_on(cv) (CvUNIQUE_on(cv),SvFAKE_off(cv))
+#define CvEVAL_off(cv) CvUNIQUE_off(cv)
+
+/* BEGIN|INIT|END */
+#define CvSPECIAL(cv) (CvUNIQUE(cv) && SvFAKE(cv))
+#define CvSPECIAL_on(cv) (CvUNIQUE_on(cv),SvFAKE_on(cv))
+#define CvSPECIAL_off(cv) (CvUNIQUE_off(cv),SvFAKE_off(cv))
diff --git a/gnu/usr.bin/perl/cygwin32/cw32imp.h b/gnu/usr.bin/perl/cygwin32/cw32imp.h
index 1fb11d3e03c..885cbb12025 100644
--- a/gnu/usr.bin/perl/cygwin32/cw32imp.h
+++ b/gnu/usr.bin/perl/cygwin32/cw32imp.h
@@ -165,7 +165,6 @@
#define Perl_scopestack (*__imp_Perl_scopestack)
#define Perl_scopestack_ix (*__imp_Perl_scopestack_ix)
#define Perl_scopestack_max (*__imp_Perl_scopestack_max)
-#define Perl_scrgv (*__imp_Perl_scrgv)
#define Perl_sh_path (*__imp_Perl_sh_path)
#define Perl_sig_name (*__imp_Perl_sig_name)
#define Perl_sig_num (*__imp_Perl_sig_num)
diff --git a/gnu/usr.bin/perl/cygwin32/ld2 b/gnu/usr.bin/perl/cygwin32/ld2
index 9aec8798fed..cdec9d96eff 100644
--- a/gnu/usr.bin/perl/cygwin32/ld2
+++ b/gnu/usr.bin/perl/cygwin32/ld2
@@ -4,6 +4,6 @@
# passes all args to ld.
#
-PERLPATH=/perl5.004
+PERLPATH=/perl5.005
$PERLPATH/perl $PERLPATH/perlld "$@"
diff --git a/gnu/usr.bin/perl/cygwin32/perlgcc b/gnu/usr.bin/perl/cygwin32/perlgcc
index 97d7d1a8a53..202ed29a4f9 100644
--- a/gnu/usr.bin/perl/cygwin32/perlgcc
+++ b/gnu/usr.bin/perl/cygwin32/perlgcc
@@ -30,21 +30,21 @@ $libflagString = join(" ",@libFlags);
# make exports file
my $command = "echo EXPORTS > perl.def";
print "$command\n";
-system($command);
+system($command) == 0 or die "system() failed.\n";
$command ="nm $libstring | grep '^........ [TCD] _'| grep -v _impure_ptr | sed 's/[^_]*_//' >> perl.def";
print "$command\n";
-system($command);
+system($command) == 0 or die "system() failed.\n";
# Build the perl.a lib to link to:
$command ="dlltool --as=as --dllname perl.exe --def perl.def --output-lib perl.a";
print "$command\n";
-system($command);
+system($command) == 0 or die "system() failed.\n";
# change name of export lib to libperlexp so that is can be understood by ld2/perlld
$command ="mv perl.a libperlexp.a";
print "$command\n";
-system($command);
+system($command) == 0 or die "system() failed.\n";
# get the full path name of a few libs:
my $crt0 = `gcc -print-file-name=crt0.o`;
@@ -53,25 +53,32 @@ my $libdir = `gcc -print-file-name=libcygwin.a`;
chomp $libdir;
$libdir =~ s/libcygwin\.a//g;
+# when $crt0 and $libdir get used in the system calls below, the \'s
+# from the gcc -print-file-name get used to create special characters,
+# such as \n, \t. Replace the \'s with /'s so that this does not
+# happen:
+$crt0 =~ s:\\:/:g;
+$libdir =~ s:\\:/:g;
+
# Link exe:
$command = "ld --base-file perl.base -o perl.exe $crt0 $obsString $libstring -L$libdir $libflagString";
print "$command\n";
-system($command);
+system($command) == 0 or die "system() failed.\n";
$command = "dlltool --as=as --dllname perl.exe --def perl.def --base-file perl.base --output-exp perl.exp";
print "$command\n";
-system($command);
+system($command) == 0 or die "system() failed.\n";
$command = "ld --base-file perl.base perl.exp -o perl.exe $crt0 $obsString $libstring -L$libdir $libflagString";
print "$command\n";
-system($command);
+system($command) == 0 or die "system() failed.\n";
$command = "dlltool --as=as --dllname perl.exe --def perl.def --base-file perl.base --output-exp perl.exp";
print "$command\n";
-system($command);
+system($command) == 0 or die "system() failed.\n";
$command = "ld perl.exp -o perl.exe $crt0 $obsString $libstring -L$libdir $libflagString";
print "$command\n";
-system($command);
+system($command) == 0 or die "system() failed.\n";
print "perlgcc: Completed\n";
diff --git a/gnu/usr.bin/perl/cygwin32/perlld b/gnu/usr.bin/perl/cygwin32/perlld
index 1622f2ffaf2..97edfd64dd6 100644
--- a/gnu/usr.bin/perl/cygwin32/perlld
+++ b/gnu/usr.bin/perl/cygwin32/perlld
@@ -47,54 +47,54 @@ if( $args=~/\-o (.+?)\.dll/i){
writeInit();
$command = "gcc -c $fixup.c\n";
print $command;
- system($command);
+ system($command) == 0 or die "system() failed.\n";
$command = "gcc -c $init.cc\n";
print $command;
- system($command);
+ system($command) == 0 or die "system() failed.\n";
$command = "echo EXPORTS > $libname.def\n";
print $command;
- system($command);
+ system($command) == 0 or die "system() failed.\n";
$command = "nm ".join(" ",@objs)." $init.o $fixup.o | grep '^........ [TCD] _' | sed 's/[^_]*_//' >> $libname.def\n";
print $command;
- system($command);
+ system($command) == 0 or die "system() failed.\n";
$command = "ld --base-file $libname.base --dll -o $libname.dll ".join(" ",@objs)." $init.o $fixup.o ";
$command .= join(" ",@flags)." -e _dll_entry\@12 \n";
print $command;
- system($command);
+ system($command) == 0 or die "system() failed.\n";
$command = "dlltool --as=as --dllname $libname.dll --def $libname.def --base-file $libname.base --output-exp $libname.exp\n";
print $command;
- system($command);
+ system($command) == 0 or die "system() failed.\n";
$command = "ld --base-file $libname.base $libname.exp --dll -o $libname.dll ".join(" ",@objs)." $init.o $fixup.o ";
$command .= join(" ",@flags)." -e _dll_entry\@12 \n";
print $command;
- system($command);
+ system($command) == 0 or die "system() failed.\n";
$command = "dlltool --as=as --dllname $libname.dll --def $libname.def --base-file $libname.base --output-exp $libname.exp\n";
print $command;
- system($command);
+ system($command) == 0 or die "system() failed.\n";
$command = "ld $libname.exp --dll -o $libname.dll ".join(" ",@objs)." $init.o $fixup.o ";
$command .= join(" ",@flags)." -e _dll_entry\@12 \n";
print $command;
- system($command);
+ system($command) == 0 or die "system() failed.\n";
print "Build the import lib\n";
$command = "dlltool --as=as --dllname $libname.dll --def $libname.def --output-lib $libname.a\n";
print $command;
- system($command);
+ system($command) == 0 or die "system() failed.\n";
# if there was originally a path, copy the dll and a to that location:
if($path && $path ne "./" && $path."\n" ne "`pwd`"){
$command = "mv $libname.dll $path".$libname.".dll\n";
print $command;
- system($command);
+ system($command) == 0 or die "system() failed.\n";
$command = "mv $libname.a $path".$libname.".a\n";
print $command;
- system($command);
+ system($command) == 0 or die "system() failed.\n";
}
@@ -102,7 +102,7 @@ if( $args=~/\-o (.+?)\.dll/i){
else{ # no special processing, just call ld
$command = "ld $args\n";
print $command;
- system($command);
+ system($command) == 0 or die "system() failed.\n";
}
#---------------------------------------------------------------------------
diff --git a/gnu/usr.bin/perl/deb.c b/gnu/usr.bin/perl/deb.c
index 8058d1a3b39..ad26cd6e18f 100644
--- a/gnu/usr.bin/perl/deb.c
+++ b/gnu/usr.bin/perl/deb.c
@@ -1,6 +1,6 @@
/* deb.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -15,118 +15,100 @@
#include "EXTERN.h"
#include "perl.h"
-#ifdef DEBUGGING
-#if !defined(I_STDARG) && !defined(I_VARARGS)
-
-/*
- * Fallback on the old hackers way of doing varargs
- */
-
-/*VARARGS1*/
-void
-deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
- char *pat;
-{
- register I32 i;
- GV* gv = curcop->cop_filegv;
-
- PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
- SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
- (long)curcop->cop_line);
- for (i=0; i<dlevel; i++)
- PerlIO_printf(Perl_debug_log, "%c%c ",debname[i],debdelim[i]);
- PerlIO_printf(Perl_debug_log, pat,a1,a2,a3,a4,a5,a6,a7,a8);
-}
-
-#else /* !defined(I_STDARG) && !defined(I_VARARGS) */
-
-# ifdef I_STDARG
void
deb(const char *pat, ...)
-# else
-/*VARARGS1*/
-void
-deb(pat, va_alist)
- const char *pat;
- va_dcl
-# endif
{
+#ifdef DEBUGGING
+ dTHR;
va_list args;
register I32 i;
- GV* gv = curcop->cop_filegv;
+ GV* gv = PL_curcop->cop_filegv;
+#ifdef USE_THREADS
+ PerlIO_printf(Perl_debug_log, "0x%lx (%s:%ld)\t",
+ (unsigned long) thr,
+ SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
+ (long)PL_curcop->cop_line);
+#else
PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
- (long)curcop->cop_line);
- for (i=0; i<dlevel; i++)
- PerlIO_printf(Perl_debug_log, "%c%c ",debname[i],debdelim[i]);
+ (long)PL_curcop->cop_line);
+#endif /* USE_THREADS */
+ for (i=0; i<PL_dlevel; i++)
+ PerlIO_printf(Perl_debug_log, "%c%c ",PL_debname[i],PL_debdelim[i]);
-# ifdef I_STDARG
va_start(args, pat);
-# else
- va_start(args);
-# endif
(void) PerlIO_vprintf(Perl_debug_log,pat,args);
va_end( args );
+#endif /* DEBUGGING */
}
-#endif /* !defined(I_STDARG) && !defined(I_VARARGS) */
void
-deb_growlevel()
+deb_growlevel(void)
{
- dlmax += 128;
- Renew(debname, dlmax, char);
- Renew(debdelim, dlmax, char);
+#ifdef DEBUGGING
+ PL_dlmax += 128;
+ Renew(PL_debname, PL_dlmax, char);
+ Renew(PL_debdelim, PL_dlmax, char);
+#endif /* DEBUGGING */
}
I32
-debstackptrs()
+debstackptrs(void)
{
+#ifdef DEBUGGING
+ dTHR;
PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
- (unsigned long)curstack, (unsigned long)stack_base,
- (long)*markstack_ptr, (long)(stack_sp-stack_base),
- (long)(stack_max-stack_base));
+ (unsigned long)PL_curstack, (unsigned long)PL_stack_base,
+ (long)*PL_markstack_ptr, (long)(PL_stack_sp-PL_stack_base),
+ (long)(PL_stack_max-PL_stack_base));
PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
- (unsigned long)mainstack, (unsigned long)AvARRAY(curstack),
- (long)mainstack, (long)AvFILL(curstack), (long)AvMAX(curstack));
+ (unsigned long)PL_mainstack, (unsigned long)AvARRAY(PL_curstack),
+ (long)PL_mainstack, (long)AvFILLp(PL_curstack), (long)AvMAX(PL_curstack));
+#endif /* DEBUGGING */
return 0;
}
I32
-debstack()
+debstack(void)
{
- I32 top = stack_sp - stack_base;
+#ifdef DEBUGGING
+ dTHR;
+ I32 top = PL_stack_sp - PL_stack_base;
register I32 i = top - 30;
- I32 *markscan = markstack;
+ I32 *markscan = PL_curstackinfo->si_markbase;
if (i < 0)
i = 0;
- while (++markscan <= markstack_ptr)
+ while (++markscan <= PL_markstack_ptr)
if (*markscan >= i)
break;
+#ifdef USE_THREADS
+ PerlIO_printf(Perl_debug_log, i ? "0x%lx => ... " : "0x%lx => ",
+ (unsigned long) thr);
+#else
PerlIO_printf(Perl_debug_log, i ? " => ... " : " => ");
- if (stack_base[0] != &sv_undef || stack_sp < stack_base)
+#endif /* USE_THREADS */
+ if (PL_stack_base[0] != &PL_sv_undef || PL_stack_sp < PL_stack_base)
PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
do {
++i;
- if (markscan <= markstack_ptr && *markscan < i) {
+ if (markscan <= PL_markstack_ptr && *markscan < i) {
do {
++markscan;
PerlIO_putc(Perl_debug_log, '*');
}
- while (markscan <= markstack_ptr && *markscan < i);
+ while (markscan <= PL_markstack_ptr && *markscan < i);
PerlIO_printf(Perl_debug_log, " ");
}
if (i > top)
break;
- PerlIO_printf(Perl_debug_log, "%-4s ", SvPEEK(stack_base[i]));
+ PerlIO_printf(Perl_debug_log, "%-4s ", SvPEEK(PL_stack_base[i]));
}
while (1);
PerlIO_printf(Perl_debug_log, "\n");
+#endif /* DEBUGGING */
return 0;
}
-#else
-static int dummy; /* avoid totally empty deb.o file */
-#endif /* DEBUGGING */
diff --git a/gnu/usr.bin/perl/doio.c b/gnu/usr.bin/perl/doio.c
index a27e5b9fdd4..74544c95002 100644
--- a/gnu/usr.bin/perl/doio.c
+++ b/gnu/usr.bin/perl/doio.c
@@ -1,6 +1,6 @@
/* doio.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -18,13 +18,12 @@
#include "perl.h"
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
+#ifndef HAS_SEM
#include <sys/ipc.h>
+#endif
#ifdef HAS_MSG
#include <sys/msg.h>
#endif
-#ifdef HAS_SEM
-#include <sys/sem.h>
-#endif
#ifdef HAS_SHM
#include <sys/shm.h>
# ifndef HAS_SHMAT_PROTOTYPE
@@ -34,18 +33,24 @@
#endif
#ifdef I_UTIME
-# ifdef _MSC_VER
+# if defined(_MSC_VER) || defined(__MINGW32__)
# include <sys/utime.h>
# else
# include <utime.h>
# endif
#endif
+
#ifdef I_FCNTL
#include <fcntl.h>
#endif
#ifdef I_SYS_FILE
#include <sys/file.h>
#endif
+#ifdef O_EXCL
+# define OPEN_EXCL O_EXCL
+#else
+# define OPEN_EXCL 0
+#endif
#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
#include <signal.h>
@@ -76,13 +81,7 @@
#endif
bool
-do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp)
-GV *gv;
-register char *name;
-I32 len;
-int as_raw;
-int rawmode, rawperm;
-PerlIO *supplied_fp;
+do_open(GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp)
{
register IO *io = GvIOn(gv);
PerlIO *saveifp = Nullfp;
@@ -92,21 +91,22 @@ PerlIO *supplied_fp;
PerlIO *fp;
int fd;
int result;
+ bool was_fdopen = FALSE;
- forkprocess = 1; /* assume true if no fork */
+ PL_forkprocess = 1; /* assume true if no fork */
if (IoIFP(io)) {
fd = PerlIO_fileno(IoIFP(io));
if (IoTYPE(io) == '-')
result = 0;
- else if (fd <= maxsysfd) {
+ else if (fd <= PL_maxsysfd) {
saveifp = IoIFP(io);
saveofp = IoOFP(io);
savetype = IoTYPE(io);
result = 0;
}
else if (IoTYPE(io) == '|')
- result = my_pclose(IoIFP(io));
+ result = PerlProc_pclose(IoIFP(io));
else if (IoIFP(io) != IoOFP(io)) {
if (IoOFP(io)) {
result = PerlIO_close(IoOFP(io));
@@ -117,32 +117,47 @@ PerlIO *supplied_fp;
}
else
result = PerlIO_close(IoIFP(io));
- if (result == EOF && fd > maxsysfd)
+ if (result == EOF && fd > PL_maxsysfd)
PerlIO_printf(PerlIO_stderr(), "Warning: unable to close filehandle %s properly.\n",
GvENAME(gv));
IoOFP(io) = IoIFP(io) = Nullfp;
}
if (as_raw) {
- result = rawmode & 3;
- IoTYPE(io) = "<>++"[result];
+#ifndef O_ACCMODE
+#define O_ACCMODE 3 /* Assume traditional implementation */
+#endif
+ switch (result = rawmode & O_ACCMODE) {
+ case O_RDONLY:
+ IoTYPE(io) = '<';
+ break;
+ case O_WRONLY:
+ IoTYPE(io) = '>';
+ break;
+ case O_RDWR:
+ default:
+ IoTYPE(io) = '+';
+ break;
+ }
+
writing = (result > 0);
- fd = open(name, rawmode, rawperm);
+ fd = PerlLIO_open3(name, rawmode, rawperm);
+
if (fd == -1)
fp = NULL;
else {
char *fpmode;
- if (result == 0)
+ if (result == O_RDONLY)
fpmode = "r";
#ifdef O_APPEND
else if (rawmode & O_APPEND)
- fpmode = (result == 1) ? "a" : "a+";
+ fpmode = (result == O_WRONLY) ? "a" : "a+";
#endif
else
- fpmode = (result == 1) ? "w" : "r+";
+ fpmode = (result == O_WRONLY) ? "w" : "r+";
fp = PerlIO_fdopen(fd, fpmode);
if (!fp)
- close(fd);
+ PerlLIO_close(fd);
}
}
else {
@@ -170,9 +185,12 @@ PerlIO *supplied_fp;
if (strNE(name,"-"))
TAINT_ENV();
TAINT_PROPER("piped open");
- if (dowarn && name[strlen(name)-1] == '|')
- warn("Can't do bidirectional pipe");
- fp = my_popen(name,"w");
+ if (name[strlen(name)-1] == '|') {
+ name[strlen(name)-1] = '\0' ;
+ if (PL_dowarn)
+ warn("Can't do bidirectional pipe");
+ }
+ fp = PerlProc_popen(name,"w");
writing = 1;
}
else if (*name == '>') {
@@ -220,10 +238,12 @@ PerlIO *supplied_fp;
fd = -1;
}
if (dodup)
- fd = dup(fd);
+ fd = PerlLIO_dup(fd);
+ else
+ was_fdopen = TRUE;
if (!(fp = PerlIO_fdopen(fd,mode))) {
if (dodup)
- close(fd);
+ PerlLIO_close(fd);
}
}
}
@@ -252,7 +272,7 @@ PerlIO *supplied_fp;
else
fp = PerlIO_open(name,mode);
}
- else if (name[len-1] == '|') {
+ else if (len > 1 && name[len-1] == '|') {
name[--len] = '\0';
while (len && isSPACE(name[len-1]))
name[--len] = '\0';
@@ -261,7 +281,7 @@ PerlIO *supplied_fp;
if (strNE(name,"-"))
TAINT_ENV();
TAINT_PROPER("piped open");
- fp = my_popen(name,"r");
+ fp = PerlProc_popen(name,"r");
IoTYPE(io) = '|';
}
else {
@@ -277,28 +297,30 @@ PerlIO *supplied_fp;
}
}
if (!fp) {
- if (dowarn && IoTYPE(io) == '<' && strchr(name, '\n'))
+ if (PL_dowarn && IoTYPE(io) == '<' && strchr(name, '\n'))
warn(warn_nl, "open");
goto say_false;
}
if (IoTYPE(io) &&
IoTYPE(io) != '|' && IoTYPE(io) != '-') {
- if (Fstat(PerlIO_fileno(fp),&statbuf) < 0) {
+ dTHR;
+ if (PerlLIO_fstat(PerlIO_fileno(fp),&PL_statbuf) < 0) {
(void)PerlIO_close(fp);
goto say_false;
}
- if (S_ISSOCK(statbuf.st_mode))
+ if (S_ISSOCK(PL_statbuf.st_mode))
IoTYPE(io) = 's'; /* in case a socket was passed in to us */
#ifdef HAS_SOCKET
else if (
#ifdef S_IFMT
- !(statbuf.st_mode & S_IFMT)
+ !(PL_statbuf.st_mode & S_IFMT)
#else
- !statbuf.st_mode
+ !PL_statbuf.st_mode
#endif
) {
- Sock_size_t buflen = sizeof tokenbuf;
- if (getsockname(PerlIO_fileno(fp), (struct sockaddr *)tokenbuf,
+ 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 */
@@ -320,28 +342,34 @@ PerlIO *supplied_fp;
int pid;
SV *sv;
- dup2(PerlIO_fileno(fp), fd);
- sv = *av_fetch(fdpid,PerlIO_fileno(fp),TRUE);
+ PerlLIO_dup2(PerlIO_fileno(fp), fd);
+ sv = *av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
(void)SvUPGRADE(sv, SVt_IV);
pid = SvIVX(sv);
SvIVX(sv) = 0;
- sv = *av_fetch(fdpid,fd,TRUE);
+ sv = *av_fetch(PL_fdpid,fd,TRUE);
(void)SvUPGRADE(sv, SVt_IV);
SvIVX(sv) = pid;
- PerlIO_close(fp);
+ if (!was_fdopen)
+ PerlIO_close(fp);
}
fp = saveifp;
PerlIO_clearerr(fp);
}
#if defined(HAS_FCNTL) && defined(F_SETFD)
- fd = PerlIO_fileno(fp);
- fcntl(fd,F_SETFD,fd > maxsysfd);
+ {
+ int save_errno = errno;
+ fd = PerlIO_fileno(fp);
+ fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */
+ errno = save_errno;
+ }
#endif
IoIFP(io) = fp;
if (writing) {
+ dTHR;
if (IoTYPE(io) == 's'
- || (IoTYPE(io) == '>' && S_ISCHR(statbuf.st_mode)) ) {
+ || (IoTYPE(io) == '>' && S_ISCHR(PL_statbuf.st_mode)) ) {
if (!(IoOFP(io) = PerlIO_fdopen(PerlIO_fileno(fp),"w"))) {
PerlIO_close(fp);
IoIFP(io) = Nullfp;
@@ -361,8 +389,7 @@ say_false:
}
PerlIO *
-nextargv(gv)
-register GV *gv;
+nextargv(register GV *gv)
{
register SV *sv;
#ifndef FLEXFILENAMES
@@ -372,55 +399,70 @@ register GV *gv;
int fileuid;
int filegid;
- if (!argvoutgv)
- argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO);
- if (filemode & (S_ISUID|S_ISGID)) {
- PerlIO_flush(IoIFP(GvIOn(argvoutgv))); /* chmod must follow last write */
+ if (!PL_argvoutgv)
+ PL_argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO);
+ if (PL_filemode & (S_ISUID|S_ISGID)) {
+ PerlIO_flush(IoIFP(GvIOn(PL_argvoutgv))); /* chmod must follow last write */
#ifdef HAS_FCHMOD
- (void)fchmod(lastfd,filemode);
+ (void)fchmod(PL_lastfd,PL_filemode);
#else
- (void)chmod(oldname,filemode);
+ (void)PerlLIO_chmod(PL_oldname,PL_filemode);
#endif
}
- filemode = 0;
+ PL_filemode = 0;
while (av_len(GvAV(gv)) >= 0) {
- STRLEN len;
+ dTHR;
+ STRLEN oldlen;
sv = av_shift(GvAV(gv));
SAVEFREESV(sv);
sv_setsv(GvSV(gv),sv);
SvSETMAGIC(GvSV(gv));
- oldname = SvPVx(GvSV(gv), len);
- if (do_open(gv,oldname,len,FALSE,0,0,Nullfp)) {
- if (inplace) {
+ PL_oldname = SvPVx(GvSV(gv), oldlen);
+ if (do_open(gv,PL_oldname,oldlen,PL_inplace!=0,O_RDONLY,0,Nullfp)) {
+ if (PL_inplace) {
TAINT_PROPER("inplace open");
- if (strEQ(oldname,"-")) {
+ if (oldlen == 1 && *PL_oldname == '-') {
setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO));
return IoIFP(GvIOp(gv));
}
#ifndef FLEXFILENAMES
- filedev = statbuf.st_dev;
- fileino = statbuf.st_ino;
+ filedev = PL_statbuf.st_dev;
+ fileino = PL_statbuf.st_ino;
#endif
- filemode = statbuf.st_mode;
- fileuid = statbuf.st_uid;
- filegid = statbuf.st_gid;
- if (!S_ISREG(filemode)) {
+ PL_filemode = PL_statbuf.st_mode;
+ fileuid = PL_statbuf.st_uid;
+ filegid = PL_statbuf.st_gid;
+ if (!S_ISREG(PL_filemode)) {
warn("Can't do inplace edit: %s is not a regular file",
- oldname );
+ PL_oldname );
do_close(gv,FALSE);
continue;
}
- if (*inplace) {
-#ifdef SUFFIX
- add_suffix(sv,inplace);
-#else
- sv_catpv(sv,inplace);
-#endif
+ if (*PL_inplace) {
+ char *star = strchr(PL_inplace, '*');
+ if (star) {
+ char *begin = PL_inplace;
+ sv_setpvn(sv, "", 0);
+ do {
+ sv_catpvn(sv, begin, star - begin);
+ sv_catpvn(sv, PL_oldname, oldlen);
+ begin = ++star;
+ } while ((star = strchr(begin, '*')));
+ if (*begin)
+ sv_catpv(sv,begin);
+ }
+ else {
+ sv_catpv(sv,PL_inplace);
+ }
#ifndef FLEXFILENAMES
- if (Stat(SvPVX(sv),&statbuf) >= 0
- && statbuf.st_dev == filedev
- && statbuf.st_ino == fileino ) {
- warn("Can't do inplace edit: %s > 14 characters",
+ if (PerlLIO_stat(SvPVX(sv),&PL_statbuf) >= 0
+ && PL_statbuf.st_dev == filedev
+ && PL_statbuf.st_ino == fileino
+#ifdef DJGPP
+ || (_djstat_fail_bits & _STFAIL_TRUENAME)!=0
+#endif
+ ) {
+ warn("Can't do inplace edit: %s would not be uniq",
SvPVX(sv) );
do_close(gv,FALSE);
continue;
@@ -428,35 +470,35 @@ register GV *gv;
#endif
#ifdef HAS_RENAME
#ifndef DOSISH
- if (rename(oldname,SvPVX(sv)) < 0) {
+ if (PerlLIO_rename(PL_oldname,SvPVX(sv)) < 0) {
warn("Can't rename %s to %s: %s, skipping file",
- oldname, SvPVX(sv), Strerror(errno) );
+ PL_oldname, SvPVX(sv), Strerror(errno) );
do_close(gv,FALSE);
continue;
}
#else
do_close(gv,FALSE);
- (void)unlink(SvPVX(sv));
- (void)rename(oldname,SvPVX(sv));
- do_open(gv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp);
+ (void)PerlLIO_unlink(SvPVX(sv));
+ (void)PerlLIO_rename(PL_oldname,SvPVX(sv));
+ do_open(gv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,O_RDONLY,0,Nullfp);
#endif /* DOSISH */
#else
(void)UNLINK(SvPVX(sv));
- if (link(oldname,SvPVX(sv)) < 0) {
+ if (link(PL_oldname,SvPVX(sv)) < 0) {
warn("Can't rename %s to %s: %s, skipping file",
- oldname, SvPVX(sv), Strerror(errno) );
+ PL_oldname, SvPVX(sv), Strerror(errno) );
do_close(gv,FALSE);
continue;
}
- (void)UNLINK(oldname);
+ (void)UNLINK(PL_oldname);
#endif
}
else {
#if !defined(DOSISH) && !defined(AMIGAOS)
# ifndef VMS /* Don't delete; use automatic file versioning */
- if (UNLINK(oldname) < 0) {
- warn("Can't rename %s to %s: %s, skipping file",
- oldname, SvPVX(sv), Strerror(errno) );
+ if (UNLINK(PL_oldname) < 0) {
+ warn("Can't remove %s: %s, skipping file",
+ PL_oldname, Strerror(errno) );
do_close(gv,FALSE);
continue;
}
@@ -466,32 +508,38 @@ register GV *gv;
#endif
}
- sv_setpvn(sv,">",1);
- sv_catpv(sv,oldname);
+ sv_setpvn(sv,">",!PL_inplace);
+ sv_catpvn(sv,PL_oldname,oldlen);
SETERRNO(0,0); /* in case sprintf set errno */
- if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp)) {
+#ifdef VMS
+ if (!do_open(PL_argvoutgv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,
+ O_WRONLY|O_CREAT|O_TRUNC,0,Nullfp)) {
+#else
+ if (!do_open(PL_argvoutgv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,
+ O_WRONLY|O_CREAT|OPEN_EXCL,0666,Nullfp)) {
+#endif
warn("Can't do inplace edit on %s: %s",
- oldname, Strerror(errno) );
+ PL_oldname, Strerror(errno) );
do_close(gv,FALSE);
continue;
}
- setdefout(argvoutgv);
- lastfd = PerlIO_fileno(IoIFP(GvIOp(argvoutgv)));
- (void)Fstat(lastfd,&statbuf);
+ setdefout(PL_argvoutgv);
+ PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv)));
+ (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf);
#ifdef HAS_FCHMOD
- (void)fchmod(lastfd,filemode);
+ (void)fchmod(PL_lastfd,PL_filemode);
#else
# if !(defined(WIN32) && defined(__BORLANDC__))
/* Borland runtime creates a readonly file! */
- (void)chmod(oldname,filemode);
+ (void)PerlLIO_chmod(PL_oldname,PL_filemode);
# endif
#endif
- if (fileuid != statbuf.st_uid || filegid != statbuf.st_gid) {
+ if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) {
#ifdef HAS_FCHOWN
- (void)fchown(lastfd,fileuid,filegid);
+ (void)fchown(PL_lastfd,fileuid,filegid);
#else
#ifdef HAS_CHOWN
- (void)chown(oldname,fileuid,filegid);
+ (void)PerlLIO_chown(PL_oldname,fileuid,filegid);
#endif
#endif
}
@@ -499,10 +547,11 @@ register GV *gv;
return IoIFP(GvIOp(gv));
}
else
- PerlIO_printf(PerlIO_stderr(), "Can't open %s: %s\n",SvPV(sv, na), Strerror(errno));
+ PerlIO_printf(PerlIO_stderr(), "Can't open %s: %s\n",
+ SvPV(sv, oldlen), Strerror(errno));
}
- if (inplace) {
- (void)do_close(argvoutgv,FALSE);
+ if (PL_inplace) {
+ (void)do_close(PL_argvoutgv,FALSE);
setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO));
}
return Nullfp;
@@ -510,10 +559,7 @@ register GV *gv;
#ifdef HAS_PIPE
void
-do_pipe(sv, rgv, wgv)
-SV *sv;
-GV *rgv;
-GV *wgv;
+do_pipe(SV *sv, GV *rgv, GV *wgv)
{
register IO *rstio;
register IO *wstio;
@@ -532,7 +578,7 @@ GV *wgv;
if (IoIFP(wstio))
do_close(wgv,FALSE);
- if (pipe(fd) < 0)
+ if (PerlProc_pipe(fd) < 0)
goto badexit;
IoIFP(rstio) = PerlIO_fdopen(fd[0], "r");
IoOFP(wstio) = PerlIO_fdopen(fd[1], "w");
@@ -541,44 +587,42 @@ GV *wgv;
IoTYPE(wstio) = '>';
if (!IoIFP(rstio) || !IoOFP(wstio)) {
if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio));
- else close(fd[0]);
+ else PerlLIO_close(fd[0]);
if (IoOFP(wstio)) PerlIO_close(IoOFP(wstio));
- else close(fd[1]);
+ else PerlLIO_close(fd[1]);
goto badexit;
}
- sv_setsv(sv,&sv_yes);
+ sv_setsv(sv,&PL_sv_yes);
return;
badexit:
- sv_setsv(sv,&sv_undef);
+ sv_setsv(sv,&PL_sv_undef);
return;
}
#endif
/* explicit renamed to avoid C++ conflict -- kja */
bool
-#ifndef CAN_PROTOTYPE
-do_close(gv,not_implicit)
-GV *gv;
-bool not_implicit;
-#else
do_close(GV *gv, bool not_implicit)
-#endif /* CAN_PROTOTYPE */
{
bool retval;
IO *io;
if (!gv)
- gv = argvgv;
+ gv = PL_argvgv;
if (!gv || SvTYPE(gv) != SVt_PVGV) {
- SETERRNO(EBADF,SS$_IVCHAN);
+ if (not_implicit)
+ SETERRNO(EBADF,SS$_IVCHAN);
return FALSE;
}
io = GvIO(gv);
if (!io) { /* never opened */
- if (dowarn && not_implicit)
- warn("Close on unopened file <%s>",GvENAME(gv));
+ if (not_implicit) {
+ if (PL_dowarn)
+ warn("Close on unopened file <%s>",GvENAME(gv));
+ SETERRNO(EBADF,SS$_IVCHAN);
+ }
return FALSE;
}
retval = io_close(io);
@@ -592,15 +636,14 @@ do_close(GV *gv, bool not_implicit)
}
bool
-io_close(io)
-IO* io;
+io_close(IO *io)
{
bool retval = FALSE;
int status;
if (IoIFP(io)) {
if (IoTYPE(io) == '|') {
- status = my_pclose(IoIFP(io));
+ status = PerlProc_pclose(IoIFP(io));
STATUS_NATIVE_SET(status);
retval = (STATUS_POSIX == 0);
}
@@ -616,14 +659,17 @@ IO* io;
}
IoOFP(io) = IoIFP(io) = Nullfp;
}
+ else {
+ SETERRNO(EBADF,SS$_IVCHAN);
+ }
return retval;
}
bool
-do_eof(gv)
-GV *gv;
+do_eof(GV *gv)
{
+ dTHR;
register IO *io;
int ch;
@@ -648,8 +694,8 @@ GV *gv;
if (PerlIO_get_cnt(IoIFP(io)) < -1)
PerlIO_set_cnt(IoIFP(io),-1);
}
- if (op->op_flags & OPf_SPECIAL) { /* not necessarily a real EOF yet? */
- if (!nextargv(argvgv)) /* get another fp handy */
+ if (PL_op->op_flags & OPf_SPECIAL) { /* not necessarily a real EOF yet? */
+ if (!nextargv(PL_argvgv)) /* get another fp handy */
return TRUE;
}
else
@@ -659,8 +705,7 @@ GV *gv;
}
long
-do_tell(gv)
-GV *gv;
+do_tell(GV *gv)
{
register IO *io;
register PerlIO *fp;
@@ -672,17 +717,14 @@ GV *gv;
#endif
return PerlIO_tell(fp);
}
- if (dowarn)
+ if (PL_dowarn)
warn("tell() on unopened file");
SETERRNO(EBADF,RMS$_IFI);
return -1L;
}
bool
-do_seek(gv, pos, whence)
-GV *gv;
-long pos;
-int whence;
+do_seek(GV *gv, long int pos, int whence)
{
register IO *io;
register PerlIO *fp;
@@ -694,29 +736,66 @@ int whence;
#endif
return PerlIO_seek(fp, pos, whence) >= 0;
}
- if (dowarn)
+ if (PL_dowarn)
warn("seek() on unopened file");
SETERRNO(EBADF,RMS$_IFI);
return FALSE;
}
long
-do_sysseek(gv, pos, whence)
-GV *gv;
-long pos;
-int whence;
+do_sysseek(GV *gv, long int pos, int whence)
{
register IO *io;
register PerlIO *fp;
if (gv && (io = GvIO(gv)) && (fp = IoIFP(io)))
- return lseek(PerlIO_fileno(fp), pos, whence);
- if (dowarn)
+ return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence);
+ if (PL_dowarn)
warn("sysseek() on unopened file");
SETERRNO(EBADF,RMS$_IFI);
return -1L;
}
+int
+do_binmode(PerlIO *fp, int iotype, int flag)
+{
+ if (flag != TRUE)
+ croak("panic: unsetting binmode"); /* Not implemented yet */
+#ifdef DOSISH
+#if defined(atarist) || defined(__MINT__)
+ if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN))
+ return 1;
+ else
+ return 0;
+#else
+ if (PerlLIO_setmode(PerlIO_fileno(fp), OP_BINARY) != -1) {
+#if defined(WIN32) && defined(__BORLANDC__)
+ /* The translation mode of the stream is maintained independent
+ * of the translation mode of the fd in the Borland RTL (heavy
+ * digging through their runtime sources reveal). User has to
+ * set the mode explicitly for the stream (though they don't
+ * document this anywhere). GSAR 97-5-24
+ */
+ PerlIO_seek(fp,0L,0);
+ ((FILE*)fp)->flags |= _F_BIN;
+#endif
+ return 1;
+ }
+ else
+ return 0;
+#endif
+#else
+#if defined(USEMYBINMODE)
+ if (my_binmode(fp,iotype) != NULL)
+ return 1;
+ else
+ return 0;
+#else
+ return 1;
+#endif
+#endif
+}
+
#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
/* code courtesy of William Kucharski */
#define HAS_CHSIZE
@@ -728,19 +807,19 @@ Off_t length; /* length to set file to */
struct flock fl;
struct stat filebuf;
- if (Fstat(fd, &filebuf) < 0)
+ if (PerlLIO_fstat(fd, &filebuf) < 0)
return -1;
if (filebuf.st_size < length) {
/* extend file length */
- if ((lseek(fd, (length - 1), 0)) < 0)
+ if ((PerlLIO_lseek(fd, (length - 1), 0)) < 0)
return -1;
/* write a "0" byte */
- if ((write(fd, "", 1)) != 1)
+ if ((PerlLIO_write(fd, "", 1)) != 1)
return -1;
}
else {
@@ -769,9 +848,7 @@ Off_t length; /* length to set file to */
#endif /* F_FREESP */
bool
-do_print(sv,fp)
-register SV *sv;
-PerlIO *fp;
+do_print(register SV *sv, PerlIO *fp)
{
register char *tmps;
STRLEN len;
@@ -779,22 +856,22 @@ PerlIO *fp;
/* assuming fp is checked earlier */
if (!sv)
return TRUE;
- if (ofmt) {
+ if (PL_ofmt) {
if (SvGMAGICAL(sv))
mg_get(sv);
if (SvIOK(sv) && SvIVX(sv) != 0) {
- PerlIO_printf(fp, ofmt, (double)SvIVX(sv));
+ PerlIO_printf(fp, PL_ofmt, (double)SvIVX(sv));
return !PerlIO_error(fp);
}
if ( (SvNOK(sv) && SvNVX(sv) != 0.0)
|| (looks_like_number(sv) && sv_2nv(sv) != 0.0) ) {
- PerlIO_printf(fp, ofmt, SvNVX(sv));
+ PerlIO_printf(fp, PL_ofmt, SvNVX(sv));
return !PerlIO_error(fp);
}
}
switch (SvTYPE(sv)) {
case SVt_NULL:
- if (dowarn)
+ if (PL_dowarn)
warn(warn_uninit);
return TRUE;
case SVt_IV:
@@ -815,37 +892,38 @@ PerlIO *fp;
}
I32
-my_stat(ARGS)
-dARGS
+my_stat(ARGSproto)
{
- dSP;
+ djSP;
IO *io;
GV* tmpgv;
- if (op->op_flags & OPf_REF) {
- EXTEND(sp,1);
+ if (PL_op->op_flags & OPf_REF) {
+ EXTEND(SP,1);
tmpgv = cGVOP->op_gv;
do_fstat:
io = GvIO(tmpgv);
if (io && IoIFP(io)) {
- statgv = tmpgv;
- sv_setpv(statname,"");
- laststype = OP_STAT;
- return (laststatval = Fstat(PerlIO_fileno(IoIFP(io)), &statcache));
+ PL_statgv = tmpgv;
+ sv_setpv(PL_statname,"");
+ PL_laststype = OP_STAT;
+ return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache));
}
else {
- if (tmpgv == defgv)
- return laststatval;
- if (dowarn)
+ if (tmpgv == PL_defgv)
+ return PL_laststatval;
+ if (PL_dowarn)
warn("Stat on unopened file <%s>",
GvENAME(tmpgv));
- statgv = Nullgv;
- sv_setpv(statname,"");
- return (laststatval = -1);
+ PL_statgv = Nullgv;
+ sv_setpv(PL_statname,"");
+ return (PL_laststatval = -1);
}
}
else {
SV* sv = POPs;
+ char *s;
+ STRLEN n_a;
PUTBACK;
if (SvTYPE(sv) == SVt_PVGV) {
tmpgv = (GV*)sv;
@@ -856,97 +934,96 @@ dARGS
goto do_fstat;
}
- statgv = Nullgv;
- sv_setpv(statname,SvPV(sv, na));
- laststype = OP_STAT;
- laststatval = Stat(SvPV(sv, na),&statcache);
- if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
+ s = SvPV(sv, n_a);
+ PL_statgv = Nullgv;
+ sv_setpv(PL_statname, s);
+ PL_laststype = OP_STAT;
+ PL_laststatval = PerlLIO_stat(s, &PL_statcache);
+ if (PL_laststatval < 0 && PL_dowarn && strchr(s, '\n'))
warn(warn_nl, "stat");
- return laststatval;
+ return PL_laststatval;
}
}
I32
-my_lstat(ARGS)
-dARGS
+my_lstat(ARGSproto)
{
- dSP;
+ djSP;
SV *sv;
- if (op->op_flags & OPf_REF) {
- EXTEND(sp,1);
- if (cGVOP->op_gv == defgv) {
- if (laststype != OP_LSTAT)
+ STRLEN n_a;
+ if (PL_op->op_flags & OPf_REF) {
+ EXTEND(SP,1);
+ if (cGVOP->op_gv == PL_defgv) {
+ if (PL_laststype != OP_LSTAT)
croak("The stat preceding -l _ wasn't an lstat");
- return laststatval;
+ return PL_laststatval;
}
croak("You can't use -l on a filehandle");
}
- laststype = OP_LSTAT;
- statgv = Nullgv;
+ PL_laststype = OP_LSTAT;
+ PL_statgv = Nullgv;
sv = POPs;
PUTBACK;
- sv_setpv(statname,SvPV(sv, na));
+ sv_setpv(PL_statname,SvPV(sv, n_a));
#ifdef HAS_LSTAT
- laststatval = lstat(SvPV(sv, na),&statcache);
+ PL_laststatval = PerlLIO_lstat(SvPV(sv, n_a),&PL_statcache);
#else
- laststatval = Stat(SvPV(sv, na),&statcache);
+ PL_laststatval = PerlLIO_stat(SvPV(sv, n_a),&PL_statcache);
#endif
- if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
+ if (PL_laststatval < 0 && PL_dowarn && strchr(SvPV(sv, n_a), '\n'))
warn(warn_nl, "lstat");
- return laststatval;
+ return PL_laststatval;
}
bool
-do_aexec(really,mark,sp)
-SV *really;
-register SV **mark;
-register SV **sp;
+do_aexec(SV *really, register SV **mark, register SV **sp)
{
register char **a;
char *tmps;
+ STRLEN n_a;
if (sp > mark) {
- New(401,Argv, sp - mark + 1, char*);
- a = Argv;
+ dTHR;
+ New(401,PL_Argv, sp - mark + 1, char*);
+ a = PL_Argv;
while (++mark <= sp) {
if (*mark)
- *a++ = SvPVx(*mark, na);
+ *a++ = SvPVx(*mark, n_a);
else
*a++ = "";
}
*a = Nullch;
- if (*Argv[0] != '/') /* will execvp use PATH? */
+ if (*PL_Argv[0] != '/') /* will execvp use PATH? */
TAINT_ENV(); /* testing IFS here is overkill, probably */
- if (really && *(tmps = SvPV(really, na)))
- execvp(tmps,Argv);
+ if (really && *(tmps = SvPV(really, n_a)))
+ PerlProc_execvp(tmps,PL_Argv);
else
- execvp(Argv[0],Argv);
- if (dowarn)
- warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno));
+ PerlProc_execvp(PL_Argv[0],PL_Argv);
+ if (PL_dowarn)
+ warn("Can't exec \"%s\": %s", PL_Argv[0], Strerror(errno));
}
do_execfree();
return FALSE;
}
void
-do_execfree()
+do_execfree(void)
{
- if (Argv) {
- Safefree(Argv);
- Argv = Null(char **);
+ if (PL_Argv) {
+ Safefree(PL_Argv);
+ PL_Argv = Null(char **);
}
- if (Cmd) {
- Safefree(Cmd);
- Cmd = Nullch;
+ if (PL_Cmd) {
+ Safefree(PL_Cmd);
+ PL_Cmd = Nullch;
}
}
-#if !defined(OS2) && !defined(WIN32)
+#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP)
bool
-do_exec(cmd)
-char *cmd;
+do_exec(char *cmd)
{
register char **a;
register char *s;
@@ -958,9 +1035,9 @@ char *cmd;
/* save an extra exec if possible */
#ifdef CSH
- if (strnEQ(cmd,cshname,cshlen) && strnEQ(cmd+cshlen," -c",3)) {
+ if (strnEQ(cmd,PL_cshname,PL_cshlen) && strnEQ(cmd+PL_cshlen," -c",3)) {
strcpy(flags,"-c");
- s = cmd+cshlen+3;
+ s = cmd+PL_cshlen+3;
if (*s == 'f') {
s++;
strcat(flags,"f");
@@ -976,7 +1053,7 @@ char *cmd;
*--s = '\0';
if (s[-1] == '\'') {
*--s = '\0';
- execl(cshname,"csh", flags,ncmd,(char*)0);
+ PerlProc_execl(PL_cshname,"csh", flags,ncmd,(char*)0);
*s = '\'';
return FALSE;
}
@@ -1003,15 +1080,15 @@ char *cmd;
break;
}
doshell:
- execl(sh_path, "sh", "-c", cmd, (char*)0);
+ PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char*)0);
return FALSE;
}
}
- New(402,Argv, (s - cmd) / 2 + 2, char*);
- Cmd = savepvn(cmd, s-cmd);
- a = Argv;
- for (s = Cmd; *s;) {
+ New(402,PL_Argv, (s - cmd) / 2 + 2, char*);
+ PL_Cmd = savepvn(cmd, s-cmd);
+ a = PL_Argv;
+ for (s = PL_Cmd; *s;) {
while (*s && isSPACE(*s)) s++;
if (*s)
*(a++) = s;
@@ -1020,14 +1097,14 @@ char *cmd;
*s++ = '\0';
}
*a = Nullch;
- if (Argv[0]) {
- execvp(Argv[0],Argv);
+ if (PL_Argv[0]) {
+ PerlProc_execvp(PL_Argv[0],PL_Argv);
if (errno == ENOEXEC) { /* for system V NIH syndrome */
do_execfree();
goto doshell;
}
- if (dowarn)
- warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno));
+ if (PL_dowarn)
+ warn("Can't exec \"%s\": %s", PL_Argv[0], Strerror(errno));
}
do_execfree();
return FALSE;
@@ -1036,18 +1113,24 @@ char *cmd;
#endif /* OS2 || WIN32 */
I32
-apply(type,mark,sp)
-I32 type;
-register SV **mark;
-register SV **sp;
+apply(I32 type, register SV **mark, register SV **sp)
{
+ dTHR;
register I32 val;
register I32 val2;
register I32 tot = 0;
+ char *what;
char *s;
SV **oldmark = mark;
+ STRLEN n_a;
+
+#define APPLY_TAINT_PROPER() \
+ STMT_START { \
+ if (PL_tainted) { TAINT_PROPER(what); } \
+ } STMT_END
- if (tainting) {
+ /* This is a first heuristic; it doesn't catch tainting magic. */
+ if (PL_tainting) {
while (++mark <= sp) {
if (SvTAINTED(*mark)) {
TAINT;
@@ -1058,37 +1141,51 @@ register SV **sp;
}
switch (type) {
case OP_CHMOD:
- TAINT_PROPER("chmod");
+ what = "chmod";
+ APPLY_TAINT_PROPER();
if (++mark <= sp) {
- tot = sp - mark;
val = SvIVx(*mark);
+ APPLY_TAINT_PROPER();
+ tot = sp - mark;
while (++mark <= sp) {
- if (chmod(SvPVx(*mark, na),val))
+ char *name = SvPVx(*mark, n_a);
+ APPLY_TAINT_PROPER();
+ if (PerlLIO_chmod(name, val))
tot--;
}
}
break;
#ifdef HAS_CHOWN
case OP_CHOWN:
- TAINT_PROPER("chown");
+ what = "chown";
+ APPLY_TAINT_PROPER();
if (sp - mark > 2) {
val = SvIVx(*++mark);
val2 = SvIVx(*++mark);
+ APPLY_TAINT_PROPER();
tot = sp - mark;
while (++mark <= sp) {
- if (chown(SvPVx(*mark, na),val,val2))
+ char *name = SvPVx(*mark, n_a);
+ APPLY_TAINT_PROPER();
+ if (PerlLIO_chown(name, val, val2))
tot--;
}
}
break;
#endif
+/*
+XXX Should we make lchown() directly available from perl?
+For now, we'll let Configure test for HAS_LCHOWN, but do
+nothing in the core.
+ --AD 5/1998
+*/
#ifdef HAS_KILL
case OP_KILL:
- TAINT_PROPER("kill");
+ what = "kill";
+ APPLY_TAINT_PROPER();
if (mark == sp)
break;
- s = SvPVx(*++mark, na);
- tot = sp - mark;
+ s = SvPVx(*++mark, n_a);
if (isUPPER(*s)) {
if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
s += 3;
@@ -1097,6 +1194,8 @@ register SV **sp;
}
else
val = SvIVx(*mark);
+ APPLY_TAINT_PROPER();
+ tot = sp - mark;
#ifdef VMS
/* kill() doesn't do process groups (job trees?) under VMS */
if (val < 0) val = -val;
@@ -1109,6 +1208,7 @@ register SV **sp;
while (++mark <= sp) {
I32 proc = SvIVx(*mark);
register unsigned long int __vmssts;
+ APPLY_TAINT_PROPER();
if (!((__vmssts = sys$delprc(&proc,0)) & 1)) {
tot--;
switch (__vmssts) {
@@ -1131,36 +1231,41 @@ register SV **sp;
val = -val;
while (++mark <= sp) {
I32 proc = SvIVx(*mark);
+ APPLY_TAINT_PROPER();
#ifdef HAS_KILLPG
- if (killpg(proc,val)) /* BSD */
+ if (PerlProc_killpg(proc,val)) /* BSD */
#else
- if (kill(-proc,val)) /* SYSV */
+ if (PerlProc_kill(-proc,val)) /* SYSV */
#endif
tot--;
}
}
else {
while (++mark <= sp) {
- if (kill(SvIVx(*mark),val))
+ I32 proc = SvIVx(*mark);
+ APPLY_TAINT_PROPER();
+ if (PerlProc_kill(proc, val))
tot--;
}
}
break;
#endif
case OP_UNLINK:
- TAINT_PROPER("unlink");
+ what = "unlink";
+ APPLY_TAINT_PROPER();
tot = sp - mark;
while (++mark <= sp) {
- s = SvPVx(*mark, na);
- if (euid || unsafe) {
+ s = SvPVx(*mark, n_a);
+ APPLY_TAINT_PROPER();
+ if (PL_euid || PL_unsafe) {
if (UNLINK(s))
tot--;
}
else { /* don't let root wipe out directories without -U */
#ifdef HAS_LSTAT
- if (lstat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
+ if (PerlLIO_lstat(s,&PL_statbuf) < 0 || S_ISDIR(PL_statbuf.st_mode))
#else
- if (Stat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
+ if (PerlLIO_stat(s,&PL_statbuf) < 0 || S_ISDIR(PL_statbuf.st_mode))
#endif
tot--;
else {
@@ -1172,28 +1277,32 @@ register SV **sp;
break;
#ifdef HAS_UTIME
case OP_UTIME:
- TAINT_PROPER("utime");
+ what = "utime";
+ APPLY_TAINT_PROPER();
if (sp - mark > 2) {
#if defined(I_UTIME) || defined(VMS)
struct utimbuf utbuf;
#else
struct {
- long actime;
- long modtime;
+ Time_t actime;
+ Time_t modtime;
} utbuf;
#endif
Zero(&utbuf, sizeof utbuf, char);
#ifdef BIG_TIME
- utbuf.actime = (Time_t)SvNVx(*++mark); /* time accessed */
- utbuf.modtime = (Time_t)SvNVx(*++mark); /* time modified */
+ utbuf.actime = (Time_t)SvNVx(*++mark); /* time accessed */
+ utbuf.modtime = (Time_t)SvNVx(*++mark); /* time modified */
#else
- utbuf.actime = SvIVx(*++mark); /* time accessed */
- utbuf.modtime = SvIVx(*++mark); /* time modified */
+ utbuf.actime = (Time_t)SvIVx(*++mark); /* time accessed */
+ utbuf.modtime = (Time_t)SvIVx(*++mark); /* time modified */
#endif
+ APPLY_TAINT_PROPER();
tot = sp - mark;
while (++mark <= sp) {
- if (utime(SvPVx(*mark, na),&utbuf))
+ char *name = SvPVx(*mark, n_a);
+ APPLY_TAINT_PROPER();
+ if (PerlLIO_utime(name, &utbuf))
tot--;
}
}
@@ -1203,15 +1312,14 @@ register SV **sp;
#endif
}
return tot;
+
+#undef APPLY_TAINT_PROPER
}
/* Do the permissions allow some operation? Assumes statcache already set. */
#ifndef VMS /* VMS' cando is in vms.c */
I32
-cando(bit, effective, statbufp)
-I32 bit;
-I32 effective;
-register struct stat *statbufp;
+cando(I32 bit, I32 effective, register struct stat *statbufp)
{
#ifdef DOSISH
/* [Comments and code from Len Reed]
@@ -1238,7 +1346,7 @@ register struct stat *statbufp;
return (bit & statbufp->st_mode) ? TRUE : FALSE;
#else /* ! DOSISH */
- if ((effective ? euid : uid) == 0) { /* root is special */
+ if ((effective ? PL_euid : PL_uid) == 0) { /* root is special */
if (bit == S_IXUSR) {
if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
return TRUE;
@@ -1247,7 +1355,7 @@ register struct stat *statbufp;
return TRUE; /* root reads and writes anything */
return FALSE;
}
- if (statbufp->st_uid == (effective ? euid : uid) ) {
+ if (statbufp->st_uid == (effective ? PL_euid : PL_uid) ) {
if (statbufp->st_mode & bit)
return TRUE; /* ok as "user" */
}
@@ -1263,11 +1371,9 @@ register struct stat *statbufp;
#endif /* ! VMS */
I32
-ingroup(testgid,effective)
-I32 testgid;
-I32 effective;
+ingroup(I32 testgid, I32 effective)
{
- if (testgid == (effective ? egid : gid))
+ if (testgid == (effective ? PL_egid : PL_gid))
return TRUE;
#ifdef HAS_GETGROUPS
#ifndef NGROUPS
@@ -1289,11 +1395,9 @@ I32 effective;
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
I32
-do_ipcget(optype, mark, sp)
-I32 optype;
-SV **mark;
-SV **sp;
+do_ipcget(I32 optype, SV **mark, SV **sp)
{
+ dTHR;
key_t key;
I32 n, flags;
@@ -1324,18 +1428,13 @@ SV **sp;
}
I32
-do_ipcctl(optype, mark, sp)
-I32 optype;
-SV **mark;
-SV **sp;
+do_ipcctl(I32 optype, SV **mark, SV **sp)
{
+ dTHR;
SV *astr;
char *a;
I32 id, n, cmd, infosize, getinfo;
I32 ret = -1;
-#if defined(__linux__) || defined (__OpenBSD__) /* XXX Need metaconfig test */
- union semun unsemds;
-#endif
id = SvIVx(*++mark);
n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
@@ -1365,23 +1464,12 @@ SV **sp;
else if (cmd == GETALL || cmd == SETALL)
{
struct semid_ds semds;
-#if defined(__linux__) || defined (__OpenBSD__) /* XXX Need metaconfig test */
-/* linux & OpenBSD (and Solaris2?) uses :
- int semctl (int semid, int semnum, int cmd, union semun arg)
- union semun {
- int val;
- struct semid_ds *buf;
- ushort *array;
- };
-*/
- union semun semun;
+ union semun semun;
+
semun.buf = &semds;
- if (semctl(id, 0, IPC_STAT, semun) == -1)
-#else
- if (semctl(id, 0, IPC_STAT, &semds) == -1)
-#endif
- return -1;
getinfo = (cmd == GETALL);
+ if (Semctl(id, 0, IPC_STAT, semun) == -1)
+ return -1;
infosize = semds.sem_nsems * sizeof(short);
/* "short" is technically wrong but much more portable
than guessing about u_?short(_t)? */
@@ -1424,13 +1512,12 @@ SV **sp;
break;
#endif
#ifdef HAS_SEM
- case OP_SEMCTL:
-#if defined(__linux__) || defined (__OpenBSD__) /* XXX Need metaconfig test */
- unsemds.buf = (struct semid_ds *)a;
- ret = semctl(id, n, cmd, unsemds);
-#else
- ret = semctl(id, n, cmd, (struct semid_ds *)a);
-#endif
+ case OP_SEMCTL: {
+ union semun unsemds;
+
+ unsemds.buf = (struct semid_ds *)a;
+ ret = Semctl(id, n, cmd, unsemds);
+ }
break;
#endif
#ifdef HAS_SHM
@@ -1448,11 +1535,10 @@ SV **sp;
}
I32
-do_msgsnd(mark, sp)
-SV **mark;
-SV **sp;
+do_msgsnd(SV **mark, SV **sp)
{
#ifdef HAS_MSG
+ dTHR;
SV *mstr;
char *mbuf;
I32 id, msize, flags;
@@ -1472,11 +1558,10 @@ SV **sp;
}
I32
-do_msgrcv(mark, sp)
-SV **mark;
-SV **sp;
+do_msgrcv(SV **mark, SV **sp)
{
#ifdef HAS_MSG
+ dTHR;
SV *mstr;
char *mbuf;
long mtype;
@@ -1510,11 +1595,10 @@ SV **sp;
}
I32
-do_semop(mark, sp)
-SV **mark;
-SV **sp;
+do_semop(SV **mark, SV **sp)
{
#ifdef HAS_SEM
+ dTHR;
SV *opstr;
char *opbuf;
I32 id;
@@ -1536,12 +1620,10 @@ SV **sp;
}
I32
-do_shmio(optype, mark, sp)
-I32 optype;
-SV **mark;
-SV **sp;
+do_shmio(I32 optype, SV **mark, SV **sp)
{
#ifdef HAS_SHM
+ dTHR;
SV *mstr;
char *mbuf, *shm;
I32 id, mpos, msize;
@@ -1559,7 +1641,7 @@ SV **sp;
SETERRNO(EFAULT,SS$_ACCVIO); /* can't do as caller requested */
return -1;
}
- shm = (Shmat_t)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
+ shm = (char *)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
if (shm == (char *)-1) /* I hate System V IPC, I really do */
return -1;
if (optype == OP_SHMREAD) {
@@ -1588,3 +1670,4 @@ SV **sp;
}
#endif /* SYSV IPC */
+
diff --git a/gnu/usr.bin/perl/doop.c b/gnu/usr.bin/perl/doop.c
index 571a9aa70db..85d7b9eb9ce 100644
--- a/gnu/usr.bin/perl/doop.c
+++ b/gnu/usr.bin/perl/doop.c
@@ -1,6 +1,6 @@
/* doop.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -19,20 +19,20 @@
#endif
I32
-do_trans(sv,arg)
-SV *sv;
-OP *arg;
+do_trans(SV *sv, OP *arg)
{
+ dTHR;
register short *tbl;
register U8 *s;
register U8 *send;
register U8 *d;
register I32 ch;
register I32 matches = 0;
- register I32 squash = op->op_private & OPpTRANS_SQUASH;
+ register I32 squash = PL_op->op_private & OPpTRANS_SQUASH;
+ register U8 *p;
STRLEN len;
- if (SvREADONLY(sv))
+ if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_COUNTONLY))
croak(no_modify);
tbl = (short*)cPVOP->op_pv;
s = (U8*)SvPV(sv, len);
@@ -45,7 +45,7 @@ OP *arg;
if (!tbl || !s)
croak("panic: do_trans");
DEBUG_t( deb("2.TBL\n"));
- if (!op->op_private) {
+ if (!PL_op->op_private) {
while (s < send) {
if ((ch = tbl[*s]) >= 0) {
matches++;
@@ -53,17 +53,27 @@ OP *arg;
}
s++;
}
+ SvSETMAGIC(sv);
+ }
+ else if (PL_op->op_private & OPpTRANS_COUNTONLY) {
+ while (s < send) {
+ if (tbl[*s] >= 0)
+ matches++;
+ s++;
+ }
}
else {
d = s;
+ p = send;
while (s < send) {
if ((ch = tbl[*s]) >= 0) {
*d = ch;
- if (matches++ && squash) {
- if (d[-1] == *d)
+ matches++;
+ if (squash) {
+ if (p == d - 1 && *p == *d)
matches--;
else
- d++;
+ p = d++;
}
else
d++;
@@ -75,17 +85,13 @@ OP *arg;
matches += send - d; /* account for disappeared chars */
*d = '\0';
SvCUR_set(sv, d - (U8*)SvPVX(sv));
+ SvSETMAGIC(sv);
}
- SvSETMAGIC(sv);
return matches;
}
void
-do_join(sv,del,mark,sp)
-register SV *sv;
-SV *del;
-register SV **mark;
-register SV **sp;
+do_join(register SV *sv, SV *del, register SV **mark, register SV **sp)
{
SV **oldmark = mark;
register I32 items = sp - mark;
@@ -100,7 +106,7 @@ register SV **sp;
sv_upgrade(sv, SVt_PV);
if (SvLEN(sv) < len + items) { /* current length is way too short */
while (items-- > 0) {
- if (*mark) {
+ if (*mark && !SvGMAGICAL(*mark) && SvOK(*mark)) {
SvPV(*mark, tmplen);
len += tmplen;
}
@@ -141,10 +147,7 @@ register SV **sp;
}
void
-do_sprintf(sv,len,sarg)
-SV *sv;
-I32 len;
-SV **sarg;
+do_sprintf(SV *sv, I32 len, SV **sarg)
{
STRLEN patlen;
char *pat = SvPV(*sarg, patlen);
@@ -157,8 +160,7 @@ SV **sarg;
}
void
-do_vecset(sv)
-SV *sv;
+do_vecset(SV *sv)
{
SV *targ = LvTARG(sv);
register I32 offset;
@@ -209,9 +211,7 @@ SV *sv;
}
void
-do_chop(astr,sv)
-register SV *astr;
-register SV *sv;
+do_chop(register SV *astr, register SV *sv)
{
STRLEN len;
char *s;
@@ -223,7 +223,7 @@ register SV *sv;
max = AvFILL(av);
for (i = 0; i <= max; i++) {
sv = (SV*)av_fetch(av, i, FALSE);
- if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
+ if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
do_chop(astr, sv);
}
return;
@@ -253,14 +253,14 @@ register SV *sv;
}
I32
-do_chomp(sv)
-register SV *sv;
+do_chomp(register SV *sv)
{
+ dTHR;
register I32 count;
STRLEN len;
char *s;
- if (RsSNARF(rs))
+ if (RsSNARF(PL_rs))
return 0;
count = 0;
if (SvTYPE(sv) == SVt_PVAV) {
@@ -270,7 +270,7 @@ register SV *sv;
max = AvFILL(av);
for (i = 0; i <= max; i++) {
sv = (SV*)av_fetch(av, i, FALSE);
- if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
+ if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
count += do_chomp(sv);
}
return count;
@@ -289,7 +289,7 @@ register SV *sv;
s = SvPV_force(sv, len);
if (s && len) {
s += --len;
- if (RsPARA(rs)) {
+ if (RsPARA(PL_rs)) {
if (*s != '\n')
goto nope;
++count;
@@ -301,7 +301,7 @@ register SV *sv;
}
else {
STRLEN rslen;
- char *rsptr = SvPV(rs, rslen);
+ char *rsptr = SvPV(PL_rs, rslen);
if (rslen == 1) {
if (*s != *rsptr)
goto nope;
@@ -327,12 +327,9 @@ register SV *sv;
}
void
-do_vop(optype,sv,left,right)
-I32 optype;
-SV *sv;
-SV *left;
-SV *right;
+do_vop(I32 optype, SV *sv, SV *left, SV *right)
{
+ dTHR; /* just for taint */
#ifdef LIBERAL
register long *dl;
register long *ll;
@@ -355,7 +352,8 @@ SV *right;
len = leftlen < rightlen ? leftlen : rightlen;
lensave = len;
if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
- dc = SvPV_force(sv, na);
+ 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);
@@ -444,22 +442,23 @@ SV *right;
}
OP *
-do_kv(ARGS)
-dARGS
+do_kv(ARGSproto)
{
- dSP;
+ djSP;
HV *hv = (HV*)POPs;
+ HV *keys;
register HE *entry;
SV *tmpstr;
I32 gimme = GIMME_V;
- I32 dokeys = (op->op_type == OP_KEYS);
- I32 dovalues = (op->op_type == OP_VALUES);
-
- if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV)
+ 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)
dokeys = dovalues = TRUE;
if (!hv) {
- if (op->op_flags & OPf_MOD) { /* lvalue */
+ if (PL_op->op_flags & OPf_MOD) { /* lvalue */
dTARGET; /* make sure to clear its target here */
if (SvTYPE(TARG) == SVt_PVLV)
LvTARG(TARG) = Nullsv;
@@ -468,55 +467,58 @@ dARGS
RETURN;
}
- (void)hv_iterinit(hv); /* always reset iterator regardless */
+ keys = realhv ? hv : avhv_keys((AV*)hv);
+ (void)hv_iterinit(keys); /* always reset iterator regardless */
if (gimme == G_VOID)
RETURN;
if (gimme == G_SCALAR) {
- I32 i;
+ IV i;
dTARGET;
- if (op->op_flags & OPf_MOD) { /* lvalue */
+ if (PL_op->op_flags & OPf_MOD) { /* lvalue */
if (SvTYPE(TARG) < SVt_PVLV) {
sv_upgrade(TARG, SVt_PVLV);
sv_magic(TARG, Nullsv, 'k', Nullch, 0);
}
LvTYPE(TARG) = 'k';
- LvTARG(TARG) = (SV*)hv;
+ if (LvTARG(TARG) != (SV*)keys) {
+ if (LvTARG(TARG))
+ SvREFCNT_dec(LvTARG(TARG));
+ LvTARG(TARG) = SvREFCNT_inc(keys);
+ }
PUSHs(TARG);
RETURN;
}
- if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
- i = HvKEYS(hv);
+ if (! SvTIED_mg((SV*)keys, 'P'))
+ i = HvKEYS(keys);
else {
i = 0;
/*SUPPRESS 560*/
- while (entry = hv_iternext(hv)) {
- i++;
- }
+ while (hv_iternext(keys)) i++;
}
PUSHi( i );
RETURN;
}
- /* Guess how much room we need. hv_max may be a few too many. Oh well. */
- EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
+ EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues));
PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */
- while (entry = hv_iternext(hv)) {
+ while (entry = hv_iternext(keys)) {
SPAGAIN;
if (dokeys)
XPUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */
if (dovalues) {
tmpstr = sv_newmortal();
PUTBACK;
- sv_setsv(tmpstr,hv_iterval(hv,entry));
+ sv_setsv(tmpstr,realhv ?
+ hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry));
DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
(unsigned long)HeHASH(entry),
- HvMAX(hv)+1,
- (unsigned long)(HeHASH(entry) & HvMAX(hv))));
+ HvMAX(keys)+1,
+ (unsigned long)(HeHASH(entry) & HvMAX(keys))));
SPAGAIN;
XPUSHs(tmpstr);
}
diff --git a/gnu/usr.bin/perl/dosish.h b/gnu/usr.bin/perl/dosish.h
index 1b251ef3104..1d52d0c0cdd 100644
--- a/gnu/usr.bin/perl/dosish.h
+++ b/gnu/usr.bin/perl/dosish.h
@@ -7,9 +7,30 @@
#ifdef DJGPP
# define BIT_BUCKET "nul"
# define OP_BINARY O_BINARY
-void Perl_DJGPP_init();
-# define PERL_SYS_INIT(argcp, argvp) STMT_START { \
- Perl_DJGPP_init(); } STMT_END
+# define PERL_SYS_INIT(c,v) Perl_DJGPP_init(c,v)
+# include <signal.h>
+# define HAS_UTIME
+# define HAS_KILL
+ char *djgpp_pathexp (const char*);
+# if (DJGPP==2 && DJGPP_MINOR < 2)
+# define NO_LOCALECONV_MON_THOUSANDS_SEP
+# endif
+# ifdef USE_THREADS
+# define NEED_PTHREAD_INIT
+# define OLD_PTHREADS_API
+# define YIELD pthread_yield(NULL)
+# define DETACH(t) \
+ STMT_START { \
+ if (pthread_detach(&(t)->self)) { \
+ MUTEX_UNLOCK(&(t)->mutex); \
+ croak("panic: DETACH"); \
+ } \
+ } STMT_END
+# define pthread_mutexattr_default NULL
+# define pthread_condattr_default NULL
+# define pthread_addr_t any_t
+# define PTHREAD_CREATE_JOINABLE (&err)
+# endif
#else /* DJGPP */
# ifdef WIN32
# define PERL_SYS_INIT(c,v) Perl_win32_init(c,v)
@@ -20,15 +41,10 @@ void Perl_DJGPP_init();
# endif
#endif /* DJGPP */
-#define PERL_SYS_TERM()
+#define PERL_SYS_TERM() MALLOC_TERM
#define dXSUB_SYS
#define TMPPATH "plXXXXXX"
-#ifdef WIN32
-#define HAS_UTIME
-#define HAS_KILL
-#endif
-
/*
* 5.003_07 and earlier keyed on #ifdef MSDOS for determining if we were
* running on DOS, *and* if we had to cope with 16 bit memory addressing
@@ -54,6 +70,14 @@ void Perl_DJGPP_init();
*/
#undef USEMYBINMODE
+/* Stat_t:
+ * This symbol holds the type used to declare buffers for information
+ * returned by stat(). It's usually just struct stat. It may be necessary
+ * to include <sys/stat.h> and <sys/types.h> to get any typedef'ed
+ * information.
+ */
+#define Stat_t struct stat
+
/* USE_STAT_RDEV:
* This symbol is defined if this system has a stat structure declaring
* st_rdev
@@ -94,12 +118,18 @@ void Perl_DJGPP_init();
#ifndef WIN32
# define Stat(fname,bufptr) stat((fname),(bufptr))
#else
-# define Stat(fname,bufptr) win32_stat((fname),(bufptr))
-# define my_getenv(var) getenv(var)
+# define HAS_IOCTL
+# define HAS_UTIME
+# define HAS_KILL
+# define HAS_WAIT
+# define HAS_CHOWN
/*
- * the following are standard library calls (stdio in particular)
- * that is being redirected to the perl DLL. This is needed for
- * Dynaloading any modules that called stdio functions
+ * This provides a layer of functions and macros to ensure extensions will
+ * get to use the same RTL functions as the core.
*/
-# include <win32iop.h>
+# ifndef HASATTRIBUTE
+# ifndef PERL_OBJECT
+# include <win32iop.h>
+# endif
+# endif
#endif /* WIN32 */
diff --git a/gnu/usr.bin/perl/dump.c b/gnu/usr.bin/perl/dump.c
index 9bd51acc008..782c62d2b3a 100644
--- a/gnu/usr.bin/perl/dump.c
+++ b/gnu/usr.bin/perl/dump.c
@@ -1,6 +1,6 @@
/* dump.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -15,32 +15,27 @@
#include "EXTERN.h"
#include "perl.h"
-#ifndef DEBUGGING
-void
-dump_all()
-{
-}
-#else /* Rest of file is for DEBUGGING */
-
-#ifdef I_STDARG
+#ifndef PERL_OBJECT
static void dump(char *pat, ...);
-#else
-static void dump();
-#endif
+#endif /* PERL_OBJECT */
void
-dump_all()
+dump_all(void)
{
+#ifdef DEBUGGING
+ dTHR;
PerlIO_setlinebuf(Perl_debug_log);
- if (main_root)
- dump_op(main_root);
- dump_packsubs(defstash);
+ if (PL_main_root)
+ dump_op(PL_main_root);
+ dump_packsubs(PL_defstash);
+#endif /* DEBUGGING */
}
void
-dump_packsubs(stash)
-HV* stash;
+dump_packsubs(HV *stash)
{
+#ifdef DEBUGGING
+ dTHR;
I32 i;
HE *entry;
@@ -50,21 +45,24 @@ HV* stash;
for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
GV *gv = (GV*)HeVAL(entry);
HV *hv;
+ if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
+ continue;
if (GvCVu(gv))
dump_sub(gv);
if (GvFORM(gv))
dump_form(gv);
if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
- (hv = GvHV(gv)) && HvNAME(hv) && hv != defstash)
+ (hv = GvHV(gv)) && HvNAME(hv) && hv != PL_defstash)
dump_packsubs(hv); /* nested package */
}
}
+#endif /* DEBUGGING */
}
void
-dump_sub(gv)
-GV* gv;
+dump_sub(GV *gv)
{
+#ifdef DEBUGGING
SV *sv = sv_newmortal();
gv_fullname3(sv, gv, Nullch);
@@ -77,12 +75,13 @@ GV* gv;
dump_op(CvROOT(GvCV(gv)));
else
dump("<undef>\n");
+#endif /* DEBUGGING */
}
void
-dump_form(gv)
-GV* gv;
+dump_form(GV *gv)
{
+#ifdef DEBUGGING
SV *sv = sv_newmortal();
gv_fullname3(sv, gv, Nullch);
@@ -91,45 +90,48 @@ GV* gv;
dump_op(CvROOT(GvFORM(gv)));
else
dump("<undef>\n");
+#endif /* DEBUGGING */
}
void
-dump_eval()
+dump_eval(void)
{
- dump_op(eval_root);
+#ifdef DEBUGGING
+ dump_op(PL_eval_root);
+#endif /* DEBUGGING */
}
void
-dump_op(op)
-register OP *op;
+dump_op(OP *o)
{
+#ifdef DEBUGGING
dump("{\n");
- if (op->op_seq)
- PerlIO_printf(Perl_debug_log, "%-4d", op->op_seq);
+ if (o->op_seq)
+ PerlIO_printf(Perl_debug_log, "%-4d", o->op_seq);
else
PerlIO_printf(Perl_debug_log, " ");
- dump("TYPE = %s ===> ", op_name[op->op_type]);
- if (op->op_next) {
- if (op->op_seq)
- PerlIO_printf(Perl_debug_log, "%d\n", op->op_next->op_seq);
+ dump("TYPE = %s ===> ", op_name[o->op_type]);
+ if (o->op_next) {
+ if (o->op_seq)
+ PerlIO_printf(Perl_debug_log, "%d\n", o->op_next->op_seq);
else
- PerlIO_printf(Perl_debug_log, "(%d)\n", op->op_next->op_seq);
+ PerlIO_printf(Perl_debug_log, "(%d)\n", o->op_next->op_seq);
}
else
PerlIO_printf(Perl_debug_log, "DONE\n");
- dumplvl++;
- if (op->op_targ) {
- if (op->op_type == OP_NULL)
- dump(" (was %s)\n", op_name[op->op_targ]);
+ PL_dumplvl++;
+ if (o->op_targ) {
+ if (o->op_type == OP_NULL)
+ dump(" (was %s)\n", op_name[o->op_targ]);
else
- dump("TARG = %d\n", op->op_targ);
+ dump("TARG = %d\n", o->op_targ);
}
#ifdef DUMPADDR
- dump("ADDR = 0x%lx => 0x%lx\n",op, op->op_next);
+ dump("ADDR = 0x%lx => 0x%lx\n",o, o->op_next);
#endif
- if (op->op_flags) {
+ if (o->op_flags) {
SV *tmpsv = newSVpv("", 0);
- switch (op->op_flags & OPf_WANT) {
+ switch (o->op_flags & OPf_WANT) {
case OPf_WANT_VOID:
sv_catpv(tmpsv, ",VOID");
break;
@@ -143,58 +145,58 @@ register OP *op;
sv_catpv(tmpsv, ",UNKNOWN");
break;
}
- if (op->op_flags & OPf_KIDS)
+ if (o->op_flags & OPf_KIDS)
sv_catpv(tmpsv, ",KIDS");
- if (op->op_flags & OPf_PARENS)
+ if (o->op_flags & OPf_PARENS)
sv_catpv(tmpsv, ",PARENS");
- if (op->op_flags & OPf_STACKED)
+ if (o->op_flags & OPf_STACKED)
sv_catpv(tmpsv, ",STACKED");
- if (op->op_flags & OPf_REF)
+ if (o->op_flags & OPf_REF)
sv_catpv(tmpsv, ",REF");
- if (op->op_flags & OPf_MOD)
+ if (o->op_flags & OPf_MOD)
sv_catpv(tmpsv, ",MOD");
- if (op->op_flags & OPf_SPECIAL)
+ if (o->op_flags & OPf_SPECIAL)
sv_catpv(tmpsv, ",SPECIAL");
dump("FLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
SvREFCNT_dec(tmpsv);
}
- if (op->op_private) {
+ if (o->op_private) {
SV *tmpsv = newSVpv("", 0);
- if (op->op_type == OP_AASSIGN) {
- if (op->op_private & OPpASSIGN_COMMON)
+ if (o->op_type == OP_AASSIGN) {
+ if (o->op_private & OPpASSIGN_COMMON)
sv_catpv(tmpsv, ",COMMON");
}
- else if (op->op_type == OP_SASSIGN) {
- if (op->op_private & OPpASSIGN_BACKWARDS)
+ else if (o->op_type == OP_SASSIGN) {
+ if (o->op_private & OPpASSIGN_BACKWARDS)
sv_catpv(tmpsv, ",BACKWARDS");
}
- else if (op->op_type == OP_TRANS) {
- if (op->op_private & OPpTRANS_SQUASH)
+ else if (o->op_type == OP_TRANS) {
+ if (o->op_private & OPpTRANS_SQUASH)
sv_catpv(tmpsv, ",SQUASH");
- if (op->op_private & OPpTRANS_DELETE)
+ if (o->op_private & OPpTRANS_DELETE)
sv_catpv(tmpsv, ",DELETE");
- if (op->op_private & OPpTRANS_COMPLEMENT)
+ if (o->op_private & OPpTRANS_COMPLEMENT)
sv_catpv(tmpsv, ",COMPLEMENT");
}
- else if (op->op_type == OP_REPEAT) {
- if (op->op_private & OPpREPEAT_DOLIST)
+ else if (o->op_type == OP_REPEAT) {
+ if (o->op_private & OPpREPEAT_DOLIST)
sv_catpv(tmpsv, ",DOLIST");
}
- else if (op->op_type == OP_ENTERSUB ||
- op->op_type == OP_RV2SV ||
- op->op_type == OP_RV2AV ||
- op->op_type == OP_RV2HV ||
- op->op_type == OP_RV2GV ||
- op->op_type == OP_AELEM ||
- op->op_type == OP_HELEM )
+ else if (o->op_type == OP_ENTERSUB ||
+ o->op_type == OP_RV2SV ||
+ o->op_type == OP_RV2AV ||
+ o->op_type == OP_RV2HV ||
+ o->op_type == OP_RV2GV ||
+ o->op_type == OP_AELEM ||
+ o->op_type == OP_HELEM )
{
- if (op->op_type == OP_ENTERSUB) {
- if (op->op_private & OPpENTERSUB_AMPER)
+ if (o->op_type == OP_ENTERSUB) {
+ if (o->op_private & OPpENTERSUB_AMPER)
sv_catpv(tmpsv, ",AMPER");
- if (op->op_private & OPpENTERSUB_DB)
+ if (o->op_private & OPpENTERSUB_DB)
sv_catpv(tmpsv, ",DB");
}
- switch (op->op_private & OPpDEREF) {
+ switch (o->op_private & OPpDEREF) {
case OPpDEREF_SV:
sv_catpv(tmpsv, ",SV");
break;
@@ -205,84 +207,85 @@ register OP *op;
sv_catpv(tmpsv, ",HV");
break;
}
- if (op->op_type == OP_AELEM || op->op_type == OP_HELEM) {
- if (op->op_private & OPpLVAL_DEFER)
+ if (o->op_type == OP_AELEM || o->op_type == OP_HELEM) {
+ if (o->op_private & OPpLVAL_DEFER)
sv_catpv(tmpsv, ",LVAL_DEFER");
}
else {
- if (op->op_private & HINT_STRICT_REFS)
+ if (o->op_private & HINT_STRICT_REFS)
sv_catpv(tmpsv, ",STRICT_REFS");
}
}
- else if (op->op_type == OP_CONST) {
- if (op->op_private & OPpCONST_BARE)
+ else if (o->op_type == OP_CONST) {
+ if (o->op_private & OPpCONST_BARE)
sv_catpv(tmpsv, ",BARE");
}
- else if (op->op_type == OP_FLIP) {
- if (op->op_private & OPpFLIP_LINENUM)
+ else if (o->op_type == OP_FLIP) {
+ if (o->op_private & OPpFLIP_LINENUM)
sv_catpv(tmpsv, ",LINENUM");
}
- else if (op->op_type == OP_FLOP) {
- if (op->op_private & OPpFLIP_LINENUM)
+ else if (o->op_type == OP_FLOP) {
+ if (o->op_private & OPpFLIP_LINENUM)
sv_catpv(tmpsv, ",LINENUM");
}
- if (op->op_flags & OPf_MOD && op->op_private & OPpLVAL_INTRO)
+ if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
sv_catpv(tmpsv, ",INTRO");
if (SvCUR(tmpsv))
dump("PRIVATE = (%s)\n", SvPVX(tmpsv) + 1);
SvREFCNT_dec(tmpsv);
}
- switch (op->op_type) {
+ switch (o->op_type) {
case OP_GVSV:
case OP_GV:
- if (cGVOP->op_gv) {
+ if (cGVOPo->op_gv) {
+ STRLEN n_a;
SV *tmpsv = NEWSV(0,0);
ENTER;
SAVEFREESV(tmpsv);
- gv_fullname3(tmpsv, cGVOP->op_gv, Nullch);
- dump("GV = %s\n", SvPV(tmpsv, na));
+ gv_fullname3(tmpsv, cGVOPo->op_gv, Nullch);
+ dump("GV = %s\n", SvPV(tmpsv, n_a));
LEAVE;
}
else
dump("GV = NULL\n");
break;
case OP_CONST:
- dump("SV = %s\n", SvPEEK(cSVOP->op_sv));
+ dump("SV = %s\n", SvPEEK(cSVOPo->op_sv));
break;
case OP_NEXTSTATE:
case OP_DBSTATE:
- if (cCOP->cop_line)
- dump("LINE = %d\n",cCOP->cop_line);
- if (cCOP->cop_label)
- dump("LABEL = \"%s\"\n",cCOP->cop_label);
+ if (cCOPo->cop_line)
+ dump("LINE = %d\n",cCOPo->cop_line);
+ if (cCOPo->cop_label)
+ dump("LABEL = \"%s\"\n",cCOPo->cop_label);
break;
case OP_ENTERLOOP:
dump("REDO ===> ");
- if (cLOOP->op_redoop)
- PerlIO_printf(Perl_debug_log, "%d\n", cLOOP->op_redoop->op_seq);
+ if (cLOOPo->op_redoop)
+ PerlIO_printf(Perl_debug_log, "%d\n", cLOOPo->op_redoop->op_seq);
else
PerlIO_printf(Perl_debug_log, "DONE\n");
dump("NEXT ===> ");
- if (cLOOP->op_nextop)
- PerlIO_printf(Perl_debug_log, "%d\n", cLOOP->op_nextop->op_seq);
+ if (cLOOPo->op_nextop)
+ PerlIO_printf(Perl_debug_log, "%d\n", cLOOPo->op_nextop->op_seq);
else
PerlIO_printf(Perl_debug_log, "DONE\n");
dump("LAST ===> ");
- if (cLOOP->op_lastop)
- PerlIO_printf(Perl_debug_log, "%d\n", cLOOP->op_lastop->op_seq);
+ if (cLOOPo->op_lastop)
+ PerlIO_printf(Perl_debug_log, "%d\n", cLOOPo->op_lastop->op_seq);
else
PerlIO_printf(Perl_debug_log, "DONE\n");
break;
case OP_COND_EXPR:
dump("TRUE ===> ");
- if (cCONDOP->op_true)
- PerlIO_printf(Perl_debug_log, "%d\n", cCONDOP->op_true->op_seq);
+ if (cCONDOPo->op_true)
+ PerlIO_printf(Perl_debug_log, "%d\n", cCONDOPo->op_true->op_seq);
else
PerlIO_printf(Perl_debug_log, "DONE\n");
dump("FALSE ===> ");
- if (cCONDOP->op_false)
- PerlIO_printf(Perl_debug_log, "%d\n", cCONDOP->op_false->op_seq);
+ if (cCONDOPo->op_false)
+ PerlIO_printf(Perl_debug_log, "%d\n", cCONDOPo->op_false->op_seq);
else
PerlIO_printf(Perl_debug_log, "DONE\n");
break;
@@ -291,32 +294,34 @@ register OP *op;
case OP_OR:
case OP_AND:
dump("OTHER ===> ");
- if (cLOGOP->op_other)
- PerlIO_printf(Perl_debug_log, "%d\n", cLOGOP->op_other->op_seq);
+ if (cLOGOPo->op_other)
+ PerlIO_printf(Perl_debug_log, "%d\n", cLOGOPo->op_other->op_seq);
else
PerlIO_printf(Perl_debug_log, "DONE\n");
break;
case OP_PUSHRE:
case OP_MATCH:
+ case OP_QR:
case OP_SUBST:
- dump_pm((PMOP*)op);
+ dump_pm(cPMOPo);
break;
default:
break;
}
- if (op->op_flags & OPf_KIDS) {
+ if (o->op_flags & OPf_KIDS) {
OP *kid;
- for (kid = cUNOP->op_first; kid; kid = kid->op_sibling)
+ for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
dump_op(kid);
}
- dumplvl--;
+ PL_dumplvl--;
dump("}\n");
+#endif /* DEBUGGING */
}
void
-dump_gv(gv)
-register GV *gv;
+dump_gv(GV *gv)
{
+#ifdef DEBUGGING
SV *sv;
if (!gv) {
@@ -324,7 +329,7 @@ register GV *gv;
return;
}
sv = sv_newmortal();
- dumplvl++;
+ PL_dumplvl++;
PerlIO_printf(Perl_debug_log, "{\n");
gv_fullname3(sv, gv, Nullch);
dump("GV_NAME = %s", SvPVX(sv));
@@ -333,14 +338,15 @@ register GV *gv;
dump("-> %s", SvPVX(sv));
}
dump("\n");
- dumplvl--;
+ PL_dumplvl--;
dump("}\n");
+#endif /* DEBUGGING */
}
void
-dump_pm(pm)
-register PMOP *pm;
+dump_pm(PMOP *pm)
{
+#ifdef DEBUGGING
char ch;
if (!pm) {
@@ -348,7 +354,7 @@ register PMOP *pm;
return;
}
dump("{\n");
- dumplvl++;
+ PL_dumplvl++;
if (pm->op_pmflags & PMf_ONCE)
ch = '?';
else
@@ -363,18 +369,19 @@ register PMOP *pm;
dump("PMf_REPL = ");
dump_op(pm->op_pmreplroot);
}
- if (pm->op_pmshort) {
- dump("PMf_SHORT = %s\n",SvPEEK(pm->op_pmshort));
- }
- if (pm->op_pmflags) {
+ if (pm->op_pmflags || (pm->op_pmregexp && pm->op_pmregexp->check_substr)) {
SV *tmpsv = newSVpv("", 0);
- if (pm->op_pmflags & PMf_USED)
+ if (pm->op_pmdynflags & PMdf_USED)
sv_catpv(tmpsv, ",USED");
+ if (pm->op_pmdynflags & PMdf_TAINTED)
+ sv_catpv(tmpsv, ",TAINTED");
if (pm->op_pmflags & PMf_ONCE)
sv_catpv(tmpsv, ",ONCE");
- if (pm->op_pmflags & PMf_SCANFIRST)
+ if (pm->op_pmregexp && pm->op_pmregexp->check_substr
+ && !(pm->op_pmregexp->reganch & ROPT_NOSCAN))
sv_catpv(tmpsv, ",SCANFIRST");
- if (pm->op_pmflags & PMf_ALL)
+ if (pm->op_pmregexp && pm->op_pmregexp->check_substr
+ && pm->op_pmregexp->reganch & ROPT_CHECK_ALL)
sv_catpv(tmpsv, ",ALL");
if (pm->op_pmflags & PMf_SKIPWHITE)
sv_catpv(tmpsv, ",SKIPWHITE");
@@ -386,56 +393,31 @@ register PMOP *pm;
sv_catpv(tmpsv, ",GLOBAL");
if (pm->op_pmflags & PMf_CONTINUE)
sv_catpv(tmpsv, ",CONTINUE");
+ if (pm->op_pmflags & PMf_RETAINT)
+ sv_catpv(tmpsv, ",RETAINT");
if (pm->op_pmflags & PMf_EVAL)
sv_catpv(tmpsv, ",EVAL");
dump("PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
SvREFCNT_dec(tmpsv);
}
- dumplvl--;
+ PL_dumplvl--;
dump("}\n");
+#endif /* DEBUGGING */
}
-#if !defined(I_STDARG) && !defined(I_VARARGS)
-/* VARARGS1 */
-static void dump(arg1,arg2,arg3,arg4,arg5)
-char *arg1;
-long arg2, arg3, arg4, arg5;
-{
- I32 i;
-
- for (i = dumplvl*4; i; i--)
- (void)PerlIO_putc(Perl_debug_log,' ');
- PerlIO_printf(Perl_debug_log, arg1, arg2, arg3, arg4, arg5);
-}
-
-#else
-
-#ifdef I_STDARG
-static void
+STATIC void
dump(char *pat,...)
-#else
-/*VARARGS0*/
-static void
-dump(pat,va_alist)
- char *pat;
- va_dcl
-#endif
{
+#ifdef DEBUGGING
I32 i;
va_list args;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
- for (i = dumplvl*4; i; i--)
+ for (i = PL_dumplvl*4; i; i--)
(void)PerlIO_putc(Perl_debug_log,' ');
PerlIO_vprintf(Perl_debug_log,pat,args);
va_end(args);
+#endif /* DEBUGGING */
}
-#endif
-
-#endif
diff --git a/gnu/usr.bin/perl/eg/ADB b/gnu/usr.bin/perl/eg/ADB
index bbf07509ccf..9221449cd64 100644
--- a/gnu/usr.bin/perl/eg/ADB
+++ b/gnu/usr.bin/perl/eg/ADB
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $RCSfile: ADB,v $$Revision: 1.2 $$Date: 1997/11/30 07:49:35 $
+# $RCSfile: ADB,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:17 $
# This script is only useful when used in your crash directory.
diff --git a/gnu/usr.bin/perl/eg/cgi/RunMeFirst b/gnu/usr.bin/perl/eg/cgi/RunMeFirst
index c96d79eb628..018b11b7184 100644
--- a/gnu/usr.bin/perl/eg/cgi/RunMeFirst
+++ b/gnu/usr.bin/perl/eg/cgi/RunMeFirst
@@ -9,10 +9,17 @@ unless (-w $ww) {
}
# Decode the sample image.
-for $bin (qw(wilogo.gif)) {
- unless (open UU, "$bin.uu") { warn "Can't open $bin.uu: $!\n"; next }
+for $uu (<*.uu>) {
+ unless (open UU, "<$uu") { warn "Can't open $uu: $!\n"; next }
+ while (<UU>) {
+ chomp;
+ if (/^begin\s+\d+\s+(.+)$/) {
+ $bin = $1;
+ last;
+ }
+ }
unless (open BIN, "> $bin") { warn "Can't create $bin: $!\n"; next }
- $_ = <UU>;
+ binmode BIN;
while (<UU>) {
chomp;
last if /^end/;
@@ -24,6 +31,6 @@ for $bin (qw(wilogo.gif)) {
# Create symlinks from *.txt to *.cgi for documentation purposes.
foreach (<*.cgi>) {
- ($target = $_) =~ s/cgi$/txt/;
+ ($target = $_) =~ s/cgi$/txt/i;
symlink $_, $target unless -e $target;
}
diff --git a/gnu/usr.bin/perl/eg/cgi/file_upload.cgi b/gnu/usr.bin/perl/eg/cgi/file_upload.cgi
index 1f9eaec3321..f6bbbe0b741 100644
--- a/gnu/usr.bin/perl/eg/cgi/file_upload.cgi
+++ b/gnu/usr.bin/perl/eg/cgi/file_upload.cgi
@@ -1,7 +1,8 @@
-#!/usr/local/bin/perl
+#!/usr/local/bin/perl -w
+use lib '..';
use CGI qw(:standard);
-use CGI::Carp;
+use CGI::Carp qw/fatalsToBrowser/;
print header();
print start_html("File Upload Example");
@@ -32,9 +33,12 @@ print start_multipart_form(),
# Process the form if there is a file name entered
if ($file = param('filename')) {
$tmpfile=tmpFileName($file);
+ $mimetype = uploadInfo($file)->{'Content-Type'} || '';
print hr(),
h2($file),
- h3($tmpfile);
+ h3($tmpfile),
+ h4("MIME Type:",em($mimetype));
+
my($lines,$words,$characters,@words) = (0,0,0,0);
while (<$file>) {
$lines++;
@@ -52,6 +56,8 @@ if ($file = param('filename')) {
}
}
+# print cite("URL parameters: "),url_param();
+
print hr(),
a({href=>"../cgi_docs.html"},"CGI documentation"),
hr,
diff --git a/gnu/usr.bin/perl/eg/cgi/index.html b/gnu/usr.bin/perl/eg/cgi/index.html
index 9eafd5f1086..75e2d301399 100644
--- a/gnu/usr.bin/perl/eg/cgi/index.html
+++ b/gnu/usr.bin/perl/eg/cgi/index.html
@@ -23,6 +23,12 @@
<LI> <A HREF="save_state.txt">Look at its source code</A>
</UL>
+<H2> Server Push</H2>
+<ul>
+ <li><a href="nph-multipart.cgi">Try the script</a>
+ <li><a href="nph-multipart.txt">Look at its source code</a>
+</ul>
+
<H2> Read the coordinates from a clickable image map</H2>
<UL>
<LI> <A HREF="clickable_image.cgi">Try the script</A>
@@ -42,6 +48,7 @@
</UL>
<h2>Echo fatal script errors to the browser</h2>
+<em>This script deliberately generates a compile-time error.</em>
<ul>
<li><a href="crash.cgi">Try the script</a>
<li><a href="crash.txt">Look at its source code</a>
@@ -73,7 +80,7 @@
<li><a href="cookie.txt">Look at its source code</a>
</ul>
-<h2>Permanently customize the appearance of a page</h2>
+<h2>Permanently customize the appearance of a page with a cookie</h2>
<ul>
<li><a href="customize.cgi">Try the script</a>
<li><a href="customize.txt">Look at its source code</a>
@@ -100,12 +107,12 @@
<HR>
<MENU>
<LI> <A HREF="../cgi_docs.html">CGI.pm documentation</A>
- <LI> <A HREF="../CGI.pm.tar.gz">Download the CGI.pm distribution</A>
+ <LI> <A HREF="../../CGI.pm.tar.gz">Download the CGI.pm distribution</A>
</MENU>
<HR>
<ADDRESS>Lincoln D. Stein, lstein@genome.wi.mit.edu<br>
<a href="/">Whitehead Institute/MIT Center for Genome Research</a></ADDRESS>
<!-- hhmts start -->
-Last modified: Mon Dec 2 06:23:25 EST 1996
+Last modified: Tue May 19 22:16:43 EDT 1998
<!-- hhmts end -->
</BODY> </HTML>
diff --git a/gnu/usr.bin/perl/eg/cgi/monty.cgi b/gnu/usr.bin/perl/eg/cgi/monty.cgi
index b7c0f6a8f60..693c2586fc8 100644
--- a/gnu/usr.bin/perl/eg/cgi/monty.cgi
+++ b/gnu/usr.bin/perl/eg/cgi/monty.cgi
@@ -1,6 +1,7 @@
#!/usr/local/bin/perl
use CGI;
+use CGI::Carp qw/fatalsToBrowser/;
$query = new CGI;
@@ -15,7 +16,7 @@ print $query->end_html;
sub print_prompt {
my($query) = @_;
- print $query->start_multipart_form;
+ print $query->start_form;
print "<EM>What's your name?</EM><BR>";
print $query->textfield('name');
print $query->checkbox('Not my real name');
@@ -23,19 +24,19 @@ sub print_prompt {
print "<P><EM>Where can you find English Sparrows?</EM><BR>";
print $query->checkbox_group(
-name=>'Sparrow locations',
- -values=>[England,France,Spain,Asia,Hoboken],
+ -Values=>[England,France,Spain,Asia,Hoboken],
-linebreak=>'yes',
-defaults=>[England,Asia]);
print "<P><EM>How far can they fly?</EM><BR>",
$query->radio_group(
-name=>'how far',
- -values=>['10 ft','1 mile','10 miles','real far'],
+ -Values=>['10 ft','1 mile','10 miles','real far'],
-default=>'1 mile');
print "<P><EM>What's your favorite color?</EM> ";
print $query->popup_menu(-name=>'Color',
- -values=>['black','brown','red','yellow'],
+ -Values=>['black','brown','red','yellow'],
-default=>'red');
print $query->hidden('Reference','Monty Python and the Holy Grail');
@@ -43,7 +44,7 @@ sub print_prompt {
print "<P><EM>What have you got there?</EM><BR>";
print $query->scrolling_list(
-name=>'possessions',
- -values=>['A Coconut','A Grail','An Icon',
+ -Values=>['A Coconut','A Grail','An Icon',
'A Sword','A Ticket'],
-size=>5,
-multiple=>'true');
diff --git a/gnu/usr.bin/perl/eg/cgi/save_state.cgi b/gnu/usr.bin/perl/eg/cgi/save_state.cgi
index be79051bd64..85bacaf59a8 100644
--- a/gnu/usr.bin/perl/eg/cgi/save_state.cgi
+++ b/gnu/usr.bin/perl/eg/cgi/save_state.cgi
@@ -12,7 +12,7 @@ print "<H1>Save and Restore Example</H1>\n";
$query = &restore_parameters($query) if $query->param('action') eq 'RESTORE';
# Here's where we create the form
-print $query->startform;
+print $query->start_multipart_form;
print "Popup 1: ",$query->popup_menu('popup1',[qw{red green purple magenta orange chartreuse brown}]),"\n";
print "Popup 2: ",$query->popup_menu('popup2',[qw{lion tiger bear zebra potto wildebeest frog emu gazelle}]),"\n";
print "<P>";
diff --git a/gnu/usr.bin/perl/eg/cgi/wilogo.gif.uu b/gnu/usr.bin/perl/eg/cgi/wilogo.gif.uu
index a183bc02d5b..c5d10423b49 100644
--- a/gnu/usr.bin/perl/eg/cgi/wilogo.gif.uu
+++ b/gnu/usr.bin/perl/eg/cgi/wilogo.gif.uu
@@ -1,4 +1,4 @@
-begin 644 wilogo.gif
+begin 444 wilogo.gif
M1TE&.#=A7@!$`(```'X2F?___RP`````7@!$```"_D2.J<#MKF)ZU,A3,[OO
M(IUY']A%9"6AW$F)+#2]Y:BNLF6_\;WMH<?#I72^VP+D"@*)F&"O25KRDM&B
M[%C-7;4_J)*6'4ZE&O`W8"1OQ5UGPWRBIKDPM!MW9J]-[;LUKL;$5W.'YQ3(
@@ -10,5 +10,4 @@ M8LHLAS'D1Y,42UGY9O,F-T:X@@JEE@D1RW>/D@8R.DZ-+*E0CQ:9JJ5JU!SQ
MR&BU2D.;E*4'ER0TNY%G2A/Y.G[=VG%81+5K_UG$21<A6;=YP9'5B++O7:@7
M\]J5]]?DX7:)%<]5%=B/55>-GQW55;$8L\RW6J8-9>QM7<^A/SMZK!ESY$,+
(KPA.EJ```#L`
-`
end
diff --git a/gnu/usr.bin/perl/eg/changes b/gnu/usr.bin/perl/eg/changes
index 6396e2c3932..1d7ec598eee 100644
--- a/gnu/usr.bin/perl/eg/changes
+++ b/gnu/usr.bin/perl/eg/changes
@@ -1,6 +1,6 @@
#!/usr/bin/perl -P
-# $RCSfile: changes,v $$Revision: 1.2 $$Date: 1997/11/30 07:49:37 $
+# $RCSfile: changes,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:17 $
($dir, $days) = @ARGV;
$dir = '/' if $dir eq '';
diff --git a/gnu/usr.bin/perl/eg/dus b/gnu/usr.bin/perl/eg/dus
index 463290fe569..5ea7d0456be 100644
--- a/gnu/usr.bin/perl/eg/dus
+++ b/gnu/usr.bin/perl/eg/dus
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $RCSfile: dus,v $$Revision: 1.2 $$Date: 1997/11/30 07:49:37 $
+# $RCSfile: dus,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:17 $
# This script does a du -s on any directories in the current directory that
# are not mount points for another filesystem.
diff --git a/gnu/usr.bin/perl/eg/findcp b/gnu/usr.bin/perl/eg/findcp
index b7831c5cee5..827b7b6df81 100644
--- a/gnu/usr.bin/perl/eg/findcp
+++ b/gnu/usr.bin/perl/eg/findcp
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $RCSfile: findcp,v $$Revision: 1.2 $$Date: 1997/11/30 07:49:38 $
+# $RCSfile: findcp,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:18 $
# This is a wrapper around the find command that pretends find has a switch
# of the form -cp host:destination. It presumes your find implements -ls.
diff --git a/gnu/usr.bin/perl/eg/findtar b/gnu/usr.bin/perl/eg/findtar
index 48e3b22aece..e5c1be278f3 100644
--- a/gnu/usr.bin/perl/eg/findtar
+++ b/gnu/usr.bin/perl/eg/findtar
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $RCSfile: findtar,v $$Revision: 1.2 $$Date: 1997/11/30 07:49:39 $
+# $RCSfile: findtar,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:18 $
# findtar takes find-style arguments and spits out a tarfile on stdout.
# It won't work unless your find supports -ls and your tar the I flag.
diff --git a/gnu/usr.bin/perl/eg/g/gcp b/gnu/usr.bin/perl/eg/g/gcp
index 32dfe8eeccb..55c5b44f4b0 100644
--- a/gnu/usr.bin/perl/eg/g/gcp
+++ b/gnu/usr.bin/perl/eg/g/gcp
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $RCSfile: gcp,v $$Revision: 1.2 $$Date: 1997/11/30 07:54:45 $
+# $RCSfile: gcp,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:19 $
# Here is a script to do global rcps. See man page.
diff --git a/gnu/usr.bin/perl/eg/g/gcp.man b/gnu/usr.bin/perl/eg/g/gcp.man
index 391141f78b1..1640d5f53c8 100644
--- a/gnu/usr.bin/perl/eg/g/gcp.man
+++ b/gnu/usr.bin/perl/eg/g/gcp.man
@@ -1,4 +1,4 @@
-.\" $RCSfile: gcp.man,v $$Revision: 1.2 $$Date: 1997/11/30 07:54:47 $
+.\" $RCSfile: gcp.man,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:20 $
.TH GCP 1C "13 May 1988"
.SH NAME
gcp \- global file copy
diff --git a/gnu/usr.bin/perl/eg/g/ged b/gnu/usr.bin/perl/eg/g/ged
index 103790ea2e5..2846cba2478 100644
--- a/gnu/usr.bin/perl/eg/g/ged
+++ b/gnu/usr.bin/perl/eg/g/ged
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $RCSfile: ged,v $$Revision: 1.2 $$Date: 1997/11/30 07:54:47 $
+# $RCSfile: ged,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:20 $
# Does inplace edits on a set of files on a set of machines.
#
diff --git a/gnu/usr.bin/perl/eg/g/gsh b/gnu/usr.bin/perl/eg/g/gsh
index 251568a028d..d8866476a69 100644
--- a/gnu/usr.bin/perl/eg/g/gsh
+++ b/gnu/usr.bin/perl/eg/g/gsh
@@ -1,6 +1,6 @@
#! /usr/bin/perl
-# $RCSfile: gsh,v $$Revision: 1.2 $$Date: 1997/11/30 07:54:48 $
+# $RCSfile: gsh,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:20 $
# Do rsh globally--see man page
diff --git a/gnu/usr.bin/perl/eg/g/gsh.man b/gnu/usr.bin/perl/eg/g/gsh.man
index abcdbc67b20..98dece012e2 100644
--- a/gnu/usr.bin/perl/eg/g/gsh.man
+++ b/gnu/usr.bin/perl/eg/g/gsh.man
@@ -1,4 +1,4 @@
-.\" $RCSfile: gsh.man,v $$Revision: 1.2 $$Date: 1997/11/30 07:54:49 $
+.\" $RCSfile: gsh.man,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:20 $
.TH GSH 8 "13 May 1988"
.SH NAME
gsh \- global shell
diff --git a/gnu/usr.bin/perl/eg/muck.man b/gnu/usr.bin/perl/eg/muck.man
index 05c52853e53..8273cf73e59 100644
--- a/gnu/usr.bin/perl/eg/muck.man
+++ b/gnu/usr.bin/perl/eg/muck.man
@@ -1,4 +1,4 @@
-.\" $RCSfile: muck.man,v $$Revision: 1.2 $$Date: 1997/11/30 07:49:39 $
+.\" $RCSfile: muck.man,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:18 $
.TH MUCK 1 "10 Jan 1989"
.SH NAME
muck \- make usage checker
diff --git a/gnu/usr.bin/perl/eg/myrup b/gnu/usr.bin/perl/eg/myrup
index 61ca8b072ce..5db1213fab0 100644
--- a/gnu/usr.bin/perl/eg/myrup
+++ b/gnu/usr.bin/perl/eg/myrup
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $RCSfile: myrup,v $$Revision: 1.2 $$Date: 1997/11/30 07:49:40 $
+# $RCSfile: myrup,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:18 $
# This was a customization of ruptime requested by someone here who wanted
# to be able to find the least loaded machine easily. It uses the
diff --git a/gnu/usr.bin/perl/eg/nih b/gnu/usr.bin/perl/eg/nih
index 50bf016954d..70dda9e3202 100644
--- a/gnu/usr.bin/perl/eg/nih
+++ b/gnu/usr.bin/perl/eg/nih
@@ -1,7 +1,7 @@
eval 'exec /usr/bin/perl -Spi.bak $0 ${1+"$@"}'
if $running_under_some_shell;
-# $RCSfile: nih,v $$Revision: 1.2 $$Date: 1997/11/30 07:49:41 $
+# $RCSfile: nih,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:18 $
# This script makes #! scripts directly executable on machines that don't
# support #!. It edits in place any scripts mentioned on the command line.
diff --git a/gnu/usr.bin/perl/eg/relink b/gnu/usr.bin/perl/eg/relink
index c0d6de3afdd..50bf998fa91 100644
--- a/gnu/usr.bin/perl/eg/relink
+++ b/gnu/usr.bin/perl/eg/relink
@@ -2,11 +2,11 @@
'di';
'ig00';
#
-# $RCSfile: relink,v $$Revision: 1.2 $$Date: 1997/11/30 07:49:41 $
+# $RCSfile: relink,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:18 $
#
# $Log: relink,v $
-# Revision 1.2 1997/11/30 07:49:41 millert
-# perl 5.004_04
+# Revision 1.3 1999/04/29 22:51:18 millert
+# perl5.005_03 (stock)
#
($op = shift) || die "Usage: relink perlexpr [filenames]\n";
diff --git a/gnu/usr.bin/perl/eg/rename b/gnu/usr.bin/perl/eg/rename
index f041b08d870..8c8d48da4c8 100644
--- a/gnu/usr.bin/perl/eg/rename
+++ b/gnu/usr.bin/perl/eg/rename
@@ -2,11 +2,11 @@
'di';
'ig00';
#
-# $RCSfile: rename,v $$Revision: 1.2 $$Date: 1997/11/30 07:49:42 $
+# $RCSfile: rename,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:18 $
#
# $Log: rename,v $
-# Revision 1.2 1997/11/30 07:49:42 millert
-# perl 5.004_04
+# Revision 1.3 1999/04/29 22:51:18 millert
+# perl5.005_03 (stock)
#
($op = shift) || die "Usage: rename perlexpr [filenames]\n";
diff --git a/gnu/usr.bin/perl/eg/rmfrom b/gnu/usr.bin/perl/eg/rmfrom
index bfd5b835f0f..cb4c0e9cba0 100644
--- a/gnu/usr.bin/perl/eg/rmfrom
+++ b/gnu/usr.bin/perl/eg/rmfrom
@@ -1,6 +1,6 @@
#!/usr/bin/perl -n
-# $RCSfile: rmfrom,v $$Revision: 1.2 $$Date: 1997/11/30 07:49:42 $
+# $RCSfile: rmfrom,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:18 $
# A handy (but dangerous) script to put after a find ... -print.
diff --git a/gnu/usr.bin/perl/eg/scan/scan_df b/gnu/usr.bin/perl/eg/scan/scan_df
index 906277d6eac..0b5468fa387 100644
--- a/gnu/usr.bin/perl/eg/scan/scan_df
+++ b/gnu/usr.bin/perl/eg/scan/scan_df
@@ -1,6 +1,6 @@
#!/usr/bin/perl -P
-# $RCSfile: scan_df,v $$Revision: 1.2 $$Date: 1997/11/30 07:54:50 $
+# $RCSfile: scan_df,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:20 $
# This report points out filesystems that are in danger of overflowing.
diff --git a/gnu/usr.bin/perl/eg/scan/scan_last b/gnu/usr.bin/perl/eg/scan/scan_last
index 77d40da71d7..e22dcf392fa 100644
--- a/gnu/usr.bin/perl/eg/scan/scan_last
+++ b/gnu/usr.bin/perl/eg/scan/scan_last
@@ -1,6 +1,6 @@
#!/usr/bin/perl -P
-# $RCSfile: scan_last,v $$Revision: 1.2 $$Date: 1997/11/30 07:54:51 $
+# $RCSfile: scan_last,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:20 $
# This reports who was logged on at weird hours
diff --git a/gnu/usr.bin/perl/eg/scan/scan_messages b/gnu/usr.bin/perl/eg/scan/scan_messages
index 12f75adc8d5..cc101d76acb 100644
--- a/gnu/usr.bin/perl/eg/scan/scan_messages
+++ b/gnu/usr.bin/perl/eg/scan/scan_messages
@@ -1,6 +1,6 @@
#!/usr/bin/perl -P
-# $RCSfile: scan_messages,v $$Revision: 1.2 $$Date: 1997/11/30 07:54:51 $
+# $RCSfile: scan_messages,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:20 $
# This prints out extraordinary console messages. You'll need to customize.
diff --git a/gnu/usr.bin/perl/eg/scan/scan_passwd b/gnu/usr.bin/perl/eg/scan/scan_passwd
index 545d0cb6d89..58f9fcd69d4 100644
--- a/gnu/usr.bin/perl/eg/scan/scan_passwd
+++ b/gnu/usr.bin/perl/eg/scan/scan_passwd
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $RCSfile: scan_passwd,v $$Revision: 1.2 $$Date: 1997/11/30 07:54:52 $
+# $RCSfile: scan_passwd,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:21 $
# This scans passwd file for security holes.
diff --git a/gnu/usr.bin/perl/eg/scan/scan_ps b/gnu/usr.bin/perl/eg/scan/scan_ps
index 0c1f6f1ef63..793373605f6 100644
--- a/gnu/usr.bin/perl/eg/scan/scan_ps
+++ b/gnu/usr.bin/perl/eg/scan/scan_ps
@@ -1,6 +1,6 @@
#!/usr/bin/perl -P
-# $RCSfile: scan_ps,v $$Revision: 1.2 $$Date: 1997/11/30 07:54:52 $
+# $RCSfile: scan_ps,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:21 $
# This looks for looping processes.
diff --git a/gnu/usr.bin/perl/eg/scan/scan_sudo b/gnu/usr.bin/perl/eg/scan/scan_sudo
index 9c23731b50c..37648e75652 100644
--- a/gnu/usr.bin/perl/eg/scan/scan_sudo
+++ b/gnu/usr.bin/perl/eg/scan/scan_sudo
@@ -1,6 +1,6 @@
#!/usr/bin/perl -P
-# $RCSfile: scan_sudo,v $$Revision: 1.2 $$Date: 1997/11/30 07:54:53 $
+# $RCSfile: scan_sudo,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:21 $
# Analyze the sudo log.
diff --git a/gnu/usr.bin/perl/eg/scan/scan_suid b/gnu/usr.bin/perl/eg/scan/scan_suid
index 8f31bed736f..f6555eb55b6 100644
--- a/gnu/usr.bin/perl/eg/scan/scan_suid
+++ b/gnu/usr.bin/perl/eg/scan/scan_suid
@@ -1,6 +1,6 @@
#!/usr/bin/perl -P
-# $RCSfile: scan_suid,v $$Revision: 1.2 $$Date: 1997/11/30 07:54:54 $
+# $RCSfile: scan_suid,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:21 $
# Look for new setuid root files.
diff --git a/gnu/usr.bin/perl/eg/scan/scanner b/gnu/usr.bin/perl/eg/scan/scanner
index 25db7904dcd..258e07ab506 100644
--- a/gnu/usr.bin/perl/eg/scan/scanner
+++ b/gnu/usr.bin/perl/eg/scan/scanner
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $RCSfile: scanner,v $$Revision: 1.2 $$Date: 1997/11/30 07:54:55 $
+# $RCSfile: scanner,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:21 $
# This runs all the scan_* routines on all the machines in /etc/ghosts.
# We run this every morning at about 6 am:
diff --git a/gnu/usr.bin/perl/eg/shmkill b/gnu/usr.bin/perl/eg/shmkill
index 958f9fca995..d04ebb5b049 100644
--- a/gnu/usr.bin/perl/eg/shmkill
+++ b/gnu/usr.bin/perl/eg/shmkill
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $RCSfile: shmkill,v $$Revision: 1.2 $$Date: 1997/11/30 07:49:43 $
+# $RCSfile: shmkill,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:18 $
# A script to call from crontab periodically when people are leaving shared
# memory sitting around unattached.
diff --git a/gnu/usr.bin/perl/eg/van/empty b/gnu/usr.bin/perl/eg/van/empty
index 37a8063979c..9df6170e3d6 100644
--- a/gnu/usr.bin/perl/eg/van/empty
+++ b/gnu/usr.bin/perl/eg/van/empty
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $RCSfile: empty,v $$Revision: 1.2 $$Date: 1997/11/30 07:54:59 $
+# $RCSfile: empty,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:21 $
# This script empties a trashcan.
diff --git a/gnu/usr.bin/perl/eg/van/unvanish b/gnu/usr.bin/perl/eg/van/unvanish
index fe277c16683..08268bff17e 100644
--- a/gnu/usr.bin/perl/eg/van/unvanish
+++ b/gnu/usr.bin/perl/eg/van/unvanish
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $RCSfile: unvanish,v $$Revision: 1.2 $$Date: 1997/11/30 07:54:59 $
+# $RCSfile: unvanish,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:22 $
sub it {
if ($olddir ne '.') {
diff --git a/gnu/usr.bin/perl/eg/van/vanexp b/gnu/usr.bin/perl/eg/van/vanexp
index b5bb5095477..44f60d648bf 100644
--- a/gnu/usr.bin/perl/eg/van/vanexp
+++ b/gnu/usr.bin/perl/eg/van/vanexp
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $RCSfile: vanexp,v $$Revision: 1.2 $$Date: 1997/11/30 07:55:00 $
+# $RCSfile: vanexp,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:22 $
# This is for running from a find at night to expire old .deleteds
diff --git a/gnu/usr.bin/perl/eg/van/vanish b/gnu/usr.bin/perl/eg/van/vanish
index 2f391d6c07e..3bdf02e1c13 100644
--- a/gnu/usr.bin/perl/eg/van/vanish
+++ b/gnu/usr.bin/perl/eg/van/vanish
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $RCSfile: vanish,v $$Revision: 1.2 $$Date: 1997/11/30 07:55:00 $
+# $RCSfile: vanish,v $$Revision: 1.3 $$Date: 1999/04/29 22:51:22 $
sub it {
if ($olddir ne '.') {
diff --git a/gnu/usr.bin/perl/eg/wrapsuid b/gnu/usr.bin/perl/eg/wrapsuid
index 5ee7f6e614f..bf47187244b 100644
--- a/gnu/usr.bin/perl/eg/wrapsuid
+++ b/gnu/usr.bin/perl/eg/wrapsuid
@@ -2,11 +2,11 @@
'di';
'ig00';
#
-# $Header: /home/cvs/src/gnu/usr.bin/perl/eg/Attic/wrapsuid,v 1.2 1997/11/30 07:49:44 millert Exp $
+# $Header: /home/cvs/src/gnu/usr.bin/perl/eg/Attic/wrapsuid,v 1.3 1999/04/29 22:51:18 millert Exp $
#
# $Log: wrapsuid,v $
-# Revision 1.2 1997/11/30 07:49:44 millert
-# perl 5.004_04
+# Revision 1.3 1999/04/29 22:51:18 millert
+# perl5.005_03 (stock)
#
# Revision 1.1 90/08/11 13:51:29 lwall
# Initial revision
diff --git a/gnu/usr.bin/perl/emacs/cperl-mode.el b/gnu/usr.bin/perl/emacs/cperl-mode.el
index b00d77a1156..3d7be098c08 100644
--- a/gnu/usr.bin/perl/emacs/cperl-mode.el
+++ b/gnu/usr.bin/perl/emacs/cperl-mode.el
@@ -1,14 +1,27 @@
-;;; This code started from the following message of long time ago (IZ):
+;;; cperl-mode.el --- Perl code editing commands for Emacs
+
+;;;; The following message is relative to GNU version of the module:
+
+;; Copyright (C) 1985, 86, 87, 91, 92, 93, 94, 95, 96, 1997
+;; Free Software Foundation, Inc.
+
+;; Author: Ilya Zakharevich and Bob Olson
+;; Maintainer: Ilya Zakharevich <ilya@math.ohio-state.edu>
+;; Keywords: languages, Perl
+
+;; This file is part of GNU Emacs.
+
+;;; This code started from the following message of long time ago
+;;; (IZ), but Bob does not maintain this mode any more:
;;; From: olson@mcs.anl.gov (Bob Olson)
;;; Newsgroups: comp.lang.perl
;;; Subject: cperl-mode: Another perl mode for Gnuemacs
;;; Date: 14 Aug 91 15:20:01 GMT
-;; Perl code editing commands for Emacs
-;; Copyright (C) 1985-1996 Bob Olson, Ilya Zakharevich
+;; Copyright (C) Ilya Zakharevich and Bob Olson
-;; This file is not (yet) part of GNU Emacs. It may be distributed
+;; This file may be distributed
;; either under the same terms as GNU Emacs, or under the same terms
;; as Perl. You should have received a copy of Perl Artistic license
;; along with the Perl distribution.
@@ -28,13 +41,15 @@
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-
;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu
;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de
-;; $Id: cperl-mode.el,v 1.39 1997/10/14 08:28:00 ilya Exp ilya $
+;;; Commentary:
+
+;; $Id: cperl-mode.el 4.5 1998/07/28 08:55:41 vera Exp vera $
-;;; To use this mode put the following into your .emacs file:
+;;; Before (future?) RMS Emacs 20.3: To use this mode put the following into
+;;; your .emacs file:
;; (autoload 'perl-mode "cperl-mode" "alternate mode for editing Perl programs" t)
@@ -43,14 +58,15 @@
;; (setq cperl-hairy t)
-;;; in your .emacs file. (Emacs rulers do not consider it politically
+;;; in your .emacs file. (Emacs rulers do not consider it politically
;;; correct to make whistles enabled by default.)
-;;; DO NOT FORGET to read micro-docs. (available from `Perl' menu). <<<<<<
+;;; DO NOT FORGET to read micro-docs (available from `Perl' menu) <<<<<<
;;; or as help on variables `cperl-tips', `cperl-problems', <<<<<<
-;;; `cperl-non-problems', `cperl-praise'. <<<<<<
+;;; `cperl-non-problems', `cperl-praise', `cperl-speed'. <<<<<<
-;;; Additional useful commands to put into your .emacs file:
+;;; Additional useful commands to put into your .emacs file (before
+;;; (future?) RMS Emacs 20.3):
;; (setq auto-mode-alist
;; (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode)) auto-mode-alist ))
@@ -59,26 +75,25 @@
;;; The mode information (on C-h m) provides some customization help.
;;; If you use font-lock feature of this mode, it is advisable to use
-;;; either lazy-lock-mode or fast-lock-mode (available on ELisp
-;;; archive in files lazy-lock.el and fast-lock.el). I prefer lazy-lock.
+;;; either lazy-lock-mode or fast-lock-mode. I prefer lazy-lock.
;;; Faces used now: three faces for first-class and second-class keywords
;;; and control flow words, one for each: comments, string, labels,
;;; functions definitions and packages, arrays, hashes, and variable
-;;; definitions. If you do not see all these faces, your font-lock does
-;;; not define them, so you need to define them manually. Maybe you have
-;;; an obsolete font-lock from 19.28 or earlier. Upgrade.
+;;; definitions. If you do not see all these faces, your font-lock does
+;;; not define them, so you need to define them manually. Maybe you have
+;;; an obsolete font-lock from 19.28 or earlier. Upgrade.
;;; If you have a grayscale monitor, and do not have the variable
;;; font-lock-display-type bound to 'grayscale, insert
;;; (setq font-lock-display-type 'grayscale)
-;;; into your .emacs file.
+;;; into your .emacs file (this is relevant before RMS Emacs 20).
-;;;; This mode supports font-lock, imenu and mode-compile. In the
+;;;; This mode supports font-lock, imenu and mode-compile. In the
;;;; hairy version font-lock is on, but you should activate imenu
-;;;; yourself (note that mode-compile is not standard yet). Well, you
+;;;; yourself (note that mode-compile is not standard yet). Well, you
;;;; can use imenu from keyboard anyway (M-x imenu), but it is better
;;;; to bind it like that:
@@ -463,9 +478,425 @@
;;; `cperl-find-pods-heres' somehow maybe called when string-face is undefined
;;; - put a stupid workaround for 20.1
-(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
+;;;; After 1.39:
+;;; Could indent here-docs for comments;
+;;; These problems fixed:
+;;;;;;; s/foo/\\bar/ - backslash at start of subst (made into two chunk)
+;;;;;;; s[foo] <blah>e - "e" part delimited by "different" <> (will match)
+;;; Matching brackets honor prefices, may expand abbreviations;
+;;; When expanding abbrevs, will remove last char only after
+;;; self-inserted whitespace;
+;;; More convenient "Refress hard constructs" in menu;
+;;; `cperl-add-tags-recurse', `cperl-add-tags-recurse-noxs'
+;;; added (for -batch mode);
+;;; Better handling of errors when scanning for Perl constructs;
+;;;;;;; Possible "problem" with class hierarchy in Perl distribution
+;;;;;;; directory: ./ext duplicates ./lib;
+;;; Write relative paths for generated TAGS;
+
+;;;; After 1.40:
+;;; s /// may be separated by "\n\f" too;
+;;; `s #blah' recognized as a comment;
+;;; Would highlight s/abc//s wrong;
+;;; Debugging code in `cperl-electric-keywords' was leaking a message;
+
+;;;; After 1.41:
+;;; RMS changes for (future?) 20.3 merged
+
+;;;; 2.0.1.0: RMS mode (has 3 misprints)
+
+;;;; After 2.0:
+;;; RMS whitespace changes for (future?) 20.3 merged
+
+;;;; After 2.1:
+;;; History updated
+
+;;;; After 2.2:
+;;; Merge `c-style-alist' since `c-mode' is no more. (Somebody who
+;;; uses the styles should check that they work OK!)
+;;; All the variable warnings go away, some undef functions too.
+
+;;;; After 2.3:
+;;; Added `cperl-perldoc' (thanks to Anthony Foiani <afoiani@uswest.com>)
+;;; Added `cperl-pod-to-manpage' (thanks to Nick Roberts <Nick.Roberts@src.bae.co.uk>)
+;;; All the function warnings go away.
+
+;;;; After 2.4:
+;;; `Perl doc', `Regexp' submenus created (latter to allow short displays).
+;;; `cperl-clobber-lisp-bindings' added.
+;;; $a->y() is not y///.
+;;; `cperl-after-block-p' was missing a `save-excursion' => wrong results.
+;;; `cperl-val' was defined too late.
+;;; `cperl-init-faces' was failing.
+;;; Init faces when loading `ps-print'.
+
+;;;; After 2.4:
+;;; `cperl-toggle-autohelp' implemented.
+;;; `while SPACE LESS' was buggy.
+;;; `-text' in `[-text => 1]' was not highlighted.
+;;; `cperl-after-block-p' was FALSE after `sub f {}'.
+
+;;;; After 2.5:
+;;; `foreachmy', `formy' expanded too.
+;;; Expand `=pod-directive'.
+;;; `cperl-linefeed' behaves reasonable in POD-directive lines.
+;;; `cperl-electric-keyword' prints a message, governed by
+;;; `cperl-message-electric-keyword'.
+
+;;;; After 2.6:
+;;; Typing `}' was not checking for being block or not.
+;;; Beautifying levels in RE: Did not know about lookbehind;
+;;; finding *which* level was not intuitive;
+;;; `cperl-beautify-levels' added.
+;;; Allow here-docs contain `=head1' and friends (at least for keywords).
+
+;;;; After 2.7:
+;;; Fix for broken `font-lock-unfontify-region-function'. Should
+;;; preserve `syntax-table' properties even with `lazy-lock'.
+
+;;;; After 2.8:
+;;; Some more compile time warnings crept in.
+;;; `cperl-indent-region-fix-else' implemented.
+;;; `cperl-fix-line-spacing' implemented.
+;;; `cperl-invert-if-unless' implemented (C-c C-t and in Menu).
+;;; Upgraded hints to mention 20.2's goods/bads.
+;;; Started to use `cperl-extra-newline-before-brace-multiline',
+;;; `cperl-break-one-line-blocks-when-indent',
+;;; `cperl-fix-hanging-brace-when-indent', `cperl-merge-trailing-else'.
+
+;;;; After 2.9:
+;;; Workaround for another `font-lock's `syntax-table' text-property bug.
+;;; `zerop' could be applied to nil.
+;;; At last, may work with `font-lock' without setting `cperl-font-lock'.
+;;; (We expect that starting from 19.33, `font-lock' supports keywords
+;;; being a function - what is a correct version?)
+;;; Rename `cperl-indent-region-fix-else' to
+;;; `cperl-indent-region-fix-constructs'.
+;;; `cperl-fix-line-spacing' could be triggered inside strings, would not
+;;; know what to do with BLOCKs of map/printf/etc.
+;;; `cperl-merge-trailing-else' and `cperl-fix-line-spacing' handle
+;;; `continue' too.
+;;; Indentation after {BLOCK} knows about map/printf/etc.
+;;; Finally: treat after-comma lines as continuation lines.
+
+;;;; After 2.10:
+;;; `continue' made electric.
+;;; Electric `do' inserts `do/while'.
+;;; Some extra compile-time warnings crept in.
+;;; `font-lock' of 19.33 could not handle font-lock-keywords being a function
+;;; returning a symbol.
+
+;;;; After 2.11:
+;;; Changes to make syntaxification to be autoredone via `font-lock'.
+;;; Switched on by `cperl-syntaxify-by-font-lock', off by default so far.
+
+;;;; After 2.12:
+;;; Remove some commented out chunks.
+;;; Styles are slightly updated (a lot of work is needed, especially
+;;; with new `cperl-fix-line-spacing').
+
+;;;; After 2.13:
+;;; Old value of style is memorized when choosing a new style, may be
+;;; restored from the same menu.
+;;; Mode-documentation added to micro-docs.
+;;; `cperl-praise' updated.
+;;; `cperl-toggle-construct-fix' added on C-c C-w and menu.
+;;; `auto-fill-mode' added on C-c C-f and menu.
+;;; `PerlStyle' style added.
+;;; Message for termination of scan corrected.
+
+;;;; After 2.14:
+
+;;; Did not work with -q
+
+;;;; After 2.15:
+
+;;; `cperl-speed' hints added.
+;;; Minor style fixes.
+
+;;;; After 2.15:
+;;; Make backspace electric after expansion of `else/continue' too.
+
+;;;; After 2.16:
+;;; Starting to merge changes to RMS emacs version.
+
+;;;; After 2.17:
+;;; Merged custom stuff and darn `font-lock-constant-face'.
+
+;;;; After 2.18:
+;;; Bumped the version to 3.1
+
+;;;; After 3.1:
+;;; Fixed customization to honor cperl-hairy.
+;;; Created customization groups. Sent to RMS to include into 2.3.
+
+;;;; After 3.2:
+;;; Interaction of `font-lock-hot-pass' and `cperl-syntaxify-by-font-lock'.
+;;; (`cperl-after-block-and-statement-beg'):
+;;; (`cperl-after-block-p'):
+;;; (`cperl-after-expr-p'): It is BLOCK if we reach lim when backup sexp.
+;;; (`cperl-indent-region'): Make a marker for END - text added/removed.
+;;; (`cperl-style-alist', `cperl-styles-entries')
+;;; Include `cperl-merge-trailing-else' where the value is clear.
+
+;;;; After 3.3:
+;;; (`cperl-tips'):
+;;; (`cperl-problems'): Improvements to docs.
+
+;;;; After 3.4:
+;;; (`cperl-mode'): Make lazy syntaxification possible.
+;;; (`cperl-find-pods-heres'): Safe a position in buffer where it is safe to
+;;; restart syntaxification.
+;;; (`cperl-syntaxify-by-font-lock'): Set to t, should be safe now.
+
+;;;; After 3.5:
+;;; (`cperl-syntaxify-by-font-lock'): Better default, customizes to
+;;; `message' too.
+
+;;;; After 3.6:
+;;; (`cperl-find-pods-heres'): changed so that -d ?foo? is a RE.
+;;; (`cperl-array-face'): changed name from `font-lock-emphasized-face'.
+;;; (`cperl-hash-face'): changed name from `font-lock-other-emphasized-face'.
+;;; Use `defface' to define these two extra faces.
+
+;;;; After 3.7:
+;;; Can use linear algorithm for indentation if Emacs supports it:
+;;; indenting DB::DB (800+ lines) improved from 69 sec to 11 sec
+;;; (73 vs 15 with imenu).
+;;; (`cperl-emacs-can-parse'): New state.
+;;; (`cperl-indent-line'): Corrected to use global state.
+;;; (`cperl-calculate-indent'): Likewise.
+;;; (`cperl-fix-line-spacing'): Likewise (not used yet).
+
+;;;; After 3.8:
+;;; (`cperl-choose-color'): Converted to a function (to be compilable in text-mode).
+
+;;;; After 3.9:
+;;; (`cperl-dark-background '): Disable without window-system.
+
+;;;; After 3.10:
+;;; Do `defface' only if window-system.
+
+;;;; After 3.11:
+;;; (`cperl-fix-line-spacing'): sped up to bail out early.
+;;; (`cperl-indent-region'): Disable hooks during the call (how to call them later?).
+
+;;; Now indents 820-line-long function in 6.5 sec (including syntaxification) the first time
+;;; (when buffer has few properties), 7.1 sec the second time.
+
+;;;Function Name Call Count Elapsed Time Average Time
+;;;========================================= ========== ============ ============
+;;;cperl-indent-exp 1 10.039999999 10.039999999
+;;;cperl-indent-region 1 10.0 10.0
+;;;cperl-indent-line 821 6.2100000000 0.0075639464
+;;;cperl-calculate-indent 821 5.0199999999 0.0061144945
+;;;cperl-backward-to-noncomment 2856 2.0500000000 0.0007177871
+;;;cperl-fontify-syntaxically 2 1.78 0.8900000000
+;;;cperl-find-pods-heres 2 1.78 0.8900000000
+;;;cperl-update-syntaxification 1 1.78 1.78
+;;;cperl-fix-line-spacing 769 1.4800000000 0.0019245773
+;;;cperl-after-block-and-statement-beg 163 1.4100000000 0.0086503067
+;;;cperl-block-p 775 1.1800000000 0.0015225806
+;;;cperl-to-comment-or-eol 3652 1.1200000000 0.0003066812
+;;;cperl-after-block-p 165 1.0500000000 0.0063636363
+;;;cperl-commentify 141 0.22 0.0015602836
+;;;cperl-get-state 813 0.16 0.0001968019
+;;;cperl-backward-to-start-of-continued-exp 26 0.12 0.0046153846
+;;;cperl-delay-update-hook 2107 0.0899999999 4.271...e-05
+;;;cperl-protect-defun-start 141 0.0700000000 0.0004964539
+;;;cperl-after-label 407 0.0599999999 0.0001474201
+;;;cperl-forward-re 139 0.0299999999 0.0002158273
+;;;cperl-comment-indent 26 0.0299999999 0.0011538461
+;;;cperl-use-region-p 8 0.0 0.0
+;;;cperl-lazy-hook 15 0.0 0.0
+;;;cperl-after-expr-p 8 0.0 0.0
+;;;cperl-font-lock-unfontify-region-function 1 0.0 0.0
+
+;;;Function Name Call Count Elapsed Time Average Time
+;;;========================================= ========== ============ ============
+;;;cperl-fix-line-spacing 769 1.4500000000 0.0018855656
+;;;cperl-indent-line 13 0.3100000000 0.0238461538
+;;;cperl-after-block-and-statement-beg 69 0.2700000000 0.0039130434
+;;;cperl-after-block-p 69 0.2099999999 0.0030434782
+;;;cperl-calculate-indent 13 0.1000000000 0.0076923076
+;;;cperl-backward-to-noncomment 177 0.0700000000 0.0003954802
+;;;cperl-get-state 13 0.0 0.0
+;;;cperl-to-comment-or-eol 179 0.0 0.0
+;;;cperl-get-help-defer 1 0.0 0.0
+;;;cperl-lazy-hook 11 0.0 0.0
+;;;cperl-after-expr-p 2 0.0 0.0
+;;;cperl-block-p 13 0.0 0.0
+;;;cperl-after-label 5 0.0 0.0
+
+;;;; After 3.12:
+;;; (`cperl-find-pods-heres'): do not warn on `=cut' if doing a chunk only.
+
+;;;; After 3.13:
+;;; (`cperl-mode'): load pseudo-faces on `cperl-find-pods-heres' (for 19.30).
+;;; (`x-color-defined-p'): was not compiling on XEmacs
+;;; (`cperl-find-pods-heres'): 1 << 6 was OK, but 1<<6 was considered as HERE
+;;; <file/glob> made into a string.
+
+;;;; After 3.14:
+;;; (`cperl-find-pods-heres'): Postpone addition of faces after syntactic step
+;;; Recognition of <FH> was wrong.
+;;; (`cperl-clobber-lisp-bindings'): if set, C-c variants are the old ones
+;;; (`cperl-unwind-to-safe'): New function.
+;;; (`cperl-fontify-syntaxically'): Use `cperl-unwind-to-safe' to start at reasonable position.
+
+;;;; After 3.15:
+;;; (`cperl-forward-re'): Highlight the trailing / in s/foo// as string.
+;;; Highlight the starting // in s//foo/ as function-name.
+
+;;;; After 3.16:
+;;; (`cperl-find-pods-heres'): Highlight `gem' in s///gem as a keyword.
+
+;;;; After 4.0:
+;;; (`cperl-find-pods-heres'): `qr' added
+;;; (`cperl-electric-keyword'): Likewise
+;;; (`cperl-electric-else'): Likewise
+;;; (`cperl-to-comment-or-eol'): Likewise
+;;; (`cperl-make-regexp-x'): Likewise
+;;; (`cperl-init-faces'): Likewise, and `lock' (as overridable?).
+;;; (`cperl-find-pods-heres'): Knows that split// is null-RE.
+;;; Highlights separators in 3-parts expressions
+;;; as labels.
+
+;;;; After 4.1:
+;;; (`cperl-find-pods-heres'): <> was considered as a glob
+;;; (`cperl-syntaxify-unwind'): New configuration variable
+;;; (`cperl-fontify-m-as-s'): New configuration variable
+
+;;;; After 4.2:
+;;; (`cperl-find-pods-heres'): of the last line being `=head1' fixed.
+
+;;; Handling of a long construct is still buggy if only the part of
+;;; construct touches the updated region (we unwind to the start of
+;;; long construct, but the end may have residual properties).
+
+;;; (`cperl-unwind-to-safe'): would not go to beginning of buffer.
+;;; (`cperl-electric-pod'): check for after-expr was performed
+;;; inside of POD too.
+
+;;;; After 4.3:
+;;; (`cperl-backward-to-noncomment'): better treatment of PODs and HEREs.
+
+;;; Indent-line works good, but indent-region does not - at toplevel...
+;;; (`cperl-unwind-to-safe'): Signature changed.
+;;; (`x-color-defined-p'): was defmacro'ed with a tick. Remove another def.
+;;; (`cperl-clobber-mode-lists'): New configuration variable.
+;;; (`cperl-array-face'): One of definitions was garbled.
+
+;;;; After 4.4:
+;;; (`cperl-not-bad-regexp'): Updated.
+;;; (`cperl-make-regexp-x'): Misprint in a message.
+;;; (`cperl-find-pods-heres'): $a-1 ? foo : bar; was a regexp.
+;;; `<< (' was considered a start of POD.
+;;; Init: `cperl-is-face' was busted.
+;;; (`cperl-make-face'): New macros.
+;;; (`cperl-force-face'): New macros.
+;;; (`cperl-init-faces'): Corrected to use new macros;
+;;; `if' for copying `reference-face' to
+;;; `constant-face' was backward.
+;;; (`font-lock-other-type-face'): Done via `defface' too.
+
+;;; Code:
+
+
+(if (fboundp 'eval-when-compile)
+ (eval-when-compile
+ (condition-case nil
+ (require 'custom)
+ (error nil))
+ (or (fboundp 'defgroup)
+ (defmacro defgroup (name val doc &rest arr)
+ nil))
+ (or (fboundp 'custom-declare-variable)
+ (defmacro defcustom (name val doc &rest arr)
+ (` (defvar (, name) (, val) (, doc)))))
+ (or (and (fboundp 'custom-declare-variable)
+ (string< "19.31" emacs-version)) ; Checked with 19.30: defface does not work
+ (defmacro defface (&rest arr)
+ nil))
+ ;; Avoid warning (tmp definitions)
+ (or (fboundp 'x-color-defined-p)
+ (defmacro x-color-defined-p (col)
+ (cond ((fboundp 'color-defined-p) (` (color-defined-p (, col))))
+ ;; XEmacs >= 19.12
+ ((fboundp 'valid-color-name-p) (` (valid-color-name-p (, col))))
+ ;; XEmacs 19.11
+ (t (` (x-valid-color-name-p (, col)))))))
+ (defmacro cperl-is-face (arg) ; Takes quoted arg
+ (cond ((fboundp 'find-face)
+ (` (find-face (, arg))))
+ (;;(and (fboundp 'face-list)
+ ;; (face-list))
+ (fboundp 'face-list)
+ (` (member (, arg) (and (fboundp 'face-list)
+ (face-list)))))
+ (t
+ (` (boundp (, arg))))))
+ (defmacro cperl-make-face (arg descr) ; Takes unquoted arg
+ (cond ((fboundp 'make-face)
+ (` (make-face (quote (, arg)))))
+ (t
+ (` (defconst (, arg) (quote (, arg)) (, descr))))))
+ (defmacro cperl-force-face (arg descr) ; Takes unquoted arg
+ (` (progn
+ (or (cperl-is-face (quote (, arg)))
+ (cperl-make-face (, arg) (, descr)))
+ (or (boundp (quote (, arg))) ; We use unquoted variants too
+ (defconst (, arg) (quote (, arg)) (, descr))))))))
+
+(require 'custom)
+(defun cperl-choose-color (&rest list)
+ (let (answer)
+ (while list
+ (or answer
+ (if (or (x-color-defined-p (car list))
+ (null (cdr list)))
+ (setq answer (car list))))
+ (setq list (cdr list)))
+ answer))
+
+
+(defgroup cperl nil
+ "Major mode for editing Perl code."
+ :prefix "cperl-"
+ :group 'languages)
+
+(defgroup cperl-indentation-details nil
+ "Indentation."
+ :prefix "cperl-"
+ :group 'cperl)
+
+(defgroup cperl-affected-by-hairy nil
+ "Variables affected by `cperl-hairy'."
+ :prefix "cperl-"
+ :group 'cperl)
+
+(defgroup cperl-autoinsert-details nil
+ "Auto-insert tuneup."
+ :prefix "cperl-"
+ :group 'cperl)
+
+(defgroup cperl-faces nil
+ "Fontification colors."
+ :prefix "cperl-"
+ :group 'cperl)
+
+(defgroup cperl-speed nil
+ "Speed vs. validity tuneup."
+ :prefix "cperl-"
+ :group 'cperl)
+
+(defgroup cperl-help-system nil
+ "Help system tuneup."
+ :prefix "cperl-"
+ :group 'cperl)
+
-(defvar cperl-extra-newline-before-brace nil
+(defcustom cperl-extra-newline-before-brace nil
"*Non-nil means that if, elsif, while, until, else, for, foreach
and do constructs look like:
@@ -477,152 +908,370 @@ instead of:
if () {
}
-")
-
-(defvar cperl-indent-level 2
- "*Indentation of CPerl statements with respect to containing block.")
-(defvar cperl-lineup-step nil
+"
+ :type 'boolean
+ :group 'cperl-autoinsert-details)
+
+(defcustom cperl-extra-newline-before-brace-multiline
+ cperl-extra-newline-before-brace
+ "*Non-nil means the same as `cperl-extra-newline-before-brace', but
+for constructs with multiline if/unless/while/until/for/foreach condition."
+ :type 'boolean
+ :group 'cperl-autoinsert-details)
+
+(defcustom cperl-indent-level 2
+ "*Indentation of CPerl statements with respect to containing block."
+ :type 'integer
+ :group 'cperl-indentation-details)
+
+(defcustom cperl-lineup-step nil
"*`cperl-lineup' will always lineup at multiple of this number.
-If `nil', the value of `cperl-indent-level' will be used.")
-(defvar cperl-brace-imaginary-offset 0
+If `nil', the value of `cperl-indent-level' will be used."
+ :type '(choice (const nil) integer)
+ :group 'cperl-indentation-details)
+
+(defcustom cperl-brace-imaginary-offset 0
"*Imagined indentation of a Perl open brace that actually follows a statement.
An open brace following other text is treated as if it were this far
-to the right of the start of its line.")
-(defvar cperl-brace-offset 0
- "*Extra indentation for braces, compared with other text in same context.")
-(defvar cperl-label-offset -2
- "*Offset of CPerl label lines relative to usual indentation.")
-(defvar cperl-min-label-indent 1
- "*Minimal offset of CPerl label lines.")
-(defvar cperl-continued-statement-offset 2
- "*Extra indent for lines not starting new statements.")
-(defvar cperl-continued-brace-offset 0
+to the right of the start of its line."
+ :type 'integer
+ :group 'cperl-indentation-details)
+
+(defcustom cperl-brace-offset 0
+ "*Extra indentation for braces, compared with other text in same context."
+ :type 'integer
+ :group 'cperl-indentation-details)
+(defcustom cperl-label-offset -2
+ "*Offset of CPerl label lines relative to usual indentation."
+ :type 'integer
+ :group 'cperl-indentation-details)
+(defcustom cperl-min-label-indent 1
+ "*Minimal offset of CPerl label lines."
+ :type 'integer
+ :group 'cperl-indentation-details)
+(defcustom cperl-continued-statement-offset 2
+ "*Extra indent for lines not starting new statements."
+ :type 'integer
+ :group 'cperl-indentation-details)
+(defcustom cperl-continued-brace-offset 0
"*Extra indent for substatements that start with open-braces.
-This is in addition to cperl-continued-statement-offset.")
-(defvar cperl-close-paren-offset -1
- "*Extra indent for substatements that start with close-parenthesis.")
-
-(defvar cperl-auto-newline nil
+This is in addition to cperl-continued-statement-offset."
+ :type 'integer
+ :group 'cperl-indentation-details)
+(defcustom cperl-close-paren-offset -1
+ "*Extra indent for substatements that start with close-parenthesis."
+ :type 'integer
+ :group 'cperl-indentation-details)
+
+(defcustom cperl-auto-newline nil
"*Non-nil means automatically newline before and after braces,
-and after colons and semicolons, inserted in CPerl code. The following
+and after colons and semicolons, inserted in CPerl code. The following
\\[cperl-electric-backspace] will remove the inserted whitespace.
Insertion after colons requires both this variable and
-`cperl-auto-newline-after-colon' set.")
+`cperl-auto-newline-after-colon' set."
+ :type 'boolean
+ :group 'cperl-autoinsert-details)
-(defvar cperl-auto-newline-after-colon nil
+(defcustom cperl-auto-newline-after-colon nil
"*Non-nil means automatically newline even after colons.
-Subject to `cperl-auto-newline' setting.")
+Subject to `cperl-auto-newline' setting."
+ :type 'boolean
+ :group 'cperl-autoinsert-details)
-(defvar cperl-tab-always-indent t
+(defcustom cperl-tab-always-indent t
"*Non-nil means TAB in CPerl mode should always reindent the current line,
-regardless of where in the line point is when the TAB command is used.")
+regardless of where in the line point is when the TAB command is used."
+ :type 'boolean
+ :group 'cperl-indentation-details)
-(defvar cperl-font-lock nil
+(defcustom cperl-font-lock nil
"*Non-nil (and non-null) means CPerl buffers will use font-lock-mode.
-Can be overwritten by `cperl-hairy' if nil.")
+Can be overwritten by `cperl-hairy' if nil."
+ :type '(choice (const null) boolean)
+ :group 'cperl-affected-by-hairy)
-(defvar cperl-electric-lbrace-space nil
+(defcustom cperl-electric-lbrace-space nil
"*Non-nil (and non-null) means { after $ in CPerl buffers should be preceded by ` '.
-Can be overwritten by `cperl-hairy' if nil.")
+Can be overwritten by `cperl-hairy' if nil."
+ :type '(choice (const null) boolean)
+ :group 'cperl-affected-by-hairy)
-(defvar cperl-electric-parens-string "({[]})<"
+(defcustom cperl-electric-parens-string "({[]})<"
"*String of parentheses that should be electric in CPerl.
-Closing ones are electric only if the region is highlighted.")
+Closing ones are electric only if the region is highlighted."
+ :type 'string
+ :group 'cperl-affected-by-hairy)
-(defvar cperl-electric-parens nil
+(defcustom cperl-electric-parens nil
"*Non-nil (and non-null) means parentheses should be electric in CPerl.
-Can be overwritten by `cperl-hairy' if nil.")
-(defvar cperl-electric-parens-mark
+Can be overwritten by `cperl-hairy' if nil."
+ :type '(choice (const null) boolean)
+ :group 'cperl-affected-by-hairy)
+
+(defvar zmacs-regions) ; Avoid warning
+
+(defcustom cperl-electric-parens-mark
(and window-system
(or (and (boundp 'transient-mark-mode) ; For Emacs
transient-mark-mode)
(and (boundp 'zmacs-regions) ; For XEmacs
zmacs-regions)))
"*Not-nil means that electric parens look for active mark.
-Default is yes if there is visual feedback on mark.")
+Default is yes if there is visual feedback on mark."
+ :type 'boolean
+ :group 'cperl-autoinsert-details)
-(defvar cperl-electric-linefeed nil
+(defcustom cperl-electric-linefeed nil
"*If true, LFD should be hairy in CPerl, otherwise C-c LFD is hairy.
In any case these two mean plain and hairy linefeeds together.
-Can be overwritten by `cperl-hairy' if nil.")
+Can be overwritten by `cperl-hairy' if nil."
+ :type '(choice (const null) boolean)
+ :group 'cperl-affected-by-hairy)
-(defvar cperl-electric-keywords nil
+(defcustom cperl-electric-keywords nil
"*Not-nil (and non-null) means keywords are electric in CPerl.
-Can be overwritten by `cperl-hairy' if nil.")
-
-(defvar cperl-hairy nil
- "*Not-nil means all the bells and whistles are enabled in CPerl.")
-
-(defvar cperl-comment-column 32
- "*Column to put comments in CPerl (use \\[cperl-indent]' to lineup with code).")
-
-(defvar cperl-vc-header-alist '((SCCS "$sccs = '%W\%' ;")
- (RCS "$rcs = ' $Id\$ ' ;"))
- "*What to use as `vc-header-alist' in CPerl.")
-
-(defvar cperl-info-on-command-no-prompt nil
+Can be overwritten by `cperl-hairy' if nil."
+ :type '(choice (const null) boolean)
+ :group 'cperl-affected-by-hairy)
+
+(defcustom cperl-hairy nil
+ "*Not-nil means most of the bells and whistles are enabled in CPerl.
+Affects: `cperl-font-lock', `cperl-electric-lbrace-space',
+`cperl-electric-parens', `cperl-electric-linefeed', `cperl-electric-keywords',
+`cperl-info-on-command-no-prompt', `cperl-clobber-lisp-bindings',
+`cperl-lazy-help-time'."
+ :type 'boolean
+ :group 'cperl-affected-by-hairy)
+
+(defcustom cperl-comment-column 32
+ "*Column to put comments in CPerl (use \\[cperl-indent] to lineup with code)."
+ :type 'integer
+ :group 'cperl-indentation-details)
+
+(defcustom cperl-vc-header-alist '((SCCS "$sccs = '%W\%' ;")
+ (RCS "$rcs = ' $Id\$ ' ;"))
+ "*What to use as `vc-header-alist' in CPerl."
+ :type '(repeat (list symbol string))
+ :group 'cperl)
+
+(defcustom cperl-clobber-mode-lists
+ (not
+ (and
+ (boundp 'interpreter-mode-alist)
+ (assoc "miniperl" interpreter-mode-alist)
+ (assoc "\\.\\([pP][Llm]\\|al\\)$" auto-mode-alist)))
+ "*Whether to install us into `interpreter-' and `extension' mode lists."
+ :type 'boolean
+ :group 'cperl)
+
+(defcustom cperl-info-on-command-no-prompt nil
"*Not-nil (and non-null) means not to prompt on C-h f.
The opposite behaviour is always available if prefixed with C-c.
-Can be overwritten by `cperl-hairy' if nil.")
-
-(defvar cperl-lazy-help-time nil
- "*Not-nil (and non-null) means to show lazy help after given idle time.")
-
-(defvar cperl-pod-face 'font-lock-comment-face
- "*The result of evaluation of this expression is used for pod highlighting.")
-
-(defvar cperl-pod-head-face 'font-lock-variable-name-face
+Can be overwritten by `cperl-hairy' if nil."
+ :type '(choice (const null) boolean)
+ :group 'cperl-affected-by-hairy)
+
+(defcustom cperl-clobber-lisp-bindings nil
+ "*Not-nil (and non-null) means not overwrite C-h f.
+The function is available on \\[cperl-info-on-command], \\[cperl-get-help].
+Can be overwritten by `cperl-hairy' if nil."
+ :type '(choice (const null) boolean)
+ :group 'cperl-affected-by-hairy)
+
+(defcustom cperl-lazy-help-time nil
+ "*Not-nil (and non-null) means to show lazy help after given idle time.
+Can be overwritten by `cperl-hairy' to be 5 sec if nil."
+ :type '(choice (const null) integer)
+ :group 'cperl-affected-by-hairy)
+
+(defcustom cperl-pod-face 'font-lock-comment-face
+ "*The result of evaluation of this expression is used for pod highlighting."
+ :type 'face
+ :group 'cperl-faces)
+
+(defcustom cperl-pod-head-face 'font-lock-variable-name-face
"*The result of evaluation of this expression is used for pod highlighting.
-Font for POD headers.")
-
-(defvar cperl-here-face 'font-lock-string-face
- "*The result of evaluation of this expression is used for here-docs highlighting.")
-
-(defvar cperl-pod-here-fontify '(featurep 'font-lock)
- "*Not-nil after evaluation means to highlight pod and here-docs sections.")
-
-(defvar cperl-pod-here-scan t
+Font for POD headers."
+ :type 'face
+ :group 'cperl-faces)
+
+(defcustom cperl-here-face 'font-lock-string-face
+ "*The result of evaluation of this expression is used for here-docs highlighting."
+ :type 'face
+ :group 'cperl-faces)
+
+(defcustom cperl-pod-here-fontify '(featurep 'font-lock)
+ "*Not-nil after evaluation means to highlight pod and here-docs sections."
+ :type 'boolean
+ :group 'cperl-faces)
+
+(defcustom cperl-fontify-m-as-s t
+ "*Not-nil means highlight 1arg regular expressions operators same as 2arg."
+ :type 'boolean
+ :group 'cperl-faces)
+
+(defcustom cperl-pod-here-scan t
"*Not-nil means look for pod and here-docs sections during startup.
-You can always make lookup from menu or using \\[cperl-find-pods-heres].")
+You can always make lookup from menu or using \\[cperl-find-pods-heres]."
+ :type 'boolean
+ :group 'cperl-speed)
-(defvar cperl-imenu-addback nil
+(defcustom cperl-imenu-addback nil
"*Not-nil means add backreferences to generated `imenu's.
-May require patched `imenu' and `imenu-go'.")
+May require patched `imenu' and `imenu-go'. Obsolete."
+ :type 'boolean
+ :group 'cperl-help-system)
-(defvar cperl-max-help-size 66
- "*Non-nil means shrink-wrapping of info-buffer allowed up to these percents.")
+(defcustom cperl-max-help-size 66
+ "*Non-nil means shrink-wrapping of info-buffer allowed up to these percents."
+ :type '(choice integer (const nil))
+ :group 'cperl-help-system)
-(defvar cperl-shrink-wrap-info-frame t
- "*Non-nil means shrink-wrapping of info-buffer-frame allowed.")
+(defcustom cperl-shrink-wrap-info-frame t
+ "*Non-nil means shrink-wrapping of info-buffer-frame allowed."
+ :type 'boolean
+ :group 'cperl-help-system)
-(defvar cperl-info-page "perl"
+(defcustom cperl-info-page "perl"
"*Name of the info page containing perl docs.
-Older version of this page was called `perl5', newer `perl'.")
+Older version of this page was called `perl5', newer `perl'."
+ :type 'string
+ :group 'cperl-help-system)
-(defvar cperl-use-syntax-table-text-property
+(defcustom cperl-use-syntax-table-text-property
(boundp 'parse-sexp-lookup-properties)
- "*Non-nil means CPerl sets up and uses `syntax-table' text property.")
+ "*Non-nil means CPerl sets up and uses `syntax-table' text property."
+ :type 'boolean
+ :group 'cperl-speed)
-(defvar cperl-use-syntax-table-text-property-for-tags
+(defcustom cperl-use-syntax-table-text-property-for-tags
cperl-use-syntax-table-text-property
- "*Non-nil means: set up and use `syntax-table' text property generating TAGS.")
-
-(defvar cperl-scan-files-regexp "\\.\\([pP][Llm]\\|xs\\)$"
- "*Regexp to match files to scan when generating TAGS.")
-
-(defvar cperl-noscan-files-regexp "/\\(\\.\\.?\\|SCCS\\|RCS\\|blib\\)$"
- "*Regexp to match files/dirs to skip when generating TAGS.")
-
-(defvar cperl-regexp-indent-step nil
- "*indentation used when beautifying regexps.
-If `nil', the value of `cperl-indent-level' will be used.")
-
-(defvar cperl-indent-left-aligned-comments t
- "*Non-nil means that the comment starting in leftmost column should indent.")
-
-(defvar cperl-under-as-char t
- "*Non-nil means that the _ (underline) should be treated as word char.")
-
+ "*Non-nil means: set up and use `syntax-table' text property generating TAGS."
+ :type 'boolean
+ :group 'cperl-speed)
+
+(defcustom cperl-scan-files-regexp "\\.\\([pP][Llm]\\|xs\\)$"
+ "*Regexp to match files to scan when generating TAGS."
+ :type 'regexp
+ :group 'cperl)
+
+(defcustom cperl-noscan-files-regexp "/\\(\\.\\.?\\|SCCS\\|RCS\\|blib\\)$"
+ "*Regexp to match files/dirs to skip when generating TAGS."
+ :type 'regexp
+ :group 'cperl)
+
+(defcustom cperl-regexp-indent-step nil
+ "*Indentation used when beautifying regexps.
+If `nil', the value of `cperl-indent-level' will be used."
+ :type '(choice integer (const nil))
+ :group 'cperl-indentation-details)
+
+(defcustom cperl-indent-left-aligned-comments t
+ "*Non-nil means that the comment starting in leftmost column should indent."
+ :type 'boolean
+ :group 'cperl-indentation-details)
+
+(defcustom cperl-under-as-char t
+ "*Non-nil means that the _ (underline) should be treated as word char."
+ :type 'boolean
+ :group 'cperl)
+
+(defcustom cperl-extra-perl-args ""
+ "*Extra arguments to use when starting Perl.
+Currently used with `cperl-check-syntax' only."
+ :type 'string
+ :group 'cperl)
+
+(defcustom cperl-message-electric-keyword t
+ "*Non-nil means that the `cperl-electric-keyword' prints a help message."
+ :type 'boolean
+ :group 'cperl-help-system)
+
+(defcustom cperl-indent-region-fix-constructs 1
+ "*Amount of space to insert between `}' and `else' or `elsif'
+in `cperl-indent-region'. Set to nil to leave as is. Values other
+than 1 and nil will probably not work."
+ :type '(choice (const nil) (const 1))
+ :group 'cperl-indentation-details)
+
+(defcustom cperl-break-one-line-blocks-when-indent t
+ "*Non-nil means that one-line if/unless/while/until/for/foreach BLOCKs
+need to be reformated into multiline ones when indenting a region."
+ :type 'boolean
+ :group 'cperl-indentation-details)
+
+(defcustom cperl-fix-hanging-brace-when-indent t
+ "*Non-nil means that BLOCK-end `}' may be put on a separate line
+when indenting a region.
+Braces followed by else/elsif/while/until are excepted."
+ :type 'boolean
+ :group 'cperl-indentation-details)
+
+(defcustom cperl-merge-trailing-else t
+ "*Non-nil means that BLOCK-end `}' followed by else/elsif/continue
+may be merged to be on the same line when indenting a region."
+ :type 'boolean
+ :group 'cperl-indentation-details)
+
+(defcustom cperl-syntaxify-by-font-lock
+ (boundp 'parse-sexp-lookup-properties)
+ "*Non-nil means that CPerl uses `font-lock's routines for syntaxification.
+Having it TRUE may be not completely debugged yet."
+ :type '(choice (const message) boolean)
+ :group 'cperl-speed)
+
+(defcustom cperl-syntaxify-unwind
+ t
+ "*Non-nil means that CPerl unwinds to a start of along construction
+when syntaxifying a chunk of buffer."
+ :type 'boolean
+ :group 'cperl-speed)
+
+(if window-system
+ (progn
+ (defvar cperl-dark-background
+ (cperl-choose-color "navy" "os2blue" "darkgreen"))
+ (defvar cperl-dark-foreground
+ (cperl-choose-color "orchid1" "orange"))
+
+ (defface font-lock-other-type-face
+ (` ((((class grayscale) (background light))
+ (:background "Gray90" :italic t :underline t))
+ (((class grayscale) (background dark))
+ (:foreground "Gray80" :italic t :underline t :bold t))
+ (((class color) (background light))
+ (:foreground "chartreuse3"))
+ (((class color) (background dark))
+ (:foreground (, cperl-dark-foreground)))
+ (t (:bold t :underline t))))
+ "Font Lock mode face used to highlight array names."
+ :group 'cperl-faces)
+
+ (defface cperl-array-face
+ (` ((((class grayscale) (background light))
+ (:background "Gray90" :bold t))
+ (((class grayscale) (background dark))
+ (:foreground "Gray80" :bold t))
+ (((class color) (background light))
+ (:foreground "Blue" :background "lightyellow2" :bold t))
+ (((class color) (background dark))
+ (:foreground "yellow" :background (, cperl-dark-background) :bold t))
+ (t (:bold t))))
+ "Font Lock mode face used to highlight array names."
+ :group 'cperl-faces)
+
+ (defface cperl-hash-face
+ (` ((((class grayscale) (background light))
+ (:background "Gray90" :bold t :italic t))
+ (((class grayscale) (background dark))
+ (:foreground "Gray80" :bold t :italic t))
+ (((class color) (background light))
+ (:foreground "Red" :background "lightyellow2" :bold t :italic t))
+ (((class color) (background dark))
+ (:foreground "Red" :background (, cperl-dark-background) :bold t :italic t))
+ (t (:bold t :italic t))))
+ "Font Lock mode face used to highlight hash names."
+ :group 'cperl-faces)))
@@ -633,10 +1282,12 @@ If `nil', the value of `cperl-indent-level' will be used.")
ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs
and/or
ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl
+Subdirectory `cperl-mode' may contain yet newer development releases and/or
+patches to related files.
Get support packages choose-color.el (or font-lock-extra.el before
19.30), imenu-go.el from the same place. \(Look for other files there
-too... ;-) Get a patch for imenu.el in 19.29. Note that for 19.30 and
+too... ;-). Get a patch for imenu.el in 19.29. Note that for 19.30 and
later you should use choose-color.el *instead* of font-lock-extra.el
\(and you will not get smart highlighting in C :-().
@@ -649,7 +1300,7 @@ older version was on
http://www.metronet.com:70/9/perlinfo/perl5/manual/perl5-info.tar.gz
If you use imenu-go, run imenu on perl5-info buffer (you can do it
-from CPerl menu). If many files are related, generate TAGS files from
+from CPerl menu). If many files are related, generate TAGS files from
Tools/Tags submenu in CPerl menu.
If some class structure is too complicated, use Tools/Hierarchy-view
@@ -665,58 +1316,79 @@ Before reporting (non-)problems look in the problem section on what I
know about them.")
(defvar cperl-problems 'please-ignore-this-line
-"Emacs has a _very_ restricted syntax parsing engine.
-
-It may be corrected on the level of C code, please look in the
-`non-problems' section if you want to volunteer.
-
-CPerl mode tries to corrects some Emacs misunderstandings, however,
-for efficiency reasons the degree of correction is different for
-different operations. The partially corrected problems are: POD
-sections, here-documents, regexps. The operations are: highlighting,
-indentation, electric keywords, electric braces.
+"Some faces will not be shown on some versions of Emacs unless you
+install choose-color.el, available from
+ ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs/
+
+Emacs had a _very_ restricted syntax parsing engine until RMS's Emacs
+20.1. Most problems below are corrected starting from this version of
+Emacs, and all of them should go with (future) RMS's version 20.3.
+
+Note that even with newer Emacsen interaction of `font-lock' and
+syntaxification is not cleaned up. You may get slightly different
+colors basing on the order of fontification and syntaxification. This
+might be corrected by setting `cperl-syntaxify-by-font-lock' to t, but
+the corresponding code is still extremely buggy.
+
+Even with older Emacsen CPerl mode tries to corrects some Emacs
+misunderstandings, however, for efficiency reasons the degree of
+correction is different for different operations. The partially
+corrected problems are: POD sections, here-documents, regexps. The
+operations are: highlighting, indentation, electric keywords, electric
+braces.
This may be confusing, since the regexp s#//#/#\; may be highlighted
as a comment, but it will be recognized as a regexp by the indentation
-code. Or the opposite case, when a pod section is highlighted, but
+code. Or the opposite case, when a pod section is highlighted, but
may break the indentation of the following code (though indentation
should work if the balance of delimiters is not broken by POD).
The main trick (to make $ a \"backslash\") makes constructions like
-${aaa} look like unbalanced braces. The only trick I can think of is
+${aaa} look like unbalanced braces. The only trick I can think of is
to insert it as $ {aaa} (legal in perl5, not in perl4).
Similar problems arise in regexps, when /(\\s|$)/ should be rewritten
-as /($|\\s)/. Note that such a transposition is not always possible
-:-(. " )
+as /($|\\s)/. Note that such a transposition is not always possible.
+
+The solution is to upgrade your Emacs. Note that RMS's 20.2 has some
+bugs related to `syntax-table' text properties. Patches are available
+on the main CPerl download site, and on CPAN.
+
+If these bugs cannot be fixed on your machine (say, you have an inferior
+environment and cannot recompile), you may still disable all the fancy stuff
+via `cperl-use-syntax-table-text-property'." )
(defvar cperl-non-problems 'please-ignore-this-line
-"As you know from `problems' section, Perl syntax is too hard for CPerl.
+"As you know from `problems' section, Perl syntax is too hard for CPerl on
+older Emacsen.
-Most the time, if you write your own code, you may find an equivalent
-\(and almost as readable) expression.
+Most of the time, if you write your own code, you may find an equivalent
+\(and almost as readable) expression (what is discussed below is usually
+not relevant on newer Emacsen, since they can do it automatically).
Try to help CPerl: add comments with embedded quotes to fix CPerl
misunderstandings about the end of quotation:
$a='500$'; # ';
-You won't need it too often. The reason: $ \"quotes\" the following
+You won't need it too often. The reason: $ \"quotes\" the following
character (this saves a life a lot of times in CPerl), thus due to
Emacs parsing rules it does not consider tick (i.e., ' ) after a
-dollar as a closing one, but as a usual character.
+dollar as a closing one, but as a usual character. This is usually
+correct, but not in the above context.
-Now the indentation code is pretty wise. The only drawback is that it
-relies on Emacs parsing to find matching parentheses. And Emacs
-*cannot* match parentheses in Perl 100% correctly. So
+Even with older Emacsen the indentation code is pretty wise. The only
+drawback is that it relied on Emacs parsing to find matching
+parentheses. And Emacs *could not* match parentheses in Perl 100%
+correctly. So
1 if s#//#/#;
-will not break indentation, but
+would not break indentation, but
1 if ( s#//#/# );
-will.
+would. Upgrade.
By similar reasons
s\"abc\"def\";
-will confuse CPerl a lot.
+would confuse CPerl a lot.
If you still get wrong indentation in situation that you think the
code should be able to parse, try:
@@ -724,10 +1396,8 @@ code should be able to parse, try:
a) Check what Emacs thinks about balance of your parentheses.
b) Supply the code to me (IZ).
-Pods are treated _very_ rudimentally. Here-documents are not treated
-at all (except highlighting and inhibiting indentation). (This may
-change some time. RMS approved making syntax lookup recognize text
-attributes, but volunteers are needed to change Emacs C code.)
+Pods were treated _very_ rudimentally. Here-documents were not
+treated at all (except highlighting and inhibiting indentation). Upgrade.
To speed up coloring the following compromises exist:
a) sub in $mypackage::sub may be highlighted.
@@ -735,12 +1405,15 @@ To speed up coloring the following compromises exist:
c) if your regexp contains a keyword (like \"s\"), it may be highlighted.
-Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove
+Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove
`car' before `imenu-choose-buffer-index' in `imenu'.
-")
+`imenu-add-to-menubar' in 20.2 is broken.
+A lot of things on XEmacs may be broken too, judging by bug reports I
+recieve. Note that some releases of XEmacs are better than the others
+as far as bugs reports I see are concerned.")
(defvar cperl-praise 'please-ignore-this-line
- "RMS asked me to list good things about CPerl. Here they go:
+ "RMS asked me to list good things about CPerl. Here they go:
0) It uses the newest `syntax-table' property ;-);
@@ -749,7 +1422,7 @@ mode - but the latter number may have improved too in last years) even
without `syntax-table' property; When using this property, it should
handle 99.995% of lines correct - or somesuch.
-2) It is generally belived to be \"the most user-friendly Emacs
+2) It is generally believed to be \"the most user-friendly Emacs
package\" whatever it may mean (I doubt that the people who say similar
things tried _all_ the rest of Emacs ;-), but this was not a lonely
voice);
@@ -780,7 +1453,7 @@ voice);
namespaces in Perl have different colors);
i) Can construct TAGS basing on its knowledge of Perl syntax,
the standard menu has 6 different way to generate
- TAGS (if by directory, .xs files - with C-language
+ TAGS (if \"by directory\", .xs files - with C-language
bindings - are included in the scan);
j) Can build a hierarchical view of classes (via imenu) basing
on generated TAGS file;
@@ -788,44 +1461,106 @@ voice);
for electric logical constructs
while () {}
with different styles of expansion (context sensitive
- to be not so bothering). Electric parentheses behave
+ to be not so bothering). Electric parentheses behave
\"as they should\" in a presence of a visible region.
l) Changes msb.el \"on the fly\" to insert a group \"Perl files\";
+ m) Can convert from
+ if (A) { B }
+ to
+ B if A;
+
+ n) Highlights (by user-choice) either 3-delimiters constructs
+ (such as tr/a/b/), or regular expressions and `y/tr'.
5) The indentation engine was very smart, but most of tricks may be
-not needed anymore with the support for `syntax-table' property. Has
+not needed anymore with the support for `syntax-table' property. Has
progress indicator for indentation (with `imenu' loaded).
-6) Indent-region improves inline-comments as well;
+6) Indent-region improves inline-comments as well; also corrects
+whitespace *inside* the conditional/loop constructs.
7) Fill-paragraph correctly handles multi-line comments;
+
+8) Can switch to different indentation styles by one command, and restore
+the settings present before the switch.
+
+9) When doing indentation of control constructs, may correct
+line-breaks/spacing between elements of the construct.
+")
+
+(defvar cperl-speed 'please-ignore-this-line
+ "This is an incomplete compendium of what is available in other parts
+of CPerl documentation. (Please inform me if I skept anything.)
+
+There is a perception that CPerl is slower than alternatives. This part
+of documentation is designed to overcome this misconception.
+
+*By default* CPerl tries to enable the most comfortable settings.
+From most points of view, correctly working package is infinitely more
+comfortable than a non-correctly working one, thus by default CPerl
+prefers correctness over speed. Below is the guide how to change
+settings if your preferences are different.
+
+A) Speed of loading the file. When loading file, CPerl may perform a
+scan which indicates places which cannot be parsed by primitive Emacs
+syntax-parsing routines, and marks them up so that either
+
+ A1) CPerl may work around these deficiencies (for big chunks, mostly
+ PODs and HERE-documents), or
+ A2) On capable Emaxen CPerl will use improved syntax-handlings
+ which reads mark-up hints directly.
+
+ The scan in case A2 is much more comprehensive, thus may be slower.
+
+ User can disable syntax-engine-helping scan of A2 by setting
+ `cperl-use-syntax-table-text-property'
+ variable to nil (if it is set to t).
+
+ One can disable the scan altogether (both A1 and A2) by setting
+ `cperl-pod-here-scan'
+ to nil.
+
+B) Speed of editing operations.
+
+ One can add a (minor) speedup to editing operations by setting
+ `cperl-use-syntax-table-text-property'
+ variable to nil (if it is set to t). This will disable
+ syntax-engine-helping scan, thus will make many more Perl
+ constructs be wrongly recognized by CPerl, thus may lead to
+ wrongly matched parentheses, wrong indentation, etc.
+
+ One can unset `cperl-syntaxify-unwind'. This might speed up editing
+ of, say, long POD sections.
")
;;; Portability stuff:
-(defmacro cperl-define-key (fsf-key definition &optional xemacs-key)
+(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
+
+(defmacro cperl-define-key (emacs-key definition &optional xemacs-key)
(` (define-key cperl-mode-map
(, (if xemacs-key
- (` (if cperl-xemacs-p (, xemacs-key) (, fsf-key)))
- fsf-key))
+ (` (if cperl-xemacs-p (, xemacs-key) (, emacs-key)))
+ emacs-key))
(, definition))))
-(defvar del-back-ch (car (append (where-is-internal 'delete-backward-char)
- (where-is-internal 'backward-delete-char-untabify)))
+(defvar cperl-del-back-ch
+ (car (append (where-is-internal 'delete-backward-char)
+ (where-is-internal 'backward-delete-char-untabify)))
"Character generated by key bound to delete-backward-char.")
-(and (vectorp del-back-ch) (= (length del-back-ch) 1)
- (setq del-back-ch (aref del-back-ch 0)))
+(and (vectorp cperl-del-back-ch) (= (length cperl-del-back-ch) 1)
+ (setq cperl-del-back-ch (aref cperl-del-back-ch 0)))
+(defun cperl-mark-active () (mark)) ; Avoid undefined warning
(if cperl-xemacs-p
(progn
;; "Active regions" are on: use region only if active
;; "Active regions" are off: use region unconditionally
(defun cperl-use-region-p ()
- (if zmacs-regions (mark) t))
- (defun cperl-mark-active () (mark)))
+ (if zmacs-regions (mark) t)))
(defun cperl-use-region-p ()
(if transient-mark-mode mark-active t))
(defun cperl-mark-active () mark-active))
@@ -833,14 +1568,15 @@ progress indicator for indentation (with `imenu' loaded).
(defsubst cperl-enable-font-lock ()
(or cperl-xemacs-p window-system))
+(defun cperl-putback-char (c) ; Emacs 19
+ (set 'unread-command-events (list c))) ; Avoid undefined warning
+
(if (boundp 'unread-command-events)
(if cperl-xemacs-p
(defun cperl-putback-char (c) ; XEmacs >= 19.12
- (setq unread-command-events (list (character-to-event c))))
- (defun cperl-putback-char (c) ; Emacs 19
- (setq unread-command-events (list c))))
+ (setq unread-command-events (list (eval '(character-to-event c))))))
(defun cperl-putback-char (c) ; XEmacs <= 19.11
- (setq unread-command-event (character-to-event c))))
+ (set 'unread-command-event (eval '(character-to-event c))))) ; Avoid warnings
(or (fboundp 'uncomment-region)
(defun uncomment-region (beg end)
@@ -853,21 +1589,38 @@ progress indicator for indentation (with `imenu' loaded).
'lazy-lock)
"Text property which inhibits refontification.")
-(defsubst cperl-put-do-not-fontify (from to)
- (put-text-property (max (point-min) (1- from))
- to cperl-do-not-fontify t))
-
-(defvar cperl-mode-hook nil
- "Hook run by `cperl-mode'.")
-
+(defsubst cperl-put-do-not-fontify (from to &optional post)
+ ;; If POST, do not do it with postponed fontification
+ (if (and post cperl-syntaxify-by-font-lock)
+ nil
+ (put-text-property (max (point-min) (1- from))
+ to cperl-do-not-fontify t)))
+
+(defcustom cperl-mode-hook nil
+ "Hook run by `cperl-mode'."
+ :type 'hook
+ :group 'cperl)
+
+(defvar cperl-syntax-state nil)
+(defvar cperl-syntax-done-to nil)
+(defvar cperl-emacs-can-parse (> (length (save-excursion
+ (parse-partial-sexp 1 1))) 9))
+
+;; Make customization possible "in reverse"
+(defsubst cperl-val (symbol &optional default hairy)
+ (cond
+ ((eq (symbol-value symbol) 'null) default)
+ (cperl-hairy (or hairy t))
+ (t (symbol-value symbol))))
;;; Probably it is too late to set these guys already, but it can help later:
-(setq auto-mode-alist
+(and cperl-clobber-mode-lists
+ (setq auto-mode-alist
(append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode)) auto-mode-alist ))
-(and (boundp 'interpreter-mode-alist)
- (setq interpreter-mode-alist (append interpreter-mode-alist
- '(("miniperl" . perl-mode)))))
+ (and (boundp 'interpreter-mode-alist)
+ (setq interpreter-mode-alist (append interpreter-mode-alist
+ '(("miniperl" . perl-mode))))))
(if (fboundp 'eval-when-compile)
(eval-when-compile
(condition-case nil
@@ -876,14 +1629,25 @@ progress indicator for indentation (with `imenu' loaded).
(condition-case nil
(require 'easymenu)
(error nil))
+ (condition-case nil
+ (require 'etags)
+ (error nil))
+ (condition-case nil
+ (require 'timer)
+ (error nil))
+ (condition-case nil
+ (require 'man)
+ (error nil))
+ (condition-case nil
+ (require 'info)
+ (error nil))
;; Calling `cperl-enable-font-lock' below doesn't compile on XEmacs,
;; macros instead of defsubsts don't work on Emacs, so we do the
- ;; expansion manually. Any other suggestions?
+ ;; expansion manually. Any other suggestions?
(if (or (string-match "XEmacs\\|Lucid" emacs-version)
window-system)
(require 'font-lock))
- (require 'cl)
- ))
+ (require 'cl)))
(defvar cperl-mode-abbrev-table nil
"Abbrev table in use in Cperl-mode buffers.")
@@ -905,9 +1669,13 @@ progress indicator for indentation (with `imenu' loaded).
(cperl-define-key ":" 'cperl-electric-terminator)
(cperl-define-key "\C-j" 'newline-and-indent)
(cperl-define-key "\C-c\C-j" 'cperl-linefeed)
+ (cperl-define-key "\C-c\C-t" 'cperl-invert-if-unless)
(cperl-define-key "\C-c\C-a" 'cperl-toggle-auto-newline)
(cperl-define-key "\C-c\C-k" 'cperl-toggle-abbrev)
+ (cperl-define-key "\C-c\C-w" 'cperl-toggle-construct-fix)
+ (cperl-define-key "\C-c\C-f" 'auto-fill-mode)
(cperl-define-key "\C-c\C-e" 'cperl-toggle-electric)
+ (cperl-define-key "\C-c\C-ha" 'cperl-toggle-autohelp)
(cperl-define-key "\e\C-q" 'cperl-indent-exp) ; Usually not bound
(cperl-define-key [?\C-\M-\|] 'cperl-lineup
[(control meta |)])
@@ -916,16 +1684,32 @@ progress indicator for indentation (with `imenu' loaded).
(cperl-define-key "\177" 'cperl-electric-backspace)
(cperl-define-key "\t" 'cperl-indent-command)
;; don't clobber the backspace binding:
- (cperl-define-key "\C-c\C-hf" 'cperl-info-on-current-command
- [(control c) (control h) f])
- (cperl-define-key "\C-hf"
- ;;(concat (char-to-string help-char) "f") ; does not work
- 'cperl-info-on-command
- [(control h) f])
- (cperl-define-key "\C-hv"
- ;;(concat (char-to-string help-char) "v") ; does not work
- 'cperl-get-help
- [(control h) v])
+ (cperl-define-key "\C-c\C-hF" 'cperl-info-on-command
+ [(control c) (control h) F])
+ (if (cperl-val 'cperl-clobber-lisp-bindings)
+ (progn
+ (cperl-define-key "\C-hf"
+ ;;(concat (char-to-string help-char) "f") ; does not work
+ 'cperl-info-on-command
+ [(control h) f])
+ (cperl-define-key "\C-hv"
+ ;;(concat (char-to-string help-char) "v") ; does not work
+ 'cperl-get-help
+ [(control h) v])
+ (cperl-define-key "\C-c\C-hf"
+ ;;(concat (char-to-string help-char) "f") ; does not work
+ (key-binding "\C-hf")
+ [(control c) (control h) f])
+ (cperl-define-key "\C-c\C-hv"
+ ;;(concat (char-to-string help-char) "v") ; does not work
+ (key-binding "\C-hv")
+ [(control c) (control h) v]))
+ (cperl-define-key "\C-c\C-hf" 'cperl-info-on-current-command
+ [(control c) (control h) f])
+ (cperl-define-key "\C-c\C-hv"
+ ;;(concat (char-to-string help-char) "v") ; does not work
+ 'cperl-get-help
+ [(control c) (control h) v]))
(if (and cperl-xemacs-p
(<= emacs-minor-version 11) (<= emacs-major-version 19))
(progn
@@ -947,6 +1731,8 @@ progress indicator for indentation (with `imenu' loaded).
cperl-mode-map global-map)))
(defvar cperl-menu)
+(defvar cperl-lazy-installed)
+(defvar cperl-old-style nil)
(condition-case nil
(progn
(require 'easymenu)
@@ -959,12 +1745,17 @@ progress indicator for indentation (with `imenu' loaded).
["Fill paragraph/comment" cperl-fill-paragraph t]
"----"
["Line up a construction" cperl-lineup (cperl-use-region-p)]
- ["Beautify a regexp" cperl-beautify-regexp
- cperl-use-syntax-table-text-property]
- ["Beautify a group in regexp" cperl-beautify-level
- cperl-use-syntax-table-text-property]
- ["Contract a group in regexp" cperl-contract-level
- cperl-use-syntax-table-text-property]
+ ["Invert if/unless/while/until" cperl-invert-if-unless t]
+ ("Regexp"
+ ["Beautify" cperl-beautify-regexp
+ cperl-use-syntax-table-text-property]
+ ["Beautify a group" cperl-beautify-level
+ cperl-use-syntax-table-text-property]
+ ["Contract a group" cperl-contract-level
+ cperl-use-syntax-table-text-property]
+ ["Contract groups" cperl-contract-levels
+ cperl-use-syntax-table-text-property])
+ ["Refresh \"hard\" constructions" cperl-find-pods-heres t]
"----"
["Indent region" cperl-indent-region (cperl-use-region-p)]
["Comment region" cperl-comment-region (cperl-use-region-p)]
@@ -1003,32 +1794,45 @@ progress indicator for indentation (with `imenu' loaded).
["Create tags for Perl files in (sub)directories"
(cperl-write-tags nil t t t) t]
["Add tags for Perl files in (sub)directories"
- (cperl-write-tags nil nil t t) t])
- ["Recalculate \"hard\" constructions" cperl-find-pods-heres t]
+ (cperl-write-tags nil nil t t) t]))
+ ("Perl docs"
["Define word at point" imenu-go-find-at-position
(fboundp 'imenu-go-find-at-position)]
["Help on function" cperl-info-on-command t]
["Help on function at point" cperl-info-on-current-command t]
["Help on symbol at point" cperl-get-help t]
- ["Auto-help on" cperl-lazy-install (fboundp 'run-with-idle-timer)]
- ["Auto-help off" cperl-lazy-unstall
- (fboundp 'run-with-idle-timer)])
+ ["Perldoc" cperl-perldoc t]
+ ["Perldoc on word at point" cperl-perldoc-at-point t]
+ ["View manpage of POD in this file" cperl-pod-to-manpage t]
+ ["Auto-help on" cperl-lazy-install
+ (and (fboundp 'run-with-idle-timer)
+ (not cperl-lazy-installed))]
+ ["Auto-help off" (eval '(cperl-lazy-unstall))
+ (and (fboundp 'run-with-idle-timer)
+ cperl-lazy-installed)])
("Toggle..."
["Auto newline" cperl-toggle-auto-newline t]
["Electric parens" cperl-toggle-electric t]
["Electric keywords" cperl-toggle-abbrev t]
- )
+ ["Fix whitespace on indent" cperl-toggle-construct-fix t]
+ ["Auto fill" auto-fill-mode t])
("Indent styles..."
+ ["CPerl" (cperl-set-style "CPerl") t]
+ ["PerlStyle" (cperl-set-style "PerlStyle") t]
["GNU" (cperl-set-style "GNU") t]
["C++" (cperl-set-style "C++") t]
["FSF" (cperl-set-style "FSF") t]
["BSD" (cperl-set-style "BSD") t]
- ["Whitesmith" (cperl-set-style "Whitesmith") t])
+ ["Whitesmith" (cperl-set-style "Whitesmith") t]
+ ["Current" (cperl-set-style "Current") t]
+ ["Memorized" (cperl-set-style-back) cperl-old-style])
("Micro-docs"
["Tips" (describe-variable 'cperl-tips) t]
["Problems" (describe-variable 'cperl-problems) t]
["Non-problems" (describe-variable 'cperl-non-problems) t]
- ["Praise" (describe-variable 'cperl-praise) t]))))
+ ["Speed" (describe-variable 'cperl-speed) t]
+ ["Praise" (describe-variable 'cperl-praise) t]
+ ["CPerl mode" (describe-function 'cperl-mode) t]))))
(error nil))
(autoload 'c-macro-expand "cmacexp"
@@ -1071,21 +1875,18 @@ The expansion is entirely correct because it uses the C preprocessor."
-;; Make customization possible "in reverse"
-;;(defun cperl-set (symbol to)
-;; (or (eq (symbol-value symbol) 'null) (set symbol to)))
-(defsubst cperl-val (symbol &optional default hairy)
- (cond
- ((eq (symbol-value symbol) 'null) default)
- (cperl-hairy (or hairy t))
- (t (symbol-value symbol))))
-
;; provide an alias for working with emacs 19. the perl-mode that comes
;; with it is really bad, and this lets us seamlessly replace it.
+;;;###autoload
(fset 'perl-mode 'cperl-mode)
-(defvar cperl-faces-init)
+(defvar cperl-faces-init nil)
;; Fix for msb.el
(defvar cperl-msb-fixed nil)
+(defvar font-lock-syntactic-keywords)
+(defvar perl-font-lock-keywords)
+(defvar perl-font-lock-keywords-1)
+(defvar perl-font-lock-keywords-2)
+;;;###autoload
(defun cperl-mode ()
"Major mode for editing Perl code.
Expression and list commands understand all C brackets.
@@ -1094,78 +1895,96 @@ Paragraphs are separated by blank lines only.
Delete converts tabs to spaces as it moves back.
Various characters in Perl almost always come in pairs: {}, (), [],
-sometimes <>. When the user types the first, she gets the second as
+sometimes <>. When the user types the first, she gets the second as
well, with optional special formatting done on {}. (Disabled by
default.) You can always quote (with \\[quoted-insert]) the left
-\"paren\" to avoid the expansion. The processing of < is special,
-since most the time you mean \"less\". Cperl mode tries to guess
+\"paren\" to avoid the expansion. The processing of < is special,
+since most the time you mean \"less\". Cperl mode tries to guess
whether you want to type pair <>, and inserts is if it
-appropriate. You can set `cperl-electric-parens-string' to the string that
+appropriate. You can set `cperl-electric-parens-string' to the string that
contains the parenths from the above list you want to be electrical.
Electricity of parenths is controlled by `cperl-electric-parens'.
You may also set `cperl-electric-parens-mark' to have electric parens
look for active mark and \"embrace\" a region if possible.'
CPerl mode provides expansion of the Perl control constructs:
- if, else, elsif, unless, while, until, for, and foreach.
-=========(Disabled by default, see `cperl-electric-keywords'.)
-The user types the keyword immediately followed by a space, which causes
-the construct to be expanded, and the user is positioned where she is most
-likely to want to be.
-eg. when the user types a space following \"if\" the following appears in
-the buffer:
- if () { or if ()
- } {
- }
-and the cursor is between the parentheses. The user can then type some
-boolean expression within the parens. Having done that, typing
-\\[cperl-linefeed] places you, appropriately indented on a new line
-between the braces. If CPerl decides that you want to insert
-\"English\" style construct like
+
+ if, else, elsif, unless, while, until, continue, do,
+ for, foreach, formy and foreachmy.
+
+and POD directives (Disabled by default, see `cperl-electric-keywords'.)
+
+The user types the keyword immediately followed by a space, which
+causes the construct to be expanded, and the point is positioned where
+she is most likely to want to be. eg. when the user types a space
+following \"if\" the following appears in the buffer: if () { or if ()
+} { } and the cursor is between the parentheses. The user can then
+type some boolean expression within the parens. Having done that,
+typing \\[cperl-linefeed] places you - appropriately indented - on a
+new line between the braces (if you typed \\[cperl-linefeed] in a POD
+directive line, then appropriate number of new lines is inserted).
+
+If CPerl decides that you want to insert \"English\" style construct like
+
bite if angry;
-it will not do any expansion. See also help on variable
-`cperl-extra-newline-before-brace'.
+
+it will not do any expansion. See also help on variable
+`cperl-extra-newline-before-brace'. (Note that one can switch the
+help message on expansion by setting `cperl-message-electric-keyword'
+to nil.)
\\[cperl-linefeed] is a convenience replacement for typing carriage
-return. It places you in the next line with proper indentation, or if
+return. It places you in the next line with proper indentation, or if
you type it inside the inline block of control construct, like
+
foreach (@lines) {print; print}
+
and you are on a boundary of a statement inside braces, it will
transform the construct into a multiline and will place you into an
-appropriately indented blank line. If you need a usual
+appropriately indented blank line. If you need a usual
`newline-and-indent' behaviour, it is on \\[newline-and-indent],
see documentation on `cperl-electric-linefeed'.
+Use \\[cperl-invert-if-unless] to change a construction of the form
+
+ if (A) { B }
+
+into
+
+ B if A;
+
\\{cperl-mode-map}
-Setting the variable `cperl-font-lock' to t switches on
-font-lock-mode, `cperl-electric-lbrace-space' to t switches on
-electric space between $ and {, `cperl-electric-parens-string' is the
-string that contains parentheses that should be electric in CPerl (see
-also `cperl-electric-parens-mark' and `cperl-electric-parens'),
+Setting the variable `cperl-font-lock' to t switches on font-lock-mode
+\(even with older Emacsen), `cperl-electric-lbrace-space' to t switches
+on electric space between $ and {, `cperl-electric-parens-string' is
+the string that contains parentheses that should be electric in CPerl
+\(see also `cperl-electric-parens-mark' and `cperl-electric-parens'),
setting `cperl-electric-keywords' enables electric expansion of
-control structures in CPerl. `cperl-electric-linefeed' governs which
-one of two linefeed behavior is preferable. You can enable all these
+control structures in CPerl. `cperl-electric-linefeed' governs which
+one of two linefeed behavior is preferable. You can enable all these
options simultaneously (recommended mode of use) by setting
-`cperl-hairy' to t. In this case you can switch separate options off
-by setting them to `null'. Note that one may undo the extra whitespace
-inserted by semis and braces in `auto-newline'-mode by consequent
-\\[cperl-electric-backspace].
+`cperl-hairy' to t. In this case you can switch separate options off
+by setting them to `null'. Note that one may undo the extra
+whitespace inserted by semis and braces in `auto-newline'-mode by
+consequent \\[cperl-electric-backspace].
If your site has perl5 documentation in info format, you can use commands
\\[cperl-info-on-current-command] and \\[cperl-info-on-command] to access it.
These keys run commands `cperl-info-on-current-command' and
`cperl-info-on-command', which one is which is controlled by variable
-`cperl-info-on-command-no-prompt' (in turn affected by `cperl-hairy').
+`cperl-info-on-command-no-prompt' and `cperl-clobber-lisp-bindings'
+\(in turn affected by `cperl-hairy').
Even if you have no info-format documentation, short one-liner-style
-help is available on \\[cperl-get-help].
+help is available on \\[cperl-get-help], and one can run perldoc or
+man via menu.
-It is possible to show this help automatically after some idle
-time. This is regulated by variable `cperl-lazy-help-time'. Default
-with `cperl-hairy' is 5 secs idle time if the value of this variable
-is nil. It is also possible to switch this on/off from the
-menu. Requires `run-with-idle-timer'.
+It is possible to show this help automatically after some idle time.
+This is regulated by variable `cperl-lazy-help-time'. Default with
+`cperl-hairy' (if the value of `cperl-lazy-help-time' is nil) is 5
+secs idle time . It is also possible to switch this on/off from the
+menu, or via \\[cperl-toggle-autohelp]. Requires `run-with-idle-timer'.
Use \\[cperl-lineup] to vertically lineup some construction - put the
beginning of the region at the start of construction, and make region
@@ -1173,16 +1992,18 @@ span the needed amount of lines.
Variables `cperl-pod-here-scan', `cperl-pod-here-fontify',
`cperl-pod-face', `cperl-pod-head-face' control processing of pod and
-here-docs sections. In a future version results of scan may be used
-for indentation too, currently they are used for highlighting only.
+here-docs sections. With capable Emaxen results of scan are used
+for indentation too, otherwise they are used for highlighting only.
Variables controlling indentation style:
`cperl-tab-always-indent'
Non-nil means TAB in CPerl mode should always reindent the current line,
regardless of where in the line point is when the TAB command is used.
+ `cperl-indent-left-aligned-comments'
+ Non-nil means that the comment starting in leftmost column should indent.
`cperl-auto-newline'
Non-nil means automatically newline before and after braces,
- and after colons and semicolons, inserted in Perl code. The following
+ and after colons and semicolons, inserted in Perl code. The following
\\[cperl-electric-backspace] will remove the inserted whitespace.
Insertion after colons requires both this variable and
`cperl-auto-newline-after-colon' set.
@@ -1215,25 +2036,31 @@ Settings for K&R and BSD indentation styles are
`cperl-brace-offset' -5 -8
`cperl-label-offset' -5 -8
-If `cperl-indent-level' is 0, the statement after opening brace in column 0 is indented on `cperl-brace-offset'+`cperl-continued-statement-offset'.
+CPerl knows several indentation styles, and may bulk set the
+corresponding variables. Use \\[cperl-set-style] to do this. Use
+\\[cperl-set-style-back] to restore the memorized preexisting values
+\(both available from menu).
+
+If `cperl-indent-level' is 0, the statement after opening brace in
+column 0 is indented on
+`cperl-brace-offset'+`cperl-continued-statement-offset'.
Turning on CPerl mode calls the hooks in the variable `cperl-mode-hook'
-with no args."
+with no args.
+
+DO NOT FORGET to read micro-docs (available from `Perl' menu)
+or as help on variables `cperl-tips', `cperl-problems',
+`cperl-non-problems', `cperl-praise', `cperl-speed'."
(interactive)
(kill-all-local-variables)
- ;;(if cperl-hairy
- ;; (progn
- ;; (cperl-set 'cperl-font-lock cperl-hairy)
- ;; (cperl-set 'cperl-electric-lbrace-space cperl-hairy)
- ;; (cperl-set 'cperl-electric-parens "{[(<")
- ;; (cperl-set 'cperl-electric-keywords cperl-hairy)
- ;; (cperl-set 'cperl-electric-linefeed cperl-hairy)))
(use-local-map cperl-mode-map)
(if (cperl-val 'cperl-electric-linefeed)
(progn
(local-set-key "\C-J" 'cperl-linefeed)
(local-set-key "\C-C\C-J" 'newline-and-indent)))
- (if (cperl-val 'cperl-info-on-command-no-prompt)
+ (if (and
+ (cperl-val 'cperl-clobber-lisp-bindings)
+ (cperl-val 'cperl-info-on-command-no-prompt))
(progn
;; don't clobber the backspace binding:
(cperl-define-key "\C-hf" 'cperl-info-on-current-command [(control h) f])
@@ -1250,9 +2077,16 @@ with no args."
("until" "until" cperl-electric-keyword 0)
("unless" "unless" cperl-electric-keyword 0)
("else" "else" cperl-electric-else 0)
+ ("continue" "continue" cperl-electric-else 0)
("for" "for" cperl-electric-keyword 0)
("foreach" "foreach" cperl-electric-keyword 0)
- ("do" "do" cperl-electric-keyword 0)))
+ ("formy" "formy" cperl-electric-keyword 0)
+ ("foreachmy" "foreachmy" cperl-electric-keyword 0)
+ ("do" "do" cperl-electric-keyword 0)
+ ("pod" "pod" cperl-electric-pod 0)
+ ("over" "over" cperl-electric-pod 0)
+ ("head1" "head1" cperl-electric-pod 0)
+ ("head2" "head2" cperl-electric-pod 0)))
(setq abbrevs-changed prev-a-c)))
(setq local-abbrev-table cperl-mode-abbrev-table)
(abbrev-mode (if (cperl-val 'cperl-electric-keywords) 1 0))
@@ -1290,25 +2124,50 @@ with no args."
(make-local-variable 'imenu-sort-function)
(setq imenu-sort-function nil)
(make-local-variable 'vc-header-alist)
- (setq vc-header-alist cperl-vc-header-alist)
+ (set 'vc-header-alist cperl-vc-header-alist) ; Avoid warning
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults
- (if (string< emacs-version "19.30")
- '(perl-font-lock-keywords-2)
+ (cond
+ ((string< emacs-version "19.30")
+ '(perl-font-lock-keywords-2))
+ ((string< emacs-version "19.33") ; Which one to use?
'((perl-font-lock-keywords
perl-font-lock-keywords-1
- perl-font-lock-keywords-2))))
+ perl-font-lock-keywords-2)))
+ (t
+ '((cperl-load-font-lock-keywords
+ cperl-load-font-lock-keywords-1
+ cperl-load-font-lock-keywords-2)))))
+ (make-local-variable 'cperl-syntax-state)
(if cperl-use-syntax-table-text-property
(progn
(make-variable-buffer-local 'parse-sexp-lookup-properties)
;; Do not introduce variable if not needed, we check it!
- (set 'parse-sexp-lookup-properties t)))
+ (set 'parse-sexp-lookup-properties t)
+ ;; Fix broken font-lock:
+ (or (boundp 'font-lock-unfontify-region-function)
+ (set 'font-lock-unfontify-region-function
+ 'font-lock-default-unfontify-buffer))
+ (make-variable-buffer-local 'font-lock-unfontify-region-function)
+ (set 'font-lock-unfontify-region-function
+ 'cperl-font-lock-unfontify-region-function)
+ (make-variable-buffer-local 'cperl-syntax-done-to)
+ ;; Another bug: unless font-lock-syntactic-keywords, font-lock
+ ;; ignores syntax-table text-property. (t) is a hack
+ ;; to make font-lock think that font-lock-syntactic-keywords
+ ;; are defined
+ (make-variable-buffer-local 'font-lock-syntactic-keywords)
+ (setq font-lock-syntactic-keywords
+ (if cperl-syntaxify-by-font-lock
+ '(t (cperl-fontify-syntaxically))
+ '(t)))))
+ (make-local-variable 'cperl-old-style)
(or (fboundp 'cperl-old-auto-fill-mode)
(progn
(fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode))
(defun auto-fill-mode (&optional arg)
(interactive "P")
- (cperl-old-auto-fill-mode arg)
+ (eval '(cperl-old-auto-fill-mode arg)) ; Avoid a warning
(and auto-fill-function (eq major-mode 'perl-mode)
(setq auto-fill-function 'cperl-do-auto-fill)))))
(if (cperl-enable-font-lock)
@@ -1319,12 +2178,19 @@ with no args."
(not cperl-msb-fixed)
(cperl-msb-fix))
(if (featurep 'easymenu)
- (easy-menu-add cperl-menu)) ; A NOP under FSF Emacs.
+ (easy-menu-add cperl-menu)) ; A NOP in RMS Emacs.
(run-hooks 'cperl-mode-hook)
;; After hooks since fontification will break this
- (if cperl-pod-here-scan (cperl-find-pods-heres)))
+ (if cperl-pod-here-scan
+ (or ;;(and (boundp 'font-lock-mode)
+ ;; (eval 'font-lock-mode) ; Avoid warning
+ ;; (boundp 'font-lock-hot-pass) ; Newer font-lock
+ cperl-syntaxify-by-font-lock ;;)
+ (progn (or cperl-faces-init (cperl-init-faces-weak))
+ (cperl-find-pods-heres)))))
;; Fix for perldb - make default reasonable
+(defvar gud-perldb-history)
(defun cperl-db ()
(interactive)
(require 'gud)
@@ -1339,7 +2205,7 @@ with no args."
nil nil
'(gud-perldb-history . 1))))
-
+(defvar msb-menu-cond)
(defun cperl-msb-fix ()
;; Adds perl files to msb menu, supposes that msb is already loaded
(setq cperl-msb-fixed t)
@@ -1356,7 +2222,7 @@ with no args."
;; This is used by indent-for-comment
;; to decide how much to indent a comment in CPerl code
-;; based on its context. Do fallback if comment is found wrong.
+;; based on its context. Do fallback if comment is found wrong.
(defvar cperl-wrong-comment)
@@ -1425,7 +2291,7 @@ See `comment-region'."
(defun cperl-electric-brace (arg &optional only-before)
"Insert character and correct line's indentation.
If ONLY-BEFORE and `cperl-auto-newline', will insert newline before the
-place (even in empty line), but not after. If after \")\" and the inserted
+place (even in empty line), but not after. If after \")\" and the inserted
char is \"{\", insert extra newline before only if
`cperl-extra-newline-before-brace'."
(interactive "P")
@@ -1447,41 +2313,52 @@ char is \"{\", insert extra newline before only if
(setq last-command-char ?\{)
(cperl-electric-lbrace arg insertpos))
(forward-char 1))
- (if (and (not arg) ; No args, end (of empty line or auto)
- (eolp)
- (or (and (null only-before)
- (save-excursion
- (skip-chars-backward " \t")
- (bolp)))
- (and (eq last-command-char ?\{) ; Do not insert newline
- ;; if after ")" and `cperl-extra-newline-before-brace'
- ;; is nil, do not insert extra newline.
- (not cperl-extra-newline-before-brace)
- (save-excursion
- (skip-chars-backward " \t")
- (eq (preceding-char) ?\))))
- (if cperl-auto-newline
- (progn (cperl-indent-line) (newline) t) nil)))
- (progn
- (insert last-command-char)
- (cperl-indent-line)
- (if cperl-auto-newline
- (setq insertpos (1- (point))))
- (if (and cperl-auto-newline (null only-before))
- (progn
- (newline)
- (cperl-indent-line)))
+ ;: Check whether we close something "usual" with `}'
+ (if (and (eq last-command-char ?\})
+ (not
+ (condition-case nil
+ (save-excursion
+ (up-list (- (prefix-numeric-value arg)))
+ ;;(cperl-after-block-p (point-min))
+ (cperl-after-expr-p nil "{;)"))
+ (error nil))))
+ ;; Just insert the guy
+ (self-insert-command (prefix-numeric-value arg))
+ (if (and (not arg) ; No args, end (of empty line or auto)
+ (eolp)
+ (or (and (null only-before)
+ (save-excursion
+ (skip-chars-backward " \t")
+ (bolp)))
+ (and (eq last-command-char ?\{) ; Do not insert newline
+ ;; if after ")" and `cperl-extra-newline-before-brace'
+ ;; is nil, do not insert extra newline.
+ (not cperl-extra-newline-before-brace)
+ (save-excursion
+ (skip-chars-backward " \t")
+ (eq (preceding-char) ?\))))
+ (if cperl-auto-newline
+ (progn (cperl-indent-line) (newline) t) nil)))
+ (progn
+ (self-insert-command (prefix-numeric-value arg))
+ (cperl-indent-line)
+ (if cperl-auto-newline
+ (setq insertpos (1- (point))))
+ (if (and cperl-auto-newline (null only-before))
+ (progn
+ (newline)
+ (cperl-indent-line)))
+ (save-excursion
+ (if insertpos (progn (goto-char insertpos)
+ (search-forward (make-string
+ 1 last-command-char))
+ (setq insertpos (1- (point)))))
+ (delete-char -1))))
+ (if insertpos
(save-excursion
- (if insertpos (progn (goto-char insertpos)
- (search-forward (make-string
- 1 last-command-char))
- (setq insertpos (1- (point)))))
- (delete-char -1))))
- (if insertpos
- (save-excursion
- (goto-char insertpos)
- (self-insert-command (prefix-numeric-value arg)))
- (self-insert-command (prefix-numeric-value arg))))))
+ (goto-char insertpos)
+ (self-insert-command (prefix-numeric-value arg)))
+ (self-insert-command (prefix-numeric-value arg)))))))
(defun cperl-electric-lbrace (arg &optional end)
"Insert character, correct line's indentation, correct quoting by space."
@@ -1502,8 +2379,15 @@ char is \"{\", insert extra newline before only if
(save-excursion
(skip-chars-backward "$")
(looking-at "\\(\\$\\$\\)*\\$\\([^\\$]\\|$\\)"))
- (insert ? ))
- (if (cperl-after-expr-p nil "{;)") nil (setq cperl-auto-newline nil))
+ (insert ?\ ))
+ ;; Check whether we are in comment
+ (if (and
+ (save-excursion
+ (beginning-of-line)
+ (not (looking-at "[ \t]*#")))
+ (cperl-after-expr-p nil "{;)"))
+ nil
+ (setq cperl-auto-newline nil))
(cperl-electric-brace arg)
(and (cperl-val 'cperl-electric-parens)
(eq last-command-char ?{)
@@ -1532,18 +2416,22 @@ char is \"{\", insert extra newline before only if
(>= (save-excursion (cperl-to-comment-or-eol) (point)) (point))
;;(not (save-excursion (search-backward "#" beg t)))
(if (eq last-command-char ?<)
- (cperl-after-expr-p nil "{;(,:=")
+ (progn
+ (and abbrev-mode ; later it is too late, may be after `for'
+ (expand-abbrev))
+ (cperl-after-expr-p nil "{;(,:="))
1))
(progn
- (insert last-command-char)
+ (self-insert-command (prefix-numeric-value arg))
(if other-end (goto-char (marker-position other-end)))
- (insert (cdr (assoc last-command-char '((?{ .?})
- (?[ . ?])
- (?( . ?))
- (?< . ?>)))))
- (forward-char -1))
- (insert last-command-char)
- )))
+ (insert (make-string
+ (prefix-numeric-value arg)
+ (cdr (assoc last-command-char '((?{ .?})
+ (?[ . ?])
+ (?( . ?))
+ (?< . ?>))))))
+ (forward-char (- (prefix-numeric-value arg))))
+ (self-insert-command (prefix-numeric-value arg)))))
(defun cperl-electric-rparen (arg)
"Insert a matching pair of parentheses if marking is active.
@@ -1566,55 +2454,164 @@ If not, or if we are not at the end of marking range, would self-insert."
;;(not (save-excursion (search-backward "#" beg t)))
)
(progn
- (insert last-command-char)
+ (self-insert-command (prefix-numeric-value arg))
(setq p (point))
(if other-end (goto-char other-end))
- (insert (cdr (assoc last-command-char '((?\} . ?\{)
+ (insert (make-string
+ (prefix-numeric-value arg)
+ (cdr (assoc last-command-char '((?\} . ?\{)
(?\] . ?\[)
(?\) . ?\()
- (?\> . ?\<)))))
+ (?\> . ?\<))))))
(goto-char (1+ p)))
- (call-interactively 'self-insert-command)
- )))
+ (self-insert-command (prefix-numeric-value arg)))))
(defun cperl-electric-keyword ()
- "Insert a construction appropriate after a keyword."
+ "Insert a construction appropriate after a keyword.
+Help message may be switched off by setting `cperl-message-electric-keyword'
+to nil."
(let ((beg (save-excursion (beginning-of-line) (point)))
- (dollar (eq last-command-char ?$)))
+ (dollar (and (eq last-command-char ?$)
+ (eq this-command 'self-insert-command)))
+ (delete (and (memq last-command-char '(?\ ?\n ?\t ?\f))
+ (memq this-command '(self-insert-command newline))))
+ my do)
(and (save-excursion
- (backward-sexp 1)
+ (condition-case nil
+ (progn
+ (backward-sexp 1)
+ (setq do (looking-at "do\\>")))
+ (error nil))
(cperl-after-expr-p nil "{;:"))
(save-excursion
(not
(re-search-backward
- "[#\"'`]\\|\\<q\\(\\|[wqx]\\)\\>"
+ "[#\"'`]\\|\\<q\\(\\|[wqxr]\\)\\>"
beg t)))
(save-excursion (or (not (re-search-backward "^=" nil t))
- (looking-at "=cut")))
+ (or
+ (looking-at "=cut")
+ (and cperl-use-syntax-table-text-property
+ (not (eq (get-text-property (point)
+ 'syntax-type)
+ 'pod))))))
(progn
+ (and (eq (preceding-char) ?y)
+ (progn ; "foreachmy"
+ (forward-char -2)
+ (insert " ")
+ (forward-char 2)
+ (setq my t dollar t
+ delete
+ (memq this-command '(self-insert-command newline)))))
(and dollar (insert " $"))
(cperl-indent-line)
;;(insert " () {\n}")
(cond
(cperl-extra-newline-before-brace
- (insert " ()\n")
+ (insert (if do "\n" " ()\n"))
(insert "{")
(cperl-indent-line)
(insert "\n")
(cperl-indent-line)
- (insert "\n}"))
+ (insert "\n}")
+ (and do (insert " while ();")))
(t
- (insert " () {\n}"))
+ (insert (if do " {\n} while ();" " () {\n}")))
)
(or (looking-at "[ \t]\\|$") (insert " "))
(cperl-indent-line)
(if dollar (progn (search-backward "$")
- (forward-char 1))
+ (if my
+ (forward-char 1)
+ (delete-char 1)))
(search-backward ")"))
- (cperl-putback-char del-back-ch)))))
+ (if delete
+ (cperl-putback-char cperl-del-back-ch))
+ (if cperl-message-electric-keyword
+ (message "Precede char by C-q to avoid expansion"))))))
+
+(defun cperl-ensure-newlines (n &optional pos)
+ "Make sure there are N newlines after the point."
+ (or pos (setq pos (point)))
+ (if (looking-at "\n")
+ (forward-char 1)
+ (insert "\n"))
+ (if (> n 1)
+ (cperl-ensure-newlines (1- n) pos)
+ (goto-char pos)))
+
+(defun cperl-electric-pod ()
+ "Insert a POD chunk appropriate after a =POD directive."
+ (let ((delete (and (memq last-command-char '(?\ ?\n ?\t ?\f))
+ (memq this-command '(self-insert-command newline))))
+ head1 notlast name p really-delete over)
+ (and (save-excursion
+ (condition-case nil
+ (backward-sexp 1)
+ (error nil))
+ (and
+ (eq (preceding-char) ?=)
+ (progn
+ (setq head1 (looking-at "head1\\>"))
+ (setq over (looking-at "over\\>"))
+ (forward-char -1)
+ (bolp))
+ (or
+ (get-text-property (point) 'in-pod)
+ (cperl-after-expr-p nil "{;:")
+ (and (re-search-backward
+ "\\(\\`\n?\\|\n\n\\)=\\sw+" (point-min) t)
+ (not (or
+ (looking-at "=cut")
+ (and cperl-use-syntax-table-text-property
+ (not (eq (get-text-property (point) 'syntax-type)
+ 'pod)))))))))
+ (progn
+ (save-excursion
+ (setq notlast (search-forward "\n\n=" nil t)))
+ (or notlast
+ (progn
+ (insert "\n\n=cut")
+ (cperl-ensure-newlines 2)
+ (forward-sexp -2)
+ (if (and head1
+ (not
+ (save-excursion
+ (forward-char -1)
+ (re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\>"
+ nil t)))) ; Only one
+ (progn
+ (forward-sexp 1)
+ (setq name (file-name-sans-extension
+ (file-name-nondirectory (buffer-file-name)))
+ p (point))
+ (insert " NAME\n\n" name
+ " - \n\n=head1 SYNOPSYS\n\n\n\n"
+ "=head1 DESCRIPTION")
+ (cperl-ensure-newlines 4)
+ (goto-char p)
+ (forward-sexp 2)
+ (end-of-line)
+ (setq really-delete t))
+ (forward-sexp 1))))
+ (if over
+ (progn
+ (setq p (point))
+ (insert "\n\n=item \n\n\n\n"
+ "=back")
+ (cperl-ensure-newlines 2)
+ (goto-char p)
+ (forward-sexp 1)
+ (end-of-line)
+ (setq really-delete t)))
+ (if (and delete really-delete)
+ (cperl-putback-char cperl-del-back-ch))))))
(defun cperl-electric-else ()
- "Insert a construction appropriate after a keyword."
+ "Insert a construction appropriate after a keyword.
+Help message may be switched off by setting `cperl-message-electric-keyword'
+to nil."
(let ((beg (save-excursion (beginning-of-line) (point))))
(and (save-excursion
(backward-sexp 1)
@@ -1622,10 +2619,14 @@ If not, or if we are not at the end of marking range, would self-insert."
(save-excursion
(not
(re-search-backward
- "[#\"'`]\\|\\<q\\(\\|[wqx]\\)\\>"
+ "[#\"'`]\\|\\<q\\(\\|[wqxr]\\)\\>"
beg t)))
(save-excursion (or (not (re-search-backward "^=" nil t))
- (looking-at "=cut")))
+ (looking-at "=cut")
+ (and cperl-use-syntax-table-text-property
+ (not (eq (get-text-property (point)
+ 'syntax-type)
+ 'pod)))))
(progn
(cperl-indent-line)
;;(insert " {\n\n}")
@@ -1642,14 +2643,18 @@ If not, or if we are not at the end of marking range, would self-insert."
(cperl-indent-line)
(forward-line -1)
(cperl-indent-line)
- (cperl-putback-char del-back-ch)))))
+ (cperl-putback-char cperl-del-back-ch)
+ (setq this-command 'cperl-electric-else)
+ (if cperl-message-electric-keyword
+ (message "Precede char by C-q to avoid expansion"))))))
(defun cperl-linefeed ()
- "Go to end of line, open a new line and indent appropriately."
+ "Go to end of line, open a new line and indent appropriately.
+If in POD, insert appropriate lines."
(interactive)
(let ((beg (save-excursion (beginning-of-line) (point)))
(end (save-excursion (end-of-line) (point)))
- (pos (point)) start)
+ (pos (point)) start over cut res)
(if (and ; Check if we need to split:
; i.e., on a boundary and inside "{...}"
(save-excursion (cperl-to-comment-or-eol)
@@ -1669,7 +2674,7 @@ If not, or if we are not at the end of marking range, would self-insert."
(progn
(backward-sexp 1)
(setq start (point-marker))
- (<= start pos))))) ; Redundant? Are after the
+ (<= start pos))))) ; Redundant? Are after the
; start of parens group.
(progn
(skip-chars-backward " \t")
@@ -1702,7 +2707,7 @@ If not, or if we are not at the end of marking range, would self-insert."
(forward-line -1) ; We are on the line before target
(end-of-line)
(newline-and-indent))
- (end-of-line) ; else
+ (end-of-line) ; else - no splitting
(cond
((and (looking-at "\n[ \t]*{$")
(save-excursion
@@ -1711,6 +2716,37 @@ If not, or if we are not at the end of marking range, would self-insert."
; with an extra newline.
(forward-line 2)
(cperl-indent-line))
+ ((save-excursion ; In POD header
+ (forward-paragraph -1)
+ ;; (re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\b")
+ ;; We are after \n now, so look for the rest
+ (if (looking-at "\\(\\`\n?\\|\n\\)=\\sw+")
+ (progn
+ (setq cut (looking-at "\\(\\`\n?\\|\n\\)=cut\\>"))
+ (setq over (looking-at "\\(\\`\n?\\|\n\\)=over\\>"))
+ t)))
+ (if (and over
+ (progn
+ (forward-paragraph -1)
+ (forward-word 1)
+ (setq pos (point))
+ (setq cut (buffer-substring (point)
+ (save-excursion
+ (end-of-line)
+ (point))))
+ (delete-char (- (save-excursion (end-of-line) (point))
+ (point)))
+ (setq res (expand-abbrev))
+ (save-excursion
+ (goto-char pos)
+ (insert cut))
+ res))
+ nil
+ (cperl-ensure-newlines (if cut 2 4))
+ (forward-line 2)))
+ ((get-text-property (point) 'in-pod) ; In POD section
+ (cperl-ensure-newlines 4)
+ (forward-line 2))
((looking-at "\n[ \t]*$") ; Next line is empty - use it.
(forward-line 1)
(cperl-indent-line))
@@ -1754,7 +2790,7 @@ If not, or if we are not at the end of marking range, would self-insert."
(let ((pps (parse-partial-sexp (point) end)))
(or (nth 3 pps) (nth 4 pps) (nth 5 pps))))))))
(progn
- (insert last-command-char)
+ (self-insert-command (prefix-numeric-value arg))
;;(forward-char -1)
(if auto (setq insertpos (point-marker)))
;;(forward-char 1)
@@ -1763,12 +2799,6 @@ If not, or if we are not at the end of marking range, would self-insert."
(progn
(newline)
(cperl-indent-line)))
-;; (save-excursion
-;; (if insertpos (progn (goto-char (marker-position insertpos))
-;; (search-forward (make-string
-;; 1 last-command-char))
-;; (setq insertpos (1- (point)))))
-;; (delete-char -1))))
(save-excursion
(if insertpos (goto-char (1- (marker-position insertpos)))
(forward-char -1))
@@ -1780,20 +2810,32 @@ If not, or if we are not at the end of marking range, would self-insert."
(self-insert-command (prefix-numeric-value arg)))))
(defun cperl-electric-backspace (arg)
- "Backspace-untabify, or remove the whitespace inserted by an electric key."
+ "Backspace-untabify, or remove the whitespace around the point inserted
+by an electric key."
(interactive "p")
(if (and cperl-auto-newline
(memq last-command '(cperl-electric-semi
cperl-electric-terminator
cperl-electric-lbrace))
- (memq (preceding-char) '(? ?\t ?\n)))
+ (memq (preceding-char) '(?\ ?\t ?\n)))
(let (p)
(if (eq last-command 'cperl-electric-lbrace)
(skip-chars-forward " \t\n"))
(setq p (point))
(skip-chars-backward " \t\n")
(delete-region (point) p))
- (backward-delete-char-untabify arg)))
+ (and (eq last-command 'cperl-electric-else)
+ ;; We are removing the whitespace *inside* cperl-electric-else
+ (setq this-command 'cperl-electric-else-really))
+ (if (and cperl-auto-newline
+ (eq last-command 'cperl-electric-else-really)
+ (memq (preceding-char) '(?\ ?\t ?\n)))
+ (let (p)
+ (skip-chars-forward " \t\n")
+ (setq p (point))
+ (skip-chars-backward " \t\n")
+ (delete-region (point) p))
+ (backward-delete-char-untabify arg))))
(defun cperl-inside-parens-p ()
(condition-case ()
@@ -1807,8 +2849,8 @@ If not, or if we are not at the end of marking range, would self-insert."
(defun cperl-indent-command (&optional whole-exp)
"Indent current line as Perl code, or in some cases insert a tab character.
-If `cperl-tab-always-indent' is non-nil (the default), always indent current line.
-Otherwise, indent the current line only if point is at the left margin
+If `cperl-tab-always-indent' is non-nil (the default), always indent current
+line. Otherwise, indent the current line only if point is at the left margin
or in the line's indentation; otherwise insert a tab.
A numeric argument, regardless of its value,
@@ -1816,6 +2858,7 @@ means indent rigidly all the lines of the expression starting after point
so that this line becomes properly indented.
The relative indentation among the lines of the expression are preserved."
(interactive "P")
+ (cperl-update-syntaxification (point) (point))
(if whole-exp
;; If arg, always indent this line as Perl
;; and shift remaining lines of expression the same amount.
@@ -1830,7 +2873,7 @@ The relative indentation among the lines of the expression are preserved."
(goto-char beg)
(forward-line 1)
(setq beg (point)))
- (if (> end beg)
+ (if (and shift-amt (> end beg))
(indent-code-rigidly beg end shift-amt "#")))
(if (and (not cperl-tab-always-indent)
(save-excursion
@@ -1839,18 +2882,18 @@ The relative indentation among the lines of the expression are preserved."
(insert-tab)
(cperl-indent-line))))
-(defun cperl-indent-line (&optional symbol)
+(defun cperl-indent-line (&optional parse-data)
"Indent current line as Perl code.
Return the amount the indentation changed by."
- (let (indent
- beg shift-amt
+ (let (indent i beg shift-amt
(case-fold-search nil)
(pos (- (point-max) (point))))
- (setq indent (cperl-calculate-indent nil symbol))
+ (setq indent (cperl-calculate-indent parse-data)
+ i indent)
(beginning-of-line)
(setq beg (point))
(cond ((or (eq indent nil) (eq indent t))
- (setq indent (current-indentation)))
+ (setq indent (current-indentation) i nil))
;;((eq indent t) ; Never?
;; (setq indent (cperl-calculate-indent-within-comment)))
;;((looking-at "[ \t]*#")
@@ -1869,8 +2912,9 @@ Return the amount the indentation changed by."
((= (following-char) ?{)
(setq indent (+ indent cperl-brace-offset))))))
(skip-chars-forward " \t")
- (setq shift-amt (- indent (current-column)))
- (if (zerop shift-amt)
+ (setq shift-amt (and i (- indent (current-column))))
+ (if (or (not shift-amt)
+ (zerop shift-amt))
(if (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos)))
(delete-region beg (point))
@@ -1882,7 +2926,7 @@ Return the amount the indentation changed by."
shift-amt))
(defun cperl-after-label ()
- ;; Returns true if the point is after label. Does not do save-excursion.
+ ;; Returns true if the point is after label. Does not do save-excursion.
(and (eq (preceding-char) ?:)
(memq (char-syntax (char-after (- (point) 2)))
'(?w ?_))
@@ -1893,14 +2937,16 @@ Return the amount the indentation changed by."
(defun cperl-get-state (&optional parse-start start-state)
;; returns list (START STATE DEPTH PRESTART), START is a good place
;; to start parsing, STATE is what is returned by
- ;; `parse-partial-sexp'. DEPTH is true is we are immediately after
- ;; end of block which contains START. PRESTART is the position
+ ;; `parse-partial-sexp'. DEPTH is true is we are immediately after
+ ;; end of block which contains START. PRESTART is the position
;; basing on which START was found.
(save-excursion
(let ((start-point (point)) depth state start prestart)
- (if parse-start
+ (if (and parse-start
+ (<= parse-start start-point))
(goto-char parse-start)
- (beginning-of-defun))
+ (beginning-of-defun)
+ (setq start-state nil))
(setq prestart (point))
(if start-state nil
;; Try to go out, if sub is not on the outermost level
@@ -1918,12 +2964,11 @@ Return the amount the indentation changed by."
(or state (setq state (parse-partial-sexp start start-point -1 nil start-state)))
(list start state depth prestart))))
-(defun cperl-block-p () ; Do not C-M-q ! One string contains ";" !
- ;; Positions is before ?\{. Checks whether it starts a block.
+(defun cperl-block-p () ; Do not C-M-q ! One string contains ";" !
+ ;; Positions is before ?\{. Checks whether it starts a block.
;; No save-excursion!
(cperl-backward-to-noncomment (point-min))
- ;;(skip-chars-backward " \t\n\f")
- (or (memq (preceding-char) (append ";){}$@&%\C-@" nil)) ; Or label! \C-@ at bobp
+ (or (memq (preceding-char) (append ";){}$@&%\C-@" nil)) ; Or label! \C-@ at bobp
; Label may be mixed up with `$blah :'
(save-excursion (cperl-after-label))
(and (memq (char-syntax (preceding-char)) '(?w ?_))
@@ -1931,7 +2976,7 @@ Return the amount the indentation changed by."
(backward-sexp)
;; Need take into account `bless', `return', `tr',...
(or (and (looking-at "[a-zA-Z0-9_:]+[ \t\n\f]*[{#]") ; Method call syntax
- (not (looking-at "\\(bless\\|return\\|qw\\|tr\\|[smy]\\)\\>")))
+ (not (looking-at "\\(bless\\|return\\|q[wqrx]?\\|tr\\|[smy]\\)\\>")))
(progn
(skip-chars-backward " \t\n\f")
(and (memq (char-syntax (preceding-char)) '(?w ?_))
@@ -1942,7 +2987,7 @@ Return the amount the indentation changed by."
(defvar cperl-look-for-prop '((pod in-pod) (here-doc-delim here-doc-group)))
-(defun cperl-calculate-indent (&optional parse-start symbol)
+(defun cperl-calculate-indent (&optional parse-data) ; was parse-start
"Return appropriate indentation for current line as Perl code.
In usual case returns an integer: the column to indent to.
Returns nil if line starts inside a string, t if in a comment."
@@ -1966,7 +3011,7 @@ Returns nil if line starts inside a string, t if in a comment."
p prop look-prop)
(cond
(in-pod
- ;; In the verbatim part, probably code example. What to do???
+ ;; In the verbatim part, probably code example. What to do???
)
(t
(save-excursion
@@ -1984,7 +3029,7 @@ Returns nil if line starts inside a string, t if in a comment."
(setq pre-indent-point (point)))))))
(goto-char pre-indent-point)
(let* ((case-fold-search nil)
- (s-s (cperl-get-state))
+ (s-s (cperl-get-state (car parse-data) (nth 1 parse-data)))
(start (nth 0 s-s))
(state (nth 1 s-s))
(containing-sexp (car (cdr state)))
@@ -1993,6 +3038,11 @@ Returns nil if line starts inside a string, t if in a comment."
(- (current-indentation)
(if (nth 2 s-s) cperl-indent-level 0))))
old-indent)
+ (if parse-data
+ (progn
+ (setcar parse-data pre-indent-point)
+ (setcar (cdr parse-data) state)
+ (setq old-indent (nth 2 parse-data))))
;; (or parse-start (null symbol)
;; (setq parse-start (symbol-value symbol)
;; start-indent (nth 2 parse-start)
@@ -2043,23 +3093,30 @@ Returns nil if line starts inside a string, t if in a comment."
;; in which case this line is the first argument decl.
(skip-chars-forward " \t")
(+ start-indent
- (if (= (following-char) ?{) cperl-continued-brace-offset 0)
+ (if (= char-after ?{) cperl-continued-brace-offset 0)
(progn
- (cperl-backward-to-noncomment (or parse-start (point-min)))
- ;;(skip-chars-backward " \t\f\n")
+ (cperl-backward-to-noncomment (or old-indent (point-min)))
;; Look at previous line that's at column 0
;; to determine whether we are in top-level decls
;; or function's arg decls. Set basic-indent accordingly.
;; Now add a little if this is a continuation line.
(if (or (bobp)
- (memq (preceding-char) (append " ;}" nil)) ; Was ?\)
+ (eq (preceding-char) ?\;)
+ ;; Had ?\) too
+ (and (eq (preceding-char) ?\})
+ (cperl-after-block-and-statement-beg start))
(memq char-after (append ")]}" nil))
(and (eq (preceding-char) ?\:) ; label
(progn
(forward-sexp -1)
(skip-chars-backward " \t")
(looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:"))))
- 0
+ (progn
+ (if (and parse-data
+ (not (eq char-after ?\C-j)))
+ (setcdr (cdr parse-data)
+ (list pre-indent-point)))
+ 0)
cperl-continued-statement-offset))))
((/= (char-after containing-sexp) ?{)
;; line is expression, not statement:
@@ -2071,7 +3128,7 @@ Returns nil if line starts inside a string, t if in a comment."
(skip-chars-forward " \t"))
(current-column))
((progn
- ;; Containing-expr starts with \{. Check whether it is a hash.
+ ;; Containing-expr starts with \{. Check whether it is a hash.
(goto-char containing-sexp)
(not (cperl-block-p)))
(goto-char (1+ containing-sexp))
@@ -2101,7 +3158,11 @@ Returns nil if line starts inside a string, t if in a comment."
(beginning-of-line)
(cperl-backward-to-noncomment containing-sexp))
;; Now we get the answer.
- (if (not (memq (preceding-char) (append ", ;}{" '(nil)))) ; Was ?\,
+ ;; Had \?, too:
+ (if (not (or (memq (preceding-char) (append " ;{" '(nil)))
+ (and (eq (preceding-char) ?\})
+ (cperl-after-block-and-statement-beg
+ containing-sexp)))) ; Was ?\,
;; This line is continuation of preceding line's statement;
;; indent `cperl-continued-statement-offset' more than the
;; previous line of the statement.
@@ -2194,9 +3255,9 @@ Returns nil if line starts inside a string, t if in a comment."
(looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]"))
(if (> (current-indentation) cperl-min-label-indent)
(- (current-indentation) cperl-label-offset)
- (cperl-calculate-indent
- (if (and parse-start (<= parse-start (point)))
- parse-start)))
+ ;; Do not move `parse-data', this should
+ ;; be quick anyway:
+ (cperl-calculate-indent))
(current-indentation))))))))))))))
(defvar cperl-indent-alist
@@ -2209,12 +3270,16 @@ Returns nil if line starts inside a string, t if in a comment."
"Alist of indentation rules for CPerl mode.
The values mean:
nil: do not indent;
- number: add this amount of indentation.")
+ number: add this amount of indentation.
+
+Not finished, not used.")
(defun cperl-where-am-i (&optional parse-start start-state)
;; Unfinished
"Return a list of lists ((TYPE POS)...) of good points before the point.
-POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'."
+POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'.
+
+Not finished, not used."
(save-excursion
(let* ((start-point (point))
(s-s (cperl-get-state))
@@ -2255,7 +3320,7 @@ POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'."
(point)))
(cons (list 'expression containing-sexp) res))))
((progn
- ;; Containing-expr starts with \{. Check whether it is a hash.
+ ;; Containing-expr starts with \{. Check whether it is a hash.
(goto-char containing-sexp)
(not (cperl-block-p)))
(setq res (cons (list 'expression-blanks
@@ -2354,9 +3419,7 @@ POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'."
(looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]"))
(if (> (current-indentation) cperl-min-label-indent)
(- (current-indentation) cperl-label-offset)
- (cperl-calculate-indent
- (if (and parse-start (<= parse-start (point)))
- parse-start)))
+ (cperl-calculate-indent))
(current-indentation))))))))
res)))
@@ -2390,13 +3453,6 @@ Returns true if comment is found."
(setq state (parse-partial-sexp (point) lim nil nil nil t))
; stop at comment
;; If fails (beginning-of-line inside sexp), then contains not-comment
- ;; Do simplified processing
- ;;(if (re-search-forward "[^$]#" lim 1)
- ;; (progn
- ;; (forward-char -1)
- ;; (skip-chars-backward " \t\n\f" lim))
- ;; (goto-char lim)) ; No `#' at all
- ;;)
(if (nth 4 state) ; After `#';
; (nth 2 state) can be
; beginning of m,s,qq and so
@@ -2411,7 +3467,7 @@ Returns true if comment is found."
"\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*"
lim 'move)
(setq stop-in t)))
- ((looking-at "\\(m\\|q\\([qxw]\\)?\\)\\>")
+ ((looking-at "\\(m\\|q\\([qxwr]\\)?\\)\\>")
(or (re-search-forward
"\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#"
lim 'move)
@@ -2435,6 +3491,14 @@ Returns true if comment is found."
(defvar cperl-st-sfence '(15)) ; String-fence
(defvar cperl-st-punct '(1))
(defvar cperl-st-word '(2))
+(defvar cperl-st-bra '(4 . ?\>))
+(defvar cperl-st-ket '(5 . ?\<))
+
+(defsubst cperl-modify-syntax-type (at how)
+ (if (< at (point-max))
+ (progn
+ (put-text-property at (1+ at) 'syntax-table how)
+ (put-text-property at (1+ at) 'rear-nonsticky t))))
(defun cperl-protect-defun-start (s e)
;; C code looks for "^\\s(" to skip comment backward in "hard" situations
@@ -2443,36 +3507,38 @@ Returns true if comment is found."
(while (re-search-forward "^\\s(" e 'to-end)
(put-text-property (1- (point)) (point) 'syntax-table cperl-st-punct))))
-(defun cperl-commentify (bb e string)
+(defun cperl-commentify (bb e string &optional noface)
(if cperl-use-syntax-table-text-property
- (progn
+ (if (eq noface 'n) ; Only immediate
+ nil
;; We suppose that e is _after_ the end of construction, as after eol.
(setq string (if string cperl-st-sfence cperl-st-cfence))
- (put-text-property bb (1+ bb) 'syntax-table string)
- (put-text-property bb (1+ bb) 'rear-nonsticky t)
- (put-text-property (1- e) e 'syntax-table string)
- (put-text-property (1- e) e 'rear-nonsticky t)
+ (cperl-modify-syntax-type bb string)
+ (cperl-modify-syntax-type (1- e) string)
(if (and (eq string cperl-st-sfence) (> (- e 2) bb))
(put-text-property (1+ bb) (1- e)
'syntax-table cperl-string-syntax-table))
- (cperl-protect-defun-start bb e))))
-
-(defun cperl-forward-re (is-2arg set-st st-l err-l argument
- &optional ostart oend)
- ;; Unfinished
+ (cperl-protect-defun-start bb e))
+ ;; Fontify
+ (or noface
+ (not cperl-pod-here-fontify)
+ (put-text-property bb e 'face (if string 'font-lock-string-face
+ 'font-lock-comment-face)))))
+(defvar cperl-starters '(( ?\( . ?\) )
+ ( ?\[ . ?\] )
+ ( ?\{ . ?\} )
+ ( ?\< . ?\> )))
+
+(defun cperl-forward-re (lim end is-2arg set-st st-l err-l argument
+ &optional ostart oend)
;; Works *before* syntax recognition is done
;; May modify syntax-type text property if the situation is too hard
- (let (b starter ender st i i2)
+ (let (b starter ender st i i2 go-forward)
(skip-chars-forward " \t")
;; ender means matching-char matcher.
(setq b (point)
starter (char-after b)
- ;; ender:
- ender (cdr (assoc starter '(( ?\( . ?\) )
- ( ?\[ . ?\] )
- ( ?\{ . ?\} )
- ( ?\< . ?\> )
- ))))
+ ender (cdr (assoc starter cperl-starters)))
;; What if starter == ?\\ ????
(if set-st
(if (car st-l)
@@ -2494,6 +3560,8 @@ Returns true if comment is found."
(modify-syntax-entry ender (concat ")" (list starter)) st)))
(condition-case bb
(progn
+ ;; We use `$' syntax class to find matching stuff, but $$
+ ;; is recognized the same as $, so we need to check this manually.
(if (and (eq starter (char-after (cperl-1+ b)))
(not ender))
;; $ has TeXish matching rules, so $$ equiv $...
@@ -2509,193 +3577,299 @@ Returns true if comment is found."
(forward-char -2)
(= 0 (% (skip-chars-backward "\\\\") 2)))
(forward-char -1)))
+ ;; Now we are after the first part.
(and is-2arg ; Have trailing part
(not ender)
(eq (following-char) starter) ; Empty trailing part
- (if (eq (char-syntax (following-char)) ?.)
- (setq is-2arg nil) ; Ignore the tail
- ;; Make trailing letter into punctuation
- (setq is-2arg nil) ; Ignore the tail
- (put-text-property (point) (1+ (point))
- 'syntax-table cperl-st-punct)
- (put-text-property (point) (1+ (point)) 'rear-nonsticky t)))
+ (progn
+ (or (eq (char-syntax (following-char)) ?.)
+ ;; Make trailing letter into punctuation
+ (cperl-modify-syntax-type (point) cperl-st-punct))
+ (setq is-2arg nil go-forward t))) ; Ignore the tail
(if is-2arg ; Not number => have second part
(progn
(setq i (point) i2 i)
(if ender
- (if (eq (char-syntax (following-char)) ?\ )
+ (if (memq (following-char) '(?\ ?\t ?\n ?\f))
(progn
- (while (looking-at "\\s *#")
- (beginning-of-line 2))
- (skip-chars-forward " \t\n\f")
+ (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
+ (goto-char (match-end 0))
+ (skip-chars-forward " \t\n\f"))
(setq i2 (point))))
(forward-char -1))
(modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st)
(if ender (modify-syntax-entry ender "." st))
(setq set-st nil)
- (setq
- ender
- (cperl-forward-re nil t st-l err-l argument starter ender)
- ender (nth 2 ender)))))
- (error (goto-char (point-max))
- (message
- "End of `%s%s%c ... %c' string not found: %s"
- argument
- (if ostart (format "%c ... %c" ostart (or oend ostart)) "")
- starter (or ender starter) bb)
- (or (car err-l) (setcar err-l b))))
+ (setq ender (cperl-forward-re lim end nil t st-l err-l
+ argument starter ender)
+ ender (nth 2 ender)))))
+ (error (goto-char lim)
+ (setq set-st nil)
+ (or end
+ (message
+ "End of `%s%s%c ... %c' string/RE not found: %s"
+ argument
+ (if ostart (format "%c ... %c" ostart (or oend ostart)) "")
+ starter (or ender starter) bb)
+ (or (car err-l) (setcar err-l b)))))
(if set-st
(progn
(modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st)
(if ender (modify-syntax-entry ender "." st))))
- (list i i2 ender starter)))
+ ;; i: have 2 args, after end of the first arg
+ ;; i2: start of the second arg, if any (before delim iff `ender').
+ ;; ender: the last arg bounded by parens-like chars, the second one of them
+ ;; starter: the starting delimiter of the first arg
+ ;; go-forward: has 2 args, and the second part is empth
+ (list i i2 ender starter go-forward)))
+
+(defvar font-lock-string-face)
+;;(defvar font-lock-reference-face)
+(defvar font-lock-constant-face)
+(defsubst cperl-postpone-fontification (b e type val &optional now)
+ ;; Do after syntactic fontification?
+ (if cperl-syntaxify-by-font-lock
+ (or now (put-text-property b e 'cperl-postpone (cons type val)))
+ (put-text-property b e type val)))
+
+;;; Here is how the global structures (those which cannot be
+;;; recognized locally) are marked:
+;; a) PODs:
+;; Start-to-end is marked `in-pod' ==> t
+;; Each non-literal part is marked `syntax-type' ==> `pod'
+;; Each literal part is marked `syntax-type' ==> `in-pod'
+;; b) HEREs:
+;; Start-to-end is marked `here-doc-group' ==> t
+;; The body is marked `syntax-type' ==> `here-doc'
+;; The delimiter is marked `syntax-type' ==> `here-doc-delim'
+;; a) FORMATs:
+;; After-initial-line--to-end is marked `syntax-type' ==> `format'
+
+(defun cperl-unwind-to-safe (before)
+ (let ((pos (point)))
+ (while (and pos (get-text-property pos 'syntax-type))
+ (setq pos (previous-single-property-change pos 'syntax-type))
+ (if pos
+ (if before
+ (progn
+ (goto-char (cperl-1- pos))
+ (beginning-of-line)
+ (setq pos (point)))
+ (goto-char (setq pos (cperl-1- pos))))
+ ;; Up to the start
+ (goto-char (point-min))))))
-(defun cperl-find-pods-heres (&optional min max)
+(defun cperl-find-pods-heres (&optional min max non-inter end ignore-max)
"Scans the buffer for hard-to-parse Perl constructions.
If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify
the sections using `cperl-pod-head-face', `cperl-pod-face',
`cperl-here-face'."
(interactive)
- (or min (setq min (point-min)))
+ (or min (setq min (point-min)
+ cperl-syntax-state nil
+ cperl-syntax-done-to min))
(or max (setq max (point-max)))
- (let (face head-face here-face b e bb tag qtag b1 e1 argument i c tail state
- (cperl-pod-here-fontify (eval cperl-pod-here-fontify))
- (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t)
- (modified (buffer-modified-p))
- (after-change-functions nil)
- (state-point (point-min))
- (st-l '(nil)) (err-l '(nil)) i2
- ;; Somehow font-lock may be not loaded yet...
- (font-lock-string-face (if (boundp 'font-lock-string-face)
- font-lock-string-face
- 'font-lock-string-face))
- (search
- (concat
- "\\(\\`\n?\\|\n\n\\)="
- "\\|"
- ;; One extra () before this:
- "<<"
- "\\("
- ;; First variant "BLAH" or just ``.
- "\\([\"'`]\\)"
- "\\([^\"'`\n]*\\)"
- "\\3"
- "\\|"
- ;; Second variant: Identifier or empty
- "\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)"
- ;; Check that we do not have <<= or << 30 or << $blah.
- "\\([^= \t$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)"
- "\\)"
- "\\|"
- ;; 1+6 extra () before this:
- "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$"
- (if cperl-use-syntax-table-text-property
- (concat
- "\\|"
- ;; 1+6+2=9 extra () before this:
- "\\<\\(q[wxq]?\\|[msy]\\|tr\\)\\>"
- "\\|"
- ;; 1+6+2+1=10 extra () before this:
- "\\([?/]\\)" ; /blah/ or ?blah?
- "\\|"
- ;; 1+6+2+1+1=11 extra () before this:
- "\\<sub\\>[ \t]*\\([a-zA-Z_:'0-9]+[ \t]*\\)?\\(([^()]*)\\)"
- "\\|"
- ;; 1+6+2+1+1+2=13 extra () before this:
- "\\$\\(['{]\\)"
- "\\|"
- ;; 1+6+2+1+1+2+1=14 extra () before this:
- "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'"
- ;; 1+6+2+1+1+2+1+1=15 extra () before this:
- "\\|"
- "__\\(END\\|DATA\\)__" ; Commented - does not help with indent...
- )
- ""))))
+ (let* (face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb
+ (cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend
+ (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t)
+ (modified (buffer-modified-p))
+ (after-change-functions nil)
+ (use-syntax-state (and cperl-syntax-state
+ (>= min (car cperl-syntax-state))))
+ (state-point (if use-syntax-state
+ (car cperl-syntax-state)
+ (point-min)))
+ (state (if use-syntax-state
+ (cdr cperl-syntax-state)))
+ (st-l '(nil)) (err-l '(nil)) i2
+ ;; Somehow font-lock may be not loaded yet...
+ (font-lock-string-face (if (boundp 'font-lock-string-face)
+ font-lock-string-face
+ 'font-lock-string-face))
+ (font-lock-constant-face (if (boundp 'font-lock-constant-face)
+ font-lock-constant-face
+ 'font-lock-constant-face))
+ (font-lock-function-name-face
+ (if (boundp 'font-lock-function-name-face)
+ font-lock-function-name-face
+ 'font-lock-function-name-face))
+ (font-lock-other-type-face
+ (if (boundp 'font-lock-other-type-face)
+ font-lock-other-type-face
+ 'font-lock-other-type-face))
+ (stop-point (if ignore-max
+ (point-max)
+ max))
+ (search
+ (concat
+ "\\(\\`\n?\\|\n\n\\)="
+ "\\|"
+ ;; One extra () before this:
+ "<<"
+ "\\(" ; 1 + 1
+ ;; First variant "BLAH" or just ``.
+ "\\([\"'`]\\)" ; 2 + 1
+ "\\([^\"'`\n]*\\)" ; 3 + 1
+ "\\3"
+ "\\|"
+ ;; Second variant: Identifier or \ID or empty
+ "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1
+ ;; Do not have <<= or << 30 or <<30 or << $blah.
+ ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1
+ "\\(\\)" ; To preserve count of pars :-( 6 + 1
+ "\\)"
+ "\\|"
+ ;; 1+6 extra () before this:
+ "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$"
+ (if cperl-use-syntax-table-text-property
+ (concat
+ "\\|"
+ ;; 1+6+2=9 extra () before this:
+ "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>"
+ "\\|"
+ ;; 1+6+2+1=10 extra () before this:
+ "\\([?/<]\\)" ; /blah/ or ?blah? or <file*glob>
+ "\\|"
+ ;; 1+6+2+1+1=11 extra () before this:
+ "\\<sub\\>[ \t]*\\([a-zA-Z_:'0-9]+[ \t]*\\)?\\(([^()]*)\\)"
+ "\\|"
+ ;; 1+6+2+1+1+2=13 extra () before this:
+ "\\$\\(['{]\\)"
+ "\\|"
+ ;; 1+6+2+1+1+2+1=14 extra () before this:
+ "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'"
+ ;; 1+6+2+1+1+2+1+1=15 extra () before this:
+ "\\|"
+ "__\\(END\\|DATA\\)__" ; Commented - does not help with indent...
+ )
+ ""))))
(unwind-protect
(progn
(save-excursion
- (message "Scanning for \"hard\" Perl constructions...")
- (if cperl-pod-here-fontify
+ (or non-inter
+ (message "Scanning for \"hard\" Perl constructions..."))
+ (and cperl-pod-here-fontify
;; We had evals here, do not know why...
(setq face cperl-pod-face
head-face cperl-pod-head-face
here-face cperl-here-face))
(remove-text-properties min max
- '(syntax-type t in-pod t syntax-table t))
+ '(syntax-type t in-pod t syntax-table t
+ cperl-postpone t))
;; Need to remove face as well...
(goto-char min)
- (if (and (eq system-type 'emx)
- (looking-at "extproc[ \t]")) ; Analogue of #!
- (cperl-commentify min
- (save-excursion (end-of-line) (point))
- nil))
- (while (re-search-forward search max t)
+ (and (eq system-type 'emx)
+ (looking-at "extproc[ \t]") ; Analogue of #!
+ (cperl-commentify min
+ (save-excursion (end-of-line) (point))
+ nil))
+ (while (and
+ (< (point) max)
+ (re-search-forward search max t))
+ (setq tmpend nil) ; Valid for most cases
(cond
((match-beginning 1) ; POD section
;; "\\(\\`\n?\\|\n\n\\)="
(if (looking-at "\n*cut\\>")
- (progn
- (message "=cut is not preceded by a pod section")
+ (if ignore-max
+ nil ; Doing a chunk only
+ (message "=cut is not preceded by a POD section")
(or (car err-l) (setcar err-l (point))))
(beginning-of-line)
- (setq b (point) bb b)
- (or (re-search-forward "\n\n=cut\\>" max 'toend)
+ (setq b (point)
+ bb b
+ tb (match-beginning 0)
+ b1 nil) ; error condition
+ ;; We do not search to max, since we may be called from
+ ;; some hook of fontification, and max is random
+ (or (re-search-forward "\n\n=cut\\>" stop-point 'toend)
(progn
- (message "Cannot find the end of a pod section")
+ (message "End of a POD section not marked by =cut")
+ (setq b1 t)
(or (car err-l) (setcar err-l b))))
(beginning-of-line 2) ; An empty line after =cut is not POD!
(setq e (point))
- (put-text-property b e 'in-pod t)
- (goto-char b)
- (while (re-search-forward "\n\n[ \t]" e t)
- ;; We start 'pod 1 char earlier to include the preceding line
- (beginning-of-line)
- (put-text-property (cperl-1- b) (point) 'syntax-type 'pod)
- (cperl-put-do-not-fontify b (point))
- ;;(put-text-property (max (point-min) (1- b))
- ;; (point) cperl-do-not-fontify t)
- (if cperl-pod-here-fontify (put-text-property b (point) 'face face))
- (re-search-forward "\n\n[^ \t\f\n]" e 'toend)
- (beginning-of-line)
- (setq b (point)))
- (put-text-property (cperl-1- (point)) e 'syntax-type 'pod)
- (cperl-put-do-not-fontify (point) e)
- ;;(put-text-property (max (point-min) (1- (point)))
- ;; e cperl-do-not-fontify t)
- (if cperl-pod-here-fontify
- (progn (put-text-property (point) e 'face face)
- (goto-char bb)
- (if (looking-at
- "=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$")
- (put-text-property
- (match-beginning 1) (match-end 1)
- 'face head-face))
- (while (re-search-forward
- ;; One paragraph
- "\n\n=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$"
- e 'toend)
- (put-text-property
- (match-beginning 1) (match-end 1)
- 'face head-face))))
- (cperl-commentify bb e nil)
- (goto-char e)
- (or (eq e (point-max))
- (forward-char -1)))) ; Prepare for immediate pod start.
+ (if (and b1 (eobp))
+ ;; Unrecoverable error
+ nil
+ (and (> e max)
+ (progn
+ (remove-text-properties
+ max e '(syntax-type t in-pod t syntax-table t
+ 'cperl-postpone t))
+ (setq tmpend tb)))
+ (put-text-property b e 'in-pod t)
+ (put-text-property b e 'syntax-type 'in-pod)
+ (goto-char b)
+ (while (re-search-forward "\n\n[ \t]" e t)
+ ;; We start 'pod 1 char earlier to include the preceding line
+ (beginning-of-line)
+ (put-text-property (cperl-1- b) (point) 'syntax-type 'pod)
+ (cperl-put-do-not-fontify b (point) t)
+ ;; mark the non-literal parts as PODs
+ (if cperl-pod-here-fontify
+ (cperl-postpone-fontification b (point) 'face face t))
+ (re-search-forward "\n\n[^ \t\f\n]" e 'toend)
+ (beginning-of-line)
+ (setq b (point)))
+ (put-text-property (cperl-1- (point)) e 'syntax-type 'pod)
+ (cperl-put-do-not-fontify (point) e t)
+ (if cperl-pod-here-fontify
+ (progn
+ ;; mark the non-literal parts as PODs
+ (cperl-postpone-fontification (point) e 'face face t)
+ (goto-char bb)
+ (if (looking-at
+ "=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$")
+ ;; mark the headers
+ (cperl-postpone-fontification
+ (match-beginning 1) (match-end 1)
+ 'face head-face))
+ (while (re-search-forward
+ ;; One paragraph
+ "\n\n=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$"
+ e 'toend)
+ ;; mark the headers
+ (cperl-postpone-fontification
+ (match-beginning 1) (match-end 1)
+ 'face head-face))))
+ (cperl-commentify bb e nil)
+ (goto-char e)
+ (or (eq e (point-max))
+ (forward-char -1))))) ; Prepare for immediate pod start.
;; Here document
;; We do only one here-per-line
- ;; 1 () ahead
- ;; "<<\\(\\([\"'`]\\)\\([^\"'`\n]*\\)\\3\\|\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)\\)"
+ ;; ;; One extra () before this:
+ ;;"<<"
+ ;; "\\(" ; 1 + 1
+ ;; ;; First variant "BLAH" or just ``.
+ ;; "\\([\"'`]\\)" ; 2 + 1
+ ;; "\\([^\"'`\n]*\\)" ; 3 + 1
+ ;; "\\3"
+ ;; "\\|"
+ ;; ;; Second variant: Identifier or \ID or empty
+ ;; "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1
+ ;; ;; Do not have <<= or << 30 or <<30 or << $blah.
+ ;; ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1
+ ;; "\\(\\)" ; To preserve count of pars :-( 6 + 1
+ ;; "\\)"
((match-beginning 2) ; 1 + 1
;; Abort in comment:
(setq b (point))
(setq state (parse-partial-sexp state-point b nil nil state)
- state-point b)
- (if ;;(save-excursion
- ;; (beginning-of-line)
- ;; (search-forward "#" b t))
- (or (nth 3 state) (nth 4 state))
- (goto-char (match-end 2))
+ state-point b
+ tb (match-beginning 0)
+ i (or (nth 3 state) (nth 4 state)))
+ (if i
+ (setq c t)
+ (setq c (and
+ (match-beginning 5)
+ (not (match-beginning 6)) ; Empty
+ (looking-at
+ "[ \t]*[=0-9$@%&(]"))))
+ (if c ; Not here-doc
+ nil ; Skip it.
(if (match-beginning 5) ;4 + 1
(setq b1 (match-beginning 5) ; 4 + 1
e1 (match-end 5)) ; 4 + 1
@@ -2704,21 +3878,23 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(setq tag (buffer-substring b1 e1)
qtag (regexp-quote tag))
(cond (cperl-pod-here-fontify
- (put-text-property b1 e1 'face font-lock-reference-face)
- (cperl-put-do-not-fontify b1 e1)))
+ ;; Highlight the starting delimiter
+ (cperl-postpone-fontification b1 e1 'face font-lock-constant-face)
+ (cperl-put-do-not-fontify b1 e1 t)))
(forward-line)
(setq b (point))
- (cond ((re-search-forward (concat "^" qtag "$") max 'toend)
+ ;; We do not search to max, since we may be called from
+ ;; some hook of fontification, and max is random
+ (cond ((re-search-forward (concat "^" qtag "$")
+ stop-point 'toend)
(if cperl-pod-here-fontify
(progn
- (put-text-property (match-beginning 0) (match-end 0)
- 'face font-lock-reference-face)
- (cperl-put-do-not-fontify b (match-end 0))
- ;;(put-text-property (max (point-min) (1- b))
- ;; (min (point-max)
- ;; (1+ (match-end 0)))
- ;; cperl-do-not-fontify t)
- (put-text-property b (match-beginning 0)
+ ;; Highlight the ending delimiter
+ (cperl-postpone-fontification (match-beginning 0) (match-end 0)
+ 'face font-lock-constant-face)
+ (cperl-put-do-not-fontify b (match-end 0) t)
+ ;; Highlight the HERE-DOC
+ (cperl-postpone-fontification b (match-beginning 0)
'face here-face)))
(setq e1 (cperl-1+ (match-end 0)))
(put-text-property b (match-beginning 0)
@@ -2728,7 +3904,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(put-text-property b e1
'here-doc-group t)
(cperl-commentify b e1 nil)
- (cperl-put-do-not-fontify b (match-end 0)))
+ (cperl-put-do-not-fontify b (match-end 0) t)
+ (if (> e1 max)
+ (setq tmpend tb)))
(t (message "End of here-document `%s' not found." tag)
(or (car err-l) (setcar err-l b))))))
;; format
@@ -2739,7 +3917,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
name (if (match-beginning 8) ; 7 + 1
(buffer-substring (match-beginning 8) ; 7 + 1
(match-end 8)) ; 7 + 1
- ""))
+ "")
+ tb (match-beginning 0))
(setq argument nil)
(if cperl-pod-here-fontify
(while (and (eq (forward-line) 0)
@@ -2756,39 +3935,34 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(setq b1 (point))
(setq argument (looking-at "^[^\n]*[@^]"))
(end-of-line)
- (put-text-property b1 (point)
+ ;; Highlight the format line
+ (cperl-postpone-fontification b1 (point)
'face font-lock-string-face)
(cperl-commentify b1 (point) nil)
- (cperl-put-do-not-fontify b1 (point)))))
- (re-search-forward (concat "^[.;]$") max 'toend))
+ (cperl-put-do-not-fontify b1 (point) t))))
+ ;; We do not search to max, since we may be called from
+ ;; some hook of fontification, and max is random
+ (re-search-forward "^[.;]$" stop-point 'toend))
(beginning-of-line)
- (if (looking-at "^[.;]$")
+ (if (looking-at "^\\.$") ; ";" is not supported yet
(progn
- (put-text-property (point) (+ (point) 2)
+ ;; Highlight the ending delimiter
+ (cperl-postpone-fontification (point) (+ (point) 2)
'face font-lock-string-face)
(cperl-commentify (point) (+ (point) 2) nil)
- (cperl-put-do-not-fontify (point) (+ (point) 2)))
+ (cperl-put-do-not-fontify (point) (+ (point) 2) t))
(message "End of format `%s' not found." name)
(or (car err-l) (setcar err-l b)))
(forward-line)
- (put-text-property b (point) 'syntax-type 'format)
-;;; (cond ((re-search-forward (concat "^[.;]$") max 'toend)
-;;; (if cperl-pod-here-fontify
-;;; (progn
-;;; (put-text-property b (match-end 0)
-;;; 'face font-lock-string-face)
-;;; (cperl-put-do-not-fontify b (match-end 0))))
-;;; (put-text-property b (match-end 0)
-;;; 'syntax-type 'format)
-;;; (cperl-put-do-not-fontify b (match-beginning 0)))
-;;; (t (message "End of format `%s' not found." name)))
- )
+ (if (> (point) max)
+ (setq tmpend tb))
+ (put-text-property b (point) 'syntax-type 'format))
;; Regexp:
((or (match-beginning 10) (match-beginning 11))
;; 1+6+2=9 extra () before this:
- ;; "\\<\\(q[wxq]?\\|[msy]\\|tr\\)\\>"
+ ;; "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>"
;; "\\|"
- ;; "\\([?/]\\)" ; /blah/ or ?blah?
+ ;; "\\([?/<]\\)" ; /blah/ or ?blah? or <file*glob>
(setq b1 (if (match-beginning 10) 10 11)
argument (buffer-substring
(match-beginning b1) (match-end b1))
@@ -2796,71 +3970,166 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
i b
c (char-after (match-beginning b1))
bb (char-after (1- (match-beginning b1))) ; tmp holder
- bb (and ; user variables/whatever
- (match-beginning 10)
- (or
- (memq bb '(?\$ ?\@ ?\% ?\*))
- (and (eq bb ?-) (eq c ?s)) ; -s file test
- (and (eq bb ?\&) ; &&m/blah/
- (not (eq (char-after
- (- (match-beginning b1) 2))
- ?\&))))))
+ bb (if (eq b1 10) ; user variables/whatever
+ (or
+ (memq bb '(?\$ ?\@ ?\% ?\* ?\#)) ; $#y
+ (and (eq bb ?-) (eq c ?s)) ; -s file test
+ (and (eq bb ?\&) ; &&m/blah/
+ (not (eq (char-after
+ (- (match-beginning b1) 2))
+ ?\&))))
+ ;; <file> or <$file>
+ (and (eq c ?\<)
+ (save-match-data
+ (looking-at
+ "\\s *\\$?\\([_a-zA-Z:][_a-zA-Z0-9:]*\\s *\\)?>"))))
+ tb (match-beginning 0))
+ (goto-char (match-beginning b1))
+ (cperl-backward-to-noncomment (point-min))
(or bb
- (if (eq b1 11) ; bare /blah/ or ?blah?
+ (if (eq b1 11) ; bare /blah/ or ?blah? or <foo>
(setq argument ""
- bb ; Not a regexp?
- (progn
- (goto-char (match-beginning b1))
- (cperl-backward-to-noncomment (point-min))
- (not (or (memq (preceding-char)
- (append (if (eq c ?\?)
- ;; $a++ ? 1 : 2
- "~{(=|&*!,;"
- "~{(=|&+-*!,;") nil))
- (and (eq (preceding-char) ?\})
- (cperl-after-block-p (point-min)))
- (and (eq (char-syntax (preceding-char)) ?w)
- (progn
- (forward-sexp -1)
+ bb ; Not a regexp?
+ (progn
+ (not
+ ;; What is below: regexp-p?
+ (and
+ (or (memq (preceding-char)
+ (append (if (eq c ?\?)
+ ;; $a++ ? 1 : 2
+ "~{(=|&*!,;"
+ "~{(=|&+-*!,;") nil))
+ (and (eq (preceding-char) ?\})
+ (cperl-after-block-p (point-min)))
+ (and (eq (char-syntax (preceding-char)) ?w)
+ (progn
+ (forward-sexp -1)
+;;; After these keywords `/' starts a RE. One should add all the
+;;; functions/builtins which expect an argument, but ...
+ (if (eq (preceding-char) ?-)
+ ;; -d ?foo? is a RE
+ (looking-at "[a-zA-Z]\\>")
(looking-at
- "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>")))
- (and (eq (preceding-char) ?.)
- (eq (char-after (- (point) 2)) ?.))
- (bobp))))
- b (1- b))))
+ "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>"))))
+ (and (eq (preceding-char) ?.)
+ (eq (char-after (- (point) 2)) ?.))
+ (bobp))
+ ;; m|blah| ? foo : bar;
+ (not
+ (and (eq c ?\?)
+ cperl-use-syntax-table-text-property
+ (not (bobp))
+ (progn
+ (forward-char -1)
+ (looking-at "\\s|")))))))
+ b (1- b))
+ ;; s y tr m
+ ;; Check for $a->y
+ (if (and (eq (preceding-char) ?>)
+ (eq (char-after (- (point) 2)) ?-))
+ ;; Not a regexp
+ (setq bb t))))
(or bb (setq state (parse-partial-sexp
state-point b nil nil state)
state-point b))
(goto-char b)
(if (or bb (nth 3 state) (nth 4 state))
(goto-char i)
- (skip-chars-forward " \t")
+ (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
+ (goto-char (match-end 0))
+ (skip-chars-forward " \t\n\f"))
;; qtag means two-arg matcher, may be reset to
;; 2 or 3 later if some special quoting is needed.
;; e1 means matching-char matcher.
(setq b (point)
- i (cperl-forward-re
- (string-match "^\\([sy]\\|tr\\)$" argument)
- t st-l err-l argument)
- i2 (nth 1 i) ; start of the second part
- e1 (nth 2 i) ; ender, true if matching second part
+ ;; has 2 args
+ i2 (string-match "^\\([sy]\\|tr\\)$" argument)
+ ;; We do not search to max, since we may be called from
+ ;; some hook of fontification, and max is random
+ i (cperl-forward-re stop-point end
+ i2
+ t st-l err-l argument)
+ ;; Note that if `go', then it is considered as 1-arg
+ b1 (nth 1 i) ; start of the second part
+ tag (nth 2 i) ; ender-char, true if second part
+ ; is with matching chars []
+ go (nth 4 i) ; There is a 1-char part after the end
i (car i) ; intermediate point
- tail (if (and i (not e1)) (1- (point))))
+ e1 (point) ; end
+ ;; Before end of the second part if non-matching: ///
+ tail (if (and i (not tag))
+ (1- e1))
+ e (if i i e1) ; end of the first part
+ qtag nil) ; need to preserve backslashitis
;; Commenting \\ is dangerous, what about ( ?
(and i tail
(eq (char-after i) ?\\)
- (setq i nil tail nil))
+ (setq qtag t))
(if (null i)
- (cperl-commentify b (point) t)
+ ;; Considered as 1arg form
+ (progn
+ (cperl-commentify b (point) t)
+ (and go
+ (setq e1 (1+ e1))
+ (forward-char 1)))
(cperl-commentify b i t)
(if (looking-at "\\sw*e") ; s///e
- (cperl-find-pods-heres i2 (1- (point)))
- (cperl-commentify i2 (point) t)
+ (progn
+ (and
+ ;; silent:
+ (cperl-find-pods-heres b1 (1- (point)) t end)
+ ;; Error
+ (goto-char (1+ max)))
+ (if (and tag (eq (preceding-char) ?\>))
+ (progn
+ (cperl-modify-syntax-type (1- (point)) cperl-st-ket)
+ (cperl-modify-syntax-type i cperl-st-bra))))
+ (cperl-commentify b1 (point) t)
+ (if qtag
+ (cperl-modify-syntax-type (1+ i) cperl-st-punct))
(setq tail nil)))
+ ;; Now: tail: if the second part is non-matching without ///e
(if (eq (char-syntax (following-char)) ?w)
(progn
(forward-word 1) ; skip modifiers s///s
- (if tail (cperl-commentify tail (point) t))))))
+ (if tail (cperl-commentify tail (point) t))
+ (cperl-postpone-fontification
+ e1 (point) 'face font-lock-other-type-face)))
+ ;; Check whether it is m// which means "previous match"
+ ;; and highlight differently
+ (if (and (eq e (+ 2 b))
+ (string-match "^\\([sm]?\\|qr\\)$" argument)
+ ;; <> is already filtered out
+ ;; split // *is* using zero-pattern
+ (save-excursion
+ (condition-case nil
+ (progn
+ (goto-char tb)
+ (forward-sexp -1)
+ (not (looking-at "split\\>")))
+ (error t))))
+ (cperl-postpone-fontification
+ b e 'face font-lock-function-name-face)
+ (if (or i2 ; Has 2 args
+ (and cperl-fontify-m-as-s
+ (or
+ (string-match "^\\(m\\|qr\\)$" argument)
+ (and (eq 0 (length argument))
+ (not (eq ?\< (char-after b)))))))
+ (progn
+ (cperl-postpone-fontification
+ b (1+ b) 'face font-lock-constant-face)
+ (cperl-postpone-fontification
+ (1- e) e 'face font-lock-constant-face))))
+ (if i2
+ (progn
+ (cperl-postpone-fontification
+ (1- e1) e1 'face font-lock-constant-face)
+ (if (assoc (char-after b) cperl-starters)
+ (cperl-postpone-fontification
+ b1 (1+ b1) 'face font-lock-constant-face))))
+ (if (> (point) max)
+ (setq tmpend tb))))
((match-beginning 13) ; sub with prototypes
(setq b (match-beginning 0))
(if (memq (char-after (1- b))
@@ -2877,22 +4146,19 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
;; 1+6+2+1+1+2=13 extra () before this:
;; "\\$\\(['{]\\)"
((and (match-beginning 14)
- (eq (preceding-char) ?\')) ; $'
+ (eq (preceding-char) ?\')) ; $'
(setq b (1- (point))
state (parse-partial-sexp
state-point (1- b) nil nil state)
state-point (1- b))
(if (nth 3 state) ; in string
- (progn
- (put-text-property (1- b) b 'syntax-table cperl-st-punct)
- (put-text-property (1- b) b 'rear-nonsticky t)))
+ (cperl-modify-syntax-type (1- b) cperl-st-punct))
(goto-char (1+ b)))
;; 1+6+2+1+1+2=13 extra () before this:
;; "\\$\\(['{]\\)"
((match-beginning 14) ; ${
(setq bb (match-beginning 0))
- (put-text-property bb (1+ bb) 'syntax-table cperl-st-punct)
- (put-text-property bb (1+ bb) 'rear-nonsticky t))
+ (cperl-modify-syntax-type bb cperl-st-punct))
;; 1+6+2+1+1+2+1=14 extra () before this:
;; "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'")
((match-beginning 15) ; old $abc'efg syntax
@@ -2917,124 +4183,43 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
nil
;; (put-text-property b (1+ bb) 'syntax-type 'pod) ; Cheat
(cperl-commentify b bb nil)
- )
- (goto-char bb))))
-;;; (while (re-search-forward "\\(\\`\n?\\|\n\n\\)=" max t)
-;;; (if (looking-at "\n*cut\\>")
-;;; (progn
-;;; (message "=cut is not preceded by a pod section")
-;;; (setq err (point)))
-;;; (beginning-of-line)
-
-;;; (setq b (point) bb b)
-;;; (or (re-search-forward "\n\n=cut\\>" max 'toend)
-;;; (message "Cannot find the end of a pod section"))
-;;; (beginning-of-line 3)
-;;; (setq e (point))
-;;; (put-text-property b e 'in-pod t)
-;;; (goto-char b)
-;;; (while (re-search-forward "\n\n[ \t]" e t)
-;;; (beginning-of-line)
-;;; (put-text-property b (point) 'syntax-type 'pod)
-;;; (cperl-put-do-not-fontify b (point))
-;;; ;;(put-text-property (max (point-min) (1- b))
-;;; ;; (point) cperl-do-not-fontify t)
-;;; (if cperl-pod-here-fontify (put-text-property b (point) 'face face))
-;;; (re-search-forward "\n\n[^ \t\f\n]" e 'toend)
-;;; (beginning-of-line)
-;;; (setq b (point)))
-;;; (put-text-property (point) e 'syntax-type 'pod)
-;;; (cperl-put-do-not-fontify (point) e)
-;;; ;;(put-text-property (max (point-min) (1- (point)))
-;;; ;; e cperl-do-not-fontify t)
-;;; (if cperl-pod-here-fontify
-;;; (progn (put-text-property (point) e 'face face)
-;;; (goto-char bb)
-;;; (if (looking-at
-;;; "=[a-zA-Z0-9]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$")
-;;; (put-text-property
-;;; (match-beginning 1) (match-end 1)
-;;; 'face head-face))
-;;; (while (re-search-forward
-;;; ;; One paragraph
-;;; "\n\n=[a-zA-Z0-9]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$"
-;;; e 'toend)
-;;; (put-text-property
-;;; (match-beginning 1) (match-end 1)
-;;; 'face head-face))))
-;;; (goto-char e)))
-;;; (goto-char min)
-;;; (while (re-search-forward
-;;; ;; We exclude \n to avoid misrecognition inside quotes.
-;;; "<<\\(\\([\"'`]\\)\\([^\"'`\n]*\\)\\2\\|\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)\\)"
-;;; max t)
-;;; (if (match-beginning 4)
-;;; (setq b1 (match-beginning 4)
-;;; e1 (match-end 4))
-;;; (setq b1 (match-beginning 3)
-;;; e1 (match-end 3)))
-;;; (setq tag (buffer-substring b1 e1)
-;;; qtag (regexp-quote tag))
-;;; (cond (cperl-pod-here-fontify
-;;; (put-text-property b1 e1 'face font-lock-reference-face)
-;;; (cperl-put-do-not-fontify b1 e1)))
-;;; (forward-line)
-;;; (setq b (point))
-;;; (cond ((re-search-forward (concat "^" qtag "$") max 'toend)
-;;; (if cperl-pod-here-fontify
-;;; (progn
-;;; (put-text-property (match-beginning 0) (match-end 0)
-;;; 'face font-lock-reference-face)
-;;; (cperl-put-do-not-fontify b (match-end 0))
-;;; ;;(put-text-property (max (point-min) (1- b))
-;;; ;; (min (point-max)
-;;; ;; (1+ (match-end 0)))
-;;; ;; cperl-do-not-fontify t)
-;;; (put-text-property b (match-beginning 0)
-;;; 'face here-face)))
-;;; (put-text-property b (match-beginning 0)
-;;; 'syntax-type 'here-doc)
-;;; (cperl-put-do-not-fontify b (match-beginning 0)))
-;;; (t (message "End of here-document `%s' not found." tag))))
-;;; (goto-char min)
-;;; (while (re-search-forward
-;;; "^[ \t]*format[ \t]*\\(\\([a-zA-Z0-9_]+[ \t]*\\)?\\)=[ \t]*$"
-;;; max t)
-;;; (setq b (point)
-;;; name (buffer-substring (match-beginning 1)
-;;; (match-end 1)))
-;;; (cond ((re-search-forward (concat "^[.;]$") max 'toend)
-;;; (if cperl-pod-here-fontify
-;;; (progn
-;;; (put-text-property b (match-end 0)
-;;; 'face font-lock-string-face)
-;;; (cperl-put-do-not-fontify b (match-end 0))))
-;;; (put-text-property b (match-end 0)
-;;; 'syntax-type 'format)
-;;; (cperl-put-do-not-fontify b (match-beginning 0)))
-;;; (t (message "End of format `%s' not found." name))))
-)
+ (setq end t))
+ (goto-char bb)))
+ (if (> (point) stop-point)
+ (progn
+ (if end
+ (message "Garbage after __END__/__DATA__ ignored")
+ (message "Unbalanced syntax found while scanning")
+ (or (car err-l) (setcar err-l b)))
+ (goto-char stop-point))))
+ (setq cperl-syntax-state (cons state-point state)
+ cperl-syntax-done-to (or tmpend (max (point) max))))
(if (car err-l) (goto-char (car err-l))
- (message "Scan for \"hard\" Perl constructions completed.")))
+ (or non-inter
+ (message "Scanning for \"hard\" Perl constructions... done"))))
(and (buffer-modified-p)
(not modified)
(set-buffer-modified-p nil))
- (set-syntax-table cperl-mode-syntax-table))))
+ (set-syntax-table cperl-mode-syntax-table))
+ (car err-l)))
(defun cperl-backward-to-noncomment (lim)
;; Stops at lim or after non-whitespace that is not in comment
- (let (stop p)
+ (let (stop p pr)
(while (and (not stop) (> (point) (or lim 1)))
(skip-chars-backward " \t\n\f" lim)
(setq p (point))
(beginning-of-line)
- (if (or (looking-at "^[ \t]*\\(#\\|$\\)")
- (progn (cperl-to-comment-or-eol) (bolp)))
- nil ; Only comment, skip
- ;; Else
- (skip-chars-backward " \t")
- (if (< p (point)) (goto-char p))
- (setq stop t)))))
+ (if (memq (setq pr (get-text-property (point) 'syntax-type))
+ '(pod here-doc here-doc-delim))
+ (cperl-unwind-to-safe nil)
+ (if (or (looking-at "^[ \t]*\\(#\\|$\\)")
+ (progn (cperl-to-comment-or-eol) (bolp)))
+ nil ; Only comment, skip
+ ;; Else
+ (skip-chars-backward " \t")
+ (if (< p (point)) (goto-char p))
+ (setq stop t))))))
(defun cperl-after-block-p (lim)
;; We suppose that the preceding char is }.
@@ -3043,17 +4228,25 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(progn
(forward-sexp -1)
(cperl-backward-to-noncomment lim)
- (or (eq (preceding-char) ?\) ) ; if () {}
- (and (eq (char-syntax (preceding-char)) ?w) ; else {}
- (progn
- (forward-sexp -1)
- (looking-at "\\(else\\|grep\\|map\\)\\>")))
- (cperl-after-expr-p lim)))
+ (or (eq (point) lim)
+ (eq (preceding-char) ?\) ) ; if () {} sub f () {}
+ (if (eq (char-syntax (preceding-char)) ?w) ; else {}
+ (save-excursion
+ (forward-sexp -1)
+ (or (looking-at "\\(else\\|grep\\|map\\)\\>")
+ ;; sub f {}
+ (progn
+ (cperl-backward-to-noncomment lim)
+ (and (eq (char-syntax (preceding-char)) ?w)
+ (progn
+ (forward-sexp -1)
+ (looking-at "sub\\>"))))))
+ (cperl-after-expr-p lim))))
(error nil))))
(defun cperl-after-expr-p (&optional lim chars test)
"Returns true if the position is good for start of expression.
-TEST is the expression to evaluate at the found position. If absent,
+TEST is the expression to evaluate at the found position. If absent,
CHARS is a string that contains good characters to have before us (however,
`}' is treated \"smartly\" if it is not in the list)."
(let (stop p
@@ -3069,7 +4262,8 @@ CHARS is a string that contains good characters to have before us (however,
(skip-chars-backward " \t")
(if (< p (point)) (goto-char p))
(setq stop t)))
- (or (bobp)
+ (or (bobp) ; ???? Needed
+ (eq (point) lim)
(progn
(if test (eval test)
(or (memq (preceding-char) (append (or chars "{;") nil))
@@ -3084,14 +4278,33 @@ CHARS is a string that contains good characters to have before us (however,
(goto-char (1+ lim)))
(skip-chars-forward " \t"))
+(defun cperl-after-block-and-statement-beg (lim)
+ ;; We assume that we are after ?\}
+ (and
+ (cperl-after-block-p lim)
+ (save-excursion
+ (forward-sexp -1)
+ (cperl-backward-to-noncomment (point-min))
+ (or (bobp)
+ (eq (point) lim)
+ (not (= (char-syntax (preceding-char)) ?w))
+ (progn
+ (forward-sexp -1)
+ (not
+ (looking-at
+ "\\(map\\|grep\\|printf?\\|system\\|exec\\|tr\\|s\\)\\>")))))))
+
(defvar innerloop-done nil)
(defvar last-depth nil)
(defun cperl-indent-exp ()
"Simple variant of indentation of continued-sexp.
-Should be slow. Will not indent comment if it starts at `comment-indent'
-or looks like continuation of the comment on the previous line."
+Should be slow. Will not indent comment if it starts at `comment-indent'
+or looks like continuation of the comment on the previous line.
+
+If `cperl-indent-region-fix-constructs', will improve spacing on
+conditional/loop constructs."
(interactive)
(save-excursion
(let ((tmp-end (progn (end-of-line) (point))) top done)
@@ -3110,68 +4323,263 @@ or looks like continuation of the comment on the previous line."
(setq done t)))
(goto-char tmp-end)
(setq tmp-end (point-marker)))
+ (if cperl-indent-region-fix-constructs
+ (cperl-fix-line-spacing tmp-end))
(cperl-indent-region (point) tmp-end))))
+(defun cperl-fix-line-spacing (&optional end parse-data)
+ "Improve whitespace in a conditional/loop construct."
+ (interactive)
+ (or end
+ (setq end (point-max)))
+ (let (p pp ml have-brace
+ (ee (save-excursion (end-of-line) (point)))
+ (cperl-indent-region-fix-constructs
+ (or cperl-indent-region-fix-constructs 1)))
+ (save-excursion
+ (beginning-of-line)
+ ;; }? continue
+ ;; blah; }
+ (if (not
+ (or (looking-at "[ \t]*\\(els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|until\\)")
+ (setq have-brace (save-excursion (search-forward "}" ee t)))))
+ nil ; Do not need to do anything
+ ;; Looking at:
+ ;; }
+ ;; else
+ (if (and cperl-merge-trailing-else
+ (looking-at
+ "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>"))
+ (progn
+ (search-forward "}")
+ (setq p (point))
+ (skip-chars-forward " \t\n")
+ (delete-region p (point))
+ (insert (make-string cperl-indent-region-fix-constructs ?\ ))
+ (beginning-of-line)))
+ ;; Looking at:
+ ;; } else
+ (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>")
+ (progn
+ (search-forward "}")
+ (delete-horizontal-space)
+ (insert (make-string cperl-indent-region-fix-constructs ?\ ))
+ (beginning-of-line)))
+ ;; Looking at:
+ ;; else {
+ (if (looking-at
+ "[ \t]*}?[ \t]*\\<\\(\\els\\(e\\|if\\)\\|continue\\|unless\\|if\\|while\\|for\\(each\\)?\\|until\\)\\>\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]")
+ (progn
+ (forward-word 1)
+ (delete-horizontal-space)
+ (insert (make-string cperl-indent-region-fix-constructs ?\ ))
+ (beginning-of-line)))
+ ;; Looking at:
+ ;; foreach my $var
+ (if (looking-at
+ "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\)\\(\t*\\|[ \t][ \t]+\\)[^ \t\n]")
+ (progn
+ (forward-word 2)
+ (delete-horizontal-space)
+ (insert (make-string cperl-indent-region-fix-constructs ?\ ))
+ (beginning-of-line)))
+ ;; Looking at:
+ ;; foreach my $var (
+ (if (looking-at
+ "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\)[ \t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]")
+ (progn
+ (forward-word 3)
+ (delete-horizontal-space)
+ (insert
+ (make-string cperl-indent-region-fix-constructs ?\ ))
+ (beginning-of-line)))
+ ;; Looking at:
+ ;; } foreach my $var () {
+ (if (looking-at
+ "[ \t]*\\(}[ \t]*\\)?\\<\\(\\els\\(e\\|if\\)\\|continue\\|if\\|unless\\|while\\|for\\(each\\)?\\(\\([ t]+\\(my\\|local\\)\\)?[ \t]*\\$[_a-zA-Z0-9]+\\)?\\|until\\)\\>\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{")
+ (progn
+ (setq ml (match-beginning 8))
+ (re-search-forward "[({]")
+ (forward-char -1)
+ (setq p (point))
+ (if (eq (following-char) ?\( )
+ (progn
+ (forward-sexp 1)
+ (setq pp (point)))
+ ;; after `else' or nothing
+ (if ml ; after `else'
+ (skip-chars-backward " \t\n")
+ (beginning-of-line))
+ (setq pp nil))
+ ;; Now after the sexp before the brace
+ ;; Multiline expr should be special
+ (setq ml (and pp (save-excursion (goto-char p)
+ (search-forward "\n" pp t))))
+ (if (and (or (not pp) (< pp end))
+ (looking-at "[ \t\n]*{"))
+ (progn
+ (cond
+ ((bolp) ; Were before `{', no if/else/etc
+ nil)
+ ((looking-at "\\(\t*\\| [ \t]+\\){")
+ (delete-horizontal-space)
+ (if (if ml
+ cperl-extra-newline-before-brace-multiline
+ cperl-extra-newline-before-brace)
+ (progn
+ (delete-horizontal-space)
+ (insert "\n")
+ (if (cperl-indent-line parse-data)
+ (cperl-fix-line-spacing end parse-data)))
+ (insert
+ (make-string cperl-indent-region-fix-constructs ?\ ))))
+ ((and (looking-at "[ \t]*\n")
+ (not (if ml
+ cperl-extra-newline-before-brace-multiline
+ cperl-extra-newline-before-brace)))
+ (setq pp (point))
+ (skip-chars-forward " \t\n")
+ (delete-region pp (point))
+ (insert
+ (make-string cperl-indent-region-fix-constructs ?\ ))))
+ ;; Now we are before `{'
+ (if (looking-at "[ \t\n]*{[ \t]*[^ \t\n#]")
+ (progn
+ (skip-chars-forward " \t\n")
+ (setq pp (point))
+ (forward-sexp 1)
+ (setq p (point))
+ (goto-char pp)
+ (setq ml (search-forward "\n" p t))
+ (if (or cperl-break-one-line-blocks-when-indent ml)
+ ;; not good: multi-line BLOCK
+ (progn
+ (goto-char (1+ pp))
+ (delete-horizontal-space)
+ (insert "\n")
+ (if (cperl-indent-line parse-data)
+ (cperl-fix-line-spacing end parse-data))))))))))
+ (beginning-of-line)
+ (setq p (point) pp (save-excursion (end-of-line) (point))) ; May be different from ee.
+ ;; Now check whether there is a hanging `}'
+ ;; Looking at:
+ ;; } blah
+ (if (and
+ cperl-fix-hanging-brace-when-indent
+ have-brace
+ (not (looking-at "[ \t]*}[ \t]*\\(\\<\\(els\\(if\\|e\\)\\|continue\\|while\\|until\\)\\>\\|$\\|#\\)"))
+ (condition-case nil
+ (progn
+ (up-list 1)
+ (if (and (<= (point) pp)
+ (eq (preceding-char) ?\} )
+ (cperl-after-block-and-statement-beg (point-min)))
+ t
+ (goto-char p)
+ nil))
+ (error nil)))
+ (progn
+ (forward-char -1)
+ (skip-chars-backward " \t")
+ (if (bolp)
+ ;; `}' was the first thing on the line, insert NL *after* it.
+ (progn
+ (cperl-indent-line parse-data)
+ (search-forward "}")
+ (delete-horizontal-space)
+ (insert "\n"))
+ (delete-horizontal-space)
+ (or (eq (preceding-char) ?\;)
+ (bolp)
+ (and (eq (preceding-char) ?\} )
+ (cperl-after-block-p (point-min)))
+ (insert ";"))
+ (insert "\n"))
+ (if (cperl-indent-line parse-data)
+ (cperl-fix-line-spacing end parse-data))
+ (beginning-of-line)))))))
+
+(defvar cperl-update-start) ; Do not need to make them local
+(defvar cperl-update-end)
+(defun cperl-delay-update-hook (beg end old-len)
+ (setq cperl-update-start (min beg (or cperl-update-start (point-max))))
+ (setq cperl-update-end (max end (or cperl-update-end (point-min)))))
+
(defun cperl-indent-region (start end)
"Simple variant of indentation of region in CPerl mode.
-Should be slow. Will not indent comment if it starts at `comment-indent'
+Should be slow. Will not indent comment if it starts at `comment-indent'
or looks like continuation of the comment on the previous line.
Indents all the lines whose first character is between START and END
-inclusive."
+inclusive.
+
+If `cperl-indent-region-fix-constructs', will improve spacing on
+conditional/loop constructs."
(interactive "r")
+ (cperl-update-syntaxification end end)
(save-excursion
- (let (st comm indent-info old-comm-indent new-comm-indent
- (pm 0) (imenu-scanning-message "Indenting... (%3d%%)"))
- (goto-char start)
- (setq old-comm-indent (and (cperl-to-comment-or-eol)
- (current-column))
- new-comm-indent old-comm-indent)
- (goto-char start)
- (or (bolp) (beginning-of-line 2))
- (or (fboundp 'imenu-progress-message)
- (message "Indenting... For feedback load `imenu'..."))
- (while (and (<= (point) end) (not (eobp))) ; bol to check start
- (and (fboundp 'imenu-progress-message)
- (imenu-progress-message
- pm (/ (* 100 (- (point) start)) (- end start -1))))
- (setq st (point)
- indent-info nil
- ) ; Believe indentation of the current
- (if (and (setq comm (looking-at "[ \t]*#"))
- (or (eq (current-indentation) (or old-comm-indent
- comment-column))
- (setq old-comm-indent nil)))
- (if (and old-comm-indent
- (= (current-indentation) old-comm-indent)
- (not (eq (get-text-property (point) 'syntax-type) 'pod)))
- (let ((comment-column new-comm-indent))
- (indent-for-comment)))
- (progn
- (cperl-indent-line 'indent-info)
- (or comm
- (progn
- (if (setq old-comm-indent (and (cperl-to-comment-or-eol)
- (not (eq (get-text-property (point) 'syntax-type) 'pod))
- (current-column)))
- (progn (indent-for-comment)
- (skip-chars-backward " \t")
- (skip-chars-backward "#")
- (setq new-comm-indent (current-column))))))))
- (beginning-of-line 2))
+ (let (cperl-update-start cperl-update-end (h-a-c after-change-functions))
+ (let (st comm old-comm-indent new-comm-indent p pp i
+ (indent-info (if cperl-emacs-can-parse
+ (list nil nil) ; Cannot use '(), since will modify
+ nil))
+ after-change-functions ; Speed it up!
+ (pm 0) (imenu-scanning-message "Indenting... (%3d%%)"))
+ (if h-a-c (add-hook 'after-change-functions 'cperl-delay-update-hook))
+ (goto-char start)
+ (setq old-comm-indent (and (cperl-to-comment-or-eol)
+ (current-column))
+ new-comm-indent old-comm-indent)
+ (goto-char start)
+ (setq end (set-marker (make-marker) end)) ; indentation changes pos
+ (or (bolp) (beginning-of-line 2))
+ (or (fboundp 'imenu-progress-message)
+ (message "Indenting... For feedback load `imenu'..."))
+ (while (and (<= (point) end) (not (eobp))) ; bol to check start
+ (and (fboundp 'imenu-progress-message)
+ (imenu-progress-message
+ pm (/ (* 100 (- (point) start)) (- end start -1))))
+ (setq st (point))
+ (if (and (setq comm (looking-at "[ \t]*#"))
+ (or (eq (current-indentation) (or old-comm-indent
+ comment-column))
+ (setq old-comm-indent nil)))
+ (if (and old-comm-indent
+ (= (current-indentation) old-comm-indent)
+ (not (eq (get-text-property (point) 'syntax-type) 'pod)))
+ (let ((comment-column new-comm-indent))
+ (indent-for-comment)))
+ (progn
+ (setq i (cperl-indent-line indent-info))
+ (or comm
+ (not i)
+ (progn
+ (if cperl-indent-region-fix-constructs
+ (cperl-fix-line-spacing end indent-info))
+ (if (setq old-comm-indent
+ (and (cperl-to-comment-or-eol)
+ (not (memq (get-text-property (point)
+ 'syntax-type)
+ '(pod here-doc)))
+ (current-column)))
+ (progn (indent-for-comment)
+ (skip-chars-backward " \t")
+ (skip-chars-backward "#")
+ (setq new-comm-indent (current-column))))))))
+ (beginning-of-line 2))
(if (fboundp 'imenu-progress-message)
- (imenu-progress-message pm 100)
- (message nil)))))
-
-;;(defun cperl-slash-is-regexp (&optional pos)
-;; (save-excursion
-;; (goto-char (if pos pos (1- (point))))
-;; (and
-;; (not (memq (get-text-property (point) 'face)
-;; '(font-lock-string-face font-lock-comment-face)))
-;; (cperl-after-expr-p nil nil '
-;; (or (looking-at "[^]a-zA-Z0-9_)}]")
-;; (eq (get-text-property (point) 'face)
-;; 'font-lock-keyword-face))))))
+ (imenu-progress-message pm 100)
+ (message nil)))
+ ;; Now run the update hooks
+ (if after-change-functions
+ (save-excursion
+ (if cperl-update-end
+ (progn
+ (goto-char cperl-update-end)
+ (insert " ")
+ (delete-char -1)
+ (goto-char cperl-update-start)
+ (insert " ")
+ (delete-char -1))))))))
;; Stolen from lisp-mode with a lot of improvements
@@ -3179,7 +4587,7 @@ inclusive."
"Like \\[fill-paragraph], but handle CPerl comments.
If any of the current line is a comment, fill the comment or the
block of it that point is in, preserving the comment's initial
-indentation and initial hashes. Behaves usually outside of comment."
+indentation and initial hashes. Behaves usually outside of comment."
(interactive "P")
(let (
;; Non-nil if the current line contains a comment.
@@ -3292,7 +4700,7 @@ indentation and initial hashes. Behaves usually outside of comment."
(defun cperl-imenu-addback (lst &optional isback name)
;; We suppose that the lst is a DAG, unless the first element only
- ;; loops back, and ISBACK is set. Thus this function cannot be
+ ;; loops back, and ISBACK is set. Thus this function cannot be
;; applied twice without ISBACK set.
(cond ((not cperl-imenu-addback) lst)
(t
@@ -3319,14 +4727,16 @@ indentation and initial hashes. Behaves usually outside of comment."
packages ends-ranges p
(prev-pos 0) char fchar index index1 name (end-range 0) package)
(goto-char (point-min))
- (imenu-progress-message prev-pos 0)
+ (if noninteractive
+ (message "Scanning Perl for index")
+ (imenu-progress-message prev-pos 0))
;; Search for the function
(progn ;;save-match-data
(while (re-search-forward
(or regexp imenu-example--function-name-regexp-perl)
nil t)
- (imenu-progress-message prev-pos)
- ;;(backward-up-list 1)
+ (or noninteractive
+ (imenu-progress-message prev-pos))
(cond
((and ; Skip some noise if building tags
(match-beginning 2) ; package or sub
@@ -3395,7 +4805,8 @@ indentation and initial hashes. Behaves usually outside of comment."
(setq index1 (cons (concat "=" name) (cdr index)))
(push index index-pod-alist)
(push index1 index-unsorted-alist)))))
- (imenu-progress-message prev-pos 100)
+ (or noninteractive
+ (imenu-progress-message prev-pos 100))
(setq index-alist
(if (default-value 'imenu-sort-function)
(sort index-alist (default-value 'imenu-sort-function))
@@ -3464,36 +4875,58 @@ indentation and initial hashes. Behaves usually outside of comment."
cperl-compilation-error-regexp-alist)))
-(defvar cperl-faces-init nil)
-
(defun cperl-windowed-init ()
"Initialization under windowed version."
- (add-hook 'font-lock-mode-hook
- (function
- (lambda ()
- (if (or
- (eq major-mode 'perl-mode)
- (eq major-mode 'cperl-mode))
- (progn
- (or cperl-faces-init (cperl-init-faces))))))))
+ (if (or (featurep 'ps-print) cperl-faces-init)
+ ;; Need to init anyway:
+ (or cperl-faces-init (cperl-init-faces))
+ (add-hook 'font-lock-mode-hook
+ (function
+ (lambda ()
+ (if (or
+ (eq major-mode 'perl-mode)
+ (eq major-mode 'cperl-mode))
+ (progn
+ (or cperl-faces-init (cperl-init-faces)))))))
+ (if (fboundp 'eval-after-load)
+ (eval-after-load
+ "ps-print"
+ '(or cperl-faces-init (cperl-init-faces))))))
+
+(defun cperl-load-font-lock-keywords ()
+ (or cperl-faces-init (cperl-init-faces))
+ perl-font-lock-keywords)
+
+(defun cperl-load-font-lock-keywords-1 ()
+ (or cperl-faces-init (cperl-init-faces))
+ perl-font-lock-keywords-1)
+
+(defun cperl-load-font-lock-keywords-2 ()
+ (or cperl-faces-init (cperl-init-faces))
+ perl-font-lock-keywords-2)
(defvar perl-font-lock-keywords-1 nil
- "Additional expressions to highlight in Perl mode. Minimal set.")
+ "Additional expressions to highlight in Perl mode. Minimal set.")
(defvar perl-font-lock-keywords nil
- "Additional expressions to highlight in Perl mode. Default set.")
+ "Additional expressions to highlight in Perl mode. Default set.")
(defvar perl-font-lock-keywords-2 nil
- "Additional expressions to highlight in Perl mode. Maximal set")
+ "Additional expressions to highlight in Perl mode. Maximal set")
+
+(defvar font-lock-background-mode)
+(defvar font-lock-display-type)
+(defun cperl-init-faces-weak ()
+ ;; Allow `cperl-find-pods-heres' to run.
+ (or (boundp 'font-lock-constant-face)
+ (setq font-lock-constant-face 'font-lock-constant-face)))
(defun cperl-init-faces ()
- (condition-case nil
+ (condition-case errs
(progn
(require 'font-lock)
(and (fboundp 'font-lock-fontify-anchored-keywords)
(featurep 'font-lock-extra)
- (message "You have an obsolete package `font-lock-extra'. Install `choose-color'."))
+ (message "You have an obsolete package `font-lock-extra'. Install `choose-color'."))
(let (t-font-lock-keywords t-font-lock-keywords-1 font-lock-anchored)
- ;;(defvar cperl-font-lock-enhanced nil
- ;; "Set to be non-nil if font-lock allows active highlights.")
(if (fboundp 'font-lock-fontify-anchored-keywords)
(setq font-lock-anchored t))
(setq
@@ -3532,7 +4965,7 @@ indentation and initial hashes. Behaves usually outside of comment."
;; "getservbyport" "getservent" "getsockname"
;; "getsockopt" "glob" "gmtime" "gt" "hex" "index" "int"
;; "ioctl" "join" "kill" "lc" "lcfirst" "le" "length"
- ;; "link" "listen" "localtime" "log" "lstat" "lt"
+ ;; "link" "listen" "localtime" "lock" "log" "lstat" "lt"
;; "mkdir" "msgctl" "msgget" "msgrcv" "msgsnd" "ne"
;; "not" "oct" "open" "opendir" "or" "ord" "pack" "pipe"
;; "quotemeta" "rand" "read" "readdir" "readline"
@@ -3564,7 +4997,7 @@ indentation and initial hashes. Behaves usually outside of comment."
"ent\\)\\|gr\\(ent\\|nam\\|gid\\)\\)\\)\\)\\|"
"hex\\|i\\(n\\(t\\|dex\\)\\|octl\\)\\|join\\|kill\\|"
"l\\(i\\(sten\\|nk\\)\\|stat\\|c\\(\\|first\\)\\|t\\|e"
- "\\(\\|ngth\\)\\|o\\(caltime\\|g\\)\\)\\|m\\(sg\\(rcv\\|snd\\|"
+ "\\(\\|ngth\\)\\|o\\(c\\(altime\\|k\\)\\|g\\)\\)\\|m\\(sg\\(rcv\\|snd\\|"
"ctl\\|get\\)\\|kdir\\)\\|n\\(e\\|ot\\)\\|o\\(pen\\(\\|dir\\)\\|"
"r\\(\\|d\\)\\|ct\\)\\|p\\(ipe\\|ack\\)\\|quotemeta\\|"
"r\\(index\\|and\\|mdir\\|e\\(quire\\|ad\\(pipe\\|\\|lin"
@@ -3600,7 +5033,7 @@ indentation and initial hashes. Behaves usually outside of comment."
"END\\|for\\(\\|each\\|mat\\)\\|g\\(rep\\|oto\\)\\|if\\|keys\\|"
"l\\(ast\\|ocal\\)\\|m\\(ap\\|y\\)\\|n\\(ext\\|o\\)\\|"
"p\\(ackage\\|rint\\(\\|f\\)\\|ush\\|o\\(p\\|s\\)\\)\\|"
- "q\\(\\|q\\|w\\|x\\)\\|re\\(turn\\|do\\)\\|s\\(pli\\(ce\\|t\\)\\|"
+ "q\\(\\|q\\|w\\|x\\|r\\)\\|re\\(turn\\|do\\)\\|s\\(pli\\(ce\\|t\\)\\|"
"calar\\|tudy\\|ub\\|hift\\|ort\\)\\|t\\(r\\|ie\\)\\|"
"u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|"
"while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually
@@ -3630,12 +5063,12 @@ indentation and initial hashes. Behaves usually outside of comment."
(1 font-lock-string-face t))))
(t '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
2 font-lock-string-face t)))
- '("[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1
+ '("[\[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1
font-lock-string-face t)
'("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1
- font-lock-reference-face) ; labels
+ font-lock-constant-face) ; labels
'("\\<\\(continue\\|next\\|last\\|redo\\|goto\\)\\>[ \t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets
- 2 font-lock-reference-face)
+ 2 font-lock-constant-face)
(cond ((featurep 'font-lock-extra)
'("^[ \t]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?"
(3 font-lock-variable-name-face)
@@ -3661,15 +5094,15 @@ indentation and initial hashes. Behaves usually outside of comment."
'(
("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1
(if (eq (char-after (match-beginning 2)) ?%)
- font-lock-other-emphasized-face
- font-lock-emphasized-face)
+ cperl-hash-face
+ cperl-array-face)
t) ; arrays and hashes
("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)"
1
(if (= (- (match-end 2) (match-beginning 2)) 1)
(if (eq (char-after (match-beginning 3)) ?{)
- font-lock-other-emphasized-face
- font-lock-emphasized-face) ; arrays and hashes
+ cperl-hash-face
+ cperl-array-face) ; arrays and hashes
font-lock-variable-name-face) ; Just to put something
t)
;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2")
@@ -3680,14 +5113,19 @@ indentation and initial hashes. Behaves usually outside of comment."
;; (if (cperl-slash-is-regexp)
;; font-lock-function-name-face 'default) nil t))
)))
- (setq perl-font-lock-keywords-1 t-font-lock-keywords
+ (setq perl-font-lock-keywords-1
+ (if cperl-syntaxify-by-font-lock
+ (cons 'cperl-fontify-update
+ t-font-lock-keywords)
+ t-font-lock-keywords)
perl-font-lock-keywords perl-font-lock-keywords-1
perl-font-lock-keywords-2 (append
- t-font-lock-keywords
+ perl-font-lock-keywords-1
t-font-lock-keywords-1)))
(if (fboundp 'ps-print-buffer) (cperl-ps-print-init))
(if (or (featurep 'choose-color) (featurep 'font-lock-extra))
- (font-lock-require-faces
+ (eval ; Avoid a warning
+ '(font-lock-require-faces
(list
;; Color-light Color-dark Gray-light Gray-dark Mono
(list 'font-lock-comment-face
@@ -3733,7 +5171,7 @@ indentation and initial hashes. Behaves usually outside of comment."
nil
[nil nil t t t]
)
- (list 'font-lock-reference-face
+ (list 'font-lock-constant-face
["CadetBlue" "Aquamarine" "Gray50" "LightGray"]
nil
[nil nil t t t]
@@ -3748,105 +5186,114 @@ indentation and initial hashes. Behaves usually outside of comment."
[nil nil t t]
[nil nil t t t]
)
- (list 'font-lock-emphasized-face
+ (list 'cperl-array-face
["blue" "yellow" nil "Gray80"]
["lightyellow2" ("navy" "os2blue" "darkgreen")
"gray90"]
t
nil
nil)
- (list 'font-lock-other-emphasized-face
+ (list 'cperl-hash-face
["red" "red" nil "Gray80"]
["lightyellow2" ("navy" "os2blue" "darkgreen")
"gray90"]
t
t
- nil)))
+ nil))))
+ ;; Do it the dull way, without choose-color
(defvar cperl-guessed-background nil
"Display characteristics as guessed by cperl.")
- (or (fboundp 'x-color-defined-p)
- (defalias 'x-color-defined-p
- (cond ((fboundp 'color-defined-p) 'color-defined-p)
- ;; XEmacs >= 19.12
- ((fboundp 'valid-color-name-p) 'valid-color-name-p)
- ;; XEmacs 19.11
- (t 'x-valid-color-name-p))))
- (defvar font-lock-reference-face 'font-lock-reference-face)
- (defvar font-lock-variable-name-face 'font-lock-variable-name-face)
- (or (boundp 'font-lock-type-face)
- (defconst font-lock-type-face
- 'font-lock-type-face
- "Face to use for data types.")
- )
- (or (boundp 'font-lock-other-type-face)
- (defconst font-lock-other-type-face
- 'font-lock-other-type-face
- "Face to use for data types from another group.")
- )
- (if (not cperl-xemacs-p) nil
- (or (boundp 'font-lock-comment-face)
- (defconst font-lock-comment-face
- 'font-lock-comment-face
- "Face to use for comments.")
- )
- (or (boundp 'font-lock-keyword-face)
- (defconst font-lock-keyword-face
- 'font-lock-keyword-face
- "Face to use for keywords.")
- )
- (or (boundp 'font-lock-function-name-face)
- (defconst font-lock-function-name-face
- 'font-lock-function-name-face
- "Face to use for function names.")
- )
- )
- ;;(if (featurep 'font-lock)
- (if (face-equal font-lock-type-face font-lock-comment-face)
- (defconst font-lock-type-face
- 'font-lock-type-face
- "Face to use for basic data types.")
- )
-;;; (if (fboundp 'eval-after-load)
-;;; (eval-after-load "font-lock"
-;;; '(if (face-equal font-lock-type-face
-;;; font-lock-comment-face)
-;;; (defconst font-lock-type-face
-;;; 'font-lock-type-face
-;;; "Face to use for basic data types.")
-;;; ))) ; This does not work :-( Why?!
-;;; ; Workaround: added to font-lock-m-h
-;;; )
- (or (boundp 'font-lock-other-emphasized-face)
- (defconst font-lock-other-emphasized-face
- 'font-lock-other-emphasized-face
- "Face to use for another type of emphasizing.")
- )
- (or (boundp 'font-lock-emphasized-face)
- (defconst font-lock-emphasized-face
- 'font-lock-emphasized-face
- "Face to use for emphasizing.")
- )
+;; (or (fboundp 'x-color-defined-p)
+;; (defalias 'x-color-defined-p
+;; (cond ((fboundp 'color-defined-p) 'color-defined-p)
+;; ;; XEmacs >= 19.12
+;; ((fboundp 'valid-color-name-p) 'valid-color-name-p)
+;; ;; XEmacs 19.11
+;; (t 'x-valid-color-name-p))))
+ (cperl-force-face font-lock-constant-face
+ "Face for constant and label names")
+ (cperl-force-face font-lock-variable-name-face
+ "Face for variable names")
+ (cperl-force-face font-lock-type-face
+ "Face for data types")
+ (cperl-force-face font-lock-other-type-face
+ "Face for data types from another group")
+ (cperl-force-face font-lock-comment-face
+ "Face for comments")
+ (cperl-force-face font-lock-keyword-face
+ "Face for keywords")
+ (cperl-force-face font-lock-function-name-face
+ "Face for function names")
+ (cperl-force-face cperl-hash-face
+ "Face for hashes")
+ (cperl-force-face cperl-array-face
+ "Face for arrays")
+ ;;(defvar font-lock-constant-face 'font-lock-constant-face)
+ ;;(defvar font-lock-variable-name-face 'font-lock-variable-name-face)
+ ;;(or (boundp 'font-lock-type-face)
+ ;; (defconst font-lock-type-face
+ ;; 'font-lock-type-face
+ ;; "Face to use for data types."))
+ ;;(or (boundp 'font-lock-other-type-face)
+ ;; (defconst font-lock-other-type-face
+ ;; 'font-lock-other-type-face
+ ;; "Face to use for data types from another group."))
+ ;;(if (not cperl-xemacs-p) nil
+ ;; (or (boundp 'font-lock-comment-face)
+ ;; (defconst font-lock-comment-face
+ ;; 'font-lock-comment-face
+ ;; "Face to use for comments."))
+ ;; (or (boundp 'font-lock-keyword-face)
+ ;; (defconst font-lock-keyword-face
+ ;; 'font-lock-keyword-face
+ ;; "Face to use for keywords."))
+ ;; (or (boundp 'font-lock-function-name-face)
+ ;; (defconst font-lock-function-name-face
+ ;; 'font-lock-function-name-face
+ ;; "Face to use for function names.")))
+ (if (and
+ (not (cperl-is-face 'cperl-array-face))
+ (cperl-is-face 'font-lock-emphasized-face))
+ (copy-face 'font-lock-emphasized-face 'cperl-array-face))
+ (if (and
+ (not (cperl-is-face 'cperl-hash-face))
+ (cperl-is-face 'font-lock-other-emphasized-face))
+ (copy-face 'font-lock-other-emphasized-face
+ 'cperl-hash-face))
+ ;;(or (boundp 'cperl-hash-face)
+ ;; (defconst cperl-hash-face
+ ;; 'cperl-hash-face
+ ;; "Face to use for hashes."))
+ ;;(or (boundp 'cperl-array-face)
+ ;; (defconst cperl-array-face
+ ;; 'cperl-array-face
+ ;; "Face to use for arrays."))
;; Here we try to guess background
(let ((background
(if (boundp 'font-lock-background-mode)
font-lock-background-mode
'light))
(face-list (and (fboundp 'face-list) (face-list)))
- is-face)
- (fset 'is-face
- (cond ((fboundp 'find-face)
- (symbol-function 'find-face))
- (face-list
- (function (lambda (face) (member face face-list))))
- (t
- (function (lambda (face) (boundp face))))))
+ ;; cperl-is-face
+ )
+;;;; (fset 'cperl-is-face
+;;;; (cond ((fboundp 'find-face)
+;;;; (symbol-function 'find-face))
+;;;; (face-list
+;;;; (function (lambda (face) (member face face-list))))
+;;;; (t
+;;;; (function (lambda (face) (boundp face))))))
(defvar cperl-guessed-background
(if (and (boundp 'font-lock-display-type)
(eq font-lock-display-type 'grayscale))
'gray
background)
"Background as guessed by CPerl mode")
- (if (is-face 'font-lock-type-face) nil
+ (if (and
+ (not (cperl-is-face 'font-lock-constant-face))
+ (cperl-is-face 'font-lock-reference-face))
+ (copy-face 'font-lock-reference-face 'font-lock-constant-face))
+ (if (cperl-is-face 'font-lock-type-face) nil
(copy-face 'default 'font-lock-type-face)
(cond
((eq background 'light)
@@ -3861,7 +5308,7 @@ indentation and initial hashes. Behaves usually outside of comment."
"pink")))
(t
(set-face-background 'font-lock-type-face "gray90"))))
- (if (is-face 'font-lock-other-type-face)
+ (if (cperl-is-face 'font-lock-other-type-face)
nil
(copy-face 'font-lock-type-face 'font-lock-other-type-face)
(cond
@@ -3875,7 +5322,7 @@ indentation and initial hashes. Behaves usually outside of comment."
(if (x-color-defined-p "orchid1")
"orchid1"
"orange")))))
- (if (is-face 'font-lock-other-emphasized-face) nil
+ (if (cperl-is-face 'font-lock-other-emphasized-face) nil
(copy-face 'bold-italic 'font-lock-other-emphasized-face)
(cond
((eq background 'light)
@@ -3893,7 +5340,7 @@ indentation and initial hashes. Behaves usually outside of comment."
"darkgreen"
"dark green"))))
(t (set-face-background 'font-lock-other-emphasized-face "gray90"))))
- (if (is-face 'font-lock-emphasized-face) nil
+ (if (cperl-is-face 'font-lock-emphasized-face) nil
(copy-face 'bold 'font-lock-emphasized-face)
(cond
((eq background 'light)
@@ -3909,12 +5356,12 @@ indentation and initial hashes. Behaves usually outside of comment."
"darkgreen"
"dark green"))))
(t (set-face-background 'font-lock-emphasized-face "gray90"))))
- (if (is-face 'font-lock-variable-name-face) nil
+ (if (cperl-is-face 'font-lock-variable-name-face) nil
(copy-face 'italic 'font-lock-variable-name-face))
- (if (is-face 'font-lock-reference-face) nil
- (copy-face 'italic 'font-lock-reference-face))))
+ (if (cperl-is-face 'font-lock-constant-face) nil
+ (copy-face 'italic 'font-lock-constant-face))))
(setq cperl-faces-init t))
- (error nil)))
+ (error (message "cperl-init-faces (ignored): %s" errs))))
(defun cperl-ps-print-init ()
@@ -3927,11 +5374,13 @@ indentation and initial hashes. Behaves usually outside of comment."
(append '(font-lock-emphasized-face
font-lock-keyword-face
font-lock-variable-name-face
+ font-lock-constant-face
font-lock-reference-face
font-lock-other-emphasized-face)
ps-bold-faces))
(setq ps-italic-faces
(append '(font-lock-other-type-face
+ font-lock-constant-face
font-lock-reference-face
font-lock-other-emphasized-face)
ps-italic-faces))
@@ -3945,32 +5394,115 @@ indentation and initial hashes. Behaves usually outside of comment."
(if (cperl-enable-font-lock) (cperl-windowed-init))
+(defconst cperl-styles-entries
+ '(cperl-indent-level cperl-brace-offset cperl-continued-brace-offset
+ cperl-label-offset cperl-extra-newline-before-brace
+ cperl-merge-trailing-else
+ cperl-continued-statement-offset))
+
+(defconst cperl-style-alist
+ '(("CPerl" ; =GNU without extra-newline-before-brace
+ (cperl-indent-level . 2)
+ (cperl-brace-offset . 0)
+ (cperl-continued-brace-offset . 0)
+ (cperl-label-offset . -2)
+ (cperl-extra-newline-before-brace . nil)
+ (cperl-merge-trailing-else . t)
+ (cperl-continued-statement-offset . 2))
+ ("PerlStyle" ; CPerl with 4 as indent
+ (cperl-indent-level . 4)
+ (cperl-brace-offset . 0)
+ (cperl-continued-brace-offset . 0)
+ (cperl-label-offset . -4)
+ (cperl-extra-newline-before-brace . nil)
+ (cperl-merge-trailing-else . t)
+ (cperl-continued-statement-offset . 4))
+ ("GNU"
+ (cperl-indent-level . 2)
+ (cperl-brace-offset . 0)
+ (cperl-continued-brace-offset . 0)
+ (cperl-label-offset . -2)
+ (cperl-extra-newline-before-brace . t)
+ (cperl-merge-trailing-else . nil)
+ (cperl-continued-statement-offset . 2))
+ ("K&R"
+ (cperl-indent-level . 5)
+ (cperl-brace-offset . 0)
+ (cperl-continued-brace-offset . -5)
+ (cperl-label-offset . -5)
+ ;;(cperl-extra-newline-before-brace . nil) ; ???
+ (cperl-merge-trailing-else . nil)
+ (cperl-continued-statement-offset . 5))
+ ("BSD"
+ (cperl-indent-level . 4)
+ (cperl-brace-offset . 0)
+ (cperl-continued-brace-offset . -4)
+ (cperl-label-offset . -4)
+ ;;(cperl-extra-newline-before-brace . nil) ; ???
+ (cperl-continued-statement-offset . 4))
+ ("C++"
+ (cperl-indent-level . 4)
+ (cperl-brace-offset . 0)
+ (cperl-continued-brace-offset . -4)
+ (cperl-label-offset . -4)
+ (cperl-continued-statement-offset . 4)
+ (cperl-merge-trailing-else . nil)
+ (cperl-extra-newline-before-brace . t))
+ ("Current")
+ ("Whitesmith"
+ (cperl-indent-level . 4)
+ (cperl-brace-offset . 0)
+ (cperl-continued-brace-offset . 0)
+ (cperl-label-offset . -4)
+ ;;(cperl-extra-newline-before-brace . nil) ; ???
+ (cperl-continued-statement-offset . 4)))
+ "(Experimental) list of variables to set to get a particular indentation style.
+Should be used via `cperl-set-style' or via CPerl menu.")
+
(defun cperl-set-style (style)
"Set CPerl-mode variables to use one of several different indentation styles.
The arguments are a string representing the desired style.
-Available styles are GNU, K&R, BSD and Whitesmith."
+The list of styles is in `cperl-style-alist', available styles
+are GNU, K&R, BSD, C++ and Whitesmith.
+
+The current value of style is memorized (unless there is a memorized
+data already), may be restored by `cperl-set-style-back'.
+
+Chosing \"Current\" style will not change style, so this may be used for
+side-effect of memorizing only."
(interactive
(let ((list (mapcar (function (lambda (elt) (list (car elt))))
- c-style-alist)))
+ cperl-style-alist)))
(list (completing-read "Enter style: " list nil 'insist))))
- (let ((style (cdr (assoc style c-style-alist))) setting str sym)
+ (or cperl-old-style
+ (setq cperl-old-style
+ (mapcar (function
+ (lambda (name)
+ (cons name (eval name))))
+ cperl-styles-entries)))
+ (let ((style (cdr (assoc style cperl-style-alist))) setting str sym)
(while style
(setq setting (car style) style (cdr style))
- (setq str (symbol-name (car setting)))
- (and (string-match "^c-" str)
- (setq str (concat "cperl-" (substring str 2)))
- (setq sym (intern-soft str))
- (boundp sym)
- (set sym (cdr setting))))))
+ (set (car setting) (cdr setting)))))
+
+(defun cperl-set-style-back ()
+ "Restore a style memorised by `cperl-set-style'."
+ (interactive)
+ (or cperl-old-style (error "The style was not changed"))
+ (let (setting)
+ (while cperl-old-style
+ (setq setting (car cperl-old-style)
+ cperl-old-style (cdr cperl-old-style))
+ (set (car setting) (cdr setting)))))
(defun cperl-check-syntax ()
(interactive)
(require 'mode-compile)
- (let ((perl-dbg-flags "-wc"))
- (mode-compile)))
+ (let ((perl-dbg-flags (concat cperl-extra-perl-args " -wc")))
+ (eval '(mode-compile)))) ; Avoid a warning
(defun cperl-info-buffer (type)
- ;; Returns buffer with documentation. Creates if missing.
+ ;; Returns buffer with documentation. Creates if missing.
;; If TYPE, this vars buffer.
;; Special care is taken to not stomp over an existing info buffer
(let* ((bname (if type "*info-perl-var*" "*info-perl*"))
@@ -4250,6 +5782,27 @@ in subdirectories too."
(message "Parentheses will %sbe auto-doubled now."
(if (cperl-val 'cperl-electric-parens) "" "not ")))
+(defun cperl-toggle-autohelp ()
+ "Toggle the state of automatic help message in CPerl mode.
+See `cperl-lazy-help-time' too."
+ (interactive)
+ (if (fboundp 'run-with-idle-timer)
+ (progn
+ (if cperl-lazy-installed
+ (eval '(cperl-lazy-unstall))
+ (cperl-lazy-install))
+ (message "Perl help messages will %sbe automatically shown now."
+ (if cperl-lazy-installed "" "not ")))
+ (message "Cannot automatically show Perl help messages - run-with-idle-timer missing.")))
+
+(defun cperl-toggle-construct-fix ()
+ "Toggle whether `indent-region'/`indent-sexp' fix whitespace too."
+ (interactive)
+ (setq cperl-indent-region-fix-constructs
+ (not cperl-indent-region-fix-constructs))
+ (message "indent-region/indent-sexp will %sbe automatically fix whitespace."
+ (if cperl-indent-region-fix-constructs "" "not ")))
+
;;;; Tags file creation.
(defvar cperl-tmp-buffer " *cperl-tmp*")
@@ -4271,13 +5824,16 @@ in subdirectories too."
(let ((index-alist '())
(prev-pos 0) index index1 name package prefix)
(goto-char (point-min))
- (imenu-progress-message prev-pos 0)
+ (if noninteractive
+ (message "Scanning XSUB for index")
+ (imenu-progress-message prev-pos 0))
;; Search for the function
(progn ;;save-match-data
(while (re-search-forward
"^\\([ \t]*MODULE\\>[^\n]*\\<PACKAGE[ \t]*=[ \t]*\\([a-zA-Z_][a-zA-Z_0-9:]*\\)\\>\\|\\([a-zA-Z_][a-zA-Z_0-9]*\\)(\\|[ \t]*BOOT:\\)"
nil t)
- (imenu-progress-message prev-pos)
+ (or noninteractive
+ (imenu-progress-message prev-pos))
(cond
((match-beginning 2) ; SECTION
(setq package (buffer-substring (match-beginning 2) (match-end 2)))
@@ -4305,24 +5861,24 @@ in subdirectories too."
(setq index (imenu-example--name-and-position))
(setcar index (concat package "::BOOT:"))
(push index index-alist)))))
- (imenu-progress-message prev-pos 100)
- ;;(setq index-alist
- ;; (if (default-value 'imenu-sort-function)
- ;; (sort index-alist (default-value 'imenu-sort-function))
- ;; (nreverse index-alist)))
+ (or noninteractive
+ (imenu-progress-message prev-pos 100))
index-alist))
-(defun cperl-find-tags (file xs)
- (let (ind (b (get-buffer cperl-tmp-buffer)) lst elt pos ret
+(defun cperl-find-tags (file xs topdir)
+ (let (ind (b (get-buffer cperl-tmp-buffer)) lst elt pos ret rel
(cperl-pod-here-fontify nil))
(save-excursion
(if b (set-buffer b)
(cperl-setup-tmp-buf))
(erase-buffer)
(setq file (car (insert-file-contents file)))
- (message "Scanning file %s..." file)
- (if cperl-use-syntax-table-text-property-for-tags
- (cperl-find-pods-heres))
+ (message "Scanning file %s ..." file)
+ (if (and cperl-use-syntax-table-text-property-for-tags
+ (not xs))
+ (condition-case err ; after __END__ may have garbage
+ (cperl-find-pods-heres)
+ (error (message "While scanning for syntax: %s" err))))
(if xs
(setq lst (cperl-xsub-scan))
(setq ind (imenu-example--create-perl-index))
@@ -4370,19 +5926,43 @@ in subdirectories too."
lst))))))
(setq pos (point))
(goto-char 1)
- (insert "\f\n" file "," (number-to-string (1- pos)) "\n")
+ (setq rel file)
+ ;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties
+ (set-text-properties 0 (length rel) nil rel)
+ (and (equal topdir (substring rel 0 (length topdir)))
+ (setq rel (substring file (length topdir))))
+ (insert "\f\n" rel "," (number-to-string (1- pos)) "\n")
(setq ret (buffer-substring 1 (point-max)))
(erase-buffer)
- (message "Scanning file %s finished" file)
+ (or noninteractive
+ (message "Scanning file %s finished" file))
ret)))
-(defun cperl-write-tags (&optional file erase recurse dir inbuffer)
+(defun cperl-add-tags-recurse-noxs ()
+ "Add to TAGS data for Perl and XSUB files in the current directory and kids.
+Use as
+ emacs -batch -q -no-site-file -l emacs/cperl-mode.el \
+ -f cperl-add-tags-recurse
+"
+ (cperl-write-tags nil nil t t nil t))
+
+(defun cperl-add-tags-recurse ()
+ "Add to TAGS file data for Perl files in the current directory and kids.
+Use as
+ emacs -batch -q -no-site-file -l emacs/cperl-mode.el \
+ -f cperl-add-tags-recurse
+"
+ (cperl-write-tags nil nil t t))
+
+(defun cperl-write-tags (&optional file erase recurse dir inbuffer noxs topdir)
;; If INBUFFER, do not select buffer, and do not save
;; If ERASE is `ignore', do not erase, and do not try to delete old info.
(require 'etags)
(if file nil
(setq file (if dir default-directory (buffer-file-name)))
(if (and (not dir) (buffer-modified-p)) (error "Save buffer first!")))
+ (or topdir
+ (setq topdir default-directory))
(let ((tags-file-name "TAGS")
(case-fold-search (eq system-type 'emx))
xs)
@@ -4407,28 +5987,31 @@ in subdirectories too."
nil)
((not (file-directory-p file))
(if (string-match cperl-scan-files-regexp file)
- (cperl-write-tags file erase recurse nil t)))
+ (cperl-write-tags file erase recurse nil t noxs topdir)))
((not recurse) nil)
- (t (cperl-write-tags file erase recurse t t)))))
+ (t (cperl-write-tags file erase recurse t t noxs topdir)))))
files))
)
(t
(setq xs (string-match "\\.xs$" file))
- (cond ((eq erase 'ignore) (goto-char (point-max)))
- (erase (erase-buffer))
- (t
- (goto-char 1)
- (if (search-forward (concat "\f\n" file ",") nil t)
- (progn
- (search-backward "\f\n")
- (delete-region (point)
- (save-excursion
- (forward-char 1)
- (if (search-forward "\f\n" nil 'toend)
- (- (point) 2)
- (point-max)))))
- (goto-char (point-max)))))
- (insert (cperl-find-tags file xs))))
+ (if (not (and xs noxs))
+ (progn
+ (cond ((eq erase 'ignore) (goto-char (point-max)))
+ (erase (erase-buffer))
+ (t
+ (goto-char 1)
+ (if (search-forward (concat "\f\n" file ",") nil t)
+ (progn
+ (search-backward "\f\n")
+ (delete-region (point)
+ (save-excursion
+ (forward-char 1)
+ (if (search-forward "\f\n"
+ nil 'toend)
+ (- (point) 2)
+ (point-max)))))
+ (goto-char (point-max)))))
+ (insert (cperl-find-tags file xs topdir))))))
(if inbuffer nil ; Delegate to the caller
(save-buffer 0) ; No backup
(if (fboundp 'initialize-new-tags-table) ; Do we need something special in XEmacs?
@@ -4543,7 +6126,7 @@ One may build such TAGS files from CPerl mode menu."
(if (eq update -999) (cperl-tags-hier-init t)))
(defun cperl-tags-treeify (to level)
- ;; cadr of `to' is read-write. On start it is a cons
+ ;; cadr of `to' is read-write. On start it is a cons
(let* ((regexp (concat "^\\(" (mapconcat
'identity
(make-list level "[_a-zA-Z0-9]+")
@@ -4670,14 +6253,17 @@ One may build such TAGS files from CPerl mode menu."
"[a-zA-Z0-9_][|&][a-zA-Z0-9_$]" ; abc|def abc&def are often used.
"&[(a-zA-Z0-9_$]" ; &subroutine &(var->field)
"<\\$?\\sw+\\(\\.\\sw+\\)?>" ; <IN> <stdin.h>
- "-[a-zA-Z][ \t]+[_$\"'`]" ; -f file
+ "-[a-zA-Z][ \t]+[_$\"'`a-zA-Z]" ; -f file, -t STDIN
"-[0-9]" ; -5
"\\+\\+" ; ++var
"--" ; --var
".->" ; a->b
"->" ; a SPACE ->b
"\\[-" ; a[-1]
+ "\\\\[&$@*\\\\]" ; \&func
"^=" ; =head
+ "\\$." ; $|
+ "<<[a-zA-Z_'\"`]" ; <<FOO, <<'FOO'
"||"
"&&"
"[CBIXSLFZ]<\\(\\sw\\|\\s \\|\\s_\\|[\n]\\)*>" ; C<code like text>
@@ -4828,7 +6414,7 @@ Currently it is tuned to C and Perl syntax."
(defun cperl-get-help ()
"Get one-line docs on the symbol at the point.
The data for these docs is a little bit obsolete and may be in fact longer
-than a line. Your contribution to update/shorten it is appreciated."
+than a line. Your contribution to update/shorten it is appreciated."
(interactive)
(save-match-data ; May be called "inside" query-replace
(save-excursion
@@ -4899,10 +6485,10 @@ than a line. Your contribution to update/shorten it is appreciated."
! ... Logical negation.
... != ... Numeric inequality.
... !~ ... Search pattern, substitution, or translation (negated).
-$! In numeric context: errno. In a string context: error string.
+$! In numeric context: errno. In a string context: error string.
$\" The separator which joins elements of arrays interpolated in strings.
-$# The output format for printed numbers. Initial value is %.20g.
-$$ Process number of this script. Changes in the fork()ed child process.
+$# The output format for printed numbers. Initial value is %.15g or close.
+$$ Process number of this script. Changes in the fork()ed child process.
$% The current page number of the currently selected output channel.
The following variables are always local to the current block:
@@ -4928,11 +6514,11 @@ $, The output field separator for the print operator.
$- The number of lines left on the page.
$. The current input line number of the last filehandle that was read.
$/ The input record separator, newline by default.
-$0 Name of the file containing the perl script being executed. May be set.
+$0 Name of the file containing the perl script being executed. May be set.
$: String may be broken after these characters to fill ^-lines in a format.
-$; Subscript separator for multi-dim array emulation. Default \"\\034\".
+$; Subscript separator for multi-dim array emulation. Default \"\\034\".
$< The real uid of this process.
-$= The page length of the current output channel. Default is 60 lines.
+$= The page length of the current output channel. Default is 60 lines.
$> The effective uid of this process.
$? The status returned by the last ``, pipe close or `system'.
$@ The perl error message from the last eval or do @var{EXPR} command.
@@ -4947,14 +6533,15 @@ $^E Information about the last system error other than that provided by $!.
$^F The highest system file descriptor, ordinarily 2.
$^H The current set of syntax checks enabled by `use strict'.
$^I The value of the in-place edit extension (perl -i option).
-$^L What formats output to perform a formfeed. Default is \f.
+$^L What formats output to perform a formfeed. Default is \f.
+$^M A buffer for emergency memory allocation when running out of memory.
$^O The operating system name under which this copy of Perl was built.
$^P Internal debugging flag.
-$^T The time the script was started. Used by -A/-M/-C file tests.
+$^T The time the script was started. Used by -A/-M/-C file tests.
$^W True if warnings are requested (perl -w flag).
$^X The name under which perl was invoked (argv[0] in C-speech).
$_ The default input and pattern-searching space.
-$| Auto-flush after write/print on the current output channel? Default 0.
+$| Auto-flush after write/print on current output channel? Default 0.
$~ The name of the current report format.
... % ... Modulo division.
... %= ... Modulo division assignment.
@@ -4967,8 +6554,8 @@ $~ The name of the current report format.
... &= ... Bitwise and assignment.
... * ... Multiplication.
... ** ... Exponentiation.
-*NAME Glob: all objects refered by NAME. *NAM1 = *NAM2 aliases NAM1 to NAM2.
-&NAME(arg0, ...) Subroutine call. Arguments go to @_.
+*NAME Glob: all objects refered by NAME. *NAM1 = *NAM2 aliases NAM1 to NAM2.
+&NAME(arg0, ...) Subroutine call. Arguments go to @_.
... + ... Addition. +EXPR Makes EXPR into scalar context.
++ Auto-increment (magical on strings). ++EXPR EXPR++
... += ... Addition assignment.
@@ -5010,8 +6597,8 @@ $~ The name of the current report format.
... /= ... Division assignment.
/PATTERN/ioxsmg Pattern match.
... < ... Numeric less than. <pattern> Glob. See <NAME>, <> as well.
-<NAME> Reads line from filehandle NAME. NAME must be bareword/dollar-bareword.
-<pattern> Glob. (Unless pattern is bareword/dollar-bareword - see <NAME>)
+<NAME> Reads line from filehandle NAME (a bareword or dollar-bareword).
+<pattern> Glob (Unless pattern is bareword/dollar-bareword - see <NAME>).
<> Reads line from union of files in @ARGV (= command line) and STDIN.
... << ... Bitwise shift left. << start of HERE-DOCUMENT.
... <= ... Numeric less than or equal to.
@@ -5027,23 +6614,23 @@ $~ The name of the current report format.
?PATTERN? One-time pattern match.
@ARGV Command line arguments (not including the command name - see $0).
@INC List of places to look for perl scripts during do/include/use.
-@_ Parameter array for subroutines. Also used by split unless in array context.
+@_ Parameter array for subroutines. Also used by split unless in array context.
\\ Creates reference to what follows, like \$var, or quotes non-\w in strings.
\\0 Octal char, e.g. \\033.
-\\E Case modification terminator. See \\Q, \\L, and \\U.
-\\L Lowercase until \\E . See also \l, lc.
-\\U Upcase until \\E . See also \u, uc.
-\\Q Quote metacharacters until \\E . See also quotemeta.
+\\E Case modification terminator. See \\Q, \\L, and \\U.
+\\L Lowercase until \\E . See also \l, lc.
+\\U Upcase until \\E . See also \u, uc.
+\\Q Quote metacharacters until \\E . See also quotemeta.
\\a Alarm character (octal 007).
\\b Backspace character (octal 010).
\\c Control character, e.g. \\c[ .
\\e Escape character (octal 033).
\\f Formfeed character (octal 014).
-\\l Lowercase the next character. See also \\L and \\u, lcfirst.
+\\l Lowercase the next character. See also \\L and \\u, lcfirst.
\\n Newline character (octal 012 on most systems).
\\r Return character (octal 015 on most systems).
\\t Tab character (octal 011).
-\\u Upcase the next character. See also \\U and \\l, ucfirst.
+\\u Upcase the next character. See also \\U and \\l, ucfirst.
\\x Hex character, e.g. \\x1b.
... ^ ... Bitwise exclusive or.
__END__ Ends program source.
@@ -5051,7 +6638,7 @@ __DATA__ Ends program source.
__FILE__ Current (source) filename.
__LINE__ Current line in current source.
__PACKAGE__ Current package.
-ARGV Default multi-file input filehandle. <ARGV> is a synonym for <>.
+ARGV Default multi-file input filehandle. <ARGV> is a synonym for <>.
ARGVOUT Output filehandle with -i flag.
BEGIN { ... } Immediately executed (during compilation) piece of code.
END { ... } Pseudo-subroutine executed after the script finishes.
@@ -5071,7 +6658,7 @@ close(FILEHANDLE)
closedir(DIRHANDLE)
... cmp ... String compare.
connect(SOCKET,NAME)
-continue of { block } continue { block }. Is executed after `next' or at end.
+continue of { block } continue { block }. Is executed after `next' or at end.
cos(EXPR)
crypt(PLAINTEXT,SALT)
dbmclose(%HASH)
@@ -5130,7 +6717,6 @@ getsockname(SOCKET)
getsockopt(SOCKET,LEVEL,OPTNAME)
gmtime(EXPR)
goto LABEL
-grep(EXPR,LIST)
... gt ... String greater than.
hex(EXPR)
if (EXPR) { ... } [ elsif (EXPR) { ... } ... ] [ else { ... } ] or EXPR if EXPR
@@ -5258,7 +6844,7 @@ y/SEARCHLIST/REPLACEMENTLIST/
... | ... Bitwise or.
... || ... Logical or.
~ ... Unary bitwise complement.
-#! OS interpreter indicator. If contains `perl', used for options, and -x.
+#! OS interpreter indicator. If contains `perl', used for options, and -x.
AUTOLOAD {...} Shorthand for `sub AUTOLOAD {...}'.
CORE:: Prefix to access builtin function if imported sub obscures it.
SUPER:: Prefix to lookup for a method in @ISA classes.
@@ -5272,18 +6858,19 @@ DESTROY Shorthand for `sub DESTROY {...}'.
abs [ EXPR ] absolute value
... and ... Low-precedence synonym for &&.
bless REFERENCE [, PACKAGE] Makes reference into an object of a package.
-chomp [LIST] Strips $/ off LIST/$_. Returns count. Special if $/ eq ''!
+chomp [LIST] Strips $/ off LIST/$_. Returns count. Special if $/ eq ''!
chr Converts a number to char with the same ordinal.
else Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}.
elsif Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}.
exists $HASH{KEY} True if the key exists.
-format [NAME] = Start of output format. Ended by a single dot (.) on a line.
+format [NAME] = Start of output format. Ended by a single dot (.) on a line.
formline PICTURE, LIST Backdoor into \"format\" processing.
glob EXPR Synonym of <EXPR>.
lc [ EXPR ] Returns lowercased EXPR.
lcfirst [ EXPR ] Returns EXPR with lower-cased first letter.
+grep EXPR,LIST or grep {BLOCK} LIST Filters LIST via EXPR/BLOCK.
map EXPR, LIST or map {BLOCK} LIST Applies EXPR/BLOCK to elts of LIST.
-no PACKAGE [SYMBOL1, ...] Partial reverse for `use'. Runs `unimport' method.
+no PACKAGE [SYMBOL1, ...] Partial reverse for `use'. Runs `unimport' method.
not ... Low-precedence synonym for ! - negation.
... or ... Low-precedence synonym for ||.
pos STRING Set/Get end-position of the last match over this string, see \\G.
@@ -5423,6 +7010,9 @@ prototype \&SUB Returns prototype of the function given a reference.
(goto-char (+ 2 tmp))
(forward-sexp 1)
(cperl-beautify-regexp-piece (point) m t))
+ ((eq (char-after (+ 2 tmp)) ?<) ; Lookbehind
+ (goto-char (+ 3 tmp))
+ (cperl-beautify-regexp-piece (point) m t))
(t
(cperl-beautify-regexp-piece tmp m t)))
(goto-char m1)
@@ -5480,11 +7070,16 @@ prototype \&SUB Returns prototype of the function given a reference.
))
(defun cperl-make-regexp-x ()
+ ;; Returns position of the start
(save-excursion
(or cperl-use-syntax-table-text-property
- (error "I need to have regex marked!"))
+ (error "I need to have a regexp marked!"))
;; Find the start
- (re-search-backward "\\s|") ; Assume it is scanned already.
+ (if (looking-at "\\s|")
+ nil ; good already
+ (if (looking-at "\\([smy]\\|qr\\)\\s|")
+ (forward-char 1)
+ (re-search-backward "\\s|"))) ; Assume it is scanned already.
;;(forward-char 1)
(let ((b (point)) (e (make-marker)) have-x delim (c (current-column))
(sub-p (eq (preceding-char) ?s)) s)
@@ -5507,66 +7102,240 @@ prototype \&SUB Returns prototype of the function given a reference.
b)))
(defun cperl-beautify-regexp ()
- "do it. (Experimental, may change semantics, recheck the result.)
+ "do it. (Experimental, may change semantics, recheck the result.)
We suppose that the regexp is scanned already."
(interactive)
- (cperl-make-regexp-x)
- (re-search-backward "\\s|") ; Assume it is scanned already.
- ;;(forward-char 1)
+ (goto-char (cperl-make-regexp-x))
(let ((b (point)) (e (make-marker)))
(forward-sexp 1)
(set-marker e (1- (point)))
(cperl-beautify-regexp-piece b e nil)))
-(defun cperl-contract-level ()
- "Find an enclosing group in regexp and contract it. (Experimental, may change semantics, recheck the result.) Unfinished.
+(defun cperl-regext-to-level-start ()
+ "Goto start of an enclosing group in regexp.
We suppose that the regexp is scanned already."
(interactive)
- (let ((bb (cperl-make-regexp-x)) done)
+ (let ((limit (cperl-make-regexp-x)) done)
(while (not done)
(or (eq (following-char) ?\()
- (search-backward "(" (1+ bb) t)
+ (search-backward "(" (1+ limit) t)
(error "Cannot find `(' which starts a group"))
(setq done
(save-excursion
(skip-chars-backward "\\")
(looking-at "\\(\\\\\\\\\\)*(")))
- (or done (forward-char -1)))
- (let ((b (point)) (e (make-marker)) s c)
- (forward-sexp 1)
- (set-marker e (1- (point)))
- (goto-char b)
- (while (re-search-forward "\\(#\\)\\|\n" e t)
- (cond
- ((match-beginning 1) ; #-comment
- (or c (setq c (current-indentation)))
- (beginning-of-line 2) ; Skip
- (setq s (point))
- (skip-chars-forward " \t")
- (delete-region s (point))
- (indent-to-column c))
- (t
- (delete-char -1)
- (just-one-space)))))))
+ (or done (forward-char -1)))))
+
+(defun cperl-contract-level ()
+ "Find an enclosing group in regexp and contract it. Unfinished.
+\(Experimental, may change semantics, recheck the result.)
+We suppose that the regexp is scanned already."
+ (interactive)
+ (cperl-regext-to-level-start)
+ (let ((b (point)) (e (make-marker)) s c)
+ (forward-sexp 1)
+ (set-marker e (1- (point)))
+ (goto-char b)
+ (while (re-search-forward "\\(#\\)\\|\n" e t)
+ (cond
+ ((match-beginning 1) ; #-comment
+ (or c (setq c (current-indentation)))
+ (beginning-of-line 2) ; Skip
+ (setq s (point))
+ (skip-chars-forward " \t")
+ (delete-region s (point))
+ (indent-to-column c))
+ (t
+ (delete-char -1)
+ (just-one-space))))))
+
+(defun cperl-contract-levels ()
+ "Find an enclosing group in regexp and contract all the kids. Unfinished.
+\(Experimental, may change semantics, recheck the result.)
+We suppose that the regexp is scanned already."
+ (interactive)
+ (condition-case nil
+ (cperl-regext-to-level-start)
+ (error ; We are outside outermost group
+ (goto-char (cperl-make-regexp-x))))
+ (let ((b (point)) (e (make-marker)) s c)
+ (forward-sexp 1)
+ (set-marker e (1- (point)))
+ (goto-char (1+ b))
+ (while (re-search-forward "\\(\\\\\\\\\\)\\|(" e t)
+ (cond
+ ((match-beginning 1) ; Skip
+ nil)
+ (t ; Group
+ (cperl-contract-level))))))
(defun cperl-beautify-level ()
- "Find an enclosing group in regexp and beautify it. (Experimental, may change semantics, recheck the result.)
+ "Find an enclosing group in regexp and beautify it.
+\(Experimental, may change semantics, recheck the result.)
We suppose that the regexp is scanned already."
(interactive)
- (let ((bb (cperl-make-regexp-x)) done)
- (while (not done)
- (or (eq (following-char) ?\()
- (search-backward "(" (1+ bb) t)
- (error "Cannot find `(' which starts a group"))
- (setq done
- (save-excursion
- (skip-chars-backward "\\")
- (looking-at "\\(\\\\\\\\\\)*(")))
- (or done (forward-char -1)))
- (let ((b (point)) (e (make-marker)))
- (forward-sexp 1)
- (set-marker e (1- (point)))
- (cperl-beautify-regexp-piece b e nil))))
+ (cperl-regext-to-level-start)
+ (let ((b (point)) (e (make-marker)))
+ (forward-sexp 1)
+ (set-marker e (1- (point)))
+ (cperl-beautify-regexp-piece b e nil)))
+
+(defun cperl-invert-if-unless ()
+ "Changes `if (A) {B}' into `B if A;' if possible."
+ (interactive)
+ (or (looking-at "\\<")
+ (forward-sexp -1))
+ (if (looking-at "\\<\\(if\\|unless\\|while\\|until\\)\\>")
+ (let ((pos1 (point))
+ pos2 pos3 pos4 pos5 s1 s2 state p pos45
+ (s0 (buffer-substring (match-beginning 0) (match-end 0))))
+ (forward-sexp 2)
+ (setq pos3 (point))
+ (forward-sexp -1)
+ (setq pos2 (point))
+ (if (eq (following-char) ?\( )
+ (progn
+ (goto-char pos3)
+ (forward-sexp 1)
+ (setq pos5 (point))
+ (forward-sexp -1)
+ (setq pos4 (point))
+ ;; XXXX In fact may be `A if (B); {C}' ...
+ (if (and (eq (following-char) ?\{ )
+ (progn
+ (cperl-backward-to-noncomment pos3)
+ (eq (preceding-char) ?\) )))
+ (if (condition-case nil
+ (progn
+ (goto-char pos5)
+ (forward-sexp 1)
+ (forward-sexp -1)
+ (looking-at "\\<els\\(e\\|if\\)\\>"))
+ (error nil))
+ (error
+ "`%s' (EXPR) {BLOCK} with `else'/`elsif'" s0)
+ (goto-char (1- pos5))
+ (cperl-backward-to-noncomment pos4)
+ (if (eq (preceding-char) ?\;)
+ (forward-char -1))
+ (setq pos45 (point))
+ (goto-char pos4)
+ (while (re-search-forward "\\<\\(for\\|foreach\\|if\\|unless\\|while\\|until\\)\\>\\|;" pos45 t)
+ (setq p (match-beginning 0)
+ s1 (buffer-substring p (match-end 0))
+ state (parse-partial-sexp pos4 p))
+ (or (nth 3 state)
+ (nth 4 state)
+ (nth 5 state)
+ (error "`%s' inside `%s' BLOCK" s1 s0))
+ (goto-char (match-end 0)))
+ ;; Finally got it
+ (goto-char (1+ pos4))
+ (skip-chars-forward " \t\n")
+ (setq s2 (buffer-substring (point) pos45))
+ (goto-char pos45)
+ (or (looking-at ";?[ \t\n]*}")
+ (progn
+ (skip-chars-forward "; \t\n")
+ (setq s2 (concat s2 "\n" (buffer-substring (point) (1- pos5))))))
+ (and (equal s2 "")
+ (setq s2 "1"))
+ (goto-char (1- pos3))
+ (cperl-backward-to-noncomment pos2)
+ (or (looking-at "[ \t\n]*)")
+ (goto-char (1- pos3)))
+ (setq p (point))
+ (goto-char (1+ pos2))
+ (skip-chars-forward " \t\n")
+ (setq s1 (buffer-substring (point) p))
+ (delete-region pos4 pos5)
+ (delete-region pos2 pos3)
+ (goto-char pos1)
+ (insert s2 " ")
+ (just-one-space)
+ (forward-word 1)
+ (setq pos1 (point))
+ (insert " " s1 ";")
+ (forward-char -1)
+ (delete-horizontal-space)
+ (goto-char pos1)
+ (just-one-space)
+ (cperl-indent-line))
+ (error "`%s' (EXPR) not with an {BLOCK}" s0)))
+ (error "`%s' not with an (EXPR)" s0)))
+ (error "Not at `if', `unless', `while', or `unless'")))
+
+;;; By Anthony Foiani <afoiani@uswest.com>
+;;; Getting help on modules in C-h f ?
+;;; Need to teach it how to lookup functions
+(defvar Man-filter-list)
+(defun cperl-perldoc (word)
+ "Run a 'perldoc' on WORD."
+ (interactive
+ (list (let* ((default-entry (cperl-word-at-point))
+ (input (read-string
+ (format "perldoc entry%s: "
+ (if (string= default-entry "")
+ ""
+ (format " (default %s)" default-entry))))))
+ (if (string= input "")
+ (if (string= default-entry "")
+ (error "No perldoc args given")
+ default-entry)
+ input))))
+ (let* ((is-func (and
+ (string-match "^[a-z]+$" word)
+ (string-match (concat "^" word "\\>")
+ (documentation-property
+ 'cperl-short-docs
+ 'variable-documentation))))
+ (manual-program (if is-func "perldoc -f" "perldoc")))
+ (require 'man)
+ (Man-getpage-in-background word)))
+
+(defun cperl-perldoc-at-point ()
+ "Run a 'perldoc' on WORD."
+ (interactive)
+ (cperl-perldoc (cperl-word-at-point)))
+
+;;; By Nick Roberts <Nick.Roberts@src.bae.co.uk> (with changes)
+(defvar pod2man-program "pod2man")
+
+(defun cperl-pod-to-manpage ()
+ "Create a virtual manpage in emacs from the Perl Online Documentation"
+ (interactive)
+ (require 'man)
+ (let* ((pod2man-args (concat buffer-file-name " | nroff -man "))
+ (bufname (concat "Man " buffer-file-name))
+ (buffer (generate-new-buffer bufname)))
+ (save-excursion
+ (set-buffer buffer)
+ (let ((process-environment (copy-sequence process-environment)))
+ ;; Prevent any attempt to use display terminal fanciness.
+ (setenv "TERM" "dumb")
+ (set-process-sentinel
+ (start-process pod2man-program buffer "sh" "-c"
+ (format (cperl-pod2man-build-command) pod2man-args))
+ 'Man-bgproc-sentinel)))))
+
+(defun cperl-pod2man-build-command ()
+ "Builds the entire background manpage and cleaning command."
+ (let ((command (concat pod2man-program " %s 2>/dev/null"))
+ (flist Man-filter-list))
+ (while (and flist (car flist))
+ (let ((pcom (car (car flist)))
+ (pargs (cdr (car flist))))
+ (setq command
+ (concat command " | " pcom " "
+ (mapconcat '(lambda (phrase)
+ (if (not (stringp phrase))
+ (error "Malformed Man-filter-list"))
+ phrase)
+ pargs " ")))
+ (setq flist (cdr flist))))
+ command))
+
+(defun cperl-lazy-install ()) ; Avoid a warning
(if (fboundp 'run-with-idle-timer)
(progn
@@ -5605,4 +7374,67 @@ We suppose that the regexp is scanned already."
(setq cperl-help-shown t))))
(cperl-lazy-install)))
+
+;;; Plug for wrong font-lock:
+
+(defun cperl-font-lock-unfontify-region-function (beg end)
+ (let* ((modified (buffer-modified-p)) (buffer-undo-list t)
+ (inhibit-read-only t) (inhibit-point-motion-hooks t)
+ before-change-functions after-change-functions
+ deactivate-mark buffer-file-name buffer-file-truename)
+ (remove-text-properties beg end '(face nil))
+ (when (and (not modified) (buffer-modified-p))
+ (set-buffer-modified-p nil))))
+
+(defvar cperl-d-l nil)
+(defun cperl-fontify-syntaxically (end)
+ (and cperl-syntaxify-unwind
+ (cperl-unwind-to-safe t))
+ (let ((start (point)) (dbg (point)))
+ (or cperl-syntax-done-to
+ (setq cperl-syntax-done-to (point-min)))
+ (if (or (not (boundp 'font-lock-hot-pass))
+ (eval 'font-lock-hot-pass)
+ t) ; Not debugged otherwise
+ ;; Need to forget what is after `start'
+ (setq start (min cperl-syntax-done-to start))
+ ;; Fontification without a change
+ (setq start (max cperl-syntax-done-to start)))
+ (and (> end start)
+ (setq cperl-syntax-done-to start) ; In case what follows fails
+ (cperl-find-pods-heres start end t nil t))
+ ;;(setq cperl-d-l (cons (format "Syntaxifying %s..%s from %s to %s\n"
+ ;; dbg end start cperl-syntax-done-to)
+ ;; cperl-d-l))
+ ;;(let ((standard-output (get-buffer "*Messages*")))
+ ;;(princ (format "Syntaxifying %s..%s from %s to %s\n"
+ ;; dbg end start cperl-syntax-done-to)))
+ (if (eq cperl-syntaxify-by-font-lock 'message)
+ (message "Syntaxified %s..%s from %s to %s, state at %s"
+ dbg end start cperl-syntax-done-to
+ (car cperl-syntax-state))) ; For debugging
+ nil)) ; Do not iterate
+
+(defun cperl-fontify-update (end)
+ (let ((pos (point)) prop posend)
+ (while (< pos end)
+ (setq prop (get-text-property pos 'cperl-postpone))
+ (setq posend (next-single-property-change pos 'cperl-postpone nil end))
+ (and prop (put-text-property pos posend (car prop) (cdr prop)))
+ (setq pos posend)))
+ nil) ; Do not iterate
+
+(defun cperl-update-syntaxification (from to)
+ (if (and cperl-use-syntax-table-text-property
+ cperl-syntaxify-by-font-lock
+ (or (null cperl-syntax-done-to)
+ (< cperl-syntax-done-to to)))
+ (progn
+ (save-excursion
+ (goto-char from)
+ (cperl-fontify-syntaxically to)))))
+
(provide 'cperl-mode)
+
+;;; cperl-mode.el ends here
+
diff --git a/gnu/usr.bin/perl/embed.h b/gnu/usr.bin/perl/embed.h
index 51e5f406e7a..e7deb325750 100644
--- a/gnu/usr.bin/perl/embed.h
+++ b/gnu/usr.bin/perl/embed.h
@@ -1,6 +1,6 @@
/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
- This file is built by embed.pl from global.sym, interp.sym,
- and compat3.sym. Any changes made here will be lost!
+ This file is built by embed.pl from global.sym, intrpvar.h,
+ and thrdvar.h. Any changes made here will be lost!
*/
/* (Doing namespace management portably in C is really gross.) */
@@ -20,18 +20,13 @@
#ifdef EMBED
#define AMG_names Perl_AMG_names
+#define Error Perl_Error
#define Gv_AMupdate Perl_Gv_AMupdate
-#define No Perl_No
-#define Sv Perl_Sv
-#define Xpv Perl_Xpv
-#define Yes Perl_Yes
#define abs_amg Perl_abs_amg
#define add_amg Perl_add_amg
#define add_ass_amg Perl_add_ass_amg
#define additem Perl_additem
#define amagic_call Perl_amagic_call
-#define amagic_generation Perl_amagic_generation
-#define an Perl_an
#define append_elem Perl_append_elem
#define append_list Perl_append_list
#define apply Perl_apply
@@ -51,16 +46,23 @@
#define av_store Perl_av_store
#define av_undef Perl_av_undef
#define av_unshift Perl_av_unshift
+#define avhv_exists_ent Perl_avhv_exists_ent
+#define avhv_fetch_ent Perl_avhv_fetch_ent
+#define avhv_iternext Perl_avhv_iternext
+#define avhv_iterval Perl_avhv_iterval
+#define avhv_keys Perl_avhv_keys
#define band_amg Perl_band_amg
#define bind_match Perl_bind_match
#define block_end Perl_block_end
#define block_gimme Perl_block_gimme
#define block_start Perl_block_start
+#define block_type Perl_block_type
#define bool__amg Perl_bool__amg
+#define boot_core_UNIVERSAL Perl_boot_core_UNIVERSAL
#define bor_amg Perl_bor_amg
-#define bufend Perl_bufend
-#define bufptr Perl_bufptr
+#define bset_obj_store Perl_bset_obj_store
#define bxor_amg Perl_bxor_amg
+#define byterun Perl_byterun
#define call_list Perl_call_list
#define cando Perl_cando
#define cast_ulong Perl_cast_ulong
@@ -102,28 +104,13 @@
#define ck_subr Perl_ck_subr
#define ck_svconst Perl_ck_svconst
#define ck_trunc Perl_ck_trunc
-#define collation_ix Perl_collation_ix
-#define collation_name Perl_collation_name
-#define collation_standard Perl_collation_standard
-#define collxfrm_base Perl_collxfrm_base
-#define collxfrm_mult Perl_collxfrm_mult
-#define compcv Perl_compcv
-#define compiling Perl_compiling
#define compl_amg Perl_compl_amg
-#define comppad Perl_comppad
-#define comppad_name Perl_comppad_name
-#define comppad_name_fill Perl_comppad_name_fill
#define concat_amg Perl_concat_amg
#define concat_ass_amg Perl_concat_ass_amg
+#define condpair_magic Perl_condpair_magic
#define convert Perl_convert
-#define cop_seqmax Perl_cop_seqmax
#define cos_amg Perl_cos_amg
#define croak Perl_croak
-#define cryptseen Perl_cryptseen
-#define cshlen Perl_cshlen
-#define cshname Perl_cshname
-#define curinterp Perl_curinterp
-#define curpad Perl_curpad
#define cv_ckproto Perl_cv_ckproto
#define cv_clone Perl_cv_clone
#define cv_const_sv Perl_cv_const_sv
@@ -146,6 +133,7 @@
#define div_amg Perl_div_amg
#define div_ass_amg Perl_div_ass_amg
#define do_aexec Perl_do_aexec
+#define do_binmode Perl_do_binmode
#define do_chomp Perl_do_chomp
#define do_chop Perl_do_chop
#define do_close Perl_do_close
@@ -171,7 +159,7 @@
#define do_trans Perl_do_trans
#define do_vecset Perl_do_vecset
#define do_vop Perl_do_vop
-#define doeval Perl_doeval
+#define dofile Perl_dofile
#define dofindlabel Perl_dofindlabel
#define dopoptoeval Perl_dopoptoeval
#define dounwind Perl_dounwind
@@ -187,13 +175,8 @@
#define dump_packsubs Perl_dump_packsubs
#define dump_pm Perl_dump_pm
#define dump_sub Perl_dump_sub
-#define egid Perl_egid
#define eq_amg Perl_eq_amg
-#define error_count Perl_error_count
-#define euid Perl_euid
-#define evalseq Perl_evalseq
#define exp_amg Perl_exp_amg
-#define expect Perl_expect
#define expectterm Perl_expectterm
#define fallback_amg Perl_fallback_amg
#define fbm_compile Perl_fbm_compile
@@ -203,6 +186,8 @@
#define filter_add Perl_filter_add
#define filter_del Perl_filter_del
#define filter_read Perl_filter_read
+#define find_script Perl_find_script
+#define find_threadsv Perl_find_threadsv
#define fold Perl_fold
#define fold_constants Perl_fold_constants
#define fold_locale Perl_fold_locale
@@ -215,7 +200,12 @@
#define freq Perl_freq
#define ge_amg Perl_ge_amg
#define gen_constant_list Perl_gen_constant_list
-#define gid Perl_gid
+#define get_no_modify Perl_get_no_modify
+#define get_op_descs Perl_get_op_descs
+#define get_op_names Perl_get_op_names
+#define get_opargs Perl_get_opargs
+#define get_specialsv_list Perl_get_specialsv_list
+#define get_vtbl Perl_get_vtbl
#define gp_free Perl_gp_free
#define gp_ref Perl_gp_ref
#define gt_amg Perl_gt_amg
@@ -237,10 +227,6 @@
#define gv_stashpv Perl_gv_stashpv
#define gv_stashpvn Perl_gv_stashpvn
#define gv_stashsv Perl_gv_stashsv
-#define he_root Perl_he_root
-#define hexdigit Perl_hexdigit
-#define hints Perl_hints
-#define hoistmust Perl_hoistmust
#define hv_clear Perl_hv_clear
#define hv_delayfree_ent Perl_hv_delayfree_ent
#define hv_delete Perl_hv_delete
@@ -264,9 +250,10 @@
#define hv_undef Perl_hv_undef
#define ibcmp Perl_ibcmp
#define ibcmp_locale Perl_ibcmp_locale
-#define in_my Perl_in_my
#define inc_amg Perl_inc_amg
#define ingroup Perl_ingroup
+#define init_stacks Perl_init_stacks
+#define init_thread_intern Perl_init_thread_intern
#define instr Perl_instr
#define intro_my Perl_intro_my
#define intuit_more Perl_intuit_more
@@ -275,30 +262,10 @@
#define jmaybe Perl_jmaybe
#define keyword Perl_keyword
#define know_next Perl_know_next
-#define last_lop Perl_last_lop
-#define last_lop_op Perl_last_lop_op
-#define last_uni Perl_last_uni
#define le_amg Perl_le_amg
#define leave_scope Perl_leave_scope
-#define lex_brackets Perl_lex_brackets
-#define lex_brackstack Perl_lex_brackstack
-#define lex_casemods Perl_lex_casemods
-#define lex_casestack Perl_lex_casestack
-#define lex_defer Perl_lex_defer
-#define lex_dojoin Perl_lex_dojoin
#define lex_end Perl_lex_end
-#define lex_expect Perl_lex_expect
-#define lex_fakebrack Perl_lex_fakebrack
-#define lex_formbrack Perl_lex_formbrack
-#define lex_inpat Perl_lex_inpat
-#define lex_inwhat Perl_lex_inwhat
-#define lex_op Perl_lex_op
-#define lex_repl Perl_lex_repl
#define lex_start Perl_lex_start
-#define lex_starts Perl_lex_starts
-#define lex_state Perl_lex_state
-#define lex_stuff Perl_lex_stuff
-#define linestr Perl_linestr
#define linklist Perl_linklist
#define list Perl_list
#define listkids Perl_listkids
@@ -313,17 +280,21 @@
#define magic_clearpack Perl_magic_clearpack
#define magic_clearsig Perl_magic_clearsig
#define magic_existspack Perl_magic_existspack
-#define magic_freedefelem Perl_magic_freedefelem
+#define magic_freeregexp Perl_magic_freeregexp
#define magic_get Perl_magic_get
#define magic_getarylen Perl_magic_getarylen
#define magic_getdefelem Perl_magic_getdefelem
#define magic_getglob Perl_magic_getglob
+#define magic_getnkeys Perl_magic_getnkeys
#define magic_getpack Perl_magic_getpack
#define magic_getpos Perl_magic_getpos
#define magic_getsig Perl_magic_getsig
+#define magic_getsubstr Perl_magic_getsubstr
#define magic_gettaint Perl_magic_gettaint
#define magic_getuvar Perl_magic_getuvar
+#define magic_getvec Perl_magic_getvec
#define magic_len Perl_magic_len
+#define magic_mutexfree Perl_magic_mutexfree
#define magic_nextpack Perl_magic_nextpack
#define magic_set Perl_magic_set
#define magic_set_all_env Perl_magic_set_all_env
@@ -346,14 +317,11 @@
#define magic_settaint Perl_magic_settaint
#define magic_setuvar Perl_magic_setuvar
#define magic_setvec Perl_magic_setvec
+#define magic_sizepack Perl_magic_sizepack
#define magic_wipepack Perl_magic_wipepack
#define magicname Perl_magicname
-#define markstack Perl_markstack
+#define malloced_size Perl_malloced_size
#define markstack_grow Perl_markstack_grow
-#define markstack_max Perl_markstack_max
-#define markstack_ptr Perl_markstack_ptr
-#define max_intro_pending Perl_max_intro_pending
-#define maxo Perl_maxo
#define mem_collxfrm Perl_mem_collxfrm
#define mess Perl_mess
#define mg_clear Perl_mg_clear
@@ -361,10 +329,10 @@
#define mg_find Perl_mg_find
#define mg_free Perl_mg_free
#define mg_get Perl_mg_get
-#define mg_len Perl_mg_len
+#define mg_length Perl_mg_length
#define mg_magical Perl_mg_magical
#define mg_set Perl_mg_set
-#define min_intro_pending Perl_min_intro_pending
+#define mg_size Perl_mg_size
#define mod Perl_mod
#define mod_amg Perl_mod_amg
#define mod_ass_amg Perl_mod_ass_amg
@@ -373,10 +341,6 @@
#define mstats Perl_mstats
#define mult_amg Perl_mult_amg
#define mult_ass_amg Perl_mult_ass_amg
-#define multi_close Perl_multi_close
-#define multi_end Perl_multi_end
-#define multi_open Perl_multi_open
-#define multi_start Perl_multi_start
#define my Perl_my
#define my_bcopy Perl_my_bcopy
#define my_bzero Perl_my_bzero
@@ -394,7 +358,6 @@
#define my_stat Perl_my_stat
#define my_swap Perl_my_swap
#define my_unexec Perl_my_unexec
-#define na Perl_na
#define ncmp_amg Perl_ncmp_amg
#define ne_amg Perl_ne_amg
#define neg_amg Perl_neg_amg
@@ -406,6 +369,7 @@
#define newAVREF Perl_newAVREF
#define newBINOP Perl_newBINOP
#define newCONDOP Perl_newCONDOP
+#define newCONSTSUB Perl_newCONSTSUB
#define newCVREF Perl_newCVREF
#define newFORM Perl_newFORM
#define newFOROP Perl_newFOROP
@@ -414,6 +378,7 @@
#define newGVgen Perl_newGVgen
#define newHV Perl_newHV
#define newHVREF Perl_newHVREF
+#define newHVhv Perl_newHVhv
#define newIO Perl_newIO
#define newLISTOP Perl_newLISTOP
#define newLOGOP Perl_newLOGOP
@@ -426,6 +391,7 @@
#define newPVOP Perl_newPVOP
#define newRANGE Perl_newRANGE
#define newRV Perl_newRV
+#define newRV_noinc Perl_newRV_noinc
#define newSLICEOP Perl_newSLICEOP
#define newSTATEOP Perl_newSTATEOP
#define newSUB Perl_newSUB
@@ -436,16 +402,16 @@
#define newSVnv Perl_newSVnv
#define newSVpv Perl_newSVpv
#define newSVpvf Perl_newSVpvf
+#define newSVpvn Perl_newSVpvn
#define newSVrv Perl_newSVrv
#define newSVsv Perl_newSVsv
#define newUNOP Perl_newUNOP
#define newWHILEOP Perl_newWHILEOP
#define newXS Perl_newXS
#define newXSUB Perl_newXSUB
+#define new_stackinfo Perl_new_stackinfo
+#define new_struct_thread Perl_new_struct_thread
#define nextargv Perl_nextargv
-#define nexttoke Perl_nexttoke
-#define nexttype Perl_nexttype
-#define nextval Perl_nextval
#define ninstr Perl_ninstr
#define no_aelem Perl_no_aelem
#define no_dir_func Perl_no_dir_func
@@ -454,33 +420,26 @@
#define no_helem Perl_no_helem
#define no_mem Perl_no_mem
#define no_modify Perl_no_modify
+#define no_myglob Perl_no_myglob
#define no_op Perl_no_op
#define no_security Perl_no_security
#define no_sock_func Perl_no_sock_func
+#define no_symref Perl_no_symref
#define no_usym Perl_no_usym
+#define no_wrongref Perl_no_wrongref
#define nointrp Perl_nointrp
#define nomem Perl_nomem
-#define nomemok Perl_nomemok
#define nomethod_amg Perl_nomethod_amg
#define not_amg Perl_not_amg
#define numer_amg Perl_numer_amg
-#define numeric_local Perl_numeric_local
-#define numeric_name Perl_numeric_name
-#define numeric_standard Perl_numeric_standard
-#define oldbufptr Perl_oldbufptr
-#define oldoldbufptr Perl_oldoldbufptr
#define oopsAV Perl_oopsAV
#define oopsCV Perl_oopsCV
#define oopsHV Perl_oopsHV
-#define op Perl_op
+#define op_const_sv Perl_op_const_sv
#define op_desc Perl_op_desc
#define op_free Perl_op_free
#define op_name Perl_op_name
-#define op_seqmax Perl_op_seqmax
#define opargs Perl_opargs
-#define origalen Perl_origalen
-#define origenviron Perl_origenviron
-#define osname Perl_osname
#define package Perl_package
#define pad_alloc Perl_pad_alloc
#define pad_allocmy Perl_pad_allocmy
@@ -490,11 +449,8 @@
#define pad_reset Perl_pad_reset
#define pad_sv Perl_pad_sv
#define pad_swipe Perl_pad_swipe
-#define padix Perl_padix
-#define patleave Perl_patleave
#define peep Perl_peep
#define pidgone Perl_pidgone
-#define pidstatus Perl_pidstatus
#define pmflag Perl_pmflag
#define pmruntime Perl_pmruntime
#define pmtrans Perl_pmtrans
@@ -660,7 +616,6 @@
#define pp_i_negate Perl_pp_i_negate
#define pp_i_subtract Perl_pp_i_subtract
#define pp_index Perl_pp_index
-#define pp_indread Perl_pp_indread
#define pp_int Perl_pp_int
#define pp_interp Perl_pp_interp
#define pp_ioctl Perl_pp_ioctl
@@ -685,6 +640,7 @@
#define pp_list Perl_pp_list
#define pp_listen Perl_pp_listen
#define pp_localtime Perl_pp_localtime
+#define pp_lock Perl_pp_lock
#define pp_log Perl_pp_log
#define pp_lslice Perl_pp_lslice
#define pp_lstat Perl_pp_lstat
@@ -734,6 +690,7 @@
#define pp_push Perl_pp_push
#define pp_pushmark Perl_pp_pushmark
#define pp_pushre Perl_pp_pushre
+#define pp_qr Perl_pp_qr
#define pp_quotemeta Perl_pp_quotemeta
#define pp_rand Perl_pp_rand
#define pp_range Perl_pp_range
@@ -748,6 +705,7 @@
#define pp_refgen Perl_pp_refgen
#define pp_regcmaybe Perl_pp_regcmaybe
#define pp_regcomp Perl_pp_regcomp
+#define pp_regcreset Perl_pp_regcreset
#define pp_rename Perl_pp_rename
#define pp_repeat Perl_pp_repeat
#define pp_require Perl_pp_require
@@ -826,6 +784,7 @@
#define pp_syswrite Perl_pp_syswrite
#define pp_tell Perl_pp_tell
#define pp_telldir Perl_pp_telldir
+#define pp_threadsv Perl_pp_threadsv
#define pp_tie Perl_pp_tie
#define pp_tied Perl_pp_tied
#define pp_time Perl_pp_time
@@ -854,64 +813,46 @@
#define pregexec Perl_pregexec
#define pregfree Perl_pregfree
#define prepend_elem Perl_prepend_elem
-#define profiledata Perl_profiledata
#define psig_name Perl_psig_name
#define psig_ptr Perl_psig_ptr
#define push_return Perl_push_return
#define push_scope Perl_push_scope
#define q Perl_q
-#define rcsid Perl_rcsid
#define reall_srchlen Perl_reall_srchlen
#define ref Perl_ref
#define refkids Perl_refkids
-#define regarglen Perl_regarglen
-#define regbol Perl_regbol
-#define regcode Perl_regcode
-#define regdummy Perl_regdummy
#define regdump Perl_regdump
-#define regendp Perl_regendp
-#define regeol Perl_regeol
-#define reginput Perl_reginput
+#define regexec_flags Perl_regexec_flags
#define regkind Perl_regkind
-#define reglastparen Perl_reglastparen
-#define regmyendp Perl_regmyendp
-#define regmyp_size Perl_regmyp_size
-#define regmystartp Perl_regmystartp
-#define regnarrate Perl_regnarrate
-#define regnaughty Perl_regnaughty
#define regnext Perl_regnext
-#define regnpar Perl_regnpar
-#define regparse Perl_regparse
-#define regprecomp Perl_regprecomp
-#define regprev Perl_regprev
#define regprop Perl_regprop
-#define regsawback Perl_regsawback
-#define regsize Perl_regsize
-#define regstartp Perl_regstartp
-#define regtill Perl_regtill
-#define regxend Perl_regxend
#define repeat_amg Perl_repeat_amg
#define repeat_ass_amg Perl_repeat_ass_amg
#define repeatcpy Perl_repeatcpy
-#define retstack Perl_retstack
-#define retstack_ix Perl_retstack_ix
-#define retstack_max Perl_retstack_max
#define rninstr Perl_rninstr
-#define rsfp Perl_rsfp
-#define rsfp_filters Perl_rsfp_filters
#define rshift_amg Perl_rshift_amg
#define rshift_ass_amg Perl_rshift_ass_amg
#define rsignal Perl_rsignal
#define rsignal_restore Perl_rsignal_restore
#define rsignal_save Perl_rsignal_save
#define rsignal_state Perl_rsignal_state
-#define runops Perl_runops
+#define runops_debug Perl_runops_debug
+#define runops_standard Perl_runops_standard
#define rxres_free Perl_rxres_free
#define rxres_restore Perl_rxres_restore
#define rxres_save Perl_rxres_save
+#define safecalloc Perl_safecalloc
+#define safefree Perl_safefree
+#define safemalloc Perl_safemalloc
+#define saferealloc Perl_saferealloc
+#define safexcalloc Perl_safexcalloc
+#define safexfree Perl_safexfree
+#define safexmalloc Perl_safexmalloc
+#define safexrealloc Perl_safexrealloc
#define same_dirent Perl_same_dirent
#define save_I16 Perl_save_I16
#define save_I32 Perl_save_I32
+#define save_aelem Perl_save_aelem
#define save_aptr Perl_save_aptr
#define save_ary Perl_save_ary
#define save_clearsv Perl_save_clearsv
@@ -920,24 +861,27 @@
#define save_freeop Perl_save_freeop
#define save_freepv Perl_save_freepv
#define save_freesv Perl_save_freesv
+#define save_generic_svref Perl_save_generic_svref
#define save_gp Perl_save_gp
#define save_hash Perl_save_hash
+#define save_helem Perl_save_helem
+#define save_hints Perl_save_hints
#define save_hptr Perl_save_hptr
#define save_int Perl_save_int
#define save_item Perl_save_item
+#define save_iv Perl_save_iv
#define save_list Perl_save_list
#define save_long Perl_save_long
#define save_nogv Perl_save_nogv
+#define save_op Perl_save_op
#define save_pptr Perl_save_pptr
#define save_scalar Perl_save_scalar
#define save_sptr Perl_save_sptr
#define save_svref Perl_save_svref
+#define save_threadsv Perl_save_threadsv
#define savepv Perl_savepv
#define savepvn Perl_savepvn
-#define savestack Perl_savestack
#define savestack_grow Perl_savestack_grow
-#define savestack_ix Perl_savestack_ix
-#define savestack_max Perl_savestack_max
#define saw_return Perl_saw_return
#define sawparens Perl_sawparens
#define scalar Perl_scalar
@@ -960,17 +904,12 @@
#define scan_word Perl_scan_word
#define scmp_amg Perl_scmp_amg
#define scope Perl_scope
-#define scopestack Perl_scopestack
-#define scopestack_ix Perl_scopestack_ix
-#define scopestack_max Perl_scopestack_max
#define screaminstr Perl_screaminstr
-#define scrgv Perl_scrgv
#define seq_amg Perl_seq_amg
#define setdefout Perl_setdefout
#define setenv_getix Perl_setenv_getix
#define sge_amg Perl_sge_amg
#define sgt_amg Perl_sgt_amg
-#define sh_path Perl_sh_path
#define share_hek Perl_share_hek
#define sharepvn Perl_sharepvn
#define sig_name Perl_sig_name
@@ -983,17 +922,10 @@
#define slt_amg Perl_slt_amg
#define sne_amg Perl_sne_amg
#define sqrt_amg Perl_sqrt_amg
-#define stack_base Perl_stack_base
#define stack_grow Perl_stack_grow
-#define stack_max Perl_stack_max
-#define stack_sp Perl_stack_sp
#define start_subparse Perl_start_subparse
-#define statbuf Perl_statbuf
#define string_amg Perl_string_amg
#define sub_crush_depth Perl_sub_crush_depth
-#define sub_generation Perl_sub_generation
-#define subline Perl_subline
-#define subname Perl_subname
#define subtr_amg Perl_subtr_amg
#define subtr_ass_amg Perl_subtr_ass_amg
#define sv_2bool Perl_sv_2bool
@@ -1008,9 +940,13 @@
#define sv_backoff Perl_sv_backoff
#define sv_bless Perl_sv_bless
#define sv_catpv Perl_sv_catpv
+#define sv_catpv_mg Perl_sv_catpv_mg
#define sv_catpvf Perl_sv_catpvf
+#define sv_catpvf_mg Perl_sv_catpvf_mg
#define sv_catpvn Perl_sv_catpvn
+#define sv_catpvn_mg Perl_sv_catpvn_mg
#define sv_catsv Perl_sv_catsv
+#define sv_catsv_mg Perl_sv_catsv_mg
#define sv_chop Perl_sv_chop
#define sv_clean_all Perl_sv_clean_all
#define sv_clean_objs Perl_sv_clean_objs
@@ -1018,6 +954,7 @@
#define sv_cmp Perl_sv_cmp
#define sv_cmp_locale Perl_sv_cmp_locale
#define sv_collxfrm Perl_sv_collxfrm
+#define sv_compile_2op Perl_sv_compile_2op
#define sv_dec Perl_sv_dec
#define sv_derived_from Perl_sv_derived_from
#define sv_dump Perl_sv_dump
@@ -1030,13 +967,15 @@
#define sv_insert Perl_sv_insert
#define sv_isa Perl_sv_isa
#define sv_isobject Perl_sv_isobject
+#define sv_iv Perl_sv_iv
#define sv_len Perl_sv_len
#define sv_magic Perl_sv_magic
#define sv_mortalcopy Perl_sv_mortalcopy
#define sv_newmortal Perl_sv_newmortal
#define sv_newref Perl_sv_newref
-#define sv_no Perl_sv_no
+#define sv_nv Perl_sv_nv
#define sv_peek Perl_sv_peek
+#define sv_pvn Perl_sv_pvn
#define sv_pvn_force Perl_sv_pvn_force
#define sv_ref Perl_sv_ref
#define sv_reftype Perl_sv_reftype
@@ -1044,43 +983,48 @@
#define sv_report_used Perl_sv_report_used
#define sv_reset Perl_sv_reset
#define sv_setiv Perl_sv_setiv
+#define sv_setiv_mg Perl_sv_setiv_mg
#define sv_setnv Perl_sv_setnv
+#define sv_setnv_mg Perl_sv_setnv_mg
#define sv_setptrobj Perl_sv_setptrobj
#define sv_setpv Perl_sv_setpv
+#define sv_setpv_mg Perl_sv_setpv_mg
#define sv_setpvf Perl_sv_setpvf
+#define sv_setpvf_mg Perl_sv_setpvf_mg
#define sv_setpviv Perl_sv_setpviv
+#define sv_setpviv_mg Perl_sv_setpviv_mg
#define sv_setpvn Perl_sv_setpvn
+#define sv_setpvn_mg Perl_sv_setpvn_mg
#define sv_setref_iv Perl_sv_setref_iv
#define sv_setref_nv Perl_sv_setref_nv
#define sv_setref_pv Perl_sv_setref_pv
#define sv_setref_pvn Perl_sv_setref_pvn
#define sv_setsv Perl_sv_setsv
+#define sv_setsv_mg Perl_sv_setsv_mg
#define sv_setuv Perl_sv_setuv
+#define sv_setuv_mg Perl_sv_setuv_mg
#define sv_taint Perl_sv_taint
#define sv_tainted Perl_sv_tainted
-#define sv_undef Perl_sv_undef
+#define sv_true Perl_sv_true
#define sv_unmagic Perl_sv_unmagic
#define sv_unref Perl_sv_unref
#define sv_untaint Perl_sv_untaint
#define sv_upgrade Perl_sv_upgrade
#define sv_usepvn Perl_sv_usepvn
+#define sv_usepvn_mg Perl_sv_usepvn_mg
+#define sv_uv Perl_sv_uv
#define sv_vcatpvfn Perl_sv_vcatpvfn
#define sv_vsetpvfn Perl_sv_vsetpvfn
-#define sv_yes Perl_sv_yes
#define taint_env Perl_taint_env
#define taint_proper Perl_taint_proper
-#define thisexpr Perl_thisexpr
-#define timesbuf Perl_timesbuf
-#define tokenbuf Perl_tokenbuf
#define too_few_arguments Perl_too_few_arguments
#define too_many_arguments Perl_too_many_arguments
-#define uid Perl_uid
#define unlnk Perl_unlnk
+#define unlock_condpair Perl_unlock_condpair
#define unshare_hek Perl_unshare_hek
#define unsharepvn Perl_unsharepvn
#define utilize Perl_utilize
#define varies Perl_varies
-#define vert Perl_vert
#define vivify_defelem Perl_vivify_defelem
#define vivify_ref Perl_vivify_ref
#define vtbl_amagic Perl_vtbl_amagic
@@ -1097,10 +1041,12 @@
#define vtbl_isa Perl_vtbl_isa
#define vtbl_isaelem Perl_vtbl_isaelem
#define vtbl_mglob Perl_vtbl_mglob
+#define vtbl_mutex Perl_vtbl_mutex
#define vtbl_nkeys Perl_vtbl_nkeys
#define vtbl_pack Perl_vtbl_pack
#define vtbl_packelem Perl_vtbl_packelem
#define vtbl_pos Perl_vtbl_pos
+#define vtbl_regexp Perl_vtbl_regexp
#define vtbl_sig Perl_vtbl_sig
#define vtbl_sigelem Perl_vtbl_sigelem
#define vtbl_substr Perl_vtbl_substr
@@ -1113,19 +1059,16 @@
#define warn_nl Perl_warn_nl
#define warn_nosemi Perl_warn_nosemi
#define warn_reserved Perl_warn_reserved
+#define warn_uninit Perl_warn_uninit
#define watch Perl_watch
#define watchaddr Perl_watchaddr
#define watchok Perl_watchok
#define whichsig Perl_whichsig
-#define xiv_arenaroot Perl_xiv_arenaroot
-#define xiv_root Perl_xiv_root
-#define xnv_root Perl_xnv_root
-#define xpv_root Perl_xpv_root
-#define xrv_root Perl_xrv_root
#define yychar Perl_yychar
#define yycheck Perl_yycheck
#define yydebug Perl_yydebug
#define yydefred Perl_yydefred
+#define yydestruct Perl_yydestruct
#define yydgoto Perl_yydgoto
#define yyerrflag Perl_yyerrflag
#define yyerror Perl_yyerror
@@ -1144,518 +1087,5 @@
#define yyval Perl_yyval
#define yywarn Perl_yywarn
-/* Hide global symbols that 5.003 revealed? */
-
-#ifndef BINCOMPAT3
-
-#define Error Perl_Error
-#define SvIV Perl_SvIV
-#define SvNV Perl_SvNV
-#define SvTRUE Perl_SvTRUE
-#define SvUV Perl_SvUV
-#define block_type Perl_block_type
-#define boot_core_UNIVERSAL Perl_boot_core_UNIVERSAL
-#define comppad_name_floor Perl_comppad_name_floor
-#define debug Perl_debug
-#define do_undump Perl_do_undump
-#define nice_chunk Perl_nice_chunk
-#define nice_chunk_size Perl_nice_chunk_size
-#define no_myglob Perl_no_myglob
-#define no_symref Perl_no_symref
-#define no_wrongref Perl_no_wrongref
-#define pad_reset_pending Perl_pad_reset_pending
-#define padix_floor Perl_padix_floor
-#define regflags Perl_regflags
-#define safecalloc Perl_safecalloc
-#define safefree Perl_safefree
-#define safemalloc Perl_safemalloc
-#define saferealloc Perl_saferealloc
-#define safexcalloc Perl_safexcalloc
-#define safexfree Perl_safexfree
-#define safexmalloc Perl_safexmalloc
-#define safexrealloc Perl_safexrealloc
-#define save_iv Perl_save_iv
-#define sv_pvn Perl_sv_pvn
-#define warn_uninit Perl_warn_uninit
-#define yydestruct Perl_yydestruct
-
-#endif /* !BINCOMPAT3 */
-
-#endif /* EMBED */
-
-/* Put interpreter-specific symbols into a struct? */
-
-#ifdef MULTIPLICITY
-
-#define Argv (curinterp->IArgv)
-#define Cmd (curinterp->ICmd)
-#define DBgv (curinterp->IDBgv)
-#define DBline (curinterp->IDBline)
-#define DBsignal (curinterp->IDBsignal)
-#define DBsingle (curinterp->IDBsingle)
-#define DBsub (curinterp->IDBsub)
-#define DBtrace (curinterp->IDBtrace)
-#define allgvs (curinterp->Iallgvs)
-#define ampergv (curinterp->Iampergv)
-#define argvgv (curinterp->Iargvgv)
-#define argvoutgv (curinterp->Iargvoutgv)
-#define basetime (curinterp->Ibasetime)
-#define beginav (curinterp->Ibeginav)
-#define bodytarget (curinterp->Ibodytarget)
-#define cddir (curinterp->Icddir)
-#define chopset (curinterp->Ichopset)
-#define copline (curinterp->Icopline)
-#define curblock (curinterp->Icurblock)
-#define curcop (curinterp->Icurcop)
-#define curcopdb (curinterp->Icurcopdb)
-#define curcsv (curinterp->Icurcsv)
-#define curpm (curinterp->Icurpm)
-#define curstack (curinterp->Icurstack)
-#define curstash (curinterp->Icurstash)
-#define curstname (curinterp->Icurstname)
-#define cxstack (curinterp->Icxstack)
-#define cxstack_ix (curinterp->Icxstack_ix)
-#define cxstack_max (curinterp->Icxstack_max)
-#define dbargs (curinterp->Idbargs)
-#define debdelim (curinterp->Idebdelim)
-#define debname (curinterp->Idebname)
-#define debstash (curinterp->Idebstash)
-#define defgv (curinterp->Idefgv)
-#define defoutgv (curinterp->Idefoutgv)
-#define defstash (curinterp->Idefstash)
-#define delaymagic (curinterp->Idelaymagic)
-#define diehook (curinterp->Idiehook)
-#define dirty (curinterp->Idirty)
-#define dlevel (curinterp->Idlevel)
-#define dlmax (curinterp->Idlmax)
-#define doextract (curinterp->Idoextract)
-#define doswitches (curinterp->Idoswitches)
-#define dowarn (curinterp->Idowarn)
-#define dumplvl (curinterp->Idumplvl)
-#define e_fp (curinterp->Ie_fp)
-#define e_tmpname (curinterp->Ie_tmpname)
-#define endav (curinterp->Iendav)
-#define envgv (curinterp->Ienvgv)
-#define errgv (curinterp->Ierrgv)
-#define eval_root (curinterp->Ieval_root)
-#define eval_start (curinterp->Ieval_start)
-#define fdpid (curinterp->Ifdpid)
-#define filemode (curinterp->Ifilemode)
-#define firstgv (curinterp->Ifirstgv)
-#define forkprocess (curinterp->Iforkprocess)
-#define formfeed (curinterp->Iformfeed)
-#define formtarget (curinterp->Iformtarget)
-#define gensym (curinterp->Igensym)
-#define in_eval (curinterp->Iin_eval)
-#define incgv (curinterp->Iincgv)
-#define inplace (curinterp->Iinplace)
-#define last_in_gv (curinterp->Ilast_in_gv)
-#define lastfd (curinterp->Ilastfd)
-#define lastretstr (curinterp->Ilastretstr)
-#define lastscream (curinterp->Ilastscream)
-#define lastsize (curinterp->Ilastsize)
-#define lastspbase (curinterp->Ilastspbase)
-#define laststatval (curinterp->Ilaststatval)
-#define laststype (curinterp->Ilaststype)
-#define leftgv (curinterp->Ileftgv)
-#define lineary (curinterp->Ilineary)
-#define localizing (curinterp->Ilocalizing)
-#define localpatches (curinterp->Ilocalpatches)
-#define main_cv (curinterp->Imain_cv)
-#define main_root (curinterp->Imain_root)
-#define main_start (curinterp->Imain_start)
-#define mainstack (curinterp->Imainstack)
-#define maxscream (curinterp->Imaxscream)
-#define maxsysfd (curinterp->Imaxsysfd)
-#define mess_sv (curinterp->Imess_sv)
-#define minus_F (curinterp->Iminus_F)
-#define minus_a (curinterp->Iminus_a)
-#define minus_c (curinterp->Iminus_c)
-#define minus_l (curinterp->Iminus_l)
-#define minus_n (curinterp->Iminus_n)
-#define minus_p (curinterp->Iminus_p)
-#define multiline (curinterp->Imultiline)
-#define mystack_base (curinterp->Imystack_base)
-#define mystack_mark (curinterp->Imystack_mark)
-#define mystack_max (curinterp->Imystack_max)
-#define mystack_sp (curinterp->Imystack_sp)
-#define mystrk (curinterp->Imystrk)
-#define nrs (curinterp->Inrs)
-#define ofmt (curinterp->Iofmt)
-#define ofs (curinterp->Iofs)
-#define ofslen (curinterp->Iofslen)
-#define oldlastpm (curinterp->Ioldlastpm)
-#define oldname (curinterp->Ioldname)
-#define op_mask (curinterp->Iop_mask)
-#define origargc (curinterp->Iorigargc)
-#define origargv (curinterp->Iorigargv)
-#define origfilename (curinterp->Iorigfilename)
-#define ors (curinterp->Iors)
-#define orslen (curinterp->Iorslen)
-#define parsehook (curinterp->Iparsehook)
-#define patchlevel (curinterp->Ipatchlevel)
-#define perl_destruct_level (curinterp->Iperl_destruct_level)
-#define perldb (curinterp->Iperldb)
-#define preambleav (curinterp->Ipreambleav)
-#define preambled (curinterp->Ipreambled)
-#define preprocess (curinterp->Ipreprocess)
-#define restartop (curinterp->Irestartop)
-#define rightgv (curinterp->Irightgv)
-#define rs (curinterp->Irs)
-#define runlevel (curinterp->Irunlevel)
-#define sawampersand (curinterp->Isawampersand)
-#define sawstudy (curinterp->Isawstudy)
-#define sawvec (curinterp->Isawvec)
-#define screamfirst (curinterp->Iscreamfirst)
-#define screamnext (curinterp->Iscreamnext)
-#define secondgv (curinterp->Isecondgv)
-#define siggv (curinterp->Isiggv)
-#define signalstack (curinterp->Isignalstack)
-#define sortcop (curinterp->Isortcop)
-#define sortstack (curinterp->Isortstack)
-#define sortstash (curinterp->Isortstash)
-#define splitstr (curinterp->Isplitstr)
-#define start_env (curinterp->Istart_env)
-#define statcache (curinterp->Istatcache)
-#define statgv (curinterp->Istatgv)
-#define statname (curinterp->Istatname)
-#define statusvalue (curinterp->Istatusvalue)
-#define statusvalue_vms (curinterp->Istatusvalue_vms)
-#define stdingv (curinterp->Istdingv)
-#define strchop (curinterp->Istrchop)
-#define strtab (curinterp->Istrtab)
-#define sv_arenaroot (curinterp->Isv_arenaroot)
-#define sv_count (curinterp->Isv_count)
-#define sv_objcount (curinterp->Isv_objcount)
-#define sv_root (curinterp->Isv_root)
-#define tainted (curinterp->Itainted)
-#define tainting (curinterp->Itainting)
-#define tmps_floor (curinterp->Itmps_floor)
-#define tmps_ix (curinterp->Itmps_ix)
-#define tmps_max (curinterp->Itmps_max)
-#define tmps_stack (curinterp->Itmps_stack)
-#define top_env (curinterp->Itop_env)
-#define toptarget (curinterp->Itoptarget)
-#define unsafe (curinterp->Iunsafe)
-#define warnhook (curinterp->Iwarnhook)
-
-#else /* !MULTIPLICITY */
-
-#define IArgv Argv
-#define ICmd Cmd
-#define IDBgv DBgv
-#define IDBline DBline
-#define IDBsignal DBsignal
-#define IDBsingle DBsingle
-#define IDBsub DBsub
-#define IDBtrace DBtrace
-#define Iallgvs allgvs
-#define Iampergv ampergv
-#define Iargvgv argvgv
-#define Iargvoutgv argvoutgv
-#define Ibasetime basetime
-#define Ibeginav beginav
-#define Ibodytarget bodytarget
-#define Icddir cddir
-#define Ichopset chopset
-#define Icopline copline
-#define Icurblock curblock
-#define Icurcop curcop
-#define Icurcopdb curcopdb
-#define Icurcsv curcsv
-#define Icurpm curpm
-#define Icurstack curstack
-#define Icurstash curstash
-#define Icurstname curstname
-#define Icxstack cxstack
-#define Icxstack_ix cxstack_ix
-#define Icxstack_max cxstack_max
-#define Idbargs dbargs
-#define Idebdelim debdelim
-#define Idebname debname
-#define Idebstash debstash
-#define Idefgv defgv
-#define Idefoutgv defoutgv
-#define Idefstash defstash
-#define Idelaymagic delaymagic
-#define Idiehook diehook
-#define Idirty dirty
-#define Idlevel dlevel
-#define Idlmax dlmax
-#define Idoextract doextract
-#define Idoswitches doswitches
-#define Idowarn dowarn
-#define Idumplvl dumplvl
-#define Ie_fp e_fp
-#define Ie_tmpname e_tmpname
-#define Iendav endav
-#define Ienvgv envgv
-#define Ierrgv errgv
-#define Ieval_root eval_root
-#define Ieval_start eval_start
-#define Ifdpid fdpid
-#define Ifilemode filemode
-#define Ifirstgv firstgv
-#define Iforkprocess forkprocess
-#define Iformfeed formfeed
-#define Iformtarget formtarget
-#define Igensym gensym
-#define Iin_eval in_eval
-#define Iincgv incgv
-#define Iinplace inplace
-#define Ilast_in_gv last_in_gv
-#define Ilastfd lastfd
-#define Ilastretstr lastretstr
-#define Ilastscream lastscream
-#define Ilastsize lastsize
-#define Ilastspbase lastspbase
-#define Ilaststatval laststatval
-#define Ilaststype laststype
-#define Ileftgv leftgv
-#define Ilineary lineary
-#define Ilocalizing localizing
-#define Ilocalpatches localpatches
-#define Imain_cv main_cv
-#define Imain_root main_root
-#define Imain_start main_start
-#define Imainstack mainstack
-#define Imaxscream maxscream
-#define Imaxsysfd maxsysfd
-#define Imess_sv mess_sv
-#define Iminus_F minus_F
-#define Iminus_a minus_a
-#define Iminus_c minus_c
-#define Iminus_l minus_l
-#define Iminus_n minus_n
-#define Iminus_p minus_p
-#define Imultiline multiline
-#define Imystack_base mystack_base
-#define Imystack_mark mystack_mark
-#define Imystack_max mystack_max
-#define Imystack_sp mystack_sp
-#define Imystrk mystrk
-#define Inrs nrs
-#define Iofmt ofmt
-#define Iofs ofs
-#define Iofslen ofslen
-#define Ioldlastpm oldlastpm
-#define Ioldname oldname
-#define Iop_mask op_mask
-#define Iorigargc origargc
-#define Iorigargv origargv
-#define Iorigfilename origfilename
-#define Iors ors
-#define Iorslen orslen
-#define Iparsehook parsehook
-#define Ipatchlevel patchlevel
-#define Iperl_destruct_level perl_destruct_level
-#define Iperldb perldb
-#define Ipreambleav preambleav
-#define Ipreambled preambled
-#define Ipreprocess preprocess
-#define Irestartop restartop
-#define Irightgv rightgv
-#define Irs rs
-#define Irunlevel runlevel
-#define Isawampersand sawampersand
-#define Isawstudy sawstudy
-#define Isawvec sawvec
-#define Iscreamfirst screamfirst
-#define Iscreamnext screamnext
-#define Isecondgv secondgv
-#define Isiggv siggv
-#define Isignalstack signalstack
-#define Isortcop sortcop
-#define Isortstack sortstack
-#define Isortstash sortstash
-#define Isplitstr splitstr
-#define Istart_env start_env
-#define Istatcache statcache
-#define Istatgv statgv
-#define Istatname statname
-#define Istatusvalue statusvalue
-#define Istatusvalue_vms statusvalue_vms
-#define Istdingv stdingv
-#define Istrchop strchop
-#define Istrtab strtab
-#define Isv_arenaroot sv_arenaroot
-#define Isv_count sv_count
-#define Isv_objcount sv_objcount
-#define Isv_root sv_root
-#define Itainted tainted
-#define Itainting tainting
-#define Itmps_floor tmps_floor
-#define Itmps_ix tmps_ix
-#define Itmps_max tmps_max
-#define Itmps_stack tmps_stack
-#define Itop_env top_env
-#define Itoptarget toptarget
-#define Iunsafe unsafe
-#define Iwarnhook warnhook
-
-/* Hide interpreter-specific symbols? */
-
-#ifdef EMBED
-
-#define curcop Perl_curcop
-#define curcopdb Perl_curcopdb
-#define envgv Perl_envgv
-#define siggv Perl_siggv
-#define tainting Perl_tainting
-
-/* Hide interpreter symbols that 5.003 revealed? */
-
-#ifndef BINCOMPAT3
-
-#define Argv Perl_Argv
-#define Cmd Perl_Cmd
-#define DBgv Perl_DBgv
-#define DBline Perl_DBline
-#define DBsignal Perl_DBsignal
-#define DBsingle Perl_DBsingle
-#define DBsub Perl_DBsub
-#define DBtrace Perl_DBtrace
-#define allgvs Perl_allgvs
-#define ampergv Perl_ampergv
-#define argvgv Perl_argvgv
-#define argvoutgv Perl_argvoutgv
-#define basetime Perl_basetime
-#define beginav Perl_beginav
-#define bodytarget Perl_bodytarget
-#define cddir Perl_cddir
-#define chopset Perl_chopset
-#define copline Perl_copline
-#define curblock Perl_curblock
-#define curcsv Perl_curcsv
-#define curpm Perl_curpm
-#define curstack Perl_curstack
-#define curstash Perl_curstash
-#define curstname Perl_curstname
-#define cxstack Perl_cxstack
-#define cxstack_ix Perl_cxstack_ix
-#define cxstack_max Perl_cxstack_max
-#define dbargs Perl_dbargs
-#define debdelim Perl_debdelim
-#define debname Perl_debname
-#define debstash Perl_debstash
-#define defgv Perl_defgv
-#define defoutgv Perl_defoutgv
-#define defstash Perl_defstash
-#define delaymagic Perl_delaymagic
-#define diehook Perl_diehook
-#define dirty Perl_dirty
-#define dlevel Perl_dlevel
-#define dlmax Perl_dlmax
-#define doextract Perl_doextract
-#define doswitches Perl_doswitches
-#define dowarn Perl_dowarn
-#define dumplvl Perl_dumplvl
-#define e_fp Perl_e_fp
-#define e_tmpname Perl_e_tmpname
-#define endav Perl_endav
-#define errgv Perl_errgv
-#define eval_root Perl_eval_root
-#define eval_start Perl_eval_start
-#define fdpid Perl_fdpid
-#define filemode Perl_filemode
-#define firstgv Perl_firstgv
-#define forkprocess Perl_forkprocess
-#define formfeed Perl_formfeed
-#define formtarget Perl_formtarget
-#define gensym Perl_gensym
-#define in_eval Perl_in_eval
-#define incgv Perl_incgv
-#define inplace Perl_inplace
-#define last_in_gv Perl_last_in_gv
-#define lastfd Perl_lastfd
-#define lastretstr Perl_lastretstr
-#define lastscream Perl_lastscream
-#define lastsize Perl_lastsize
-#define lastspbase Perl_lastspbase
-#define laststatval Perl_laststatval
-#define laststype Perl_laststype
-#define leftgv Perl_leftgv
-#define lineary Perl_lineary
-#define localizing Perl_localizing
-#define localpatches Perl_localpatches
-#define main_cv Perl_main_cv
-#define main_root Perl_main_root
-#define main_start Perl_main_start
-#define mainstack Perl_mainstack
-#define maxscream Perl_maxscream
-#define maxsysfd Perl_maxsysfd
-#define mess_sv Perl_mess_sv
-#define minus_F Perl_minus_F
-#define minus_a Perl_minus_a
-#define minus_c Perl_minus_c
-#define minus_l Perl_minus_l
-#define minus_n Perl_minus_n
-#define minus_p Perl_minus_p
-#define multiline Perl_multiline
-#define mystack_base Perl_mystack_base
-#define mystack_mark Perl_mystack_mark
-#define mystack_max Perl_mystack_max
-#define mystack_sp Perl_mystack_sp
-#define mystrk Perl_mystrk
-#define nrs Perl_nrs
-#define ofmt Perl_ofmt
-#define ofs Perl_ofs
-#define ofslen Perl_ofslen
-#define oldlastpm Perl_oldlastpm
-#define oldname Perl_oldname
-#define op_mask Perl_op_mask
-#define origargc Perl_origargc
-#define origargv Perl_origargv
-#define origfilename Perl_origfilename
-#define ors Perl_ors
-#define orslen Perl_orslen
-#define parsehook Perl_parsehook
-#define patchlevel Perl_patchlevel
-#define perl_destruct_level Perl_perl_destruct_level
-#define perldb Perl_perldb
-#define preambleav Perl_preambleav
-#define preambled Perl_preambled
-#define preprocess Perl_preprocess
-#define restartop Perl_restartop
-#define rightgv Perl_rightgv
-#define rs Perl_rs
-#define runlevel Perl_runlevel
-#define sawampersand Perl_sawampersand
-#define sawstudy Perl_sawstudy
-#define sawvec Perl_sawvec
-#define screamfirst Perl_screamfirst
-#define screamnext Perl_screamnext
-#define secondgv Perl_secondgv
-#define signalstack Perl_signalstack
-#define sortcop Perl_sortcop
-#define sortstack Perl_sortstack
-#define sortstash Perl_sortstash
-#define splitstr Perl_splitstr
-#define start_env Perl_start_env
-#define statcache Perl_statcache
-#define statgv Perl_statgv
-#define statname Perl_statname
-#define statusvalue Perl_statusvalue
-#define statusvalue_vms Perl_statusvalue_vms
-#define stdingv Perl_stdingv
-#define strchop Perl_strchop
-#define strtab Perl_strtab
-#define sv_arenaroot Perl_sv_arenaroot
-#define sv_count Perl_sv_count
-#define sv_objcount Perl_sv_objcount
-#define sv_root Perl_sv_root
-#define tainted Perl_tainted
-#define tmps_floor Perl_tmps_floor
-#define tmps_ix Perl_tmps_ix
-#define tmps_max Perl_tmps_max
-#define tmps_stack Perl_tmps_stack
-#define top_env Perl_top_env
-#define toptarget Perl_toptarget
-#define unsafe Perl_unsafe
-#define warnhook Perl_warnhook
-
-#endif /* !BINCOMPAT3 */
-
#endif /* EMBED */
-#endif /* MULTIPLICITY */
diff --git a/gnu/usr.bin/perl/embed.pl b/gnu/usr.bin/perl/embed.pl
index 266a33e7e0a..497b97df355 100644
--- a/gnu/usr.bin/perl/embed.pl
+++ b/gnu/usr.bin/perl/embed.pl
@@ -2,6 +2,25 @@
require 5.003;
+# XXX others that may need adding
+# warnhook
+# hints
+# copline
+my @extvars = qw(sv_undef sv_yes sv_no na dowarn
+ curcop compiling
+ tainting tainted stack_base stack_sp sv_arenaroot
+ curstash DBsub DBsingle debstash
+ rsfp
+ stdingv
+ defgv
+ errgv
+ rsfp_filters
+ perldb
+ diehook
+ dirty
+ perl_destruct_level
+ );
+
sub readsyms (\%$) {
my ($syms, $file) = @_;
%$syms = ();
@@ -18,8 +37,56 @@ sub readsyms (\%$) {
}
readsyms %global, 'global.sym';
-readsyms %interp, 'interp.sym';
-readsyms %compat3, 'compat3.sym';
+
+sub readvars(\%$$) {
+ my ($syms, $file,$pre) = @_;
+ %$syms = ();
+ local (*FILE, $_);
+ open(FILE, "< $file")
+ or die "embed.pl: Can't open $file: $!\n";
+ while (<FILE>) {
+ s/[ \t]*#.*//; # Delete comments.
+ if (/PERLVARI?C?\($pre(\w+)/) {
+ $$syms{$1} = 1;
+ }
+ }
+ close(FILE);
+}
+
+my %intrp;
+my %thread;
+
+readvars %intrp, 'intrpvar.h','I';
+readvars %thread, 'thrdvar.h','T';
+readvars %globvar, 'perlvars.h','G';
+
+foreach my $sym (sort keys %intrp)
+ {
+ if (exists $global{$sym})
+ {
+ delete $global{$sym};
+ warn "$sym in global.sym as well as intrpvar.h\n";
+ }
+ }
+
+foreach my $sym (sort keys %globvar)
+ {
+ if (exists $global{$sym})
+ {
+ delete $global{$sym};
+ warn "$sym in global.sym as well as perlvars.h\n";
+ }
+ }
+
+foreach my $sym (sort keys %thread)
+ {
+ warn "$sym in intrpvar.h as well as thrdvar.h\n" if exists $intrp{$sym};
+ if (exists $global{$sym})
+ {
+ delete $global{$sym};
+ warn "$sym in global.sym as well as thrdvar.h\n";
+ }
+ }
sub hide ($$) {
my ($from, $to) = @_;
@@ -30,13 +97,19 @@ sub embed ($) {
my ($sym) = @_;
hide($sym, "Perl_$sym");
}
-sub multon ($) {
+sub embedvar ($) {
my ($sym) = @_;
- hide($sym, "(curinterp->I$sym)");
+# hide($sym, "Perl_$sym");
+ return '';
}
-sub multoff ($) {
- my ($sym) = @_;
- hide("I$sym", $sym);
+
+sub multon ($$$) {
+ my ($sym,$pre,$ptr) = @_;
+ hide("PL_$sym", "($ptr$pre$sym)");
+}
+sub multoff ($$) {
+ my ($sym,$pre) = @_;
+ return hide("PL_$pre$sym", "PL_$sym");
}
unlink 'embed.h';
@@ -45,8 +118,8 @@ open(EM, '> embed.h')
print EM <<'END';
/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
- This file is built by embed.pl from global.sym, interp.sym,
- and compat3.sym. Any changes made here will be lost!
+ This file is built by embed.pl from global.sym, intrpvar.h,
+ and thrdvar.h. Any changes made here will be lost!
*/
/* (Doing namespace management portably in C is really gross.) */
@@ -68,35 +141,60 @@ print EM <<'END';
END
for $sym (sort keys %global) {
- print EM embed($sym) unless $compat3{$sym};
+ print EM embed($sym);
}
print EM <<'END';
-/* Hide global symbols that 5.003 revealed? */
-
-#ifndef BINCOMPAT3
+#endif /* EMBED */
END
-for $sym (sort keys %global) {
- print EM embed($sym) if $compat3{$sym};
-}
+close(EM);
+
+unlink 'embedvar.h';
+open(EM, '> embedvar.h')
+ or die "Can't create embedvar.h: $!\n";
print EM <<'END';
+/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+ This file is built by embed.pl from global.sym, intrpvar.h,
+ and thrdvar.h. Any changes made here will be lost!
+*/
-#endif /* !BINCOMPAT3 */
+/* (Doing namespace management portably in C is really gross.) */
+
+/* EMBED has no run-time penalty, but helps keep the Perl namespace
+ from colliding with that used by other libraries pulled in
+ by extensions or by embedding perl. Allow a cc -DNO_EMBED
+ override, however, to keep binary compatability with previous
+ versions of perl.
+*/
-#endif /* EMBED */
/* Put interpreter-specific symbols into a struct? */
#ifdef MULTIPLICITY
+#ifndef USE_THREADS
+/* If we do not have threads then per-thread vars are per-interpreter */
+
+END
+
+for $sym (sort keys %thread) {
+ print EM multon($sym,'T','PL_curinterp->');
+}
+
+print EM <<'END';
+
+#endif /* !USE_THREADS */
+
+/* These are always per-interpreter if there is more than one */
+
END
-for $sym (sort keys %interp) {
- print EM multon($sym);
+for $sym (sort keys %intrp) {
+ print EM multon($sym,'I','PL_curinterp->');
}
print EM <<'END';
@@ -105,40 +203,113 @@ print EM <<'END';
END
-for $sym (sort keys %interp) {
- print EM multoff($sym);
+for $sym (sort keys %intrp) {
+ print EM multoff($sym,'I');
}
print EM <<'END';
-/* Hide interpreter-specific symbols? */
+#ifndef USE_THREADS
+
+END
+
+for $sym (sort keys %thread) {
+ print EM multoff($sym,'T');
+}
+
+print EM <<'END';
+
+#endif /* USE_THREADS */
+
+/* Hide what would have been interpreter-specific symbols? */
#ifdef EMBED
END
-for $sym (sort keys %interp) {
- print EM embed($sym) if $compat3{$sym};
+for $sym (sort keys %intrp) {
+ print EM embedvar($sym);
+}
+
+print EM <<'END';
+
+#ifndef USE_THREADS
+
+END
+
+for $sym (sort keys %thread) {
+ print EM embedvar($sym);
+}
+
+print EM <<'END';
+
+#endif /* USE_THREADS */
+#endif /* EMBED */
+#endif /* MULTIPLICITY */
+
+/* Now same trickey for per-thread variables */
+
+#ifdef USE_THREADS
+
+END
+
+for $sym (sort keys %thread) {
+ print EM multon($sym,'T','thr->');
}
print EM <<'END';
-/* Hide interpreter symbols that 5.003 revealed? */
+#endif /* USE_THREADS */
-#ifndef BINCOMPAT3
+#ifdef PERL_GLOBAL_STRUCT
END
-for $sym (sort keys %interp) {
- print EM embed($sym) unless $compat3{$sym};
+for $sym (sort keys %globvar) {
+ print EM multon($sym,'G','PL_Vars.');
}
print EM <<'END';
-#endif /* !BINCOMPAT3 */
+#else /* !PERL_GLOBAL_STRUCT */
+
+END
+
+for $sym (sort keys %globvar) {
+ print EM multoff($sym,'G');
+}
+
+print EM <<'END';
+
+#ifdef EMBED
+
+END
+
+for $sym (sort keys %globvar) {
+ print EM embedvar($sym);
+}
+
+print EM <<'END';
#endif /* EMBED */
+#endif /* PERL_GLOBAL_STRUCT */
-#endif /* MULTIPLICITY */
END
+print EM <<'END';
+
+#ifndef MIN_PERL_DEFINE
+
+END
+
+for $sym (sort @extvars) {
+ print EM hide($sym,"PL_$sym");
+}
+
+print EM <<'END';
+
+#endif /* MIN_PERL_DEFINE */
+END
+
+
+close(EM);
diff --git a/gnu/usr.bin/perl/ext/DB_File/DB_File.pm b/gnu/usr.bin/perl/ext/DB_File/DB_File.pm
index df1593fd657..e5759ff5585 100644
--- a/gnu/usr.bin/perl/ext/DB_File/DB_File.pm
+++ b/gnu/usr.bin/perl/ext/DB_File/DB_File.pm
@@ -1,10 +1,10 @@
# DB_File.pm -- Perl 5 interface to Berkeley DB
#
-# written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
-# last modified 29th Jun 1997
-# version 1.15
+# written by Paul Marquess (Paul.Marquess@btinternet.com)
+# last modified 6th March 1999
+# version 1.65
#
-# Copyright (c) 1995, 1996, 1997 Paul Marquess. All rights reserved.
+# Copyright (c) 1995-9 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.
@@ -141,11 +141,11 @@ sub TIEHASH
package DB_File ;
use strict;
-use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO) ;
+use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO $db_version) ;
use Carp;
-$VERSION = "1.15" ;
+$VERSION = "1.65" ;
#typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
$DB_BTREE = new DB_File::BTREEINFO ;
@@ -212,13 +212,25 @@ sub AUTOLOAD {
eval {
- # Make all Fcntl O_XXX constants available for importing
- require Fcntl;
- my @O = grep /^O_/, @Fcntl::EXPORT;
- Fcntl->import(@O); # first we import what we want to export
- push(@EXPORT, @O);
+ # Make all Fcntl O_XXX constants available for importing
+ require Fcntl;
+ my @O = grep /^O_/, @Fcntl::EXPORT;
+ Fcntl->import(@O); # first we import what we want to export
+ push(@EXPORT, @O);
};
+## import borrowed from IO::File
+## exports Fcntl constants if available.
+#sub import {
+# my $pkg = shift;
+# my $callpkg = caller;
+# Exporter::export $pkg, $callpkg, @_;
+# eval {
+# require Fcntl;
+# Exporter::export 'Fcntl', $callpkg, '/^O_/';
+# };
+#}
+
bootstrap DB_File $VERSION;
# Preloaded methods go here. Autoload methods go after __END__, and are
@@ -232,6 +244,14 @@ sub tie_hash_or_array
$arg[4] = tied %{ $arg[4] }
if @arg >= 5 && ref $arg[4] && $arg[4] =~ /=HASH/ && tied %{ $arg[4] } ;
+ # make recno in Berkeley DB version 2 work like recno in version 1.
+ if ($db_version > 1 and defined $arg[4] and $arg[4] =~ /RECNO/ and
+ $arg[1] and ! -e $arg[1]) {
+ open(FH, ">$arg[1]") or return undef ;
+ close FH ;
+ chmod $arg[3] ? $arg[3] : 0666 , $arg[1] ;
+ }
+
DoTie_($tieHASH, @arg) ;
}
@@ -245,6 +265,75 @@ sub TIEARRAY
tie_hash_or_array(@_) ;
}
+sub CLEAR
+{
+ my $self = shift;
+ my $key = "" ;
+ my $value = "" ;
+ my $status = $self->seq($key, $value, R_FIRST());
+ my @keys;
+
+ while ($status == 0) {
+ push @keys, $key;
+ $status = $self->seq($key, $value, R_NEXT());
+ }
+ foreach $key (reverse @keys) {
+ my $s = $self->del($key);
+ }
+}
+
+sub EXTEND { }
+
+sub STORESIZE
+{
+ my $self = shift;
+ my $length = shift ;
+ my $current_length = $self->length() ;
+
+ if ($length < $current_length) {
+ my $key ;
+ for ($key = $current_length - 1 ; $key >= $length ; -- $key)
+ { $self->del($key) }
+ }
+ elsif ($length > $current_length) {
+ $self->put($length-1, "") ;
+ }
+}
+
+sub find_dup
+{
+ croak "Usage: \$db->find_dup(key,value)\n"
+ unless @_ == 3 ;
+
+ my $db = shift ;
+ my ($origkey, $value_wanted) = @_ ;
+ my ($key, $value) = ($origkey, 0);
+ my ($status) = 0 ;
+
+ for ($status = $db->seq($key, $value, R_CURSOR() ) ;
+ $status == 0 ;
+ $status = $db->seq($key, $value, R_NEXT() ) ) {
+
+ return 0 if $key eq $origkey and $value eq $value_wanted ;
+ }
+
+ return $status ;
+}
+
+sub del_dup
+{
+ croak "Usage: \$db->del_dup(key,value)\n"
+ unless @_ == 3 ;
+
+ my $db = shift ;
+ my ($key, $value) = @_ ;
+ my ($status) = $db->find_dup($key, $value) ;
+ return $status if $status != 0 ;
+
+ $status = $db->del($key, R_CURSOR() ) ;
+ return $status ;
+}
+
sub get_dup
{
croak "Usage: \$db->get_dup(key [,flag])\n"
@@ -288,7 +377,7 @@ __END__
=head1 NAME
-DB_File - Perl5 access to Berkeley DB
+DB_File - Perl5 access to Berkeley DB version 1.x
=head1 SYNOPSIS
@@ -309,6 +398,8 @@ DB_File - Perl5 access to Berkeley DB
$count = $X->get_dup($key) ;
@list = $X->get_dup($key) ;
%list = $X->get_dup($key, 1) ;
+ $status = $X->find_dup($key, $value) ;
+ $status = $X->del_dup($key, $value) ;
# RECNO only
$a = $X->length;
@@ -323,14 +414,11 @@ DB_File - Perl5 access to Berkeley DB
=head1 DESCRIPTION
B<DB_File> is a module which allows Perl programs to make use of the
-facilities provided by Berkeley DB. If you intend to use this
-module you should really have a copy of the Berkeley DB manual pages at
-hand. The interface defined here mirrors the Berkeley DB interface
-closely.
-
-Please note that this module will only work with version 1.x of
-Berkeley DB. Once Berkeley DB version 2 is released, B<DB_File> will be
-upgraded to work with it.
+facilities provided by Berkeley DB version 1.x (if you have a newer
+version of DB, see L<Using DB_File with Berkeley DB version 2>). It is
+assumed that you have a copy of the Berkeley DB manual pages at hand
+when reading this documentation. The interface defined here mirrors the
+Berkeley DB interface closely.
Berkeley DB is a C library which provides a consistent interface to a
number of database formats. B<DB_File> provides an interface to all
@@ -371,6 +459,33 @@ number.
=back
+=head2 Using DB_File with Berkeley DB version 2
+
+Although B<DB_File> is intended to be used with Berkeley DB version 1,
+it can also be used with version 2. In this case the interface is
+limited to the functionality provided by Berkeley DB 1.x. Anywhere the
+version 2 interface differs, B<DB_File> arranges for it to work like
+version 1. This feature allows B<DB_File> scripts that were built with
+version 1 to be migrated to version 2 without any changes.
+
+If you want to make use of the new features available in Berkeley DB
+2.x, use the Perl module B<BerkeleyDB> instead.
+
+At the time of writing this document the B<BerkeleyDB> module is still
+alpha quality (the version number is < 1.0), and so unsuitable for use
+in any serious development work. Once its version number is >= 1.0, it
+is considered stable enough for real work.
+
+B<Note:> The database file format has changed in Berkeley DB version 2.
+If you cannot recreate your databases, you must dump any existing
+databases with the C<db_dump185> utility that comes with Berkeley DB.
+Once you have rebuilt DB_File to use Berkeley DB version 2, your
+databases can be recreated using C<db_load>. Refer to the Berkeley DB
+documentation for further details.
+
+Please read L<"COPYRIGHT"> before using version 2.x of Berkeley DB with
+DB_File.
+
=head2 Interface to Berkeley DB
B<DB_File> allows access to Berkeley DB files using the tie() mechanism
@@ -758,9 +873,12 @@ that prints:
This time we have got all the key/value pairs, including the multiple
values associated with the key C<Wall>.
+To make life easier when dealing with duplicate keys, B<DB_File> comes with
+a few utility methods.
+
=head2 The get_dup() Method
-B<DB_File> comes with a utility method, called C<get_dup>, to assist in
+The C<get_dup> method assists in
reading duplicate values from BTREE databases. The method can take the
following forms:
@@ -809,6 +927,79 @@ and it will print:
Smith => [John]
Dog => []
+=head2 The find_dup() Method
+
+ $status = $X->find_dup($key, $value) ;
+
+This method checks for the existance of a specific key/value pair. If the
+pair exists, the cursor is left pointing to the pair and the method
+returns 0. Otherwise the method returns a non-zero value.
+
+Assuming the database from the previous example:
+
+ use strict ;
+ use DB_File ;
+
+ use vars qw($filename $x %h $found) ;
+
+ my $filename = "tree" ;
+
+ # Enable duplicate records
+ $DB_BTREE->{'flags'} = R_DUP ;
+
+ $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE
+ or die "Cannot open $filename: $!\n";
+
+ $found = ( $x->find_dup("Wall", "Larry") == 0 ? "" : "not") ;
+ print "Larry Wall is $found there\n" ;
+
+ $found = ( $x->find_dup("Wall", "Harry") == 0 ? "" : "not") ;
+ print "Harry Wall is $found there\n" ;
+
+ undef $x ;
+ untie %h ;
+
+prints this
+
+ Larry Wall is there
+ Harry Wall is not there
+
+
+=head2 The del_dup() Method
+
+ $status = $X->del_dup($key, $value) ;
+
+This method deletes a specific key/value pair. It returns
+0 if they exist and have been deleted successfully.
+Otherwise the method returns a non-zero value.
+
+Again assuming the existance of the C<tree> database
+
+ use strict ;
+ use DB_File ;
+
+ use vars qw($filename $x %h $found) ;
+
+ my $filename = "tree" ;
+
+ # Enable duplicate records
+ $DB_BTREE->{'flags'} = R_DUP ;
+
+ $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE
+ or die "Cannot open $filename: $!\n";
+
+ $x->del_dup("Wall", "Larry") ;
+
+ $found = ( $x->find_dup("Wall", "Larry") == 0 ? "" : "not") ;
+ print "Larry Wall is $found there\n" ;
+
+ undef $x ;
+ untie %h ;
+
+prints this
+
+ Larry Wall is not there
+
=head2 Matching Partial Keys
The BTREE interface has a feature which allows partial keys to be
@@ -891,7 +1082,7 @@ Here is the output:
DB_RECNO provides an interface to flat text files. Both variable and
fixed length records are supported.
-In order to make RECNO more compatible with Perl the array offset for
+In order to make RECNO more compatible with Perl, the array offset for
all RECNO arrays begins at 0 rather than 1 as in Berkeley DB.
As with normal Perl arrays, a RECNO array can be accessed using
@@ -920,7 +1111,7 @@ error will be fixed in the next release of Berkeley DB.
That clarifies the situation with regards Berkeley DB itself. What
about B<DB_File>? Well, the behavior defined in the quote above is
-quite useful, so B<DB_File> conforms it.
+quite useful, so B<DB_File> conforms to it.
That means that you can specify other options (e.g. cachesize) and
still have bval default to C<"\n"> for variable length records, and
@@ -928,7 +1119,9 @@ space for fixed length records.
=head2 A Simple Example
-Here is a simple example that uses RECNO.
+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<Extra RECNO Methods> for a workaround).
use strict ;
use DB_File ;
@@ -942,6 +1135,18 @@ Here is a simple example that uses RECNO.
$h[1] = "blue" ;
$h[2] = "yellow" ;
+ push @h, "green", "black" ;
+
+ my $elements = scalar @h ;
+ print "The array contains $elements entries\n" ;
+
+ my $last = pop @h ;
+ print "popped $last\n" ;
+
+ unshift @h, "white" ;
+ my $first = shift @h ;
+ print "shifted $first\n" ;
+
# Check for existence of a key
print "Element 1 Exists with value $h[1]\n" if $h[1] ;
@@ -953,18 +1158,24 @@ Here is a simple example that uses RECNO.
Here is the output from the script:
-
+ The array contains 5 entries
+ popped black
+ unshifted white
Element 1 Exists with value blue
- The last element is yellow
- The 2nd last element is blue
+ The last element is green
+ The 2nd last element is yellow
+
+=head2 Extra RECNO Methods
-=head2 Extra Methods
+If you are using a version of Perl earlier than 5.004_57, the tied
+array interface is quite limited. In the example script above
+C<push>, C<pop>, C<shift>, C<unshift>
+or determining the array length will not work with a tied array.
-As you can see from the example above, the tied array interface is
-quite limited. To make the interface more useful, a number of methods
-are supplied with B<DB_File> to simulate the standard array operations
-that are not currently implemented in Perl's tied array interface. All
-these methods are accessed via the object returned from the tie call.
+To make the interface more useful for older versions of Perl, a number
+of methods are supplied with B<DB_File> to simulate the missing array
+operations. All these methods are accessed via the object returned from
+the tie call.
Here are the methods:
@@ -1537,152 +1748,13 @@ of having a C<use strict> in all your scripts.
=head1 HISTORY
-=over
-
-=item 0.1
-
-First Release.
-
-=item 0.2
-
-When B<DB_File> is opening a database file it no longer terminates the
-process if I<dbopen> returned an error. This allows file protection
-errors to be caught at run time. Thanks to Judith Grass
-E<lt>grass@cybercash.comE<gt> for spotting the bug.
-
-=item 0.3
-
-Added prototype support for multiple btree compare callbacks.
-
-=item 1.0
-
-B<DB_File> has been in use for over a year. To reflect that, the
-version number has been incremented to 1.0.
-
-Added complete support for multiple concurrent callbacks.
-
-Using the I<push> method on an empty list didn't work properly. This
-has been fixed.
-
-=item 1.01
-
-Fixed a core dump problem with SunOS.
-
-The return value from TIEHASH wasn't set to NULL when dbopen returned
-an error.
-
-=item 1.02
-
-Merged OS/2 specific code into DB_File.xs
-
-Removed some redundant code in DB_File.xs.
-
-Documentation update.
-
-Allow negative subscripts with RECNO interface.
-
-Changed the default flags from O_RDWR to O_CREAT|O_RDWR.
-
-The example code which showed how to lock a database needed a call to
-C<sync> added. Without it the resultant database file was empty.
-
-Added get_dup method.
-
-=item 1.03
-
-Documentation update.
-
-B<DB_File> now imports the constants (O_RDWR, O_CREAT etc.) from Fcntl
-automatically.
-
-The standard hash function C<exists> is now supported.
-
-Modified the behavior of get_dup. When it returns an associative
-array, the value is the count of the number of matching BTREE values.
-
-=item 1.04
-
-Minor documentation changes.
-
-Fixed a bug in hash_cb. Patches supplied by Dave Hammen,
-E<lt>hammen@gothamcity.jsc.nasa.govE<gt>.
-
-Fixed a bug with the constructors for DB_File::HASHINFO,
-DB_File::BTREEINFO and DB_File::RECNOINFO. Also tidied up the
-constructors to make them C<-w> clean.
-
-Reworked part of the test harness to be more locale friendly.
-
-=item 1.05
-
-Made all scripts in the documentation C<strict> and C<-w> clean.
-
-Added logic to F<DB_File.xs> to allow the module to be built after Perl
-is installed.
-
-=item 1.06
-
-Minor namespace cleanup: Localized C<PrintBtree>.
-
-=item 1.07
-
-Fixed bug with RECNO, where bval wasn't defaulting to "\n".
-
-=item 1.08
-
-Documented operation of bval.
-
-=item 1.09
-
-Minor bug fix in DB_File::HASHINFO, DB_File::RECNOINFO and
-DB_File::BTREEINFO.
-
-Changed default mode to 0666.
-
-=item 1.10
-
-Fixed fd method so that it still returns -1 for in-memory files when db
-1.86 is used.
-
-=item 1.11
-
-Documented the untie gotcha.
-
-=item 1.12
-
-Documented the incompatibility with version 2 of Berkeley DB.
-
-=item 1.13
-
-Minor changes to DB_FIle.xs and DB_File.pm
-
-=item 1.14
-
-Made it illegal to tie an associative array to a RECNO database and an
-ordinary array to a HASH or BTREE database.
-
-=item 1.15
-
-Patch from Gisle Aas <gisle@aas.no> to suppress "use of undefined
-value" warning with db_get and db_seq.
-
-Patch from Gisle Aas <gisle@aas.no> to make DB_File export only the O_*
-constants from Fcntl.
-
-Removed the DESTROY method from the DB_File::HASHINFO module.
-
-Previously DB_File hard-wired the class name of any object that it
-created to "DB_File". This makes sub-classing difficult. Now DB_File
-creats objects in the namespace of the package it has been inherited
-into.
-
-=back
+Moved to the Changes file.
=head1 BUGS
Some older versions of Berkeley DB had problems with fixed length
-records using the RECNO file format. The newest version at the time of
-writing was 1.85 - this seems to have fixed the problems with RECNO.
+records using the RECNO file format. This problem has been fixed since
+version 1.85 of Berkeley DB.
I am sure there are bugs in the code. If you do find any, or can
suggest any enhancements, I would welcome your comments.
@@ -1690,38 +1762,51 @@ suggest any enhancements, I would welcome your comments.
=head1 AVAILABILITY
B<DB_File> comes with the standard Perl source distribution. Look in
-the directory F<ext/DB_File>.
+the directory F<ext/DB_File>. Given the amount of time between releases
+of Perl the version that ships with Perl is quite likely to be out of
+date, so the most recent version can always be found on CPAN (see
+L<perlmod/CPAN> for details), in the directory
+F<modules/by-module/DB_File>.
+
+This version of B<DB_File> will work with either version 1.x or 2.x of
+Berkeley DB, but is limited to the functionality provided by version 1.
-This version of B<DB_File> will only work with version 1.x of Berkeley
-DB. It is I<not> yet compatible with version 2.
+The official web site for Berkeley DB is
+F<http://www.sleepycat.com/db>. The ftp equivalent is
+F<ftp.sleepycat.com:/pub>. Both versions 1 and 2 of Berkeley DB are
+available there.
-Version 1 of Berkeley DB is available at your nearest CPAN archive (see
-L<perlmod/"CPAN"> for a list) in F<src/misc/db.1.85.tar.gz>, or via the
-host F<ftp.cs.berkeley.edu> in F</ucb/4bsd/db.tar.gz>. Alternatively,
-check out the Berkeley DB home page at F<http://www.bostic.com/db>. It
-is I<not> under the GPL.
+Alternatively, Berkeley DB version 1 is available at your nearest CPAN
+archive in F<src/misc/db.1.85.tar.gz>.
-If you are running IRIX, then get Berkeley DB from
+If you are running IRIX, then get Berkeley DB version 1 from
F<http://reality.sgi.com/ariel>. It has the patches necessary to
compile properly on IRIX 5.3.
-As of January 1997, version 1.86 of Berkeley DB is available from the
-Berkeley DB home page. Although this release does fix a number of bugs
-that were present in 1.85 you should be aware of the following
-information (taken from the Berkeley DB home page) before you consider
-using it:
+=head1 COPYRIGHT
+
+Copyright (c) 1995-9 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.
+
+Although B<DB_File> is covered by the Perl license, the library it
+makes use of, namely Berkeley DB, is not. Berkeley DB has its own
+copyright and its own license. Please take the time to read it.
+
+Here are are few words taken from the Berkeley DB FAQ (at
+http://www.sleepycat.com) regarding the license:
+
+ Do I have to license DB to use it in Perl scripts?
- DB version 1.86 includes a new implementation of the hash access
- method that fixes a variety of hashing problems found in DB version
- 1.85. We are making it available as an interim solution until DB
- 2.0 is available.
+ No. The Berkeley DB license requires that software that uses
+ Berkeley DB be freely redistributable. In the case of Perl, that
+ software is Perl, and not your scripts. Any Perl scripts that you
+ write are your property, including scripts that make use of
+ Berkeley DB. Neither the Perl license nor the Berkeley DB license
+ place any restriction on what you may do with them.
- PLEASE NOTE: the underlying file format for the hash access method
- changed between version 1.85 and version 1.86, so you will have to
- dump and reload all of your databases to convert from version 1.85
- to version 1.86. If you do not absolutely require the fixes from
- version 1.86, we strongly urge you to wait until DB 2.0 is released
- before upgrading from 1.85.
+If you are in any doubt about the license situation, contact either the
+Berkeley DB authors or the author of DB_File. See L<"AUTHOR"> for details.
=head1 SEE ALSO
@@ -1731,7 +1816,7 @@ L<perl(1)>, L<dbopen(3)>, L<hash(3)>, L<recno(3)>, L<btree(3)>
=head1 AUTHOR
The DB_File interface was written by Paul Marquess
-E<lt>pmarquess@bfsec.bt.co.ukE<gt>.
+E<lt>Paul.Marquess@btinternet.comE<gt>.
Questions about the DB system itself may be addressed to
E<lt>db@sleepycat.com<gt>.
diff --git a/gnu/usr.bin/perl/ext/DB_File/DB_File.xs b/gnu/usr.bin/perl/ext/DB_File/DB_File.xs
index d2c7e6c645b..94113eb4e28 100644
--- a/gnu/usr.bin/perl/ext/DB_File/DB_File.xs
+++ b/gnu/usr.bin/perl/ext/DB_File/DB_File.xs
@@ -2,13 +2,13 @@
DB_File.xs -- Perl 5 interface to Berkeley DB
- written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
- last modified 29th Jun 1997
- version 1.15
+ written by Paul Marquess <Paul.Marquess@btinternet.com>
+ last modified 6th March 1999
+ version 1.65
All comments/suggestions/problems are welcome
- Copyright (c) 1995, 1996, 1997 Paul Marquess. All rights reserved.
+ Copyright (c) 1995-9 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.
@@ -39,11 +39,33 @@
in-memory files when db 1.86 is used.
1.11 - No change to DB_File.xs
1.12 - No change to DB_File.xs
- 1.13 - Tidied up a few casts.
- 1.14 - Made it illegal to tie an associative array to a RECNO
- database and an ordinary array to a HASH or BTREE database.
- 1.15 - Patch from Gisle Aas <gisle@aas.no> to suppress "use of
+ 1.13 - Tidied up a few casts.
+ 1.14 - Made it illegal to tie an associative array to a RECNO
+ database and an ordinary array to a HASH or BTREE database.
+ 1.50 - Make work with both DB 1.x or DB 2.x
+ 1.51 - Fixed a bug in mapping 1.x O_RDONLY flag to 2.x DB_RDONLY equivalent
+ 1.52 - Patch from Gisle Aas <gisle@aas.no> to suppress "use of
undefined value" warning with db_get and db_seq.
+ 1.53 - Added DB_RENUMBER to flags for recno.
+ 1.54 - Fixed bug in the fd method
+ 1.55 - Fix for AIX from Jarkko Hietaniemi
+ 1.56 - No change to DB_File.xs
+ 1.57 - added the #undef op to allow building with Threads support.
+ 1.58 - Fixed a problem with the use of sv_setpvn. When the
+ size is specified as 0, it does a strlen on the data.
+ This was ok for DB 1.x, but isn't for DB 2.x.
+ 1.59 - No change to DB_File.xs
+ 1.60 - Some code tidy up
+ 1.61 - added flagSet macro for DB 2.5.x
+ fixed typo in O_RDONLY test.
+ 1.62 - No change to DB_File.xs
+ 1.63 - Fix to alllow DB 2.6.x to build.
+ 1.64 - Tidied up the 1.x to 2.x flags mapping code.
+ Added a patch from Mark Kettenis <kettenis@wins.uva.nl>
+ to fix a flag mapping problem with O_RDONLY on the Hurd
+ 1.65 - Fixed a bug in the PUSH logic.
+ Added BOOT check that using 2.3.4 or greater
+
*/
@@ -52,13 +74,123 @@
#include "perl.h"
#include "XSUB.h"
+#ifndef PERL_VERSION
+#include "patchlevel.h"
+#define PERL_REVISION 5
+#define PERL_VERSION PATCHLEVEL
+#define PERL_SUBVERSION SUBVERSION
+#endif
+
+#if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
+
+# define PL_sv_undef sv_undef
+# define PL_na na
+
+#endif
+
+/* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
+ * shortly #included by the <db.h>) __attribute__ to the possibly
+ * already defined __attribute__, for example by GNUC or by Perl. */
+
+#undef __attribute__
+
+/* If Perl has been compiled with Threads support,the symbol op will
+ be defined here. This clashes with a field name in db.h, so get rid of it.
+ */
+#ifdef op
+#undef op
+#endif
#include <db.h>
-/* #ifdef DB_VERSION_MAJOR */
-/* #include <db_185.h> */
-/* #endif */
#include <fcntl.h>
+/* #define TRACE */
+
+
+
+#ifdef DB_VERSION_MAJOR
+
+/* map version 2 features & constants onto their version 1 equivalent */
+
+#ifdef DB_Prefix_t
+#undef DB_Prefix_t
+#endif
+#define DB_Prefix_t size_t
+
+#ifdef DB_Hash_t
+#undef DB_Hash_t
+#endif
+#define DB_Hash_t u_int32_t
+
+/* DBTYPE stays the same */
+/* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
+typedef DB_INFO INFO ;
+
+/* version 2 has db_recno_t in place of recno_t */
+typedef db_recno_t recno_t;
+
+
+#define R_CURSOR DB_SET_RANGE
+#define R_FIRST DB_FIRST
+#define R_IAFTER DB_AFTER
+#define R_IBEFORE DB_BEFORE
+#define R_LAST DB_LAST
+#define R_NEXT DB_NEXT
+#define R_NOOVERWRITE DB_NOOVERWRITE
+#define R_PREV DB_PREV
+#define R_SETCURSOR 0
+#define R_RECNOSYNC 0
+#define R_FIXEDLEN DB_FIXEDLEN
+#define R_DUP DB_DUP
+
+#define db_HA_hash h_hash
+#define db_HA_ffactor h_ffactor
+#define db_HA_nelem h_nelem
+#define db_HA_bsize db_pagesize
+#define db_HA_cachesize db_cachesize
+#define db_HA_lorder db_lorder
+
+#define db_BT_compare bt_compare
+#define db_BT_prefix bt_prefix
+#define db_BT_flags flags
+#define db_BT_psize db_pagesize
+#define db_BT_cachesize db_cachesize
+#define db_BT_lorder db_lorder
+#define db_BT_maxkeypage
+#define db_BT_minkeypage
+
+
+#define db_RE_reclen re_len
+#define db_RE_flags flags
+#define db_RE_bval re_pad
+#define db_RE_bfname re_source
+#define db_RE_psize db_pagesize
+#define db_RE_cachesize db_cachesize
+#define db_RE_lorder db_lorder
+
+#define TXN NULL,
+
+#define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
+
+
+#define DBT_flags(x) x.flags = 0
+#define DB_flags(x, v) x |= v
+
+#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
+#define flagSet(flags, bitmask) ((flags) & (bitmask))
+#else
+#define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
+#endif
+
+#else /* db version 1.x */
+
+typedef union INFO {
+ HASHINFO hash ;
+ RECNOINFO recno ;
+ BTREEINFO btree ;
+ } INFO ;
+
+
#ifdef mDB_Prefix_t
#ifdef DB_Prefix_t
#undef DB_Prefix_t
@@ -73,11 +205,66 @@
#define DB_Hash_t mDB_Hash_t
#endif
-union INFO {
- HASHINFO hash ;
- RECNOINFO recno ;
- BTREEINFO btree ;
- } ;
+#define db_HA_hash hash.hash
+#define db_HA_ffactor hash.ffactor
+#define db_HA_nelem hash.nelem
+#define db_HA_bsize hash.bsize
+#define db_HA_cachesize hash.cachesize
+#define db_HA_lorder hash.lorder
+
+#define db_BT_compare btree.compare
+#define db_BT_prefix btree.prefix
+#define db_BT_flags btree.flags
+#define db_BT_psize btree.psize
+#define db_BT_cachesize btree.cachesize
+#define db_BT_lorder btree.lorder
+#define db_BT_maxkeypage btree.maxkeypage
+#define db_BT_minkeypage btree.minkeypage
+
+#define db_RE_reclen recno.reclen
+#define db_RE_flags recno.flags
+#define db_RE_bval recno.bval
+#define db_RE_bfname recno.bfname
+#define db_RE_psize recno.psize
+#define db_RE_cachesize recno.cachesize
+#define db_RE_lorder recno.lorder
+
+#define TXN
+
+#define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
+#define DBT_flags(x)
+#define DB_flags(x, v)
+#define flagSet(flags, bitmask) ((flags) & (bitmask))
+
+#endif /* db version 1 */
+
+
+
+#define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
+#define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
+#define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
+
+#define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
+#define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
+
+#ifdef DB_VERSION_MAJOR
+#define db_DESTROY(db) ((db->dbp)->close)(db->dbp, 0)
+#define db_close(db) ((db->dbp)->close)(db->dbp, 0)
+#define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
+ ? ((db->cursor)->c_del)(db->cursor, 0) \
+ : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
+
+#else
+
+#define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
+#define db_close(db) ((db->dbp)->close)(db->dbp)
+#define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
+#define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
+
+#endif
+
+
+#define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
typedef struct {
DBTYPE type ;
@@ -86,53 +273,101 @@ typedef struct {
SV * prefix ;
SV * hash ;
int in_memory ;
- union INFO info ;
+ INFO info ;
+#ifdef DB_VERSION_MAJOR
+ DBC * cursor ;
+#endif
} DB_File_type;
typedef DB_File_type * DB_File ;
typedef DBT DBTKEY ;
-
-/* #define TRACE */
-
-#define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
-#define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
-#define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
-#define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, &key, &value, flags)
-
-#define db_close(db) ((db->dbp)->close)(db->dbp)
-#define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
-#define db_fd(db) (db->in_memory \
- ? -1 \
- : ((db->dbp)->fd)(db->dbp) )
-#define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
-#define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, &key, &value, flags)
-#define db_seq(db, key, value, flags) ((db->dbp)->seq)(db->dbp, &key, &value, flags)
-#define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
-
+#define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
#define OutputValue(arg, name) \
{ if (RETVAL == 0) { \
- sv_setpvn(arg, name.data, name.size) ; \
+ my_sv_setpvn(arg, name.data, name.size) ; \
} \
}
#define OutputKey(arg, name) \
- { if (RETVAL == 0) \
+ { if (RETVAL == 0) \
{ \
if (db->type != DB_RECNO) { \
- sv_setpvn(arg, name.data, name.size); \
+ my_sv_setpvn(arg, name.data, name.size); \
} \
else \
sv_setiv(arg, (I32)*(I32*)name.data - 1); \
} \
}
+
/* Internal Global Data */
static recno_t Value ;
-static DB_File CurrentDB ;
static recno_t zero = 0 ;
-static DBTKEY empty = { &zero, sizeof(recno_t) } ;
+static DB_File CurrentDB ;
+static DBTKEY empty ;
+
+#ifdef DB_VERSION_MAJOR
+
+static int
+db_put(db, key, value, flags)
+DB_File db ;
+DBTKEY key ;
+DBT value ;
+u_int flags ;
+
+{
+ int status ;
+
+ if (flagSet(flags, R_CURSOR)) {
+ status = ((db->cursor)->c_del)(db->cursor, 0);
+ if (status != 0)
+ return status ;
+
+#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
+ flags &= ~R_CURSOR ;
+#else
+ flags &= ~DB_OPFLAGS_MASK ;
+#endif
+
+ }
+
+ return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
+
+}
+
+#endif /* DB_VERSION_MAJOR */
+
+static void
+GetVersionInfo()
+{
+ SV * ver_sv = perl_get_sv("DB_File::db_version", TRUE) ;
+#ifdef DB_VERSION_MAJOR
+ int Major, Minor, Patch ;
+
+ (void)db_version(&Major, &Minor, &Patch) ;
+
+ /* check that libdb is recent enough -- we need 2.3.4 or greater */
+ if (Major == 2 && (Minor < 3 || (Minor == 3 && Patch < 4)))
+ croak("DB_File needs Berkeley DB 2.3.4 or greater, you have %d.%d.%d\n",
+ Major, Minor, Patch) ;
+
+#if PERL_VERSION > 3
+ sv_setpvf(ver_sv, "%d.%d", Major, Minor) ;
+#else
+ {
+ char buffer[40] ;
+ sprintf(buffer, "%d.%d", Major, Minor) ;
+ sv_setpv(ver_sv, buffer) ;
+ }
+#endif
+
+#else
+ sv_setiv(ver_sv, 1) ;
+#endif
+
+}
static int
@@ -160,8 +395,8 @@ const DBT * key2 ;
ENTER ;
SAVETMPS;
- PUSHMARK(sp) ;
- EXTEND(sp,2) ;
+ PUSHMARK(SP) ;
+ EXTEND(SP,2) ;
PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
PUTBACK ;
@@ -207,8 +442,8 @@ const DBT * key2 ;
ENTER ;
SAVETMPS;
- PUSHMARK(sp) ;
- EXTEND(sp,2) ;
+ PUSHMARK(SP) ;
+ EXTEND(SP,2) ;
PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
PUTBACK ;
@@ -245,7 +480,7 @@ size_t size ;
ENTER ;
SAVETMPS;
- PUSHMARK(sp) ;
+ PUSHMARK(SP) ;
XPUSHs(sv_2mortal(newSVpv((char*)data,size)));
PUTBACK ;
@@ -271,45 +506,50 @@ size_t size ;
static void
PrintHash(hash)
-HASHINFO * hash ;
+INFO * hash ;
{
printf ("HASH Info\n") ;
- printf (" hash = %s\n", (hash->hash != NULL ? "redefined" : "default")) ;
- printf (" bsize = %d\n", hash->bsize) ;
- printf (" ffactor = %d\n", hash->ffactor) ;
- printf (" nelem = %d\n", hash->nelem) ;
- printf (" cachesize = %d\n", hash->cachesize) ;
- printf (" lorder = %d\n", hash->lorder) ;
+ printf (" hash = %s\n",
+ (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
+ printf (" bsize = %d\n", hash->db_HA_bsize) ;
+ printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
+ printf (" nelem = %d\n", hash->db_HA_nelem) ;
+ printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
+ printf (" lorder = %d\n", hash->db_HA_lorder) ;
}
static void
PrintRecno(recno)
-RECNOINFO * recno ;
+INFO * recno ;
{
printf ("RECNO Info\n") ;
- printf (" flags = %d\n", recno->flags) ;
- printf (" cachesize = %d\n", recno->cachesize) ;
- printf (" psize = %d\n", recno->psize) ;
- printf (" lorder = %d\n", recno->lorder) ;
- printf (" reclen = %lu\n", (unsigned long)recno->reclen) ;
- printf (" bval = %d 0x%x\n", recno->bval, recno->bval) ;
- printf (" bfname = %d [%s]\n", recno->bfname, recno->bfname) ;
+ printf (" flags = %d\n", recno->db_RE_flags) ;
+ printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
+ printf (" psize = %d\n", recno->db_RE_psize) ;
+ printf (" lorder = %d\n", recno->db_RE_lorder) ;
+ printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
+ printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
+ printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
}
static void
PrintBtree(btree)
-BTREEINFO * btree ;
+INFO * btree ;
{
printf ("BTREE Info\n") ;
- printf (" compare = %s\n", (btree->compare ? "redefined" : "default")) ;
- printf (" prefix = %s\n", (btree->prefix ? "redefined" : "default")) ;
- printf (" flags = %d\n", btree->flags) ;
- printf (" cachesize = %d\n", btree->cachesize) ;
- printf (" psize = %d\n", btree->psize) ;
- printf (" maxkeypage = %d\n", btree->maxkeypage) ;
- printf (" minkeypage = %d\n", btree->minkeypage) ;
- printf (" lorder = %d\n", btree->lorder) ;
+ printf (" compare = %s\n",
+ (btree->db_BT_compare ? "redefined" : "default")) ;
+ printf (" prefix = %s\n",
+ (btree->db_BT_prefix ? "redefined" : "default")) ;
+ printf (" flags = %d\n", btree->db_BT_flags) ;
+ printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
+ printf (" psize = %d\n", btree->db_BT_psize) ;
+#ifndef DB_VERSION_MAJOR
+ printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
+ printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
+#endif
+ printf (" lorder = %d\n", btree->db_BT_lorder) ;
}
#else
@@ -323,16 +563,18 @@ BTREEINFO * btree ;
static I32
GetArrayLength(db)
-DB * db ;
+DB_File db ;
{
DBT key ;
DBT value ;
int RETVAL ;
- RETVAL = (db->seq)(db, &key, &value, R_LAST) ;
+ DBT_flags(key) ;
+ DBT_flags(value) ;
+ RETVAL = do_SEQ(db, key, value, R_LAST) ;
if (RETVAL == 0)
RETVAL = *(I32 *)key.data ;
- else if (RETVAL == 1) /* No key means empty file */
+ else /* No key means empty file */
RETVAL = 0 ;
return ((I32)RETVAL) ;
@@ -345,7 +587,7 @@ I32 value ;
{
if (value < 0) {
/* Get the length of the array */
- I32 length = GetArrayLength(db->dbp) ;
+ I32 length = GetArrayLength(db) ;
/* check for attempt to write before start of array */
if (length + value + 1 <= 0)
@@ -371,7 +613,11 @@ SV * sv ;
HV * action ;
DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
void * openinfo = NULL ;
- union INFO * info = &RETVAL->info ;
+ INFO * info = &RETVAL->info ;
+ STRLEN n_a;
+
+/* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
+ Zero(RETVAL, 1, DB_File_type) ;
/* Default to HASH */
RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
@@ -407,26 +653,26 @@ SV * sv ;
if (svp && SvOK(*svp))
{
- info->hash.hash = hash_cb ;
+ info->db_HA_hash = hash_cb ;
RETVAL->hash = newSVsv(*svp) ;
}
else
- info->hash.hash = NULL ;
+ info->db_HA_hash = NULL ;
- svp = hv_fetch(action, "bsize", 5, FALSE);
- info->hash.bsize = svp ? SvIV(*svp) : 0;
-
svp = hv_fetch(action, "ffactor", 7, FALSE);
- info->hash.ffactor = svp ? SvIV(*svp) : 0;
+ info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
svp = hv_fetch(action, "nelem", 5, FALSE);
- info->hash.nelem = svp ? SvIV(*svp) : 0;
+ info->db_HA_nelem = svp ? SvIV(*svp) : 0;
+ svp = hv_fetch(action, "bsize", 5, FALSE);
+ info->db_HA_bsize = svp ? SvIV(*svp) : 0;
+
svp = hv_fetch(action, "cachesize", 9, FALSE);
- info->hash.cachesize = svp ? SvIV(*svp) : 0;
+ info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
svp = hv_fetch(action, "lorder", 6, FALSE);
- info->hash.lorder = svp ? SvIV(*svp) : 0;
+ info->db_HA_lorder = svp ? SvIV(*svp) : 0;
PrintHash(info) ;
}
@@ -441,38 +687,40 @@ SV * sv ;
svp = hv_fetch(action, "compare", 7, FALSE);
if (svp && SvOK(*svp))
{
- info->btree.compare = btree_compare ;
+ info->db_BT_compare = btree_compare ;
RETVAL->compare = newSVsv(*svp) ;
}
else
- info->btree.compare = NULL ;
+ info->db_BT_compare = NULL ;
svp = hv_fetch(action, "prefix", 6, FALSE);
if (svp && SvOK(*svp))
{
- info->btree.prefix = btree_prefix ;
+ info->db_BT_prefix = btree_prefix ;
RETVAL->prefix = newSVsv(*svp) ;
}
else
- info->btree.prefix = NULL ;
+ info->db_BT_prefix = NULL ;
svp = hv_fetch(action, "flags", 5, FALSE);
- info->btree.flags = svp ? SvIV(*svp) : 0;
+ info->db_BT_flags = svp ? SvIV(*svp) : 0;
svp = hv_fetch(action, "cachesize", 9, FALSE);
- info->btree.cachesize = svp ? SvIV(*svp) : 0;
+ info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
+#ifndef DB_VERSION_MAJOR
svp = hv_fetch(action, "minkeypage", 10, FALSE);
info->btree.minkeypage = svp ? SvIV(*svp) : 0;
svp = hv_fetch(action, "maxkeypage", 10, FALSE);
info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
+#endif
svp = hv_fetch(action, "psize", 5, FALSE);
- info->btree.psize = svp ? SvIV(*svp) : 0;
+ info->db_BT_psize = svp ? SvIV(*svp) : 0;
svp = hv_fetch(action, "lorder", 6, FALSE);
- info->btree.lorder = svp ? SvIV(*svp) : 0;
+ info->db_BT_lorder = svp ? SvIV(*svp) : 0;
PrintBtree(info) ;
@@ -485,45 +733,87 @@ SV * sv ;
RETVAL->type = DB_RECNO ;
openinfo = (void *)info ;
+ info->db_RE_flags = 0 ;
+
svp = hv_fetch(action, "flags", 5, FALSE);
- info->recno.flags = (u_long) (svp ? SvIV(*svp) : 0);
+ info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
+
+ svp = hv_fetch(action, "reclen", 6, FALSE);
+ info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
svp = hv_fetch(action, "cachesize", 9, FALSE);
- info->recno.cachesize = (u_int) (svp ? SvIV(*svp) : 0);
+ info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
svp = hv_fetch(action, "psize", 5, FALSE);
- info->recno.psize = (u_int) (svp ? SvIV(*svp) : 0);
+ info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
svp = hv_fetch(action, "lorder", 6, FALSE);
- info->recno.lorder = (int) (svp ? SvIV(*svp) : 0);
-
- svp = hv_fetch(action, "reclen", 6, FALSE);
- info->recno.reclen = (size_t) (svp ? SvIV(*svp) : 0);
+ info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
+
+#ifdef DB_VERSION_MAJOR
+ info->re_source = name ;
+ name = NULL ;
+#endif
+ svp = hv_fetch(action, "bfname", 6, FALSE);
+ if (svp && SvOK(*svp)) {
+ char * ptr = SvPV(*svp,n_a) ;
+#ifdef DB_VERSION_MAJOR
+ name = (char*) n_a ? ptr : NULL ;
+#else
+ info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
+#endif
+ }
+ else
+#ifdef DB_VERSION_MAJOR
+ name = NULL ;
+#else
+ info->db_RE_bfname = NULL ;
+#endif
svp = hv_fetch(action, "bval", 4, FALSE);
+#ifdef DB_VERSION_MAJOR
+ if (svp && SvOK(*svp))
+ {
+ int value ;
+ if (SvPOK(*svp))
+ value = (int)*SvPV(*svp, n_a) ;
+ else
+ value = SvIV(*svp) ;
+
+ if (info->flags & DB_FIXEDLEN) {
+ info->re_pad = value ;
+ info->flags |= DB_PAD ;
+ }
+ else {
+ info->re_delim = value ;
+ info->flags |= DB_DELIMITER ;
+ }
+
+ }
+#else
if (svp && SvOK(*svp))
{
if (SvPOK(*svp))
- info->recno.bval = (u_char)*SvPV(*svp, na) ;
+ info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
else
- info->recno.bval = (u_char)(unsigned long) SvIV(*svp) ;
+ info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
+ DB_flags(info->flags, DB_DELIMITER) ;
+
}
else
{
- if (info->recno.flags & R_FIXEDLEN)
- info->recno.bval = (u_char) ' ' ;
+ if (info->db_RE_flags & R_FIXEDLEN)
+ info->db_RE_bval = (u_char) ' ' ;
else
- info->recno.bval = (u_char) '\n' ;
+ info->db_RE_bval = (u_char) '\n' ;
+ DB_flags(info->flags, DB_DELIMITER) ;
}
-
- svp = hv_fetch(action, "bfname", 6, FALSE);
- if (svp && SvOK(*svp)) {
- char * ptr = SvPV(*svp,na) ;
- info->recno.bfname = (char*) (na ? ptr : NULL) ;
- }
- else
- info->recno.bfname = NULL ;
+#endif
+#ifdef DB_RENUMBER
+ info->flags |= DB_RENUMBER ;
+#endif
+
PrintRecno(info) ;
}
else
@@ -538,7 +828,44 @@ SV * sv ;
#endif /* __EMX__ */
#endif /* OS2 */
+#ifdef DB_VERSION_MAJOR
+
+ {
+ int Flags = 0 ;
+ int status ;
+
+ /* Map 1.x flags to 2.x flags */
+ if ((flags & O_CREAT) == O_CREAT)
+ Flags |= DB_CREATE ;
+
+#if O_RDONLY == 0
+ if (flags == O_RDONLY)
+#else
+ if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
+#endif
+ Flags |= DB_RDONLY ;
+
+#ifdef O_TRUNC
+ if ((flags & O_TRUNC) == O_TRUNC)
+ Flags |= DB_TRUNCATE ;
+#endif
+
+ status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
+ if (status == 0)
+#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
+ status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
+#else
+ status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
+ 0) ;
+#endif
+
+ if (status)
+ RETVAL->dbp = NULL ;
+
+ }
+#else
RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
+#endif
return (RETVAL) ;
}
@@ -774,12 +1101,6 @@ int arg;
case 'Z':
break;
case '_':
- if (strEQ(name, "__R_UNUSED"))
-#ifdef __R_UNUSED
- return __R_UNUSED;
-#else
- goto not_there;
-#endif
break;
}
errno = EINVAL;
@@ -792,6 +1113,15 @@ not_there:
MODULE = DB_File PACKAGE = DB_File PREFIX = db_
+BOOT:
+ {
+ GetVersionInfo() ;
+
+ empty.data = &zero ;
+ empty.size = sizeof(recno_t) ;
+ DBT_flags(empty) ;
+ }
+
double
constant(name,arg)
char * name
@@ -808,9 +1138,10 @@ db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_H
{
char * name = (char *) NULL ;
SV * sv = (SV *) NULL ;
+ STRLEN n_a;
if (items >= 3 && SvOK(ST(2)))
- name = (char*) SvPV(ST(2), na) ;
+ name = (char*) SvPV(ST(2), n_a) ;
if (items == 6)
sv = ST(5) ;
@@ -835,6 +1166,10 @@ db_DESTROY(db)
if (db->prefix)
SvREFCNT_dec(db->prefix) ;
Safefree(db) ;
+#ifdef DB_VERSION_MAJOR
+ if (RETVAL > 0)
+ RETVAL = -1 ;
+#endif
int
@@ -854,8 +1189,9 @@ db_EXISTS(db, key)
{
DBT value ;
+ DBT_flags(value) ;
CurrentDB = db ;
- RETVAL = (((db->dbp)->get)(db->dbp, &key, &value, 0) == 0) ;
+ RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
}
OUTPUT:
RETVAL
@@ -867,13 +1203,14 @@ db_FETCH(db, key, flags=0)
u_int flags
CODE:
{
- DBT value ;
+ DBT value ;
+ DBT_flags(value) ;
CurrentDB = db ;
- RETVAL = ((db->dbp)->get)(db->dbp, &key, &value, flags) ;
+ /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
+ RETVAL = db_get(db, key, value, flags) ;
ST(0) = sv_newmortal();
- if (RETVAL == 0)
- sv_setpvn(ST(0), value.data, value.size);
+ OutputValue(ST(0), value)
}
int
@@ -891,20 +1228,15 @@ db_FIRSTKEY(db)
DB_File db
CODE:
{
- DBTKEY key ;
+ DBTKEY key ;
DBT value ;
- DB * Db = db->dbp ;
+ DBT_flags(key) ;
+ DBT_flags(value) ;
CurrentDB = db ;
- RETVAL = (Db->seq)(Db, &key, &value, R_FIRST) ;
+ RETVAL = do_SEQ(db, key, value, R_FIRST) ;
ST(0) = sv_newmortal();
- if (RETVAL == 0)
- {
- if (db->type != DB_RECNO)
- sv_setpvn(ST(0), key.data, key.size);
- else
- sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
- }
+ OutputKey(ST(0), key) ;
}
int
@@ -914,18 +1246,12 @@ db_NEXTKEY(db, key)
CODE:
{
DBT value ;
- DB * Db = db->dbp ;
+ DBT_flags(value) ;
CurrentDB = db ;
- RETVAL = (Db->seq)(Db, &key, &value, R_NEXT) ;
+ RETVAL = do_SEQ(db, key, value, R_NEXT) ;
ST(0) = sv_newmortal();
- if (RETVAL == 0)
- {
- if (db->type != DB_RECNO)
- sv_setpvn(ST(0), key.data, key.size);
- else
- sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
- }
+ OutputKey(ST(0), key) ;
}
#
@@ -935,6 +1261,7 @@ db_NEXTKEY(db, key)
int
unshift(db, ...)
DB_File db
+ ALIAS: UNSHIFT = 1
CODE:
{
DBTKEY key ;
@@ -942,17 +1269,30 @@ unshift(db, ...)
int i ;
int One ;
DB * Db = db->dbp ;
+ STRLEN n_a;
+ DBT_flags(key) ;
+ DBT_flags(value) ;
CurrentDB = db ;
+#ifdef DB_VERSION_MAJOR
+ /* get the first value */
+ RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
+ RETVAL = 0 ;
+#else
RETVAL = -1 ;
+#endif
for (i = items-1 ; i > 0 ; --i)
{
- value.data = SvPV(ST(i), na) ;
- value.size = na ;
+ value.data = SvPV(ST(i), n_a) ;
+ value.size = n_a ;
One = 1 ;
key.data = &One ;
key.size = sizeof(int) ;
+#ifdef DB_VERSION_MAJOR
+ RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
+#else
RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
+#endif
if (RETVAL != 0)
break;
}
@@ -963,48 +1303,53 @@ unshift(db, ...)
I32
pop(db)
DB_File db
+ ALIAS: POP = 1
CODE:
{
DBTKEY key ;
DBT value ;
- DB * Db = db->dbp ;
+ DBT_flags(key) ;
+ DBT_flags(value) ;
CurrentDB = db ;
+
/* First get the final value */
- RETVAL = (Db->seq)(Db, &key, &value, R_LAST) ;
+ RETVAL = do_SEQ(db, key, value, R_LAST) ;
ST(0) = sv_newmortal();
/* Now delete it */
if (RETVAL == 0)
{
/* the call to del will trash value, so take a copy now */
- sv_setpvn(ST(0), value.data, value.size);
- RETVAL = (Db->del)(Db, &key, R_CURSOR) ;
+ OutputValue(ST(0), value) ;
+ RETVAL = db_del(db, key, R_CURSOR) ;
if (RETVAL != 0)
- sv_setsv(ST(0), &sv_undef);
+ sv_setsv(ST(0), &PL_sv_undef);
}
}
I32
shift(db)
DB_File db
+ ALIAS: SHIFT = 1
CODE:
{
DBT value ;
DBTKEY key ;
- DB * Db = db->dbp ;
+ DBT_flags(key) ;
+ DBT_flags(value) ;
CurrentDB = db ;
/* get the first value */
- RETVAL = (Db->seq)(Db, &key, &value, R_FIRST) ;
+ RETVAL = do_SEQ(db, key, value, R_FIRST) ;
ST(0) = sv_newmortal();
/* Now delete it */
if (RETVAL == 0)
{
/* the call to del will trash value, so take a copy now */
- sv_setpvn(ST(0), value.data, value.size);
- RETVAL = (Db->del)(Db, &key, R_CURSOR) ;
+ OutputValue(ST(0), value) ;
+ RETVAL = db_del(db, key, R_CURSOR) ;
if (RETVAL != 0)
- sv_setsv (ST(0), &sv_undef) ;
+ sv_setsv (ST(0), &PL_sv_undef) ;
}
}
@@ -1012,30 +1357,46 @@ shift(db)
I32
push(db, ...)
DB_File db
+ ALIAS: PUSH = 1
CODE:
{
DBTKEY key ;
- DBTKEY * keyptr = &key ;
DBT value ;
DB * Db = db->dbp ;
int i ;
+ STRLEN n_a;
+ DBT_flags(key) ;
+ DBT_flags(value) ;
CurrentDB = db ;
+#ifdef DB_VERSION_MAJOR
+ RETVAL = 0 ;
+ key = empty ;
+ for (i = 1 ; i < items ; ++i)
+ {
+ value.data = SvPV(ST(i), n_a) ;
+ value.size = n_a ;
+ RETVAL = (Db->put)(Db, NULL, &key, &value, DB_APPEND) ;
+ if (RETVAL != 0)
+ break;
+ }
+#else
/* Set the Cursor to the Last element */
- RETVAL = (Db->seq)(Db, &key, &value, R_LAST) ;
+ RETVAL = do_SEQ(db, key, value, R_LAST) ;
if (RETVAL >= 0)
{
if (RETVAL == 1)
- keyptr = &empty ;
+ key = empty ;
for (i = items - 1 ; i > 0 ; --i)
{
- value.data = SvPV(ST(i), na) ;
- value.size = na ;
- RETVAL = (Db->put)(Db, keyptr, &value, R_IAFTER) ;
+ value.data = SvPV(ST(i), n_a) ;
+ value.size = n_a ;
+ RETVAL = (Db->put)(Db, &key, &value, R_IAFTER) ;
if (RETVAL != 0)
break;
}
}
+#endif
}
OUTPUT:
RETVAL
@@ -1044,9 +1405,10 @@ push(db, ...)
I32
length(db)
DB_File db
+ ALIAS: FETCHSIZE = 1
CODE:
CurrentDB = db ;
- RETVAL = GetArrayLength(db->dbp) ;
+ RETVAL = GetArrayLength(db) ;
OUTPUT:
RETVAL
@@ -1060,8 +1422,17 @@ db_del(db, key, flags=0)
DB_File db
DBTKEY key
u_int flags
- INIT:
+ CODE:
CurrentDB = db ;
+ RETVAL = db_del(db, key, flags) ;
+#ifdef DB_VERSION_MAJOR
+ if (RETVAL > 0)
+ RETVAL = -1 ;
+ else if (RETVAL == DB_NOTFOUND)
+ RETVAL = 1 ;
+#endif
+ OUTPUT:
+ RETVAL
int
@@ -1070,9 +1441,18 @@ db_get(db, key, value, flags=0)
DBTKEY key
DBT value = NO_INIT
u_int flags
- INIT:
+ CODE:
CurrentDB = db ;
+ DBT_flags(value) ;
+ RETVAL = db_get(db, key, value, flags) ;
+#ifdef DB_VERSION_MAJOR
+ if (RETVAL > 0)
+ RETVAL = -1 ;
+ else if (RETVAL == DB_NOTFOUND)
+ RETVAL = 1 ;
+#endif
OUTPUT:
+ RETVAL
value
int
@@ -1081,23 +1461,53 @@ db_put(db, key, value, flags=0)
DBTKEY key
DBT value
u_int flags
- INIT:
+ CODE:
CurrentDB = db ;
+ RETVAL = db_put(db, key, value, flags) ;
+#ifdef DB_VERSION_MAJOR
+ if (RETVAL > 0)
+ RETVAL = -1 ;
+ else if (RETVAL == DB_KEYEXIST)
+ RETVAL = 1 ;
+#endif
OUTPUT:
- key if (flags & (R_IAFTER|R_IBEFORE)) OutputKey(ST(1), key);
+ RETVAL
+ key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
int
db_fd(db)
DB_File db
- INIT:
+ int status = 0 ;
+ CODE:
CurrentDB = db ;
+#ifdef DB_VERSION_MAJOR
+ RETVAL = -1 ;
+ status = (db->in_memory
+ ? -1
+ : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
+ if (status != 0)
+ RETVAL = -1 ;
+#else
+ RETVAL = (db->in_memory
+ ? -1
+ : ((db->dbp)->fd)(db->dbp) ) ;
+#endif
+ OUTPUT:
+ RETVAL
int
db_sync(db, flags=0)
DB_File db
u_int flags
- INIT:
+ CODE:
CurrentDB = db ;
+ RETVAL = db_sync(db, flags) ;
+#ifdef DB_VERSION_MAJOR
+ if (RETVAL > 0)
+ RETVAL = -1 ;
+#endif
+ OUTPUT:
+ RETVAL
int
@@ -1106,9 +1516,18 @@ db_seq(db, key, value, flags)
DBTKEY key
DBT value = NO_INIT
u_int flags
- INIT:
+ CODE:
CurrentDB = db ;
+ DBT_flags(value) ;
+ RETVAL = db_seq(db, key, value, flags);
+#ifdef DB_VERSION_MAJOR
+ if (RETVAL > 0)
+ RETVAL = -1 ;
+ else if (RETVAL == DB_NOTFOUND)
+ RETVAL = 1 ;
+#endif
OUTPUT:
+ RETVAL
key
value
diff --git a/gnu/usr.bin/perl/ext/DB_File/Makefile.PL b/gnu/usr.bin/perl/ext/DB_File/Makefile.PL
index 39b8bc70303..1a13e0bbd8e 100644
--- a/gnu/usr.bin/perl/ext/DB_File/Makefile.PL
+++ b/gnu/usr.bin/perl/ext/DB_File/Makefile.PL
@@ -4,10 +4,14 @@ use Config ;
# OS2 is a special case, so check for it now.
my $OS2 = "-DOS2" if $Config{'osname'} eq 'os2' ;
+my $LIB = "-ldb" ;
+# so is win32
+$LIB = "-llibdb" if $^O eq 'MSWin32' ;
+
WriteMakefile(
NAME => 'DB_File',
- LIBS => ["-L/usr/local/lib -ldb"],
- MAN3PODS => ' ', # Pods will be built by installman.
+ LIBS => ["-L/usr/local/lib $LIB"],
+ MAN3PODS => {}, # Pods will be built by installman.
#INC => '-I/usr/local/include',
VERSION_FROM => 'DB_File.pm',
XSPROTOARG => '-noprototypes',
diff --git a/gnu/usr.bin/perl/ext/DB_File/typemap b/gnu/usr.bin/perl/ext/DB_File/typemap
index a6212243de2..994ba272323 100644
--- a/gnu/usr.bin/perl/ext/DB_File/typemap
+++ b/gnu/usr.bin/perl/ext/DB_File/typemap
@@ -1,8 +1,8 @@
-# typemap for Perl 5 interface to Berkeley DB
+# typemap for Perl 5 interface to Berkeley
#
-# written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
-# last modified 28th June 1996
-# version 0.2
+# written by Paul Marquess <Paul.Marquess@btinternet.com>
+# last modified 21st February 1999
+# version 1.65
#
#################################### DB SECTION
#
@@ -16,17 +16,20 @@ DBTKEY T_dbtkeydatum
INPUT
T_dbtkeydatum
if (db->type != DB_RECNO) {
- $var.data = SvPV($arg, na);
- $var.size = (int)na;
+ $var.data = SvPV($arg, PL_na);
+ $var.size = (int)PL_na;
+ DBT_flags($var);
}
else {
Value = GetRecnoKey(db, SvIV($arg)) ;
$var.data = & Value;
$var.size = (int)sizeof(recno_t);
+ DBT_flags($var);
}
T_dbtdatum
- $var.data = SvPV($arg, na);
- $var.size = (int)na;
+ $var.data = SvPV($arg, PL_na);
+ $var.size = (int)PL_na;
+ DBT_flags($var);
OUTPUT
diff --git a/gnu/usr.bin/perl/ext/DynaLoader/Makefile.PL b/gnu/usr.bin/perl/ext/DynaLoader/Makefile.PL
index 9323935880b..2141fdeb2f6 100644
--- a/gnu/usr.bin/perl/ext/DynaLoader/Makefile.PL
+++ b/gnu/usr.bin/perl/ext/DynaLoader/Makefile.PL
@@ -4,14 +4,15 @@ WriteMakefile(
NAME => 'DynaLoader',
LINKTYPE => 'static',
DEFINE => '-DPERL_CORE -DLIBC="$(LIBC)"',
- MAN3PODS => ' ', # Pods will be built by installman.
+ MAN3PODS => {}, # Pods will be built by installman.
SKIP => [qw(dynamic dynamic_lib dynamic_bs)],
XSPROTOARG => '-noprototypes', # XXX remove later?
- VERSION_FROM => 'DynaLoader.pm',
- clean => {FILES => 'DynaLoader.c DynaLoader.xs'},
+ VERSION_FROM => 'DynaLoader_pm.PL',
+ PL_FILES => {'DynaLoader_pm.PL'=>'DynaLoader.pm'},
+ PM => {'DynaLoader.pm' => '$(INST_LIBDIR)/DynaLoader.pm'},
+ clean => {FILES => 'DynaLoader.c DynaLoader.xs DynaLoader.pm'},
);
-
sub MY::postamble {
'
DynaLoader.xs: $(DLSRC)
diff --git a/gnu/usr.bin/perl/ext/DynaLoader/dl_aix.xs b/gnu/usr.bin/perl/ext/DynaLoader/dl_aix.xs
index 746666636ae..ea5040857d0 100644
--- a/gnu/usr.bin/perl/ext/DynaLoader/dl_aix.xs
+++ b/gnu/usr.bin/perl/ext/DynaLoader/dl_aix.xs
@@ -29,6 +29,20 @@
#include <a.out.h>
#include <ldfcn.h>
+/*
+ * AIX 4.3 does remove some useful definitions from ldfcn.h. Define
+ * these here to compensate for that lossage.
+ */
+#ifndef BEGINNING
+# define BEGINNING SEEK_SET
+#endif
+#ifndef FSEEK
+# define FSEEK(ldptr,o,p) fseek(IOPTR(ldptr),(p==BEGINNING)?(OFFSET(ldptr) +o):o,p)
+#endif
+#ifndef FREAD
+# define FREAD(p,s,n,ldptr) fread(p,s,n,IOPTR(ldptr))
+#endif
+
/* If using PerlIO, redefine these macros from <ldfcn.h> */
#ifdef USE_PERLIO
#define FSEEK(ldptr,o,p) PerlIO_seek(IOPTR(ldptr),(p==BEGINNING)?(OFFSET(ldptr)+o):o,p)
@@ -77,6 +91,65 @@ 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)";
+
+char *strerrorcat(char *str, int err) {
+ int strsiz = strlen(str);
+ int msgsiz;
+ char *msg;
+
+#ifdef USE_THREADS
+ char *buf = malloc(BUFSIZ);
+
+ if (buf == 0)
+ return 0;
+ if (strerror_r(err, buf, sizeof(buf)) == 0)
+ msg = buf;
+ else
+ msg = strerror_r_failed;
+ msgsiz = strlen(msg);
+ if (strsiz + msgsiz < BUFSIZ)
+ strcat(str, msg);
+ free(buf);
+#else
+ if ((msg = strerror(err)) == 0)
+ msg = strerror_failed;
+ msgsiz = strlen(msg); /* Note msg = buf and free() above. */
+ if (strsiz + msgsiz < BUFSIZ) /* Do not move this after #endif. */
+ strcat(str, msg);
+#endif
+
+ return str;
+}
+
+char *strerrorcpy(char *str, int err) {
+ int msgsiz;
+ char *msg;
+
+#ifdef USE_THREADS
+ char *buf = malloc(BUFSIZ);
+
+ if (buf == 0)
+ return 0;
+ if (strerror_r(err, buf, sizeof(buf)) == 0)
+ msg = buf;
+ else
+ msg = strerror_r_failed;
+ msgsiz = strlen(msg);
+ if (msgsiz < BUFSIZ)
+ strcpy(str, msg);
+ free(buf);
+#else
+ if ((msg = strerror(err)) == 0)
+ msg = strerror_failed;
+ msgsiz = strlen(msg); /* Note msg = buf and free() above. */
+ if (msgsiz < BUFSIZ) /* Do not move this after #endif. */
+ strcpy(str, msg);
+#endif
+
+ return str;
+}
/* ARGSUSED */
void *dlopen(char *path, int mode)
@@ -106,14 +179,14 @@ void *dlopen(char *path, int mode)
if (mp == NULL) {
errvalid++;
strcpy(errbuf, "Newz: ");
- strcat(errbuf, strerror(errno));
+ strerrorcat(errbuf, errno);
return NULL;
}
if ((mp->name = savepv(path)) == NULL) {
errvalid++;
strcpy(errbuf, "savepv: ");
- strcat(errbuf, strerror(errno));
+ strerrorcat(errbuf, errno);
safefree(mp);
return NULL;
}
@@ -136,14 +209,14 @@ void *dlopen(char *path, int mode)
if (errno == ENOEXEC) {
char *tmp[BUFSIZ/sizeof(char *)];
if (loadquery(L_GETMESSAGES, tmp, sizeof(tmp)) == -1)
- strcpy(errbuf, strerror(errno));
+ strerrorcpy(errbuf, errno);
else {
char **p;
for (p = tmp; *p; p++)
caterr(*p);
}
} else
- strcat(errbuf, strerror(errno));
+ strerrorcat(errbuf, errno);
return NULL;
}
mp->refCnt = 1;
@@ -153,7 +226,7 @@ void *dlopen(char *path, int mode)
dlclose(mp);
errvalid++;
strcpy(errbuf, "loadbind: ");
- strcat(errbuf, strerror(errno));
+ strerrorcat(errbuf, errno);
return NULL;
}
if (readExports(mp) == -1) {
@@ -194,7 +267,7 @@ static void caterr(char *s)
strcat(errbuf, p);
break;
case L_ERROR_ERRNO:
- strcat(errbuf, strerror(atoi(++p)));
+ strerrorcat(errbuf, atoi(++p));
break;
default:
strcat(errbuf, s);
@@ -241,7 +314,7 @@ int dlclose(void *handle)
result = unload(mp->entry);
if (result == -1) {
errvalid++;
- strcpy(errbuf, strerror(errno));
+ strerrorcpy(errbuf, errno);
}
if (mp->exports) {
register ExportPtr ep;
@@ -306,7 +379,7 @@ static int readExports(ModulePtr mp)
if (errno != ENOENT) {
errvalid++;
strcpy(errbuf, "readExports: ");
- strcat(errbuf, strerror(errno));
+ strerrorcat(errbuf, errno);
return -1;
}
/*
@@ -317,7 +390,7 @@ static int readExports(ModulePtr mp)
if ((buf = safemalloc(size)) == NULL) {
errvalid++;
strcpy(errbuf, "readExports: ");
- strcat(errbuf, strerror(errno));
+ strerrorcat(errbuf, errno);
return -1;
}
while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
@@ -326,14 +399,14 @@ static int readExports(ModulePtr mp)
if ((buf = safemalloc(size)) == NULL) {
errvalid++;
strcpy(errbuf, "readExports: ");
- strcat(errbuf, strerror(errno));
+ strerrorcat(errbuf, errno);
return -1;
}
}
if (i == -1) {
errvalid++;
strcpy(errbuf, "readExports: ");
- strcat(errbuf, strerror(errno));
+ strerrorcat(errbuf, errno);
safefree(buf);
return -1;
}
@@ -357,7 +430,7 @@ static int readExports(ModulePtr mp)
if (!ldp) {
errvalid++;
strcpy(errbuf, "readExports: ");
- strcat(errbuf, strerror(errno));
+ strerrorcat(errbuf, errno);
return -1;
}
}
@@ -382,7 +455,7 @@ static int readExports(ModulePtr mp)
if ((ldbuf = (char *)safemalloc(sh.s_size)) == NULL) {
errvalid++;
strcpy(errbuf, "readExports: ");
- strcat(errbuf, strerror(errno));
+ strerrorcat(errbuf, errno);
while(ldclose(ldp) == FAILURE)
;
return -1;
@@ -423,7 +496,7 @@ static int readExports(ModulePtr mp)
if (mp->exports == NULL) {
errvalid++;
strcpy(errbuf, "readExports: ");
- strcat(errbuf, strerror(errno));
+ strerrorcat(errbuf, errno);
safefree(ldbuf);
while(ldclose(ldp) == FAILURE)
;
@@ -468,7 +541,7 @@ static void * findMain(void)
if ((buf = safemalloc(size)) == NULL) {
errvalid++;
strcpy(errbuf, "findMain: ");
- strcat(errbuf, strerror(errno));
+ strerrorcat(errbuf, errno);
return NULL;
}
while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
@@ -477,14 +550,14 @@ static void * findMain(void)
if ((buf = safemalloc(size)) == NULL) {
errvalid++;
strcpy(errbuf, "findMain: ");
- strcat(errbuf, strerror(errno));
+ strerrorcat(errbuf, errno);
return NULL;
}
}
if (i == -1) {
errvalid++;
strcpy(errbuf, "findMain: ");
- strcat(errbuf, strerror(errno));
+ strerrorcat(errbuf, errno);
safefree(buf);
return NULL;
}
diff --git a/gnu/usr.bin/perl/ext/DynaLoader/dl_cygwin32.xs b/gnu/usr.bin/perl/ext/DynaLoader/dl_cygwin32.xs
index 2b7563764e1..b64ab3e3456 100644
--- a/gnu/usr.bin/perl/ext/DynaLoader/dl_cygwin32.xs
+++ b/gnu/usr.bin/perl/ext/DynaLoader/dl_cygwin32.xs
@@ -82,11 +82,11 @@ dl_load_file(filename,flags=0)
int flags
PREINIT:
CODE:
- DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
+ DLDEBUG(1,PerlIO_printf(PerlIO_stderr(),"dl_load_file(%s):\n", filename));
RETVAL = (void*) LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ;
- DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL));
+ DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL){
SaveError("%d",GetLastError()) ;
@@ -113,10 +113,10 @@ dl_find_symbol(libhandle, symbolname)
void * libhandle
char * symbolname
CODE:
- DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
+ DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n",
libhandle, symbolname));
RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname);
- DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL));
+ DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref = %x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
SaveError("%d",GetLastError()) ;
@@ -138,7 +138,7 @@ dl_install_xsub(perl_name, symref, filename="$Package")
void * symref
char * filename
CODE:
- DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
+ DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n",
perl_name, symref));
ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
diff --git a/gnu/usr.bin/perl/ext/DynaLoader/dl_dld.xs b/gnu/usr.bin/perl/ext/DynaLoader/dl_dld.xs
index 44933ec92ca..2443ab0d694 100644
--- a/gnu/usr.bin/perl/ext/DynaLoader/dl_dld.xs
+++ b/gnu/usr.bin/perl/ext/DynaLoader/dl_dld.xs
@@ -58,10 +58,10 @@ dl_private_init()
dlderr = dld_init("/proc/self/exe");
if (dlderr) {
#endif
- dlderr = dld_init(dld_find_executable(origargv[0]));
+ dlderr = dld_init(dld_find_executable(PL_origargv[0]));
if (dlderr) {
char *msg = dld_strerror(dlderr);
- SaveError("dld_init(%s) failed: %s", origargv[0], msg);
+ SaveError("dld_init(%s) failed: %s", PL_origargv[0], msg);
DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "%s", LastError));
}
#ifdef __linux__
@@ -144,7 +144,7 @@ dl_undef_symbols()
if (dld_undefined_sym_count) {
int x;
char **undef_syms = dld_list_undefined_sym();
- EXTEND(sp, dld_undefined_sym_count);
+ EXTEND(SP, dld_undefined_sym_count);
for (x=0; x < dld_undefined_sym_count; x++)
PUSHs(sv_2mortal(newSVpv(undef_syms[x]+1, 0)));
free(undef_syms);
diff --git a/gnu/usr.bin/perl/ext/DynaLoader/dl_dlopen.xs b/gnu/usr.bin/perl/ext/DynaLoader/dl_dlopen.xs
index fef4530cfee..24592056531 100644
--- a/gnu/usr.bin/perl/ext/DynaLoader/dl_dlopen.xs
+++ b/gnu/usr.bin/perl/ext/DynaLoader/dl_dlopen.xs
@@ -206,7 +206,7 @@ dl_install_xsub(perl_name, symref, filename="$Package")
CODE:
DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n",
perl_name, (unsigned long) symref));
- ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
+ ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)_((CV *)))symref, filename)));
char *
diff --git a/gnu/usr.bin/perl/ext/DynaLoader/dl_hpux.xs b/gnu/usr.bin/perl/ext/DynaLoader/dl_hpux.xs
index 51d464e6dea..a82e0eac111 100644
--- a/gnu/usr.bin/perl/ext/DynaLoader/dl_hpux.xs
+++ b/gnu/usr.bin/perl/ext/DynaLoader/dl_hpux.xs
@@ -65,6 +65,9 @@ dl_load_file(filename, flags=0)
* unresolved references in situations like this. */
/* bind_type = BIND_IMMEDIATE|BIND_NONFATAL; */
}
+ /* BIND_NOSTART removed from bind_type because it causes the shared library's */
+ /* initialisers not to be run. This causes problems with all of the static objects */
+ /* in the library. */
#ifdef DEBUGGING
if (dl_debug)
bind_type |= BIND_VERBOSE;
@@ -74,14 +77,14 @@ dl_load_file(filename, flags=0)
for (i = 0; i <= max; i++) {
char *sym = SvPVX(*av_fetch(dl_resolve_using, i, 0));
DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s) (dependent)\n", sym));
- obj = shl_load(sym, bind_type | BIND_NOSTART, 0L);
+ obj = shl_load(sym, bind_type, 0L);
if (obj == NULL) {
goto end;
}
}
DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s): ", filename));
- obj = shl_load(filename, bind_type | BIND_NOSTART, 0L);
+ obj = shl_load(filename, bind_type, 0L);
DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", obj));
end:
diff --git a/gnu/usr.bin/perl/ext/DynaLoader/dl_next.xs b/gnu/usr.bin/perl/ext/DynaLoader/dl_next.xs
index 92d14bc81c2..dfa8a3eac8c 100644
--- a/gnu/usr.bin/perl/ext/DynaLoader/dl_next.xs
+++ b/gnu/usr.bin/perl/ext/DynaLoader/dl_next.xs
@@ -100,7 +100,7 @@ static void TranslateError
path, number, type);
break;
}
- safefree(dl_last_error);
+ Safefree(dl_last_error);
dl_last_error = savepv(error);
}
@@ -151,10 +151,10 @@ static void TransferError(NXStream *s)
int len, maxlen;
if ( dl_last_error ) {
- safefree(dl_last_error);
+ Safefree(dl_last_error);
}
NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
- dl_last_error = safemalloc(len);
+ New(1097, dl_last_error, len, char);
strcpy(dl_last_error, buffer);
}
@@ -172,6 +172,7 @@ static char *dlopen(char *path, int mode /* mode is ignored */)
I32 i, psize;
char *result;
char **p;
+ STRLEN n_a;
/* Do not load what is already loaded into this process */
if (hv_fetch(dl_loaded_files, path, strlen(path), 0))
@@ -182,7 +183,7 @@ static char *dlopen(char *path, int mode /* mode is ignored */)
p = (char **) safemalloc(psize * sizeof(char*));
p[0] = path;
for(i=1; i<psize-1; i++) {
- p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), na);
+ p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), n_a);
}
p[psize-1] = 0;
rld_success = rld_load(nxerr, (struct mach_header **)0, p,
@@ -191,7 +192,7 @@ static char *dlopen(char *path, int mode /* mode is ignored */)
if (rld_success) {
result = path;
/* prevent multiple loads of same file into same process */
- hv_store(dl_loaded_files, path, strlen(path), &sv_yes, 0);
+ hv_store(dl_loaded_files, path, strlen(path), &PL_sv_yes, 0);
} else {
TransferError(nxerr);
result = (char*) 0;
diff --git a/gnu/usr.bin/perl/ext/DynaLoader/dl_vms.xs b/gnu/usr.bin/perl/ext/DynaLoader/dl_vms.xs
index 0329ebd9cbd..08fd2f3f460 100644
--- a/gnu/usr.bin/perl/ext/DynaLoader/dl_vms.xs
+++ b/gnu/usr.bin/perl/ext/DynaLoader/dl_vms.xs
@@ -1,7 +1,7 @@
/* dl_vms.xs
*
* Platform: OpenVMS, VAX or AXP
- * Author: Charles Bailey bailey@genetics.upenn.edu
+ * Author: Charles Bailey bailey@newman.upenn.edu
* Revised: 12-Dec-1994
*
* Implementation Note
@@ -184,7 +184,7 @@ dl_expandspec(filespec)
DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tSYNCHK sys$parse = %d\n",sts));
if (!(sts & 1)) {
dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
}
else {
/* Now set up a default spec - everything but the name */
@@ -205,7 +205,7 @@ dl_expandspec(filespec)
DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tname/default sys$parse = %d\n",sts));
if (!(sts & 1)) {
dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
}
else {
/* Now find the actual file */
@@ -213,7 +213,7 @@ dl_expandspec(filespec)
DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tsys$search = %d\n",sts));
if (!(sts & 1)) {
dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
}
else {
ST(0) = sv_2mortal(newSVpv(dlnam.nam$l_rsa,dlnam.nam$b_rsl));
@@ -263,7 +263,7 @@ dl_load_file(filespec, flags)
dlptr->name.dsc$w_length = namlst[0].len;
dlptr->name.dsc$a_pointer = savepvn(namlst[0].string,namlst[0].len);
dlptr->defspec.dsc$w_length = specdsc.dsc$w_length - namlst[0].len;
- dlptr->defspec.dsc$a_pointer = safemalloc(dlptr->defspec.dsc$w_length + 1);
+ New(1097, dlptr->defspec.dsc$a_pointer, dlptr->defspec.dsc$w_length + 1, char);
deflen = namlst[0].string - specdsc.dsc$a_pointer;
memcpy(dlptr->defspec.dsc$a_pointer,specdsc.dsc$a_pointer,deflen);
memcpy(dlptr->defspec.dsc$a_pointer + deflen,
@@ -295,7 +295,7 @@ dl_load_file(filespec, flags)
Safefree(dlptr->name.dsc$a_pointer);
Safefree(dlptr->defspec.dsc$a_pointer);
Safefree(dlptr);
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
}
else {
ST(0) = sv_2mortal(newSViv((IV) dlptr));
@@ -323,7 +323,7 @@ dl_find_symbol(librefptr,symname)
(unsigned long int) entry));
if (!(sts & 1)) {
/* error message already saved by findsym_handler */
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
}
else ST(0) = sv_2mortal(newSViv((IV) entry));
diff --git a/gnu/usr.bin/perl/ext/DynaLoader/dlutils.c b/gnu/usr.bin/perl/ext/DynaLoader/dlutils.c
index 58006789ef6..bfa1f78ac0a 100644
--- a/gnu/usr.bin/perl/ext/DynaLoader/dlutils.c
+++ b/gnu/usr.bin/perl/ext/DynaLoader/dlutils.c
@@ -26,7 +26,7 @@ static int dl_debug = 0; /* value copied from $DynaLoader::dl_error */
static void
-dl_generic_private_init() /* called by dl_*.xs dl_private_init() */
+dl_generic_private_init(CPERLarg) /* called by dl_*.xs dl_private_init() */
{
char *perl_dl_nonlazy;
#ifdef DEBUGGING
@@ -44,16 +44,8 @@ dl_generic_private_init() /* called by dl_*.xs dl_private_init() */
/* SaveError() takes printf style args and saves the result in LastError */
-#ifdef STANDARD_C
static void
-SaveError(char* pat, ...)
-#else
-/*VARARGS0*/
-static void
-SaveError(pat, va_alist)
- char *pat;
- va_dcl
-#endif
+SaveError(CPERLarg_ char* pat, ...)
{
va_list args;
char *message;
@@ -61,11 +53,7 @@ SaveError(pat, va_alist)
/* This code is based on croak/warn, see mess() in util.c */
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
message = mess(pat, &args);
va_end(args);
diff --git a/gnu/usr.bin/perl/ext/Fcntl/Fcntl.pm b/gnu/usr.bin/perl/ext/Fcntl/Fcntl.pm
index 6214323c31c..f1edb8ed79d 100644
--- a/gnu/usr.bin/perl/ext/Fcntl/Fcntl.pm
+++ b/gnu/usr.bin/perl/ext/Fcntl/Fcntl.pm
@@ -52,33 +52,71 @@ $VERSION = "1.03";
# (move infrequently used names to @EXPORT_OK below)
@EXPORT =
qw(
- F_DUPFD F_GETFD F_GETLK F_SETFD F_GETFL F_SETFL F_SETLK F_SETLKW
- FD_CLOEXEC F_RDLCK F_UNLCK F_WRLCK F_POSIX
- O_CREAT O_EXCL O_NOCTTY O_TRUNC
- O_APPEND O_NONBLOCK
- O_NDELAY O_DEFER
- O_RDONLY O_RDWR O_WRONLY
- O_BINARY O_TEXT
- O_EXLOCK O_SHLOCK O_ASYNC O_DSYNC O_RSYNC O_SYNC
- F_SETOWN F_GETOWN
+ FD_CLOEXEC
+ F_DUPFD
+ F_EXLCK
+ F_GETFD
+ F_GETFL
+ F_GETLK
+ F_GETOWN
+ F_POSIX
+ F_RDLCK
+ F_SETFD
+ F_SETFL
+ F_SETLK
+ F_SETLKW
+ F_SETOWN
+ F_SHLCK
+ F_UNLCK
+ F_WRLCK
+ O_ACCMODE
+ O_APPEND
+ O_ASYNC
+ O_BINARY
+ O_CREAT
+ O_DEFER
+ O_DSYNC
+ O_EXCL
+ O_EXLOCK
+ O_NDELAY
+ O_NOCTTY
+ O_NONBLOCK
+ O_RDONLY
+ O_RDWR
+ O_RSYNC
+ O_SHLOCK
+ O_SYNC
+ O_TEXT
+ O_TRUNC
+ O_WRONLY
);
# Other items we are prepared to export if requested
@EXPORT_OK = qw(
- LOCK_SH LOCK_EX LOCK_NB LOCK_UN
- FAPPEND FASYNC FCREAT FDEFER FEXCL FNDELAY FNONBLOCK FSYNC FTRUNC
+ FAPPEND
+ FASYNC
+ FCREAT
+ FDEFER
+ FEXCL
+ FNDELAY
+ FNONBLOCK
+ FSYNC
+ FTRUNC
+ LOCK_EX
+ LOCK_NB
+ LOCK_SH
+ LOCK_UN
);
# Named groups of exports
%EXPORT_TAGS = (
'flock' => [qw(LOCK_SH LOCK_EX LOCK_NB LOCK_UN)],
'Fcompat' => [qw(FAPPEND FASYNC FCREAT FDEFER FEXCL
- FNDELAY FNONBLOCK FSYNC FTRUNC)],
+ FNDELAY FNONBLOCK FSYNC FTRUNC)],
);
sub AUTOLOAD {
- my($constname);
- ($constname = $AUTOLOAD) =~ s/.*:://;
- my $val = constant($constname, @_ ? $_[0] : 0);
+ (my $constname = $AUTOLOAD) =~ s/.*:://;
+ my $val = constant($constname, 0);
if ($! != 0) {
if ($! =~ /Invalid/) {
$AutoLoader::AUTOLOAD = $AUTOLOAD;
@@ -90,7 +128,7 @@ sub AUTOLOAD {
";
}
}
- eval "sub $AUTOLOAD { $val }";
+ *$AUTOLOAD = sub { $val };
goto &$AUTOLOAD;
}
diff --git a/gnu/usr.bin/perl/ext/Fcntl/Fcntl.xs b/gnu/usr.bin/perl/ext/Fcntl/Fcntl.xs
index 9034031c9ca..5149444b685 100644
--- a/gnu/usr.bin/perl/ext/Fcntl/Fcntl.xs
+++ b/gnu/usr.bin/perl/ext/Fcntl/Fcntl.xs
@@ -5,7 +5,13 @@
#ifdef VMS
# include <file.h>
#else
+#if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
+#define _NO_OLDNAMES
+#endif
# include <fcntl.h>
+#if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
+#undef _NO_OLDNAMES
+#endif
#endif
/* This comment is a kludge to get metaconfig to see the symbols
@@ -23,17 +29,14 @@
*/
static int
-not_here(s)
-char *s;
+not_here(char *s)
{
croak("%s not implemented on this architecture", s);
return -1;
}
static double
-constant(name, arg)
-char *name;
-int arg;
+constant(char *name, int arg)
{
errno = 0;
switch (*name) {
@@ -45,12 +48,24 @@ int arg;
#else
goto not_there;
#endif
+ if (strEQ(name, "F_EXLCK"))
+#ifdef F_EXLCK
+ return F_EXLCK;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "F_GETFD"))
#ifdef F_GETFD
return F_GETFD;
#else
goto not_there;
#endif
+ if (strEQ(name, "F_GETFL"))
+#ifdef F_GETFL
+ return F_GETFL;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "F_GETLK"))
#ifdef F_GETLK
return F_GETLK;
@@ -63,21 +78,21 @@ int arg;
#else
goto not_there;
#endif
- if (strEQ(name, "F_SETFD"))
-#ifdef F_SETFD
- return F_SETFD;
+ if (strEQ(name, "F_POSIX"))
+#ifdef F_POSIX
+ return F_POSIX;
#else
goto not_there;
#endif
- if (strEQ(name, "F_GETFL"))
-#ifdef F_GETFL
- return F_GETFL;
+ if (strEQ(name, "F_RDLCK"))
+#ifdef F_RDLCK
+ return F_RDLCK;
#else
goto not_there;
#endif
- if (strEQ(name, "F_POSIX"))
-#ifdef F_POSIX
- return F_POSIX;
+ if (strEQ(name, "F_SETFD"))
+#ifdef F_SETFD
+ return F_SETFD;
#else
goto not_there;
#endif
@@ -105,9 +120,9 @@ int arg;
#else
goto not_there;
#endif
- if (strEQ(name, "F_RDLCK"))
-#ifdef F_RDLCK
- return F_RDLCK;
+ if (strEQ(name, "F_SHLCK"))
+#ifdef F_SHLCK
+ return F_SHLCK;
#else
goto not_there;
#endif
@@ -150,6 +165,12 @@ int arg;
#else
goto not_there;
#endif
+ if (strEQ(name, "FDEFER"))
+#ifdef FDEFER
+ return FDEFER;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "FEXCL"))
#ifdef FEXCL
return FEXCL;
@@ -214,33 +235,69 @@ int arg;
break;
case 'O':
if (strnEQ(name, "O_", 2)) {
+ if (strEQ(name, "O_ACCMODE"))
+#ifdef O_ACCMODE
+ return O_ACCMODE;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "O_APPEND"))
+#ifdef O_APPEND
+ return O_APPEND;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "O_ASYNC"))
+#ifdef O_ASYNC
+ return O_ASYNC;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "O_BINARY"))
+#ifdef O_BINARY
+ return O_BINARY;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "O_CREAT"))
#ifdef O_CREAT
return O_CREAT;
#else
goto not_there;
#endif
+ if (strEQ(name, "O_DEFER"))
+#ifdef O_DEFER
+ return O_DEFER;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "O_DSYNC"))
+#ifdef O_DSYNC
+ return O_DSYNC;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "O_EXCL"))
#ifdef O_EXCL
return O_EXCL;
#else
goto not_there;
#endif
- if (strEQ(name, "O_NOCTTY"))
-#ifdef O_NOCTTY
- return O_NOCTTY;
+ if (strEQ(name, "O_EXLOCK"))
+#ifdef O_EXLOCK
+ return O_EXLOCK;
#else
goto not_there;
#endif
- if (strEQ(name, "O_TRUNC"))
-#ifdef O_TRUNC
- return O_TRUNC;
+ if (strEQ(name, "O_NDELAY"))
+#ifdef O_NDELAY
+ return O_NDELAY;
#else
goto not_there;
#endif
- if (strEQ(name, "O_APPEND"))
-#ifdef O_APPEND
- return O_APPEND;
+ if (strEQ(name, "O_NOCTTY"))
+#ifdef O_NOCTTY
+ return O_NOCTTY;
#else
goto not_there;
#endif
@@ -250,12 +307,6 @@ int arg;
#else
goto not_there;
#endif
- if (strEQ(name, "O_NDELAY"))
-#ifdef O_NDELAY
- return O_NDELAY;
-#else
- goto not_there;
-#endif
if (strEQ(name, "O_RDONLY"))
#ifdef O_RDONLY
return O_RDONLY;
@@ -268,21 +319,9 @@ int arg;
#else
goto not_there;
#endif
- if (strEQ(name, "O_WRONLY"))
-#ifdef O_WRONLY
- return O_WRONLY;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "O_BINARY"))
-#ifdef O_BINARY
- return O_BINARY;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "O_EXLOCK"))
-#ifdef O_EXLOCK
- return O_EXLOCK;
+ if (strEQ(name, "O_RSYNC"))
+#ifdef O_RSYNC
+ return O_RSYNC;
#else
goto not_there;
#endif
@@ -292,33 +331,27 @@ int arg;
#else
goto not_there;
#endif
- if (strEQ(name, "O_ASYNC"))
-#ifdef O_ASYNC
- return O_ASYNC;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "O_DSYNC"))
-#ifdef O_DSYNC
- return O_DSYNC;
+ if (strEQ(name, "O_SYNC"))
+#ifdef O_SYNC
+ return O_SYNC;
#else
goto not_there;
#endif
- if (strEQ(name, "O_RSYNC"))
-#ifdef O_RSYNC
- return O_RSYNC;
+ if (strEQ(name, "O_TEXT"))
+#ifdef O_TEXT
+ return O_TEXT;
#else
goto not_there;
#endif
- if (strEQ(name, "O_SYNC"))
-#ifdef O_SYNC
- return O_SYNC;
+ if (strEQ(name, "O_TRUNC"))
+#ifdef O_TRUNC
+ return O_TRUNC;
#else
goto not_there;
#endif
- if (strEQ(name, "O_DEFER"))
-#ifdef O_DEFER
- return O_DEFER;
+ if (strEQ(name, "O_WRONLY"))
+#ifdef O_WRONLY
+ return O_WRONLY;
#else
goto not_there;
#endif
diff --git a/gnu/usr.bin/perl/ext/GDBM_File/GDBM_File.pm b/gnu/usr.bin/perl/ext/GDBM_File/GDBM_File.pm
index 9c7ae066b79..09df4373fb6 100644
--- a/gnu/usr.bin/perl/ext/GDBM_File/GDBM_File.pm
+++ b/gnu/usr.bin/perl/ext/GDBM_File/GDBM_File.pm
@@ -7,7 +7,7 @@ GDBM_File - Perl5 access to the gdbm library.
=head1 SYNOPSIS
use GDBM_File ;
- tie %hash, 'GDBM_File', $filename, &GDBM_WRCREAT, 0640);
+ tie %hash, 'GDBM_File', $filename, &GDBM_WRCREAT, 0640;
# Use the %hash array.
untie %hash ;
diff --git a/gnu/usr.bin/perl/ext/GDBM_File/typemap b/gnu/usr.bin/perl/ext/GDBM_File/typemap
index a9b73d8b811..317a8f3886c 100644
--- a/gnu/usr.bin/perl/ext/GDBM_File/typemap
+++ b/gnu/usr.bin/perl/ext/GDBM_File/typemap
@@ -14,8 +14,8 @@ FATALFUNC T_OPAQUEPTR
INPUT
T_DATUM
- $var.dptr = SvPV($arg, na);
- $var.dsize = (int)na;
+ $var.dptr = SvPV($arg, PL_na);
+ $var.dsize = (int)PL_na;
T_GDATUM
UNIMPLEMENTED
OUTPUT
diff --git a/gnu/usr.bin/perl/ext/IO/IO.pm b/gnu/usr.bin/perl/ext/IO/IO.pm
index 1ba05ca9165..4d4c81ce405 100644
--- a/gnu/usr.bin/perl/ext/IO/IO.pm
+++ b/gnu/usr.bin/perl/ext/IO/IO.pm
@@ -12,7 +12,7 @@ IO - load various IO modules
=head1 DESCRIPTION
-C<IO> provides a simple mechanism to load all of the IO modules at one go.
+C<IO> provides a simple mechanism to load some of the IO modules at one go.
Currently this includes:
IO::Handle
diff --git a/gnu/usr.bin/perl/ext/IO/IO.xs b/gnu/usr.bin/perl/ext/IO/IO.xs
index e558d5c4e0a..300581ed4e2 100644
--- a/gnu/usr.bin/perl/ext/IO/IO.xs
+++ b/gnu/usr.bin/perl/ext/IO/IO.xs
@@ -7,7 +7,14 @@
# include <unistd.h>
#endif
#ifdef I_FCNTL
+#if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
+#define _NO_OLDNAMES
+#endif
# include <fcntl.h>
+#if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
+#undef _NO_OLDNAMES
+#endif
+
#endif
#ifdef PerlIO
@@ -22,17 +29,14 @@ typedef FILE * OutputStream;
#endif
static int
-not_here(s)
-char *s;
+not_here(char *s)
{
croak("%s not implemented on this architecture", s);
return -1;
}
static bool
-constant(name, pval)
-char *name;
-IV *pval;
+constant(char *name, IV *pval)
{
switch (*name) {
case '_':
@@ -97,7 +101,7 @@ fgetpos(handle)
ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
}
else {
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
errno = EINVAL;
}
@@ -107,7 +111,8 @@ fsetpos(handle, pos)
SV * pos
CODE:
char *p;
- if (handle && (p = SvPVx(pos, na)) && na == sizeof(Fpos_t))
+ STRLEN n_a;
+ if (handle && (p = SvPVx(pos, n_a)) && n_a == sizeof(Fpos_t))
#ifdef PerlIO
RETVAL = PerlIO_setpos(handle, (Fpos_t*)p);
#else
@@ -142,7 +147,7 @@ new_tmpfile(packname = "IO::File")
SvREFCNT_dec(gv); /* undo increment in newRV() */
}
else {
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
SvREFCNT_dec(gv);
}
@@ -156,7 +161,7 @@ constant(name)
if (constant(name, &i))
ST(0) = sv_2mortal(newSViv(i));
else
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
int
ungetc(handle, c)
diff --git a/gnu/usr.bin/perl/ext/IO/Makefile.PL b/gnu/usr.bin/perl/ext/IO/Makefile.PL
index 4a34be61fbb..6a2d50dc83c 100644
--- a/gnu/usr.bin/perl/ext/IO/Makefile.PL
+++ b/gnu/usr.bin/perl/ext/IO/Makefile.PL
@@ -1,7 +1,7 @@
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'IO',
- MAN3PODS => ' ', # Pods will be built by installman.
+ MAN3PODS => {}, # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'lib/IO/Handle.pm',
XS_VERSION => 1.15
diff --git a/gnu/usr.bin/perl/ext/IO/lib/IO/Handle.pm b/gnu/usr.bin/perl/ext/IO/lib/IO/Handle.pm
index 39e32f05abb..7927641f7f1 100644
--- a/gnu/usr.bin/perl/ext/IO/lib/IO/Handle.pm
+++ b/gnu/usr.bin/perl/ext/IO/lib/IO/Handle.pm
@@ -207,7 +207,7 @@ use SelectSaver;
require Exporter;
@ISA = qw(Exporter);
-$VERSION = "1.1504";
+$VERSION = "1.1505";
$XS_VERSION = "1.15";
@EXPORT_OK = qw(
@@ -423,84 +423,79 @@ sub stat {
##
sub autoflush {
- my $old = new SelectSaver qualify($_[0], caller);
+ my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
my $prev = $|;
$| = @_ > 1 ? $_[1] : 1;
$prev;
}
sub output_field_separator {
- my $old = new SelectSaver qualify($_[0], caller);
my $prev = $,;
$, = $_[1] if @_ > 1;
$prev;
}
sub output_record_separator {
- my $old = new SelectSaver qualify($_[0], caller);
my $prev = $\;
$\ = $_[1] if @_ > 1;
$prev;
}
sub input_record_separator {
- my $old = new SelectSaver qualify($_[0], caller);
my $prev = $/;
$/ = $_[1] if @_ > 1;
$prev;
}
sub input_line_number {
- my $old = new SelectSaver qualify($_[0], caller);
+ # localizing $. doesn't work as advertised. grrrrrr.
my $prev = $.;
$. = $_[1] if @_ > 1;
$prev;
}
sub format_page_number {
- my $old = new SelectSaver qualify($_[0], caller);
+ my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
my $prev = $%;
$% = $_[1] if @_ > 1;
$prev;
}
sub format_lines_per_page {
- my $old = new SelectSaver qualify($_[0], caller);
+ my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
my $prev = $=;
$= = $_[1] if @_ > 1;
$prev;
}
sub format_lines_left {
- my $old = new SelectSaver qualify($_[0], caller);
+ my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
my $prev = $-;
$- = $_[1] if @_ > 1;
$prev;
}
sub format_name {
- my $old = new SelectSaver qualify($_[0], caller);
+ my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
my $prev = $~;
$~ = qualify($_[1], caller) if @_ > 1;
$prev;
}
sub format_top_name {
- my $old = new SelectSaver qualify($_[0], caller);
+ my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
my $prev = $^;
$^ = qualify($_[1], caller) if @_ > 1;
$prev;
}
sub format_line_break_characters {
- my $old = new SelectSaver qualify($_[0], caller);
my $prev = $:;
$: = $_[1] if @_ > 1;
$prev;
}
sub format_formfeed {
- my $old = new SelectSaver qualify($_[0], caller);
my $prev = $^L;
$^L = $_[1] if @_ > 1;
$prev;
@@ -520,10 +515,10 @@ sub format_write {
if (@_ == 2) {
my ($fh, $fmt) = @_;
my $oldfmt = $fh->format_name($fmt);
- write($fh);
+ CORE::write($fh);
$fh->format_name($oldfmt);
} else {
- write($_[0]);
+ CORE::write($_[0]);
}
}
diff --git a/gnu/usr.bin/perl/ext/IO/lib/IO/Pipe.pm b/gnu/usr.bin/perl/ext/IO/lib/IO/Pipe.pm
index ae6d9a547e2..23c51b08319 100644
--- a/gnu/usr.bin/perl/ext/IO/lib/IO/Pipe.pm
+++ b/gnu/usr.bin/perl/ext/IO/lib/IO/Pipe.pm
@@ -14,7 +14,7 @@ use vars qw($VERSION);
use Carp;
use Symbol;
-$VERSION = "1.0901";
+$VERSION = "1.0902";
sub new {
my $type = shift;
@@ -96,7 +96,7 @@ sub reader {
close ${*$me}[1];
bless $me, ref($fh);
- *{*$me} = *{*$fh}; # Alias self to handle
+ *$me = *$fh; # Alias self to handle
bless $fh; # Really wan't un-bless here
${*$me}{'io_pipe_pid'} = $pid
if defined $pid;
@@ -113,7 +113,7 @@ sub writer {
close ${*$me}[0];
bless $me, ref($fh);
- *{*$me} = *{*$fh}; # Alias self to handle
+ *$me = *$fh; # Alias self to handle
bless $fh; # Really wan't un-bless here
${*$me}{'io_pipe_pid'} = $pid
if defined $pid;
@@ -177,10 +177,10 @@ IO::pipe - supply object methods for pipes
=head1 DESCRIPTION
-C<IO::Pipe> provides an interface to createing pipes between
+C<IO::Pipe> provides an interface to creating pipes between
processes.
-=head1 CONSTRCUTOR
+=head1 CONSTRUCTOR
=over 4
diff --git a/gnu/usr.bin/perl/ext/IO/lib/IO/Seekable.pm b/gnu/usr.bin/perl/ext/IO/lib/IO/Seekable.pm
index 91c381a61e9..86154c5722d 100644
--- a/gnu/usr.bin/perl/ext/IO/lib/IO/Seekable.pm
+++ b/gnu/usr.bin/perl/ext/IO/lib/IO/Seekable.pm
@@ -14,7 +14,7 @@ IO::Seekable - supply seek based methods for I/O objects
=head1 DESCRIPTION
-C<IO::Seekable> does not have a constuctor of its own as is intended to
+C<IO::Seekable> does not have a constructor of its own as it is intended to
be inherited by other C<IO::Handle> based objects. It provides methods
which allow seeking of the file descriptors.
diff --git a/gnu/usr.bin/perl/ext/IO/lib/IO/Socket.pm b/gnu/usr.bin/perl/ext/IO/lib/IO/Socket.pm
index aadb502f193..2b4bc49daf7 100644
--- a/gnu/usr.bin/perl/ext/IO/lib/IO/Socket.pm
+++ b/gnu/usr.bin/perl/ext/IO/lib/IO/Socket.pm
@@ -186,7 +186,7 @@ sub socketpair {
my $fh1 = $class->new();
my $fh2 = $class->new();
- socketpair($fh1,$fh1,$domain,$type,$protocol) or
+ socketpair($fh1,$fh2,$domain,$type,$protocol) or
return ();
${*$fh1}{'io_socket_type'} = ${*$fh2}{'io_socket_type'} = $type;
@@ -664,7 +664,7 @@ Returns the pathname to the fifo at the local end
=item peerpath()
-Returns the pathanme to the fifo at the peer end
+Returns the pathname to the fifo at the peer end
=back
diff --git a/gnu/usr.bin/perl/ext/IPC/SysV/Makefile.PL b/gnu/usr.bin/perl/ext/IPC/SysV/Makefile.PL
index d4ea5583de6..51715e78279 100644
--- a/gnu/usr.bin/perl/ext/IPC/SysV/Makefile.PL
+++ b/gnu/usr.bin/perl/ext/IPC/SysV/Makefile.PL
@@ -1,5 +1,5 @@
# This -*- perl -*- script makes the Makefile
-# $Id: Makefile.PL,v 1.1.1.1 1999/04/29 22:38:48 millert Exp $
+# $Id: Makefile.PL,v 1.2 1999/04/29 22:51:30 millert Exp $
require 5.002;
use ExtUtils::MakeMaker;
diff --git a/gnu/usr.bin/perl/ext/NDBM_File/NDBM_File.pm b/gnu/usr.bin/perl/ext/NDBM_File/NDBM_File.pm
index 47b1f5aa3c2..ed4fe2b36f9 100644
--- a/gnu/usr.bin/perl/ext/NDBM_File/NDBM_File.pm
+++ b/gnu/usr.bin/perl/ext/NDBM_File/NDBM_File.pm
@@ -12,7 +12,7 @@ require DynaLoader;
@ISA = qw(Tie::Hash DynaLoader);
-$VERSION = "1.00";
+$VERSION = "1.01";
bootstrap NDBM_File $VERSION;
@@ -27,6 +27,7 @@ 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);
diff --git a/gnu/usr.bin/perl/ext/NDBM_File/typemap b/gnu/usr.bin/perl/ext/NDBM_File/typemap
index a9b73d8b811..317a8f3886c 100644
--- a/gnu/usr.bin/perl/ext/NDBM_File/typemap
+++ b/gnu/usr.bin/perl/ext/NDBM_File/typemap
@@ -14,8 +14,8 @@ FATALFUNC T_OPAQUEPTR
INPUT
T_DATUM
- $var.dptr = SvPV($arg, na);
- $var.dsize = (int)na;
+ $var.dptr = SvPV($arg, PL_na);
+ $var.dsize = (int)PL_na;
T_GDATUM
UNIMPLEMENTED
OUTPUT
diff --git a/gnu/usr.bin/perl/ext/ODBM_File/ODBM_File.xs b/gnu/usr.bin/perl/ext/ODBM_File/ODBM_File.xs
index b57e560bd39..892c038a9ce 100644
--- a/gnu/usr.bin/perl/ext/ODBM_File/ODBM_File.xs
+++ b/gnu/usr.bin/perl/ext/ODBM_File/ODBM_File.xs
@@ -3,7 +3,7 @@
#include "XSUB.h"
#ifdef NULL
-#undef NULL
+#undef NULL /* XXX Why? */
#endif
#ifdef I_DBM
# include <dbm.h>
@@ -46,6 +46,10 @@ static int dbmrefcnt;
MODULE = ODBM_File PACKAGE = ODBM_File PREFIX = odbm_
+#ifndef NULL
+# define NULL 0
+#endif
+
ODBM_File
odbm_TIEHASH(dbtype, filename, flags, mode)
char * dbtype
@@ -60,7 +64,7 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
New(0, tmpbuf, strlen(filename) + 5, char);
SAVEFREEPV(tmpbuf);
sprintf(tmpbuf,"%s.dir",filename);
- if (stat(tmpbuf, &statbuf) < 0) {
+ if (stat(tmpbuf, &PL_statbuf) < 0) {
if (flags & O_CREAT) {
if (mode < 0 || close(creat(tmpbuf,mode)) < 0)
croak("ODBM_File: Can't create %s", filename);
@@ -72,7 +76,7 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
croak("ODBM_FILE: Can't open %s", filename);
}
RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
- ST(0) = sv_mortalcopy(&sv_undef);
+ ST(0) = sv_mortalcopy(&PL_sv_undef);
sv_setptrobj(ST(0), RETVAL, dbtype);
}
diff --git a/gnu/usr.bin/perl/ext/Opcode/Makefile.PL b/gnu/usr.bin/perl/ext/Opcode/Makefile.PL
index 7fdcdf6ac13..d7e781f21db 100644
--- a/gnu/usr.bin/perl/ext/Opcode/Makefile.PL
+++ b/gnu/usr.bin/perl/ext/Opcode/Makefile.PL
@@ -1,7 +1,7 @@
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'Opcode',
- MAN3PODS => ' ',
+ MAN3PODS => {},
VERSION_FROM => 'Opcode.pm',
- XS_VERSION => '1.02'
+ XS_VERSION => '1.03'
);
diff --git a/gnu/usr.bin/perl/ext/Opcode/Opcode.pm b/gnu/usr.bin/perl/ext/Opcode/Opcode.pm
index a35ad1b47b4..0ee6be69559 100644
--- a/gnu/usr.bin/perl/ext/Opcode/Opcode.pm
+++ b/gnu/usr.bin/perl/ext/Opcode/Opcode.pm
@@ -5,7 +5,7 @@ require 5.002;
use vars qw($VERSION $XS_VERSION @ISA @EXPORT_OK);
$VERSION = "1.04";
-$XS_VERSION = "1.02";
+$XS_VERSION = "1.03";
use strict;
use Carp;
@@ -152,7 +152,7 @@ like gv2cv, i_ncmp and ftsvtx.
=item an operator tag name (optag)
Operator tags can be used to refer to groups (or sets) of operators.
-Tag names always being with a colon. The Opcode module defines several
+Tag names always begin with a colon. The Opcode module defines several
optags and the user can define others using the define_optag function.
=item a negated opname or optag
@@ -326,7 +326,7 @@ invert_opset function.
ucfirst lcfirst uc lc quotemeta trans chop schop chomp schomp
- match split
+ match split qr
list lslice splice push pop shift unshift reverse
@@ -398,7 +398,7 @@ These are a hotchpotch of opcodes still waiting to be considered
bless -- could be used to change ownership of objects (reblessing)
- pushre regcmaybe regcomp subst substcont
+ pushre regcmaybe regcreset regcomp subst substcont
sprintf prtf -- can core dump
@@ -427,12 +427,18 @@ beyond the scope of the compartment.
rand srand
+=item :base_thread
+
+These ops are related to multi-threading.
+
+ lock threadsv
+
=item :default
A handy tag name for a I<reasonable> default set of ops. (The current ops
allowed are unstable while development continues. It will change.)
- :base_core :base_mem :base_loop :base_io :base_orig
+ :base_core :base_mem :base_loop :base_io :base_orig :base_thread
If safety matters to you (and why else would you be using the Opcode module?)
then you should not rely on the definition of this, or indeed any other, optag!
@@ -563,7 +569,7 @@ Originally designed and implemented by Malcolm Beattie,
mbeattie@sable.ox.ac.uk as part of Safe version 1.
Split out from Safe module version 1, named opcode tags and other
-changes added by Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt>.
+changes added by Tim Bunce.
=cut
diff --git a/gnu/usr.bin/perl/ext/Opcode/Opcode.xs b/gnu/usr.bin/perl/ext/Opcode/Opcode.xs
index 9d4b726536a..e93b90046a3 100644
--- a/gnu/usr.bin/perl/ext/Opcode/Opcode.xs
+++ b/gnu/usr.bin/perl/ext/Opcode/Opcode.xs
@@ -2,9 +2,10 @@
#include "perl.h"
#include "XSUB.h"
-/* maxo shouldn't differ from MAXO but leave room anyway (see BOOT:) */
+/* PL_maxo shouldn't differ from MAXO but leave room anyway (see BOOT:) */
#define OP_MASK_BUF_SIZE (MAXO + 100)
+/* XXX op_named_bits and opset_all are never freed */
static HV *op_named_bits; /* cache shared for whole process */
static SV *opset_all; /* mask with all bits set */
static IV opset_len; /* length of opmasks in bytes */
@@ -21,21 +22,25 @@ static SV *get_op_bitspec _((char *opname, STRLEN len, int fatal));
* It is first loaded with the name and number of each perl operator.
* Then the builtin tags :none and :all are added.
* Opcode.pm loads the standard optags from __DATA__
+ * XXX leak-alert: data allocated here is never freed, call this
+ * at most once
*/
static void
-op_names_init()
+op_names_init(void)
{
int i;
STRLEN len;
- char *opname;
+ char **op_names;
char *bitmap;
op_named_bits = newHV();
- for(i=0; i < maxo; ++i) {
- hv_store(op_named_bits, op_name[i],strlen(op_name[i]),
- Sv=newSViv(i), 0);
- SvREADONLY_on(Sv);
+ op_names = get_op_names();
+ for(i=0; i < PL_maxo; ++i) {
+ SV *sv;
+ sv = newSViv(i);
+ SvREADONLY_on(sv);
+ hv_store(op_named_bits, op_names[i], strlen(op_names[i]), sv, 0);
}
put_op_bitspec(":none",0, sv_2mortal(new_opset(Nullsv)));
@@ -46,7 +51,7 @@ op_names_init()
while(i-- > 0)
bitmap[i] = 0xFF;
/* Take care to set the right number of bits in the last byte */
- bitmap[len-1] = (maxo & 0x07) ? ~(0xFF << (maxo & 0x07)) : 0xFF;
+ bitmap[len-1] = (PL_maxo & 0x07) ? ~(0xFF << (PL_maxo & 0x07)) : 0xFF;
put_op_bitspec(":all",0, opset_all); /* don't mortalise */
}
@@ -57,10 +62,7 @@ op_names_init()
*/
static void
-put_op_bitspec(optag, len, mask)
- char *optag;
- STRLEN len;
- SV *mask;
+put_op_bitspec(char *optag, STRLEN len, SV *mask)
{
SV **svp;
verify_opset(mask,1);
@@ -81,10 +83,7 @@ put_op_bitspec(optag, len, mask)
*/
static SV *
-get_op_bitspec(opname, len, fatal)
- char *opname;
- STRLEN len;
- int fatal;
+get_op_bitspec(char *opname, STRLEN len, int fatal)
{
SV **svp;
if (!len)
@@ -107,8 +106,7 @@ get_op_bitspec(opname, len, fatal)
static SV *
-new_opset(old_opset)
- SV *old_opset;
+new_opset(SV *old_opset)
{
SV *opset;
if (old_opset) {
@@ -116,7 +114,7 @@ new_opset(old_opset)
opset = newSVsv(old_opset);
}
else {
- opset = newSV(opset_len);
+ opset = NEWSV(1156, opset_len);
Zero(SvPVX(opset), opset_len + 1, char);
SvCUR_set(opset, opset_len);
(void)SvPOK_only(opset);
@@ -127,9 +125,7 @@ new_opset(old_opset)
static int
-verify_opset(opset, fatal)
- SV *opset;
- int fatal;
+verify_opset(SV *opset, int fatal)
{
char *err = Nullch;
if (!SvOK(opset)) err = "undefined";
@@ -143,17 +139,13 @@ verify_opset(opset, fatal)
static void
-set_opset_bits(bitmap, bitspec, on, opname)
- char *bitmap;
- SV *bitspec;
- int on;
- char *opname;
+set_opset_bits(char *bitmap, SV *bitspec, int on, char *opname)
{
if (SvIOK(bitspec)) {
int myopcode = SvIV(bitspec);
int offset = myopcode >> 3;
int bit = myopcode & 0x07;
- if (myopcode >= maxo || myopcode < 0)
+ if (myopcode >= PL_maxo || myopcode < 0)
croak("panic: opcode \"%s\" value %d is invalid", opname, myopcode);
if (opcode_debug >= 2)
warn("set_opset_bits bit %2d (off=%d, bit=%d) %s %s\n",
@@ -181,8 +173,7 @@ set_opset_bits(bitmap, bitspec, on, opname)
static void
-opmask_add(opset) /* THE ONLY FUNCTION TO EDIT op_mask ITSELF */
- SV *opset;
+opmask_add(SV *opset) /* THE ONLY FUNCTION TO EDIT PL_op_mask ITSELF */
{
int i,j;
char *bitmask;
@@ -191,8 +182,8 @@ opmask_add(opset) /* THE ONLY FUNCTION TO EDIT op_mask ITSELF */
verify_opset(opset,1); /* croaks on bad opset */
- if (!op_mask) /* caller must ensure op_mask exists */
- croak("Can't add to uninitialised op_mask");
+ if (!PL_op_mask) /* caller must ensure PL_op_mask exists */
+ croak("Can't add to uninitialised PL_op_mask");
/* OPCODES ALREADY MASKED ARE NEVER UNMASKED. See opmask_addlocal() */
@@ -203,25 +194,28 @@ opmask_add(opset) /* THE ONLY FUNCTION TO EDIT op_mask ITSELF */
myopcode += 8;
continue;
}
- for (j=0; j < 8 && myopcode < maxo; )
- op_mask[myopcode++] |= bits & (1 << j++);
+ for (j=0; j < 8 && myopcode < PL_maxo; )
+ PL_op_mask[myopcode++] |= bits & (1 << j++);
}
}
static void
-opmask_addlocal(opset, op_mask_buf) /* Localise op_mask then opmask_add() */
- SV *opset;
- char *op_mask_buf;
+opmask_addlocal(SV *opset, char *op_mask_buf) /* Localise PL_op_mask then opmask_add() */
{
- char *orig_op_mask = op_mask;
- SAVEPPTR(op_mask);
+ char *orig_op_mask = PL_op_mask;
+ SAVEPPTR(PL_op_mask);
+#if !defined(PERL_OBJECT)
+ /* XXX casting to an ordinary function ptr from a member function ptr
+ * is disallowed by Borland
+ */
if (opcode_debug >= 2)
- SAVEDESTRUCTOR((void(*)_((void*)))warn,"op_mask restored");
- op_mask = &op_mask_buf[0];
+ SAVEDESTRUCTOR((void(CPERLscope(*))_((void*)))warn,"PL_op_mask restored");
+#endif
+ PL_op_mask = &op_mask_buf[0];
if (orig_op_mask)
- Copy(orig_op_mask, op_mask, maxo, char);
+ Copy(orig_op_mask, PL_op_mask, PL_maxo, char);
else
- Zero(op_mask, maxo, char);
+ Zero(PL_op_mask, PL_maxo, char);
opmask_add(opset);
}
@@ -232,19 +226,19 @@ MODULE = Opcode PACKAGE = Opcode
PROTOTYPES: ENABLE
BOOT:
- assert(maxo < OP_MASK_BUF_SIZE);
- opset_len = (maxo + 7) / 8;
+ assert(PL_maxo < OP_MASK_BUF_SIZE);
+ opset_len = (PL_maxo + 7) / 8;
if (opcode_debug >= 1)
warn("opset_len %ld\n", (long)opset_len);
op_names_init();
void
-_safe_call_sv(package, mask, codesv)
- char * package
+_safe_call_sv(Package, mask, codesv)
+ char * Package
SV * mask
SV * codesv
- PPCODE:
+PPCODE:
char op_mask_buf[OP_MASK_BUF_SIZE];
GV *gv;
@@ -252,21 +246,21 @@ _safe_call_sv(package, mask, codesv)
opmask_addlocal(mask, op_mask_buf);
- save_aptr(&endav);
- endav = (AV*)sv_2mortal((SV*)newAV()); /* ignore END blocks for now */
+ save_aptr(&PL_endav);
+ PL_endav = (AV*)sv_2mortal((SV*)newAV()); /* ignore END blocks for now */
- save_hptr(&defstash); /* save current default stack */
+ save_hptr(&PL_defstash); /* save current default stack */
/* the assignment to global defstash changes our sense of 'main' */
- defstash = gv_stashpv(package, GV_ADDWARN); /* should exist already */
+ PL_defstash = gv_stashpv(Package, GV_ADDWARN); /* should exist already */
/* defstash must itself contain a main:: so we'll add that now */
/* take care with the ref counts (was cause of long standing bug) */
/* XXX I'm still not sure if this is right, GV_ADDWARN should warn! */
gv = gv_fetchpv("main::", GV_ADDWARN, SVt_PVHV);
sv_free((SV*)GvHV(gv));
- GvHV(gv) = (HV*)SvREFCNT_inc(defstash);
+ GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash);
- PUSHMARK(sp);
+ PUSHMARK(SP);
perl_call_sv(codesv, GIMME|G_EVAL|G_KEEPERR); /* use callers context */
SPAGAIN; /* for the PUTBACK added by xsubpp */
LEAVE;
@@ -281,17 +275,17 @@ verify_opset(opset, fatal = 0)
void
invert_opset(opset)
SV *opset
- CODE:
+CODE:
{
char *bitmap;
STRLEN len = opset_len;
- opset = new_opset(opset); /* verify and clone opset */
+ opset = sv_2mortal(new_opset(opset)); /* verify and clone opset */
bitmap = SvPVX(opset);
while(len-- > 0)
bitmap[len] = ~bitmap[len];
- /* take care of extra bits beyond maxo in last byte */
- if (maxo & 07)
- bitmap[opset_len-1] &= ~(0xFF << (maxo & 0x07));
+ /* take care of extra bits beyond PL_maxo in last byte */
+ if (PL_maxo & 07)
+ bitmap[opset_len-1] &= ~(0xFF << (PL_maxo & 0x07));
}
ST(0) = opset;
@@ -300,16 +294,16 @@ void
opset_to_ops(opset, desc = 0)
SV *opset
int desc
- PPCODE:
+PPCODE:
{
STRLEN len;
int i, j, myopcode;
char *bitmap = SvPV(opset, len);
- char **names = (desc) ? op_desc : op_name;
+ char **names = (desc) ? get_op_descs() : get_op_names();
verify_opset(opset,1);
for (myopcode=0, i=0; i < opset_len; i++) {
U16 bits = bitmap[i];
- for (j=0; j < 8 && myopcode < maxo; j++, myopcode++) {
+ for (j=0; j < 8 && myopcode < PL_maxo; j++, myopcode++) {
if ( bits & (1 << j) )
XPUSHs(sv_2mortal(newSVpv(names[myopcode], 0)));
}
@@ -319,12 +313,12 @@ opset_to_ops(opset, desc = 0)
void
opset(...)
- CODE:
+CODE:
int i, j;
SV *bitspec, *opset;
char *bitmap;
STRLEN len, on;
- opset = new_opset(Nullsv);
+ opset = sv_2mortal(new_opset(Nullsv));
bitmap = SvPVX(opset);
for (i = 0; i < items; i++) {
char *opname;
@@ -349,11 +343,11 @@ opset(...)
void
permit_only(safe, ...)
SV *safe
- ALIAS:
+ALIAS:
permit = 1
deny_only = 2
deny = 3
- CODE:
+CODE:
int i, on;
SV *bitspec, *mask;
char *bitmap, *opname;
@@ -363,8 +357,9 @@ permit_only(safe, ...)
croak("Not a Safe object");
mask = *hv_fetch((HV*)SvRV(safe), "Mask",4, 1);
if (ONLY_THESE) /* *_only = new mask, else edit current */
- sv_setsv(mask, new_opset(PERMITING ? opset_all : Nullsv));
- else verify_opset(mask,1); /* croaks */
+ sv_setsv(mask, sv_2mortal(new_opset(PERMITING ? opset_all : Nullsv)));
+ else
+ verify_opset(mask,1); /* croaks */
bitmap = SvPVX(mask);
for (i = 1; i < items; i++) {
on = PERMITING ? 0 : 1; /* deny = mask bit on */
@@ -380,16 +375,17 @@ permit_only(safe, ...)
}
set_opset_bits(bitmap, bitspec, on, opname);
}
- ST(0) = &sv_yes;
+ ST(0) = &PL_sv_yes;
void
opdesc(...)
- PPCODE:
+PPCODE:
int i, myopcode;
STRLEN len;
SV **args;
+ char **op_desc = get_op_descs();
/* copy args to a scratch area since we may push output values onto */
/* the stack faster than we read values off it if masks are used. */
args = (SV**)SvPVX(sv_2mortal(newSVpv((char*)&ST(0), items*sizeof(SV*))));
@@ -398,17 +394,18 @@ opdesc(...)
SV *bitspec = get_op_bitspec(opname, len, 1);
if (SvIOK(bitspec)) {
myopcode = SvIV(bitspec);
- if (myopcode < 0 || myopcode >= maxo)
+ if (myopcode < 0 || myopcode >= PL_maxo)
croak("panic: opcode %d (%s) out of range",myopcode,opname);
XPUSHs(sv_2mortal(newSVpv(op_desc[myopcode], 0)));
}
else if (SvPOK(bitspec) && SvCUR(bitspec) == opset_len) {
int b, j;
- char *bitmap = SvPV(bitspec,na);
+ STRLEN n_a;
+ char *bitmap = SvPV(bitspec,n_a);
myopcode = 0;
for (b=0; b < opset_len; b++) {
U16 bits = bitmap[b];
- for (j=0; j < 8 && myopcode < maxo; j++, myopcode++)
+ for (j=0; j < 8 && myopcode < PL_maxo; j++, myopcode++)
if (bits & (1 << j))
XPUSHs(sv_2mortal(newSVpv(op_desc[myopcode], 0)));
}
@@ -423,49 +420,49 @@ void
define_optag(optagsv, mask)
SV *optagsv
SV *mask
- CODE:
+CODE:
STRLEN len;
char *optag = SvPV(optagsv, len);
put_op_bitspec(optag, len, mask); /* croaks */
- ST(0) = &sv_yes;
+ ST(0) = &PL_sv_yes;
void
empty_opset()
- CODE:
+CODE:
ST(0) = sv_2mortal(new_opset(Nullsv));
void
full_opset()
- CODE:
+CODE:
ST(0) = sv_2mortal(new_opset(opset_all));
void
opmask_add(opset)
SV *opset
- PREINIT:
- if (!op_mask)
- Newz(0, op_mask, maxo, char);
+PREINIT:
+ if (!PL_op_mask)
+ Newz(0, PL_op_mask, PL_maxo, char);
void
opcodes()
- PPCODE:
+PPCODE:
if (GIMME == G_ARRAY) {
croak("opcodes in list context not yet implemented"); /* XXX */
}
else {
- XPUSHs(sv_2mortal(newSViv(maxo)));
+ XPUSHs(sv_2mortal(newSViv(PL_maxo)));
}
void
opmask()
- CODE:
+CODE:
ST(0) = sv_2mortal(new_opset(Nullsv));
- if (op_mask) {
+ if (PL_op_mask) {
char *bitmap = SvPVX(ST(0));
int myopcode;
- for(myopcode=0; myopcode < maxo; ++myopcode) {
- if (op_mask[myopcode])
+ for(myopcode=0; myopcode < PL_maxo; ++myopcode) {
+ if (PL_op_mask[myopcode])
bitmap[myopcode >> 3] |= 1 << (myopcode & 0x07);
}
}
diff --git a/gnu/usr.bin/perl/ext/Opcode/Safe.pm b/gnu/usr.bin/perl/ext/Opcode/Safe.pm
index c9d741647ec..2d09c2e5c74 100644
--- a/gnu/usr.bin/perl/ext/Opcode/Safe.pm
+++ b/gnu/usr.bin/perl/ext/Opcode/Safe.pm
@@ -53,11 +53,11 @@ sub new {
sub DESTROY {
my $obj = shift;
- $obj->erase if $obj->{Erase};
+ $obj->erase('DESTROY') if $obj->{Erase};
}
sub erase {
- my $obj= shift;
+ my ($obj, $action) = @_;
my $pkg = $obj->root();
my ($stem, $leaf);
@@ -73,18 +73,22 @@ sub erase {
#warn " stem_symtab hash ".scalar(%$stem_symtab)."\n";
# ", join(', ', %$stem_symtab),"\n";
- delete $stem_symtab->{$leaf};
+# delete $stem_symtab->{$leaf};
-# my $leaf_glob = $stem_symtab->{$leaf};
-# my $leaf_symtab = *{$leaf_glob}{HASH};
+ my $leaf_glob = $stem_symtab->{$leaf};
+ my $leaf_symtab = *{$leaf_glob}{HASH};
# warn " leaf_symtab ", join(', ', %$leaf_symtab),"\n";
-# %$leaf_symtab = ();
+ %$leaf_symtab = ();
#delete $leaf_symtab->{'__ANON__'};
#delete $leaf_symtab->{'foo'};
#delete $leaf_symtab->{'main::'};
# my $foo = undef ${"$stem\::"}{"$leaf\::"};
- $obj->share_from('main', $default_share);
+ if ($action and $action eq 'DESTROY') {
+ delete $stem_symtab->{$leaf};
+ } else {
+ $obj->share_from('main', $default_share);
+ }
1;
}
@@ -279,8 +283,8 @@ perl code is compiled into an internal format before execution.
Evaluating perl code (e.g. via "eval" or "do 'file'") causes
the code to be compiled into an internal format and then,
provided there was no error in the compilation, executed.
-Code evaulated in a compartment compiles subject to the
-compartment's operator mask. Attempting to evaulate code in a
+Code evaluated in a compartment compiles subject to the
+compartment's operator mask. Attempting to evaluate code in a
compartment which contains a masked operator will cause the
compilation to fail with an error. The code will not be executed.
diff --git a/gnu/usr.bin/perl/ext/Opcode/ops.pm b/gnu/usr.bin/perl/ext/Opcode/ops.pm
index b9ea36cef39..9b553b76347 100644
--- a/gnu/usr.bin/perl/ext/Opcode/ops.pm
+++ b/gnu/usr.bin/perl/ext/Opcode/ops.pm
@@ -31,7 +31,7 @@ ops - Perl pragma to restrict unsafe operations when compiling
=head1 DESCRIPTION
-Since the ops pragma currently has an irreversable global effect, it is
+Since the ops pragma currently has an irreversible global effect, it is
only of significant practical use with the C<-M> option on the command line.
See the L<Opcode> module for information about opcodes, optags, opmasks
diff --git a/gnu/usr.bin/perl/ext/POSIX/POSIX.pm b/gnu/usr.bin/perl/ext/POSIX/POSIX.pm
index 2885c0d84c8..84298cb69aa 100644
--- a/gnu/usr.bin/perl/ext/POSIX/POSIX.pm
+++ b/gnu/usr.bin/perl/ext/POSIX/POSIX.pm
@@ -68,7 +68,7 @@ $VERSION = "1.02" ;
_POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT
_POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX
_POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_MAX
- _POSIX_STREADM_MAX _POSIX_TZNAME_MAX)],
+ _POSIX_STREAM_MAX _POSIX_TZNAME_MAX)],
locale_h => [qw(LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC
LC_TIME NULL localeconv setlocale)],
@@ -179,6 +179,7 @@ Exporter::export_tags();
alarm chdir chown close fork getlogin getppid getpgrp link
pipe read rmdir sleep unlink write
utime
+ nice
);
# Grandfather old foo_h form to new :foo_h form
@@ -267,25 +268,25 @@ sub toupper {
sub closedir {
usage "closedir(dirhandle)" if @_ != 1;
- closedir($_[0]);
+ CORE::closedir($_[0]);
}
sub opendir {
usage "opendir(directory)" if @_ != 1;
my $dirhandle = gensym;
- opendir($dirhandle, $_[0])
+ CORE::opendir($dirhandle, $_[0])
? $dirhandle
: undef;
}
sub readdir {
usage "readdir(dirhandle)" if @_ != 1;
- readdir($_[0]);
+ CORE::readdir($_[0]);
}
sub rewinddir {
usage "rewinddir(dirhandle)" if @_ != 1;
- rewinddir($_[0]);
+ CORE::rewinddir($_[0]);
}
sub errno {
@@ -300,42 +301,42 @@ sub creat {
sub fcntl {
usage "fcntl(filehandle, cmd, arg)" if @_ != 3;
- fcntl($_[0], $_[1], $_[2]);
+ CORE::fcntl($_[0], $_[1], $_[2]);
}
sub getgrgid {
usage "getgrgid(gid)" if @_ != 1;
- getgrgid($_[0]);
+ CORE::getgrgid($_[0]);
}
sub getgrnam {
usage "getgrnam(name)" if @_ != 1;
- getgrnam($_[0]);
+ CORE::getgrnam($_[0]);
}
sub atan2 {
usage "atan2(x,y)" if @_ != 2;
- atan2($_[0], $_[1]);
+ CORE::atan2($_[0], $_[1]);
}
sub cos {
usage "cos(x)" if @_ != 1;
- cos($_[0]);
+ CORE::cos($_[0]);
}
sub exp {
usage "exp(x)" if @_ != 1;
- exp($_[0]);
+ CORE::exp($_[0]);
}
sub fabs {
usage "fabs(x)" if @_ != 1;
- abs($_[0]);
+ CORE::abs($_[0]);
}
sub log {
usage "log(x)" if @_ != 1;
- log($_[0]);
+ CORE::log($_[0]);
}
sub pow {
@@ -345,22 +346,22 @@ sub pow {
sub sin {
usage "sin(x)" if @_ != 1;
- sin($_[0]);
+ CORE::sin($_[0]);
}
sub sqrt {
usage "sqrt(x)" if @_ != 1;
- sqrt($_[0]);
+ CORE::sqrt($_[0]);
}
sub getpwnam {
usage "getpwnam(name)" if @_ != 1;
- getpwnam($_[0]);
+ CORE::getpwnam($_[0]);
}
sub getpwuid {
usage "getpwuid(uid)" if @_ != 1;
- getpwuid($_[0]);
+ CORE::getpwuid($_[0]);
}
sub longjmp {
@@ -381,12 +382,12 @@ sub sigsetjmp {
sub kill {
usage "kill(pid, sig)" if @_ != 2;
- kill $_[1], $_[0];
+ CORE::kill $_[1], $_[0];
}
sub raise {
usage "raise(sig)" if @_ != 1;
- kill $_[0], $$; # Is this good enough?
+ CORE::kill $_[0], $$; # Is this good enough?
}
sub offsetof {
@@ -479,12 +480,12 @@ sub fwrite {
sub getc {
usage "getc(handle)" if @_ != 1;
- getc($_[0]);
+ CORE::getc($_[0]);
}
sub getchar {
usage "getchar()" if @_ != 0;
- getc(STDIN);
+ CORE::getc(STDIN);
}
sub gets {
@@ -499,7 +500,7 @@ sub perror {
sub printf {
usage "printf(pattern, args...)" if @_ < 1;
- printf STDOUT @_;
+ CORE::printf STDOUT @_;
}
sub putc {
@@ -516,17 +517,17 @@ sub puts {
sub remove {
usage "remove(filename)" if @_ != 1;
- unlink($_[0]);
+ CORE::unlink($_[0]);
}
sub rename {
usage "rename(oldfilename, newfilename)" if @_ != 2;
- rename($_[0], $_[1]);
+ CORE::rename($_[0], $_[1]);
}
sub rewind {
usage "rewind(filehandle)" if @_ != 1;
- seek($_[0],0,0);
+ CORE::seek($_[0],0,0);
}
sub scanf {
@@ -535,7 +536,7 @@ sub scanf {
sub sprintf {
usage "sprintf(pattern,args)" if @_ == 0;
- sprintf(shift,@_);
+ CORE::sprintf(shift,@_);
}
sub sscanf {
@@ -564,7 +565,7 @@ sub vsprintf {
sub abs {
usage "abs(x)" if @_ != 1;
- abs($_[0]);
+ CORE::abs($_[0]);
}
sub atexit {
@@ -597,7 +598,7 @@ sub div {
sub exit {
usage "exit(status)" if @_ != 1;
- exit($_[0]);
+ CORE::exit($_[0]);
}
sub free {
@@ -639,7 +640,7 @@ sub srand {
sub system {
usage "system(command)" if @_ != 1;
- system($_[0]);
+ CORE::system($_[0]);
}
sub memchr {
@@ -718,7 +719,7 @@ sub strspn {
sub strstr {
usage "strstr(big, little)" if @_ != 2;
- index($_[0], $_[1]);
+ CORE::index($_[0], $_[1]);
}
sub strtok {
@@ -727,71 +728,71 @@ sub strtok {
sub chmod {
usage "chmod(mode, filename)" if @_ != 2;
- chmod($_[0], $_[1]);
+ CORE::chmod($_[0], $_[1]);
}
sub fstat {
usage "fstat(fd)" if @_ != 1;
local *TMP;
open(TMP, "<&$_[0]"); # Gross.
- my @l = stat(TMP);
+ my @l = CORE::stat(TMP);
close(TMP);
@l;
}
sub mkdir {
usage "mkdir(directoryname, mode)" if @_ != 2;
- mkdir($_[0], $_[1]);
+ CORE::mkdir($_[0], $_[1]);
}
sub stat {
usage "stat(filename)" if @_ != 1;
- stat($_[0]);
+ CORE::stat($_[0]);
}
sub umask {
usage "umask(mask)" if @_ != 1;
- umask($_[0]);
+ CORE::umask($_[0]);
}
sub wait {
usage "wait()" if @_ != 0;
- wait();
+ CORE::wait();
}
sub waitpid {
usage "waitpid(pid, options)" if @_ != 2;
- waitpid($_[0], $_[1]);
+ CORE::waitpid($_[0], $_[1]);
}
sub gmtime {
usage "gmtime(time)" if @_ != 1;
- gmtime($_[0]);
+ CORE::gmtime($_[0]);
}
sub localtime {
usage "localtime(time)" if @_ != 1;
- localtime($_[0]);
+ CORE::localtime($_[0]);
}
sub time {
usage "time()" if @_ != 0;
- time;
+ CORE::time;
}
sub alarm {
usage "alarm(seconds)" if @_ != 1;
- alarm($_[0]);
+ CORE::alarm($_[0]);
}
sub chdir {
usage "chdir(directory)" if @_ != 1;
- chdir($_[0]);
+ CORE::chdir($_[0]);
}
sub chown {
usage "chown(filename, uid, gid)" if @_ != 3;
- chown($_[0], $_[1], $_[2]);
+ CORE::chown($_[0], $_[1], $_[2]);
}
sub execl {
@@ -820,13 +821,20 @@ sub execvp {
sub fork {
usage "fork()" if @_ != 0;
- fork;
+ CORE::fork;
}
sub getcwd
{
usage "getcwd()" if @_ != 0;
- chop($cwd = `pwd`);
+ if ($^O eq 'MSWin32') {
+ # this perhaps applies to everyone else also?
+ require Cwd;
+ $cwd = &Cwd::cwd;
+ }
+ else {
+ chop($cwd = `pwd`);
+ }
$cwd;
}
@@ -853,12 +861,12 @@ sub getgroups {
sub getlogin {
usage "getlogin()" if @_ != 0;
- getlogin();
+ CORE::getlogin();
}
sub getpgrp {
usage "getpgrp()" if @_ != 0;
- getpgrp($_[0]);
+ CORE::getpgrp;
}
sub getpid {
@@ -868,7 +876,7 @@ sub getpid {
sub getppid {
usage "getppid()" if @_ != 0;
- getppid;
+ CORE::getppid;
}
sub getuid {
@@ -883,12 +891,16 @@ sub isatty {
sub link {
usage "link(oldfilename, newfilename)" if @_ != 2;
- link($_[0], $_[1]);
+ CORE::link($_[0], $_[1]);
}
sub rmdir {
usage "rmdir(directoryname)" if @_ != 1;
- rmdir($_[0]);
+ CORE::rmdir($_[0]);
+}
+
+sub setbuf {
+ redef "IO::Handle::setbuf()";
}
sub setgid {
@@ -901,18 +913,22 @@ sub setuid {
$< = $_[0];
}
+sub setvbuf {
+ redef "IO::Handle::setvbuf()";
+}
+
sub sleep {
usage "sleep(seconds)" if @_ != 1;
- sleep($_[0]);
+ CORE::sleep($_[0]);
}
sub unlink {
usage "unlink(filename)" if @_ != 1;
- unlink($_[0]);
+ CORE::unlink($_[0]);
}
sub utime {
usage "utime(filename, atime, mtime)" if @_ != 3;
- utime($_[1], $_[2], $_[0]);
+ CORE::utime($_[1], $_[2], $_[0]);
}
diff --git a/gnu/usr.bin/perl/ext/POSIX/POSIX.pod b/gnu/usr.bin/perl/ext/POSIX/POSIX.pod
index c781765a146..6a4a61aca62 100644
--- a/gnu/usr.bin/perl/ext/POSIX/POSIX.pod
+++ b/gnu/usr.bin/perl/ext/POSIX/POSIX.pod
@@ -1009,13 +1009,14 @@ Convert date and time information to string. Returns the string.
Synopsis:
- strftime(fmt, sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
+ strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
The month (C<mon>), weekday (C<wday>), and yearday (C<yday>) begin at zero.
I.e. January is 0, not 1; Sunday is 0, not 1; January 1st is 0, not 1. The
-year (C<year>) is given in years since 1900. I.e. The year 1995 is 95; the
+year (C<year>) is given in years since 1900. I.e., the year 1995 is 95; the
year 2001 is 101. Consult your system's C<strftime()> manpage for details
-about these and the other arguments.
+about these and the other arguments. The given arguments are made consistent
+by calling C<mktime()> before calling your system's C<strftime()> function.
The string for Tuesday, December 12, 1995.
@@ -1392,7 +1393,9 @@ Tests the SigSet object to see if it contains a specific signal.
=item new
Create a new Termios object. This object will be destroyed automatically
-when it is no longer needed.
+when it is no longer needed. A Termios object corresponds to the termios
+C struct. new() mallocs a new one, getattr() fills it from a file descriptor,
+and setattr() sets a file descriptor's parameters to match Termios' contents.
$termios = POSIX::Termios->new;
@@ -1474,13 +1477,13 @@ array so an index must be specified.
Set the c_cflag field of a termios object.
- $termios->setcflag( &POSIX::CLOCAL );
+ $termios->setcflag( $c_cflag | &POSIX::CLOCAL );
=item setiflag
Set the c_iflag field of a termios object.
- $termios->setiflag( &POSIX::BRKINT );
+ $termios->setiflag( $c_iflag | &POSIX::BRKINT );
=item setispeed
@@ -1494,13 +1497,13 @@ Returns C<undef> on failure.
Set the c_lflag field of a termios object.
- $termios->setlflag( &POSIX::ECHO );
+ $termios->setlflag( $c_lflag | &POSIX::ECHO );
=item setoflag
Set the c_oflag field of a termios object.
- $termios->setoflag( &POSIX::OPOST );
+ $termios->setoflag( $c_oflag | &POSIX::OPOST );
=item setospeed
diff --git a/gnu/usr.bin/perl/ext/POSIX/POSIX.xs b/gnu/usr.bin/perl/ext/POSIX/POSIX.xs
index a09eafe37af..15e026e212b 100644
--- a/gnu/usr.bin/perl/ext/POSIX/POSIX.xs
+++ b/gnu/usr.bin/perl/ext/POSIX/POSIX.xs
@@ -1,7 +1,16 @@
+#ifdef WIN32
+#define _POSIX_
+#endif
#include "EXTERN.h"
#define PERLIO_NOT_STDIO 1
#include "perl.h"
#include "XSUB.h"
+#ifdef PERL_OBJECT /* XXX _very_ temporary hacks */
+# undef signal
+# undef open
+# undef setmode
+# define open PerlLIO_open3
+#endif
#include <ctype.h>
#ifdef I_DIRENT /* XXX maybe better to just rely on perl.h? */
#include <dirent.h>
@@ -20,12 +29,12 @@
#endif
#include <setjmp.h>
#include <signal.h>
-#ifdef I_STDARG
#include <stdarg.h>
-#endif
+
#ifdef I_STDDEF
#include <stddef.h>
#endif
+
/* XXX This comment is just to make I_TERMIO and I_SGTTY visible to
metaconfig for future extension writers. We don't use them in POSIX.
(This is really sneaky :-) --AD
@@ -40,7 +49,9 @@
#include <sys/stat.h>
#include <sys/types.h>
#include <time.h>
-#include <unistd.h> /* see hints/sunos_4_1.sh */
+#ifdef I_UNISTD
+#include <unistd.h>
+#endif
#include <fcntl.h>
#if defined(__VMS) && !defined(__POSIX_SOURCE)
@@ -51,83 +62,13 @@
# define pid_t int /* old versions of DECC miss this in types.h */
# endif
-# undef mkfifo /* #defined in perl.h */
+# undef mkfifo
# define mkfifo(a,b) (not_here("mkfifo"),-1)
# define tzset() not_here("tzset")
#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)
# define HAS_TZNAME /* shows up in VMS 7.0 or Dec C 5.6 */
# include <utsname.h>
-#else
- /* The default VMS emulation of Unix signals isn't very POSIXish */
- typedef int sigset_t;
-# define sigpending(a) (not_here("sigpending"),0)
-
- /* sigset_t is atomic under VMS, so these routines are easy */
- int sigemptyset(sigset_t *set) {
- if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
- *set = 0; return 0;
- }
- int sigfillset(sigset_t *set) {
- int i;
- if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
- for (i = 0; i < NSIG; i++) *set |= (1 << i);
- return 0;
- }
- int sigaddset(sigset_t *set, int sig) {
- if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
- if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; }
- *set |= (1 << (sig - 1));
- return 0;
- }
- int sigdelset(sigset_t *set, int sig) {
- if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
- if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; }
- *set &= ~(1 << (sig - 1));
- return 0;
- }
- int sigismember(sigset_t *set, int sig) {
- if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
- if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; }
- *set & (1 << (sig - 1));
- }
- /* The tools for sigprocmask() are there, just not the routine itself */
-# ifndef SIG_UNBLOCK
-# define SIG_UNBLOCK 1
-# endif
-# ifndef SIG_BLOCK
-# define SIG_BLOCK 2
-# endif
-# ifndef SIG_SETMASK
-# define SIG_SETMASK 3
-# endif
- int sigprocmask(int how, sigset_t *set, sigset_t *oset) {
- if (!set || !oset) {
- set_errno(EFAULT); set_vaxc_errno(SS$_ACCVIO);
- return -1;
- }
- switch (how) {
- case SIG_SETMASK:
- *oset = sigsetmask(*set);
- break;
- case SIG_BLOCK:
- *oset = sigblock(*set);
- break;
- case SIG_UNBLOCK:
- *oset = sigblock(0);
- sigsetmask(*oset & ~*set);
- break;
- default:
- set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
- return -1;
- }
- return 0;
- }
-# define sigaction sigvec
-# define sa_flags sv_onstack
-# define sa_handler sv_handler
-# define sa_mask sv_mask
-# define sigsuspend(set) sigpause(*set)
# endif /* __VMS_VER >= 70000000 or Dec C 5.6 */
/* The POSIX notion of ttyname() is better served by getname() under VMS */
@@ -136,7 +77,7 @@
/* The non-POSIX CRTL times() has void return type, so we just get the
current time directly */
- clock_t vms_times(struct tms *bufptr) {
+ clock_t vms_times(struct tms *PL_bufptr) {
clock_t retval;
/* Get wall time and convert to 10 ms intervals to
* produce the return value that the POSIX standard expects */
@@ -156,11 +97,49 @@
_ckvmssts(lib$ediv(&divisor,vmstime,(long int *)&retval,&remainder));
# endif
/* Fill in the struct tms using the CRTL routine . . .*/
- times((tbuffer_t *)bufptr);
+ times((tbuffer_t *)PL_bufptr);
return (clock_t) retval;
}
# define times(t) vms_times(t)
#else
+#if defined (WIN32)
+# undef mkfifo
+# define mkfifo(a,b) not_here("mkfifo")
+# define ttyname(a) (char*)not_here("ttyname")
+# define sigset_t long
+# define pid_t long
+# ifdef __BORLANDC__
+# define tzname _tzname
+# endif
+# ifdef _MSC_VER
+# define mode_t short
+# endif
+# ifdef __MINGW32__
+# define mode_t short
+# ifndef tzset
+# define tzset() not_here("tzset")
+# endif
+# ifndef _POSIX_OPEN_MAX
+# define _POSIX_OPEN_MAX FOPEN_MAX /* XXX bogus ? */
+# endif
+# endif
+# define sigaction(a,b,c) not_here("sigaction")
+# define sigpending(a) not_here("sigpending")
+# define sigprocmask(a,b,c) not_here("sigprocmask")
+# define sigsuspend(a) not_here("sigsuspend")
+# define sigemptyset(a) not_here("sigemptyset")
+# define sigaddset(a,b) not_here("sigaddset")
+# define sigdelset(a,b) not_here("sigdelset")
+# define sigfillset(a) not_here("sigfillset")
+# define sigismember(a,b) not_here("sigismember")
+#else
+
+# ifndef HAS_MKFIFO
+# ifndef mkfifo
+# define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
+# endif
+# endif /* !HAS_MKFIFO */
+
# include <grp.h>
# include <sys/times.h>
# ifdef HAS_UNAME
@@ -170,7 +149,8 @@
# ifdef I_UTIME
# include <utime.h>
# endif
-#endif
+#endif /* WIN32 */
+#endif /* __VMS */
typedef int SysRet;
typedef long SysRetLong;
@@ -298,10 +278,14 @@ unsigned long strtoul _((const char *, char **, int));
#endif
#ifdef HAS_TZNAME
+# ifndef WIN32
extern char *tzname[];
+# endif
#else
+#if !defined(WIN32) || (defined(__MINGW32__) && !defined(tzname))
char *tzname[] = { "" , "" };
#endif
+#endif
/* XXX struct tm on some systems (SunOS4/BSD) contains extra (non POSIX)
* fields for which we don't have Configure support yet:
@@ -317,6 +301,12 @@ char *tzname[] = { "" , "" };
* support is added and NETaa14816 is considered in full.
* It does not address tzname aspects of NETaa14816.
*/
+#ifdef HAS_GNULIBC
+# ifndef STRUCT_TM_HASZONE
+# define STRUCT_TM_HAS_ZONE
+# endif
+#endif
+
#ifdef STRUCT_TM_HASZONE
static void
init_tm(ptm) /* see mktime, strftime and asctime */
@@ -332,7 +322,13 @@ init_tm(ptm) /* see mktime, strftime and asctime */
#endif
-#ifndef HAS_LONG_DOUBLE /* XXX What to do about long doubles? */
+#ifdef HAS_LONG_DOUBLE
+# if LONG_DOUBLESIZE > DOUBLESIZE
+# undef HAS_LONG_DOUBLE /* XXX until we figure out how to use them */
+# endif
+#endif
+
+#ifndef HAS_LONG_DOUBLE
#ifdef LDBL_MAX
#undef LDBL_MAX
#endif
@@ -345,17 +341,19 @@ init_tm(ptm) /* see mktime, strftime and asctime */
#endif
static int
-not_here(s)
-char *s;
+not_here(char *s)
{
croak("POSIX::%s not implemented on this architecture", s);
return -1;
}
-static double
-constant(name, arg)
-char *name;
-int arg;
+static
+#ifdef HAS_LONG_DOUBLE
+long double
+#else
+double
+#endif
+constant(char *name, int arg)
{
errno = 0;
switch (*name) {
@@ -822,6 +820,8 @@ int arg;
#else
goto not_there;
#endif
+ break;
+ case 'L':
if (strEQ(name, "ELOOP"))
#ifdef ELOOP
return ELOOP;
@@ -2315,55 +2315,55 @@ int arg;
case '_':
if (strnEQ(name, "_PC_", 4)) {
if (strEQ(name, "_PC_CHOWN_RESTRICTED"))
-#ifdef _PC_CHOWN_RESTRICTED
+#if defined(_PC_CHOWN_RESTRICTED) || HINT_SC_EXIST
return _PC_CHOWN_RESTRICTED;
#else
goto not_there;
#endif
if (strEQ(name, "_PC_LINK_MAX"))
-#ifdef _PC_LINK_MAX
+#if defined(_PC_LINK_MAX) || HINT_SC_EXIST
return _PC_LINK_MAX;
#else
goto not_there;
#endif
if (strEQ(name, "_PC_MAX_CANON"))
-#ifdef _PC_MAX_CANON
+#if defined(_PC_MAX_CANON) || HINT_SC_EXIST
return _PC_MAX_CANON;
#else
goto not_there;
#endif
if (strEQ(name, "_PC_MAX_INPUT"))
-#ifdef _PC_MAX_INPUT
+#if defined(_PC_MAX_INPUT) || HINT_SC_EXIST
return _PC_MAX_INPUT;
#else
goto not_there;
#endif
if (strEQ(name, "_PC_NAME_MAX"))
-#ifdef _PC_NAME_MAX
+#if defined(_PC_NAME_MAX) || HINT_SC_EXIST
return _PC_NAME_MAX;
#else
goto not_there;
#endif
if (strEQ(name, "_PC_NO_TRUNC"))
-#ifdef _PC_NO_TRUNC
+#if defined(_PC_NO_TRUNC) || HINT_SC_EXIST
return _PC_NO_TRUNC;
#else
goto not_there;
#endif
if (strEQ(name, "_PC_PATH_MAX"))
-#ifdef _PC_PATH_MAX
+#if defined(_PC_PATH_MAX) || HINT_SC_EXIST
return _PC_PATH_MAX;
#else
goto not_there;
#endif
if (strEQ(name, "_PC_PIPE_BUF"))
-#ifdef _PC_PIPE_BUF
+#if defined(_PC_PIPE_BUF) || HINT_SC_EXIST
return _PC_PIPE_BUF;
#else
goto not_there;
#endif
if (strEQ(name, "_PC_VDISABLE"))
-#ifdef _PC_VDISABLE
+#if defined(_PC_VDISABLE) || HINT_SC_EXIST
return _PC_VDISABLE;
#else
goto not_there;
@@ -2489,61 +2489,61 @@ int arg;
}
if (strnEQ(name, "_SC_", 4)) {
if (strEQ(name, "_SC_ARG_MAX"))
-#ifdef _SC_ARG_MAX
+#if defined(_SC_ARG_MAX) || HINT_SC_EXIST
return _SC_ARG_MAX;
#else
goto not_there;
#endif
if (strEQ(name, "_SC_CHILD_MAX"))
-#ifdef _SC_CHILD_MAX
+#if defined(_SC_CHILD_MAX) || HINT_SC_EXIST
return _SC_CHILD_MAX;
#else
goto not_there;
#endif
if (strEQ(name, "_SC_CLK_TCK"))
-#ifdef _SC_CLK_TCK
+#if defined(_SC_CLK_TCK) || HINT_SC_EXIST
return _SC_CLK_TCK;
#else
goto not_there;
#endif
if (strEQ(name, "_SC_JOB_CONTROL"))
-#ifdef _SC_JOB_CONTROL
+#if defined(_SC_JOB_CONTROL) || HINT_SC_EXIST
return _SC_JOB_CONTROL;
#else
goto not_there;
#endif
if (strEQ(name, "_SC_NGROUPS_MAX"))
-#ifdef _SC_NGROUPS_MAX
+#if defined(_SC_NGROUPS_MAX) || HINT_SC_EXIST
return _SC_NGROUPS_MAX;
#else
goto not_there;
#endif
if (strEQ(name, "_SC_OPEN_MAX"))
-#ifdef _SC_OPEN_MAX
+#if defined(_SC_OPEN_MAX) || HINT_SC_EXIST
return _SC_OPEN_MAX;
#else
goto not_there;
#endif
if (strEQ(name, "_SC_SAVED_IDS"))
-#ifdef _SC_SAVED_IDS
+#if defined(_SC_SAVED_IDS) || HINT_SC_EXIST
return _SC_SAVED_IDS;
#else
goto not_there;
#endif
if (strEQ(name, "_SC_STREAM_MAX"))
-#ifdef _SC_STREAM_MAX
+#if defined(_SC_STREAM_MAX) || HINT_SC_EXIST
return _SC_STREAM_MAX;
#else
goto not_there;
#endif
if (strEQ(name, "_SC_TZNAME_MAX"))
-#ifdef _SC_TZNAME_MAX
+#if defined(_SC_TZNAME_MAX) || HINT_SC_EXIST
return _SC_TZNAME_MAX;
#else
goto not_there;
#endif
if (strEQ(name, "_SC_VERSION"))
-#ifdef _SC_VERSION
+#if defined(_SC_VERSION) || HINT_SC_EXIST
return _SC_VERSION;
#else
goto not_there;
@@ -2567,7 +2567,7 @@ new(packname = "POSIX::SigSet", ...)
CODE:
{
int i;
- RETVAL = (sigset_t*)safemalloc(sizeof(sigset_t));
+ New(0, RETVAL, 1, sigset_t);
sigemptyset(RETVAL);
for (i = 1; i < items; i++)
sigaddset(RETVAL, SvIV(ST(i)));
@@ -2579,7 +2579,7 @@ void
DESTROY(sigset)
POSIX::SigSet sigset
CODE:
- safefree((char *)sigset);
+ Safefree(sigset);
SysRet
sigaddset(sigset, sig)
@@ -2613,9 +2613,10 @@ new(packname = "POSIX::Termios", ...)
CODE:
{
#ifdef I_TERMIOS
- RETVAL = (struct termios*)safemalloc(sizeof(struct termios));
+ New(0, RETVAL, 1, struct termios);
#else
not_here("termios");
+ RETVAL = 0;
#endif
}
OUTPUT:
@@ -2626,7 +2627,7 @@ DESTROY(termios_ref)
POSIX::Termios termios_ref
CODE:
#ifdef I_TERMIOS
- safefree((char *)termios_ref);
+ Safefree(termios_ref);
#else
not_here("termios");
#endif
@@ -2665,7 +2666,8 @@ getiflag(termios_ref)
#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
RETVAL = termios_ref->c_iflag;
#else
- not_here("getiflag");
+ not_here("getiflag");
+ RETVAL = 0;
#endif
OUTPUT:
RETVAL
@@ -2677,7 +2679,8 @@ getoflag(termios_ref)
#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
RETVAL = termios_ref->c_oflag;
#else
- not_here("getoflag");
+ not_here("getoflag");
+ RETVAL = 0;
#endif
OUTPUT:
RETVAL
@@ -2689,7 +2692,8 @@ getcflag(termios_ref)
#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
RETVAL = termios_ref->c_cflag;
#else
- not_here("getcflag");
+ not_here("getcflag");
+ RETVAL = 0;
#endif
OUTPUT:
RETVAL
@@ -2701,7 +2705,8 @@ getlflag(termios_ref)
#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
RETVAL = termios_ref->c_lflag;
#else
- not_here("getlflag");
+ not_here("getlflag");
+ RETVAL = 0;
#endif
OUTPUT:
RETVAL
@@ -2716,7 +2721,8 @@ getcc(termios_ref, ccix)
croak("Bad getcc subscript");
RETVAL = termios_ref->c_cc[ccix];
#else
- not_here("getcc");
+ not_here("getcc");
+ RETVAL = 0;
#endif
OUTPUT:
RETVAL
@@ -2802,7 +2808,7 @@ isalnum(charstring)
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!isalnum(*s))
RETVAL = 0;
@@ -2814,7 +2820,7 @@ isalpha(charstring)
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!isalpha(*s))
RETVAL = 0;
@@ -2826,7 +2832,7 @@ iscntrl(charstring)
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!iscntrl(*s))
RETVAL = 0;
@@ -2838,7 +2844,7 @@ isdigit(charstring)
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!isdigit(*s))
RETVAL = 0;
@@ -2850,7 +2856,7 @@ isgraph(charstring)
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!isgraph(*s))
RETVAL = 0;
@@ -2862,7 +2868,7 @@ islower(charstring)
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!islower(*s))
RETVAL = 0;
@@ -2874,7 +2880,7 @@ isprint(charstring)
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!isprint(*s))
RETVAL = 0;
@@ -2886,7 +2892,7 @@ ispunct(charstring)
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!ispunct(*s))
RETVAL = 0;
@@ -2898,7 +2904,7 @@ isspace(charstring)
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!isspace(*s))
RETVAL = 0;
@@ -2910,7 +2916,7 @@ isupper(charstring)
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!isupper(*s))
RETVAL = 0;
@@ -2922,7 +2928,7 @@ isxdigit(charstring)
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!isxdigit(*s))
RETVAL = 0;
@@ -2948,7 +2954,6 @@ localeconv()
#ifdef HAS_LOCALECONV
struct lconv *lcbuf;
RETVAL = newHV();
- SET_NUMERIC_LOCAL();
if (lcbuf = localeconv()) {
/* the strings */
if (lcbuf->decimal_point && *lcbuf->decimal_point)
@@ -2957,9 +2962,11 @@ localeconv()
if (lcbuf->thousands_sep && *lcbuf->thousands_sep)
hv_store(RETVAL, "thousands_sep", 13,
newSVpv(lcbuf->thousands_sep, 0), 0);
+#ifndef NO_LOCALECONV_GROUPING
if (lcbuf->grouping && *lcbuf->grouping)
hv_store(RETVAL, "grouping", 8,
newSVpv(lcbuf->grouping, 0), 0);
+#endif
if (lcbuf->int_curr_symbol && *lcbuf->int_curr_symbol)
hv_store(RETVAL, "int_curr_symbol", 15,
newSVpv(lcbuf->int_curr_symbol, 0), 0);
@@ -2969,12 +2976,16 @@ localeconv()
if (lcbuf->mon_decimal_point && *lcbuf->mon_decimal_point)
hv_store(RETVAL, "mon_decimal_point", 17,
newSVpv(lcbuf->mon_decimal_point, 0), 0);
+#ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep)
hv_store(RETVAL, "mon_thousands_sep", 17,
newSVpv(lcbuf->mon_thousands_sep, 0), 0);
+#endif
+#ifndef NO_LOCALECONV_MON_GROUPING
if (lcbuf->mon_grouping && *lcbuf->mon_grouping)
hv_store(RETVAL, "mon_grouping", 12,
newSVpv(lcbuf->mon_grouping, 0), 0);
+#endif
if (lcbuf->positive_sign && *lcbuf->positive_sign)
hv_store(RETVAL, "positive_sign", 13,
newSVpv(lcbuf->positive_sign, 0), 0);
@@ -3150,11 +3161,13 @@ sigaction(sig, action, oldaction = 0)
POSIX::SigAction action
POSIX::SigAction oldaction
CODE:
-
+#ifdef WIN32
+ RETVAL = not_here("sigaction");
+#else
# This code is really grody because we're trying to make the signal
# interface look beautiful, which is hard.
- if (!siggv)
+ if (!PL_siggv)
gv_fetchpv("SIG", TRUE, SVt_PVHV);
{
@@ -3162,14 +3175,15 @@ sigaction(sig, action, oldaction = 0)
struct sigaction oact;
POSIX__SigSet sigset;
SV** svp;
- SV** sigsvp = hv_fetch(GvHVn(siggv),
+ SV** sigsvp = hv_fetch(GvHVn(PL_siggv),
sig_name[sig],
strlen(sig_name[sig]),
TRUE);
+ STRLEN n_a;
/* Remember old handler name if desired. */
if (oldaction) {
- char *hand = SvPVx(*sigsvp, na);
+ char *hand = SvPVx(*sigsvp, n_a);
svp = hv_fetch(oldaction, "HANDLER", 7, TRUE);
sv_setpv(*svp, *hand ? hand : "DEFAULT");
}
@@ -3180,7 +3194,7 @@ sigaction(sig, action, oldaction = 0)
svp = hv_fetch(action, "HANDLER", 7, FALSE);
if (!svp)
croak("Can't supply an action without a HANDLER");
- sv_setpv(*sigsvp, SvPV(*svp, na));
+ sv_setpv(*sigsvp, SvPV(*svp, n_a));
mg_set(*sigsvp); /* handles DEFAULT and IGNORE */
act.sa_handler = sighandler;
@@ -3219,7 +3233,7 @@ sigaction(sig, action, oldaction = 0)
sigset = (sigset_t*) tmp;
}
else {
- sigset = (sigset_t*)safemalloc(sizeof(sigset_t));
+ New(0, sigset, 1, sigset_t);
sv_setptrobj(*svp, sigset, "POSIX::SigSet");
}
*sigset = oact.sa_mask;
@@ -3229,6 +3243,7 @@ sigaction(sig, action, oldaction = 0)
sv_setiv(*svp, oact.sa_flags);
}
}
+#endif
OUTPUT:
RETVAL
@@ -3240,7 +3255,20 @@ SysRet
sigprocmask(how, sigset, oldsigset = 0)
int how
POSIX::SigSet sigset
- POSIX::SigSet oldsigset
+ POSIX::SigSet oldsigset = NO_INIT
+INIT:
+ if ( items < 3 ) {
+ oldsigset = 0;
+ }
+ else if (sv_derived_from(ST(2), "POSIX::SigSet")) {
+ IV tmp = SvIV((SV*)SvRV(ST(2)));
+ oldsigset = (POSIX__SigSet) tmp;
+ }
+ else {
+ New(0, oldsigset, 1, sigset_t);
+ sigemptyset(oldsigset);
+ sv_setref_pv(ST(2), "POSIX::SigSet", (void*)oldsigset);
+ }
SysRet
sigsuspend(signal_mask)
@@ -3278,7 +3306,7 @@ pipe()
PPCODE:
int fds[2];
if (pipe(fds) != -1) {
- EXTEND(sp,2);
+ EXTEND(SP,2);
PUSHs(sv_2mortal(newSViv(fds[0])));
PUSHs(sv_2mortal(newSViv(fds[1])));
}
@@ -3322,7 +3350,7 @@ uname()
#ifdef HAS_UNAME
struct utsname buf;
if (uname(&buf) >= 0) {
- EXTEND(sp, 5);
+ EXTEND(SP, 5);
PUSHs(sv_2mortal(newSVpv(buf.sysname, 0)));
PUSHs(sv_2mortal(newSVpv(buf.nodename, 0)));
PUSHs(sv_2mortal(newSVpv(buf.release, 0)));
@@ -3390,11 +3418,11 @@ strtod(str)
num = strtod(str, &unparsed);
PUSHs(sv_2mortal(newSVnv(num)));
if (GIMME == G_ARRAY) {
- EXTEND(sp, 1);
+ EXTEND(SP, 1);
if (unparsed)
PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
else
- PUSHs(&sv_undef);
+ PUSHs(&PL_sv_undef);
}
void
@@ -3411,11 +3439,11 @@ strtol(str, base = 0)
else
PUSHs(sv_2mortal(newSVnv((double)num)));
if (GIMME == G_ARRAY) {
- EXTEND(sp, 1);
+ EXTEND(SP, 1);
if (unparsed)
PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
else
- PUSHs(&sv_undef);
+ PUSHs(&PL_sv_undef);
}
void
@@ -3432,11 +3460,11 @@ strtoul(str, base = 0)
else
PUSHs(sv_2mortal(newSVnv((double)num)));
if (GIMME == G_ARRAY) {
- EXTEND(sp, 1);
+ EXTEND(SP, 1);
if (unparsed)
PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
else
- PUSHs(&sv_undef);
+ PUSHs(&PL_sv_undef);
}
SV *
@@ -3533,7 +3561,7 @@ times()
struct tms tms;
clock_t realtime;
realtime = times( &tms );
- EXTEND(sp,5);
+ EXTEND(SP,5);
PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
@@ -3575,7 +3603,7 @@ mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
RETVAL
char *
-strftime(fmt, sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
+strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
char * fmt
int sec
int min
@@ -3601,8 +3629,45 @@ strftime(fmt, sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
mytm.tm_wday = wday;
mytm.tm_yday = yday;
mytm.tm_isdst = isdst;
+ (void) mktime(&mytm);
len = strftime(tmpbuf, sizeof tmpbuf, fmt, &mytm);
- ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
+ /*
+ ** The following is needed to handle to the situation where
+ ** tmpbuf overflows. Basically we want to allocate a buffer
+ ** and try repeatedly. The reason why it is so complicated
+ ** is that getting a return value of 0 from strftime can indicate
+ ** one of the following:
+ ** 1. buffer overflowed,
+ ** 2. illegal conversion specifier, or
+ ** 3. the format string specifies nothing to be returned(not
+ ** an error). This could be because format is an empty string
+ ** or it specifies %p that yields an empty string in some locale.
+ ** If there is a better way to make it portable, go ahead by
+ ** all means.
+ */
+ if ( ( len > 0 && len < sizeof(tmpbuf) )
+ || ( len == 0 && strlen(fmt) == 0 ) ) {
+ ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
+ } else {
+ /* Possibly buf overflowed - try again with a bigger buf */
+ int bufsize = strlen(fmt) + sizeof(tmpbuf);
+ char* buf;
+ int buflen;
+
+ New(0, buf, bufsize, char);
+ while( buf ) {
+ buflen = strftime(buf, bufsize, fmt, &mytm);
+ if ( buflen > 0 && buflen < bufsize ) break;
+ bufsize *= 2;
+ Renew(buf, bufsize, char);
+ }
+ if ( buf ) {
+ ST(0) = sv_2mortal(newSVpv(buf, buflen));
+ Safefree(buf);
+ } else {
+ ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
+ }
+ }
}
void
@@ -3611,7 +3676,7 @@ tzset()
void
tzname()
PPCODE:
- EXTEND(sp,2);
+ EXTEND(SP,2);
PUSHs(sv_2mortal(newSVpv(tzname[0],strlen(tzname[0]))));
PUSHs(sv_2mortal(newSVpv(tzname[1],strlen(tzname[1]))));
diff --git a/gnu/usr.bin/perl/ext/SDBM_File/Makefile.PL b/gnu/usr.bin/perl/ext/SDBM_File/Makefile.PL
index 02dfd7d84ff..749478551fe 100644
--- a/gnu/usr.bin/perl/ext/SDBM_File/Makefile.PL
+++ b/gnu/usr.bin/perl/ext/SDBM_File/Makefile.PL
@@ -6,21 +6,30 @@ use ExtUtils::MakeMaker;
# which perform the corresponding actions in the subdirectory.
$define = ($^O eq 'MSWin32') ? '-DMSDOS' : '';
+if ($^O eq 'MSWin32') { $myextlib = 'sdbm\\libsdbm$(LIB_EXT)'; }
+else { $myextlib = 'sdbm/libsdbm$(LIB_EXT)'; }
WriteMakefile(
- NAME => 'SDBM_File',
- MYEXTLIB => 'sdbm'.($^O eq 'MSWin32' ? '\\' : '/').'libsdbm$(LIB_EXT)',
- MAN3PODS => ' ', # Pods will be built by installman.
- XSPROTOARG => '-noprototypes', # XXX remove later?
- VERSION_FROM => 'SDBM_File.pm',
- DEFINE => $define,
-);
-
+ NAME => 'SDBM_File',
+ MYEXTLIB => $myextlib,
+ MAN3PODS => {}, # Pods will be built by installman.
+ XSPROTOARG => '-noprototypes', # XXX remove later?
+ VERSION_FROM => 'SDBM_File.pm',
+ DEFINE => $define,
+ );
sub MY::postamble {
+ if ($^O ne 'VMS') {
'
$(MYEXTLIB): sdbm/Makefile
cd sdbm && $(MAKE) all
';
+ } else {
+ '
+$(MYEXTLIB) : [.sdbm]descrip.mms
+ set def [.sdbm]
+ $(MMS) all
+ set def [-]
+';
+ }
}
-
diff --git a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/Makefile.PL b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/Makefile.PL
index 50fd83eb253..e6fdcf93069 100644
--- a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/Makefile.PL
+++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/Makefile.PL
@@ -1,33 +1,65 @@
use ExtUtils::MakeMaker;
$define = '-DSDBM -DDUFF';
-$define .= ' -DWIN32' if ($^O eq 'MSWin32');
+$define .= ' -DWIN32 -DPERL_STATIC_SYMS' if ($^O eq 'MSWin32');
+
+if ($^O eq 'VMS') { # Old VAXC compiler can't handle Duff's device
+ require Config;
+ $define =~ s/\s+-DDUFF// if $Config::Config{'vms_cc_type'} eq 'vaxc';
+}
WriteMakefile(
NAME => 'sdbm', # (doesn't matter what the name is here) oh yes it does
- LINKTYPE => 'static',
+# LINKTYPE => 'static',
DEFINE => $define,
INC => '-I$(PERL_INC)', # force PERL_INC dir ahead of system -I's
- SKIP => [qw(dynamic dynamic_lib)],
+ INST_ARCHLIB => '.',
+ SKIP => [qw(dynamic dynamic_lib dlsyms)],
OBJECT => '$(O_FILES)',
clean => {'FILES' => 'dbu libsdbm.a dbd dba dbe x-dbu *.dir *.pag'},
H => [qw(tune.h sdbm.h pair.h $(PERL_INC)/config.h)],
C => [qw(sdbm.c pair.c hash.c)]
);
+sub MY::constants {
+ package MY;
+ my $r = shift->SUPER::constants();
+ if ($^O eq 'VMS') {
+ $r =~ s/^INST_STATIC =.*$/INST_STATIC = libsdbm\$(LIB_EXT)/m
+ }
+ return $r;
+}
+
sub MY::post_constants {
+ package MY;
+ if ($^O eq 'VMS') {
+ shift->SUPER::post_constants();
+ } else {
'
INST_STATIC = libsdbm$(LIB_EXT)
'
+ }
}
sub MY::top_targets {
- '
+ my $r = '
all :: static
+ $(NOECHO) $(NOOP)
config ::
+ $(NOECHO) $(NOOP)
lint:
lint -abchx $(LIBSRCS)
+
';
+ $r .= '
+# This is a workaround, the problem is that our old GNU make exports
+# variables into the environment so $(MYEXTLIB) is set in here to this
+# value which can not be built.
+sdbm/libsdbm.a:
+ $(NOECHO) $(NOOP)
+' unless $^O eq 'VMS';
+
+ return $r;
}
diff --git a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/pair.c b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/pair.c
index 23bbfe9a67c..a9a805a4aa3 100644
--- a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/pair.c
+++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/pair.c
@@ -7,11 +7,8 @@
* page-level routines
*/
-#ifndef lint
-static char rcsid[] = "$Id: pair.c,v 1.10 90/12/13 13:00:35 oz Exp $";
-#endif
-
#include "config.h"
+#include "EXTERN.h"
#include "sdbm.h"
#include "tune.h"
#include "pair.h"
@@ -44,9 +41,7 @@ static int seepair proto((char *, int, char *, int));
*/
int
-fitpair(pag, need)
-char *pag;
-int need;
+fitpair(char *pag, int need)
{
register int n;
register int off;
@@ -63,10 +58,7 @@ int need;
}
void
-putpair(pag, key, val)
-char *pag;
-datum key;
-datum val;
+putpair(char *pag, datum key, datum val)
{
register int n;
register int off;
@@ -92,9 +84,7 @@ datum val;
}
datum
-getpair(pag, key)
-char *pag;
-datum key;
+getpair(char *pag, datum key)
{
register int i;
register int n;
@@ -114,9 +104,7 @@ datum key;
#ifdef SEEDUPS
int
-duppair(pag, key)
-char *pag;
-datum key;
+duppair(char *pag, datum key)
{
register short *ino = (short *) pag;
return ino[0] > 0 && seepair(pag, ino[0], key.dptr, key.dsize) > 0;
@@ -124,9 +112,7 @@ datum key;
#endif
datum
-getnkey(pag, num)
-char *pag;
-int num;
+getnkey(char *pag, int num)
{
datum key;
register int off;
@@ -145,9 +131,7 @@ int num;
}
int
-delpair(pag, key)
-char *pag;
-datum key;
+delpair(char *pag, datum key)
{
register int n;
register int i;
@@ -219,11 +203,7 @@ datum key;
* return 0 if not found.
*/
static int
-seepair(pag, n, key, siz)
-char *pag;
-register int n;
-register char *key;
-register int siz;
+seepair(char *pag, register int n, register char *key, register int siz)
{
register int i;
register int off = PBLKSIZ;
@@ -239,10 +219,7 @@ register int siz;
}
void
-splpage(pag, new, sbit)
-char *pag;
-char *new;
-long sbit;
+splpage(char *pag, char *New, long int sbit)
{
datum key;
datum val;
@@ -254,7 +231,7 @@ long sbit;
(void) memcpy(cur, pag, PBLKSIZ);
(void) memset(pag, 0, PBLKSIZ);
- (void) memset(new, 0, PBLKSIZ);
+ (void) memset(New, 0, PBLKSIZ);
n = ino[0];
for (ino++; n > 0; ino += 2) {
@@ -265,14 +242,14 @@ long sbit;
/*
* select the page pointer (by looking at sbit) and insert
*/
- (void) putpair((exhash(key) & sbit) ? new : pag, key, val);
+ (void) putpair((exhash(key) & sbit) ? New : pag, key, val);
off = ino[1];
n -= 2;
}
debug(("%d split %d/%d\n", ((short *) cur)[0] / 2,
- ((short *) new)[0] / 2,
+ ((short *) New)[0] / 2,
((short *) pag)[0] / 2));
}
@@ -283,8 +260,7 @@ long sbit;
* this could be made more rigorous.
*/
int
-chkpage(pag)
-char *pag;
+chkpage(char *pag)
{
register int n;
register int off;
diff --git a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.c b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.c
index c2d9cbd47de..c147e45b43a 100644
--- a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.c
+++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.c
@@ -7,10 +7,7 @@
* core routines
*/
-#ifndef lint
-static char rcsid[] = "$Id: sdbm.c,v 1.16 90/12/13 13:01:31 oz Exp $";
-#endif
-
+#include "INTERN.h"
#include "config.h"
#include "sdbm.h"
#include "tune.h"
@@ -39,7 +36,7 @@ extern int errno;
extern Malloc_t malloc proto((MEM_SIZE));
extern Free_t free proto((Malloc_t));
-extern Off_t lseek();
+extern Off_t lseek(int, Off_t, int);
#endif
/*
@@ -72,13 +69,8 @@ static long masks[] = {
001777777777, 003777777777, 007777777777, 017777777777
};
-datum nullitem = {NULL, 0};
-
DBM *
-sdbm_open(file, flags, mode)
-register char *file;
-register int flags;
-register int mode;
+sdbm_open(register char *file, register int flags, register int mode)
{
register DBM *db;
register char *dirname;
@@ -92,7 +84,7 @@ register int mode;
*/
n = strlen(file) * 2 + strlen(DIRFEXT) + strlen(PAGFEXT) + 2;
- if ((dirname = malloc((unsigned) n)) == NULL)
+ if ((dirname = (char *) malloc((unsigned) n)) == NULL)
return errno = ENOMEM, (DBM *) NULL;
/*
* build the file names
@@ -107,11 +99,7 @@ register int mode;
}
DBM *
-sdbm_prep(dirname, pagname, flags, mode)
-char *dirname;
-char *pagname;
-int flags;
-int mode;
+sdbm_prep(char *dirname, char *pagname, int flags, int mode)
{
register DBM *db;
struct stat dstat;
@@ -170,8 +158,7 @@ int mode;
}
void
-sdbm_close(db)
-register DBM *db;
+sdbm_close(register DBM *db)
{
if (db == NULL)
errno = EINVAL;
@@ -183,9 +170,7 @@ register DBM *db;
}
datum
-sdbm_fetch(db, key)
-register DBM *db;
-datum key;
+sdbm_fetch(register DBM *db, datum key)
{
if (db == NULL || bad(key))
return errno = EINVAL, nullitem;
@@ -197,9 +182,7 @@ datum key;
}
int
-sdbm_delete(db, key)
-register DBM *db;
-datum key;
+sdbm_delete(register DBM *db, datum key)
{
if (db == NULL || bad(key))
return errno = EINVAL, -1;
@@ -223,11 +206,7 @@ datum key;
}
int
-sdbm_store(db, key, val, flags)
-register DBM *db;
-datum key;
-datum val;
-int flags;
+sdbm_store(register DBM *db, datum key, datum val, int flags)
{
int need;
register long hash;
@@ -285,22 +264,19 @@ int flags;
* giving up.
*/
static int
-makroom(db, hash, need)
-register DBM *db;
-long hash;
-int need;
+makroom(register DBM *db, long int hash, int need)
{
long newp;
char twin[PBLKSIZ];
char *pag = db->pagbuf;
- char *new = twin;
+ char *New = twin;
register int smax = SPLTMAX;
do {
/*
* split the current page
*/
- (void) splpage(pag, new, db->hmask + 1);
+ (void) splpage(pag, New, db->hmask + 1);
/*
* address of the new page
*/
@@ -319,10 +295,10 @@ int need;
|| write(db->pagf, db->pagbuf, PBLKSIZ) < 0)
return 0;
db->pagbno = newp;
- (void) memcpy(pag, new, PBLKSIZ);
+ (void) memcpy(pag, New, PBLKSIZ);
}
else if (lseek(db->pagf, OFF_PAG(newp), SEEK_SET) < 0
- || write(db->pagf, new, PBLKSIZ) < 0)
+ || write(db->pagf, New, PBLKSIZ) < 0)
return 0;
if (!setdbit(db, db->curbit))
@@ -363,8 +339,7 @@ int need;
* deletions aren't taken into account. (ndbm bug)
*/
datum
-sdbm_firstkey(db)
-register DBM *db;
+sdbm_firstkey(register DBM *db)
{
if (db == NULL)
return errno = EINVAL, nullitem;
@@ -382,8 +357,7 @@ register DBM *db;
}
datum
-sdbm_nextkey(db)
-register DBM *db;
+sdbm_nextkey(register DBM *db)
{
if (db == NULL)
return errno = EINVAL, nullitem;
@@ -394,9 +368,7 @@ register DBM *db;
* all important binary trie traversal
*/
static int
-getpage(db, hash)
-register DBM *db;
-register long hash;
+getpage(register DBM *db, register long int hash)
{
register int hbit;
register long dbit;
@@ -435,9 +407,7 @@ register long hash;
}
static int
-getdbit(db, dbit)
-register DBM *db;
-register long dbit;
+getdbit(register DBM *db, register long int dbit)
{
register long c;
register long dirb;
@@ -458,9 +428,7 @@ register long dbit;
}
static int
-setdbit(db, dbit)
-register DBM *db;
-register long dbit;
+setdbit(register DBM *db, register long int dbit)
{
register long c;
register long dirb;
@@ -469,6 +437,7 @@ register long dbit;
dirb = c / DBLKSIZ;
if (dirb != db->dirbno) {
+ (void) memset(db->dirbuf, 0, DBLKSIZ);
if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0
|| read(db->dirf, db->dirbuf, DBLKSIZ) < 0)
return 0;
@@ -494,8 +463,7 @@ register long dbit;
* the page, try the next page in sequence
*/
static datum
-getnext(db)
-register DBM *db;
+getnext(register DBM *db)
{
datum key;
diff --git a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.h b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.h
index fdd9165145c..84d5f75468c 100644
--- a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.h
+++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.h
@@ -9,7 +9,11 @@
#define PAIRMAX 1008 /* arbitrary on PBLKSIZ-N */
#define SPLTMAX 10 /* maximum allowed splits */
/* for a single insertion */
+#ifdef VMS
+#define DIRFEXT ".sdbm_dir"
+#else
#define DIRFEXT ".dir"
+#endif
#define PAGFEXT ".pag"
typedef struct {
@@ -47,9 +51,13 @@ typedef struct {
int dsize;
} datum;
-extern datum nullitem;
+EXTCONST datum nullitem
+#ifdef DOINIT
+ = {0, 0}
+#endif
+ ;
-#ifdef __STDC__
+#if defined(__STDC__) || defined(__cplusplus) || defined(CAN_PROTOTYPE)
#define proto(p) p
#else
#define proto(p) ()
@@ -116,15 +124,22 @@ extern long sdbm_hash proto((char *, int));
#include <ctype.h>
#include <setjmp.h>
-#ifdef I_UNISTD
+#if defined(I_UNISTD)
#include <unistd.h>
#endif
-#if !defined(MSDOS) && !defined(WIN32)
-# ifdef PARAM_NEEDS_TYPES
-# include <sys/types.h>
+#ifdef VMS
+# include <file.h>
+# include <unixio.h>
+#endif
+
+#ifdef I_SYS_PARAM
+# if !defined(MSDOS) && !defined(WIN32) && !defined(VMS)
+# ifdef PARAM_NEEDS_TYPES
+# include <sys/types.h>
+# endif
+# include <sys/param.h>
# endif
-# include <sys/param.h>
#endif
#ifndef _TYPES_ /* If types.h defines this it's easy. */
@@ -183,6 +198,10 @@ extern long sdbm_hash proto((char *, int));
#ifdef I_MEMORY
#include <memory.h>
+#endif
+
+#ifdef __cplusplus
+#define HAS_MEMCPY
#endif
#ifdef HAS_MEMCPY
@@ -233,13 +252,15 @@ extern long sdbm_hash proto((char *, int));
# endif
#else
# ifndef memcmp
-# /* maybe we should have included the full embedding header... */
+ /* maybe we should have included the full embedding header... */
# ifdef NO_EMBED
# define memcmp my_memcmp
# else
# define memcmp Perl_my_memcmp
# endif
+#ifndef __cplusplus
extern int memcmp proto((char*, char*, int));
+#endif
# endif
#endif /* HAS_MEMCMP */
@@ -258,7 +279,12 @@ extern long sdbm_hash proto((char *, int));
#endif
#ifdef I_NETINET_IN
-# include <netinet/in.h>
+# ifdef VMS
+# include <in.h>
+# else
+# include <netinet/in.h>
+# endif
#endif
#endif /* Include guard */
+
diff --git a/gnu/usr.bin/perl/ext/SDBM_File/typemap b/gnu/usr.bin/perl/ext/SDBM_File/typemap
index a9b73d8b811..317a8f3886c 100644
--- a/gnu/usr.bin/perl/ext/SDBM_File/typemap
+++ b/gnu/usr.bin/perl/ext/SDBM_File/typemap
@@ -14,8 +14,8 @@ FATALFUNC T_OPAQUEPTR
INPUT
T_DATUM
- $var.dptr = SvPV($arg, na);
- $var.dsize = (int)na;
+ $var.dptr = SvPV($arg, PL_na);
+ $var.dsize = (int)PL_na;
T_GDATUM
UNIMPLEMENTED
OUTPUT
diff --git a/gnu/usr.bin/perl/ext/Socket/Socket.pm b/gnu/usr.bin/perl/ext/Socket/Socket.pm
index 51dce5939e0..1ed19f713d2 100644
--- a/gnu/usr.bin/perl/ext/Socket/Socket.pm
+++ b/gnu/usr.bin/perl/ext/Socket/Socket.pm
@@ -1,7 +1,7 @@
package Socket;
-use vars qw($VERSION @ISA @EXPORT);
-$VERSION = "1.6";
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+$VERSION = "1.7";
=head1 NAME
@@ -20,7 +20,7 @@ Socket, sockaddr_in, sockaddr_un, inet_aton, inet_ntoa - load the C socket.h def
$proto = getprotobyname('tcp');
socket(Socket_Handle, PF_INET, SOCK_STREAM, $proto);
- $port = getservbyname('smtp');
+ $port = getservbyname('smtp', 'tcp');
$sin = sockaddr_in($port,inet_aton("127.1"));
$sin = sockaddr_in(7,inet_aton("localhost"));
$sin = sockaddr_in(7,INADDR_LOOPBACK);
@@ -45,6 +45,15 @@ and your native C compiler. This means that it has a
far more likely chance of getting the numbers right. This includes
all of the commonly used pound-defines like AF_INET, SOCK_STREAM, etc.
+Also, some common socket "newline" constants are provided: the
+constants C<CR>, C<LF>, and C<CRLF>, as well as C<$CR>, C<$LF>, and
+C<$CRLF>, which map to C<\015>, C<\012>, and C<\015\012>. If you do
+not want to use the literal characters in your programs, then use
+the constants provided here. They are not exported by default, but can
+be imported individually, and with the C<:crlf> export tag:
+
+ use Socket qw(:DEFAULT :crlf);
+
In addition, some structure manipulation functions are available:
=over
@@ -184,10 +193,25 @@ require DynaLoader;
AF_UNIX
AF_UNSPEC
AF_X25
+ MSG_CTLFLAGS
+ MSG_CTLIGNORE
+ MSG_CTRUNC
MSG_DONTROUTE
+ MSG_DONTWAIT
+ MSG_EOF
+ MSG_EOR
+ MSG_ERRQUEUE
+ MSG_FIN
MSG_MAXIOVLEN
+ MSG_NOSIGNAL
MSG_OOB
MSG_PEEK
+ MSG_PROXY
+ MSG_RST
+ MSG_SYN
+ MSG_TRUNC
+ MSG_URG
+ MSG_WAITALL
PF_802
PF_APPLETALK
PF_CCITT
@@ -212,6 +236,11 @@ require DynaLoader;
PF_UNIX
PF_UNSPEC
PF_X25
+ SCM_CONNECT
+ SCM_CREDENTIALS
+ SCM_CREDS
+ SCM_RIGHTS
+ SCM_TIMESTAMP
SOCK_DGRAM
SOCK_RAW
SOCK_RDM
@@ -239,6 +268,23 @@ require DynaLoader;
SO_USELOOPBACK
);
+@EXPORT_OK = qw(CR LF CRLF $CR $LF $CRLF);
+
+%EXPORT_TAGS = (
+ crlf => [qw(CR LF CRLF $CR $LF $CRLF)],
+ all => [@EXPORT, @EXPORT_OK],
+);
+
+BEGIN {
+ sub CR () {"\015"}
+ sub LF () {"\012"}
+ sub CRLF () {"\015\012"}
+}
+
+*CR = \CR();
+*LF = \LF();
+*CRLF = \CRLF();
+
sub sockaddr_in {
if (@_ == 6 && !wantarray) { # perl5.001m compat; use this && die
my($af, $port, @quad) = @_;
diff --git a/gnu/usr.bin/perl/ext/Socket/Socket.xs b/gnu/usr.bin/perl/ext/Socket/Socket.xs
index e3b282b0adb..0bd6e590570 100644
--- a/gnu/usr.bin/perl/ext/Socket/Socket.xs
+++ b/gnu/usr.bin/perl/ext/Socket/Socket.xs
@@ -7,6 +7,11 @@
# include <sys/types.h>
# endif
#include <sys/socket.h>
+#ifdef MPE
+# define PF_INET AF_INET
+# define PF_UNIX AF_UNIX
+# define SOCK_RAW 3
+#endif
#ifdef I_SYS_UN
#include <sys/un.h>
#endif
@@ -14,7 +19,9 @@
# include <netinet/in.h>
# endif
#include <netdb.h>
-#include <arpa/inet.h>
+#ifdef I_ARPA_INET
+# include <arpa/inet.h>
+#endif
#else
#include "sockadapt.h"
#endif
@@ -47,9 +54,7 @@
* cannot distinguish between failure and a local broadcast address.
*/
static int
-my_inet_aton(cp, addr)
-register const char *cp;
-struct in_addr *addr;
+my_inet_aton(register const char *cp, struct in_addr *addr)
{
register U32 val;
register int base;
@@ -80,9 +85,9 @@ struct in_addr *addr;
cp++;
continue;
}
- if (base == 16 && (s=strchr(hexdigit,c))) {
+ if (base == 16 && (s=strchr(PL_hexdigit,c))) {
val = (val << 4) +
- ((s - hexdigit) & 15);
+ ((s - PL_hexdigit) & 15);
cp++;
continue;
}
@@ -145,17 +150,14 @@ struct in_addr *addr;
static int
-not_here(s)
-char *s;
+not_here(char *s)
{
croak("Socket::%s not implemented on this architecture", s);
return -1;
}
static double
-constant(name, arg)
-char *name;
-int arg;
+constant(char *name, int arg)
{
errno = 0;
switch (*name) {
@@ -328,30 +330,114 @@ int arg;
case 'L':
break;
case 'M':
+ if (strEQ(name, "MSG_CTLFLAGS"))
+#ifdef MSG_CTLFLAGS
+ return MSG_CTLFLAGS;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "MSG_CTLIGNORE"))
+#ifdef MSG_CTLIGNORE
+ return MSG_CTLIGNORE;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "MSG_CTRUNC"))
+#if defined(MSG_TRUNC) || defined(HAS_MSG_CTRUNC) /* might be an enum */
+ return MSG_CTRUNC;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "MSG_DONTROUTE"))
-#ifdef MSG_DONTROUTE
+#if defined(MSG_DONTROUTE) || defined(HAS_MSG_DONTROUTE) /* might be an enum */
return MSG_DONTROUTE;
#else
goto not_there;
#endif
+ if (strEQ(name, "MSG_DONTWAIT"))
+#ifdef MSG_DONTWAIT
+ return MSG_DONTWAIT;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "MSG_EOF"))
+#ifdef MSG_EOF
+ return MSG_EOF;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "MSG_EOR"))
+#ifdef MSG_EOR
+ return MSG_EOR;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "MSG_ERRQUEUE"))
+#ifdef MSG_ERRQUEUE
+ return MSG_ERRQUEUE;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "MSG_FIN"))
+#ifdef MSG_FIN
+ return MSG_FIN;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "MSG_MAXIOVLEN"))
#ifdef MSG_MAXIOVLEN
return MSG_MAXIOVLEN;
#else
goto not_there;
#endif
+ if (strEQ(name, "MSG_NOSIGNAL"))
+#ifdef MSG_NOSIGNAL
+ return MSG_NOSIGNAL;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "MSG_OOB"))
-#ifdef MSG_OOB
+#if defined(MSG_OOB) || defined(HAS_MSG_OOB) /* might be an enum */
return MSG_OOB;
#else
goto not_there;
#endif
if (strEQ(name, "MSG_PEEK"))
-#ifdef MSG_PEEK
+#if defined(MSG_PEEK) || defined(HAS_MSG_PEEK) /* might be an enum */
return MSG_PEEK;
#else
goto not_there;
#endif
+ if (strEQ(name, "MSG_PROXY"))
+#if defined(MSG_PROXY) || defined(HAS_MSG_PROXY) /* might be an enum */
+ return MSG_PROXY;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "MSG_RST"))
+#ifdef MSG_RST
+ return MSG_RST;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "MSG_SYN"))
+#ifdef MSG_SYN
+ return MSG_SYN;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "MSG_TRUNC"))
+#ifdef MSG_TRUNC
+ return MSG_TRUNC;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "MSG_WAITALL"))
+#ifdef MSG_WAITALL
+ return MSG_WAITALL;
+#else
+ goto not_there;
+#endif
break;
case 'N':
break;
@@ -508,6 +594,36 @@ int arg;
case 'R':
break;
case 'S':
+ if (strEQ(name, "SCM_CONNECT"))
+#ifdef SCM_CONNECT
+ return SCM_CONNECT;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "SCM_CREDENTIALS"))
+#ifdef SCM_CREDENTIALS
+ return SCM_CREDENTIALS;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "SCM_CREDS"))
+#ifdef SCM_CREDS
+ return SCM_CREDS;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "SCM_RIGHTS"))
+#if defined(SCM_RIGHTS) || defined(HAS_SCM_RIGHTS) /* might be an enum */
+ return SCM_RIGHTS;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "SCM_TIMESTAMP"))
+#ifdef SCM_TIMESTAMP
+ return SCM_TIMESTAMP;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "SOCK_DGRAM"))
#ifdef SOCK_DGRAM
return SOCK_DGRAM;
@@ -704,13 +820,11 @@ inet_aton(host)
{
struct in_addr ip_address;
struct hostent * phe;
- int ok;
+ int ok = inet_aton(host, &ip_address);
- if (phe = gethostbyname(host)) {
+ if (!ok && (phe = gethostbyname(host))) {
Copy( phe->h_addr, &ip_address, phe->h_length, char );
ok = 1;
- } else {
- ok = inet_aton(host, &ip_address);
}
ST(0) = sv_newmortal();
@@ -747,9 +861,13 @@ pack_sockaddr_un(pathname)
{
#ifdef I_SYS_UN
struct sockaddr_un sun_ad; /* fear using sun */
+ STRLEN len;
Zero( &sun_ad, sizeof sun_ad, char );
sun_ad.sun_family = AF_UNIX;
- Copy( pathname, sun_ad.sun_path, sizeof sun_ad.sun_path, char );
+ len = strlen(pathname);
+ if (len > sizeof(sun_ad.sun_path))
+ len = sizeof(sun_ad.sun_path);
+ Copy( pathname, sun_ad.sun_path, len, char );
ST(0) = sv_2mortal(newSVpv((char *)&sun_ad, sizeof sun_ad));
#else
ST(0) = (SV *) not_here("pack_sockaddr_un");
@@ -763,9 +881,10 @@ unpack_sockaddr_un(sun_sv)
CODE:
{
#ifdef I_SYS_UN
- STRLEN sockaddrlen;
struct sockaddr_un addr;
- char * sun_ad = SvPV(sun_sv,sockaddrlen);
+ STRLEN sockaddrlen;
+ char * sun_ad = SvPV(sun_sv,sockaddrlen);
+ char * e;
if (sockaddrlen != sizeof(addr)) {
croak("Bad arg length for %s, length is %d, should be %d",
@@ -780,8 +899,11 @@ unpack_sockaddr_un(sun_sv)
"Socket::unpack_sockaddr_un",
addr.sun_family,
AF_UNIX);
- }
- ST(0) = sv_2mortal(newSVpv(addr.sun_path, strlen(addr.sun_path)));
+ }
+ e = addr.sun_path;
+ while (*e && e < addr.sun_path + sizeof addr.sun_path)
+ ++e;
+ ST(0) = sv_2mortal(newSVpv(addr.sun_path, e - addr.sun_path));
#else
ST(0) = (SV *) not_here("unpack_sockaddr_un");
#endif
@@ -828,7 +950,7 @@ unpack_sockaddr_in(sin_sv)
port = ntohs(addr.sin_port);
ip_address = addr.sin_addr;
- EXTEND(sp, 2);
+ EXTEND(SP, 2);
PUSHs(sv_2mortal(newSViv((IV) port)));
PUSHs(sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address)));
}
diff --git a/gnu/usr.bin/perl/ext/util/make_ext b/gnu/usr.bin/perl/ext/util/make_ext
index 70a5d2eb231..54caf7dfd8d 100644
--- a/gnu/usr.bin/perl/ext/util/make_ext
+++ b/gnu/usr.bin/perl/ext/util/make_ext
@@ -61,6 +61,8 @@ fi
case "$extspec" in
lib*) # Remove lib/auto prefix and /*.* suffix
pname=`echo "$extspec" | sed -e 's:^lib/auto/::' -e 's:/[^/]*\.[^/]*$::' ` ;;
+ext*) # Remove ext/ prefix and /pm_to_blib suffix
+ pname=`echo "$extspec" | sed -e 's:^ext/::' -e 's:/pm_to_blib$::' ` ;;
*::*) # Convert :: to /
pname=`echo "$extspec" | sed -e 's/::/\//g' ` ;;
*) pname="$extspec" ;;
@@ -93,6 +95,10 @@ dynamic) makeargs="LINKTYPE=dynamic";
target=all
;;
+nonxs) makeargs="";
+ target=all
+ ;;
+
*clean) # If Makefile has been moved to Makefile.old by a make clean
# then use Makefile.old for realclean rather than rebuild it
if test ! -f $makefile -a -f Makefile.old; then
diff --git a/gnu/usr.bin/perl/form.h b/gnu/usr.bin/perl/form.h
index 5e74c613fad..0d3053d78b7 100644
--- a/gnu/usr.bin/perl/form.h
+++ b/gnu/usr.bin/perl/form.h
@@ -1,6 +1,6 @@
/* form.h
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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/gnu/usr.bin/perl/global.sym b/gnu/usr.bin/perl/global.sym
index 864be817570..99edf17782f 100644
--- a/gnu/usr.bin/perl/global.sym
+++ b/gnu/usr.bin/perl/global.sym
@@ -1,126 +1,58 @@
# Global symbols that need to be hidden in embedded applications.
-# Variables
+# Variables - should not be here but in perlvars.h
AMG_names
Error
-No
-Sv
-Xpv
-Yes
abs_amg
add_amg
add_ass_amg
additem
-amagic_generation
-an
atan2_amg
band_amg
block_type
bool__amg
bor_amg
-bufend
-bufptr
bxor_amg
check
-collation_ix
-collation_name
-collation_standard
-collxfrm_base
-collxfrm_mult
-compcv
-compiling
compl_amg
-comppad
-comppad_name
-comppad_name_fill
-comppad_name_floor
concat_amg
concat_ass_amg
-cop_seqmax
cos_amg
-cryptseen
-cshlen
-cshname
-curinterp
-curpad
dc
-debug
dec_amg
di
div_amg
div_ass_amg
-do_undump
+do_binmode
ds
-egid
eq_amg
-error_count
-euid
-evalseq
exp_amg
-expect
expectterm
fallback_amg
fold
fold_locale
freq
ge_amg
-gid
gt_amg
-hexdigit
-hints
-in_my
inc_amg
+init_thread_intern
io_close
know_next
-last_lop
-last_lop_op
-last_uni
le_amg
-lex_brackets
-lex_brackstack
-lex_casemods
-lex_casestack
-lex_defer
-lex_dojoin
-lex_expect
-lex_fakebrack
-lex_formbrack
-lex_inpat
-lex_inwhat
-lex_op
-lex_repl
-lex_starts
-lex_state
-lex_stuff
-linestr
log_amg
lshift_amg
lshift_ass_amg
lt_amg
-markstack
-markstack_max
-markstack_ptr
-max_intro_pending
-maxo
-min_intro_pending
mod_amg
mod_ass_amg
mult_amg
mult_ass_amg
-multi_close
-multi_end
-multi_open
-multi_start
-na
ncmp_amg
ne_amg
neg_amg
-nexttoke
-nexttype
-nextval
-nice_chunk
-nice_chunk_size
+new_struct_thread
+new_stackinfo
no_aelem
no_dir_func
no_func
@@ -135,82 +67,31 @@ no_usym
no_wrongref
nointrp
nomem
-nomemok
nomethod_amg
not_amg
-numeric_local
-numeric_name
-numeric_standard
numer_amg
-oldbufptr
-oldoldbufptr
-op
+op_const_sv
op_desc
op_name
-op_seqmax
opargs
-origalen
-origenviron
-osname
-pad_reset_pending
-padix
-padix_floor
-patleave
-pidstatus
pow_amg
pow_ass_amg
ppaddr
-profiledata
psig_name
psig_ptr
-rcsid
reall_srchlen
-regarglen
-regbol
-regcode
-regdummy
-regendp
-regeol
-regflags
-reginput
regkind
-reglastparen
-regmyendp
-regmyp_size
-regmystartp
-regnarrate
-regnaughty
-regnpar
-regparse
-regprecomp
-regprev
-regsawback
-regsize
-regstartp
-regtill
-regxend
repeat_amg
repeat_ass_amg
-retstack
-retstack_ix
-retstack_max
-rsfp
-rsfp_filters
rshift_amg
rshift_ass_amg
-savestack
-savestack_ix
-savestack_max
+runops_debug
+runops_standard
saw_return
scmp_amg
-scopestack
-scopestack_ix
-scopestack_max
-scrgv
seq_amg
sge_amg
sgt_amg
-sh_path
sig_name
sig_num
simple
@@ -219,25 +100,10 @@ sle_amg
slt_amg
sne_amg
sqrt_amg
-stack_base
-stack_max
-stack_sp
-statbuf
string_amg
-sub_generation
-subline
-subname
subtr_amg
subtr_ass_amg
-sv_no
-sv_undef
-sv_yes
-thisexpr
-timesbuf
-tokenbuf
-uid
varies
-vert
vivify_defelem
vivify_ref
vtbl_amagic
@@ -254,10 +120,12 @@ vtbl_glob
vtbl_isa
vtbl_isaelem
vtbl_mglob
+vtbl_mutex
vtbl_nkeys
vtbl_pack
vtbl_packelem
vtbl_pos
+vtbl_regexp
vtbl_sig
vtbl_sigelem
vtbl_substr
@@ -292,10 +160,6 @@ yyval
# Functions
Gv_AMupdate
-SvTRUE
-SvIV
-SvUV
-SvNV
amagic_call
append_elem
append_list
@@ -315,11 +179,18 @@ av_shift
av_store
av_undef
av_unshift
+avhv_exists_ent
+avhv_fetch_ent
+avhv_iternext
+avhv_iterval
+avhv_keys
bind_match
block_end
block_gimme
block_start
boot_core_UNIVERSAL
+bset_obj_store
+byterun
call_list
cando
cast_ulong
@@ -360,6 +231,7 @@ ck_split
ck_subr
ck_svconst
ck_trunc
+condpair_magic
convert
croak
cv_ckproto
@@ -404,7 +276,7 @@ do_tell
do_trans
do_vecset
do_vop
-doeval
+dofile
dofindlabel
dopoptoeval
dounwind
@@ -426,6 +298,8 @@ fetch_io
filter_add
filter_del
filter_read
+find_script
+find_threadsv
fold_constants
force_ident
force_list
@@ -434,6 +308,12 @@ force_word
form
free_tmps
gen_constant_list
+get_op_descs
+get_op_names
+get_no_modify
+get_opargs
+get_specialsv_list
+get_vtbl
gp_free
gp_ref
gv_AVadd
@@ -454,8 +334,6 @@ gv_init
gv_stashpv
gv_stashpvn
gv_stashsv
-he_root
-hoistmust
hv_clear
hv_delayfree_ent
hv_delete
@@ -480,6 +358,7 @@ hv_undef
ibcmp
ibcmp_locale
ingroup
+init_stacks
instr
intro_my
intuit_more
@@ -494,24 +373,29 @@ list
listkids
localize
looks_like_number
-magic_clearenv
magic_clear_all_env
+magic_clearenv
magic_clearpack
magic_clearsig
magic_existspack
-magic_freedefelem
+magic_freeregexp
magic_get
magic_getarylen
magic_getdefelem
magic_getglob
+magic_getnkeys
magic_getpack
magic_getpos
magic_getsig
+magic_getsubstr
magic_gettaint
magic_getuvar
+magic_getvec
magic_len
+magic_mutexfree
magic_nextpack
magic_set
+magic_set_all_env
magic_setamagic
magic_setarylen
magic_setbm
@@ -531,9 +415,10 @@ magic_setsubstr
magic_settaint
magic_setuvar
magic_setvec
-magic_set_all_env
+magic_sizepack
magic_wipepack
magicname
+malloced_size
markstack_grow
mem_collxfrm
mess
@@ -542,9 +427,10 @@ mg_copy
mg_find
mg_free
mg_get
-mg_len
+mg_length
mg_magical
mg_set
+mg_size
mod
modkids
moreswitches
@@ -574,6 +460,7 @@ newAV
newAVREF
newBINOP
newCONDOP
+newCONSTSUB
newCVREF
newFORM
newFOROP
@@ -582,6 +469,7 @@ newGVREF
newGVgen
newHV
newHVREF
+newHVhv
newIO
newLISTOP
newLOGOP
@@ -594,6 +482,7 @@ newPROG
newPVOP
newRANGE
newRV
+newRV_noinc
newSLICEOP
newSTATEOP
newSUB
@@ -604,6 +493,7 @@ newSViv
newSVnv
newSVpv
newSVpvf
+newSVpvn
newSVrv
newSVsv
newUNOP
@@ -792,7 +682,6 @@ pp_i_ne
pp_i_negate
pp_i_subtract
pp_index
-pp_indread
pp_int
pp_interp
pp_ioctl
@@ -817,6 +706,7 @@ pp_link
pp_list
pp_listen
pp_localtime
+pp_lock
pp_log
pp_lslice
pp_lstat
@@ -866,6 +756,7 @@ pp_prtf
pp_push
pp_pushmark
pp_pushre
+pp_qr
pp_quotemeta
pp_rand
pp_range
@@ -879,6 +770,7 @@ pp_redo
pp_ref
pp_refgen
pp_regcmaybe
+pp_regcreset
pp_regcomp
pp_rename
pp_repeat
@@ -958,6 +850,7 @@ pp_system
pp_syswrite
pp_tell
pp_telldir
+pp_threadsv
pp_tie
pp_tied
pp_time
@@ -991,29 +884,30 @@ q
ref
refkids
regdump
+regexec_flags
regnext
regprop
repeatcpy
rninstr
rsignal
+rsignal_restore
rsignal_save
rsignal_state
-rsignal_restore
-runops
rxres_free
rxres_restore
rxres_save
safecalloc
-safemalloc
safefree
+safemalloc
saferealloc
safexcalloc
-safexmalloc
safexfree
+safexmalloc
safexrealloc
same_dirent
save_I16
save_I32
+save_aelem
save_aptr
save_ary
save_clearsv
@@ -1022,8 +916,11 @@ save_destructor
save_freeop
save_freepv
save_freesv
+save_generic_svref
save_gp
save_hash
+save_helem
+save_hints
save_hptr
save_int
save_item
@@ -1031,10 +928,12 @@ save_iv
save_list
save_long
save_nogv
+save_op
save_pptr
save_scalar
save_sptr
save_svref
+save_threadsv
savepv
savepvn
savestack_grow
@@ -1079,10 +978,14 @@ sv_2uv
sv_add_arena
sv_backoff
sv_bless
-sv_catpvf
sv_catpv
+sv_catpv_mg
+sv_catpvf
+sv_catpvf_mg
sv_catpvn
+sv_catpvn_mg
sv_catsv
+sv_catsv_mg
sv_chop
sv_clean_all
sv_clean_objs
@@ -1090,6 +993,7 @@ sv_clear
sv_cmp
sv_cmp_locale
sv_collxfrm
+sv_compile_2op
sv_dec
sv_derived_from
sv_dump
@@ -1102,11 +1006,13 @@ sv_inc
sv_insert
sv_isa
sv_isobject
+sv_iv
sv_len
sv_magic
sv_mortalcopy
sv_newmortal
sv_newref
+sv_nv
sv_peek
sv_pvn
sv_pvn_force
@@ -1115,26 +1021,37 @@ sv_reftype
sv_replace
sv_report_used
sv_reset
-sv_setpvf
sv_setiv
+sv_setiv_mg
sv_setnv
+sv_setnv_mg
sv_setptrobj
sv_setpv
+sv_setpv_mg
+sv_setpvf
+sv_setpvf_mg
sv_setpviv
+sv_setpviv_mg
sv_setpvn
+sv_setpvn_mg
sv_setref_iv
sv_setref_nv
sv_setref_pv
sv_setref_pvn
sv_setsv
+sv_setsv_mg
sv_setuv
+sv_setuv_mg
sv_taint
sv_tainted
+sv_true
sv_unmagic
sv_unref
sv_untaint
sv_upgrade
sv_usepvn
+sv_usepvn_mg
+sv_uv
sv_vcatpvfn
sv_vsetpvfn
taint_env
@@ -1142,6 +1059,7 @@ taint_proper
too_few_arguments
too_many_arguments
unlnk
+unlock_condpair
unshare_hek
unsharepvn
utilize
@@ -1149,13 +1067,8 @@ wait4pid
warn
watch
whichsig
-xiv_arenaroot
-xiv_root
-xnv_root
-xpv_root
-xrv_root
-yyerror
yydestruct
+yyerror
yylex
yyparse
yywarn
diff --git a/gnu/usr.bin/perl/gv.c b/gnu/usr.bin/perl/gv.c
index fff3bcfa876..1845058c36c 100644
--- a/gnu/usr.bin/perl/gv.c
+++ b/gnu/usr.bin/perl/gv.c
@@ -1,6 +1,6 @@
/* gv.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -19,11 +19,8 @@
#include "EXTERN.h"
#include "perl.h"
-EXT char rcsid[];
-
GV *
-gv_AVadd(gv)
-register GV *gv;
+gv_AVadd(register GV *gv)
{
if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
croak("Bad symbol for array");
@@ -33,8 +30,7 @@ register GV *gv;
}
GV *
-gv_HVadd(gv)
-register GV *gv;
+gv_HVadd(register GV *gv)
{
if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
croak("Bad symbol for hash");
@@ -44,8 +40,7 @@ register GV *gv;
}
GV *
-gv_IOadd(gv)
-register GV *gv;
+gv_IOadd(register GV *gv)
{
if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
croak("Bad symbol for filehandle");
@@ -55,9 +50,9 @@ register GV *gv;
}
GV *
-gv_fetchfile(name)
-char *name;
+gv_fetchfile(char *name)
{
+ dTHR;
char smallbuf[256];
char *tmpbuf;
STRLEN tmplen;
@@ -71,9 +66,9 @@ char *name;
tmpbuf[0] = '_';
tmpbuf[1] = '<';
strcpy(tmpbuf + 2, name);
- gv = *(GV**)hv_fetch(defstash, tmpbuf, tmplen, TRUE);
+ gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, TRUE);
if (!isGV(gv))
- gv_init(gv, defstash, tmpbuf, tmplen, FALSE);
+ gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE);
if (tmpbuf != smallbuf)
Safefree(tmpbuf);
sv_setpv(GvSV(gv), name);
@@ -85,36 +80,63 @@ char *name;
}
void
-gv_init(gv, stash, name, len, multi)
-GV *gv;
-HV *stash;
-char *name;
-STRLEN len;
-int multi;
+gv_init(GV *gv, HV *stash, char *name, STRLEN len, int multi)
{
+ dTHR;
register GP *gp;
+ bool doproto = SvTYPE(gv) > SVt_NULL;
+ char *proto = (doproto && SvPOK(gv)) ? SvPVX(gv) : NULL;
sv_upgrade((SV*)gv, SVt_PVGV);
- if (SvLEN(gv))
- Safefree(SvPVX(gv));
+ if (SvLEN(gv)) {
+ if (proto) {
+ SvPVX(gv) = NULL;
+ SvLEN(gv) = 0;
+ SvPOK_off(gv);
+ } else
+ Safefree(SvPVX(gv));
+ }
Newz(602, gp, 1, GP);
GvGP(gv) = gp_ref(gp);
GvSV(gv) = NEWSV(72,0);
- GvLINE(gv) = curcop->cop_line;
- GvFILEGV(gv) = curcop->cop_filegv;
+ GvLINE(gv) = PL_curcop->cop_line;
+ GvFILEGV(gv) = PL_curcop->cop_filegv;
+ GvCVGEN(gv) = 0;
GvEGV(gv) = gv;
sv_magic((SV*)gv, (SV*)gv, '*', name, len);
- GvSTASH(gv) = stash;
+ GvSTASH(gv) = (HV*)SvREFCNT_inc(stash);
GvNAME(gv) = savepvn(name, len);
GvNAMELEN(gv) = len;
- if (multi)
+ if (multi || doproto) /* doproto means it _was_ mentioned */
GvMULTI_on(gv);
+ if (doproto) { /* Replicate part of newSUB here. */
+ SvIOK_off(gv);
+ ENTER;
+ /* XXX unsafe for threads if eval_owner isn't held */
+ start_subparse(0,0); /* Create CV in compcv. */
+ GvCV(gv) = PL_compcv;
+ LEAVE;
+
+ PL_sub_generation++;
+ CvGV(GvCV(gv)) = (GV*)SvREFCNT_inc(gv);
+ CvFILEGV(GvCV(gv)) = PL_curcop->cop_filegv;
+ CvSTASH(GvCV(gv)) = PL_curstash;
+#ifdef USE_THREADS
+ CvOWNER(GvCV(gv)) = 0;
+ if (!CvMUTEXP(GvCV(gv))) {
+ New(666, CvMUTEXP(GvCV(gv)), 1, perl_mutex);
+ MUTEX_INIT(CvMUTEXP(GvCV(gv)));
+ }
+#endif /* USE_THREADS */
+ if (proto) {
+ sv_setpv((SV*)GvCV(gv), proto);
+ Safefree(proto);
+ }
+ }
}
-static void
-gv_init_sv(gv, sv_type)
-GV* gv;
-I32 sv_type;
+STATIC void
+gv_init_sv(GV *gv, I32 sv_type)
{
switch (sv_type) {
case SVt_PVIO:
@@ -130,11 +152,7 @@ I32 sv_type;
}
GV *
-gv_fetchmeth(stash, name, len, level)
-HV* stash;
-char* name;
-STRLEN len;
-I32 level;
+gv_fetchmeth(HV *stash, char *name, STRLEN len, I32 level)
{
AV* av;
GV* topgv;
@@ -145,7 +163,8 @@ I32 level;
if (!stash)
return 0;
if ((level > 100) || (level < -100))
- croak("Recursive inheritance detected");
+ croak("Recursive inheritance detected while looking for method '%s' in package '%s'",
+ name, HvNAME(stash));
DEBUG_o( deb("Looking for method %s in package %s\n",name,HvNAME(stash)) );
@@ -158,17 +177,19 @@ I32 level;
gv_init(topgv, stash, name, len, TRUE);
if (cv = GvCV(topgv)) {
/* If genuine method or valid cache entry, use it */
- if (!GvCVGEN(topgv) || GvCVGEN(topgv) >= sub_generation)
+ if (!GvCVGEN(topgv) || GvCVGEN(topgv) == PL_sub_generation)
return topgv;
/* Stale cached entry: junk it */
SvREFCNT_dec(cv);
GvCV(topgv) = cv = Nullcv;
GvCVGEN(topgv) = 0;
}
+ else if (GvCVGEN(topgv) == PL_sub_generation)
+ return 0; /* cache indicates sub doesn't exist */
}
gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE);
- av = (gvp && (gv = *gvp) && gv != (GV*)&sv_undef) ? GvAV(gv) : Nullav;
+ av = (gvp && (gv = *gvp) && gv != (GV*)&PL_sv_undef) ? GvAV(gv) : Nullav;
/* create and re-create @.*::SUPER::ISA on demand */
if (!av || !SvMAGIC(av)) {
@@ -181,7 +202,8 @@ I32 level;
packlen -= 7;
basestash = gv_stashpvn(packname, packlen, TRUE);
gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE);
- if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
+ 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))
croak("Cannot create %s::ISA", HvNAME(stash));
@@ -195,12 +217,13 @@ I32 level;
if (av) {
SV** svp = AvARRAY(av);
- I32 items = AvFILL(av) + 1;
+ /* NOTE: No support for tied ISA */
+ I32 items = AvFILLp(av) + 1;
while (items--) {
SV* sv = *svp++;
HV* basestash = gv_stashsv(sv, FALSE);
if (!basestash) {
- if (dowarn)
+ if (PL_dowarn)
warn("Can't locate package %s for @%s::ISA",
SvPVX(sv), HvNAME(stash));
continue;
@@ -234,10 +257,14 @@ I32 level;
if (cv = GvCV(topgv))
SvREFCNT_dec(cv);
GvCV(topgv) = (CV*)SvREFCNT_inc(GvCV(gv));
- GvCVGEN(topgv) = sub_generation;
+ GvCVGEN(topgv) = PL_sub_generation;
}
return gv;
}
+ else if (topgv && GvREFCNT(topgv) == 1) {
+ /* cache the fact that the method is not defined */
+ GvCVGEN(topgv) = PL_sub_generation;
+ }
}
}
@@ -245,19 +272,15 @@ I32 level;
}
GV *
-gv_fetchmethod(stash, name)
-HV* stash;
-char* name;
+gv_fetchmethod(HV *stash, char *name)
{
return gv_fetchmethod_autoload(stash, name, TRUE);
}
GV *
-gv_fetchmethod_autoload(stash, name, autoload)
-HV* stash;
-char* name;
-I32 autoload;
+gv_fetchmethod_autoload(HV *stash, char *name, I32 autoload)
{
+ dTHR;
register char *nend;
char *nsplit = 0;
GV* gv;
@@ -276,7 +299,7 @@ I32 autoload;
if ((nsplit - origname) == 5 && strnEQ(origname, "SUPER", 5)) {
/* ->SUPER::method should really be looked up in original stash */
SV *tmpstr = sv_2mortal(newSVpvf("%s::SUPER",
- HvNAME(curcop->cop_stash)));
+ HvNAME(PL_curcop->cop_stash)));
stash = gv_stashpvn(SvPVX(tmpstr), SvCUR(tmpstr), TRUE);
DEBUG_o( deb("Treating %s as %s::%s\n",
origname, HvNAME(stash), name) );
@@ -288,7 +311,7 @@ I32 autoload;
gv = gv_fetchmeth(stash, name, nend - name, 0);
if (!gv) {
if (strEQ(name,"import"))
- gv = (GV*)&sv_yes;
+ gv = (GV*)&PL_sv_yes;
else if (autoload)
gv = gv_autoload4(stash, name, nend - name, TRUE);
}
@@ -316,11 +339,7 @@ I32 autoload;
}
GV*
-gv_autoload4(stash, name, len, method)
-HV* stash;
-char* name;
-STRLEN len;
-I32 method;
+gv_autoload4(HV *stash, char *name, STRLEN len, I32 method)
{
static char autoload[] = "AUTOLOAD";
static STRLEN autolen = 8;
@@ -339,7 +358,7 @@ I32 method;
/*
* Inheriting AUTOLOAD for non-methods works ... for now.
*/
- if (dowarn && !method && (GvCVGEN(gv) || GvSTASH(gv) != stash))
+ if (PL_dowarn && !method && (GvCVGEN(gv) || GvSTASH(gv) != stash))
warn(
"Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
HvNAME(stash), (int)len, name);
@@ -363,18 +382,13 @@ I32 method;
}
HV*
-gv_stashpv(name,create)
-char *name;
-I32 create;
+gv_stashpv(char *name, I32 create)
{
return gv_stashpvn(name, strlen(name), create);
}
HV*
-gv_stashpvn(name,namelen,create)
-char *name;
-U32 namelen;
-I32 create;
+gv_stashpvn(char *name, U32 namelen, I32 create)
{
char smallbuf[256];
char *tmpbuf;
@@ -403,9 +417,7 @@ I32 create;
}
HV*
-gv_stashsv(sv,create)
-SV *sv;
-I32 create;
+gv_stashsv(SV *sv, I32 create)
{
register char *ptr;
STRLEN len;
@@ -415,11 +427,9 @@ I32 create;
GV *
-gv_fetchpv(nambeg,add,sv_type)
-char *nambeg;
-I32 add;
-I32 sv_type;
+gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
{
+ dTHR;
register char *name = nambeg;
register GV *gv = 0;
GV**gvp;
@@ -427,7 +437,6 @@ I32 sv_type;
register char *namend;
HV *stash = 0;
U32 add_gvflags = 0;
- char *tmpbuf;
if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */
name++;
@@ -437,29 +446,35 @@ I32 sv_type;
(*namend == ':' && namend[1] == ':'))
{
if (!stash)
- stash = defstash;
+ stash = PL_defstash;
if (!stash || !SvREFCNT(stash)) /* symbol table under destruction */
return Nullgv;
len = namend - name;
if (len > 0) {
- New(601, tmpbuf, len+3, char);
+ char smallbuf[256];
+ char *tmpbuf;
+
+ if (len + 3 < sizeof smallbuf)
+ tmpbuf = smallbuf;
+ else
+ New(601, tmpbuf, len+3, char);
Copy(name, tmpbuf, len, char);
tmpbuf[len++] = ':';
tmpbuf[len++] = ':';
tmpbuf[len] = '\0';
gvp = (GV**)hv_fetch(stash,tmpbuf,len,add);
- Safefree(tmpbuf);
- if (!gvp || *gvp == (GV*)&sv_undef)
- return Nullgv;
- gv = *gvp;
-
- if (SvTYPE(gv) == SVt_PVGV)
- GvMULTI_on(gv);
- else if (!add)
+ gv = gvp ? *gvp : Nullgv;
+ if (gv && gv != (GV*)&PL_sv_undef) {
+ if (SvTYPE(gv) != SVt_PVGV)
+ gv_init(gv, stash, tmpbuf, len, (add & GV_ADDMULTI));
+ else
+ GvMULTI_on(gv);
+ }
+ if (tmpbuf != smallbuf)
+ Safefree(tmpbuf);
+ if (!gv || gv == (GV*)&PL_sv_undef)
return Nullgv;
- else
- gv_init(gv, stash, nambeg, namend - nambeg, (add & 2));
if (!(stash = GvHV(gv)))
stash = GvHV(gv) = newHV();
@@ -473,7 +488,7 @@ I32 sv_type;
namend++;
name = namend;
if (!*name)
- return gv ? gv : (GV*)*hv_fetch(defstash, "main::", 6, TRUE);
+ return gv ? gv : (GV*)*hv_fetch(PL_defstash, "main::", 6, TRUE);
}
}
len = namend - name;
@@ -487,35 +502,29 @@ I32 sv_type;
bool global = FALSE;
if (isUPPER(*name)) {
- if (*name > 'I') {
- if (*name == 'S' && (
- strEQ(name, "SIG") ||
- strEQ(name, "STDIN") ||
- strEQ(name, "STDOUT") ||
- strEQ(name, "STDERR") ))
- global = TRUE;
- }
- else if (*name > 'E') {
- if (*name == 'I' && strEQ(name, "INC"))
- global = TRUE;
- }
- else if (*name > 'A') {
- if (*name == 'E' && strEQ(name, "ENV"))
- global = TRUE;
- }
+ if (*name == 'S' && (
+ strEQ(name, "SIG") ||
+ strEQ(name, "STDIN") ||
+ strEQ(name, "STDOUT") ||
+ strEQ(name, "STDERR")))
+ global = TRUE;
+ else if (*name == 'I' && strEQ(name, "INC"))
+ global = TRUE;
+ else if (*name == 'E' && strEQ(name, "ENV"))
+ global = TRUE;
else if (*name == 'A' && (
strEQ(name, "ARGV") ||
- strEQ(name, "ARGVOUT") ))
+ strEQ(name, "ARGVOUT")))
global = TRUE;
}
else if (*name == '_' && !name[1])
global = TRUE;
if (global)
- stash = defstash;
- else if ((COP*)curcop == &compiling) {
- stash = curstash;
- if (add && (hints & HINT_STRICT_VARS) &&
+ stash = PL_defstash;
+ else if ((COP*)PL_curcop == &PL_compiling) {
+ stash = PL_curstash;
+ if (add && (PL_hints & HINT_STRICT_VARS) &&
sv_type != SVt_PVCV &&
sv_type != SVt_PVGV &&
sv_type != SVt_PVFM &&
@@ -524,7 +533,7 @@ I32 sv_type;
{
gvp = (GV**)hv_fetch(stash,name,len,0);
if (!gvp ||
- *gvp == (GV*)&sv_undef ||
+ *gvp == (GV*)&PL_sv_undef ||
SvTYPE(*gvp) != SVt_PVGV)
{
stash = 0;
@@ -544,33 +553,42 @@ I32 sv_type;
}
}
else
- stash = curcop->cop_stash;
+ stash = PL_curcop->cop_stash;
}
else
- stash = defstash;
+ stash = PL_defstash;
}
/* By this point we should have a stash and a name */
if (!stash) {
- if (add) {
- warn("Global symbol \"%s\" requires explicit package name", name);
- ++error_count;
- stash = curstash ? curstash : defstash; /* avoid core dumps */
- add_gvflags = ((sv_type == SVt_PV) ? GVf_IMPORTED_SV
- : (sv_type == SVt_PVAV) ? GVf_IMPORTED_AV
- : (sv_type == SVt_PVHV) ? GVf_IMPORTED_HV
- : 0);
- }
- else
+ if (!add)
return Nullgv;
+ if (add & ~GV_ADDMULTI) {
+ char sv_type_char = ((sv_type == SVt_PV) ? '$'
+ : (sv_type == SVt_PVAV) ? '@'
+ : (sv_type == SVt_PVHV) ? '%'
+ : 0);
+ if (sv_type_char)
+ warn("Global symbol \"%c%s\" requires explicit package name",
+ sv_type_char, name);
+ else
+ warn("Global symbol \"%s\" requires explicit package name",
+ name);
+ }
+ ++PL_error_count;
+ stash = PL_curstash ? PL_curstash : PL_defstash; /* avoid core dumps */
+ add_gvflags = ((sv_type == SVt_PV) ? GVf_IMPORTED_SV
+ : (sv_type == SVt_PVAV) ? GVf_IMPORTED_AV
+ : (sv_type == SVt_PVHV) ? GVf_IMPORTED_HV
+ : 0);
}
if (!SvREFCNT(stash)) /* symbol table under destruction */
return Nullgv;
gvp = (GV**)hv_fetch(stash,name,len,add);
- if (!gvp || *gvp == (GV*)&sv_undef)
+ if (!gvp || *gvp == (GV*)&PL_sv_undef)
return Nullgv;
gv = *gvp;
if (SvTYPE(gv) == SVt_PVGV) {
@@ -579,13 +597,15 @@ I32 sv_type;
gv_init_sv(gv, sv_type);
}
return gv;
+ } else if (add & GV_NOINIT) {
+ return gv;
}
/* Adding a new symbol */
- if (add & 4)
+ if (add & GV_ADDWARN)
warn("Had to create %s unexpectedly", nambeg);
- gv_init(gv, stash, name, len, add & 2);
+ gv_init(gv, stash, name, len, add & GV_ADDMULTI);
gv_init_sv(gv, sv_type);
GvFLAGS(gv) |= add_gvflags;
@@ -596,12 +616,6 @@ I32 sv_type;
IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START;
}
break;
-
- case 'a':
- case 'b':
- if (len == 1)
- GvMULTI_on(gv);
- break;
case 'E':
if (strnEQ(name, "EXPORT", 6))
GvMULTI_on(gv);
@@ -611,7 +625,9 @@ I32 sv_type;
AV* av = GvAVn(gv);
GvMULTI_on(gv);
sv_magic((SV*)av, (SV*)gv, 'I', Nullch, 0);
- if (add & 2 && strEQ(nambeg,"AnyDBM_File::ISA") && AvFILL(av) == -1)
+ /* NOTE: No support for tied ISA */
+ if ((add & GV_ADDMULTI) && strEQ(nambeg,"AnyDBM_File::ISA")
+ && AvFILLp(av) == -1)
{
char *pname;
av_push(av, newSVpv(pname = "NDBM_File",0));
@@ -632,7 +648,7 @@ I32 sv_type;
if (strEQ(name, "OVERLOAD")) {
HV* hv = GvHVn(gv);
GvMULTI_on(gv);
- sv_magic((SV*)hv, (SV*)gv, 'A', 0, 0);
+ hv_magic(hv, gv, 'A');
}
break;
#endif /* OVERLOAD */
@@ -640,51 +656,46 @@ I32 sv_type;
if (strEQ(name, "SIG")) {
HV *hv;
I32 i;
- siggv = gv;
- GvMULTI_on(siggv);
- hv = GvHVn(siggv);
- hv_magic(hv, siggv, 'S');
+ PL_siggv = gv;
+ GvMULTI_on(PL_siggv);
+ hv = GvHVn(PL_siggv);
+ hv_magic(hv, PL_siggv, 'S');
for(i=1;sig_name[i];i++) {
SV ** init;
init=hv_fetch(hv,sig_name[i],strlen(sig_name[i]),1);
if(init)
- sv_setsv(*init,&sv_undef);
+ sv_setsv(*init,&PL_sv_undef);
psig_ptr[i] = 0;
psig_name[i] = 0;
}
- /* initialize signal stack */
- signalstack = newAV();
- AvREAL_off(signalstack);
- av_extend(signalstack, 30);
- av_fill(signalstack, 0);
}
break;
case '&':
if (len > 1)
break;
- ampergv = gv;
- sawampersand = TRUE;
+ PL_ampergv = gv;
+ PL_sawampersand = TRUE;
goto ro_magicalize;
case '`':
if (len > 1)
break;
- leftgv = gv;
- sawampersand = TRUE;
+ PL_leftgv = gv;
+ PL_sawampersand = TRUE;
goto ro_magicalize;
case '\'':
if (len > 1)
break;
- rightgv = gv;
- sawampersand = TRUE;
+ PL_rightgv = gv;
+ PL_sawampersand = TRUE;
goto ro_magicalize;
case ':':
if (len > 1)
break;
- sv_setpv(GvSV(gv),chopset);
+ sv_setpv(GvSV(gv),PL_chopset);
goto magicalize;
case '?':
@@ -695,13 +706,28 @@ I32 sv_type;
#endif
goto magicalize;
+ case '!':
+ if (len > 1)
+ break;
+ if (sv_type > SVt_PV && PL_curcop != &PL_compiling) {
+ HV* stash = gv_stashpvn("Errno",5,FALSE);
+ if(!stash || !(gv_fetchmethod(stash, "TIEHASH"))) {
+ dSP;
+ PUTBACK;
+ perl_require_pv("Errno.pm");
+ SPAGAIN;
+ stash = gv_stashpvn("Errno",5,FALSE);
+ if (!stash || !(gv_fetchmethod(stash, "TIEHASH")))
+ croak("Can't use %%! because Errno.pm is not available");
+ }
+ }
+ goto magicalize;
case '#':
case '*':
- if (dowarn && len == 1 && sv_type == SVt_PV)
+ if (PL_dowarn && len == 1 && sv_type == SVt_PV)
warn("Use of $%s is deprecated", name);
/* FALL THROUGH */
case '[':
- case '!':
case '^':
case '~':
case '=':
@@ -717,12 +743,13 @@ I32 sv_type;
case '/':
case '|':
case '\001':
+ case '\003':
case '\004':
case '\005':
case '\006':
case '\010':
+ case '\011': /* NOT \t in EBCDIC */
case '\017':
- case '\t':
case '\020':
case '\024':
case '\027':
@@ -751,7 +778,7 @@ I32 sv_type;
if (len > 1)
break;
sv_setpv(GvSV(gv),"\f");
- formfeed = GvSV(gv);
+ PL_formfeed = GvSV(gv);
break;
case ';':
if (len > 1)
@@ -762,7 +789,7 @@ I32 sv_type;
if (len == 1) {
SV *sv = GvSV(gv);
sv_upgrade(sv, SVt_PVNV);
- sv_setpv(sv, patchlevel);
+ sv_setpv(sv, PL_patchlevel);
(void)sv_2nv(sv);
SvREADONLY_on(sv);
}
@@ -772,10 +799,7 @@ I32 sv_type;
}
void
-gv_fullname3(sv, gv, prefix)
-SV *sv;
-GV *gv;
-char *prefix;
+gv_fullname3(SV *sv, GV *gv, char *prefix)
{
HV *hv = GvSTASH(gv);
if (!hv) {
@@ -789,10 +813,7 @@ char *prefix;
}
void
-gv_efullname3(sv, gv, prefix)
-SV *sv;
-GV *gv;
-char *prefix;
+gv_efullname3(SV *sv, GV *gv, char *prefix)
{
GV *egv = GvEGV(gv);
if (!egv)
@@ -802,25 +823,22 @@ char *prefix;
/* XXX compatibility with versions <= 5.003. */
void
-gv_fullname(sv,gv)
-SV *sv;
-GV *gv;
+gv_fullname(SV *sv, GV *gv)
{
gv_fullname3(sv, gv, sv == (SV*)gv ? "*" : "");
}
/* XXX compatibility with versions <= 5.003. */
void
-gv_efullname(sv,gv)
-SV *sv;
-GV *gv;
+gv_efullname(SV *sv, GV *gv)
{
gv_efullname3(sv, gv, sv == (SV*)gv ? "*" : "");
}
IO *
-newIO()
+newIO(void)
{
+ dTHR;
IO *io;
GV *iogv;
@@ -829,16 +847,17 @@ newIO()
SvREFCNT(io) = 1;
SvOBJECT_on(io);
iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV);
- if (!iogv)
+ /* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
+ if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV);
SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv));
return io;
}
void
-gv_check(stash)
-HV* stash;
+gv_check(HV *stash)
{
+ dTHR;
register HE *entry;
register I32 i;
register GV *gv;
@@ -852,16 +871,16 @@ HV* stash;
if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
(gv = (GV*)HeVAL(entry)) && (hv = GvHV(gv)) && HvNAME(hv))
{
- if (hv != defstash)
+ if (hv != PL_defstash)
gv_check(hv); /* nested package */
}
else if (isALPHA(*HeKEY(entry))) {
gv = (GV*)HeVAL(entry);
- if (GvMULTI(gv))
+ if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv))
continue;
- curcop->cop_line = GvLINE(gv);
+ PL_curcop->cop_line = GvLINE(gv);
filegv = GvFILEGV(gv);
- curcop->cop_filegv = filegv;
+ PL_curcop->cop_filegv = filegv;
if (filegv && GvMULTI(filegv)) /* Filename began with slash */
continue;
warn("Name \"%s::%s\" used only once: possible typo",
@@ -872,18 +891,16 @@ HV* stash;
}
GV *
-newGVgen(pack)
-char *pack;
+newGVgen(char *pack)
{
- return gv_fetchpv(form("%s::_GEN_%ld", pack, (long)gensym++),
+ return gv_fetchpv(form("%s::_GEN_%ld", pack, (long)PL_gensym++),
TRUE, SVt_PVGV);
}
/* hopefully this is only called on local symbol table entries */
GP*
-gp_ref(gp)
-GP* gp;
+gp_ref(GP *gp)
{
gp->gp_refcnt++;
if (gp->gp_cv) {
@@ -895,15 +912,14 @@ GP* gp;
}
else {
/* Adding a new name to a subroutine invalidates method cache */
- sub_generation++;
+ PL_sub_generation++;
}
}
return gp;
}
void
-gp_free(gv)
-GV* gv;
+gp_free(GV *gv)
{
GP* gp;
CV* cv;
@@ -916,7 +932,7 @@ GV* gv;
}
if (gp->gp_cv) {
/* Deleting the name of a subroutine invalidates method cache */
- sub_generation++;
+ PL_sub_generation++;
}
if (--gp->gp_refcnt > 0) {
if (gp->gp_egv == gv)
@@ -963,19 +979,20 @@ register GV *gv;
/* Updates and caches the CV's */
bool
-Gv_AMupdate(stash)
-HV* stash;
+Gv_AMupdate(HV *stash)
{
+ dTHR;
GV** gvp;
HV* hv;
GV* gv;
CV* cv;
MAGIC* mg=mg_find((SV*)stash,'c');
- AMT *amtp=mg ? (AMT*)mg->mg_ptr: NULL;
+ AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL;
AMT amt;
+ STRLEN n_a;
- if (mg && amtp->was_ok_am == amagic_generation
- && amtp->was_ok_sub == sub_generation)
+ if (mg && amtp->was_ok_am == PL_amagic_generation
+ && amtp->was_ok_sub == PL_sub_generation)
return AMT_AMAGIC(amtp);
if (amtp && AMT_AMAGIC(amtp)) { /* Have table. */
int i;
@@ -989,14 +1006,14 @@ HV* stash;
DEBUG_o( deb("Recalcing overload magic in package %s\n",HvNAME(stash)) );
- amt.was_ok_am = amagic_generation;
- amt.was_ok_sub = sub_generation;
+ amt.was_ok_am = PL_amagic_generation;
+ amt.was_ok_sub = PL_sub_generation;
amt.fallback = AMGfallNO;
amt.flags = 0;
#ifdef OVERLOAD_VIA_HASH
gvp=(GV**)hv_fetch(stash,"OVERLOAD",8,FALSE); /* A shortcut */
- if (gvp && ((gv = *gvp) != (GV*)&sv_undef && (hv = GvHV(gv)))) {
+ if (gvp && ((gv = *gvp) != (GV*)&PL_sv_undef && (hv = GvHV(gv)))) {
int filled=0;
int i;
char *cp;
@@ -1015,12 +1032,12 @@ HV* stash;
cp = (char *)AMG_names[i];
svp = (SV**)hv_fetch(hv, cp, strlen(cp), FALSE);
- if (svp && ((sv = *svp) != &sv_undef)) {
+ if (svp && ((sv = *svp) != &PL_sv_undef)) {
switch (SvTYPE(sv)) {
default:
if (!SvROK(sv)) {
if (!SvOK(sv)) break;
- gv = gv_fetchmethod(stash, SvPV(sv, na));
+ gv = gv_fetchmethod(stash, SvPV(sv, n_a));
if (gv) cv = GvCV(gv);
break;
}
@@ -1081,7 +1098,7 @@ HV* stash;
GV *ngv;
DEBUG_o( deb("Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n",
- SvPV(GvSV(gv), na), cp, HvNAME(stash)) );
+ SvPV(GvSV(gv), n_a), cp, HvNAME(stash)) );
if (!SvPOK(GvSV(gv))
|| !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)),
FALSE)))
@@ -1119,28 +1136,22 @@ HV* stash;
return FALSE;
}
-/* During call to this subroutine stack can be reallocated. It is
- * advised to call SPAGAIN macro in your code after call */
-
SV*
-amagic_call(left,right,method,flags)
-SV* left;
-SV* right;
-int method;
-int flags;
+amagic_call(SV *left, SV *right, int method, int flags)
{
+ dTHR;
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;
- int postpr=0, inc_dec_ass=0, assignshift=assign?1:0;
+ int postpr = 0, force_cpy = 0, assignshift = assign ? 1 : 0;
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)
? (oamtp = amtp = (AMT*)mg->mg_ptr)->table
- : NULL))
+ : (CV **) NULL))
&& ((cv = cvp[off=method+assignshift])
|| (assign && amtp->fallback > AMGfallNEVER && /* fallback to
* usual method */
@@ -1151,17 +1162,20 @@ int flags;
int logic;
/* look for substituted methods */
+ /* In all the covered cases we should be called with assign==0. */
switch (method) {
case inc_amg:
- if (((cv = cvp[off=add_ass_amg]) && (inc_dec_ass=1))
- || ((cv = cvp[off=add_amg]) && (postpr=1))) {
- right = &sv_yes; lr = -1; assign = 1;
+ force_cpy = 1;
+ if ((cv = cvp[off=add_ass_amg])
+ || ((cv = cvp[off = add_amg]) && (force_cpy = 0, postpr = 1))) {
+ right = &PL_sv_yes; lr = -1; assign = 1;
}
break;
case dec_amg:
- if (((cv = cvp[off=subtr_ass_amg]) && (inc_dec_ass=1))
- || ((cv = cvp[off=subtr_amg]) && (postpr=1))) {
- right = &sv_yes; lr = -1; assign = 1;
+ force_cpy = 1;
+ if ((cv = cvp[off = subtr_ass_amg])
+ || ((cv = cvp[off = subtr_amg]) && (force_cpy = 0, postpr=1))) {
+ right = &PL_sv_yes; lr = -1; assign = 1;
}
break;
case bool__amg:
@@ -1181,15 +1195,19 @@ int flags;
break;
case copy_amg:
{
- SV* ref=SvRV(left);
- if (!SvROK(ref) && SvTYPE(ref) <= SVt_PVMG) {
+ /*
+ * SV* ref causes confusion with the interpreter variable of
+ * the same name
+ */
+ SV* tmpRef=SvRV(left);
+ if (!SvROK(tmpRef) && SvTYPE(tmpRef) <= SVt_PVMG) {
/*
* Just to be extra cautious. Maybe in some
* additional cases sv_setsv is safe, too.
*/
- SV* newref = newSVsv(ref);
+ SV* newref = newSVsv(tmpRef);
SvOBJECT_on(newref);
- SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(ref));
+ SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(tmpRef));
return newref;
}
}
@@ -1233,7 +1251,7 @@ int flags;
&& (mg = mg_find((SV*)(stash=SvSTASH(SvRV(right))),'c'))
&& (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
? (amtp = (AMT*)mg->mg_ptr)->table
- : NULL))
+ : (CV **) NULL))
&& (cv = cvp[off=method])) { /* Method for right
* argument found */
lr=1;
@@ -1303,6 +1321,7 @@ int flags;
}
return NULL;
}
+ force_cpy = force_cpy || assign;
}
}
if (!notfound) {
@@ -1319,14 +1338,33 @@ int flags;
flags & AMGf_unary? " for argument" : "",
HvNAME(stash),
fl? ",\n\tassignment variant used": "") );
+ }
/* Since we use shallow copy during assignment, we need
* to dublicate the contents, probably calling user-supplied
* version of copy operator
*/
- if ((method + assignshift==off
- && (assign || method==inc_amg || method==dec_amg))
- || inc_dec_ass) RvDEEPCP(left);
- }
+ /* We need to copy in following cases:
+ * a) Assignment form was called.
+ * assignshift==1, assign==T, method + 1 == off
+ * 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,
+ * force_cpy == T
+ * d) Increment or decrement, translated to nomethod.
+ * assignshift==0, assign==0,
+ * force_cpy == T
+ * e) Assignment form translated to nomethod.
+ * assignshift==1, assign==T, method + 1 != off
+ * force_cpy == T
+ */
+ /* off is method, method+assignshift, or a result of opcode substitution.
+ * In the latter case assignshift==0, so only notfound case is important.
+ */
+ if (( (method + assignshift == off)
+ && (assign || (method == inc_amg) || (method == dec_amg)))
+ || force_cpy)
+ RvDEEPCP(left);
{
dSP;
BINOP myop;
@@ -1339,31 +1377,32 @@ int flags;
myop.op_next = Nullop;
myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED;
+ PUSHSTACKi(PERLSI_OVERLOAD);
ENTER;
- SAVESPTR(op);
- op = (OP *) &myop;
- if (PERLDB_SUB && curstash != debstash)
- op->op_private |= OPpENTERSUB_DB;
+ SAVEOP();
+ PL_op = (OP *) &myop;
+ if (PERLDB_SUB && PL_curstash != PL_debstash)
+ PL_op->op_private |= OPpENTERSUB_DB;
PUTBACK;
- pp_pushmark();
+ pp_pushmark(ARGS);
- EXTEND(sp, notfound + 5);
+ EXTEND(SP, notfound + 5);
PUSHs(lr>0? right: left);
PUSHs(lr>0? left: right);
- PUSHs( lr > 0 ? &sv_yes : ( assign ? &sv_undef : &sv_no ));
+ PUSHs( lr > 0 ? &PL_sv_yes : ( assign ? &PL_sv_undef : &PL_sv_no ));
if (notfound) {
PUSHs( sv_2mortal(newSVpv((char *)AMG_names[method + assignshift],0)) );
}
PUSHs((SV*)cv);
PUTBACK;
- if (op = pp_entersub())
- runops();
+ if (PL_op = pp_entersub(ARGS))
+ CALLRUNOPS();
LEAVE;
SPAGAIN;
res=POPs;
- PUTBACK;
+ POPSTACK;
CATCH_SET(oldcatch);
if (postpr) {
@@ -1405,3 +1444,4 @@ int flags;
}
}
#endif /* OVERLOAD */
+
diff --git a/gnu/usr.bin/perl/gv.h b/gnu/usr.bin/perl/gv.h
index 804007519e7..0226513b5ee 100644
--- a/gnu/usr.bin/perl/gv.h
+++ b/gnu/usr.bin/perl/gv.h
@@ -1,6 +1,6 @@
/* gv.h
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -127,6 +127,11 @@ HV *GvHVn();
#define DM_EGID 0x020
#define DM_DELAY 0x100
-#define GV_ADD 0x01
-#define GV_ADDMULTI 0x02
-#define GV_ADDWARN 0x04
+/*
+ * symbol creation flags, for use in gv_fetchpv() and perl_get_*v()
+ */
+#define GV_ADD 0x01 /* add, if symbol not already there */
+#define GV_ADDMULTI 0x02 /* add, pretending it has been added already */
+#define GV_ADDWARN 0x04 /* add, but warn if symbol wasn't already there */
+#define GV_ADDINEVAL 0x08 /* add, as though we're doing so within an eval */
+#define GV_NOINIT 0x10 /* add, but don't init symbol, if type != PVGV */
diff --git a/gnu/usr.bin/perl/handy.h b/gnu/usr.bin/perl/handy.h
index 379fab8b04e..7744c31e038 100644
--- a/gnu/usr.bin/perl/handy.h
+++ b/gnu/usr.bin/perl/handy.h
@@ -1,6 +1,6 @@
/* handy.h
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -65,7 +65,7 @@
#endif /* NeXT */
#ifndef HAS_BOOL
-# ifdef UTS
+# if defined(UTS) || defined(VMS)
# define bool int
# else
# define bool char
@@ -82,22 +82,27 @@
expecting an int), but the disadvantage that an I32 is not 32 bits.
Andy Dougherty August 1996
- In the future, we may perhaps want to think about something like
- #if INTSIZE == 4
- typedef I32 int;
- #else
- # if LONGSIZE == 4
- typedef I32 long;
- # else
- # if SHORTSIZE == 4
- typedef I32 short;
- # else
- typedef I32 int;
- # endif
- # endif
- #endif
- For the moment, these are mentioned here so metaconfig will
- construct Configure to figure out the various sizes.
+ There is no guarantee that there is *any* integral type with
+ exactly 32 bits. It is perfectly legal for a system to have
+ sizeof(short) == sizeof(int) == sizeof(long) == 8.
+
+ 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
+ SHORTSIZE == sizeof(short)
+ INTSIZE == sizeof(int)
+ LONGSIZE == sizeof(long)
+ LONGLONGSIZE == sizeof(long long) (if HAS_LONG_LONG)
+ PTRSIZE == sizeof(void *)
+ DOUBLESIZE == sizeof(double)
+ LONG_DOUBLESIZE == sizeof(long double) (if HAS_LONG_DOUBLE).
+ Most of these are currently unused, but they are mentioned here so
+ metaconfig will include the appropriate tests in Configure and
+ we can then start to consider how best to deal with long long
+ variables.
+ Andy Dougherty April 1998
*/
typedef char I8;
@@ -114,7 +119,7 @@ typedef unsigned short U16;
#define U16_MAX PERL_USHORT_MAX
#define U16_MIN PERL_USHORT_MIN
-#if BYTEORDER > 0x4321
+#if LONGSIZE > 4
typedef int I32;
typedef unsigned int U32;
# define I32_MAX PERL_INT_MAX
@@ -178,11 +183,20 @@ typedef unsigned short U16;
#define isSPACE(c) \
((c) == ' ' || (c) == '\t' || (c) == '\n' || (c) =='\r' || (c) == '\f')
#define isDIGIT(c) ((c) >= '0' && (c) <= '9')
-#define isUPPER(c) ((c) >= 'A' && (c) <= 'Z')
-#define isLOWER(c) ((c) >= 'a' && (c) <= 'z')
-#define isPRINT(c) (((c) > 32 && (c) < 127) || isSPACE(c))
-#define toUPPER(c) (isLOWER(c) ? (c) - ('a' - 'A') : (c))
-#define toLOWER(c) (isUPPER(c) ? (c) + ('a' - 'A') : (c))
+#ifdef EBCDIC
+ /* In EBCDIC we do not do locales: therefore() isupper() is fine. */
+# define isUPPER(c) isupper(c)
+# define isLOWER(c) islower(c)
+# define isPRINT(c) isprint(c)
+# define toUPPER(c) toupper(c)
+# define toLOWER(c) tolower(c)
+#else
+# define isUPPER(c) ((c) >= 'A' && (c) <= 'Z')
+# define isLOWER(c) ((c) >= 'a' && (c) <= 'z')
+# define isPRINT(c) (((c) > 32 && (c) < 127) || isSPACE(c))
+# define toUPPER(c) (isLOWER(c) ? (c) - ('a' - 'A') : (c))
+# define toLOWER(c) (isUPPER(c) ? (c) + ('a' - 'A') : (c))
+#endif
#ifdef USE_NEXT_CTYPE
@@ -233,8 +247,13 @@ typedef unsigned short U16;
# endif
#endif /* USE_NEXT_CTYPE */
-/* This conversion works both ways, strangely enough. */
-#define toCTRL(c) (toUPPER(c) ^ 64)
+#ifdef EBCDIC
+EXT int ebcdic_control _((int));
+# define toCTRL(c) ebcdic_control(c)
+#else
+ /* This conversion works both ways, strangely enough. */
+# define toCTRL(c) (toUPPER(c) ^ 64)
+#endif
/* Line numbers are unsigned, 16 bits. */
typedef U16 line_t;
@@ -244,7 +263,10 @@ typedef U16 line_t;
#define NOLINE ((line_t) 65535)
#endif
-/* XXX LEAKTEST doesn't really work in perl5. There are direct calls to
+
+/* This looks obsolete (IZ):
+
+ XXX LEAKTEST doesn't really work in perl5. There are direct calls to
safemalloc() in the source, so LEAKTEST won't pick them up.
Further, if you try LEAKTEST, you'll also end up calling
Safefree, which might call safexfree() on some things that weren't
@@ -255,6 +277,9 @@ typedef U16 line_t;
*/
#ifndef lint
+
+#define NEWSV(x,len) newSV(len)
+
#ifndef LEAKTEST
#define New(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n)*sizeof(t))))
@@ -266,7 +291,6 @@ typedef U16 line_t;
#define Renewc(v,n,t,c) \
(v = (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
#define Safefree(d) safefree((Malloc_t)(d))
-#define NEWSV(x,len) newSV(len)
#else /* LEAKTEST */
@@ -278,12 +302,15 @@ typedef U16 line_t;
(v = (t*)safexrealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
#define Renewc(v,n,t,c) \
(v = (c*)safexrealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
-#define Safefree(d) safexfree((Malloc_t)d)
-#define NEWSV(x,len) newSV(x,len)
+#define Safefree(d) safexfree((Malloc_t)(d))
#define MAXXCOUNT 1400
-long xcount[MAXXCOUNT];
-long lastxcount[MAXXCOUNT];
+#define MAXY_SIZE 80
+#define MAXYCOUNT 16 /* (MAXY_SIZE/4 + 1) */
+extern long xcount[MAXXCOUNT];
+extern long lastxcount[MAXXCOUNT];
+extern long xycount[MAXXCOUNT][MAXYCOUNT];
+extern long lastxycount[MAXXCOUNT][MAXYCOUNT];
#endif /* LEAKTEST */
diff --git a/gnu/usr.bin/perl/hints/README.hints b/gnu/usr.bin/perl/hints/README.hints
index 2c27068e385..e36bd6d1dd9 100644
--- a/gnu/usr.bin/perl/hints/README.hints
+++ b/gnu/usr.bin/perl/hints/README.hints
@@ -1,17 +1,24 @@
+=head1 NAME
+
+README.hints
+
+=head1 DESCRIPTION
+
These files are used by Configure to set things which Configure either
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. I would appreciate hearing about any problems
-or suggested changes.
+over from perl4.
+
+Please send any problems or suggested changes to perlbug@perl.com.
Hint file naming convention: Each hint file name should have only
-one '.'. (This is for portability to non-unix filesystems.) Names
+one '.'. (This is for portability to non-unix file systems.) Names
should also fit in <= 14 characters, for portability to older SVR3
systems. File names are of the form $osname_$osvers.sh, with all '.'
-changed to '_', and all characters such as '/' that don't belong in
+changed to '_', and all characters (such as '/') that don't belong in
Unix filenames omitted.
-For example, consider SunOS 4.1.3. Configure determines $osname=sunos
+For example, consider Sun OS 4.1.3. Configure determines $osname=sunos
(all names are converted to lower case) and $osvers=4.1.3. Configure
will search for an appropriate hint file in the following order:
@@ -22,18 +29,185 @@ will search for an appropriate hint file in the following order:
If you need to create a hint file, please try to use as general a name
as possible and include minor version differences inside case or test
-statements. Be sure also to include a default choice. (See
-aix.sh for one example.) That way, if you write a hint file for
-foonix 3.2, it might still work without any changes when foonix 3.3 is
-released.
+statements. For example, for IRIX 6.X, we have the following hints
+files:
+
+ irix_6_0.sh
+ irix_6_1.sh
+ irix_6.sh
+
+That is, 6.0 and 6.1 have their own special hints, but 6.2, 6.3, and
+up are all handled by the same irix_6.sh. That way, we don't have to
+make a new hint file every time the IRIX O/S is upgraded.
+
+If you need to test for specific minor version differences in your
+hints file, be sure to include a default choice. (See aix.sh for one
+example.) That way, if you write a hint file for foonix 3.2, it might
+still work without any changes when foonix 3.3 is released.
Please also comment carefully on why the different hints are needed.
That way, a future version of Configure may be able to automatically
-detect what is needed. A glossary of config.sh variables is in the
-file Porting/Glossary.
+detect what is needed.
+
+A glossary of config.sh variables is in the file Porting/Glossary.
+
+=head1 Hint file tricks
+
+=head2 Printing critical messages
+
+[This is still experimental]
+
+If you have a *REALLY* important message that the user ought to see at
+the end of the Configure run, you can store it in the file
+'config.msg'. At the end of the Configure run, Configure will display
+the contents of this file. Currently, the only place this is used is
+in Configure itself to warn about the need to set LD_LIBRARY_PATH if
+you are building a shared libperl.so.
+
+To use this feature, just do something like the following
+
+ $cat <<EOM | $tee -a ../config.msg >&4
+
+ This is a really important message. Be sure to read it
+ before you type 'make'.
+ EOM
+
+This message will appear on the screen as the hint file is being
+processed and again at the end of Configure.
+
+Please use this sparingly.
+
+=head2 Propagating variables to config.sh
+
+Sometimes, you want an extra variable to appear in config.sh. For
+example, if your system can't compile toke.c with the optimizer on,
+you can put
+
+ toke_cflags='optimize=""'
+
+at the beginning of a line in your hints file. Configure will then
+extract that variable and place it in your config.sh file. Later,
+while compiling toke.c, the cflags shell script will eval $toke_cflags
+and hence compile toke.c without optimization.
+
+Note that for this to work, the variable you want to propagate must
+appear in the first column of the hint file. It is extracted by
+Configure with a simple sed script, so beware that surrounding case
+statements aren't any help.
+
+By contrast, if you don't want Configure to propagate your temporary
+variable, simply indent it by a leading tab in your hint file.
+
+For example, prior to 5.002, a bug in scope.c led to perl crashing
+when compiled with -O in AIX 4.1.1. The following "obvious"
+workaround in hints/aix.sh wouldn't work as expected:
+
+ case "$osvers" in
+ 4.1.1)
+ scope_cflags='optimize=""'
+ ;;
+ esac
+
+because Configure doesn't parse the surrounding 'case' statement, it
+just blindly propagates any variable that starts in the first column.
+For this particular case, that's probably harmless anyway.
+
+Three possible fixes are:
+
+=over
+
+=item 1
+
+Create an aix_4_1_1.sh hint file that contains the scope_cflags
+line and then sources the regular aix hints file for the rest of
+the information.
+
+=item 2
+
+Do the following trick:
+
+ scope_cflags='case "$osvers" in 4.1*) optimize=" ";; esac'
+
+Now when $scope_cflags is eval'd by the cflags shell script, the
+case statement is executed. Of course writing scripts to be eval'd is
+tricky, especially if there is complex quoting. Or,
+
+=item 3
+
+Write directly to Configure's temporary file UU/config.sh.
+You can do this with
+
+ case "$osvers" in
+ 4.1.1)
+ echo "scope_cflags='optimize=\"\"'" >> UU/config.sh
+ scope_cflags='optimize=""'
+ ;;
+ esac
+
+Note you have to both write the definition to the temporary
+UU/config.sh file and set the variable to the appropriate value.
+
+This is sneaky, but it works. Still, if you need anything this
+complex, perhaps you should create the separate hint file for
+aix 4.1.1.
+
+=back
+
+=head2 Call-backs
+
+=over 4
+
+=item Warning
+
+All of the following is experimental and subject to change. But it
+probably won't change much. :-)
+
+=item Compiler-related flags
+
+The settings of some things, such as optimization flags, may depend on
+the particular compiler used. For example, for ISC we have the
+following:
+
+ case "$cc" in
+ *gcc*) ccflags="$ccflags -posix"
+ ldflags="$ldflags -posix"
+ ;;
+ *) ccflags="$ccflags -Xp -D_POSIX_SOURCE"
+ ldflags="$ldflags -Xp"
+ ;;
+ esac
+
+However, the hints file is processed before the user is asked which
+compiler should be used. Thus in order for these hints to be useful,
+the user must specify sh Configure -Dcc=gcc on the command line, as
+advised by the INSTALL file.
+
+For versions of perl later than 5.004_61, this problem can
+be circumvented by the use of "call-back units". That is, the hints
+file can tuck this information away into a file UU/cc.cbu. Then,
+after Configure prompts the user for the C compiler, it will load in
+and run the UU/cc.cbu "call-back" unit. See hints/solaris_2.sh for an
+example.
+
+=item Threading-related flags
+
+Similarly, after Configure prompts the user about whether or not to
+compile Perl with threads, it will look for a "call-back" unit
+usethreads.cbu. See hints/linux.sh for an example.
+
+=item Future status
+
+I hope this "call-back" scheme is simple enough to use but powerful
+enough to deal with most situations. Still, there are certainly cases
+where it's not enough. For example, for aix we actually change
+compilers if we are using threads.
+
+I'd appreciate feedback on whether this is sufficiently general to be
+helpful, or whether we ought to simply continue to require folks to
+say things like "sh Configure -Dcc=gcc -Dusethreads" on the command line.
+
+=back
Have the appropriate amount of fun :-)
Andy Dougherty doughera@lafcol.lafayette.edu
- Dept. of Physics
- Lafayette College, Easton PA 18042
diff --git a/gnu/usr.bin/perl/hints/aix.sh b/gnu/usr.bin/perl/hints/aix.sh
index 2c42151ea61..d2c45c0a590 100644
--- a/gnu/usr.bin/perl/hints/aix.sh
+++ b/gnu/usr.bin/perl/hints/aix.sh
@@ -1,6 +1,8 @@
# hints/aix.sh
# AIX 3.x.x hints thanks to Wayne Scott <wscott@ichips.intel.com>
# AIX 4.1 hints thanks to Christopher Chan-Nui <channui@austin.ibm.com>.
+# AIX 4.1 pthreading by Christopher Chan-Nui <channui@austin.ibm.com> and
+# Jarkko Hietaniemi <jhi@iki.fi>.
# Merged on Mon Feb 6 10:22:35 EST 1995 by
# Andy Dougherty <doughera@lafcol.lafayette.edu>
@@ -17,6 +19,10 @@ alignbytes=8
usemymalloc='n'
+# Intuiting the existence of system calls under AIX is difficult,
+# at best; the safest technique is to find them empirically.
+usenm='undef'
+
so="a"
dlext="so"
@@ -30,13 +36,13 @@ esac
case "$osvers" in
3*) d_fchmod=undef
- ccflags='-D_ALL_SOURCE'
+ ccflags="$ccflags -D_ALL_SOURCE"
;;
*) # These hints at least work for 4.x, possibly other systems too.
- ccflags='-D_ALL_SOURCE -D_ANSI_C_SOURCE -D_POSIX_SOURCE'
+ ccflags="$ccflags -D_ALL_SOURCE -D_ANSI_C_SOURCE -D_POSIX_SOURCE"
case "$cc" in
*gcc*) ;;
- *) ccflags="-qmaxmem=8192 $ccflags" ;;
+ *) ccflags="$ccflags -qmaxmem=8192" ;;
esac
nm_opt='-B'
;;
@@ -46,12 +52,6 @@ esac
d_setregid='undef'
d_setreuid='undef'
-# The optimizer in 4.1.1 apparently generates bad code for scope.c.
-# Configure doesn't offer an easy way to propagate extra variables
-# only for certain cases, so the following contortion is required:
-# This is probably not needed in 5.002 and later.
-# scope_cflags='case "$osvers" in 4.1*) optimize=" ";; esac'
-
# Changes for dynamic linking by Wayne Scott <wscott@ichips.intel.com>
#
# Tell perl which symbols to export for dynamic linking.
@@ -67,10 +67,51 @@ esac
# symbol: boot_$(EXP) can it be auto-generated?
case "$osvers" in
3*)
-lddlflags='-H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -e _nostart -lc'
+ lddlflags='-H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -e _nostart -lc'
;;
*)
-lddlflags='-H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -b noentry -lc'
+ lddlflags='-bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -b noentry -lc'
+ ;;
+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]*)
+ ccflags="$ccflags -DNEED_PTHREAD_INIT"
+ case "$cc" in
+ cc_r) ;;
+ cc|xlc_r)
+ echo >&4 "Switching cc to cc_r because of POSIX threads."
+ # xlc_r has been known to produce buggy code in AIX 4.3.2.
+ # (e.g. pragma/overload core dumps)
+ # --jhi@iki.fi
+ cc=cc_r
+ ;;
+ '')
+ cc=cc_r
+ ;;
+ *)
+ cat >&4 <<EOM
+For pthreads you should use the AIX C compiler cc_r.
+(now your compiler was '$cc')
+Cannot continue, aborting.
+EOM
+ exit 1
+ ;;
+ esac
+
+ # Add the POSIX threads library and the re-entrant libc.
+
+ lddlflags=`echo $lddlflags | sed 's/ -lc$/ -lpthreads -lc_r -lc/'`
-;;
+ # Add the c_r library to the list of wanted libraries.
+ # Make sure the c_r library is before the c library or
+ # make will fail.
+ set `echo X "$libswanted "| sed -e 's/ c / c_r c /'`
+ shift
+ libswanted="$*"
+ ;;
esac
+EOCBU
diff --git a/gnu/usr.bin/perl/hints/amigaos.sh b/gnu/usr.bin/perl/hints/amigaos.sh
index e7686436913..9d86e52bc03 100644
--- a/gnu/usr.bin/perl/hints/amigaos.sh
+++ b/gnu/usr.bin/perl/hints/amigaos.sh
@@ -42,10 +42,6 @@ lddlflags='-oformat a.out-amiga -r'
# ccflags='-DAMIGAOS -mstackextend -m68020 -resident32'
# ldflags='-m68020 -resident32'
-# Avoid telldir prototype conflict in pp_sys.c (AmigaOS uses const DIR *)
-# Configure should test for this. Volunteers?
-pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"'
-
# AmigaOS always reports only two links to directories, even if they
# contain subdirectories. Consequently, we use this variable to stop
# File::Find using the link count to determine whether there are
diff --git a/gnu/usr.bin/perl/hints/apollo.sh b/gnu/usr.bin/perl/hints/apollo.sh
index 8c361aa0518..05f433dfc11 100644
--- a/gnu/usr.bin/perl/hints/apollo.sh
+++ b/gnu/usr.bin/perl/hints/apollo.sh
@@ -1,13 +1,17 @@
# Info from Johann Klasek <jk@auto.tuwien.ac.at>
# Merged by Andy Dougherty <doughera@lafcol.lafayette.edu>
-# Last revised Fri Jun 2 11:21:27 EDT 1995
+# Last revised Tue Mar 16 19:12:22 EET 1999 by
+# Jarkko Hietaniemi <jhi@iki.fi>
# uname -a looks like
# DomainOS newton 10.4.1 bsd4.3 425t
# We want to use both BSD includes and some of the features from the
# /sys5 includes.
-ccflags="$ccflags -A cpu,mathchip -I/usr/include -I/sys5/usr/include"
+ccflags="$ccflags -A cpu,mathchip -I`pwd`/apollo -I/usr/include -I/sys5/usr/include"
+
+# When Apollo runs a script with "#!", it sets argv[0] to the script name.
+toke_cflags='ccflags="$ccflags -DARG_ZERO_IS_SCRIPT"'
# These adjustments are necessary (why?) to compile malloc.c.
freetype='void'
diff --git a/gnu/usr.bin/perl/hints/bsdos.sh b/gnu/usr.bin/perl/hints/bsdos.sh
index 53adfa3b501..c54a0c1606b 100644
--- a/gnu/usr.bin/perl/hints/bsdos.sh
+++ b/gnu/usr.bin/perl/hints/bsdos.sh
@@ -3,7 +3,7 @@
# hints file for BSD/OS (adapted from bsd386.sh)
# Original by Neil Bowers <neilb@khoros.unm.edu>; Tue Oct 4 12:01:34 EDT 1994
# Updated by Tony Sanders <sanders@bsdi.com>; Sat Aug 23 12:47:45 MDT 1997
-# Added 3.1 with ELF dynamic libraries
+# Added 3.1 with ELF dynamic libraries (NOT in 3.1 yet. Estimated for 4.0)
# SYSV IPC tested Ok so I re-enabled.
#
# To override the compiler on the command line:
@@ -33,9 +33,6 @@ libswanted="$*"
glibpth="$glibpth /usr/X11/lib"
ldflags="$ldflags -L/usr/X11/lib"
-# Avoid telldir prototype conflict in pp_sys.c
-pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"'
-
case "$optimize" in
'') optimize='-O2' ;;
esac
@@ -69,7 +66,7 @@ case "$osvers" in
'') cc='gcc2' ;;
esac
;;
-2.0*|2.1*|3.0*)
+2.0*|2.1*|3.0*|3.1*)
so='o'
# default to GCC 2.X w/shared libraries
@@ -88,14 +85,14 @@ case "$osvers" in
libswanted="Xpm Xaw Xmu Xt SM ICE Xext X11 $libswanted"
libswanted="rpc curses termcap $libswanted"
;;
-3.1*)
- # ELF dynamic link libraries starting in 3.1
+4.0*)
+ # ELF dynamic link libraries starting in 4.0 (???)
useshrplib='true'
so='so'
dlext='so'
case "$cc" in
- '') cc='cc' # cc is gcc2 in 3.1
+ '') cc='cc' # cc is gcc2 in 4.0
cccdlflags="-fPIC"
ccdlflags=" " ;;
esac
diff --git a/gnu/usr.bin/perl/hints/dec_osf.sh b/gnu/usr.bin/perl/hints/dec_osf.sh
index 255505b087f..8758cbb8207 100644
--- a/gnu/usr.bin/perl/hints/dec_osf.sh
+++ b/gnu/usr.bin/perl/hints/dec_osf.sh
@@ -102,7 +102,9 @@ case "$optimize" in
*gcc*)
optimize='-O3' ;;
*) case "$_DEC_cc_style" in
- new) optimize='-O4' ;;
+ new) optimize='-O4'
+ ccflags="$ccflags -fprm d -ieee"
+ ;;
old) optimize='-O2 -Olimit 3200' ;;
esac
ccflags="$ccflags -D_INTRINSICS"
@@ -111,6 +113,17 @@ case "$optimize" in
;;
esac
+# Make glibpth agree with the compiler suite. Note that /shlib
+# is not here. That's on purpose. Even though that's where libc
+# really lives from V4.0 on, the linker (and /sbin/loader) won't
+# look there by default. The sharable /sbin utilities were all
+# built with "-Wl,-rpath,/shlib" to get around that. This makes
+# no attempt to figure out the additional location(s) searched by
+# gcc, since not all versions of gcc are easily coerced into
+# revealing that information.
+glibpth="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc"
+glibpth="$glibpth /usr/lib /usr/local/lib /var/shlib"
+
# dlopen() is in libc
libswanted="`echo $libswanted | sed -e 's/ dl / /'`"
@@ -165,6 +178,38 @@ case "$optimize" in
esac
#
+# Make embedding in things like INN and Apache more memory friendly.
+# Keep it overridable on the Configure command line, though, so that
+# "-Uuseshrplib" prevents this default.
+#
+
+case "$_DEC_cc_style.$useshrplib" in
+ new.) useshrplib="$define" ;;
+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]*)
+ # Threads interfaces changed with V4.0.
+ case "`uname -r`" in
+ *[123].*)
+ libswanted="$libswanted pthreads mach exc c_r"
+ ccflags="-threads $ccflags"
+ ;;
+ *)
+ libswanted="$libswanted pthread exc"
+ ccflags="-pthread $ccflags"
+ ;;
+ esac
+
+ usemymalloc='n'
+ ;;
+esac
+EOCBU
+
+#
# Unset temporary variables no more needed.
#
@@ -174,6 +219,22 @@ unset _DEC_uname_r
#
# History:
#
+# perl5.004_57:
+#
+# 19-Dec-1997 Spider Boardman <spider@Orb.Nashua.NH.US>
+#
+# * Newer Digital UNIX compilers enforce signaling for NaN without
+# -ieee. Added -fprm d at the same time since it's friendlier for
+# embedding.
+#
+# * Fixed the library search path to match cc, ld, and /sbin/loader.
+#
+# * Default to building -Duseshrplib on newer systems. -Uuseshrplib
+# still overrides.
+#
+# * Fix -pthread additions for useshrplib. ld has no -pthread option.
+#
+#
# perl5.004_04:
#
# 19-Sep-1997 Spider Boardman <spider@Orb.Nashua.NH.US>
diff --git a/gnu/usr.bin/perl/hints/dynixptx.sh b/gnu/usr.bin/perl/hints/dynixptx.sh
index 78a45e42a31..2edf0263053 100644
--- a/gnu/usr.bin/perl/hints/dynixptx.sh
+++ b/gnu/usr.bin/perl/hints/dynixptx.sh
@@ -1,5 +1,9 @@
# Sequent Dynix/Ptx v. 4 hints
# Created 1996/03/15 by Brad Howerter, bhower@wgc.woodward.com
+
+# Modified 1998/11/10 by Martin J. Bligh, mbligh@sequent.com
+# to incorporate work done by Kurtis D. Rader & myself.
+
# Use Configure -Dcc=gcc to use gcc.
# cc wants -G for dynamic loading
@@ -15,10 +19,41 @@ libswanted=`echo $libswanted | sed -e 's/ inet / /'`
# Configure defaults to usenm='y', which doesn't work very well
usenm='n'
-# Reported by bruce@aps.org ("Bruce P. Schuck") as needed for
-# DYNIX/ptx 4.0 V4.2.1 to get socket i/o to work
-# Not defined by default in case they break other versions.
-# These probably need to be worked into a piece of code that
-# checks for the need for this setting.
-# cppflags='-Wc,+abi-socket -I/usr/local/include'
-# ccflags='-Wc,+abi-socket -I/usr/local/include'
+# for performance, apparently this makes a huge difference (~krader)
+
+d_vfork='define'
+optimize='-Wc,-O3 -W0,-xstring'
+
+# We override d_socket because it's very hard for Configure to get it right
+# in Dynix/Ptx, for several reasons.
+# (1) the socket interface is in libsocket.so -- this wouldn't be so hard
+# for Configure to fathom...but it gets more tangled.
+# (2) if the system has been patched there can be libsocket.so.1.FOO.BAR,
+# the FOO.BAR being the old version of the system before the patching.
+# Configure picks up the old broken version.
+# (3) libsocket.so points to either libsocket.so.1 (v4.2)
+# or libsocket.so.1.1 (v4.4) The socket call in libsocket.so.1.1
+# (BSD socket library) is called bsd_socket(), and has a macro wrapper
+# to hide this.
+# This information kindly provided by Martin J. Bligh of Sequent.
+# As he puts it:
+# "Sequent has unusual capabilities, taking it above and beyond
+# the complexity of any other vendor" :-)
+#
+# Jarkko Hietaniemi November 1998
+
+case "$osvers" in
+4.4*) # configure doesn't find sockets, as they're in libsocket, not libc
+ d_socket='define'
+ d_oldsock='undef'
+ d_sockpair='define'
+ ;;
+4.2*) # on ptx/TCP 4.2, we can use BSD sockets, but they're not the default.
+ cppflags='-Wc,+bsd-socket'
+ ccflags='-Wc,+bsd-socket'
+ ldflags='-Wc,+bsd-socket'
+ d_socket='define'
+ d_oldsock='undef'
+ d_sockpair='define'
+ ;;
+esac
diff --git a/gnu/usr.bin/perl/hints/freebsd.sh b/gnu/usr.bin/perl/hints/freebsd.sh
index 6ce5fa720c7..66f6ca02bfc 100644
--- a/gnu/usr.bin/perl/hints/freebsd.sh
+++ b/gnu/usr.bin/perl/hints/freebsd.sh
@@ -17,7 +17,16 @@
# Additional 2.2 defines from
# Mark Murray <mark@grondar.za>
# Date: Wed, 6 Nov 1996 09:44:58 +0200 (MET)
-#
+#
+# Modified to ensure we replace -lc with -lc_r, and
+# to put in place-holders for various specific hints.
+# Andy Dougherty <doughera@lafcol.lafayette.edu>
+# Date: Tue Mar 10 16:07:00 EST 1998
+#
+# Support for FreeBSD/ELF
+# Ollivier Robert <roberto@keltia.freenix.fr>
+# Date: Wed Sep 2 16:22:12 CEST 1998
+#
# The two flags "-fpic -DPIC" are used to indicate a
# will-be-shared object. Configure will guess the -fpic, (and the
# -DPIC is not used by perl proper) but the full define is included to
@@ -89,15 +98,29 @@ esac
# out here to avoid duplicating them everywhere.
case "$osvers" in
0.*|1.0*) ;;
+
+3.*|4.0*)
+ objformat=`/usr/bin/objformat`
+ if [ x$objformat = xelf ]; then
+ libpth="/usr/lib /usr/local/lib"
+ glibpth="/usr/lib /usr/local/lib"
+ ldflags="-Wl,-E "
+ lddlflags="-shared "
+ else
+ if [ -e /usr/lib/aout ]; then
+ libpth="/usr/lib/aout /usr/local/lib /usr/lib"
+ glibpth="/usr/lib/aout /usr/local/lib /usr/lib"
+ fi
+ lddlflags='-Bshareable'
+ fi
+ cccdlflags='-DPIC -fpic'
+ ;;
+
*) cccdlflags='-DPIC -fpic'
lddlflags="-Bshareable $lddlflags"
;;
esac
-# Avoid telldir prototype conflict in pp_sys.c (FreeBSD uses const DIR *)
-# Configure should test for this. Volunteers?
-pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"'
-
cat <<'EOM' >&4
Some users have reported that Configure halts when testing for
@@ -108,3 +131,91 @@ problem. Try
EOM
+# From: Anton Berezin <tobez@plab.ku.dk>
+# To: perl5-porters@perl.org
+# Subject: [PATCH 5.005_54] Configure - hints/freebsd.sh signal handler type
+# Date: 30 Nov 1998 19:46:24 +0100
+# Message-ID: <864srhhvcv.fsf@lion.plab.ku.dk>
+
+signal_t='void'
+d_voidsig='define'
+
+# set libperl.so.X.X for 2.2.X
+case "$osvers" in
+2.2*)
+ # unfortunately this code gets executed before
+ # the equivalent in the main Configure so we copy a little
+ # from Configure XXX Configure should be fixed.
+ if $test -r $src/patchlevel.h;then
+ patchlevel=`awk '/define[ ]+PATCHLEVEL/ {print $3}' $src/patchlevel.h`
+ subversion=`awk '/define[ ]+SUBVERSION/ {print $3}' $src/patchlevel.h`
+ else
+ patchlevel=0
+ subversion=0
+ fi
+ libperl="libperl.so.$patchlevel.$subversion"
+ unset patchlevel
+ unset subversion
+ ;;
+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]*)
+ lc_r=`/sbin/ldconfig -r|grep ':-lc_r'|awk '{print $NF}'`
+ case "$osvers" in
+ 2.2.8*|3.*|4.*)
+ if [ ! -r "$lc_r" ]; then
+ cat <<EOM >&4
+POSIX threads should be supported by FreeBSD $osvers --
+but your system is missing the shared libc_r.
+(/sbin/ldconfig -r doesn't find any).
+
+Consider using the latest STABLE release.
+EOM
+ exit 1
+ fi
+ ldflags="-pthread $ldflags"
+ ;;
+ 2.2*)
+ cat <<EOM >&4
+POSIX threads are not supported well by FreeBSD $osvers.
+
+Please consider upgrading to at least FreeBSD 2.2.8,
+or preferably to 3.something.
+
+(While 2.2.7 does have pthreads, it has some problems
+ with the combination of threads and pipes and therefore
+ many Perl tests will either hang or fail.)
+EOM
+ exit 1
+ ;;
+ *) cat <<EOM >&4
+I did not know that FreeBSD $osvers supports POSIX threads.
+
+Feel free to tell perlbug@perl.com otherwise.
+EOM
+ exit 1
+ ;;
+ esac
+
+ set `echo X "$libswanted "| sed -e 's/ c / c_r /'`
+ shift
+ libswanted="$*"
+ # Configure will probably pick the wrong libc to use for nm scan.
+ # The safest quick-fix is just to not use nm at all...
+ usenm=false
+
+ case "$osvers" in
+ 2.2.8*)
+ # ... but this does not apply for 2.2.8 - we know it's safe
+ libc="$lc_r"
+ usenm=true
+ ;;
+ esac
+
+ unset lc_r
+esac
+EOCBU
diff --git a/gnu/usr.bin/perl/hints/hpux.sh b/gnu/usr.bin/perl/hints/hpux.sh
index c2500d0c370..8a9e3cb25d2 100644
--- a/gnu/usr.bin/perl/hints/hpux.sh
+++ b/gnu/usr.bin/perl/hints/hpux.sh
@@ -20,6 +20,7 @@
# Distinguish between MC68020, MC68030, MC68040
# Don't assume every OS != 10 is < 10, (e.g., 11).
# From: Chuck Phillips <cdp@fc.hp.com>
+# HP-UX 10 pthreads hints: Matthew T Harden <mthard@mthard1.monsanto.com>
# This version: August 15, 1997
# Current maintainer: Jeff Okamoto <okamoto@corp.hp.com>
@@ -43,8 +44,10 @@
# "ext.libs" file which is *probably* messing up the order. Often,
# you can replace ext.libs with an empty file to fix the problem.
#
-# If you get a message about "too much defining", you might have to
-# add the following to your ccflags: '-Wp,-H256000'
+# If you get a message about "too much defining", as may happen
+# in HPUX < 10, you might have to append a single entry to your
+# ccflags: '-Wp,-H256000'
+# NOTE: This is a single entry (-W takes the argument 'p,-H256000').
#--------------------------------------------------------------------
# Turn on the _HPUX_SOURCE flag to get many of the HP add-ons
@@ -60,10 +63,6 @@
# reading from a NULL pointer causes a SEGV.
ccflags="$ccflags -D_HPUX_SOURCE"
-# If you plan to use gcc, then you should uncomment the following line
-# so you get the HP math library and not the GCC math library.
-# ccflags="$ccflags -L/lib/pa1.1"
-
# Check if you're using the bundled C compiler. This compiler doesn't support
# ANSI C (the -Aa flag) nor can it produce shared libraries. Thus we have
# to turn off dynamic loading.
@@ -82,6 +81,16 @@ EOM
esac
else
ccflags="$ccflags -Aa" # The add-on compiler supports ANSI C
+ # cppstdin and cpprun need the -Aa option if you use the unbundled
+ # ANSI C compiler (*not* the bundled K&R compiler or gcc)
+ # [XXX this should be set automatically by Configure, but isn't yet.]
+ # [XXX This is reported not to work. You may have to edit config.sh.
+ # After running Configure, set cpprun and cppstdin in config.sh,
+ # run "Configure -S" and then "make".]
+ cpprun="${cc:-cc} -E -Aa"
+ cppstdin="$cpprun"
+ cppminus='-'
+ cpplast='-'
fi
# For HP's ANSI C compiler, up to "+O3" is safe for everything
# except shared libraries (PIC code). Max safe for PIC is "+O2".
@@ -92,6 +101,12 @@ EOM
;;
esac
+# Even if you use gcc, prefer the HP math library over the GNU one.
+
+case "`$cc -v 2>&1`" in
+"*gcc*" ) test -d /lib/pa1.1 && ccflags="$ccflags -L/lib/pa1.1" ;;
+esac
+
# Determine the architecture type of this system.
# Keep leading tab below -- Configure Black Magic -- RAM, 03/02/97
xxOsRevMajor=`uname -r | sed -e 's/^[^0-9]*//' | cut -d. -f1`;
@@ -124,6 +139,60 @@ else
selecttype='int *'
fi
+# 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]*)
+ if [ "$xxOsRevMajor" -lt 10 ]; then
+ cat <<EOM >&4
+HP-UX $xxOsRevMajor cannot support POSIX threads.
+Consider upgrading to at least HP-UX 11.
+Cannot continue, aborting.
+EOM
+ exit 1
+ fi
+ case "$xxOsRevMajor" in
+ 10)
+ # Under 10.X, a threaded perl can be built, but it needs
+ # libcma and OLD_PTHREADS_API. Also <pthread.h> needs to
+ # be #included before any other includes (in perl.h)
+ if [ ! -f /usr/include/pthread.h -o ! -f /usr/lib/libcma.sl ]; then
+ cat <<EOM >&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.
+Cannot continue, aborting.
+EOM
+ exit 1
+ 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 <pthread.h> 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"
+ set `echo X "$libswanted "| sed -e 's/ c / pthread c /'`
+ shift
+ libswanted="$*"
+ ;;
+ esac
+ usemymalloc='n'
+ ;;
+esac
+EOCBU
# Remove bad libraries that will cause problems
# (This doesn't remove libraries that don't actually exist)
@@ -167,6 +236,11 @@ case "$prefix" in
'') prefix='/opt/perl5' ;;
esac
+# HP-UX can't do setuid emulation offered by Configure
+case "$d_dosuid" in
+'') d_dosuid="$undef" ;;
+esac
+
# Date: Fri, 6 Sep 96 23:15:31 CDT
# From: "Daniel S. Lewart" <d-lewart@uiuc.edu>
# I looked through the gcc.info and found this:
diff --git a/gnu/usr.bin/perl/hints/irix_4.sh b/gnu/usr.bin/perl/hints/irix_4.sh
index f5883f38cb7..8013c8a1f49 100644
--- a/gnu/usr.bin/perl/hints/irix_4.sh
+++ b/gnu/usr.bin/perl/hints/irix_4.sh
@@ -22,3 +22,14 @@ If you have problems, you might have try including
-DSTANDARD_C -cckr
in ccflags.
EOM
+
+case "$usethreads" in
+$define|true|[yY]*)
+ cat >&4 <<EOM
+IRIX `uname -r` does not support POSIX threads.
+You should upgrade to at least IRIX 6.2 with pthread patches.
+EOM
+ exit 1
+ ;;
+esac
+
diff --git a/gnu/usr.bin/perl/hints/irix_5.sh b/gnu/usr.bin/perl/hints/irix_5.sh
index e4d03473281..757ffff3847 100644
--- a/gnu/usr.bin/perl/hints/irix_5.sh
+++ b/gnu/usr.bin/perl/hints/irix_5.sh
@@ -12,7 +12,7 @@ i_time='define'
case "$cc" in
*gcc*) ccflags="$ccflags -D_BSD_TYPES" ;;
-*) ccflags="$ccflags -D_POSIX_SOURCE -ansiposix -D_BSD_TYPES -Olimit 3000" ;;
+*) ccflags="$ccflags -D_POSIX_SOURCE -ansiposix -D_BSD_TYPES -Olimit 4000" ;;
esac
lddlflags="-shared"
@@ -32,3 +32,14 @@ libswanted="$*"
# patchSG0000596. The patch can be downloaded from Advantage OnLine (SGI's
# WWW server) or from the Support Advantage 9/95 Patch CDROM. Thanks to Tom
# Christiansen and others who provided assistance.
+
+case "$usethreads" in
+$define|true|[yY]*)
+ cat >&4 <<EOM
+IRIX `uname -r` does not support POSIX threads.
+You should upgrade to at least IRIX 6.2 with pthread patches.
+EOM
+ exit 1
+ ;;
+esac
+
diff --git a/gnu/usr.bin/perl/hints/irix_6.sh b/gnu/usr.bin/perl/hints/irix_6.sh
index 795b6ab640d..3250fc7d4a8 100644
--- a/gnu/usr.bin/perl/hints/irix_6.sh
+++ b/gnu/usr.bin/perl/hints/irix_6.sh
@@ -20,6 +20,11 @@
# Tweaked by Chip Salzenberg <chip@perl.com> on 5/13/97
# - don't assume 'cc -n32' if the n32 libm.so is missing
+# Threaded by Jarkko Hietaniemi <jhi@iki.fi> on 11/18/97
+# - POSIX threads knowledge by IRIX version
+
+# gcc-enabled by Kurt Starsinic <kstar@isinet.com> on 3/24/1998
+
# Use sh Configure -Dcc='cc -n32' to try compiling with -n32.
# or -Dcc='cc -n32 -mips3' (or -mips4) to force (non)portability
# Don't bother with -n32 unless you have the 7.1 or later compilers.
@@ -40,28 +45,65 @@ esac
case "$cc" in
*"cc -n32"*)
+ # Perl 5.004_57 introduced new qsort code into pp_ctl.c that
+ # makes IRIX cc prior to 7.2.1 to emit bad code.
+ # so some serious hackery follows to set pp_ctl flags correctly.
+
# Check for which version of the compiler we're running
case "`$cc -version 2>&1`" in
*7.0*) # Mongoose 7.0
ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1042,1048,1110,1116,1184 -OPT:Olimit=0"
- optimize='none'
+ optimize='none'
;;
- *7.*) # Mongoose 7.1+
+ *7.1*|*7.2|*7.20) # Mongoose 7.1+
ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0"
- optimize='-O3'
+ optimize='-O3'
+# This is a temporary fix for 5.005.
+# Leave pp_ctl_cflags line at left margin for Configure. See
+# hints/README.hints, especially the section
+# =head2 Propagating variables to config.sh
+pp_ctl_cflags='optimize=-O'
+ ;;
+ *7.*) # Mongoose 7.2.1+
+ ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0:space=ON"
+ optimize='-O3'
;;
*6.2*) # Ragnarok 6.2
ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184"
- optimize='none'
+ optimize='none'
;;
*) # Be safe and not optimize
- ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0"
+ ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0"
optimize='none'
;;
esac
- ld=ld
- ldflags=' -L/usr/local/lib -L/usr/lib32 -L/lib32'
+# this is to accommodate the 'modules' capability of the
+# 7.2 MIPSPro compilers, which allows for the compilers to be installed
+# in a nondefault location. Almost everything works as expected, but
+# /usr/include isn't caught properly. Hence see the /usr/include/pthread.h
+# change below to include TOOLROOT (a modules environment variable),
+# and the following code. Additional
+# code to accommodate the 'modules' environment should probably be added
+# here if possible, or be inserted as a ${TOOLROOT} reference before
+# absolute paths (again, see the pthread.h change below).
+# -- krishna@sgi.com, 8/23/98
+
+if [ "X${TOOLROOT}" != "X" ]; then
+# we cant set cppflags because it gets overwritten
+# we dont actually need $TOOLROOT/usr/include on the cc line cuz the
+# modules functionality already includes it but
+# XXX - how do I change cppflags in the hints file?
+ ccflags="$ccflags -I${TOOLROOT}/usr/include"
+ usrinc="${TOOLROOT}/usr/include"
+fi
+
+ ld=$cc
+ # perl's malloc can return improperly aligned buffer
+ # usemymalloc='undef'
+malloc_cflags='ccflags="-DSTRICT_ALIGNMENT $ccflags"'
+ # NOTE: -L/usr/lib32 -L/lib32 are automatically selected by the linker
+ ldflags=' -L/usr/local/lib32 -L/usr/local/lib'
cccdlflags=' '
# From: David Billinghurst <David.Billinghurst@riotinto.com.au>
# If you get complaints about so_locations then change the following
@@ -73,6 +115,11 @@ case "$cc" in
nm_opt='-p'
nm_so_opt='-p'
;;
+*gcc*)
+ ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -D_POSIX_C_SOURCE"
+ optimize="-O3"
+ usenm='undef'
+ ;;
*)
# this is needed to force the old-32 paths
# since the system default can be changed.
@@ -81,10 +128,9 @@ case "$cc" in
;;
esac
-# This should be a Configure thing, but not for now...
-pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"'
-
-# We don't want these libraries. Anyone know why?
+# We don't want these libraries.
+# Socket networking is in libc, these are not installed by default,
+# and just slow perl down. (scotth@sgi.com)
set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ nsl / /' -e 's/ dl / /'`
shift
libswanted="$*"
@@ -107,8 +153,59 @@ libswanted="$*"
# you need is in libc. You do also need '-lbsd' if you choose not
# to use the -D_BSD_* defines. Note that as of 6.2 the only
# difference between '-lmalloc' and '-lc' malloc is the debugging
-# and control calls. -- scotth@sgi.com
+# and control calls, which aren't used by perl. -- scotth@sgi.com
-set `echo X "$libswanted "|sed -e 's/ sun / /' -e 's/ crypt / /' -e 's/ bsd / /' -e 's/ PW / /'`
+set `echo X "$libswanted "|sed -e 's/ sun / /' -e 's/ crypt / /' -e 's/ bsd / /' -e 's/ PW / /' -e 's/ malloc / /'`
shift
libswanted="$*"
+
+# 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]*)
+ if test ! -f ${TOOLROOT}/usr/include/pthread.h -o ! -f /usr/lib/libpthread.so; then
+ case "`uname -r`" in
+ [1-5].*|6.[01])
+ cat >&4 <<EOM
+IRIX `uname -r` does not support POSIX threads.
+You should upgrade to at least IRIX 6.2 with pthread patches.
+EOM
+ ;;
+ 6.2)
+ cat >&4 <<EOM
+IRIX 6.2 can have the POSIX threads.
+However, the following IRIX patches (or their replacements) MUST be installed:
+ 1404 Irix 6.2 Posix 1003.1b man pages
+ 1645 IRIX 6.2 & 6.3 POSIX header file updates
+ 2000 Irix 6.2 Posix 1003.1b support modules
+ 2254 Pthread library fixes
+ 2401 6.2 all platform kernel rollup
+IMPORTANT:
+ Without patch 2401, a kernel bug in IRIX 6.2 will
+ cause your machine to panic and crash when running
+ threaded perl. IRIX 6.3 and up should be OK.
+EOM
+ ;;
+ [67].*)
+ cat >&4 <<EOM
+IRIX `uname -r` should have the POSIX threads.
+But, somehow, you do not seem to have them installed.
+EOM
+ ;;
+ esac
+ cat >&4 <<EOM
+Cannot continue, aborting.
+EOM
+ exit 1
+ fi
+ set `echo X "$libswanted "| sed -e 's/ c / pthread /'`
+ ld="${cc:-cc}"
+ shift
+ libswanted="$*"
+
+ usemymalloc='n'
+ ;;
+esac
+EOCBU
+
diff --git a/gnu/usr.bin/perl/hints/irix_6_0.sh b/gnu/usr.bin/perl/hints/irix_6_0.sh
index 38fe27d282c..e61db0460fc 100644
--- a/gnu/usr.bin/perl/hints/irix_6_0.sh
+++ b/gnu/usr.bin/perl/hints/irix_6_0.sh
@@ -41,3 +41,14 @@ libswanted="$*"
# set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ sun / /' -e 's/ crypt / /' -e 's/ nsl / /' -e 's/ dl / /'`
# shift
# libswanted="$*"
+
+case "$usethreads" in
+$define|true|[yY]*)
+ cat >&4 <<EOM
+IRIX `uname -r` does not support POSIX threads.
+You should upgrade to at least IRIX 6.2 with pthread patches.
+EOM
+ exit 1
+ ;;
+esac
+
diff --git a/gnu/usr.bin/perl/hints/irix_6_1.sh b/gnu/usr.bin/perl/hints/irix_6_1.sh
index 38fe27d282c..e61db0460fc 100644
--- a/gnu/usr.bin/perl/hints/irix_6_1.sh
+++ b/gnu/usr.bin/perl/hints/irix_6_1.sh
@@ -41,3 +41,14 @@ libswanted="$*"
# set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ sun / /' -e 's/ crypt / /' -e 's/ nsl / /' -e 's/ dl / /'`
# shift
# libswanted="$*"
+
+case "$usethreads" in
+$define|true|[yY]*)
+ cat >&4 <<EOM
+IRIX `uname -r` does not support POSIX threads.
+You should upgrade to at least IRIX 6.2 with pthread patches.
+EOM
+ exit 1
+ ;;
+esac
+
diff --git a/gnu/usr.bin/perl/hints/isc.sh b/gnu/usr.bin/perl/hints/isc.sh
index 43b70fde366..cdfe91c605a 100644
--- a/gnu/usr.bin/perl/hints/isc.sh
+++ b/gnu/usr.bin/perl/hints/isc.sh
@@ -34,6 +34,9 @@ ccflags="$ccflags -DBOGUS_GETNAME_RETURN=256"
# rename(2) can't rename long filenames
d_rename=undef
+# for ext/IPC/SysV/SysV.xs
+ccflags="$ccflags -DPERL_ISC"
+
# You can also include -D_SYSV3 to pick up "traditionally visible"
# symbols hidden by name-space pollution rules. This raises some
# compilation "redefinition" warnings, but they appear harmless.
diff --git a/gnu/usr.bin/perl/hints/linux.sh b/gnu/usr.bin/perl/hints/linux.sh
index 8ddb765e1e0..4764e9ea4bd 100644
--- a/gnu/usr.bin/perl/hints/linux.sh
+++ b/gnu/usr.bin/perl/hints/linux.sh
@@ -18,6 +18,27 @@
# No version of Linux supports setuid scripts.
d_suidsafe='undef'
+# Debian and Red Hat, and perhaps other vendors, provide both runtime and
+# development packages for some libraries. The runtime packages contain shared
+# libraries with version information in their names (e.g., libgdbm.so.1.7.3);
+# the development packages supplement this with versionless shared libraries
+# (e.g., libgdbm.so).
+#
+# If you want to link against such a library, you must install the development
+# version of the package.
+#
+# These packages use a -dev naming convention in both Debian and Red Hat:
+# libgdbmg1 (non-development version of GNU libc 2-linked GDBM library)
+# libgdbmg1-dev (development version of GNU libc 2-linked GDBM library)
+# So make sure that for any libraries you wish to link Perl with under
+# Debian or Red Hat you have the -dev packages installed.
+#
+# Some operating systems (e.g., Solaris 2.6) will link to a versioned shared
+# library implicitly. For example, on Solaris, `ld foo.o -lgdbm' will find an
+# appropriate version of libgdbm, if one is available; Linux, however, doesn't
+# do the implicit mapping.
+ignore_versioned_solibs='y'
+
# perl goes into the /usr tree. See the Filesystem Standard
# available via anonymous FTP at tsx-11.mit.edu in
# /pub/linux/docs/linux-standards/fsstnd.
@@ -29,16 +50,9 @@ esac
# gcc-2.6.3 defines _G_HAVE_BOOL to 1, but doesn't actually supply bool.
ccflags="-Dbool=char -DHAS_BOOL $ccflags"
-# libc6, aka glibc2, seems to need STRUCT_TM_HASZONE defined.
-# Thanks to Bart Schuller <schuller@Lunatech.com>
-# See Message-ID: <19971009002636.50729@tanglefoot>
-# This is currently commented out for maintenance releases
-# but should probably be uncommented for 5.005 or after
-# more widespread testing.
-#POSIX_cflags='ccflags="$ccflags -DSTRUCT_TM_HASZONE"'
-
# BSD compatability library no longer needed
-set `echo X "$libswanted "| sed -e 's/ bsd / /'`
+# 'kaffe' has a /usr/lib/libnet.so which is not at all relevent for perl.
+set `echo X "$libswanted "| sed -e 's/ bsd / /' -e 's/ net / /'`
shift
libswanted="$*"
@@ -177,8 +191,8 @@ fi
if [ ! "`csh -c 'echo $version' 2>/dev/null`" ]
then
echo 'Real csh found (might break); looking for tcsh ...'
- # Use ../UU/loc to find tcsh. (We run in the hints/ directory.)
- if xxx=`../UU/loc tcsh blurfl $pth`; $test -f "$xxx"; then
+ # Use ./UU/loc to find tcsh. (We no longer run in the hints/ directory)
+ if xxx=`./UU/loc tcsh blurfl $pth`; $test -f "$xxx"; then
echo "Found tcsh. I'll use it for globbing."
# We can't change Configure's setting of $csh, due to the way
# Configure handles $d_portable and commands found in $loclist.
@@ -194,11 +208,31 @@ fi
# Shimpei Yamashita <shimpei@socrates.patnet.caltech.edu>
# Message-Id: <33EF1634.B36B6500@pobox.com>
#
-# MkLinux (osname=linux,archname=ppc-linux), which differs slightly from other
-# linuces, needs special flags passed in order for dynamic loading to work.
+# The DR2 of MkLinux (osname=linux,archname=ppc-linux) may need
+# special flags passed in order for dynamic loading to work.
# instead of the recommended:
+#
# ccdlflags='-rdynamic'
#
# it should be:
# ccdlflags='-Wl,-E'
-
+#
+# So if your DR2 (DR3 came out summer 1998, consider upgrading)
+# has problems with dynamic loading, uncomment the
+# following three lines, make distclean, and re-Configure:
+#case "`uname -r | sed 's/^[0-9.-]*//'``arch`" in
+#'osfmach3ppc') ccdlflags='-Wl,-E' ;;
+#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]*)
+ ccflags="-D_REENTRANT $ccflags"
+ set `echo X "$libswanted "| sed -e 's/ c / pthread c /'`
+ shift
+ libswanted="$*"
+ ;;
+esac
+EOCBU
diff --git a/gnu/usr.bin/perl/hints/machten.sh b/gnu/usr.bin/perl/hints/machten.sh
index 380f70261d8..f283873699d 100644
--- a/gnu/usr.bin/perl/hints/machten.sh
+++ b/gnu/usr.bin/perl/hints/machten.sh
@@ -13,6 +13,19 @@
# Martijn Koster <m.koster@webcrawler.com>
# Richard Yeh <rcyeh@cco.caltech.edu>
#
+# For now, explicitly disable dynamic loading -- MT 4.1.1 has it,
+# but these hints do not yet support it.
+# Define NOTEDEF_MACHTEN to undo gratuitous Tenon hack to signal.h.
+# -- Dominic Dunlop <domo@computer.org> 9800802
+# Completely disable SysV IPC pending more complete support from Tenon
+# -- Dominic Dunlop <domo@computer.org> 980712
+# Use vfork and perl's malloc by default
+# -- Dominic Dunlop <domo@computer.org> 980630
+# Raise perl's stack size again; cut down reg_infty; document
+# -- Dominic Dunlop <domo@computer.org> 980619
+# Use of semctl() can crash system: disable -- Dominic Dunlop 980506
+# Raise stack size further; slight tweaks to accomodate MT 4.1
+# -- Dominic Dunlop <domo@computer.org> 980211
# Raise perl's stack size -- Dominic Dunlop <domo@tcp.ip.lu> 970922
# Reinstate sigsetjmp iff version is 4.0.3 or greater; use nm
# (assumes Configure change); prune libswanted -- Dominic Dunlop 970113
@@ -23,21 +36,107 @@
#
# Comments, questions, and improvements welcome!
#
-# MachTen 4.X does support dynamic loading, but perl doesn't
+# MachTen 4.1.1 does support dynamic loading, but perl doesn't
# know how to use it yet.
+usedl=${usedl:-undef}
+
+# MachTen 4.1.1 may have an unhelpful hack in /usr/include/signal.h.
+# Undo it if so.
+if grep NOTDEF_MACHTEN /usr/include/signal.h > /dev/null
+then
+ ccflags="$ccflags -DNOTDEF_MACHTEN"
+fi
# Power MachTen is a real memory system and its standard malloc
# has been optimized for this. Using this malloc instead of Perl's
-# malloc may result in significant memory savings.
-usemymalloc='false'
+# malloc may result in significant memory savings. In particular,
+# unlike most UNIX memory allocation subsystems, MachTen's free()
+# really does return unneeded process data memory to the system.
+# However, MachTen's malloc() is woefully slow -- maybe 100 times
+# slower than perl's own, so perl's own is usually the better
+# choice. In order to use perl's malloc(), the sbrk() system call
+# must be simulated using MachTen's malloc(). See malloc.c for
+# precise details of how this is achieved. Recent improvements
+# to perl's malloc() currently crash MachTen, and so are disabled
+# by -DPLAIN_MALLOC and -DNO_FANCY_MALLOC.
+usemymalloc=${usemymalloc:-y}
+
+# Do not wrap the following long line
+malloc_cflags='ccflags="$ccflags -DPLAIN_MALLOC -DNO_FANCY_MALLOC -DUSE_PERL_SBRK"'
+
+# Note that an empty malloc_cflags appears in config.sh if perl's
+# malloc() is not used. his is harmless.
+case "$usemymalloc" in
+n) unset malloc_cflags;;
+*) ccflags="$ccflags -DHIDEMYMALLOC"
+esac
+
+# When MachTen does a fork(), it immediately copies the whole of
+# the parent process' data space for the child. This can be
+# expensive. Using vfork() where appropriate avoids this cost.
+d_vfork=${d_vfork:-define}
+
+# Specify a high level of optimization (-O3 wouldn't do much more)
+optimize=${optimize:--O2 -fomit-frame-pointer}
# Make symbol table listings les voluminous
nmopts=-gp
-# Increase perl's stack size. Without this, lib/complex.t crashes out.
-# Particularly perverse programs may require that perl has an even larger
-# stack allocation than that specified here. (See man setstackspace )
-ldflags='-Xlstack=0x014000'
+# Set reg_infty -- the maximum allowable number of repeats in regular
+# expressions such as /a{1,$max_repeats}/, and the maximum number of
+# times /a*/ will match. Setting this too high without having a stack
+# large enough to accommodate deep recursion in the regular expression
+# engine allows perl to crash your Mac due to stack overrun if it
+# encounters a pathological regular expression. The default is a
+# compromise between capability and required stack size (see below).
+# You may override the default value from the Configure command-line
+# like this:
+#
+# Configure -Dreg_infty=16368 ...
+
+reg_infty=${reg_infty:-2047}
+
+# If you want to have many perl processes active simultaneously --
+# processing CGI forms -- for example, you should opt for a small stack.
+# For safety, you should set reg_infty no larger than the corresponding
+# value given in this table:
+#
+# Stack size reg_infty value supported
+# ---------- -------------------------
+# 128k 2**8-1 (256)
+# 256k 2**9-1 (511)
+# 512k 2**10-1 (1023)
+# 1M 2**11-1 (2047)
+# ...
+# 16M 2**15-1 (32767) (perl's default value)
+
+# This script selects a safe stack size based on the value of reg_infty
+# specified above. However, you may choose to take a risk and set
+# stack size lower: pathological regular expressions are rare in real-world
+# programs. But be aware that, if perl does encounter one, it WILL
+# crash your system. Do not set stack size lower than 96k unless
+# you want perl's installation tests ( make test ) to crash your system.
+#
+# You may override the default value from the Configure command-line
+# by specifying the required size in kilobytes like this:
+#
+# Configure -Dstack_size=96
+
+if [ "X$stack_size" = 'X' ]
+then
+ stack_size=128
+ X=`expr $reg_infty / 256`
+
+ while [ $X -gt 0 ]
+ do
+ X=`expr $X / 2`
+ stack_size=`expr $stack_size \* 2`
+ done
+ X=`expr $stack_size \* 1024`
+fi
+
+ldflags="$ldflags -Xlstack=$X"
+ccflags="$ccflags -DREG_INFTY=$reg_infty"
# Install in /usr/local by default
prefix='/usr/local'
@@ -51,6 +150,13 @@ alignbytes=8
# friends. Use setjmp and friends instead.
expr "$osvers" \< "4.0.3" > /dev/null && d_sigsetjmp='undef'
+# System V IPC support in MachTen 4.1 is incomplete (missing msg function
+# prototypes, no ftok()), buggy (semctl(.., .., IPC_STATUS, ..) hangs
+# system), and undocumented. Claim it's not there until things improve.
+d_msg=${d_msg:-undef}
+d_sem=${d_sem:-undef}
+d_shm=${d_shm:-undef}
+
# Get rid of some extra libs which it takes Configure a tediously
# long time never to find on MachTen
set `echo X "$libswanted "|sed -e 's/ net / /' -e 's/ socket / /' \
@@ -61,6 +167,8 @@ set `echo X "$libswanted "|sed -e 's/ net / /' -e 's/ socket / /' \
shift
libswanted="$*"
+# While link counts on MachTen 4.1's fast file systems work correctly,
+# on Macintosh Heirarchical File Systems, (and on HFS+)
# MachTen always reports ony two links to directories, even if they
# contain subdirectories. Consequently, we use this variable to stop
# File::Find using the link count to determine whether there are
@@ -69,20 +177,48 @@ libswanted="$*"
# Propagating recommended variable dont_use_nlink
dont_use_nlink=define
-cat <<'EOM' >&4
+cat <<EOM >&4
-Tests
- io/fs test 4 and
- op/stat test 3
-may fail since MachTen does not return a useful nlinks field to stat
-on directories.
+During Configure, you may see the message
+
+*** WHOA THERE!!! ***
+ The recommended value for \$d_msg on this machine was "undef"!
+ Keep the recommended value? [y]
+
+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.
+
+Similarly, when you see
+
+*** WHOA THERE!!! ***
+ The recommended value for \$d_vfork on this machine was "define"!
+ Keep the recommended value? [y]
+
+select the default answer: vfork() works, and avoids expensive data
+copying.
At the end of Configure, you will see a harmless message
Hmm...You had some extra variables I don't know about...I'll try to keep 'em.
Propagating recommended variable dont_use_nlink
Propagating recommended variable nmopts
+ Propagating recommended variable malloc_cflags...
+ Propagating recommended variable reg_infty
Read the File::Find documentation for more information about dont_use_nlink
+Your perl will be built with a stack size of ${stack_size}k and a regular
+expression repeat count limit of $reg_infty. If you want alternative
+values, see the file hints/machten.sh for advice on how to change them.
+
+Tests
+ io/fs test 4 and
+ op/stat test 3
+may fail since MachTen may not return a useful nlinks field to stat
+on directories.
+
EOM
-test -r ./broken-db.msg && . ./broken-db.msg
+expr "$osvers" \< "4.1" >/dev/null && test -r ./broken-db.msg && \
+ . ./broken-db.msg
+
+unset stack_size X
diff --git a/gnu/usr.bin/perl/hints/mpeix.sh b/gnu/usr.bin/perl/hints/mpeix.sh
index e952f0e0023..9ebb0bad1e1 100644
--- a/gnu/usr.bin/perl/hints/mpeix.sh
+++ b/gnu/usr.bin/perl/hints/mpeix.sh
@@ -1,70 +1,104 @@
-# MPE/IX does not have nm, and the linker doesn't complain
-# about unresolved symbols, so these are all filled in by hand.
+# The MPE/iX linker doesn't complain about unresolved symbols, and so the only
+# way to test for unresolved symbols in a program is by attempting to run it.
+# But this is slow, and fraught with problems, so the better solution is to use
+# nm.
+#
+# MPE/iX lacks a fully functional native nm, so we need to use our fake nm
+# script which will extract the symbol info from the native link editor and
+# reformat into something nm-like.
+#
+# 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.
+#
osname='mpeix'
-osvers='5.0'
-alignbytes='8'
-ccflags='-D_POSIX_SOURCE -D_SOCKET_SOURCE -D_POSIX_JOB_CONTROL'
-cc='c89'
-optimize='none'
-d_safebcpy='undef'
-d_safemcpy='undef'
-intsize='8'
-usemymalloc='y'
-d_casti32='undef'
-d_castneg='undef'
-prefix='/PERL'
-privlib='/PERL/PERL/lib'
-archlib='/PERL/PERL/lib/mpeix'
-clocktype='clock_t'
-gidtype='gid_t'
-groupstype='gid_t'
-lseektype='off_t'
-modetype='mode_t'
-randbits='15'
-ssizetype='ssize_t'
-uidtype='uid_t'
-d_stdstdio='undef'
-i_pwd='undef'
-i_grp='undef'
-#d_fd_set='undef'
-#d_fds_bits='undef'
-d_chroot='undef'
-d_fchmod='undef'
-d_fchown='undef'
-d_flock='undef'
-d_Gconvert='sprintf((b),"%.*g",(n),(x))'
-d_getpgrp2='undef'
-d_getprior='undef'
-d_killpg='undef'
-d_lstat='undef'
-d_seekdir='undef'
-d_telldir='undef'
-d_setpgrp2='undef'
-d_setprior='undef'
-d_setresgid='undef'
-d_setresuid='undef'
-d_setrgid='undef'
-d_setruid='undef'
-d_syscall='undef'
-d_truncate='undef'
-d_setregid='undef'
-d_setreuid='undef'
-d_setpgrp='undef'
-d_chsize='undef'
-d_group='undef'
-d_bcmp='undef'
-d_bcopy='undef'
-d_bzero='undef'
-d_attrib='undef'
-d_dirnamlen='define'
+osvers='5.5'
+#
+# Force Configure to use our wrapper mpeix/nm script
+#
+PATH="$PWD/mpeix:$PATH"
+nm="$PWD/mpeix/nm"
+_nm=$nm
+nm_opt='-configperl'
+usenm='true'
+#
+# Various directory locations.
+#
+prefix='/PERL/PUB'
+archname='PA-RISC1.1'
+bin="$prefix"
+installman1dir="$prefix/man/man1"
+installman3dir="$prefix/man/man3"
+man1dir="$prefix/man/man1"
+man3dir="$prefix/man/man3"
+perlpath="$prefix/PERL"
+scriptdir="$prefix"
+startperl="#!$prefix/perl"
+startsh='#!/bin/sh'
+#
+# Compiling.
+#
+cc='gcc'
+cccdlflags='none'
+ccflags='-DMPE -D_POSIX_SOURCE -D_SOCKET_SOURCE -D_POSIX_JOB_CONTROL -DIS_SOCKET_CLIB_ITSELF'
+locincpth='/usr/local/include /usr/contrib/include /BIND/PUB/include'
+optimize='-O2'
+ranlib='/bin/true'
+# Special compiling options for certain source files.
+regcomp_cflags='optimize=-O'
+toke_cflags='ccflags="$ccflags -DARG_ZERO_IS_SCRIPT"'
+#
+# Linking.
+#
+lddlflags='-b'
+libs='-lbind -lsyslog -lcurses -lsvipc -lsocket -lm -lc'
+loclibpth='/usr/local/lib /usr/contrib/lib /BIND/PUB/lib /SYSLOG/PUB'
+#
+# External functions and data items.
+#
+d_crypt='define'
+d_difftime='define'
+d_dlerror='undef'
+d_dlopen='undef'
+d_Gconvert='gcvt((x),(n),(b))'
+d_inetaton='undef'
d_link='undef'
-d_passwd='undef'
+d_mblen='define'
+d_mbstowcs='define'
+d_mbtowc='define'
+d_memcmp='define'
+d_memcpy='define'
+d_memmove='define'
+d_memset='define'
+d_pwage='undef'
d_pwcomment='undef'
+d_pwgecos='undef'
+d_pwpasswd='undef'
+d_setpgid='undef'
+d_setsid='undef'
+d_setvbuf='define'
d_statblks='undef'
-libs='-lsvipc -lsocket -lm -lc'
-ranlib='/bin/true'
-d_nice='undef'
-d_cuserid='undef'
+d_strchr='define'
+d_strcoll='define'
+d_strerrm='strerror(e)'
+d_strerror='define'
+d_strtod='define'
+d_strtol='define'
+d_strtoul='define'
+d_strxfrm='define'
+d_syserrlst='define'
+d_time='define'
+d_wcstombs='define'
+d_wctomb='define'
+#
+# Include files.
+#
i_termios='undef'
-d_tcgetpgrp='undef'
-d_tcsetpgrp='undef'
+i_time='define'
+i_systime='undef'
+i_systimek='undef'
+timeincl='/usr/include/time.h'
+#
+# Data types.
+#
+timetype='time_t'
diff --git a/gnu/usr.bin/perl/hints/netbsd.sh b/gnu/usr.bin/perl/hints/netbsd.sh
index c508815a46c..6d99a13edfe 100644
--- a/gnu/usr.bin/perl/hints/netbsd.sh
+++ b/gnu/usr.bin/perl/hints/netbsd.sh
@@ -1,12 +1,11 @@
# hints/netbsd.sh
#
-# talk to mrg@eterna.com.au if you want to change this file.
+# talk to packages@netbsd.org if you want to change this file.
#
# netbsd keeps dynamic loading dl*() functions in /usr/lib/crt0.o,
# so Configure doesn't find them (unless you abandon the nm scan).
# this should be *just* 0.9 below as netbsd 0.9a was the first to
-# introduce shared libraries. however, they don't work/build on
-# pmax, powerpc and alpha ports correctly, yet.
+# introduce shared libraries.
case "$archname" in
'')
@@ -19,26 +18,26 @@ case "$osvers" in
usedl="$undef"
;;
*)
- case `uname -m` in
- alpha|powerpc|pmax)
+ if [ -f /usr/libexec/ld.elf_so ]; then
+ d_dlopen=$define
+ d_dlerror=$define
+ ccdlflags="-Wl,-E -Wl,-R${PREFIX}/lib $ccdlflags"
+ cccdlflags="-DPIC -fPIC $cccdlflags"
+ lddlflags="--whole-archive -shared $lddlflags"
+ elif [ "`uname -m`" = "pmax" ]; then
+# NetBSD 1.3 and 1.3.1 on pmax shipped an `old' ld.so, which will not work.
d_dlopen=$undef
- ;;
-# this doesn't work (yet).
-# alpha)
-# d_dlopen=$define
-# d_dlerror=$define
-# cccdlflags="-DPIC -fPIC $cccdlflags"
-# lddlflags="-shared $lddlflags"
-# ;;
- *)
+ elif [ -f /usr/libexec/ld.so ]; then
d_dlopen=$define
d_dlerror=$define
+ ccdlflags="-Wl,-R${PREFIX}/lib $ccdlflags"
# we use -fPIC here because -fpic is *NOT* enough for some of the
# extensions like Tk on some netbsd platforms (the sparc is one)
cccdlflags="-DPIC -fPIC $cccdlflags"
lddlflags="-Bforcearchive -Bshareable $lddlflags"
- ;;
- esac
+ else
+ d_dlopen=$undef
+ fi
;;
esac
@@ -47,16 +46,31 @@ esac
# way to make perl call setuid() or setgid(). if they aren't, then
# ($<, $>) = ($u, $u); will work (same for $(/$)). this is because
# you can not change the real userid of a process under 4.4BSD.
-# netbsd fixed this in 1.2A.
+# netbsd fixed this in 1.3.2.
case "$osvers" in
-0.9*|1.0*|1.1*|1.2_*|1.2|1.2.*)
+0.9*|1.[012]*|1.3|1.3.1)
d_setregid="$undef"
d_setreuid="$undef"
- d_setrgid="$undef"
- d_setruid="$undef"
;;
esac
+# These are obsolete in any netbsd.
+d_setrgid="$undef"
+d_setruid="$undef"
+
+# there's no problem with vfork.
+case "$usevfork" in
+'') usevfork=true ;;
+esac
+
# Avoid telldir prototype conflict in pp_sys.c (NetBSD uses const DIR *)
# Configure should test for this. Volunteers?
pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"'
+
+# Pre-empt the /usr/bin/perl question of installperl.
+installusrbinperl='n'
+
+# Recognize the NetBSD packages collection.
+# GDBM might be here.
+test -d /usr/pkg/lib && loclibpth="$loclibpth /usr/pkg/lib"
+test -d /usr/pkg/include && locincpth="$locincpth /usr/pkg/include"
diff --git a/gnu/usr.bin/perl/hints/next_3.sh b/gnu/usr.bin/perl/hints/next_3.sh
index 55e89591d88..99adf50ffe9 100644
--- a/gnu/usr.bin/perl/hints/next_3.sh
+++ b/gnu/usr.bin/perl/hints/next_3.sh
@@ -72,7 +72,7 @@ cccdlflags=' '
# If you want to build for specific architectures, change the line
# below to something like
#
-# archs=(m68k i386)
+# archs='m68k i386'
#
archs=`/bin/lipo -info /usr/lib/libm.a | sed -n 's/^[^:]*:[^:]*: //p'`
@@ -129,3 +129,13 @@ ranlib='sleep 5; /bin/ranlib'
# This is true whether we're on an HPPA machine or cross-compiling
# for one.
pp_cflags='optimize=""'
+
+# The SysV IPC is optional (ftp://ftp.nluug.nl/pub/comp/next/SysVIPC/)
+# Gerben_Wierda@RnA.nl
+if [ -f /usr/local/lib/libIPC.a ]; then
+ libswanted="$libswanted IPC"
+ # As of Sep 1998 d_msg wasn't supported in that library,
+ # only d_sem and d_shm, but Configure should be able to
+ # figure that out. --jhi
+ # Note also the next3 ext/IPC/SysV hints file.
+fi
diff --git a/gnu/usr.bin/perl/hints/next_4.sh b/gnu/usr.bin/perl/hints/next_4.sh
index 316b3392123..d1d0398dd9a 100644
--- a/gnu/usr.bin/perl/hints/next_4.sh
+++ b/gnu/usr.bin/perl/hints/next_4.sh
@@ -12,7 +12,7 @@
#
useposix='undef'
-libpth='/lib /usr/lib'
+libpth='/lib /usr/lib /usr/local/lib'
libswanted=' '
libc='/NextLibrary/Frameworks/System.framework/System'
@@ -33,9 +33,22 @@ ld='cc'
# If you want to build for specific architectures, change the line
# below to something like
#
-# archs=(m68k i386)
+# archs='m68k i386'
#
-archs=`/bin/lipo -info /usr/lib/libm.a | sed -n 's/^[^:]*:[^:]*: //p'`
+
+# On m68k machines, toke.c cannot be compiled at all for i386 and it can
+# only be compiled for m68k itself without optimization (this is under
+# OPENSTEP 4.2).
+#
+if [ `hostinfo | grep 'NeXT Mach.*:' | sed 's/.*RELEASE_//'` = M68K ]
+then
+ echo "Cross compilation is impossible on m68k hardware under OS 4"
+ echo "Forcing architecture to m68k only"
+ toke_cflags='optimize=""'
+ archs='m68k'
+else
+ archs=`/bin/lipo -info /usr/lib/libm.a | sed -n 's/^[^:]*:[^:]*: //p'`
+fi
#
# leave the following part alone
diff --git a/gnu/usr.bin/perl/hints/os2.sh b/gnu/usr.bin/perl/hints/os2.sh
index 2a589b5cb4a..310ae913c49 100644
--- a/gnu/usr.bin/perl/hints/os2.sh
+++ b/gnu/usr.bin/perl/hints/os2.sh
@@ -23,6 +23,14 @@ if test -f $sh.exe; then sh=$sh.exe; fi
startsh="#!$sh"
cc='gcc'
+# Make denser object files and DLL
+case "X$optimize" in
+ X)
+ optimize="-O2 -fomit-frame-pointer -malign-loops=2 -malign-jumps=2 -malign-functions=2 -s"
+ ld_dll_optimize="-s"
+ ;;
+esac
+
# Get some standard things (indented to avoid putting in config.sh):
oifs="$IFS"
IFS=" ;"
@@ -33,25 +41,25 @@ cc='gcc'
set $C_INCLUDE_PATH
usrinc="$@"
IFS="$oifs"
- tryman="`../UU/loc . /man $tryman`"
+ tryman="`./UU/loc . /man $tryman`"
tryman="`echo $tryman | tr '\\\' '/'`"
# indented to avoid having it *two* times at start
- libemx="`../UU/loc os2.a /emx/lib $libemx`"
+ libemx="`./UU/loc os2.a /emx/lib $libemx`"
-usrinc="`../UU/loc stdlib.h /emx/include $usrinc`"
+usrinc="`./UU/loc stdlib.h /emx/include $usrinc`"
usrinc="`dirname $usrinc | tr '\\\' '/'`"
libemx="`dirname $libemx | tr '\\\' '/'`"
if test -d $tryman/man1; then
sysman="$tryman/man1"
else
- sysman="`../UU/loc . /man/man1 c:/man/man1 c:/usr/man/man1 d:/man/man1 d:/usr/man/man1 e:/man/man1 e:/usr/man/man1 f:/man/man1 f:/usr/man/man1 g:/man/man1 g:/usr/man/man1 /usr/man/man1`"
+ sysman="`./UU/loc . /man/man1 c:/man/man1 c:/usr/man/man1 d:/man/man1 d:/usr/man/man1 e:/man/man1 e:/usr/man/man1 f:/man/man1 f:/usr/man/man1 g:/man/man1 g:/usr/man/man1 /usr/man/man1`"
fi
emxpath="`dirname $libemx`"
if test ! -d "$emxpath"; then
- emxpath="`../UU/loc . /emx c:/emx d:/emx e:/emx f:/emx g:/emx h:/emx /emx`"
+ emxpath="`./UU/loc . /emx c:/emx d:/emx e:/emx f:/emx g:/emx h:/emx /emx`"
fi
if test ! -d "$libemx"; then
@@ -61,7 +69,7 @@ if test ! -d "$libemx"; then
if test -d "$LIBRARY_PATH"; then
libemx="$LIBRARY_PATH"
else
- libemx="`../UU/loc . X c:/emx/lib d:/emx/lib e:/emx/lib f:/emx/lib g:/emx/lib h:/emx/lib /emx/lib`"
+ libemx="`./UU/loc . X c:/emx/lib d:/emx/lib e:/emx/lib f:/emx/lib g:/emx/lib h:/emx/lib /emx/lib`"
fi
fi
@@ -72,12 +80,12 @@ if test ! -d "$usrinc"; then
if test -d "$C_INCLUDE_PATH"; then
usrinc="$C_INCLUDE_PATH"
else
- usrinc="`../UU/loc . X c:/emx/include d:/emx/include e:/emx/include f:/emx/include g:/emx/include h:/emx/include /emx/include`"
+ usrinc="`./UU/loc . X c:/emx/include d:/emx/include e:/emx/include f:/emx/include g:/emx/include h:/emx/include /emx/include`"
fi
fi
fi
-rsx="`../UU/loc rsx.exe undef $pth`"
+rsx="`./UU/loc rsx.exe undef $pth`"
if test "$libemx" = "X"; then echo "Cannot find C library!" >&2; fi
@@ -104,19 +112,20 @@ aout_obj_ext='.o'
aout_lib_ext='.a'
aout_ar='ar'
aout_plibext='.a'
-aout_lddlflags='-Zdll'
+aout_lddlflags="-Zdll $ld_dll_optimize"
+# Cannot have 32000K stack: get SYS0170 ?!
if [ $emxcrtrev -ge 50 ]; then
- aout_ldflags='-Zexe -Zsmall-conv'
+ aout_ldflags='-Zexe -Zsmall-conv -Zstack 16000'
else
- aout_ldflags='-Zexe'
+ aout_ldflags='-Zexe -Zstack 16000'
fi
# To get into config.sh:
aout_ldflags="$aout_ldflags"
aout_d_fork='define'
-aout_ccflags='-DPERL_CORE -DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I. -DPACK_MALLOC -DTWO_POT_OPTIMIZE -DPERL_EMERGENCY_SBRK'
-aout_cppflags='-DPERL_CORE -DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I. -DPACK_MALLOC -DTWO_POT_OPTIMIZE -DPERL_EMERGENCY_SBRK'
+aout_ccflags='-DPERL_CORE -DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I.'
+aout_cppflags='-DPERL_CORE -DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I.'
aout_use_clib='c'
aout_usedl='undef'
aout_archobjs="os2.o dl_os2.o"
@@ -152,18 +161,21 @@ else
else
d_fork='undef'
fi
- lddlflags='-Zdll -Zomf -Zmt -Zcrtdll'
+ lddlflags="-Zdll -Zomf -Zmt -Zcrtdll $ld_dll_optimize"
# Recursive regmatch may eat 2.5M of stack alone.
ldflags='-Zexe -Zomf -Zmt -Zcrtdll -Zstack 32000'
if [ $emxcrtrev -ge 50 ]; then
- ccflags='-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I. -DPACK_MALLOC -DDEBUGGING_MSTATS -DTWO_POT_OPTIMIZE -DPERL_EMERGENCY_SBRK'
+ ccflags='-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I.'
else
- ccflags='-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I. -DPACK_MALLOC -DDEBUGGING_MSTATS -DEMX_BAD_SBRK'
+ ccflags='-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I. -DEMX_BAD_SBRK'
fi
use_clib='c_import'
usedl='define'
fi
+# indented to miss config.sh
+ _ar="$ar"
+
# To get into config.sh (should start at the beginning of line)
# or you can put it into config.over.
plibext="$plibext"
@@ -238,13 +250,6 @@ nm_opt='-p'
d_getprior='define'
d_setprior='define'
-# Make denser object files and DLL
-case "X$optimize" in
- X)
- optimize="-O2 -fomit-frame-pointer -malign-loops=2 -malign-jumps=2 -malign-functions=2 -s"
- ;;
-esac
-
# The next two are commented. pdksh handles #!, extproc gives no path part.
# sharpbang='extproc '
# shsharp='false'
@@ -254,11 +259,26 @@ esac
# Copy pod:
-cp ../README.os2 ../pod/perlos2.pod
+cp ./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'
+case "$usethreads" in
+$define|true|[yY]*)
+ ccflags="-Zmt $ccflags"
+ cppflags="-Zmt $cppflags" # Do we really need to set this?
+ aout_ccflags="-DUSE_THREADS $aout_ccflags"
+ aout_cppflags="-DUSE_THREADS $aout_cppflags"
+ aout_lddlflags="-Zmt $aout_lddlflags"
+ aout_ldflags="-Zmt $aout_ldflags"
+ ;;
+esac
+EOCBU
# Now install the external modules. We are in the ./hints directory.
-cd ../os2/OS2
+cd ./os2/OS2
if ! test -d ../../ext/OS2 ; then
mkdir ../../ext/OS2
@@ -286,4 +306,4 @@ done
# Now go back
-cd ../../hints
+cd ../..
diff --git a/gnu/usr.bin/perl/hints/os390.sh b/gnu/usr.bin/perl/hints/os390.sh
index fd590eaa4e6..08b60c878e4 100644
--- a/gnu/usr.bin/perl/hints/os390.sh
+++ b/gnu/usr.bin/perl/hints/os390.sh
@@ -1,4 +1,7 @@
# hints/os390.sh
+#
+# OS/390 hints by David J. Fiander <davidf@mks.com>
+#
# OS/390 OpenEdition Release 3 Mon Sep 22 1997 thanks to:
#
# John Pfuntner <pfuntner@vnet.ibm.com>
@@ -11,23 +14,48 @@
# as well as the authors of the aix.sh file
#
+# To get ANSI C, we need to use c89, and ld doesn't exist
cc='c89'
-ccflags='-DMAXSIG=38 -DOEMVS -D_OE_SOCKETS -D_XOPEN_SOURCE_EXTENDED -D_ALL_SOURCE'
+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,
+# 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'
+
alignbytes=8
-usemymalloc='y'
+
+usemymalloc='n'
+
so='a'
+
+# On OS/390, libc.a doesn't really hold anything at all,
+# so running nm on it is pretty useless.
+usenm='n'
+
+# Dynamic loading doesn't work on OS/390 quite yet
+usedl='n'
dlext='none'
+
+# Configure can't figure this out for some reason
d_shmatprototype='define'
+
usenm='false'
i_time='define'
i_systime='define'
-d_select='undef'
# (from aix.sh)
# uname -m output is too specific and not appropriate here
+# osname should come from Configure
#
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
diff --git a/gnu/usr.bin/perl/hints/powerux.sh b/gnu/usr.bin/perl/hints/powerux.sh
index fd2ebe682db..6d6bac02ed7 100644
--- a/gnu/usr.bin/perl/hints/powerux.sh
+++ b/gnu/usr.bin/perl/hints/powerux.sh
@@ -75,6 +75,16 @@ d_memcmp='undef'
#
useshrplib='false'
+# PowerMAX OS has support for a few different kinds of filesystems. The
+# newer "xfs" filesystem does *not* report a reasonable value in the
+# 'nlinks' field of stat() info for directories (in fact, it is always 1).
+# Since xfs is the only filesystem which supports partitions bigger than
+# 2gig and you can't hardly buy a disk that small anymore, xfs is coming in
+# to greater and greater use, so we pretty much have no choice but to
+# abandon all hope that number of links will mean anything.
+#
+dont_use_nlink=define
+
# Misc other flags that might be able to change, but I know these work right.
#
d_suidsafe='define'
diff --git a/gnu/usr.bin/perl/hints/qnx.sh b/gnu/usr.bin/perl/hints/qnx.sh
index 947c98f6799..b53a33d7370 100644
--- a/gnu/usr.bin/perl/hints/qnx.sh
+++ b/gnu/usr.bin/perl/hints/qnx.sh
@@ -36,18 +36,8 @@
# Resolved in 970211 Beta
# lib/io_udp.t test hangs because of a bug in getsockname().
# Fixed in latest BETA socket3r.lib
-# If there is a softlink in your path, Findbin will fail.
-# This is a documented feature of perl's getpwd().
# There is currently no support for dynamically linked
# libraries.
-# op/magic.t failure due to a feature of QNX which rewrites script
-# names before they are executed. I think you'll find that if
-# you cd `fullpath -t` before doing the make, the test will pass.
-#----------------------------------------------------------------
-# At present, all QNX systems are equivalent architectures,
-# so it might be reasonable to call archname=qnx rather than
-# making an unnecessary distinction between AT-qnx and PCI-qnx,
-# for example.
#----------------------------------------------------------------
# These hints were submitted by:
# Norton T. Allen
@@ -62,6 +52,14 @@ echo "Some tests may fail. Please read the hints/qnx.sh file."
echo ""
#----------------------------------------------------------------
+# At present, all QNX systems are equivalent architectures,
+# so it is reasonable to call archname=x86-qnx rather than
+# making an unnecessary distinction between AT-qnx and PCI-qnx,
+# for example.
+#----------------------------------------------------------------
+archname='x86-qnx'
+
+#----------------------------------------------------------------
# QNX doesn't come with a csh and the ports of tcsh I've used
# don't work reliably:
#----------------------------------------------------------------
@@ -145,7 +143,7 @@ if [ -z "`which nm 2>/dev/null`" ]; then
Creating a quick-and-dirty nm cover for Configure to use:
EOF
- cat >../UU/nm <<-'EOF'
+ cat >./UU/nm <<-'EOF'
#! /bin/sh
#__USAGE
#%C <lib> [<lib> ...]
@@ -161,7 +159,7 @@ if [ -z "`which nm 2>/dev/null`" ]; then
}
}'
EOF
- chmod +x ../UU/nm
+ chmod +x ./UU/nm
fi
cppstdin=`which cpp 2>/dev/null`
diff --git a/gnu/usr.bin/perl/hints/sco.sh b/gnu/usr.bin/perl/hints/sco.sh
index cef1c0c9423..eb598452a1d 100644
--- a/gnu/usr.bin/perl/hints/sco.sh
+++ b/gnu/usr.bin/perl/hints/sco.sh
@@ -1,140 +1,233 @@
-# sco.sh
+# sco.sh
# Courtesy of Joel Rosi-Schwartz <j.schwartz@agonet.it>
-
+###############################################################
# Additional SCO version info from
# Peter Wolfe <wolfe@teloseng.com>
-# Last revised
# Fri Jul 19 14:54:25 EDT 1996
-# by Andy Dougherty <doughera@lafcol.lafayette.edu>
-
-# To use gcc, use sh Configure -Dcc=gcc
-# But gcc will *not* do dynamic laoding on 3.2.5,
-# for that use sh Configure -Dcc=icc
-# See below for more details.
+# and again Tue Sep 29 16:37:25 EDT 1998
+# by Andy Dougherty <doughera@lafayette.edu>
+# Mostly rewritten on
+# Tue Jan 19 23:00:00 CET 1999
+# by Francois Desarmenien <desar@club-internet.fr>
+###############################################################
+#
+# To use cc, use sh Configure
+# To use gcc, use sh Configure -Dcc=gcc
+#
+# Default on 3.2v4 is to use static link (dynamic loading unsupported).
+# Default on 3.2v5 is to use dynamic loading.
+# To use static linkink instead, use to sh Configure -Dusedl=n
+#
+# Warning: - to use dynamic loading with gcc, you need gcc 2.8.0 or later
+# ******** - to compile with older releases of gcc, use Configure -Dusedl=n
+# or it wont compile properly
+#
+###############################################################
+# NOTES:
+# -----
+#
+# I Have removed inclusion of ODBM_File for OSR5
+# because it core dumps and make tests fails.
+#
+# Support for icc compiler has been removed, because it 'breaks'
+# a lot of code :-(
+#
+# It's *always* a good idea to first make a static link to be sure to
+# have all symbols resolved with the current choice of libraries, since
+# with dynamic linking, unresolved symbols are allowed an will be detected
+# only at runtime (when you try to load the module or worse, when you call
+# the symbol)
+#
+# The best choice of compiler on OSR 5 (3.2v5.*) seems to be gcc >= 2.8.0:
+# -You cannot optimize with genuine sco cc (miniperl core dumps),
+# so Perl is faster if compiled with gcc.
+# -Even optimized for speed, gcc generated code is smaller (!!!)
+# -gcc is free
+# -I use ld to link which is distributed with the core OS distribution, so you
+# don't need to buy the developement kit, just find someone kind enough to
+# give you a binary release of gcc.
+#
+#
+###############################################################
# figure out what SCO version we are. The output of uname -X is
# something like:
# System = SCO_SV
# Node = xxxxx
# Release = 3.2v5.0.0
# KernelID = 95/08/08
-# Machine = Pentium
+# Machine = Pentium
# BusType = ISA
# Serial = xxxxx
# Users = 5-user
# OEM# = 0
# Origin# = 1
-# NumCPU = 1
-
-# Use /bin/uname (because Gnu may be first on the path and
+# NumCPU = 1
+
+# Use /bin/uname (because GNU uname may be first in $PATH and
# it does not support -X) to figure out what SCO version we are:
-case `/bin/uname -X | egrep '^Release'` in
-*3.2v4.*) scorls=3 ;; # I don't know why this is 3 instead of 4 :-)
-*3.2v5.*) scorls=5 ;;
-*) scorls=3 ;; # this probabaly shouldn't happen
+# Matching '^Release' is broken by locale setting:
+# matching '3.2v' should be enough -- FD
+case `/bin/uname -X | egrep '3\.2v'` in
+*3.2v4.*) scorls=3 ;; # OSR 3
+*3.2v5.*) scorls=5 ;; # OSR 5
+*)
+ # Future of SCO OSR is SCO UnixWare: there should not be new OSR releases
+ echo "************************************************************" >&4
+ echo "" >&4
+ echo " sco.sh hints file only supports:" >&4
+ echo "" >&4
+ echo " - SCO Unix 3.2v4.x (OSR 3)" >&4
+ echo " - SCO Unix 3.2v5.x (OSR 5)" >&4
+ echo "" >&4
+ echo "" >&4
+ echo " For UnixWare, use svr4.sh hints instead" >&4
+ echo "" >&4
+ echo "***********************************************************" >&4
+ exit
+;;
esac
+###############################################################
+# Common fixes for all compilers an releases:
+
+###############################################################
+# What is true for SCO5 is true for SCO3 too today, so let's have a single
+# symbol for both
+ccflags="-U M_XENIX -D PERL_SCO"
+
+###############################################################
+# Compilers options section:
+if test "$scorls" = "3"
+then
+ dlext=''
+ case "$cc" in
+ gcc) optimize='-O2' ;;
+ *) ccflags="$ccflags -W0 -quiet"
+ optimize='-O' ;;
+ esac
+else
+ ###############################################################
+ # Need this in release 5 because of changed fpu exeption rules
+ ccflags="$ccflags -D PERL_SCO5"
+
+ ###############################################################
+ # In Release 5, always compile ELF objects
+ case "$cc" in
+ gcc)
+ ccflags="$ccflags -melf"
+ optimize='-O2'
+ ;;
+ *)
+ ccflags="$ccflags -w0 -belf"
+ optimize='-O0'
+ ;;
+ esac
+ ###############################################################
+ # Dynamic loading section:
+ #
+ # We use ld to build shared libraries as it is always available
+ # and seems to work better than GNU's one on SCO
+ #
+ # ccdlflags : must tell the linker to export all global symbols
+ # cccdlflags: must tell the compiler to generate relocatable code
+ # lddlflags : must tell the linker to output a shared library
+ #
+ # /usr/local/lib is added for convenience, since 'foreign' libraries
+ # are usually put there in sco
+ #
+ if test "$usedl" != "n"; then
+ ld='ld'
+ case "$cc" in
+ gcc)
+ ccdlflags='-Xlinker -Bexport -L/usr/local/lib'
+ cccdlflags='-fpic'
+ lddlflags='-G -L/usr/local/lib'
+ ;;
+ *)
+ ccdlflags='-Bexport -L/usr/local/lib'
+ cccdlflags='-Kpic'
+ lddlflags='-G -L/usr/local/lib'
+ ;;
+ esac
+
+ ###############################################################
+ # Use dynamic loading
+ usedl='define'
+ dlext='so'
+ dlsrc='dl_dlopen.xs'
+
+ ###############################################################
+ # Force to define those symbols, as they are #defines and not
+ # catched by Configure, and they are useful
+ d_dlopen='define'
+ d_dlerror='define'
+ fi
+fi
+
+
+###############################################################
+# Various hints, common to all releases, to have it work better:
+
+###############################################################
+# We need to remove libdl, as libdl.so exists, but ld complains
+# it can't find libdl.a ! Bug or feature ? :-)
+libswanted=`echo " $libswanted " | sed -e 's/ dl / /'`
+set X $libswanted
+shift
+libswanted="$*"
+
+###############################################################
# Try to use libintl.a since it has strcoll and strxfrm
libswanted="intl $libswanted"
+
+###############################################################
# Try to use libdbm.nfs.a since it has dbmclose.
-#
if test -f /usr/lib/libdbm.nfs.a ; then
libswanted=`echo "dbm.nfs $libswanted " | sed -e 's/ dbm / /'`
+ set X $libswanted
+ shift
+ libswanted="$*"
fi
-set X $libswanted
-shift
-libswanted="$*"
+###############################################################
+# We disable ODBM_File if OSR5 because it's mostly broken
+# but keep it for ODT3 as it seems to work.
+if test "$scorls" = "5"; then
+ i_dbm='undef'
+fi
+
+###############################################################
# We don't want Xenix cross-development libraries
glibpth=`echo $glibpth | sed -e 's! /usr/lib/386 ! !' -e 's! /lib/386 ! !'`
xlibpth=''
-case "$cc" in
-*gcc*) ccflags="$ccflags -U M_XENIX"
- optimize="$optimize -O2"
- ;;
-scocc) ;;
-
-# On SCO 3.2v5 both cc and icc can build dynamic load, but cc core
-# dumps if optimised, so I am only setting this up for icc.
-# It is possible that some 3.2v4.2 system have icc, I seem to
-# recall it was available as a seperate product but I have no
-# knowledge if it can do dynamic loading and if so how.
-# Joel Rosi-Schwartz
-icc)# Apparently, SCO's cc gives rather verbose warnings
- # Set -w0 to turn them off.
- case $scorls in
- 3) ccflags="$ccflags -W0 -quiet -U M_XENIX" ;;
- 5) ccflags="$ccflags -belf -w0 -U M_XENIX"
- optimize="-O1" # -g -O1 will not work
- # optimize="-O0" may be needed for pack test to pass.
- lddlflags='-G -L/usr/local/lib'
- ldflags=' -W l,-Bexport -L/usr/local/lib'
- dlext='so'
- dlsrc='dl_dlopen.xs'
- usedl='define'
- ;;
- esac
- ;;
-
-*) # Apparently, miniperl core dumps if -O is used.
- case "$optimize" in
- '') optimize=none ;;
- esac
- # Apparently, SCO's cc gives rather verbose warnings
- # Set -w0 to turn them off.
- case $scorls in
- 3) ccflags="$ccflags -W0 -quiet -U M_XENIX" ;;
- 5) ccflags="$ccflags -w0 -U M_XENIX -DPERL_SCO5" ;;
- esac
- ;;
-esac
-i_varargs=undef
-
+###############################################################
# I have received one report that nm extraction doesn't work if you're
# using the scocc compiler. This system had the following 'myconfig'
# uname='xxx xxx 3.2 2 i386 '
# cc='scocc', optimize='-O'
-usenm='false'
+# You can override this with Configure -Dusenm.
+case "$usenm" in
+'') usenm='false' ;;
+esac
+###############################################################
# If you want to use nm, you'll probably have to use nm -p. The
# following does that for you:
nm_opt='-p'
+###############################################################
# I have received one report that you can't include utime.h in
# pp_sys.c. Uncomment the following line if that happens to you:
# i_utime=undef
-# Apparently, some versions of SCO include both .so and .a libraries,
-# but they don't mix as they do on other ELF systems. The upshot is
-# that Configure finds -ldl (libdl.so) but 'ld' complains it can't
-# find libdl.a.
-# I don't know which systems have this feature, so I'll just remove
-# -dl from libswanted for all SCO systems until someone can figure
-# out how to get dynamic loading working on SCO.
-#
-# The output of uname -X on one such system was
-# System = SCO_SV
-# Node = xxxxx
-# Release = 3.2v5.0.0
-# KernelID = 95/08/08
-# Machine = Pentium
-# BusType = ISA
-# Serial = xxxxx
-# Users = 5-user
-# OEM# = 0
-# Origin# = 1
-# NumCPU = 1
-#
-# The 5.0.0 on the Release= line is probably the thing to watch.
-# Andy Dougherty <doughera@lafcol.lafayette.edu>
-# Thu Feb 1 15:06:56 EST 1996
-libswanted=`echo " $libswanted " | sed -e 's/ dl / /'`
-set X $libswanted
-shift
-libswanted="$*"
-
+###############################################################
# Perl 5.003_05 and later try to include both <time.h> and <sys/select.h>
# in pp_sys.c, but that fails due to a redefinition of struct timeval.
# This will generate a WHOA THERE. Accept the default.
i_sysselct=$undef
+
+
+###############################################################
+#END of hint file
diff --git a/gnu/usr.bin/perl/hints/solaris_2.sh b/gnu/usr.bin/perl/hints/solaris_2.sh
index d2124edb063..935f00d877e 100644
--- a/gnu/usr.bin/perl/hints/solaris_2.sh
+++ b/gnu/usr.bin/perl/hints/solaris_2.sh
@@ -1,5 +1,5 @@
# hints/solaris_2.sh
-# Last modified: Thu Feb 8 11:38:12 EST 1996
+# Last modified: Wed May 27 13:04:45 EDT 1998
# Andy Dougherty <doughera@lafcol.lafayette.edu>
# Based on input from lots of folks, especially
# Dean Roehrich <roehrich@ironwood-fddi.cray.com>
@@ -53,11 +53,12 @@ esac
# Here's another draft of the perl5/solaris/gcc sanity-checker.
-case $PATH in
-*/usr/ucb*:/usr/bin:*|*/usr/ucb*:/usr/bin) cat <<END >&4
+case `type ${cc:-cc}` in
+*/usr/ucb/cc*) cat <<END >&4
NOTE: Some people have reported problems with /usr/ucb/cc.
-Remove /usr/ucb from your PATH if you have difficulties.
+If you have difficulties, please make sure the directory
+containing your C compiler is before /usr/ucb in your PATH.
END
;;
@@ -95,13 +96,22 @@ END
;;
esac
+# Use shell built-in 'type' command instead of /usr/bin/which to
+# avoid possible csh start-up problems and also to use the same shell
+# we'll be using to Configure and make perl.
+# The path name is the last field in the output, but the type command
+# has an annoying array of possible outputs, e.g.:
+# make is hashed (/opt/gnu/bin/make)
+# cc is /usr/ucb/cc
+# foo not found
+# use a command like type make | awk '{print $NF}' | sed 's/[()]//g'
# See if make(1) is GNU make(1).
# If it is, make sure the setgid bit is not set.
make -v > make.vers 2>&1
if grep GNU make.vers > /dev/null 2>&1; then
- tmp=`/usr/bin/which make`
- case "`/usr/bin/ls -l $tmp`" in
+ tmp=`type make | awk '{print $NF}' | sed 's/[()]//g'`
+ case "`/usr/bin/ls -lL $tmp`" in
??????s*)
cat <<END >&2
@@ -116,24 +126,31 @@ 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'
# 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 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.
-case "`${cc:-cc} -v 2>&1`" in
-*gcc*)
+
+# Get gcc to share its secrets.
+echo 'main() { return 0; }' > try.c
+ # Indent to avoid propagation to config.sh
+ verbose=`${cc:-cc} -v -o try try.c 2>&1`
+
+if echo "$verbose" | grep '^Reading specs from' >/dev/null 2>&1; then
#
# Using gcc.
#
#echo Using gcc
- # Get gcc to share its secrets.
- echo 'main() { return 0; }' > try.c
- verbose=`${cc:-cc} -v -o try try.c 2>&1`
- rm -f try try.c
tmp=`echo "$verbose" | grep '^Reading' |
awk '{print $NF}' | sed 's/specs$/include/'`
@@ -141,36 +158,55 @@ case "`${cc:-cc} -v 2>&1`" in
# Doesn't work anymore for gcc-2.7.2.
# See if as(1) is GNU as(1). GNU as(1) won't work for this job.
- case $verbose in
- */usr/ccs/bin/as*) ;;
- *)
+ if echo "$verbose" | grep ' /usr/ccs/bin/as ' >/dev/null 2>&1; then
+ :
+ else
cat <<END >&2
NOTE: You are using GNU as(1). GNU as(1) will not build Perl.
-You must arrange to use /usr/ccs/bin/as, perhaps by setting
-GCC_EXEC_PREFIX or by including -B/usr/ccs/bin/ in your cc command.
-(Note that the trailing "/" is required.)
+I'm arranging to use /usr/ccs/bin/as by including -B/usr/ccs/bin/
+in your ${cc:-cc} command. (Note that the trailing "/" is required.)
END
- ;;
- esac
+ cc="${cc:-cc} -B/usr/ccs/bin/"
+ fi
# See if ld(1) is GNU ld(1). GNU ld(1) won't work for this job.
- case $verbose in
- */usr/ccs/bin/ld*) ;;
- *)
+ # Recompute $verbose since we may have just changed $cc.
+ verbose=`${cc:-cc} -v -o try try.c 2>&1 | grep ld 2>&1`
+ if echo "$verbose" | grep ' /usr/ccs/bin/ld ' >/dev/null 2>&1; then
+ :
+ else
+ # It's not /usr/ccs/bin/ld - but it might be egcs's ld wrapper,
+ # which calls /usr/ccs/bin/ld in turn. Passing -V to it will
+ # make it show its true colors.
+
+ myld=`echo $verbose| grep ld | awk '/\/ld/ {print $1}'`
+ # This assumes that gcc's output will not change, and that
+ # /full/path/to/ld will be the first word of the output.
+
+ # all Solaris versions of ld I've seen contain the magic
+ # string used in the grep below.
+ if $myld -V 2>&1 | grep "ld: Software Generation Utilities" >/dev/null 2>&1; then
+ cat <<END >&2
+
+Aha. You're using egcs and /usr/ccs/bin/ld.
+
+END
+
+ else
cat <<END >&2
NOTE: You are using GNU ld(1). GNU ld(1) will not build Perl.
-You must arrange to use /usr/ccs/bin/ld, perhaps by setting
-GCC_EXEC_PREFIX or by including -B/usr/ccs/bin/ in your cc command.
+I'm arranging to use /usr/ccs/bin/ld by including -B/usr/ccs/bin/
+in your ${cc:-cc} command. (Note that the trailing "/" is required.)
END
- ;;
- esac
+ cc="${cc:-cc} -B/usr/ccs/bin/"
+ fi
+ fi
- ;; #using gcc
-*)
+else
#
# Not using gcc.
#
@@ -182,8 +218,8 @@ END
cat <<END >&2
NOTE: You are using GNU as(1). GNU as(1) will not build Perl.
-You must arrange to use /usr/ccs/bin, perhaps by adding it to the
-beginning of your PATH.
+You must arrange to use /usr/ccs/bin/as, perhaps by adding /usr/ccs/bin
+to the beginning of your PATH.
END
;;
@@ -200,29 +236,79 @@ END
esac
if $gnu_ld ; then :
else
- case `which ld` in
- no\ ld\ in*|[Cc]ommand\ not\ found*)
- ;;
- /*gnu*/ld|/*GNU*/ld)
+ # 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 <<END >&2
-NOTE: You are using GNU ld(1). GNU ld(1) will not build Perl.
-You must arrange to use /usr/ccs/bin, perhaps by adding it to the
-beginning of your PATH.
+NOTE: You are apparently using GNU ld(1). GNU ld(1) will not build Perl.
+You must arrange to use /usr/ccs/bin/ld, perhaps by adding /usr/ccs/bin
+to the beginning of your PATH.
END
fi
- ;; #not using gcc
-esac
+fi
# as --version or ld --version might dump core.
+rm -f try try.c
rm -f core
+# XXX
+EOSH
+
+# 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]*)
+ ccflags="-D_REENTRANT $ccflags"
+
+ # sched_yield is in -lposix4
+ set `echo X "$libswanted "| sed -e 's/ c / posix4 pthread c /'`
+ shift
+ libswanted="$*"
+
+ # On Solaris 2.6 x86 there is a bug with sigsetjmp() and siglongjmp()
+ # when linked with the threads library, such that whatever positive
+ # value you pass to siglongjmp(), sigsetjmp() returns 1.
+ # Thanks to Simon Parsons <S.Parsons@ftel.co.uk> for this report.
+ # Sun BugID is 4117946, "sigsetjmp always returns 1 when called by
+ # siglongjmp in a MT program". As of 19980622, there is no patch
+ # available.
+ cat >try.c <<'EOM'
+ /* Test for sig(set|long)jmp bug. */
+ #include <setjmp.h>
+
+ 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 && \
+ ${cc:-cc} try.c -lpthread >/dev/null 2>&1 && ./a.out; then
+ d_sigsetjmp=$undef
+ cat << 'EOM' >&2
+
+You will see a *** WHOA THERE!!! *** message from Configure for
+d_sigsetjmp. Keep the recommended value. See hints/solaris_2.sh
+for more information.
+
+EOM
+ fi
+ ;;
+esac
+EOCBU
+
# This is just a trick to include some useful notes.
cat > /dev/null <<'End_of_Solaris_Notes'
diff --git a/gnu/usr.bin/perl/hints/sunos_4_1.sh b/gnu/usr.bin/perl/hints/sunos_4_1.sh
index 07cd89fc7b4..4585d793d76 100644
--- a/gnu/usr.bin/perl/hints/sunos_4_1.sh
+++ b/gnu/usr.bin/perl/hints/sunos_4_1.sh
@@ -1,5 +1,5 @@
# hints/sunos_4_1.sh
-# Last modified: Thu Feb 8 11:46:05 EST 1996
+# Last modified: Wed May 27 11:00:02 EDT 1998
# Andy Dougherty <doughera@lafcol.lafayette.edu>
case "$cc" in
@@ -25,9 +25,7 @@ d_tzname='undef'
# The gcc fix-includes script exposes those incorrect prototypes.
# There may be other examples as well. Volunteers are welcome to
# track them all down :-). In the meantime, we'll just skip unistd.h
-# for SunOS in most of the code. The POSIX extension is built with
-# unistd.h because, even though unistd.h has problems, if used with
-# care, it helps create a better POSIX extension.
+# for SunOS in most of the code. (However, see ext/POSIX/hints/sunos_4.pl.)
i_unistd='undef'
cat << 'EOM' >&4
@@ -37,10 +35,6 @@ d_tzname and i_unistd. Keep the recommended values. See
hints/sunos_4_1.sh for more information.
EOM
-# SunOS 4.1.3 has two extra fields in struct tm. This works around
-# the problem. Other BSD platforms may have similar problems.
-POSIX_cflags='ccflags="$ccflags -DSTRUCT_TM_HASZONE"'
-
# The correct setting of groupstype depends on which version of the C
# library is used. If you are in the 'System V environment'
# (i.e. you have /usr/5bin ahead of /usr/bin in your PATH), and
diff --git a/gnu/usr.bin/perl/hints/svr4.sh b/gnu/usr.bin/perl/hints/svr4.sh
index 922736aa487..cf6906dac78 100644
--- a/gnu/usr.bin/perl/hints/svr4.sh
+++ b/gnu/usr.bin/perl/hints/svr4.sh
@@ -1,15 +1,19 @@
# svr4 hints, System V Release 4.x
-# Last modified 1995/01/28 by Tye McQueen, tye@metronet.com
+# Last modified 1996/10/25 by Tye McQueen, tye@metronet.com
+# Merged 1998/04/23 with perl5.004_04 distribution by
+# Andy Dougherty <doughera@lafayette.edu>
+
# Use Configure -Dcc=gcc to use gcc.
case "$cc" in
'') cc='/bin/cc'
test -f $cc || cc='/usr/ccs/bin/cc'
;;
esac
+
# We include support for using libraries in /usr/ucblib, but the setting
-# of libswanted excludes some libraries found there. You may want to
-# prevent "ucb" from being removed from libswanted and see if perl will
-# build on your system.
+# of libswanted excludes some libraries found there. If you run into
+# problems, you may have to remove "ucb" from libswanted. Just delete
+# the comment '#' from the sed command below.
ldflags='-L/usr/ccs/lib -L/usr/ucblib'
ccflags='-I/usr/include -I/usr/ucbinclude'
# Don't use problematic libraries:
@@ -17,56 +21,127 @@ libswanted=`echo " $libswanted " | sed -e 's/ malloc / /'` # -e 's/ ucb / /'`
# libmalloc.a - Probably using Perl's malloc() anyway.
# libucb.a - Remove it if you have problems ld'ing. We include it because
# it is needed for ODBM_File and NDBM_File extensions.
+
if [ -r /usr/ucblib/libucb.a ]; then # If using BSD-compat. library:
- d_gconvert='undef' # Unusuable under UnixWare 1.1 [use gcvt() instead]
+ d_Gconvert='gcvt((x),(n),(b))' # Try gcvt() before gconvert().
# Use the "native" counterparts, not the BSD emulation stuff:
d_bcmp='undef' d_bcopy='undef' d_bzero='undef' d_safebcpy='undef'
d_index='undef' d_killpg='undef' d_getprior='undef' d_setprior='undef'
- d_setlinebuf='undef' d_setregid='undef' d_setreuid='undef'
+ d_setlinebuf='undef'
+ # d_setregid='undef' d_setreuid='undef' # ???
fi
-d_suidsafe='define' # "./Configure -d" can't figure this out easilly
-usevfork='false'
-# Configure may fail to find lstat() since it's a static/inline
-# function in <sys/stat.h> on Unisys U6000 SVR4, and possibly
-# other SVR4 derivatives.
-d_lstat=define
+# UnixWare has /usr/lib/libc.so.1, /usr/lib/libc.so.1.1, and
+# /usr/ccs/lib/libc.so. Configure chooses libc.so.1.1 while it
+# appears that /usr/ccs/lib/libc.so contains more symbols:
+#
+# Try the following if you want to use nm-extraction. We'll just
+# skip the nm-extraction phase, since searching for all the different
+# library versions will be hard to keep up-to-date.
+#
+# if [ "" = "$libc" -a -f /usr/ccs/lib/libc.so -a \
+# -f /usr/lib/libc.so.1 -a -f /usr/lib/libc.so.1.1 ]; then
+# if nm -h /usr/ccs/lib/libc.so | egrep '\<_?select$' >/dev/null; then
+# if nm -h /usr/lib/libc.so.1 | egrep '\<_?select$'` >/dev/null ||
+# nm -h /usr/lib/libc.so.1.1 | egrep '\<_?select$'` >/dev/null; then
+# :
+# else
+# libc=/usr/ccs/lib/libc.so
+# fi
+# fi
+# fi
+#
+# Don't bother with nm. Just compile & link a small C program.
+case "$usenm" in
+'') usenm=false;;
+esac
+
+# Broken C-Shell tests (Thanks to Tye McQueen):
+# The OS-specific checks may be obsoleted by the this generic test.
+ sh_cnt=`sh -c 'echo /*' | wc -c`
+ csh_cnt=`csh -f -c 'glob /*' 2>/dev/null | wc -c`
+ csh_cnt=`expr 1 + $csh_cnt`
+if [ "$sh_cnt" -ne "$csh_cnt" ]; then
+ echo "You're csh has a broken 'glob', disabling..." >&2
+ d_csh='undef'
+fi
-# UnixWare has a broken csh. The undocumented -X argument to uname is probably
-# a reasonable way of detecting UnixWare. Also in 2.1.1 the fields in
-# FILE* got renamed!
-uw_ver=`uname -v`
-uw_isuw=`uname -X 2>&1 | grep Release`
+# Unixware-specific problems. The undocumented -X argument to uname
+# is probably a reasonable way of detecting UnixWare.
+# UnixWare has a broken csh. (This might already be detected above).
+# In Unixware 2.1.1 the fields in FILE* got renamed!
+# Unixware 1.1 can't cast large floats to 32-bit ints.
+# Configure can't detect memcpy or memset on Unixware 2 or 7
+#
+# Leave leading tabs on the next two lines so Configure doesn't
+# propagate these variables to config.sh
+ uw_ver=`uname -v`
+ uw_isuw=`uname -X 2>&1 | grep Release`
+
+if [ "$uw_isuw" = "Release = 4.2" ]; then
+ case $uw_ver in
+ 1.1)
+ d_casti32='undef'
+ ;;
+ esac
+fi
if [ "$uw_isuw" = "Release = 4.2MP" ]; then
case $uw_ver in
2.1)
- d_csh='undef'
- ;;
+ d_csh='undef'
+ d_memcpy='define'
+ d_memset='define'
+ ;;
2.1.*)
- d_csh='undef'
- stdio_cnt='((fp)->__cnt)'
- d_stdio_cnt_lval='define'
- stdio_ptr='((fp)->__ptr)'
- d_stdio_ptr_lval='define'
- ;;
+ d_csh='undef'
+ d_memcpy='define'
+ d_memset='define'
+ stdio_cnt='((fp)->__cnt)'
+ d_stdio_cnt_lval='define'
+ stdio_ptr='((fp)->__ptr)'
+ d_stdio_ptr_lval='define'
+ ;;
esac
fi
+if [ "$uw_isuw" = "Release = 5" ]; then
+ case $uw_ver in
+ 7)
+ d_csh='undef'
+ d_memcpy='define'
+ d_memset='define'
+ stdio_cnt='((fp)->__cnt)'
+ d_stdio_cnt_lval='define'
+ stdio_ptr='((fp)->__ptr)'
+ d_stdio_ptr_lval='define'
+ ;;
+ esac
+fi
+# End of Unixware-specific tests.
# DDE SMES Supermax Enterprise Server
case "`uname -sm`" in
"UNIX_SV SMES")
- if test "$cc" = '/bin/cc' -o "$gccversion" = ""
- then
- # for cc we need -K PIC (not -K pic)
- cccdlflags="$cccdlflags -K PIC"
- fi
- # the *grent functions are in libgen.
- libswanted="$libswanted gen"
- # csh is broken (also) in SMES
- d_csh='undef'
+ # the *grent functions are in libgen.
+ libswanted="$libswanted gen"
+ # csh is broken (also) in SMES
+ # This may already be detected by the generic test above.
+ d_csh='undef'
+ case "$cc" in
+ *gcc*) ;;
+ *) # for cc we need -K PIC (not -K pic)
+ cccdlflags="$cccdlflags -K PIC"
;;
+ esac
+ ;;
esac
+# Configure may fail to find lstat() since it's a static/inline function
+# in <sys/stat.h> on Unisys U6000 SVR4, UnixWare 2.x, and possibly other
+# SVR4 derivatives. (Though UnixWare has it in /usr/ccs/lib/libc.so.)
+d_lstat=define
+
+d_suidsafe='define' # "./Configure -d" can't figure this out easilly
+
cat <<'EOM' >&4
If you wish to use dynamic linking, you must use
diff --git a/gnu/usr.bin/perl/hints/ultrix_4.sh b/gnu/usr.bin/perl/hints/ultrix_4.sh
index d8d2063b22d..7b841e53fbb 100644
--- a/gnu/usr.bin/perl/hints/ultrix_4.sh
+++ b/gnu/usr.bin/perl/hints/ultrix_4.sh
@@ -34,16 +34,16 @@ case "$cc" in
*gcc*) ;;
*)
case "$osvers" in
- *4.1*) ccflags="$ccflags -DLANGUAGE_C -Olimit 3200" ;;
- *4.2*) ccflags="$ccflags -DLANGUAGE_C -Olimit 3200"
+ *4.1*) ccflags="$ccflags -DLANGUAGE_C -Olimit 3400" ;;
+ *4.2*) ccflags="$ccflags -DLANGUAGE_C -Olimit 3400"
# Prototypes sometimes cause compilation errors in 4.2.
prototype=undef
case "$myuname" in
*risc*) d_volatile=undef ;;
esac
;;
- *4.3*) ccflags="$ccflags -std1 -DLANGUAGE_C -Olimit 3200" ;;
- *) ccflags="$ccflags -std -Olimit 3200" ;;
+ *4.3*) ccflags="$ccflags -std1 -DLANGUAGE_C -Olimit 3400" ;;
+ *) ccflags="$ccflags -std -Olimit 3400" ;;
esac
;;
esac
diff --git a/gnu/usr.bin/perl/hints/unicos.sh b/gnu/usr.bin/perl/hints/unicos.sh
index b864019a841..ab0203bec61 100644
--- a/gnu/usr.bin/perl/hints/unicos.sh
+++ b/gnu/usr.bin/perl/hints/unicos.sh
@@ -1,7 +1,16 @@
case `uname -r` in
6.1*) shellflags="-m+65536" ;;
esac
-optimize="-O1"
+case "$optimize" in
+'') optimize="-O1" ;;
+esac
d_setregid='undef'
d_setreuid='undef'
-
+case "$usemymalloc" in
+'') # The perl malloc.c SHOULD work says Ilya.
+ # But for the time being (5.004_68), alas, it doesn't.
+ # usemymalloc='y'
+ # ccflags="$ccflags -DNO_RCHECK"
+ usemymalloc='n'
+ ;;
+esac
diff --git a/gnu/usr.bin/perl/hints/unicosmk.sh b/gnu/usr.bin/perl/hints/unicosmk.sh
index 90784b5b39f..f0b63cb0ebe 100644
--- a/gnu/usr.bin/perl/hints/unicosmk.sh
+++ b/gnu/usr.bin/perl/hints/unicosmk.sh
@@ -1,3 +1,10 @@
-optimize="-O1"
+case "$optimize" in
+'') optimize="-O1" ;;
+esac
d_setregid='undef'
d_setreuid='undef'
+case "$usemymalloc" in
+'') usemymalloc='y'
+ ccflags="$ccflags -DNO_RCHECK"
+ ;;
+esac
diff --git a/gnu/usr.bin/perl/hv.c b/gnu/usr.bin/perl/hv.c
index 4eaae0f08ce..e0091eac23d 100644
--- a/gnu/usr.bin/perl/hv.c
+++ b/gnu/usr.bin/perl/hv.c
@@ -1,6 +1,6 @@
/* hv.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -14,52 +14,59 @@
#include "EXTERN.h"
#include "perl.h"
+static void hv_magic_check _((HV *hv, bool *needs_copy, bool *needs_store));
+#ifndef PERL_OBJECT
static void hsplit _((HV *hv));
static void hfreeentries _((HV *hv));
+static void more_he _((void));
+#endif
-static HE* more_he();
+#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
+# define ARRAY_ALLOC_BYTES(size) ( (size)*sizeof(HE*) )
+#else
+# define MALLOC_OVERHEAD 16
+# define ARRAY_ALLOC_BYTES(size) ( (size)*sizeof(HE*)*2 - MALLOC_OVERHEAD )
+#endif
-static HE*
-new_he()
+STATIC HE*
+new_he(void)
{
HE* he;
- if (he_root) {
- he = he_root;
- he_root = HeNEXT(he);
- return he;
- }
- return more_he();
+ LOCK_SV_MUTEX;
+ if (!PL_he_root)
+ more_he();
+ he = PL_he_root;
+ PL_he_root = HeNEXT(he);
+ UNLOCK_SV_MUTEX;
+ return he;
}
-static void
-del_he(p)
-HE* p;
+STATIC void
+del_he(HE *p)
{
- HeNEXT(p) = (HE*)he_root;
- he_root = p;
+ LOCK_SV_MUTEX;
+ HeNEXT(p) = (HE*)PL_he_root;
+ PL_he_root = p;
+ UNLOCK_SV_MUTEX;
}
-static HE*
-more_he()
+STATIC void
+more_he(void)
{
register HE* he;
register HE* heend;
- he_root = (HE*)safemalloc(1008);
- he = he_root;
+ New(54, PL_he_root, 1008/sizeof(HE), HE);
+ he = PL_he_root;
heend = &he[1008 / sizeof(HE) - 1];
while (he < heend) {
HeNEXT(he) = (HE*)(he + 1);
he++;
}
HeNEXT(he) = 0;
- return new_he();
}
-static HEK *
-save_hek(str, len, hash)
-char *str;
-I32 len;
-U32 hash;
+STATIC HEK *
+save_hek(char *str, I32 len, U32 hash)
{
char *k;
register HEK *hek;
@@ -74,8 +81,7 @@ U32 hash;
}
void
-unshare_hek(hek)
-HEK *hek;
+unshare_hek(HEK *hek)
{
unsharepvn(HEK_KEY(hek),HEK_LEN(hek),HEK_HASH(hek));
}
@@ -84,11 +90,7 @@ HEK *hek;
* contains an SV* */
SV**
-hv_fetch(hv,key,klen,lval)
-HV *hv;
-char *key;
-U32 klen;
-I32 lval;
+hv_fetch(HV *hv, char *key, U32 klen, I32 lval)
{
register XPVHV* xhv;
register U32 hash;
@@ -100,11 +102,25 @@ I32 lval;
if (SvRMAGICAL(hv)) {
if (mg_find((SV*)hv,'P')) {
+ dTHR;
sv = sv_newmortal();
mg_copy((SV*)hv, sv, key, klen);
- Sv = sv;
- return &Sv;
+ PL_hv_fetch_sv = sv;
+ return &PL_hv_fetch_sv;
}
+#ifdef ENV_IS_CASELESS
+ else if (mg_find((SV*)hv,'E')) {
+ U32 i;
+ for (i = 0; i < klen; ++i)
+ if (isLOWER(key[i])) {
+ char *nkey = strupr(SvPVX(sv_2mortal(newSVpv(key,klen))));
+ SV **ret = hv_fetch(hv, nkey, klen, 0);
+ if (!ret && lval)
+ ret = hv_store(hv, key, klen, NEWSV(61,0), 0);
+ return ret;
+ }
+ }
+#endif
}
xhv = (XPVHV*)SvANY(hv);
@@ -114,7 +130,7 @@ I32 lval;
|| (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
#endif
)
- Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
+ Newz(503,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
else
return 0;
}
@@ -135,7 +151,7 @@ I32 lval;
if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
char *gotenv;
- if ((gotenv = ENV_getenv(key)) != Nullch) {
+ if ((gotenv = PerlEnv_getenv(key)) != Nullch) {
sv = newSVpv(gotenv,strlen(gotenv));
SvTAINTED_on(sv);
return hv_store(hv,key,klen,sv,hash);
@@ -152,11 +168,7 @@ I32 lval;
/* returns a HE * structure with the all fields set */
/* note that hent_val will be a mortal sv for MAGICAL hashes */
HE *
-hv_fetch_ent(hv,keysv,lval,hash)
-HV *hv;
-SV *keysv;
-I32 lval;
-register U32 hash;
+hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash)
{
register XPVHV* xhv;
register char *key;
@@ -167,20 +179,36 @@ register U32 hash;
if (!hv)
return 0;
- if (SvRMAGICAL(hv) && mg_find((SV*)hv,'P')) {
- static HE mh;
-
- sv = sv_newmortal();
- keysv = sv_2mortal(newSVsv(keysv));
- mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
- if (!HeKEY_hek(&mh)) {
- char *k;
- New(54, k, HEK_BASESIZE + sizeof(SV*), char);
- HeKEY_hek(&mh) = (HEK*)k;
+ 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);
+ if (!HeKEY_hek(&PL_hv_fetch_ent_mh)) {
+ char *k;
+ New(54, k, HEK_BASESIZE + sizeof(SV*), char);
+ HeKEY_hek(&PL_hv_fetch_ent_mh) = (HEK*)k;
+ }
+ HeSVKEY_set(&PL_hv_fetch_ent_mh, keysv);
+ HeVAL(&PL_hv_fetch_ent_mh) = sv;
+ return &PL_hv_fetch_ent_mh;
+ }
+#ifdef ENV_IS_CASELESS
+ else if (mg_find((SV*)hv,'E')) {
+ U32 i;
+ key = SvPV(keysv, klen);
+ for (i = 0; i < klen; ++i)
+ if (isLOWER(key[i])) {
+ SV *nkeysv = sv_2mortal(newSVpv(key,klen));
+ (void)strupr(SvPVX(nkeysv));
+ entry = hv_fetch_ent(hv, nkeysv, 0, 0);
+ if (!entry && lval)
+ entry = hv_store_ent(hv, keysv, NEWSV(61,0), hash);
+ return entry;
+ }
}
- HeSVKEY_set(&mh, keysv);
- HeVAL(&mh) = sv;
- return &mh;
+#endif
}
xhv = (XPVHV*)SvANY(hv);
@@ -190,7 +218,7 @@ register U32 hash;
|| (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
#endif
)
- Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
+ Newz(503,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
else
return 0;
}
@@ -214,7 +242,7 @@ register U32 hash;
if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
char *gotenv;
- if ((gotenv = ENV_getenv(key)) != Nullch) {
+ if ((gotenv = PerlEnv_getenv(key)) != Nullch) {
sv = newSVpv(gotenv,strlen(gotenv));
SvTAINTED_on(sv);
return hv_store_ent(hv,keysv,sv,hash);
@@ -228,13 +256,27 @@ register U32 hash;
return 0;
}
+static void
+hv_magic_check (HV *hv, bool *needs_copy, bool *needs_store)
+{
+ MAGIC *mg = SvMAGIC(hv);
+ *needs_copy = FALSE;
+ *needs_store = TRUE;
+ while (mg) {
+ if (isUPPER(mg->mg_type)) {
+ *needs_copy = TRUE;
+ switch (mg->mg_type) {
+ case 'P':
+ case 'S':
+ *needs_store = FALSE;
+ }
+ }
+ mg = mg->mg_moremagic;
+ }
+}
+
SV**
-hv_store(hv,key,klen,val,hash)
-HV *hv;
-char *key;
-U32 klen;
-SV *val;
-register U32 hash;
+hv_store(HV *hv, char *key, U32 klen, SV *val, register U32 hash)
{
register XPVHV* xhv;
register I32 i;
@@ -246,21 +288,27 @@ register U32 hash;
xhv = (XPVHV*)SvANY(hv);
if (SvMAGICAL(hv)) {
- mg_copy((SV*)hv, val, key, klen);
- if (!xhv->xhv_array
- && (SvMAGIC(hv)->mg_moremagic
- || (SvMAGIC(hv)->mg_type != 'E'
-#ifdef OVERLOAD
- && SvMAGIC(hv)->mg_type != 'A'
-#endif /* OVERLOAD */
- )))
- return 0;
+ bool needs_copy;
+ bool needs_store;
+ hv_magic_check (hv, &needs_copy, &needs_store);
+ if (needs_copy) {
+ mg_copy((SV*)hv, val, key, klen);
+ if (!xhv->xhv_array && !needs_store)
+ return 0;
+#ifdef ENV_IS_CASELESS
+ else if (mg_find((SV*)hv,'E')) {
+ SV *sv = sv_2mortal(newSVpv(key,klen));
+ key = strupr(SvPVX(sv));
+ hash = 0;
+ }
+#endif
+ }
}
if (!hash)
PERL_HASH(hash, key, klen);
if (!xhv->xhv_array)
- Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
+ Newz(505, xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
i = 1;
@@ -297,11 +345,7 @@ register U32 hash;
}
HE *
-hv_store_ent(hv,keysv,val,hash)
-HV *hv;
-SV *keysv;
-SV *val;
-register U32 hash;
+hv_store_ent(HV *hv, SV *keysv, SV *val, register U32 hash)
{
register XPVHV* xhv;
register char *key;
@@ -315,29 +359,37 @@ register U32 hash;
xhv = (XPVHV*)SvANY(hv);
if (SvMAGICAL(hv)) {
- bool save_taint = tainted;
- if (tainting)
- tainted = SvTAINTED(keysv);
- keysv = sv_2mortal(newSVsv(keysv));
- mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
- TAINT_IF(save_taint);
- if (!xhv->xhv_array
- && (SvMAGIC(hv)->mg_moremagic
- || (SvMAGIC(hv)->mg_type != 'E'
-#ifdef OVERLOAD
- && SvMAGIC(hv)->mg_type != 'A'
-#endif /* OVERLOAD */
- )))
- return Nullhe;
+ dTHR;
+ bool needs_copy;
+ bool needs_store;
+ hv_magic_check (hv, &needs_copy, &needs_store);
+ if (needs_copy) {
+ bool save_taint = PL_tainted;
+ if (PL_tainting)
+ PL_tainted = SvTAINTED(keysv);
+ keysv = sv_2mortal(newSVsv(keysv));
+ mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
+ TAINT_IF(save_taint);
+ if (!xhv->xhv_array && !needs_store)
+ return Nullhe;
+#ifdef ENV_IS_CASELESS
+ else if (mg_find((SV*)hv,'E')) {
+ key = SvPV(keysv, klen);
+ keysv = sv_2mortal(newSVpv(key,klen));
+ (void)strupr(SvPVX(keysv));
+ hash = 0;
+ }
+#endif
+ }
}
key = SvPV(keysv, klen);
-
+
if (!hash)
PERL_HASH(hash, key, klen);
if (!xhv->xhv_array)
- Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
+ Newz(505, xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
i = 1;
@@ -374,31 +426,40 @@ register U32 hash;
}
SV *
-hv_delete(hv,key,klen,flags)
-HV *hv;
-char *key;
-U32 klen;
-I32 flags;
+hv_delete(HV *hv, char *key, U32 klen, I32 flags)
{
register XPVHV* xhv;
register I32 i;
register U32 hash;
register HE *entry;
register HE **oentry;
+ SV **svp;
SV *sv;
if (!hv)
return Nullsv;
if (SvRMAGICAL(hv)) {
- sv = *hv_fetch(hv, key, klen, TRUE);
- mg_clear(sv);
- if (mg_find(sv, 's')) {
- return Nullsv; /* %SIG elements cannot be deleted */
- }
- if (mg_find(sv, 'p')) {
- sv_unmagic(sv, 'p'); /* No longer an element */
- return sv;
- }
+ bool needs_copy;
+ bool needs_store;
+ hv_magic_check (hv, &needs_copy, &needs_store);
+
+ if (needs_copy && (svp = hv_fetch(hv, key, klen, TRUE))) {
+ sv = *svp;
+ mg_clear(sv);
+ if (!needs_store) {
+ if (mg_find(sv, 'p')) {
+ sv_unmagic(sv, 'p'); /* No longer an element */
+ return sv;
+ }
+ return Nullsv; /* element cannot be deleted */
+ }
+#ifdef ENV_IS_CASELESS
+ else if (mg_find((SV*)hv,'E')) {
+ sv = sv_2mortal(newSVpv(key,klen));
+ key = strupr(SvPVX(sv));
+ }
+#endif
+ }
}
xhv = (XPVHV*)SvANY(hv);
if (!xhv->xhv_array)
@@ -434,11 +495,7 @@ I32 flags;
}
SV *
-hv_delete_ent(hv,keysv,flags,hash)
-HV *hv;
-SV *keysv;
-I32 flags;
-U32 hash;
+hv_delete_ent(HV *hv, SV *keysv, I32 flags, U32 hash)
{
register XPVHV* xhv;
register I32 i;
@@ -451,12 +508,28 @@ U32 hash;
if (!hv)
return Nullsv;
if (SvRMAGICAL(hv)) {
- entry = hv_fetch_ent(hv, keysv, TRUE, hash);
- sv = HeVAL(entry);
- mg_clear(sv);
- if (mg_find(sv, 'p')) {
- sv_unmagic(sv, 'p'); /* No longer an element */
- return sv;
+ bool needs_copy;
+ bool needs_store;
+ hv_magic_check (hv, &needs_copy, &needs_store);
+
+ if (needs_copy && (entry = hv_fetch_ent(hv, keysv, TRUE, hash))) {
+ sv = HeVAL(entry);
+ mg_clear(sv);
+ if (!needs_store) {
+ if (mg_find(sv, 'p')) {
+ sv_unmagic(sv, 'p'); /* No longer an element */
+ return sv;
+ }
+ return Nullsv; /* element cannot be deleted */
+ }
+#ifdef ENV_IS_CASELESS
+ else if (mg_find((SV*)hv,'E')) {
+ key = SvPV(keysv, klen);
+ keysv = sv_2mortal(newSVpv(key,klen));
+ (void)strupr(SvPVX(keysv));
+ hash = 0;
+ }
+#endif
}
}
xhv = (XPVHV*)SvANY(hv);
@@ -496,10 +569,7 @@ U32 hash;
}
bool
-hv_exists(hv,key,klen)
-HV *hv;
-char *key;
-U32 klen;
+hv_exists(HV *hv, char *key, U32 klen)
{
register XPVHV* xhv;
register U32 hash;
@@ -511,11 +581,18 @@ 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'));
return SvTRUE(sv);
}
+#ifdef ENV_IS_CASELESS
+ else if (mg_find((SV*)hv,'E')) {
+ sv = sv_2mortal(newSVpv(key,klen));
+ key = strupr(SvPVX(sv));
+ }
+#endif
}
xhv = (XPVHV*)SvANY(hv);
@@ -539,10 +616,7 @@ U32 klen;
bool
-hv_exists_ent(hv,keysv,hash)
-HV *hv;
-SV *keysv;
-U32 hash;
+hv_exists_ent(HV *hv, SV *keysv, U32 hash)
{
register XPVHV* xhv;
register char *key;
@@ -555,12 +629,21 @@ 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);
magic_existspack(sv, mg_find(sv, 'p'));
return SvTRUE(sv);
}
+#ifdef ENV_IS_CASELESS
+ else if (mg_find((SV*)hv,'E')) {
+ key = SvPV(keysv, klen);
+ keysv = sv_2mortal(newSVpv(key,klen));
+ (void)strupr(SvPVX(keysv));
+ hash = 0;
+ }
+#endif
}
xhv = (XPVHV*)SvANY(hv);
@@ -584,82 +667,78 @@ U32 hash;
return FALSE;
}
-static void
-hsplit(hv)
-HV *hv;
+STATIC void
+hsplit(HV *hv)
{
register XPVHV* xhv = (XPVHV*)SvANY(hv);
I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
register I32 newsize = oldsize * 2;
register I32 i;
- register HE **a;
- register HE **b;
+ register char *a = xhv->xhv_array;
+ register HE **aep;
+ register HE **bep;
register HE *entry;
register HE **oentry;
-#ifndef STRANGE_MALLOC
- I32 tmp;
-#endif
- a = (HE**)xhv->xhv_array;
- nomemok = TRUE;
-#ifdef STRANGE_MALLOC
- Renew(a, newsize, HE*);
+ PL_nomemok = TRUE;
+#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
+ Renew(a, ARRAY_ALLOC_BYTES(newsize), char);
+ if (!a) {
+ PL_nomemok = FALSE;
+ return;
+ }
#else
- i = newsize * sizeof(HE*);
#define MALLOC_OVERHEAD 16
- tmp = MALLOC_OVERHEAD;
- while (tmp - MALLOC_OVERHEAD < i)
- tmp += tmp;
- tmp -= MALLOC_OVERHEAD;
- tmp /= sizeof(HE*);
- assert(tmp >= newsize);
- New(2,a, tmp, HE*);
- Copy(xhv->xhv_array, a, oldsize, HE*);
- if (oldsize >= 64 && !nice_chunk) {
- nice_chunk = (char*)xhv->xhv_array;
- nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD;
+ New(2, a, ARRAY_ALLOC_BYTES(newsize), char);
+ if (!a) {
+ PL_nomemok = FALSE;
+ return;
+ }
+ Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char);
+ if (oldsize >= 64) {
+ offer_nice_chunk(xhv->xhv_array, ARRAY_ALLOC_BYTES(oldsize));
}
else
Safefree(xhv->xhv_array);
#endif
- nomemok = FALSE;
- Zero(&a[oldsize], oldsize, HE*); /* zero 2nd half*/
+ PL_nomemok = FALSE;
+ Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
xhv->xhv_max = --newsize;
- xhv->xhv_array = (char*)a;
+ xhv->xhv_array = a;
+ aep = (HE**)a;
- for (i=0; i<oldsize; i++,a++) {
- if (!*a) /* non-existent */
+ for (i=0; i<oldsize; i++,aep++) {
+ if (!*aep) /* non-existent */
continue;
- b = a+oldsize;
- for (oentry = a, entry = *a; entry; entry = *oentry) {
+ bep = aep+oldsize;
+ for (oentry = aep, entry = *aep; entry; entry = *oentry) {
if ((HeHASH(entry) & newsize) != i) {
*oentry = HeNEXT(entry);
- HeNEXT(entry) = *b;
- if (!*b)
+ HeNEXT(entry) = *bep;
+ if (!*bep)
xhv->xhv_fill++;
- *b = entry;
+ *bep = entry;
continue;
}
else
oentry = &HeNEXT(entry);
}
- if (!*a) /* everything moved */
+ if (!*aep) /* everything moved */
xhv->xhv_fill--;
}
}
void
-hv_ksplit(hv, newmax)
-HV *hv;
-IV newmax;
+hv_ksplit(HV *hv, IV newmax)
{
register XPVHV* xhv = (XPVHV*)SvANY(hv);
I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
register I32 newsize;
register I32 i;
register I32 j;
- register HE **a;
+ register char *a;
+ register HE **aep;
register HE *entry;
register HE **oentry;
@@ -674,61 +753,62 @@ IV newmax;
if (newsize < newmax)
return; /* overflow detection */
- a = (HE**)xhv->xhv_array;
+ a = xhv->xhv_array;
if (a) {
- nomemok = TRUE;
-#ifdef STRANGE_MALLOC
- Renew(a, newsize, HE*);
+ PL_nomemok = TRUE;
+#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
+ Renew(a, ARRAY_ALLOC_BYTES(newsize), char);
+ if (!a) {
+ PL_nomemok = FALSE;
+ return;
+ }
#else
- i = newsize * sizeof(HE*);
- j = MALLOC_OVERHEAD;
- while (j - MALLOC_OVERHEAD < i)
- j += j;
- j -= MALLOC_OVERHEAD;
- j /= sizeof(HE*);
- assert(j >= newsize);
- New(2, a, j, HE*);
- Copy(xhv->xhv_array, a, oldsize, HE*);
- if (oldsize >= 64 && !nice_chunk) {
- nice_chunk = (char*)xhv->xhv_array;
- nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD;
+ New(2, a, ARRAY_ALLOC_BYTES(newsize), char);
+ if (!a) {
+ PL_nomemok = FALSE;
+ return;
+ }
+ Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char);
+ if (oldsize >= 64) {
+ offer_nice_chunk(xhv->xhv_array, ARRAY_ALLOC_BYTES(oldsize));
}
else
Safefree(xhv->xhv_array);
#endif
- nomemok = FALSE;
- Zero(&a[oldsize], newsize-oldsize, HE*); /* zero 2nd half*/
+ PL_nomemok = FALSE;
+ Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
}
else {
- Newz(0, a, newsize, HE*);
+ Newz(0, a, ARRAY_ALLOC_BYTES(newsize), char);
}
xhv->xhv_max = --newsize;
- xhv->xhv_array = (char*)a;
+ xhv->xhv_array = a;
if (!xhv->xhv_fill) /* skip rest if no entries */
return;
- for (i=0; i<oldsize; i++,a++) {
- if (!*a) /* non-existent */
+ aep = (HE**)a;
+ for (i=0; i<oldsize; i++,aep++) {
+ if (!*aep) /* non-existent */
continue;
- for (oentry = a, entry = *a; entry; entry = *oentry) {
+ for (oentry = aep, entry = *aep; entry; entry = *oentry) {
if ((j = (HeHASH(entry) & newsize)) != i) {
j -= i;
*oentry = HeNEXT(entry);
- if (!(HeNEXT(entry) = a[j]))
+ if (!(HeNEXT(entry) = aep[j]))
xhv->xhv_fill++;
- a[j] = entry;
+ aep[j] = entry;
continue;
}
else
oentry = &HeNEXT(entry);
}
- if (!*a) /* everything moved */
+ if (!*aep) /* everything moved */
xhv->xhv_fill--;
}
}
HV *
-newHV()
+newHV(void)
{
register HV *hv;
register XPVHV* xhv;
@@ -748,16 +828,55 @@ newHV()
return hv;
}
+HV *
+newHVhv(HV *ohv)
+{
+ register HV *hv;
+ STRLEN hv_max = ohv ? HvMAX(ohv) : 0;
+ STRLEN hv_fill = ohv ? HvFILL(ohv) : 0;
+
+ hv = newHV();
+ while (hv_max && hv_max + 1 >= hv_fill * 2)
+ hv_max = hv_max / 2; /* Is always 2^n-1 */
+ HvMAX(hv) = hv_max;
+ if (!hv_fill)
+ return hv;
+
+#if 0
+ if (! SvTIED_mg((SV*)ohv, 'P')) {
+ /* Quick way ???*/
+ }
+ else
+#endif
+ {
+ HE *entry;
+ I32 hv_riter = HvRITER(ohv); /* current root of iterator */
+ HE *hv_eiter = HvEITER(ohv); /* current entry of iterator */
+
+ /* Slow way */
+ hv_iterinit(ohv);
+ while (entry = hv_iternext(ohv)) {
+ hv_store(hv, HeKEY(entry), HeKLEN(entry),
+ SvREFCNT_inc(HeVAL(entry)), HeHASH(entry));
+ }
+ HvRITER(ohv) = hv_riter;
+ HvEITER(ohv) = hv_eiter;
+ }
+
+ return hv;
+}
+
void
-hv_free_ent(hv, entry)
-HV *hv;
-register HE *entry;
+hv_free_ent(HV *hv, register HE *entry)
{
+ SV *val;
+
if (!entry)
return;
- if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
- sub_generation++; /* may be deletion of method from stash */
- SvREFCNT_dec(HeVAL(entry));
+ val = HeVAL(entry);
+ if (val && isGV(val) && GvCVu(val) && HvNAME(hv))
+ PL_sub_generation++; /* may be deletion of method from stash */
+ SvREFCNT_dec(val);
if (HeKLEN(entry) == HEf_SVKEY) {
SvREFCNT_dec(HeKEY_sv(entry));
Safefree(HeKEY_hek(entry));
@@ -770,14 +889,12 @@ register HE *entry;
}
void
-hv_delayfree_ent(hv, entry)
-HV *hv;
-register HE *entry;
+hv_delayfree_ent(HV *hv, register HE *entry)
{
if (!entry)
return;
if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
- sub_generation++; /* may be deletion of method from stash */
+ PL_sub_generation++; /* may be deletion of method from stash */
sv_2mortal(HeVAL(entry)); /* free between statements */
if (HeKLEN(entry) == HEf_SVKEY) {
sv_2mortal(HeKEY_sv(entry));
@@ -791,8 +908,7 @@ register HE *entry;
}
void
-hv_clear(hv)
-HV *hv;
+hv_clear(HV *hv)
{
register XPVHV* xhv;
if (!hv)
@@ -808,9 +924,8 @@ HV *hv;
mg_clear((SV*)hv);
}
-static void
-hfreeentries(hv)
-HV *hv;
+STATIC void
+hfreeentries(HV *hv)
{
register HE **array;
register HE *entry;
@@ -843,8 +958,7 @@ HV *hv;
}
void
-hv_undef(hv)
-HV *hv;
+hv_undef(HV *hv)
{
register XPVHV* xhv;
if (!hv)
@@ -866,8 +980,7 @@ HV *hv;
}
I32
-hv_iterinit(hv)
-HV *hv;
+hv_iterinit(HV *hv)
{
register XPVHV* xhv;
HE *entry;
@@ -886,12 +999,11 @@ HV *hv;
}
xhv->xhv_riter = -1;
xhv->xhv_eiter = Null(HE*);
- return xhv->xhv_fill; /* should be xhv->xhv_keys? May change later */
+ return xhv->xhv_keys; /* used to be xhv->xhv_fill before 5.004_65 */
}
HE *
-hv_iternext(hv)
-HV *hv;
+hv_iternext(HV *hv)
{
register XPVHV* xhv;
register HE *entry;
@@ -903,7 +1015,7 @@ HV *hv;
xhv = (XPVHV*)SvANY(hv);
oldentry = entry = xhv->xhv_eiter;
- if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
+ if (mg = SvTIED_mg((SV*)hv, 'P')) {
SV *key = sv_newmortal();
if (entry) {
sv_setsv(key, HeSVKEY_force(entry));
@@ -935,7 +1047,7 @@ HV *hv;
}
if (!xhv->xhv_array)
- Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
+ Newz(506,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
if (entry)
entry = HeNEXT(entry);
while (!entry) {
@@ -957,9 +1069,7 @@ HV *hv;
}
char *
-hv_iterkey(entry,retlen)
-register HE *entry;
-I32 *retlen;
+hv_iterkey(register HE *entry, I32 *retlen)
{
if (HeKLEN(entry) == HEf_SVKEY) {
STRLEN len;
@@ -975,8 +1085,7 @@ I32 *retlen;
/* unlike hv_iterval(), this always returns a mortal copy of the key */
SV *
-hv_iterkeysv(entry)
-register HE *entry;
+hv_iterkeysv(register HE *entry)
{
if (HeKLEN(entry) == HEf_SVKEY)
return sv_mortalcopy(HeKEY_sv(entry));
@@ -986,9 +1095,7 @@ register HE *entry;
}
SV *
-hv_iterval(hv,entry)
-HV *hv;
-register HE *entry;
+hv_iterval(HV *hv, register HE *entry)
{
if (SvRMAGICAL(hv)) {
if (mg_find((SV*)hv,'P')) {
@@ -1003,10 +1110,7 @@ register HE *entry;
}
SV *
-hv_iternextsv(hv, key, retlen)
- HV *hv;
- char **key;
- I32 *retlen;
+hv_iternextsv(HV *hv, char **key, I32 *retlen)
{
HE *he;
if ( (he = hv_iternext(hv)) == NULL)
@@ -1016,19 +1120,13 @@ hv_iternextsv(hv, key, retlen)
}
void
-hv_magic(hv, gv, how)
-HV* hv;
-GV* gv;
-int how;
+hv_magic(HV *hv, GV *gv, int how)
{
sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
}
char*
-sharepvn(sv, len, hash)
-char* sv;
-I32 len;
-U32 hash;
+sharepvn(char *sv, I32 len, U32 hash)
{
return HEK_KEY(share_hek(sv, len, hash));
}
@@ -1037,10 +1135,7 @@ U32 hash;
* len and hash must both be valid for str.
*/
void
-unsharepvn(str, len, hash)
-char* str;
-I32 len;
-U32 hash;
+unsharepvn(char *str, I32 len, U32 hash)
{
register XPVHV* xhv;
register HE *entry;
@@ -1049,12 +1144,13 @@ U32 hash;
I32 found = 0;
/* what follows is the moral equivalent of:
- if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) {
+ if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) {
if (--*Svp == Nullsv)
- hv_delete(strtab, str, len, G_DISCARD, hash);
+ hv_delete(PL_strtab, str, len, G_DISCARD, hash);
} */
- xhv = (XPVHV*)SvANY(strtab);
+ xhv = (XPVHV*)SvANY(PL_strtab);
/* assert(xhv_array != 0) */
+ LOCK_STRTAB_MUTEX;
oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
if (HeHASH(entry) != hash) /* strings can't be equal */
@@ -1074,6 +1170,7 @@ U32 hash;
}
break;
}
+ UNLOCK_STRTAB_MUTEX;
if (!found)
warn("Attempt to free non-existent shared string");
@@ -1084,10 +1181,7 @@ U32 hash;
* len and hash must both be valid for str.
*/
HEK *
-share_hek(str, len, hash)
-char *str;
-I32 len;
-register U32 hash;
+share_hek(char *str, I32 len, register U32 hash)
{
register XPVHV* xhv;
register HE *entry;
@@ -1097,11 +1191,12 @@ register U32 hash;
/* what follows is the moral equivalent of:
- if (!(Svp = hv_fetch(strtab, str, len, FALSE)))
- hv_store(strtab, str, len, Nullsv, hash);
+ if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE)))
+ hv_store(PL_strtab, str, len, Nullsv, hash);
*/
- xhv = (XPVHV*)SvANY(strtab);
+ xhv = (XPVHV*)SvANY(PL_strtab);
/* assert(xhv_array != 0) */
+ LOCK_STRTAB_MUTEX;
oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
if (HeHASH(entry) != hash) /* strings can't be equal */
@@ -1123,12 +1218,14 @@ register U32 hash;
if (i) { /* initial entry? */
++xhv->xhv_fill;
if (xhv->xhv_keys > xhv->xhv_max)
- hsplit(strtab);
+ hsplit(PL_strtab);
}
}
++HeVAL(entry); /* use value slot as REFCNT */
+ UNLOCK_STRTAB_MUTEX;
return HeKEY_hek(entry);
}
+
diff --git a/gnu/usr.bin/perl/hv.h b/gnu/usr.bin/perl/hv.h
index 20af4eab578..007892d412d 100644
--- a/gnu/usr.bin/perl/hv.h
+++ b/gnu/usr.bin/perl/hv.h
@@ -1,6 +1,6 @@
/* hv.h
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -22,11 +22,12 @@ struct hek {
char hek_key[1];
};
+/* This structure must match the beginning of struct xpvmg in sv.h. */
struct xpvhv {
char * xhv_array; /* pointer to malloced string */
STRLEN xhv_fill; /* how full xhv_array currently is */
STRLEN xhv_max; /* subscript of last element of xhv_array */
- I32 xhv_keys; /* how many elements in the array */
+ IV xhv_keys; /* how many elements in the array */
double xnv_nv; /* numeric value, if any */
MAGIC* xmg_magic; /* magic for scalar array */
HV* xmg_stash; /* class package */
@@ -109,7 +110,7 @@ struct xpvhv {
HeKEY_sv(he) : \
sv_2mortal(newSVpv(HeKEY(he), \
HeKLEN(he)))) : \
- &sv_undef)
+ &PL_sv_undef)
#define HeSVKEY_set(he,sv) ((HeKLEN(he) = HEf_SVKEY), (HeKEY_sv(he) = sv))
#define Nullhek Null(HEK*)
diff --git a/gnu/usr.bin/perl/installhtml b/gnu/usr.bin/perl/installhtml
index b677cc29dbc..fd11ee69f48 100644
--- a/gnu/usr.bin/perl/installhtml
+++ b/gnu/usr.bin/perl/installhtml
@@ -295,7 +295,7 @@ sub create_index {
# get the list of .html files in this directory
opendir(DIR, $dir) ||
die "$0: error opening directory $dir for reading: $!\n";
- @files = sort(grep(/\.html$/, readdir(DIR)));
+ @files = sort(grep(/\.html?$/, readdir(DIR)));
closedir(DIR);
open(HTML, ">$html") ||
diff --git a/gnu/usr.bin/perl/installman b/gnu/usr.bin/perl/installman
index 4d74bcfea22..6fa423159fd 100644
--- a/gnu/usr.bin/perl/installman
+++ b/gnu/usr.bin/perl/installman
@@ -3,8 +3,11 @@ BEGIN { @INC = ('lib') }
use Config;
use Getopt::Long;
use File::Find;
+use File::Copy;
use File::Path qw(mkpath);
+use ExtUtils::Packlist;
use subs qw(unlink chmod rename link);
+use vars qw($packlist);
require Cwd;
umask 022;
@@ -50,6 +53,8 @@ $notify = $opt_notify || $opt_n;
-x "t/perl$Config{exe_ext}" || warn "WARNING: You've never run 'make test'!!!",
" (Installing anyway.)\n";
+$packlist = ExtUtils::Packlist->new("$Config{installarchlib}/.packlist");
+
# Install the main pod pages.
runpod2man('pod', $man1dir, $man1ext);
@@ -129,7 +134,7 @@ sub runpod2man {
# Convert name from File/Basename.pm to File::Basename.3 format,
# if necessary.
$manpage =~ s#\.p(m|od)$##;
- if ($^O eq 'os2' || $^O eq 'amigaos') {
+ if ($^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'uwin') {
$manpage =~ s#/#.#g;
} else {
$manpage =~ s#/#::#g;
@@ -156,6 +161,7 @@ sub lsmodpods {
}
}
+$packlist->write() unless $notify;
print STDERR " Installation complete\n";
exit 0;
@@ -194,12 +200,27 @@ print STDERR " unlink $name\n";
}
sub link {
- local($from,$to) = @_;
+ my($from,$to) = @_;
+ my($success) = 0;
print STDERR " ln $from $to\n";
- eval { CORE::link($from,$to) }
-|| system('cp', $from, $to) == 0
-|| warn "Couldn't link $from to $to: $!\n" unless $notify;
+ 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;
+ $packlist->{$to} = { type => 'file' };
+ };
+ if ($@) {
+ File::Copy::copy($from, $to)
+ ? $success++
+ : warn "Couldn't copy $from to $to: $!\n"
+ unless $notify;
+ $packlist->{$to} = { type => 'file' };
+ }
+ $success;
}
sub rename {
@@ -214,6 +235,7 @@ warn("Cannot rename to `$to.$i': $!"), return 0
}
link($from,$to) || return 0;
unlink($from);
+ $packlist->{$to} = { type => 'file' };
}
sub chmod {
diff --git a/gnu/usr.bin/perl/installperl b/gnu/usr.bin/perl/installperl
index 1aea39e7e92..b1d5bfb5c93 100644
--- a/gnu/usr.bin/perl/installperl
+++ b/gnu/usr.bin/perl/installperl
@@ -1,29 +1,43 @@
#!./perl
-# $OpenBSD: installperl,v 1.6 1997/07/24 21:18:44 kstailey Exp $
-#
-# This is hacked up, in order to support DESTDIR and INSTALL_STRIP.
-#
BEGIN {
require 5.004;
+ chdir '..' if !-d 'lib' and -d '..\lib';
@INC = 'lib';
$ENV{PERL5LIB} = 'lib';
}
+use strict;
+use vars qw($Is_VMS $Is_W32 $Is_OS2 $nonono $versiononly $depth);
+
+BEGIN {
+ $Is_VMS = $^O eq 'VMS';
+ $Is_W32 = $^O eq 'MSWin32';
+ $Is_OS2 = $^O eq 'os2';
+ if ($Is_VMS) { eval 'use VMS::Filespec;' }
+}
+
+my $scr_ext = ($Is_VMS ? '.Com' : $Is_W32 ? '.bat' : '');
+
use File::Find;
use File::Compare;
use File::Copy ();
use File::Path ();
+use ExtUtils::Packlist;
use Config;
-use subs qw(unlink link chmod cmd);
+use subs qw(unlink link chmod);
+use vars qw($packlist);
# override the ones in the rest of the script
sub mkpath {
File::Path::mkpath(@_) unless $nonono;
}
-$mainperldir = "/usr/bin";
-$exe_ext = $Config{exe_ext};
+my $mainperldir = "/usr/bin";
+my $exe_ext = $Config{exe_ext};
+
+# Allow ``make install PERLNAME=something_besides_perl'':
+my $perl = defined($ENV{PERLNAME}) ? $ENV{PERLNAME} : 'perl';
while (@ARGV) {
$nonono = 1 if $ARGV[0] eq '-n';
@@ -31,16 +45,37 @@ while (@ARGV) {
shift;
}
-umask 022;
+umask 022 unless $Is_VMS;
-@scripts = qw( utils/c2ph utils/h2ph utils/h2xs
- utils/perlbug utils/perldoc utils/pl2pm utils/splain
- x2p/s2p x2p/find2perl
+my @scripts = qw(utils/c2ph utils/h2ph utils/h2xs utils/perlbug utils/perldoc
+ utils/pl2pm utils/splain utils/perlcc
+ x2p/s2p x2p/find2perl
pod/pod2man pod/pod2html pod/pod2latex pod/pod2text);
-@pods = (<pod/*.pod>);
+if ($scr_ext) { @scripts = map { "$_$scr_ext" } @scripts; }
+
+my @pods = (<pod/*.pod>);
+
+# Specify here any .pm files that are actually architecture-dependent.
+# (Those included with XS extensions under ext/ are automatically
+# added later.)
+# Now that the default privlib has the full perl version number included,
+# we no longer have to play the trick of sticking version-specific .pm
+# files under the archlib directory.
+my %archpms = (
+ Config => 1,
+);
+
+if ($^O eq 'dos') {
+ push(@scripts,'djgpp/fixpmain');
+ $archpms{config} = $archpms{filehand} = 1;
+}
+
+if ((-e "testcompile") && (defined($ENV{'COMPILE'})))
+{
+ push(@scripts, map("$_.exe", @scripts));
+}
-%archpms = (Config => 1, FileHandle => 1, overload => 1);
find(sub {
if ("$File::Find::dir/$_" =~ m{^ext/[^/]+/(.*)\.pm$}) {
(my $pm = $1) =~ s{^lib/}{};
@@ -48,45 +83,37 @@ find(sub {
}
}, 'ext');
-$ver = $];
-$release = substr($ver,0,3); # Not used presently.
-$patchlevel = substr($ver,3,2);
+my $ver = $];
+my $release = substr($ver,0,3); # Not used presently.
+my $patchlevel = substr($ver,3,2);
die "Patchlevel of perl ($patchlevel)",
"and patchlevel of config.sh ($Config{'PATCHLEVEL'}) don't match\n"
if $patchlevel != $Config{'PATCHLEVEL'};
-$installdest = $ENV{"DESTDIR"};
-$installdest =~ s:/+$::;
-if ($installdest ne '') {
- # Fetch some frequently-used items from %Config, prefixing with DESTDIR.
- $installbin = "$installdest/$Config{installbin}";
- $installscript = "$installdest/$Config{installscript}";
- $installprivlib = "$installdest/$Config{installprivlib}";
- $installarchlib = "$installdest/$Config{installarchlib}";
- $installsitelib = "$installdest/$Config{installsitelib}";
- $installsitearch = "$installdest/$Config{installsitearch}";
- $installman1dir = "$installdest/$Config{installman1dir}";
- # Also whack $mainperldir.
- $mainperldir = "$installdest/$mainperldir";
-} else {
- # Fetch some frequently-used items from %Config
- $installbin = $Config{installbin};
- $installscript = $Config{installscript};
- $installprivlib = $Config{installprivlib};
- $installarchlib = $Config{installarchlib};
- $installsitelib = $Config{installsitelib};
- $installsitearch = $Config{installsitearch};
- $installman1dir = $Config{installman1dir};
-}
-
-$man1ext = $Config{man1ext};
-$libperl = $Config{libperl};
+# Fetch some frequently-used items from %Config
+my $installbin = $Config{installbin};
+my $installscript = $Config{installscript};
+my $installprivlib = $Config{installprivlib};
+my $installarchlib = $Config{installarchlib};
+my $installsitelib = $Config{installsitelib};
+my $installsitearch = $Config{installsitearch};
+my $installman1dir = $Config{installman1dir};
+my $man1ext = $Config{man1ext};
+my $libperl = $Config{libperl};
# Shared library and dynamic loading suffixes.
-$so = $Config{so};
-$dlext = $Config{dlext};
+my $so = $Config{so};
+my $dlext = $Config{dlext};
+
+my $d_dosuid = $Config{d_dosuid};
+my $binexp = $Config{binexp};
-$d_dosuid = $Config{d_dosuid};
-$binexp = $Config{binexp};
+if ($Is_VMS) { # Hang in there until File::Spec hits the big time
+ foreach ( \$installbin, \$installscript, \$installprivlib,
+ \$installarchlib, \$installsitelib, \$installsitearch,
+ \$installman1dir ) {
+ $$_ = unixify($$_); $$_ =~ s:/$::;
+ }
+}
# Do some quick sanity checks.
@@ -101,34 +128,66 @@ 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' || warn "WARNING: You've never run 'make test'!!!",
- " (Installing anyway.)\n";
+-x 't/TEST' || $Is_W32
+ || warn "WARNING: You've never run 'make test'!!!",
+ " (Installing anyway.)\n";
-# First we install the version-numbered executables.
+if ($Is_W32) {
+
+my $perldll = 'perl.' . $dlext;
+$perldll = 'perlcore.' . $dlext if $Config{'ccflags'} =~ /PERL_OBJECT/i;
+
+-f $perldll || die "No perl DLL built\n";
-if (defined($ENV{"INSTALL"})) {
- $installcmd = $ENV{"INSTALL"}
- . " " . $ENV{"INSTALL_COPY"}
- . " " . $ENV{"INSTALL_STRIP"};
-} else {
- $installcmd = "cp";
+# Install the DLL
+
+safe_unlink("$installbin/$perldll");
+copy("$perldll", "$installbin/$perldll");
+chmod(0755, "$installbin/$perldll");
}
-safe_unlink("$installbin/perl$ver$exe_ext");
-cmd("$installcmd perl$exe_ext $installbin/perl$ver$exe_ext");
-#copy("perl$exe_ext", "$installbin/perl$ver$exe_ext");
-chmod(0755, "$installbin/perl$ver$exe_ext");
+# This will be used to store the packlist
+my $packlist = ExtUtils::Packlist->new("$installarchlib/.packlist");
+
+# First we install the version-numbered executables.
+
+if ($Is_VMS) {
+ safe_unlink("$installbin/$perl$exe_ext");
+ copy("perl$exe_ext", "$installbin/$perl$exe_ext");
+ chmod(0755, "$installbin/$perl$exe_ext");
+ safe_unlink("$installbin/${perl}shr$exe_ext");
+ copy("perlshr$exe_ext", "$installbin/${perl}shr$exe_ext");
+ chmod(0755, "$installbin/${perl}shr$exe_ext");
+}
+elsif ($^O eq 'mpeix') {
+ # MPE lacks hard links and requires that executables with special
+ # capabilities reside in the MPE namespace.
+ safe_unlink("$installbin/perl$ver$exe_ext", $Config{perlpath});
+ # Install the primary executable into the MPE namespace as perlpath.
+ copy("perl$exe_ext", $Config{perlpath});
+ chmod(0755, $Config{perlpath});
+ # Create a backup copy with the version number.
+ link($Config{perlpath}, "$installbin/perl$ver$exe_ext");
+}
+elsif ($^O ne 'dos') {
+ safe_unlink("$installbin/$perl$ver$exe_ext");
+ copy("perl$exe_ext", "$installbin/$perl$ver$exe_ext");
+ chmod(0755, "$installbin/$perl$ver$exe_ext");
+}
+else {
+ safe_unlink("$installbin/$perl.exe");
+ copy("perl.exe", "$installbin/$perl.exe");
+}
-safe_unlink("$installbin/sperl$ver$exe_ext");
+safe_unlink("$installbin/s$perl$ver$exe_ext");
if ($d_dosuid) {
- cmd("$installcmd suidperl$exe_ext $installbin/sperl$ver$exe_ext");
- #copy("suidperl$exe_ext", "$installbin/sperl$ver$exe_ext");
- chmod(04711, "$installbin/sperl$ver$exe_ext");
+ copy("suidperl$exe_ext", "$installbin/s$perl$ver$exe_ext");
+ chmod(04711, "$installbin/s$perl$ver$exe_ext");
}
# Install library files.
-$do_installarchlib = $do_installprivlib = 0;
+my ($do_installarchlib, $do_installprivlib) = (0, 0);
mkpath($installprivlib, 1, 0777);
mkpath($installarchlib, 1, 0777);
@@ -151,12 +210,25 @@ else {
# Install header files and libraries.
mkpath("$installarchlib/CORE", 1, 0777);
-@corefiles = <*.h libperl*.*>;
-# AIX needs perl.exp installed as well.
-push(@corefiles,'perl.exp') if $^O eq 'aix';
-# If they have built sperl.o...
-push(@corefiles,'sperl.o') if -f 'sperl.o';
-foreach $file (@corefiles) {
+my @corefiles;
+if ($Is_VMS) { # We did core file selection during build
+ my $coredir = "lib/$Config{'arch'}/$]";
+ $coredir =~ tr/./_/;
+ @corefiles = <$coredir/*.*>;
+}
+else {
+ @corefiles = <*.h libperl*.*>;
+ # AIX needs perl.exp installed as well.
+ 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);
+ push(@corefiles,'mpeix/mpeixish.h');
+ }
+ # If they have built sperl.o...
+ push(@corefiles,'sperl.o') if -f 'sperl.o';
+}
+foreach my $file (@corefiles) {
# HP-UX (at least) needs to maintain execute permissions
# on dynamically-loadable libraries. So we do it for all.
copy_if_diff($file,"$installarchlib/CORE/$file")
@@ -164,15 +236,32 @@ foreach $file (@corefiles) {
"$installarchlib/CORE/$file");
}
+# Install main perl executables
+# Make links to ordinary names if installbin directory isn't current directory.
+
+if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VMS) {
+ safe_unlink("$installbin/$perl$exe_ext", "$installbin/suid$perl$exe_ext");
+ if ($^O eq 'mpeix') {
+ # MPE doesn't support hard links, so use a symlink.
+ # We don't want another cloned copy.
+ symlink($Config{perlpath}, "$installbin/perl$exe_ext");
+ } else {
+ link("$installbin/$perl$ver$exe_ext", "$installbin/$perl$exe_ext");
+ }
+ link("$installbin/s$perl$ver$exe_ext", "$installbin/suid$perl$exe_ext")
+ if $d_dosuid;
+}
+
# Offer to install perl in a "standard" location
-$mainperl_is_instperl = 0;
+my $mainperl_is_instperl = 0;
-if (!$versiononly && !$nonono && -t STDIN && -t STDERR
+if ($Config{installusrbinperl} eq 'define' &&
+ !$versiononly && !$nonono && !$Is_W32 && !$Is_VMS && -t STDIN && -t STDERR
&& -w $mainperldir && ! samepath($mainperldir, $installbin)) {
- local($usrbinperl) = "$mainperldir/perl$exe_ext";
- local($instperl) = "$installbin/perl$exe_ext";
- local($expinstperl) = "$binexp/perl$exe_ext";
+ my($usrbinperl) = "$mainperldir/$perl$exe_ext";
+ my($instperl) = "$installbin/$perl$exe_ext";
+ my($expinstperl) = "$binexp/$perl$exe_ext";
# First make sure $usrbinperl is not already the same as the perl we
# just installed.
@@ -190,24 +279,19 @@ if (!$versiononly && !$nonono && -t STDIN && -t STDERR
(yn("Many scripts expect perl to be installed as $usrbinperl.\n" .
"Do you wish to have $usrbinperl be the same as\n" .
"$expinstperl? [y] ")))
- {
+ {
unlink($usrbinperl);
- eval { CORE::link $instperl, $usrbinperl } ||
- eval { symlink $expinstperl, $usrbinperl } ||
- copy($instperl, $usrbinperl);
+ ( $Config{'d_link'} eq 'define' &&
+ eval { CORE::link $instperl, $usrbinperl } ) ||
+ eval { symlink $expinstperl, $usrbinperl } ||
+ copy($instperl, $usrbinperl);
+
$mainperl_is_instperl = 1;
}
}
# Make links to ordinary names if installbin directory isn't current directory.
-if (! $versiononly && ! samepath($installbin, '.')) {
- safe_unlink("$installbin/perl$exe_ext", "$installbin/suidperl$exe_ext");
- link("$installbin/perl$ver$exe_ext", "$installbin/perl$exe_ext");
- link("$installbin/sperl$ver$exe_ext", "$installbin/suidperl$exe_ext")
- if $d_dosuid;
-}
-
if (!$versiononly && ! samepath($installbin, 'x2p')) {
safe_unlink("$installbin/a2p$exe_ext");
copy("x2p/a2p$exe_ext", "$installbin/a2p$exe_ext");
@@ -239,13 +323,17 @@ if (! $versiononly) {
# pstruct should be a link to c2ph
if (! $versiononly) {
- safe_unlink("$installscript/pstruct");
- link("$installscript/c2ph","$installscript/pstruct");
+ safe_unlink("$installscript/pstruct$scr_ext");
+ if ($^O eq 'dos' or $Is_VMS) {
+ copy("$installscript/c2ph$scr_ext", "$installscript/pstruct$scr_ext");
+ } else {
+ link("$installscript/c2ph$scr_ext", "$installscript/pstruct$scr_ext");
+ }
}
# Install pod pages. Where? I guess in $installprivlib/pod.
-if (! $versiononly || !($installprivlib =~ m/\Q$]/)) {
+unless ( $versiononly && !($installprivlib =~ m/\Q$]/)) { # as line 200
mkpath("${installprivlib}/pod", 1, 0777);
# If Perl 5.003's perldiag.pod is there, rename it.
@@ -263,19 +351,11 @@ if (! $versiononly || !($installprivlib =~ m/\Q$]/)) {
}
}
- foreach $file (@pods) {
+ foreach my $file (@pods) {
# $file is a name like pod/perl.pod
copy_if_diff($file, "${installprivlib}/${file}");
}
- # Link perldiag.pod into archlib
- my ($from, $to) = ("${installprivlib}/pod/perldiag.pod",
- "${installarchlib}/pod/perldiag.pod");
- if (compare($from, $to) || $nonono) {
- mkpath("${installarchlib}/pod", 1, 0777);
- unlink($to);
- link($from, $to);
- }
}
# Check to make sure there aren't other perls around in installer's
@@ -285,22 +365,29 @@ if (! $versiononly || !($installprivlib =~ m/\Q$]/)) {
# installed perl.
if (!$versiononly) {
-
- $dirsep = ($^O eq 'os2') ? ';' : ':' ;
+ my ($path, @path);
+ my $dirsep = ($Is_OS2 || $Is_W32) ? ';' : ':' ;
($path = $ENV{"PATH"}) =~ s:\\:/:g ;
@path = split(/$dirsep/, $path);
- @otherperls = ();
+ if ($Is_VMS) {
+ my $i = 0;
+ while (exists $ENV{'DCL$PATH' . $i}) {
+ my $dir = unixpath($ENV{'DCL$PATH' . $i}); $dir =~ s-/$--;
+ push(@path,$dir);
+ }
+ }
+ my @otherperls;
for (@path) {
next unless m,^/,;
# Use &samepath here because some systems have other dirs linked
# to $mainperldir (like SunOS)
next if samepath($_, $binexp);
next if ($mainperl_is_instperl && samepath($_, $mainperldir));
- push(@otherperls, "$_/perl$exe_ext")
- if (-x "$_/perl$exe_ext" && ! -d "$_/perl$exe_ext");
+ push(@otherperls, "$_/$perl$exe_ext")
+ if (-x "$_/$perl$exe_ext" && ! -d "$_/$perl$exe_ext");
}
if (@otherperls) {
- print STDERR "\nWarning: perl appears in your path in the following " .
+ print STDERR "\nWarning: $perl appears in your path in the following " .
"locations beyond where\nwe just installed it:\n";
for (@otherperls) {
print STDERR " ", $_, "\n";
@@ -310,6 +397,7 @@ if (!$versiononly) {
}
+$packlist->write() unless $nonono;
print STDERR " Installation complete\n";
exit 0;
@@ -317,9 +405,9 @@ exit 0;
###############################################################################
sub yn {
- local($prompt) = @_;
- local($answer);
- local($default) = $prompt =~ m/\[([yn])\]\s*$/i;
+ my($prompt) = @_;
+ my($answer);
+ my($default) = $prompt =~ m/\[([yn])\]\s*$/i;
print STDERR $prompt;
chop($answer = <STDIN>);
$answer = $default if $answer =~ m/^\s*$/;
@@ -327,12 +415,14 @@ sub yn {
}
sub unlink {
- local(@names) = @_;
+ my(@names) = @_;
my($cnt) = 0;
- foreach $name (@names) {
+ return scalar(@names) if $Is_VMS;
+
+ foreach my $name (@names) {
next unless -e $name;
- chmod 0777, $name if $^O eq 'os2';
+ chmod 0777, $name if ($Is_OS2 || $Is_W32);
print STDERR " unlink $name\n";
( CORE::unlink($name) and ++$cnt
or warn "Couldn't unlink $name: $!\n" ) unless $nonono;
@@ -341,11 +431,11 @@ sub unlink {
}
sub safe_unlink {
- return if $nonono;
- local @names = @_;
- foreach $name (@names) {
+ return if $nonono or $Is_VMS;
+ my @names = @_;
+ foreach my $name (@names) {
next unless -e $name;
- chmod 0777, $name if $^O eq 'os2';
+ chmod 0777, $name if ($Is_OS2 || $Is_W32);
print STDERR " unlink $name\n";
next if CORE::unlink($name);
warn "Couldn't unlink $name: $!\n";
@@ -358,7 +448,7 @@ sub safe_unlink {
}
sub safe_rename {
- local($from,$to) = @_;
+ my($from,$to) = @_;
if (-f $to and not unlink($to)) {
my($i);
for ($i = 1; $i < 50; $i++) {
@@ -383,28 +473,23 @@ sub link {
? die "AFS" # okay inside eval {}
: warn "Couldn't link $from to $to: $!\n"
unless $nonono;
+ $packlist->{$to} = { from => $from, type => 'link' };
};
if ($@) {
+ print STDERR " creating new version of $to\n" if $Is_VMS and -e $to;
File::Copy::copy($from, $to)
? $success++
: warn "Couldn't copy $from to $to: $!\n"
unless $nonono;
+ $packlist->{$to} = { type => 'file' };
}
$success;
}
-sub cmd {
- my($cmd) = @_;
- print STDERR " $cmd\n";
- unless ($nonono) {
- system $cmd;
- warn "Command failed!!!\n" if $?;
- }
-}
-
sub chmod {
- local($mode,$name) = @_;
+ my($mode,$name) = @_;
+ return if ($^O eq 'dos');
printf STDERR " chmod %o %s\n", $mode, $name;
CORE::chmod($mode,$name)
|| warn sprintf("Couldn't chmod %o %s: $!\n", $mode, $name)
@@ -415,16 +500,20 @@ sub copy {
my($from,$to) = @_;
print STDERR " cp $from $to\n";
+ print STDERR " creating new version of $to\n" if $Is_VMS and -e $to;
File::Copy::copy($from, $to)
|| warn "Couldn't copy $from to $to: $!\n"
unless $nonono;
+ $packlist->{$to} = { type => 'file' };
}
sub samepath {
- local($p1, $p2) = @_;
- local($dev1, $ino1, $dev2, $ino2);
+ my($p1, $p2) = @_;
+
+ return (lc($p1) eq lc($p2)) if $Is_W32;
if ($p1 ne $p2) {
+ my($dev1, $ino1, $dev2, $ino2);
($dev1, $ino1) = stat($p1);
($dev2, $ino2) = stat($p2);
($dev1 == $dev2 && $ino1 == $ino2);
@@ -453,7 +542,9 @@ sub installlib {
my $installlib = $installprivlib;
if ($dir =~ /^auto/ ||
- ($name =~ /^(.*)\.(?:pm|pod)$/ && $archpms{$1})) {
+ ($name =~ /^(.*)\.(?:pm|pod)$/ && $archpms{$1}) ||
+ ($name =~ /^(.*)\.(?:h|lib)$/i && $Is_W32)
+ ) {
$installlib = $installarchlib;
return unless $do_installarchlib;
} else {
@@ -469,6 +560,7 @@ sub installlib {
#This might not work because $archname might have changed.
unlink("$installarchlib/$name");
}
+ $packlist->{"$installlib/$name"} = { type => 'file' };
if (compare($_, "$installlib/$name") || $nonono) {
unlink("$installlib/$name");
mkpath("$installlib/$dir", 1, 0777);
@@ -478,8 +570,6 @@ sub installlib {
and chmod($name =~ /\.(so|$dlext)$/o ? 0555 : 0444,
"$installlib/$name");
}
- } elsif (-d $_) {
- mkpath("$installlib/$name", 1, 0777);
}
}
@@ -495,7 +585,9 @@ sub installlib {
sub copy_if_diff {
my($from,$to)=@_;
+ return 1 if (($^O eq 'VMS') && (-d $from));
-f $from || die "$0: $from not found";
+ $packlist->{$to} = { type => 'file' };
if (compare($from, $to) || $nonono) {
safe_unlink($to); # In case we don't have write permissions.
if ($nonono) {
@@ -503,7 +595,7 @@ sub copy_if_diff {
}
copy($from, $to);
# Restore timestamps if it's a .a library or for OS/2.
- if (!$nonono && ($^O eq 'os2' || $to =~ /\.a$/)) {
+ if (!$nonono && ($Is_OS2 || $to =~ /\.a$/)) {
my ($atime, $mtime) = (stat $from)[8,9];
utime $atime, $mtime, $to;
}
diff --git a/gnu/usr.bin/perl/interp.sym b/gnu/usr.bin/perl/interp.sym
deleted file mode 100644
index 753f53dc45c..00000000000
--- a/gnu/usr.bin/perl/interp.sym
+++ /dev/null
@@ -1,151 +0,0 @@
-Argv
-Cmd
-DBgv
-DBline
-DBsignal
-DBsingle
-DBsub
-DBtrace
-allgvs
-ampergv
-argvgv
-argvoutgv
-basetime
-beginav
-bodytarget
-cddir
-chopset
-copline
-curblock
-curcop
-curcopdb
-curcsv
-curpm
-curstack
-curstash
-curstname
-cxstack
-cxstack_ix
-cxstack_max
-dbargs
-debdelim
-debname
-debstash
-defgv
-defoutgv
-defstash
-delaymagic
-diehook
-dirty
-dlevel
-dlmax
-doextract
-doswitches
-dowarn
-dumplvl
-e_fp
-e_tmpname
-endav
-envgv
-errgv
-eval_root
-eval_start
-fdpid
-filemode
-firstgv
-forkprocess
-formfeed
-formtarget
-gensym
-in_eval
-incgv
-inplace
-last_in_gv
-lastfd
-lastretstr
-lastscream
-lastsize
-lastspbase
-laststatval
-laststype
-leftgv
-lineary
-localizing
-localpatches
-main_cv
-main_root
-main_start
-mainstack
-maxscream
-maxsysfd
-mess_sv
-minus_F
-minus_a
-minus_c
-minus_l
-minus_n
-minus_p
-multiline
-mystack_base
-mystack_mark
-mystack_max
-mystack_sp
-mystrk
-nrs
-ofmt
-ofs
-ofslen
-oldlastpm
-oldname
-op_mask
-origargc
-origargv
-origfilename
-ors
-orslen
-parsehook
-patchlevel
-perldb
-perl_destruct_level
-preambled
-preambleav
-preprocess
-restartop
-rightgv
-rs
-runlevel
-sawampersand
-sawstudy
-sawvec
-screamfirst
-screamnext
-secondgv
-siggv
-signalstack
-sortcop
-sortstack
-sortstash
-splitstr
-start_env
-statcache
-statgv
-statname
-statusvalue
-statusvalue_vms
-stdingv
-strchop
-strtab
-sv_count
-sv_objcount
-sv_root
-sv_arenaroot
-tainted
-tainting
-tmps_floor
-tmps_ix
-tmps_max
-tmps_stack
-top_env
-toptarget
-unsafe
-warnhook
diff --git a/gnu/usr.bin/perl/keywords.h b/gnu/usr.bin/perl/keywords.h
index 2be133b7480..e8188311488 100644
--- a/gnu/usr.bin/perl/keywords.h
+++ b/gnu/usr.bin/perl/keywords.h
@@ -12,236 +12,239 @@
#define KEY_EQ 11
#define KEY_GE 12
#define KEY_GT 13
-#define KEY_LE 14
-#define KEY_LT 15
-#define KEY_NE 16
-#define KEY_abs 17
-#define KEY_accept 18
-#define KEY_alarm 19
-#define KEY_and 20
-#define KEY_atan2 21
-#define KEY_bind 22
-#define KEY_binmode 23
-#define KEY_bless 24
-#define KEY_caller 25
-#define KEY_chdir 26
-#define KEY_chmod 27
-#define KEY_chomp 28
-#define KEY_chop 29
-#define KEY_chown 30
-#define KEY_chr 31
-#define KEY_chroot 32
-#define KEY_close 33
-#define KEY_closedir 34
-#define KEY_cmp 35
-#define KEY_connect 36
-#define KEY_continue 37
-#define KEY_cos 38
-#define KEY_crypt 39
-#define KEY_dbmclose 40
-#define KEY_dbmopen 41
-#define KEY_defined 42
-#define KEY_delete 43
-#define KEY_die 44
-#define KEY_do 45
-#define KEY_dump 46
-#define KEY_each 47
-#define KEY_else 48
-#define KEY_elsif 49
-#define KEY_endgrent 50
-#define KEY_endhostent 51
-#define KEY_endnetent 52
-#define KEY_endprotoent 53
-#define KEY_endpwent 54
-#define KEY_endservent 55
-#define KEY_eof 56
-#define KEY_eq 57
-#define KEY_eval 58
-#define KEY_exec 59
-#define KEY_exists 60
-#define KEY_exit 61
-#define KEY_exp 62
-#define KEY_fcntl 63
-#define KEY_fileno 64
-#define KEY_flock 65
-#define KEY_for 66
-#define KEY_foreach 67
-#define KEY_fork 68
-#define KEY_format 69
-#define KEY_formline 70
-#define KEY_ge 71
-#define KEY_getc 72
-#define KEY_getgrent 73
-#define KEY_getgrgid 74
-#define KEY_getgrnam 75
-#define KEY_gethostbyaddr 76
-#define KEY_gethostbyname 77
-#define KEY_gethostent 78
-#define KEY_getlogin 79
-#define KEY_getnetbyaddr 80
-#define KEY_getnetbyname 81
-#define KEY_getnetent 82
-#define KEY_getpeername 83
-#define KEY_getpgrp 84
-#define KEY_getppid 85
-#define KEY_getpriority 86
-#define KEY_getprotobyname 87
-#define KEY_getprotobynumber 88
-#define KEY_getprotoent 89
-#define KEY_getpwent 90
-#define KEY_getpwnam 91
-#define KEY_getpwuid 92
-#define KEY_getservbyname 93
-#define KEY_getservbyport 94
-#define KEY_getservent 95
-#define KEY_getsockname 96
-#define KEY_getsockopt 97
-#define KEY_glob 98
-#define KEY_gmtime 99
-#define KEY_goto 100
-#define KEY_grep 101
-#define KEY_gt 102
-#define KEY_hex 103
-#define KEY_if 104
-#define KEY_index 105
-#define KEY_int 106
-#define KEY_ioctl 107
-#define KEY_join 108
-#define KEY_keys 109
-#define KEY_kill 110
-#define KEY_last 111
-#define KEY_lc 112
-#define KEY_lcfirst 113
-#define KEY_le 114
-#define KEY_length 115
-#define KEY_link 116
-#define KEY_listen 117
-#define KEY_local 118
-#define KEY_localtime 119
-#define KEY_log 120
-#define KEY_lstat 121
-#define KEY_lt 122
-#define KEY_m 123
-#define KEY_map 124
-#define KEY_mkdir 125
-#define KEY_msgctl 126
-#define KEY_msgget 127
-#define KEY_msgrcv 128
-#define KEY_msgsnd 129
-#define KEY_my 130
-#define KEY_ne 131
-#define KEY_next 132
-#define KEY_no 133
-#define KEY_not 134
-#define KEY_oct 135
-#define KEY_open 136
-#define KEY_opendir 137
-#define KEY_or 138
-#define KEY_ord 139
-#define KEY_pack 140
-#define KEY_package 141
-#define KEY_pipe 142
-#define KEY_pop 143
-#define KEY_pos 144
-#define KEY_print 145
-#define KEY_printf 146
-#define KEY_prototype 147
-#define KEY_push 148
-#define KEY_q 149
-#define KEY_qq 150
-#define KEY_quotemeta 151
-#define KEY_qw 152
-#define KEY_qx 153
-#define KEY_rand 154
-#define KEY_read 155
-#define KEY_readdir 156
-#define KEY_readline 157
-#define KEY_readlink 158
-#define KEY_readpipe 159
-#define KEY_recv 160
-#define KEY_redo 161
-#define KEY_ref 162
-#define KEY_rename 163
-#define KEY_require 164
-#define KEY_reset 165
-#define KEY_return 166
-#define KEY_reverse 167
-#define KEY_rewinddir 168
-#define KEY_rindex 169
-#define KEY_rmdir 170
-#define KEY_s 171
-#define KEY_scalar 172
-#define KEY_seek 173
-#define KEY_seekdir 174
-#define KEY_select 175
-#define KEY_semctl 176
-#define KEY_semget 177
-#define KEY_semop 178
-#define KEY_send 179
-#define KEY_setgrent 180
-#define KEY_sethostent 181
-#define KEY_setnetent 182
-#define KEY_setpgrp 183
-#define KEY_setpriority 184
-#define KEY_setprotoent 185
-#define KEY_setpwent 186
-#define KEY_setservent 187
-#define KEY_setsockopt 188
-#define KEY_shift 189
-#define KEY_shmctl 190
-#define KEY_shmget 191
-#define KEY_shmread 192
-#define KEY_shmwrite 193
-#define KEY_shutdown 194
-#define KEY_sin 195
-#define KEY_sleep 196
-#define KEY_socket 197
-#define KEY_socketpair 198
-#define KEY_sort 199
-#define KEY_splice 200
-#define KEY_split 201
-#define KEY_sprintf 202
-#define KEY_sqrt 203
-#define KEY_srand 204
-#define KEY_stat 205
-#define KEY_study 206
-#define KEY_sub 207
-#define KEY_substr 208
-#define KEY_symlink 209
-#define KEY_syscall 210
-#define KEY_sysopen 211
-#define KEY_sysread 212
-#define KEY_sysseek 213
-#define KEY_system 214
-#define KEY_syswrite 215
-#define KEY_tell 216
-#define KEY_telldir 217
-#define KEY_tie 218
-#define KEY_tied 219
-#define KEY_time 220
-#define KEY_times 221
-#define KEY_tr 222
-#define KEY_truncate 223
-#define KEY_uc 224
-#define KEY_ucfirst 225
-#define KEY_umask 226
-#define KEY_undef 227
-#define KEY_unless 228
-#define KEY_unlink 229
-#define KEY_unpack 230
-#define KEY_unshift 231
-#define KEY_untie 232
-#define KEY_until 233
-#define KEY_use 234
-#define KEY_utime 235
-#define KEY_values 236
-#define KEY_vec 237
-#define KEY_wait 238
-#define KEY_waitpid 239
-#define KEY_wantarray 240
-#define KEY_warn 241
-#define KEY_while 242
-#define KEY_write 243
-#define KEY_x 244
-#define KEY_xor 245
-#define KEY_y 246
+#define KEY_INIT 14
+#define KEY_LE 15
+#define KEY_LT 16
+#define KEY_NE 17
+#define KEY_abs 18
+#define KEY_accept 19
+#define KEY_alarm 20
+#define KEY_and 21
+#define KEY_atan2 22
+#define KEY_bind 23
+#define KEY_binmode 24
+#define KEY_bless 25
+#define KEY_caller 26
+#define KEY_chdir 27
+#define KEY_chmod 28
+#define KEY_chomp 29
+#define KEY_chop 30
+#define KEY_chown 31
+#define KEY_chr 32
+#define KEY_chroot 33
+#define KEY_close 34
+#define KEY_closedir 35
+#define KEY_cmp 36
+#define KEY_connect 37
+#define KEY_continue 38
+#define KEY_cos 39
+#define KEY_crypt 40
+#define KEY_dbmclose 41
+#define KEY_dbmopen 42
+#define KEY_defined 43
+#define KEY_delete 44
+#define KEY_die 45
+#define KEY_do 46
+#define KEY_dump 47
+#define KEY_each 48
+#define KEY_else 49
+#define KEY_elsif 50
+#define KEY_endgrent 51
+#define KEY_endhostent 52
+#define KEY_endnetent 53
+#define KEY_endprotoent 54
+#define KEY_endpwent 55
+#define KEY_endservent 56
+#define KEY_eof 57
+#define KEY_eq 58
+#define KEY_eval 59
+#define KEY_exec 60
+#define KEY_exists 61
+#define KEY_exit 62
+#define KEY_exp 63
+#define KEY_fcntl 64
+#define KEY_fileno 65
+#define KEY_flock 66
+#define KEY_for 67
+#define KEY_foreach 68
+#define KEY_fork 69
+#define KEY_format 70
+#define KEY_formline 71
+#define KEY_ge 72
+#define KEY_getc 73
+#define KEY_getgrent 74
+#define KEY_getgrgid 75
+#define KEY_getgrnam 76
+#define KEY_gethostbyaddr 77
+#define KEY_gethostbyname 78
+#define KEY_gethostent 79
+#define KEY_getlogin 80
+#define KEY_getnetbyaddr 81
+#define KEY_getnetbyname 82
+#define KEY_getnetent 83
+#define KEY_getpeername 84
+#define KEY_getpgrp 85
+#define KEY_getppid 86
+#define KEY_getpriority 87
+#define KEY_getprotobyname 88
+#define KEY_getprotobynumber 89
+#define KEY_getprotoent 90
+#define KEY_getpwent 91
+#define KEY_getpwnam 92
+#define KEY_getpwuid 93
+#define KEY_getservbyname 94
+#define KEY_getservbyport 95
+#define KEY_getservent 96
+#define KEY_getsockname 97
+#define KEY_getsockopt 98
+#define KEY_glob 99
+#define KEY_gmtime 100
+#define KEY_goto 101
+#define KEY_grep 102
+#define KEY_gt 103
+#define KEY_hex 104
+#define KEY_if 105
+#define KEY_index 106
+#define KEY_int 107
+#define KEY_ioctl 108
+#define KEY_join 109
+#define KEY_keys 110
+#define KEY_kill 111
+#define KEY_last 112
+#define KEY_lc 113
+#define KEY_lcfirst 114
+#define KEY_le 115
+#define KEY_length 116
+#define KEY_link 117
+#define KEY_listen 118
+#define KEY_local 119
+#define KEY_localtime 120
+#define KEY_lock 121
+#define KEY_log 122
+#define KEY_lstat 123
+#define KEY_lt 124
+#define KEY_m 125
+#define KEY_map 126
+#define KEY_mkdir 127
+#define KEY_msgctl 128
+#define KEY_msgget 129
+#define KEY_msgrcv 130
+#define KEY_msgsnd 131
+#define KEY_my 132
+#define KEY_ne 133
+#define KEY_next 134
+#define KEY_no 135
+#define KEY_not 136
+#define KEY_oct 137
+#define KEY_open 138
+#define KEY_opendir 139
+#define KEY_or 140
+#define KEY_ord 141
+#define KEY_pack 142
+#define KEY_package 143
+#define KEY_pipe 144
+#define KEY_pop 145
+#define KEY_pos 146
+#define KEY_print 147
+#define KEY_printf 148
+#define KEY_prototype 149
+#define KEY_push 150
+#define KEY_q 151
+#define KEY_qq 152
+#define KEY_qr 153
+#define KEY_quotemeta 154
+#define KEY_qw 155
+#define KEY_qx 156
+#define KEY_rand 157
+#define KEY_read 158
+#define KEY_readdir 159
+#define KEY_readline 160
+#define KEY_readlink 161
+#define KEY_readpipe 162
+#define KEY_recv 163
+#define KEY_redo 164
+#define KEY_ref 165
+#define KEY_rename 166
+#define KEY_require 167
+#define KEY_reset 168
+#define KEY_return 169
+#define KEY_reverse 170
+#define KEY_rewinddir 171
+#define KEY_rindex 172
+#define KEY_rmdir 173
+#define KEY_s 174
+#define KEY_scalar 175
+#define KEY_seek 176
+#define KEY_seekdir 177
+#define KEY_select 178
+#define KEY_semctl 179
+#define KEY_semget 180
+#define KEY_semop 181
+#define KEY_send 182
+#define KEY_setgrent 183
+#define KEY_sethostent 184
+#define KEY_setnetent 185
+#define KEY_setpgrp 186
+#define KEY_setpriority 187
+#define KEY_setprotoent 188
+#define KEY_setpwent 189
+#define KEY_setservent 190
+#define KEY_setsockopt 191
+#define KEY_shift 192
+#define KEY_shmctl 193
+#define KEY_shmget 194
+#define KEY_shmread 195
+#define KEY_shmwrite 196
+#define KEY_shutdown 197
+#define KEY_sin 198
+#define KEY_sleep 199
+#define KEY_socket 200
+#define KEY_socketpair 201
+#define KEY_sort 202
+#define KEY_splice 203
+#define KEY_split 204
+#define KEY_sprintf 205
+#define KEY_sqrt 206
+#define KEY_srand 207
+#define KEY_stat 208
+#define KEY_study 209
+#define KEY_sub 210
+#define KEY_substr 211
+#define KEY_symlink 212
+#define KEY_syscall 213
+#define KEY_sysopen 214
+#define KEY_sysread 215
+#define KEY_sysseek 216
+#define KEY_system 217
+#define KEY_syswrite 218
+#define KEY_tell 219
+#define KEY_telldir 220
+#define KEY_tie 221
+#define KEY_tied 222
+#define KEY_time 223
+#define KEY_times 224
+#define KEY_tr 225
+#define KEY_truncate 226
+#define KEY_uc 227
+#define KEY_ucfirst 228
+#define KEY_umask 229
+#define KEY_undef 230
+#define KEY_unless 231
+#define KEY_unlink 232
+#define KEY_unpack 233
+#define KEY_unshift 234
+#define KEY_untie 235
+#define KEY_until 236
+#define KEY_use 237
+#define KEY_utime 238
+#define KEY_values 239
+#define KEY_vec 240
+#define KEY_wait 241
+#define KEY_waitpid 242
+#define KEY_wantarray 243
+#define KEY_warn 244
+#define KEY_while 245
+#define KEY_write 246
+#define KEY_x 247
+#define KEY_xor 248
+#define KEY_y 249
diff --git a/gnu/usr.bin/perl/keywords.pl b/gnu/usr.bin/perl/keywords.pl
index aebb3ee2e7c..f907e3f115c 100644
--- a/gnu/usr.bin/perl/keywords.pl
+++ b/gnu/usr.bin/perl/keywords.pl
@@ -38,6 +38,7 @@ END
EQ
GE
GT
+INIT
LE
LT
NE
@@ -144,6 +145,7 @@ link
listen
local
localtime
+lock
log
lstat
lt
@@ -175,6 +177,7 @@ prototype
push
q
qq
+qr
quotemeta
qw
qx
diff --git a/gnu/usr.bin/perl/lib/AutoLoader.pm b/gnu/usr.bin/perl/lib/AutoLoader.pm
index 2773a90f10f..5b083a78944 100644
--- a/gnu/usr.bin/perl/lib/AutoLoader.pm
+++ b/gnu/usr.bin/perl/lib/AutoLoader.pm
@@ -2,31 +2,73 @@ package AutoLoader;
use vars qw(@EXPORT @EXPORT_OK);
+my $is_dosish;
+my $is_vms;
+
BEGIN {
require Exporter;
@EXPORT = ();
@EXPORT_OK = qw(AUTOLOAD);
+ $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32';
+ $is_vms = $^O eq 'VMS';
}
AUTOLOAD {
my $name;
# Braces used to preserve $1 et al.
{
- my ($pkg,$func) = $AUTOLOAD =~ /(.*)::([^:]+)$/;
- $pkg =~ s#::#/#g;
- if (defined($name=$INC{"$pkg.pm"}))
- {
- $name =~ s#^(.*)$pkg\.pm$#$1auto/$pkg/$func.al#;
- $name = undef unless (-r $name);
- }
- unless (defined $name)
- {
- $name = "auto/$AUTOLOAD.al";
- $name =~ s#::#/#g;
- }
+ # Try to find the autoloaded file from the package-qualified
+ # name of the sub. e.g., if the sub needed is
+ # Getopt::Long::GetOptions(), then $INC{Getopt/Long.pm} is
+ # something like '/usr/lib/perl5/Getopt/Long.pm', and the
+ # autoload file is '/usr/lib/perl5/auto/Getopt/Long/GetOptions.al'.
+ #
+ # However, if @INC is a relative path, this might not work. If,
+ # for example, @INC = ('lib'), then $INC{Getopt/Long.pm} is
+ # 'lib/Getopt/Long.pm', and we want to require
+ # 'auto/Getopt/Long/GetOptions.al' (without the leading 'lib').
+ # In this case, we simple prepend the 'auto/' and let the
+ # C<require> take care of the searching for us.
+
+ my ($pkg,$func) = $AUTOLOAD =~ /(.*)::([^:]+)$/;
+ $pkg =~ s#::#/#g;
+ if (defined($name=$INC{"$pkg.pm"})) {
+ $name =~ s#^(.*)$pkg\.pm$#$1auto/$pkg/$func.al#;
+
+ # if the file exists, then make sure that it is a
+ # a fully anchored path (i.e either '/usr/lib/auto/foo/bar.al',
+ # or './lib/auto/foo/bar.al'. This avoids C<require> searching
+ # (and failing) to find the 'lib/auto/foo/bar.al' because it
+ # looked for 'lib/lib/auto/foo/bar.al', given @INC = ('lib').
+
+ if (-r $name) {
+ unless ($name =~ m|^/|) {
+ if ($is_dosish) {
+ unless ($name =~ m{^([a-z]:)?[\\/]}i) {
+ $name = "./$name";
+ }
+ }
+ elsif ($is_vms) {
+ # XXX todo by VMSmiths
+ $name = "./$name";
+ }
+ else {
+ $name = "./$name";
+ }
+ }
+ }
+ else {
+ $name = undef;
+ }
+ }
+ unless (defined $name) {
+ # let C<require> do the searching
+ $name = "auto/$AUTOLOAD.al";
+ $name =~ s#::#/#g;
+ }
}
my $save = $@;
- eval {local $SIG{__DIE__};require $name};
+ eval { local $SIG{__DIE__}; require $name };
if ($@) {
if (substr($AUTOLOAD,-9) eq '::DESTROY') {
*$AUTOLOAD = sub {};
@@ -73,7 +115,7 @@ sub import {
# 'auto/POSIX/autosplit.ix' (without the leading 'lib').
#
- (my $calldir = $callpkg) =~ s#::#/#;
+ (my $calldir = $callpkg) =~ s#::#/#g;
my $path = $INC{$calldir . '.pm'};
if (defined($path)) {
# Try absolute path name.
@@ -136,7 +178,7 @@ such a file exists, AUTOLOAD will read and evaluate it,
thus (presumably) defining the needed subroutine. AUTOLOAD will then
C<goto> the newly defined subroutine.
-Once this process completes for a given funtion, it is defined, so
+Once this process completes for a given function, it is defined, so
future calls to the subroutine will bypass the AUTOLOAD mechanism.
=head2 Subroutine Stubs
@@ -224,7 +266,7 @@ C<__DATA__>, after which routines are cached. B<SelfLoader> can also
handle multiple packages in a file.
B<AutoLoader> only reads code as it is requested, and in many cases
-should be faster, but requires a machanism like B<AutoSplit> be used to
+should be faster, but requires a mechanism like B<AutoSplit> be used to
create the individual files. L<ExtUtils::MakeMaker> will invoke
B<AutoSplit> automatically if B<AutoLoader> is used in a module source
file.
@@ -242,6 +284,10 @@ to a subroutine may have a shorter name that the routine itself. This
can lead to conflicting file names. The I<AutoSplit> package warns of
these potential conflicts when used to split a module.
+AutoLoader may fail to find the autosplit files (or even find the wrong
+ones) in cases where C<@INC> contains relative paths, B<and> the program
+does C<chdir>.
+
=head1 SEE ALSO
L<SelfLoader> - an autoloader that doesn't use external files.
diff --git a/gnu/usr.bin/perl/lib/AutoSplit.pm b/gnu/usr.bin/perl/lib/AutoSplit.pm
index 8019df7187b..f8183714d7d 100644
--- a/gnu/usr.bin/perl/lib/AutoSplit.pm
+++ b/gnu/usr.bin/perl/lib/AutoSplit.pm
@@ -1,12 +1,17 @@
package AutoSplit;
-require 5.000;
-require Exporter;
-
-use Config;
-use Carp;
+use Exporter ();
+use Config qw(%Config);
+use Carp qw(carp);
+use File::Basename ();
use File::Path qw(mkpath);
+use strict;
+use vars qw(
+ $VERSION @ISA @EXPORT @EXPORT_OK
+ $Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime
+ );
+$VERSION = "1.0303";
@ISA = qw(Exporter);
@EXPORT = qw(&autosplit &autosplit_lib_modules);
@EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime);
@@ -17,13 +22,9 @@ AutoSplit - split a package for autoloading
=head1 SYNOPSIS
- perl -e 'use AutoSplit; autosplit_lib_modules(@ARGV)' ...
-
- use AutoSplit; autosplit($file, $dir, $keep, $check, $modtime);
-
-for perl versions 5.002 and later:
+ autosplit($file, $dir, $keep, $check, $modtime);
- perl -MAutoSplit -e 'autosplit($ARGV[0], $ARGV[1], $k, $chk, $modtime)' ...
+ autosplit_lib_modules(@modules);
=head1 DESCRIPTION
@@ -37,16 +38,36 @@ class hierarchy, and creates the file F<autosplit.ix>. This file acts as
both forward declaration of all package routines, and as timestamp for the
last update of the hierarchy.
-The remaining three arguments to C<autosplit> govern other options to the
-autosplitter. If the third argument, I<$keep>, is false, then any pre-existing
-C<*.al> files in the autoload directory are removed if they are no longer
-part of the module (obsoleted functions). The fourth argument, I<$check>,
-instructs C<autosplit> to check the module currently being split to ensure
-that it does include a C<use> specification for the AutoLoader module, and
-skips the module if AutoLoader is not detected. Lastly, the I<$modtime>
-argument specifies that C<autosplit> is to check the modification time of the
-module against that of the C<autosplit.ix> file, and only split the module
-if it is newer.
+The remaining three arguments to C<autosplit> govern other options to
+the autosplitter.
+
+=over 2
+
+=item $keep
+
+If the third argument, I<$keep>, is false, then any
+pre-existing C<*.al> files in the autoload directory are removed if
+they are no longer part of the module (obsoleted functions).
+$keep defaults to 0.
+
+=item $check
+
+The
+fourth argument, I<$check>, instructs C<autosplit> to check the module
+currently being split to ensure that it does include a C<use>
+specification for the AutoLoader module, and skips the module if
+AutoLoader is not detected.
+$check defaults to 1.
+
+=item $modtime
+
+Lastly, the I<$modtime> argument specifies
+that C<autosplit> is to check the modification time of the module
+against that of the C<autosplit.ix> file, and only split the module if
+it is newer.
+$modtime defaults to 1.
+
+=back
Typical use of AutoSplit in the perl MakeMaker utility is via the command-line
with:
@@ -65,33 +86,49 @@ B<lib> relative to the current directory. Each file is sent to the
autosplitter one at a time, to be split into the directory B<lib/auto>.
In both usages of the autosplitter, only subroutines defined following the
-perl special marker I<__END__> are split out into separate files. Some
+perl I<__END__> token are split out into separate files. Some
routines may be placed prior to this marker to force their immediate loading
and parsing.
-=head1 CAVEATS
+=head2 Multiple packages
-Currently, C<AutoSplit> cannot handle multiple package specifications
-within one file.
+As of version 1.01 of the AutoSplit module it is possible to have
+multiple packages within a single file. Both of the following cases
+are supported:
+
+ package NAME;
+ __END__
+ sub AAA { ... }
+ package NAME::option1;
+ sub BBB { ... }
+ package NAME::option2;
+ sub BBB { ... }
+
+ package NAME;
+ __END__
+ sub AAA { ... }
+ sub NAME::option1::BBB { ... }
+ sub NAME::option2::BBB { ... }
=head1 DIAGNOSTICS
-C<AutoSplit> will inform the user if it is necessary to create the top-level
-directory specified in the invocation. It is preferred that the script or
-installation process that invokes C<AutoSplit> have created the full directory
-path ahead of time. This warning may indicate that the module is being split
-into an incorrect path.
+C<AutoSplit> will inform the user if it is necessary to create the
+top-level directory specified in the invocation. It is preferred that
+the script or installation process that invokes C<AutoSplit> have
+created the full directory path ahead of time. This warning may
+indicate that the module is being split into an incorrect path.
-C<AutoSplit> will warn the user of all subroutines whose name causes potential
-file naming conflicts on machines with drastically limited (8 characters or
-less) file name length. Since the subroutine name is used as the file name,
-these warnings can aid in portability to such systems.
+C<AutoSplit> will warn the user of all subroutines whose name causes
+potential file naming conflicts on machines with drastically limited
+(8 characters or less) file name length. Since the subroutine name is
+used as the file name, these warnings can aid in portability to such
+systems.
-Warnings are issued and the file skipped if C<AutoSplit> cannot locate either
-the I<__END__> marker or a "package Name;"-style specification.
+Warnings are issued and the file skipped if C<AutoSplit> cannot locate
+either the I<__END__> marker or a "package Name;"-style specification.
-C<AutoSplit> will also emit general diagnostics for inability to create
-directories or files.
+C<AutoSplit> will also emit general diagnostics for inability to
+create directories or files.
=cut
@@ -102,18 +139,21 @@ $Keep = 0;
$CheckForAutoloader = 1;
$CheckModTime = 1;
-$IndexFile = "autosplit.ix"; # file also serves as timestamp
-$maxflen = 255;
+my $IndexFile = "autosplit.ix"; # file also serves as timestamp
+my $maxflen = 255;
$maxflen = 14 if $Config{'d_flexfnam'} ne 'define';
-$Is_VMS = ($^O eq 'VMS');
+if (defined (&Dos::UseLFN)) {
+ $maxflen = Dos::UseLFN() ? 255 : 11;
+}
+my $Is_VMS = ($^O eq 'VMS');
sub autosplit{
- my($file, $autodir, $k, $ckal, $ckmt) = @_;
+ my($file, $autodir, $keep, $ckal, $ckmt) = @_;
# $file - the perl source file to be split (after __END__)
# $autodir - the ".../auto" dir below which to write split subs
# Handle optional flags:
- $keep = $Keep unless defined $k;
+ $keep = $Keep unless defined $keep;
$ckal = $CheckForAutoloader unless defined $ckal;
$ckmt = $CheckModTime unless defined $ckmt;
autosplit_file($file, $autodir, $keep, $ckal, $ckmt);
@@ -136,7 +176,8 @@ sub autosplit_lib_modules{
$dir =~ s#[\.\]]#/#g;
$_ = $dir . $name;
}
- autosplit_file("lib/$_", "lib/auto", $Keep, $CheckForAutoloader, $CheckModTime);
+ autosplit_file("lib/$_", "lib/auto",
+ $Keep, $CheckForAutoloader, $CheckModTime);
}
0;
}
@@ -144,62 +185,66 @@ sub autosplit_lib_modules{
# private functions
-sub autosplit_file{
- my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time) = @_;
- my(@names);
+sub autosplit_file {
+ my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time)
+ = @_;
+ my(@outfiles);
local($_);
+ local($/) = "\n";
# where to write output files
- $autodir = "lib/auto" unless $autodir;
+ $autodir ||= "lib/auto";
if ($Is_VMS) {
- ($autodir = VMS::Filespec::unixpath($autodir)) =~ s{/$}{};
+ ($autodir = VMS::Filespec::unixpath($autodir)) =~ s|/$||;
$filename = VMS::Filespec::unixify($filename); # may have dirs
}
unless (-d $autodir){
mkpath($autodir,0,0755);
- # We should never need to create the auto dir here. installperl
- # (or similar) should have done it. Expecting it to exist is a valuable
- # sanity check against autosplitting into some random directory by mistake.
- print "Warning: AutoSplit had to create top-level $autodir unexpectedly.\n";
+ # We should never need to create the auto dir
+ # here. installperl (or similar) should have done
+ # it. Expecting it to exist is a valuable sanity check against
+ # autosplitting into some random directory by mistake.
+ print "Warning: AutoSplit had to create top-level " .
+ "$autodir unexpectedly.\n";
}
# allow just a package name to be used
$filename .= ".pm" unless ($filename =~ m/\.pm$/);
- open(IN, "<$filename") || die "AutoSplit: Can't open $filename: $!\n";
+ open(IN, "<$filename") or die "AutoSplit: Can't open $filename: $!\n";
my($pm_mod_time) = (stat($filename))[9];
my($autoloader_seen) = 0;
my($in_pod) = 0;
+ my($def_package,$last_package,$this_package,$fnr);
while (<IN>) {
# Skip pod text.
- $in_pod = 1 if /^=/;
+ $fnr++;
+ $in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/);
# record last package name seen
- $package = $1 if (m/^\s*package\s+([\w:]+)\s*;/);
+ $def_package = $1 if (m/^\s*package\s+([\w:]+)\s*;/);
++$autoloader_seen if m/^\s*(use|require)\s+AutoLoader\b/;
++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/;
last if /^__END__/;
}
if ($check_for_autoloader && !$autoloader_seen){
- print "AutoSplit skipped $filename: no AutoLoader used\n" if ($Verbose>=2);
- return 0
+ print "AutoSplit skipped $filename: no AutoLoader used\n"
+ if ($Verbose>=2);
+ return 0;
}
$_ or die "Can't find __END__ in $filename\n";
- $package or die "Can't find 'package Name;' in $filename\n";
+ $def_package or die "Can't find 'package Name;' in $filename\n";
- my($modpname) = $package;
- if ($^O eq 'MSWin32') {
- $modpname =~ s#::#\\#g;
- } else {
- $modpname =~ s#::#/#g;
- }
+ my($modpname) = _modpname($def_package);
- die "Package $package ($modpname.pm) does not match filename $filename"
+ # this _has_ to match so we have a reasonable timestamp file
+ die "Package $def_package ($modpname.pm) does not ".
+ "match filename $filename"
unless ($filename =~ m/\Q$modpname.pm\E$/ or
- ($^O eq "msdos") or ($^O eq 'MSWin32') or
+ ($^O eq 'dos') or ($^O eq 'MSWin32') or
$Is_VMS && $filename =~ m/$modpname.pm/i);
my($al_idx_file) = "$autodir/$modpname/$IndexFile";
@@ -207,14 +252,13 @@ sub autosplit_file{
if ($check_mod_time){
my($al_ts_time) = (stat("$al_idx_file"))[9] || 1;
if ($al_ts_time >= $pm_mod_time){
- print "AutoSplit skipped ($al_idx_file newer that $filename)\n"
+ print "AutoSplit skipped ($al_idx_file newer than $filename)\n"
if ($Verbose >= 2);
return undef; # one undef, not a list
}
}
- my($from) = ($Verbose>=2) ? "$filename => " : "";
- print "AutoSplitting $package ($from$autodir/$modpname)\n"
+ print "AutoSplitting $filename ($autodir/$modpname)\n"
if $Verbose;
unless (-d "$autodir/$modpname"){
@@ -228,68 +272,71 @@ sub autosplit_file{
# This is a problem because some systems silently truncate the file
# names while others treat long file names as an error.
- # We do not yet deal with multiple packages within one file.
- # Ideally both of these styles should work.
- #
- # package NAME;
- # __END__
- # sub AAA { ... }
- # package NAME::option1;
- # sub BBB { ... }
- # package NAME::option2;
- # sub BBB { ... }
- #
- # package NAME;
- # __END__
- # sub AAA { ... }
- # sub NAME::option1::BBB { ... }
- # sub NAME::option2::BBB { ... }
- #
- # For now both of these produce warnings.
-
- open(OUT,">/dev/null") || open(OUT,">nla0:"); # avoid 'not opened' warning
- my(@subnames, %proto);
+ my $Is83 = $maxflen==11; # plain, case INSENSITIVE dos filenames
+
+ my(@subnames, $subname, %proto, %package);
my @cache = ();
my $caching = 1;
+ $last_package = '';
while (<IN>) {
- next if /^=\w/ .. /^=cut/;
- if (/^package ([\w:]+)\s*;/) {
- warn "package $1; in AutoSplit section ignored. Not currently supported.";
+ $fnr++;
+ $in_pod = 1 if /^=/;
+ $in_pod = 0 if /^=cut/;
+ next if ($in_pod || /^=cut/);
+ # the following (tempting) old coding gives big troubles if a
+ # cut is forgotten at EOF:
+ # next if /^=\w/ .. /^=cut/;
+ if (/^package\s+([\w:]+)\s*;/) {
+ $this_package = $def_package = $1;
}
if (/^sub\s+([\w:]+)(\s*\(.*?\))?/) {
- print OUT "1;\n";
- my $subname = $1;
- $proto{$1} = $2 || '';
- if ($subname =~ m/::/){
- warn "subs with package names not currently supported in AutoSplit section";
+ print OUT "# end of $last_package\::$subname\n1;\n"
+ if $last_package;
+ $subname = $1;
+ my $proto = $2 || '';
+ if ($subname =~ s/(.*):://){
+ $this_package = $1;
+ } else {
+ $this_package = $def_package;
}
- push(@subnames, $subname);
+ my $fq_subname = "$this_package\::$subname";
+ $package{$fq_subname} = $this_package;
+ $proto{$fq_subname} = $proto;
+ 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";
- unless(open(OUT, ">$lpath")){
+ my $path;
+ if (!$Is83 and open(OUT, ">$lpath")){
+ $path=$lpath;
+ print " writing $lpath\n" if ($Verbose>=2);
+ } else {
open(OUT, ">$spath") or die "Can't create $spath: $!\n";
- push(@names, $sname);
+ $path=$spath;
print " writing $spath (with truncated name)\n"
if ($Verbose>=1);
- }else{
- push(@names, $lname);
- print " writing $lpath\n" if ($Verbose>=2);
}
- print OUT "# NOTE: Derived from $filename. ",
- "Changes made here will be lost.\n";
- print OUT "package $package;\n\n";
+ push(@outfiles, $path);
+ print OUT <<EOT;
+# NOTE: Derived from $filename.
+# Changes made here will be lost when autosplit again.
+# See AutoSplit.pm.
+package $this_package;
+
+#line $fnr "$filename (autosplit into $path)"
+EOT
print OUT @cache;
@cache = ();
$caching = 0;
}
if($caching) {
push(@cache, $_) if @cache || /\S/;
- }
- else {
+ } else {
print OUT $_;
}
- if(/^}/) {
+ if(/^\}/) {
if($caching) {
print OUT @cache;
@cache = ();
@@ -297,69 +344,118 @@ sub autosplit_file{
print OUT "\n";
$caching = 1;
}
+ $last_package = $this_package if defined $this_package;
}
- print OUT @cache,"1;\n";
+ print OUT @cache,"1;\n# end of $last_package\::$subname\n";
close(OUT);
close(IN);
-
+
if (!$keep){ # don't keep any obsolete *.al files in the directory
- my(%names);
- @names{@names} = @names;
- opendir(OUTDIR,"$autodir/$modpname");
- foreach(sort readdir(OUTDIR)){
- next unless /\.al$/;
- my($subname) = m/(.*)\.al$/;
- next if $names{substr($subname,0,$maxflen-3)};
- my($file) = "$autodir/$modpname/$_";
- print " deleting $file\n" if ($Verbose>=2);
- my($deleted,$thistime); # catch all versions on VMS
- do { $deleted += ($thistime = unlink $file) } while ($thistime);
- carp "Unable to delete $file: $!" unless $deleted;
+ my(%outfiles);
+ # @outfiles{@outfiles} = @outfiles;
+ # perl downcases all filenames on VMS (which upcases all filenames) so
+ # we'd better downcase the sub name list too, or subs with upper case
+ # letters in them will get their .al files deleted right after they're
+ # created. (The mixed case sub name won't match the all-lowercase
+ # filename, and so be cleaned up as a scrap file)
+ if ($Is_VMS or $Is83) {
+ %outfiles = map {lc($_) => lc($_) } @outfiles;
+ } else {
+ @outfiles{@outfiles} = @outfiles;
+ }
+ my(%outdirs,@outdirs);
+ for (@outfiles) {
+ $outdirs{File::Basename::dirname($_)}||=1;
+ }
+ for my $dir (keys %outdirs) {
+ opendir(OUTDIR,$dir);
+ foreach (sort readdir(OUTDIR)){
+ next unless /\.al$/;
+ my($file) = "$dir/$_";
+ $file = lc $file if $Is83 or $Is_VMS;
+ next if $outfiles{$file};
+ print " deleting $file\n" if ($Verbose>=2);
+ my($deleted,$thistime); # catch all versions on VMS
+ do { $deleted += ($thistime = unlink $file) } while ($thistime);
+ carp "Unable to delete $file: $!" unless $deleted;
+ }
+ closedir(OUTDIR);
}
- closedir(OUTDIR);
}
open(TS,">$al_idx_file") or
carp "AutoSplit: unable to create timestamp file ($al_idx_file): $!";
- print TS "# Index created by AutoSplit for $filename (file acts as timestamp)\n";
- print TS "package $package;\n";
- print TS map("sub $_$proto{$_} ;\n", @subnames);
+ print TS "# Index created by AutoSplit for $filename\n";
+ print TS "# (file acts as timestamp)\n";
+ $last_package = '';
+ for my $fqs (@subnames) {
+ my($subname) = $fqs;
+ $subname =~ s/.*:://;
+ print TS "package $package{$fqs};\n"
+ unless $last_package eq $package{$fqs};
+ print TS "sub $subname $proto{$fqs};\n";
+ $last_package = $package{$fqs};
+ }
print TS "1;\n";
close(TS);
- check_unique($package, $Maxlen, 1, @names);
+ _check_unique($filename, $Maxlen, 1, @outfiles);
- @names;
+ @outfiles;
}
+sub _modpname ($) {
+ my($package) = @_;
+ my $modpname = $package;
+ if ($^O eq 'MSWin32') {
+ $modpname =~ s#::#\\#g;
+ } else {
+ $modpname =~ s#::#/#g;
+ }
+ $modpname;
+}
-sub check_unique{
- my($module, $maxlen, $warn, @names) = @_;
+sub _check_unique {
+ my($filename, $maxlen, $warn, @outfiles) = @_;
my(%notuniq) = ();
my(%shorts) = ();
- my(@toolong) = grep(length > $maxlen, @names);
-
- foreach(@toolong){
- my($trunc) = substr($_,0,$maxlen);
- $notuniq{$trunc}=1 if $shorts{$trunc};
- $shorts{$trunc} = ($shorts{$trunc}) ? "$shorts{$trunc}, $_" : $_;
+ my(@toolong) = grep(
+ length(File::Basename::basename($_))
+ > $maxlen,
+ @outfiles
+ );
+
+ foreach (@toolong){
+ my($dir) = File::Basename::dirname($_);
+ my($file) = File::Basename::basename($_);
+ my($trunc) = substr($file,0,$maxlen);
+ $notuniq{$dir}{$trunc} = 1 if $shorts{$dir}{$trunc};
+ $shorts{$dir}{$trunc} = $shorts{$dir}{$trunc} ?
+ "$shorts{$dir}{$trunc}, $file" : $file;
}
if (%notuniq && $warn){
- print "$module: some names are not unique when truncated to $maxlen characters:\n";
- foreach(keys %notuniq){
- print " $shorts{$_} truncate to $_\n";
+ print "$filename: some names are not unique when " .
+ "truncated to $maxlen characters:\n";
+ foreach my $dir (sort keys %notuniq){
+ print " directory $dir:\n";
+ foreach my $trunc (sort keys %{$notuniq{$dir}}) {
+ print " $shorts{$dir}{$trunc} truncate to $trunc\n";
+ }
}
}
- %notuniq;
}
1;
__END__
# test functions so AutoSplit.pm can be applied to itself:
-sub test1{ "test 1\n"; }
-sub test2{ "test 2\n"; }
-sub test3{ "test 3\n"; }
-sub test4{ "test 4\n"; }
-
-
+sub test1 ($) { "test 1\n"; }
+sub test2 ($$) { "test 2\n"; }
+sub test3 ($$$) { "test 3\n"; }
+sub testtesttesttest4_1 { "test 4\n"; }
+sub testtesttesttest4_2 { "duplicate test 4\n"; }
+sub Just::Another::test5 { "another test 5\n"; }
+sub test6 { return join ":", __FILE__,__LINE__; }
+package Yet::Another::AutoSplit;
+sub testtesttesttest4_1 ($) { "another test 4\n"; }
+sub testtesttesttest4_2 ($$) { "another duplicate test 4\n"; }
diff --git a/gnu/usr.bin/perl/lib/Benchmark.pm b/gnu/usr.bin/perl/lib/Benchmark.pm
index 13acf869bc1..ef12d02fcbc 100644
--- a/gnu/usr.bin/perl/lib/Benchmark.pm
+++ b/gnu/usr.bin/perl/lib/Benchmark.pm
@@ -82,6 +82,30 @@ Results will be printed to STDOUT as TITLE followed by the times.
TITLE defaults to "timethis COUNT" if none is provided. STYLE
determines the format of the output, as described for timestr() below.
+The COUNT can be zero or negative: this means the I<minimum number of
+CPU seconds> to run. A zero signifies the default of 3 seconds. For
+example to run at least for 10 seconds:
+
+ timethis(-10, $code)
+
+or to run two pieces of code tests for at least 3 seconds:
+
+ timethese(0, { test1 => '...', test2 => '...'})
+
+CPU seconds is, in UNIX terms, the user time plus the system time of
+the process itself, as opposed to the real (wallclock) time and the
+time spent by the child processes. Less than 0.1 seconds is not
+accepted (-0.01 as the count, for example, will cause a fatal runtime
+exception).
+
+Note that the CPU seconds is the B<minimum> time: CPU scheduling and
+other operating system factors may complicate the attempt so that a
+little bit more time is spent. The benchmark output will, however,
+also tell the number of C<$code> runs/second, which should be a more
+interesting number than the actually spent seconds.
+
+Returns a Benchmark object.
+
=item timethese ( COUNT, CODEHASHREF, [ STYLE ] )
The CODEHASHREF is a reference to a hash containing names as keys
@@ -91,12 +115,21 @@ call
timethis(COUNT, VALUE, KEY, STYLE)
+The routines are called in string comparison order of KEY.
+
+The COUNT can be zero or negative, see timethis().
+
=item timediff ( T1, T2 )
Returns the difference between two Benchmark times as a Benchmark
object suitable for passing to timestr().
-=item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ]] )
+=item timesum ( T1, T2 )
+
+Returns the sum of two Benchmark times as a Benchmark object suitable
+for passing to timestr().
+
+=item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] )
Returns a string that formats the times in the TIMEDIFF object in
the requested STYLE. TIMEDIFF is expected to be a Benchmark object
@@ -205,8 +238,18 @@ March 28th, 1997; by Hugo van der Sanden: added support for code
references and the already documented 'debug' method; revamped
documentation.
+April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time
+functionality.
+
=cut
+# evaluate something in a clean lexical environment
+sub _doeval { eval shift }
+
+#
+# put any lexicals at file scope AFTER here
+#
+
use Carp;
use Exporter;
@ISA=(Exporter);
@@ -237,7 +280,9 @@ sub disablecache { $cache = 0; }
# --- Functions to process the 'time' data type
-sub new { my @t = (time, times); print "new=@t\n" if $debug; bless \@t; }
+sub new { my @t = (time, times, @_ == 2 ? $_[1] : 0);
+ print "new=@t\n" if $debug;
+ bless \@t; }
sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; }
sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; }
@@ -247,29 +292,39 @@ sub real { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r ; }
sub timediff {
my($a, $b) = @_;
my @r;
- for ($i=0; $i < @$a; ++$i) {
+ for (my $i=0; $i < @$a; ++$i) {
push(@r, $a->[$i] - $b->[$i]);
}
bless \@r;
}
+sub timesum {
+ my($a, $b) = @_;
+ my @r;
+ for (my $i=0; $i < @$a; ++$i) {
+ push(@r, $a->[$i] + $b->[$i]);
+ }
+ bless \@r;
+}
+
sub timestr {
my($tr, $style, $f) = @_;
my @t = @$tr;
- warn "bad time value" unless @t==5;
- my($r, $pu, $ps, $cu, $cs) = @t;
+ warn "bad time value (@t)" unless @t==6;
+ my($r, $pu, $ps, $cu, $cs, $n) = @t;
my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
$f = $defaultfmt unless defined $f;
# format a time in the required style, other formats may be added here
$style ||= $defaultstyle;
$style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
my $s = "@t $style"; # default for unknown style
- $s=sprintf("%2d secs (%$f usr %$f sys + %$f cusr %$f csys = %$f cpu)",
+ $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
@t,$t) if $style eq 'all';
- $s=sprintf("%2d secs (%$f usr %$f sys = %$f cpu)",
+ $s=sprintf("%2d wallclock secs (%$f usr + %$f sys = %$f CPU)",
$r,$pu,$ps,$pt) if $style eq 'noc';
- $s=sprintf("%2d secs (%$f cusr %$f csys = %$f cpu)",
+ $s=sprintf("%2d wallclock secs (%$f cusr + %$f csys = %$f CPU)",
$r,$cu,$cs,$ct) if $style eq 'nop';
+ $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n;
$s;
}
@@ -295,16 +350,21 @@ sub runloop {
last if $pack ne $curpack;
}
- my $subcode = (ref $c eq 'CODE')
- ? "sub { package $pack; my(\$_i)=$n; while (\$_i--){&\$c;} }"
- : "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }";
- my $subref = eval $subcode;
+ my ($subcode, $subref);
+ if (ref $c eq 'CODE') {
+ $subcode = "sub { for (1 .. $n) { local \$_; package $pack; &\$c; } }";
+ $subref = eval $subcode;
+ }
+ else {
+ $subcode = "sub { for (1 .. $n) { local \$_; package $pack; $c;} }";
+ $subref = _doeval($subcode);
+ }
croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
print STDERR "runloop $n '$subcode'\n" if $debug;
- $t0 = &new;
+ $t0 = Benchmark->new(0);
&$subref;
- $t1 = &new;
+ $t1 = Benchmark->new($n);
$td = &timediff($t1, $t0);
timedebug("runloop:",$td);
@@ -336,16 +396,98 @@ sub timeit {
$wd;
}
+
+my $default_for = 3;
+my $min_for = 0.1;
+
+sub runfor {
+ my ($code, $tmax) = @_;
+
+ if ( not defined $tmax or $tmax == 0 ) {
+ $tmax = $default_for;
+ } elsif ( $tmax < 0 ) {
+ $tmax = -$tmax;
+ }
+
+ die "runfor(..., $tmax): timelimit cannot be less than $min_for.\n"
+ if $tmax < $min_for;
+
+ my ($n, $td, $tc, $ntot, $rtot, $utot, $stot, $cutot, $cstot );
+
+ # First find the minimum $n that gives a non-zero timing.
+
+ my $nmin;
+
+ for ($n = 1, $tc = 0; $tc <= 0; $n *= 2 ) {
+ $td = timeit($n, $code);
+ $tc = $td->[1] + $td->[2];
+ }
+
+ $nmin = $n;
+
+ my $ttot = 0;
+ my $tpra = 0.05 * $tmax; # Target/time practice.
+
+ # Double $n until we have think we have practiced enough.
+ for ( $n = 1; $ttot < $tpra; $n *= 2 ) {
+ $td = timeit($n, $code);
+ $tc = $td->cpu_p;
+ $ntot += $n;
+ $rtot += $td->[0];
+ $utot += $td->[1];
+ $stot += $td->[2];
+ $ttot = $utot + $stot;
+ $cutot += $td->[3];
+ $cstot += $td->[4];
+ }
+
+ my $r;
+
+ # Then iterate towards the $tmax.
+ while ( $ttot < $tmax ) {
+ $r = $tmax / $ttot - 1; # Linear approximation.
+ $n = int( $r * $n );
+ $n = $nmin if $n < $nmin;
+ $td = timeit($n, $code);
+ $ntot += $n;
+ $rtot += $td->[0];
+ $utot += $td->[1];
+ $stot += $td->[2];
+ $ttot = $utot + $stot;
+ $cutot += $td->[3];
+ $cstot += $td->[4];
+ }
+
+ return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ];
+}
+
# --- Functions implementing high-level time-then-print utilities
+sub n_to_for {
+ my $n = shift;
+ return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
+}
+
sub timethis{
my($n, $code, $title, $style) = @_;
- my $t = timeit($n, $code);
+ my($t, $for, $forn);
+
+ if ( $n > 0 ) {
+ croak "non-integer loopcount $n, stopped" if int($n)<$n;
+ $t = timeit($n, $code);
+ $title = "timethis $n" unless defined $title;
+ } else {
+ $fort = n_to_for( $n );
+ $t = runfor($code, $fort);
+ $title = "timethis for $fort" unless defined $title;
+ $forn = $t->[-1];
+ }
local $| = 1;
- $title = "timethis $n" unless defined $title;
$style = "" unless defined $style;
printf("%10s: ", $title);
- print timestr($t, $style),"\n";
+ print timestr($t, $style, $defaultfmt),"\n";
+
+ $n = $forn if defined $forn;
# A conservative warning to spot very silly tests.
# Don't assume that your benchmark is ok simply because
@@ -363,11 +505,25 @@ sub timethese{
unless ref $alt eq HASH;
my @names = sort keys %$alt;
$style = "" unless defined $style;
- print "Benchmark: timing $n iterations of ",join(', ',@names),"...\n";
+ print "Benchmark: ";
+ if ( $n > 0 ) {
+ croak "non-integer loopcount $n, stopped" if int($n)<$n;
+ print "timing $n iterations of";
+ } else {
+ print "running";
+ }
+ print " ", join(', ',@names);
+ unless ( $n > 0 ) {
+ my $for = n_to_for( $n );
+ print ", each for at least $for CPU seconds";
+ }
+ print "...\n";
# we could save the results in an array and produce a summary here
# sum, min, max, avg etc etc
- map timethis($n, $alt->{$_}, $_, $style), @names;
+ foreach my $name (@names) {
+ timethis ($n, $alt -> {$name}, $name, $style);
+ }
}
1;
diff --git a/gnu/usr.bin/perl/lib/CGI.pm b/gnu/usr.bin/perl/lib/CGI.pm
index 9967a42cf67..f94b2dff9a1 100644
--- a/gnu/usr.bin/perl/lib/CGI.pm
+++ b/gnu/usr.bin/perl/lib/CGI.pm
@@ -1,5 +1,5 @@
package CGI;
-require 5.001;
+require 5.004;
# See the bottom of this file for the POD documentation. Search for the
# string '=head'.
@@ -8,49 +8,77 @@ require 5.001;
# documentation in manual or html file format (these utilities are part of the
# Perl 5 distribution).
-# Copyright 1995-1997 Lincoln D. Stein. All rights reserved.
+# Copyright 1995-1998 Lincoln D. Stein. All rights reserved.
# It may be used and modified freely, but I do request that this copyright
# notice remain attached to the file. You may modify this module as you
# wish, but if you redistribute a modified version, please attach a note
# listing the modifications you have made.
# The most recent version and complete docs are available at:
-# http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
-# ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
-
-# Set this to 1 to enable copious autoloader debugging messages
-$AUTOLOAD_DEBUG=0;
-
-# Set this to 1 to enable NPH scripts
-# or:
-# 1) use CGI qw(:nph)
-# 2) $CGI::nph(1)
-# 3) print header(-nph=>1)
-$NPH=0;
-
-# Set this to 1 to make the temporary files created
-# during file uploads safe from prying eyes
-# or do...
-# 1) use CGI qw(:private_tempfiles)
-# 2) $CGI::private_tempfiles(1);
-$PRIVATE_TEMPFILES=0;
-
-$CGI::revision = '$Id: CGI.pm,v 1.1 1997/11/30 07:56:38 millert Exp $';
-$CGI::VERSION='2.36';
-
-# OVERRIDE THE OS HERE IF CGI.pm GUESSES WRONG
-# $OS = 'UNIX';
-# $OS = 'MACINTOSH';
-# $OS = 'WINDOWS';
-# $OS = 'VMS';
-# $OS = 'OS2';
+# http://stein.cshl.org/WWW/software/CGI/
+
+$CGI::revision = '$Id: CGI.pm,v 1.2 1999/04/29 22:51:41 millert Exp $';
+$CGI::VERSION='2.46';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
# $TempFile::TMPDIRECTORY = '/usr/tmp';
+# >>>>> Here are some globals that you might want to adjust <<<<<<
+sub initialize_globals {
+ # Set this to 1 to enable copious autoloader debugging messages
+ $AUTOLOAD_DEBUG = 0;
+
+ # Change this to the preferred DTD to print in start_html()
+ # or use default_dtd('text of DTD to use');
+ $DEFAULT_DTD = '-//IETF//DTD HTML//EN';
+
+ # Set this to 1 to enable NPH scripts
+ # or:
+ # 1) use CGI qw(-nph)
+ # 2) $CGI::nph(1)
+ # 3) print header(-nph=>1)
+ $NPH = 0;
+
+ # Set this to 1 to disable debugging from the
+ # command line
+ $NO_DEBUG = 0;
+
+ # Set this to 1 to make the temporary files created
+ # during file uploads safe from prying eyes
+ # or do...
+ # 1) use CGI qw(:private_tempfiles)
+ # 2) $CGI::private_tempfiles(1);
+ $PRIVATE_TEMPFILES = 0;
+
+ # Set this to a positive value to limit the size of a POSTing
+ # to a certain number of bytes:
+ $POST_MAX = -1;
+
+ # Change this to 1 to disable uploads entirely:
+ $DISABLE_UPLOADS = 0;
+
+ # Change this to 1 to suppress redundant HTTP headers
+ $HEADERS_ONCE = 0;
+
+ # separate the name=value pairs by semicolons rather than ampersands
+ $USE_PARAM_SEMICOLONS = 0;
+
+ # Other globals that you shouldn't worry about.
+ undef $Q;
+ $BEEN_THERE = 0;
+ undef @QUERY_PARAM;
+ undef %EXPORT;
+
+ # prevent complaints by mod_perl
+ 1;
+}
+
# ------------------ START OF THE LIBRARY ------------
+# make mod_perlhappy
+initialize_globals();
+
# FIGURE OUT THE OS WE'RE RUNNING UNDER
# Some systems support the $^O variable. If not
# available then require() the Config library
@@ -64,7 +92,7 @@ if ($OS=~/Win/i) {
$OS = 'WINDOWS';
} elsif ($OS=~/vms/i) {
$OS = 'VMS';
-} elsif ($OS=~/Mac/i) {
+} elsif ($OS=~/^MacOS$/i) {
$OS = 'MACINTOSH';
} elsif ($OS=~/os2/i) {
$OS = 'OS2';
@@ -77,77 +105,91 @@ $needs_binmode = $OS=~/^(WINDOWS|VMS|OS2)/;
# This is the default class for the CGI object to use when all else fails.
$DefaultClass = 'CGI' unless defined $CGI::DefaultClass;
+
# This is where to look for autoloaded routines.
$AutoloadClass = $DefaultClass unless defined $CGI::AutoloadClass;
# The path separator is a slash, backslash or semicolon, depending
# on the paltform.
$SL = {
- UNIX=>'/',
- OS2=>'\\',
- WINDOWS=>'\\',
- MACINTOSH=>':',
- VMS=>'\\'
+ UNIX=>'/', OS2=>'\\', WINDOWS=>'\\', MACINTOSH=>':', VMS=>'/'
}->{$OS};
+# This no longer seems to be necessary
# Turn on NPH scripts by default when running under IIS server!
-$NPH++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/;
+# $NPH++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/;
+$IIS++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/;
# Turn on special checking for Doug MacEachern's modperl
-if (defined($ENV{'GATEWAY_INTERFACE'}) && ($MOD_PERL = $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl/)) {
- $NPH++;
+if (exists $ENV{'GATEWAY_INTERFACE'}
+ &&
+ ($MOD_PERL = $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl/))
+{
$| = 1;
- $SEQNO = 1;
+ require Apache;
+}
+# Turn on special checking for ActiveState's PerlEx
+$PERLEX++ if defined($ENV{'GATEWAY_INTERFACE'}) && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/;
+
+# Define the CRLF sequence. I can't use a simple "\r\n" because the meaning
+# of "\n" is different on different OS's (sometimes it generates CRLF, sometimes LF
+# and sometimes CR). The most popular VMS web server
+# doesn't accept CRLF -- instead it wants a LR. EBCDIC machines don't
+# use ASCII, so \015\012 means something different. I find this all
+# really annoying.
+$EBCDIC = "\t" ne "\011";
+if ($OS eq 'VMS') {
+ $CRLF = "\n";
+} elsif ($EBCDIC) {
+ $CRLF= "\r\n";
+} else {
+ $CRLF = "\015\012";
}
-# This is really "\r\n", but the meaning of \n is different
-# in MacPerl, so we resort to octal here.
-$CRLF = "\015\012";
-
if ($needs_binmode) {
$CGI::DefaultClass->binmode(main::STDOUT);
$CGI::DefaultClass->binmode(main::STDIN);
$CGI::DefaultClass->binmode(main::STDERR);
}
-# Cute feature, but it broke when the overload mechanism changed...
-# %OVERLOAD = ('""'=>'as_string');
-
%EXPORT_TAGS = (
- ':html2'=>[h1..h6,qw/p br hr ol ul li dl dt dd menu code var strong em
- tt i b blockquote pre img a address cite samp dfn html head
- base body link nextid title meta kbd start_html end_html
- input Select option/],
- ':html3'=>[qw/div table caption th td TR Tr super sub strike applet PARAM embed basefont style span/],
- ':netscape'=>[qw/blink frameset frame script font fontsize center/],
- ':form'=>[qw/textfield textarea filefield password_field hidden checkbox checkbox_group
- submit reset defaults radio_group popup_menu button autoEscape
- scrolling_list image_button start_form end_form startform endform
- start_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/],
- ':cgi'=>[qw/param path_info path_translated url self_url script_name cookie dump
- raw_cookie request_method query_string accept user_agent remote_host
- remote_addr referer server_name server_software server_port server_protocol
- virtual_host remote_ident auth_type http use_named_parameters
- remote_user user_name header redirect import_names put/],
- ':ssl' => [qw/https/],
- ':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam/],
- ':html' => [qw/:html2 :html3 :netscape/],
- ':standard' => [qw/:html2 :form :cgi/],
- ':all' => [qw/:html2 :html3 :netscape :form :cgi/]
- );
+ ':html2'=>['h1'..'h6',qw/p br hr ol ul li dl dt dd menu code var strong em
+ tt u i b blockquote pre img a address cite samp dfn html head
+ base body Link nextid title meta kbd start_html end_html
+ input Select option comment/],
+ ':html3'=>[qw/div table caption th td TR Tr sup Sub strike applet Param
+ embed basefont style span layer ilayer font frameset frame script small big/],
+ ':netscape'=>[qw/blink fontsize center/],
+ ':form'=>[qw/textfield textarea filefield password_field hidden checkbox checkbox_group
+ submit reset defaults radio_group popup_menu button autoEscape
+ scrolling_list image_button start_form end_form startform endform
+ start_multipart_form end_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/],
+ ':cgi'=>[qw/param path_info path_translated url self_url script_name cookie Dump
+ raw_cookie request_method query_string Accept user_agent remote_host
+ remote_addr referer server_name server_software server_port server_protocol
+ virtual_host remote_ident auth_type http use_named_parameters
+ save_parameters restore_parameters param_fetch
+ remote_user user_name header redirect import_names put Delete Delete_all url_param/],
+ ':ssl' => [qw/https/],
+ ':imagemap' => [qw/Area Map/],
+ ':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam/],
+ ':html' => [qw/:html2 :html3 :netscape/],
+ ':standard' => [qw/:html2 :html3 :form :cgi/],
+ ':push' => [qw/multipart_init multipart_start multipart_end/],
+ ':all' => [qw/:html2 :html3 :netscape :form :cgi :internal/]
+ );
# to import symbols into caller
sub import {
my $self = shift;
+
+# This causes modules to clash.
+# undef %EXPORT_OK;
+# undef %EXPORT;
+
+ $self->_setup_symbols(@_);
my ($callpack, $callfile, $callline) = caller;
- foreach (@_) {
- $NPH++, next if $_ eq ':nph';
- $PRIVATE_TEMPFILES++, next if $_ eq ':private_tempfiles';
- foreach (&expand_tags($_)) {
- tr/a-zA-Z0-9_//cd; # don't allow weird function names
- $EXPORT{$_}++;
- }
- }
+
# To allow overriding, search through the packages
# Till we find one in which the correct subroutine is defined.
my @packages = ($self,@{"$self\:\:ISA"});
@@ -164,8 +206,14 @@ sub import {
}
}
+sub compile {
+ my $pack = shift;
+ $pack->_setup_symbols('-compile',@_);
+}
+
sub expand_tags {
my($tag) = @_;
+ return ("start_$1","end_$1") if $tag=~/^(?:\*|start_|end_)(.+)/;
my(@r);
return ($tag) unless $EXPORT_TAGS{$tag};
foreach (@{$EXPORT_TAGS{$tag}}) {
@@ -182,8 +230,11 @@ sub new {
my($class,$initializer) = @_;
my $self = {};
bless $self,ref $class || $class || $DefaultClass;
- $CGI::DefaultClass->_reset_globals() if $MOD_PERL;
- $initializer = to_filehandle($initializer) if $initializer;
+ if ($MOD_PERL) {
+ Apache->request->register_cleanup(\&CGI::_reset_globals);
+ undef $NPH;
+ }
+ $self->_reset_globals if $PERLEX;
$self->init($initializer);
return $self;
}
@@ -230,98 +281,32 @@ sub param {
$name = $p[0];
}
- return () unless defined($name) && $self->{$name};
+ return unless defined($name) && $self->{$name};
return wantarray ? @{$self->{$name}} : $self->{$name}->[0];
}
-#### Method: delete
-# Deletes the named parameter entirely.
-####
-sub delete {
- my($self,$name) = self_or_default(@_);
- delete $self->{$name};
- delete $self->{'.fieldnames'}->{$name};
- @{$self->{'.parameters'}}=grep($_ ne $name,$self->param());
- return wantarray ? () : undef;
-}
-
sub self_or_default {
- return @_ if defined($_[0]) && !ref($_[0]) && ($_[0] eq 'CGI');
+ return @_ if defined($_[0]) && (!ref($_[0])) &&($_[0] eq 'CGI');
unless (defined($_[0]) &&
- ref($_[0]) &&
- (ref($_[0]) eq 'CGI' ||
- eval "\$_[0]->isaCGI()")) { # optimize for the common case
- $CGI::DefaultClass->_reset_globals()
- if defined($Q) && $MOD_PERL && $CGI::DefaultClass->_new_request();
+ (ref($_[0]) eq 'CGI' || UNIVERSAL::isa($_[0],'CGI')) # slightly optimized for common case
+ ) {
$Q = $CGI::DefaultClass->new unless defined($Q);
unshift(@_,$Q);
}
return @_;
}
-sub _new_request {
- return undef unless (defined(Apache->seqno()) or eval { require Apache });
- if (Apache->seqno() != $SEQNO) {
- $SEQNO = Apache->seqno();
- return 1;
- } else {
- return undef;
- }
-}
-
-sub _reset_globals {
- undef $Q;
- undef @QUERY_PARAM;
-}
-
sub self_or_CGI {
local $^W=0; # prevent a warning
if (defined($_[0]) &&
(substr(ref($_[0]),0,3) eq 'CGI'
- || eval "\$_[0]->isaCGI()")) {
+ || UNIVERSAL::isa($_[0],'CGI'))) {
return @_;
} else {
return ($DefaultClass,@_);
}
}
-sub isaCGI {
- return 1;
-}
-
-#### Method: import_names
-# Import all parameters into the given namespace.
-# Assumes namespace 'Q' if not specified
-####
-sub import_names {
- my($self,$namespace) = self_or_default(@_);
- $namespace = 'Q' unless defined($namespace);
- die "Can't import names into 'main'\n"
- if $namespace eq 'main';
- my($param,@value,$var);
- foreach $param ($self->param) {
- # protect against silly names
- ($var = $param)=~tr/a-zA-Z0-9_/_/c;
- $var = "${namespace}::$var";
- @value = $self->param($param);
- @{$var} = @value;
- ${$var} = $value[0];
- }
-}
-
-#### Method: use_named_parameters
-# Force CGI.pm to use named parameter-style method calls
-# rather than positional parameters. The same effect
-# will happen automatically if the first parameter
-# begins with a -.
-sub use_named_parameters {
- my($self,$use_named) = self_or_default(@_);
- return $self->{'.named'} unless defined ($use_named);
-
- # stupidity to avoid annoying warnings
- return $self->{'.named'}=$use_named;
-}
-
########################################
# THESE METHODS ARE MORE OR LESS PRIVATE
# GO TO THE __DATA__ SECTION TO SEE MORE
@@ -337,14 +322,13 @@ sub use_named_parameters {
sub init {
my($self,$initializer) = @_;
- my($query_string,@lines);
- my($meth) = '';
+ my($query_string,$meth,$content_length,$fh,@lines) = ('','','','');
+ local($/) = "\n";
# if we get called more than once, we want to initialize
# ourselves from the original query (which may be gone
# if it was read from STDIN originally.)
if (defined(@QUERY_PARAM) && !defined($initializer)) {
-
foreach (@QUERY_PARAM) {
$self->param('-name'=>$_,'-value'=>$QUERY_PARAM{$_});
}
@@ -352,12 +336,32 @@ sub init {
}
$meth=$ENV{'REQUEST_METHOD'} if defined($ENV{'REQUEST_METHOD'});
+ $content_length = defined($ENV{'CONTENT_LENGTH'}) ? $ENV{'CONTENT_LENGTH'} : 0;
+ die "Client attempted to POST $content_length bytes, but POSTs are limited to $POST_MAX"
+ if ($POST_MAX > 0) && ($content_length > $POST_MAX);
+ $fh = to_filehandle($initializer) if $initializer;
- # If initializer is defined, then read parameters
- # from it.
METHOD: {
- if (defined($initializer)) {
+ # Process multipart postings, but only if the initializer is
+ # not defined.
+ if ($meth eq 'POST'
+ && defined($ENV{'CONTENT_TYPE'})
+ && $ENV{'CONTENT_TYPE'}=~m|^multipart/form-data|
+ && !defined($initializer)
+ ) {
+ my($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary=\"?([^\";,]+)\"?/;
+ $self->read_multipart($boundary,$content_length);
+ last METHOD;
+ }
+
+ # If initializer is defined, then read parameters
+ # from it.
+ if (defined($initializer)) {
+ if (UNIVERSAL::isa($initializer,'CGI')) {
+ $query_string = $initializer->query_string;
+ last METHOD;
+ }
if (ref($initializer) && ref($initializer) eq 'HASH') {
foreach (keys %$initializer) {
$self->param('-name'=>$_,'-value'=>$initializer->{$_});
@@ -365,9 +369,8 @@ sub init {
last METHOD;
}
- $initializer = $$initializer if ref($initializer);
- if (defined(fileno($initializer))) {
- while (<$initializer>) {
+ if (defined($fh) && ($fh ne '')) {
+ while (<$fh>) {
chomp;
last if /^=/;
push(@lines,$_);
@@ -380,49 +383,41 @@ sub init {
}
last METHOD;
}
+
+ # last chance -- treat it as a string
+ $initializer = $$initializer if ref($initializer) eq 'SCALAR';
$query_string = $initializer;
+
last METHOD;
}
- # If method is GET or HEAD, fetch the query from
- # the environment.
- if ($meth=~/^(GET|HEAD)$/) {
- $query_string = $ENV{'QUERY_STRING'};
- last METHOD;
- }
-
- # If the method is POST, fetch the query from standard
- # input.
- if ($meth eq 'POST') {
- if (defined($ENV{'CONTENT_TYPE'})
- &&
- $ENV{'CONTENT_TYPE'}=~m|^multipart/form-data|) {
- my($boundary) = $ENV{'CONTENT_TYPE'}=~/boundary=(\S+)/;
- $self->read_multipart($boundary,$ENV{'CONTENT_LENGTH'});
-
- } else {
-
- $self->read_from_client(\*STDIN,\$query_string,$ENV{'CONTENT_LENGTH'},0)
- if $ENV{'CONTENT_LENGTH'} > 0;
+ # If method is GET or HEAD, fetch the query from
+ # the environment.
+ if ($meth=~/^(GET|HEAD)$/) {
+ $query_string = $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'};
+ last METHOD;
+ }
- }
+ if ($meth eq 'POST') {
+ $self->read_from_client(\*STDIN,\$query_string,$content_length,0)
+ if $content_length > 0;
# Some people want to have their cake and eat it too!
# Uncomment this line to have the contents of the query string
# APPENDED to the POST data.
- # $query_string .= ($query_string ? '&' : '') . $ENV{'QUERY_STRING'} if $ENV{'QUERY_STRING'};
+ # $query_string .= (length($query_string) ? '&' : '') . $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'};
last METHOD;
}
-
- # If neither is set, assume we're being debugged offline.
+
+ # If $meth is not of GET, POST or HEAD, assume we're being debugged offline.
# Check the command line and then the standard input for data.
# We use the shellwords package in order to behave the way that
# UN*X programmers expect.
- $query_string = &read_from_cmdline;
+ $query_string = read_from_cmdline() unless $NO_DEBUG;
}
-
+
# We now have the query string in hand. We do slightly
# different things for keyword lists and parameter lists.
- if ($query_string) {
+ if ($query_string ne '') {
if ($query_string =~ /=/) {
$self->parse_params($query_string);
} else {
@@ -447,39 +442,23 @@ sub init {
$self->delete('.submit');
$self->delete('.cgifields');
$self->save_request unless $initializer;
-
}
-
# FUNCTIONS TO OVERRIDE:
-
# Turn a string into a filehandle
sub to_filehandle {
- my $string = shift;
- if ($string && !ref($string)) {
- my($package) = caller(1);
- my($tmp) = $string=~/[':]/ ? $string : "$package\:\:$string";
- return $tmp if defined(fileno($tmp));
+ my $thingy = shift;
+ return undef unless $thingy;
+ return $thingy if UNIVERSAL::isa($thingy,'GLOB');
+ return $thingy if UNIVERSAL::isa($thingy,'FileHandle');
+ if (!ref($thingy)) {
+ my $caller = 1;
+ while (my $package = caller($caller++)) {
+ my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy";
+ return $tmp if defined(fileno($tmp));
+ }
}
- return $string;
-}
-
-# Create a new multipart buffer
-sub new_MultipartBuffer {
- my($self,$boundary,$length,$filehandle) = @_;
- return MultipartBuffer->new($self,$boundary,$length,$filehandle);
-}
-
-# Read data from a file handle
-sub read_from_client {
- my($self, $fh, $buff, $len, $offset) = @_;
- local $^W=0; # prevent a warning
- return read($fh, $$buff, $len, $offset);
-}
-
-# put a filehandle into binary mode (DOS)
-sub binmode {
- binmode($_[1]);
+ return undef;
}
# send output to the browser
@@ -496,7 +475,9 @@ sub print {
# unescape URL-encoded data
sub unescape {
- my($todecode) = @_;
+ shift() if ref($_[0]);
+ my $todecode = shift;
+ return undef unless defined($todecode);
$todecode =~ tr/+/ /; # pluses become spaces
$todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
return $todecode;
@@ -504,8 +485,10 @@ sub unescape {
# URL-encode data
sub escape {
- my($toencode) = @_;
- $toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
+ shift() if ref($_[0]) || $_[0] eq $DefaultClass;
+ my $toencode = shift;
+ return undef unless defined($toencode);
+ $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
return $toencode;
}
@@ -520,22 +503,14 @@ sub save_request {
}
}
-sub parse_keywordlist {
- my($self,$tosplit) = @_;
- $tosplit = &unescape($tosplit); # unescape the keywords
- $tosplit=~tr/+/ /; # pluses to spaces
- my(@keywords) = split(/\s+/,$tosplit);
- return @keywords;
-}
-
sub parse_params {
my($self,$tosplit) = @_;
- my(@pairs) = split('&',$tosplit);
+ my(@pairs) = split(/[&;]/,$tosplit);
my($param,$value);
foreach (@pairs) {
- ($param,$value) = split('=');
- $param = &unescape($param);
- $value = &unescape($value);
+ ($param,$value) = split('=',$_,2);
+ $param = unescape($param);
+ $value = unescape($value);
$self->add_parameter($param);
push (@{$self->{$param}},$value);
}
@@ -554,46 +529,46 @@ sub all_parameters {
return @{$self->{'.parameters'}};
}
-#### Method as_string
-#
-# synonym for "dump"
-####
-sub as_string {
- &dump(@_);
+# put a filehandle into binary mode (DOS)
+sub binmode {
+ CORE::binmode($_[1]);
+}
+
+sub _make_tag_func {
+ my ($self,$tagname) = @_;
+ my $func = qq#
+ sub $tagname {
+ shift if \$_[0] &&
+ (!ref(\$_[0]) && \$_[0] eq \$CGI::DefaultClass) ||
+ (ref(\$_[0]) &&
+ (substr(ref(\$_[0]),0,3) eq 'CGI' ||
+ UNIVERSAL::isa(\$_[0],'CGI')));
+
+ my(\$attr) = '';
+ if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') {
+ my(\@attr) = make_attributes( '',shift() );
+ \$attr = " \@attr" if \@attr;
+ }
+ #;
+ if ($tagname=~/start_(\w+)/i) {
+ $func .= qq! return "<\U$1\E\$attr>";} !;
+ } elsif ($tagname=~/end_(\w+)/i) {
+ $func .= qq! return "<\U/$1\E>"; } !;
+ } else {
+ $func .= qq#
+ my(\$tag,\$untag) = ("\U<$tagname\E\$attr>","\U</$tagname>\E");
+ return \$tag unless \@_;
+ my \@result = map { "\$tag\$_\$untag" } (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
+ return "\@result";
+ }#;
+ }
+return $func;
}
sub AUTOLOAD {
print STDERR "CGI::AUTOLOAD for $AUTOLOAD\n" if $CGI::AUTOLOAD_DEBUG;
- my($func) = $AUTOLOAD;
- my($pack,$func_name) = $func=~/(.+)::([^:]+)$/;
- $pack = ${"$pack\:\:AutoloadClass"} || $CGI::DefaultClass
- unless defined(${"$pack\:\:AUTOLOADED_ROUTINES"});
-
- my($sub) = \%{"$pack\:\:SUBS"};
- unless (%$sub) {
- my($auto) = \${"$pack\:\:AUTOLOADED_ROUTINES"};
- eval "package $pack; $$auto";
- die $@ if $@;
- }
- my($code) = $sub->{$func_name};
-
- $code = "sub $AUTOLOAD { }" if (!$code and $func_name eq 'DESTROY');
- if (!$code) {
- if ($EXPORT{':any'} ||
- $EXPORT{$func_name} ||
- (%EXPORT_OK || grep(++$EXPORT_OK{$_},&expand_tags(':html')))
- && $EXPORT_OK{$func_name}) {
- $code = $sub->{'HTML_FUNC'};
- $code=~s/func_name/$func_name/mg;
- }
- }
- die "Undefined subroutine $AUTOLOAD\n" unless $code;
- eval "package $pack; $code";
- if ($@) {
- $@ =~ s/ at .*\n//;
- die $@;
- }
- goto &{"$pack\:\:$func_name"};
+ my $func = &_compile;
+ goto &$func;
}
# PRIVATE SUBROUTINE
@@ -604,38 +579,112 @@ sub AUTOLOAD {
sub rearrange {
my($self,$order,@param) = @_;
return () unless @param;
-
- return @param unless (defined($param[0]) && substr($param[0],0,1) eq '-')
- || $self->use_named_parameters;
- my $i;
- for ($i=0;$i<@param;$i+=2) {
- $param[$i]=~s/^\-//; # get rid of initial - if present
- $param[$i]=~tr/a-z/A-Z/; # parameters are upper case
+ if (ref($param[0]) eq 'HASH') {
+ @param = %{$param[0]};
+ } else {
+ return @param
+ unless (defined($param[0]) && substr($param[0],0,1) eq '-')
+ || $self->use_named_parameters;
}
-
- my(%param) = @param; # convert into associative array
- my(@return_array);
-
- my($key)='';
- foreach $key (@$order) {
- my($value);
- # this is an awful hack to fix spurious warnings when the
- # -w switch is set.
- if (ref($key) && ref($key) eq 'ARRAY') {
- foreach (@$key) {
- last if defined($value);
- $value = $param{$_};
- delete $param{$_};
- }
+
+ # map parameters into positional indices
+ my ($i,%pos);
+ $i = 0;
+ foreach (@$order) {
+ foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{$_} = $i; }
+ $i++;
+ }
+
+ my (@result,%leftover);
+ $#result = $#$order; # preextend
+ while (@param) {
+ my $key = uc(shift(@param));
+ $key =~ s/^\-//;
+ if (exists $pos{$key}) {
+ $result[$pos{$key}] = shift(@param);
} else {
- $value = $param{$key};
- delete $param{$key};
+ $leftover{$key} = shift(@param);
}
- push(@return_array,$value);
}
- push (@return_array,$self->make_attributes(\%param)) if %param;
- return (@return_array);
+
+ push (@result,$self->make_attributes(\%leftover)) if %leftover;
+ @result;
+}
+
+sub _compile {
+ my($func) = $AUTOLOAD;
+ my($pack,$func_name);
+ {
+ local($1,$2); # this fixes an obscure variable suicide problem.
+ $func=~/(.+)::([^:]+)$/;
+ ($pack,$func_name) = ($1,$2);
+ $pack=~s/::SUPER$//; # fix another obscure problem
+ $pack = ${"$pack\:\:AutoloadClass"} || $CGI::DefaultClass
+ unless defined(${"$pack\:\:AUTOLOADED_ROUTINES"});
+
+ my($sub) = \%{"$pack\:\:SUBS"};
+ unless (%$sub) {
+ my($auto) = \${"$pack\:\:AUTOLOADED_ROUTINES"};
+ eval "package $pack; $$auto";
+ die $@ if $@;
+ $$auto = ''; # Free the unneeded storage (but don't undef it!!!)
+ }
+ my($code) = $sub->{$func_name};
+
+ $code = "sub $AUTOLOAD { }" if (!$code and $func_name eq 'DESTROY');
+ if (!$code) {
+ (my $base = $func_name) =~ s/^(start_|end_)//i;
+ if ($EXPORT{':any'} ||
+ $EXPORT{'-any'} ||
+ $EXPORT{$base} ||
+ (%EXPORT_OK || grep(++$EXPORT_OK{$_},&expand_tags(':html')))
+ && $EXPORT_OK{$base}) {
+ $code = $CGI::DefaultClass->_make_tag_func($func_name);
+ }
+ }
+ die "Undefined subroutine $AUTOLOAD\n" unless $code;
+ eval "package $pack; $code";
+ if ($@) {
+ $@ =~ s/ at .*\n//;
+ die $@;
+ }
+ }
+ delete($sub->{$func_name}); #free storage
+ return "$pack\:\:$func_name";
+}
+
+sub _reset_globals { initialize_globals(); }
+
+sub _setup_symbols {
+ my $self = shift;
+ my $compile = 0;
+ foreach (@_) {
+ $HEADERS_ONCE++, next if /^[:-]unique_headers$/;
+ $NPH++, next if /^[:-]nph$/;
+ $NO_DEBUG++, next if /^[:-]no_?[Dd]ebug$/;
+ $USE_PARAM_SEMICOLONS++, next if /^[:-]newstyle_urls$/;
+ $PRIVATE_TEMPFILES++, next if /^[:-]private_tempfiles$/;
+ $EXPORT{$_}++, next if /^[:-]any$/;
+ $compile++, next if /^[:-]compile$/;
+
+ # This is probably extremely evil code -- to be deleted some day.
+ if (/^[-]autoload$/) {
+ my($pkg) = caller(1);
+ *{"${pkg}::AUTOLOAD"} = sub {
+ my($routine) = $AUTOLOAD;
+ $routine =~ s/^.*::/CGI::/;
+ &$routine;
+ };
+ next;
+ }
+
+ foreach (&expand_tags($_)) {
+ tr/a-zA-Z0-9_//cd; # don't allow weird function names
+ $EXPORT{$_}++;
+ }
+ }
+ _compile_all(keys %EXPORT) if $compile;
}
###############################################################################
@@ -654,32 +703,83 @@ END_OF_FUNC
sub MULTIPART { 'multipart/form-data'; }
END_OF_FUNC
-'HTML_FUNC' => <<'END_OF_FUNC',
-sub func_name {
-
- # handle various cases in which we're called
- # most of this bizarre stuff is to avoid -w errors
- shift if $_[0] &&
- (!ref($_[0]) && $_[0] eq $CGI::DefaultClass) ||
- (ref($_[0]) &&
- (substr(ref($_[0]),0,3) eq 'CGI' ||
- eval "\$_[0]->isaCGI()"));
-
- my($attr) = '';
- if (ref($_[0]) && ref($_[0]) eq 'HASH') {
- my(@attr) = CGI::make_attributes('',shift);
- $attr = " @attr" if @attr;
- }
- my($tag,$untag) = ("\U<func_name\E$attr>","\U</func_name>\E");
- return $tag unless @_;
- if (ref($_[0]) eq 'ARRAY') {
- my(@r);
- foreach (@{$_[0]}) {
- push(@r,"$tag$_$untag");
+'SERVER_PUSH' => <<'END_OF_FUNC',
+sub SERVER_PUSH { 'multipart/x-mixed-replace; boundary="' . shift() . '"'; }
+END_OF_FUNC
+
+'use_named_parameters' => <<'END_OF_FUNC',
+#### Method: use_named_parameters
+# Force CGI.pm to use named parameter-style method calls
+# rather than positional parameters. The same effect
+# will happen automatically if the first parameter
+# begins with a -.
+sub use_named_parameters {
+ my($self,$use_named) = self_or_default(@_);
+ return $self->{'.named'} unless defined ($use_named);
+
+ # stupidity to avoid annoying warnings
+ return $self->{'.named'}=$use_named;
+}
+END_OF_FUNC
+
+'new_MultipartBuffer' => <<'END_OF_FUNC',
+# Create a new multipart buffer
+sub new_MultipartBuffer {
+ my($self,$boundary,$length,$filehandle) = @_;
+ return MultipartBuffer->new($self,$boundary,$length,$filehandle);
+}
+END_OF_FUNC
+
+'read_from_client' => <<'END_OF_FUNC',
+# Read data from a file handle
+sub read_from_client {
+ my($self, $fh, $buff, $len, $offset) = @_;
+ local $^W=0; # prevent a warning
+ return undef unless defined($fh);
+ return read($fh, $$buff, $len, $offset);
+}
+END_OF_FUNC
+
+'delete' => <<'END_OF_FUNC',
+#### Method: delete
+# Deletes the named parameter entirely.
+####
+sub delete {
+ my($self,$name) = self_or_default(@_);
+ delete $self->{$name};
+ delete $self->{'.fieldnames'}->{$name};
+ @{$self->{'.parameters'}}=grep($_ ne $name,$self->param());
+ return wantarray ? () : undef;
+}
+END_OF_FUNC
+
+#### Method: import_names
+# Import all parameters into the given namespace.
+# Assumes namespace 'Q' if not specified
+####
+'import_names' => <<'END_OF_FUNC',
+sub import_names {
+ my($self,$namespace,$delete) = self_or_default(@_);
+ $namespace = 'Q' unless defined($namespace);
+ die "Can't import names into \"main\"\n" if \%{"${namespace}::"} == \%::;
+ if ($delete || $MOD_PERL) {
+ # can anyone find an easier way to do this?
+ foreach (keys %{"${namespace}::"}) {
+ local *symbol = "${namespace}::${_}";
+ undef $symbol;
+ undef @symbol;
+ undef %symbol;
}
- return "@r";
- } else {
- return "$tag@_$untag";
+ }
+ my($param,@value,$var);
+ foreach $param ($self->param) {
+ # protect against silly names
+ ($var = $param)=~tr/a-zA-Z0-9_/_/c;
+ $var =~ s/^(?=\d)/_/;
+ local *symbol = "${namespace}::$var";
+ @value = $self->param($param);
+ @symbol = @value;
+ $symbol = $value[0];
}
}
END_OF_FUNC
@@ -693,8 +793,8 @@ END_OF_FUNC
sub keywords {
my($self,@values) = self_or_default(@_);
# If values is provided, then we set it.
- $self->{'keywords'}=[@values] if @values;
- my(@result) = @{$self->{'keywords'}};
+ $self->{'keywords'}=[@values] if defined(@values);
+ my(@result) = defined($self->{'keywords'}) ? @{$self->{'keywords'}} : ();
@result;
}
END_OF_FUNC
@@ -711,6 +811,7 @@ sub ReadParse {
*in=*{"${pkg}::in"};
}
tie(%in,CGI);
+ return scalar(keys %in);
}
END_OF_FUNC
@@ -757,7 +858,7 @@ END_OF_FUNC
'TIEHASH' => <<'END_OF_FUNC',
sub TIEHASH {
- return new CGI;
+ return $Q || new CGI;
}
END_OF_FUNC
@@ -833,6 +934,20 @@ sub delete_all {
}
EOF
+'Delete' => <<'EOF',
+sub Delete {
+ my($self,@p) = self_or_default(@_);
+ $self->delete(@p);
+}
+EOF
+
+'Delete_all' => <<'EOF',
+sub Delete_all {
+ my($self,@p) = self_or_default(@_);
+ $self->delete_all(@p);
+}
+EOF
+
#### Method: autoescape
# If you want to turn off the autoescaping features,
# call this method with undef as the argument
@@ -861,13 +976,44 @@ sub make_attributes {
foreach (keys %{$attr}) {
my($key) = $_;
$key=~s/^\-//; # get rid of initial - if present
- $key=~tr/a-z/A-Z/; # parameters are upper case
- push(@att,$attr->{$_} ne '' ? qq/$key="$attr->{$_}"/ : qq/$key/);
+ $key=~tr/a-z_/A-Z-/; # parameters are upper case, use dashes
+ push(@att,defined($attr->{$_}) ? qq/$key="$attr->{$_}"/ : qq/$key/);
}
return @att;
}
END_OF_FUNC
+#### Method: url_param
+# Return a parameter in the QUERY_STRING, regardless of
+# whether this was a POST or a GET
+####
+'url_param' => <<'END_OF_FUNC',
+sub url_param {
+ my ($self,@p) = self_or_default(@_);
+ my $name = shift(@p);
+ return undef unless exists($ENV{QUERY_STRING});
+ unless (exists($self->{'.url_param'})) {
+ $self->{'.url_param'}={}; # empty hash
+ if ($ENV{QUERY_STRING} =~ /=/) {
+ my(@pairs) = split(/[&;]/,$ENV{QUERY_STRING});
+ my($param,$value);
+ foreach (@pairs) {
+ ($param,$value) = split('=',$_,2);
+ $param = unescape($param);
+ $value = unescape($value);
+ push(@{$self->{'.url_param'}->{$param}},$value);
+ }
+ } else {
+ $self->{'.url_param'}->{'keywords'} = [$self->parse_keywordlist($ENV{QUERY_STRING})];
+ }
+ }
+ return keys %{$self->{'.url_param'}} unless defined($name);
+ return () unless $self->{'.url_param'}->{$name};
+ return wantarray ? @{$self->{'.url_param'}->{$name}}
+ : $self->{'.url_param'}->{$name}->[0];
+}
+END_OF_FUNC
+
#### Method: dump
# Returns a string in which all the known parameter/value
# pairs are represented as nested lists, mainly for the purposes
@@ -894,6 +1040,15 @@ sub dump {
}
END_OF_FUNC
+#### Method as_string
+#
+# synonym for "dump"
+####
+'as_string' => <<'END_OF_FUNC',
+sub as_string {
+ &dump(@_);
+}
+END_OF_FUNC
#### Method: save
# Write values out to a filehandle in such a way that they can
@@ -902,13 +1057,12 @@ END_OF_FUNC
'save' => <<'END_OF_FUNC',
sub save {
my($self,$filehandle) = self_or_default(@_);
- my($param);
- my($package) = caller;
-# Check that this still works!
-# $filehandle = $filehandle=~/[':]/ ? $filehandle : "$package\:\:$filehandle";
$filehandle = to_filehandle($filehandle);
+ my($param);
+ local($,) = ''; # set print field separator back to a sane value
+ local($\) = ''; # set output line separator to a sane value
foreach $param ($self->param) {
- my($escaped_param) = &escape($param);
+ my($escaped_param) = escape($param);
my($value);
foreach $value ($self->param($param)) {
print $filehandle "$escaped_param=",escape($value),"\n";
@@ -919,6 +1073,83 @@ sub save {
END_OF_FUNC
+#### Method: save_parameters
+# An alias for save() that is a better name for exportation.
+# Only intended to be used with the function (non-OO) interface.
+####
+'save_parameters' => <<'END_OF_FUNC',
+sub save_parameters {
+ my $fh = shift;
+ return save(to_filehandle($fh));
+}
+END_OF_FUNC
+
+#### Method: restore_parameters
+# A way to restore CGI parameters from an initializer.
+# Only intended to be used with the function (non-OO) interface.
+####
+'restore_parameters' => <<'END_OF_FUNC',
+sub restore_parameters {
+ $Q = $CGI::DefaultClass->new(@_);
+}
+END_OF_FUNC
+
+#### Method: multipart_init
+# Return a Content-Type: style header for server-push
+# This has to be NPH, and it is advisable to set $| = 1
+#
+# Many thanks to Ed Jordan <ed@fidalgo.net> for this
+# contribution
+####
+'multipart_init' => <<'END_OF_FUNC',
+sub multipart_init {
+ my($self,@p) = self_or_default(@_);
+ my($boundary,@other) = $self->rearrange([BOUNDARY],@p);
+ $boundary = $boundary || '------- =_aaaaaaaaaa0';
+ $self->{'separator'} = "\n--$boundary\n";
+ $type = SERVER_PUSH($boundary);
+ return $self->header(
+ -nph => 1,
+ -type => $type,
+ (map { split "=", $_, 2 } @other),
+ ) . $self->multipart_end;
+}
+END_OF_FUNC
+
+
+#### Method: multipart_start
+# Return a Content-Type: style header for server-push, start of section
+#
+# Many thanks to Ed Jordan <ed@fidalgo.net> for this
+# contribution
+####
+'multipart_start' => <<'END_OF_FUNC',
+sub multipart_start {
+ my($self,@p) = self_or_default(@_);
+ my($type,@other) = $self->rearrange([TYPE],@p);
+ $type = $type || 'text/html';
+ return $self->header(
+ -type => $type,
+ (map { split "=", $_, 2 } @other),
+ );
+}
+END_OF_FUNC
+
+
+#### Method: multipart_end
+# Return a Content-Type: style header for server-push, end of section
+#
+# Many thanks to Ed Jordan <ed@fidalgo.net> for this
+# contribution
+####
+'multipart_end' => <<'END_OF_FUNC',
+sub multipart_end {
+ my($self,@p) = self_or_default(@_);
+ return $self->{'separator'};
+}
+END_OF_FUNC
+
+
#### Method: header
# Return a Content-Type: style header
#
@@ -928,42 +1159,53 @@ sub header {
my($self,@p) = self_or_default(@_);
my(@header);
+ return undef if $self->{'.header_printed'}++ and $HEADERS_ONCE;
+
my($type,$status,$cookie,$target,$expires,$nph,@other) =
- $self->rearrange([TYPE,STATUS,[COOKIE,COOKIES],TARGET,EXPIRES,NPH],@p);
+ $self->rearrange([['TYPE','CONTENT_TYPE','CONTENT-TYPE'],
+ STATUS,[COOKIE,COOKIES],TARGET,EXPIRES,NPH],@p);
+ $nph ||= $NPH;
# rearrange() was designed for the HTML portion, so we
# need to fix it up a little.
foreach (@other) {
- next unless my($header,$value) = /([^\s=]+)=(.+)/;
- substr($header,1,1000)=~tr/A-Z/a-z/;
- ($value)=$value=~/^"(.*)"$/;
- $_ = "$header: $value";
+ next unless my($header,$value) = /([^\s=]+)=\"?(.+?)\"?$/;
+ ($_ = $header) =~ s/^(\w)(.*)/$1 . lc ($2) . ": $value"/e;
}
- $type = $type || 'text/html';
+ $type ||= 'text/html' unless defined($type);
+
+ # Maybe future compatibility. Maybe not.
+ my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0';
+ push(@header,$protocol . ' ' . ($status || '200 OK')) if $nph;
- push(@header,'HTTP/1.0 ' . ($status || '200 OK')) if $nph || $NPH;
push(@header,"Status: $status") if $status;
- push(@header,"Window-target: $target") if $target;
+ push(@header,"Window-Target: $target") if $target;
# push all the cookies -- there may be several
if ($cookie) {
- my(@cookie) = ref($cookie) ? @{$cookie} : $cookie;
+ my(@cookie) = ref($cookie) && ref($cookie) eq 'ARRAY' ? @{$cookie} : $cookie;
foreach (@cookie) {
- push(@header,"Set-cookie: $_");
+ my $cs = UNIVERSAL::isa($_,'CGI::Cookie') ? $_->as_string : $_;
+ push(@header,"Set-Cookie: $cs") if $cs ne '';
}
}
# if the user indicates an expiration time, then we need
# both an Expires and a Date header (so that the browser is
# uses OUR clock)
- push(@header,"Expires: " . &date(&expire_calc($expires),'http'))
+ push(@header,"Expires: " . expires($expires,'http'))
if $expires;
- push(@header,"Date: " . &date(&expire_calc(0),'http')) if $expires || $cookie;
+ push(@header,"Date: " . expires(0,'http')) if $expires || $cookie;
push(@header,"Pragma: no-cache") if $self->cache();
push(@header,@other);
- push(@header,"Content-type: $type");
+ push(@header,"Content-Type: $type") if $type ne '';
- my $header = join($CRLF,@header);
- return $header . "${CRLF}${CRLF}";
+ my $header = join($CRLF,@header)."${CRLF}${CRLF}";
+ if ($MOD_PERL and not $nph) {
+ my $r = Apache->request;
+ $r->send_cgi_header($header);
+ return '';
+ }
+ return $header;
}
END_OF_FUNC
@@ -991,24 +1233,17 @@ END_OF_FUNC
'redirect' => <<'END_OF_FUNC',
sub redirect {
my($self,@p) = self_or_default(@_);
- my($url,$target,$cookie,$nph,@other) = $self->rearrange([[URI,URL],TARGET,COOKIE,NPH],@p);
+ my($url,$target,$cookie,$nph,@other) = $self->rearrange([[LOCATION,URI,URL],TARGET,COOKIE,NPH],@p);
$url = $url || $self->self_url;
my(@o);
- foreach (@other) { push(@o,split("=")); }
- if($MOD_PERL or exists $self->{'.req'}) {
- my $r = $self->{'.req'} || Apache->request;
- $r->header_out(Location => $url);
- $r->err_header_out(Location => $url);
- $r->status(302);
- return;
- }
- push(@o,
- '-Status'=>'302 Found',
+ foreach (@other) { tr/\"//d; push(@o,split("=",$_,2)); }
+ unshift(@o,
+ '-Status'=>'302 Moved',
'-Location'=>$url,
- '-URI'=>$url,
- '-nph'=>($nph||$NPH));
- push(@o,'-Target'=>$target) if $target;
- push(@o,'-Cookie'=>$cookie) if $cookie;
+ '-nph'=>$nph);
+ unshift(@o,'-Target'=>$target) if $target;
+ unshift(@o,'-Cookie'=>$cookie) if $cookie;
+ unshift(@o,'-Type'=>'');
return $self->header(@o);
}
END_OF_FUNC
@@ -1036,20 +1271,21 @@ END_OF_FUNC
'start_html' => <<'END_OF_FUNC',
sub start_html {
my($self,@p) = &self_or_default(@_);
- my($title,$author,$base,$xbase,$script,$noscript,$target,$meta,$head,$style,@other) =
- $self->rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,NOSCRIPT,TARGET,META,HEAD,STYLE],@p);
+ my($title,$author,$base,$xbase,$script,$noscript,$target,$meta,$head,$style,$dtd,@other) =
+ $self->rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,NOSCRIPT,TARGET,META,HEAD,STYLE,DTD],@p);
# strangely enough, the title needs to be escaped as HTML
# while the author needs to be escaped as a URL
$title = $self->escapeHTML($title || 'Untitled Document');
- $author = $self->escapeHTML($author);
+ $author = $self->escape($author);
my(@result);
- push(@result,'<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">');
+ $dtd = $DEFAULT_DTD unless $dtd && $dtd =~ m|^-//|;
+ push(@result,qq(<!DOCTYPE HTML PUBLIC "$dtd">)) if $dtd;
push(@result,"<HTML><HEAD><TITLE>$title</TITLE>");
- push(@result,"<LINK REV=MADE HREF=\"mailto:$author\">") if $author;
+ push(@result,"<LINK REV=MADE HREF=\"mailto:$author\">") if defined $author;
if ($base || $xbase || $target) {
- my $href = $xbase || $self->url();
+ my $href = $xbase || $self->url('-path'=>1);
my $t = $target ? qq/ TARGET="$target"/ : '';
push(@result,qq/<BASE HREF="$href"$t>/);
}
@@ -1060,29 +1296,60 @@ sub start_html {
push(@result,ref($head) ? @$head : $head) if $head;
- # handle various types of -style parameters
- if ($style) {
- if (ref($style)) {
- my($src,$code,@other) =
- $self->rearrange([SRC,CODE],
- '-foo'=>'bar', # a trick to allow the '-' to be omitted
- ref($style) eq 'ARRAY' ? @$style : %$style);
- push(@result,qq/<LINK REL="stylesheet" HREF="$src">/) if $src;
- push(@result,style($code)) if $code;
- } else {
- push(@result,style($style))
- }
+ # handle the infrequently-used -style and -script parameters
+ push(@result,$self->_style($style)) if defined $style;
+ push(@result,$self->_script($script)) if defined $script;
+
+ # handle -noscript parameter
+ push(@result,<<END) if $noscript;
+<NOSCRIPT>
+$noscript
+</NOSCRIPT>
+END
+ ;
+ my($other) = @other ? " @other" : '';
+ push(@result,"</HEAD><BODY$other>");
+ return join("\n",@result);
+}
+END_OF_FUNC
+
+### Method: _style
+# internal method for generating a CSS style section
+####
+'_style' => <<'END_OF_FUNC',
+sub _style {
+ my ($self,$style) = @_;
+ my (@result);
+ my $type = 'text/css';
+ if (ref($style)) {
+ my($src,$code,$stype,@other) =
+ $self->rearrange([SRC,CODE,TYPE],
+ '-foo'=>'bar', # a trick to allow the '-' to be omitted
+ ref($style) eq 'ARRAY' ? @$style : %$style);
+ $type = $stype if $stype;
+ push(@result,qq/<LINK REL="stylesheet" HREF="$src">/) if $src;
+ push(@result,style({'type'=>$type},"<!--\n$code\n-->")) if $code;
+ } else {
+ push(@result,style({'type'=>$type},"<!--\n$style\n-->"));
}
+ @result;
+}
+END_OF_FUNC
- # handle -script parameter
- if ($script) {
+
+'_script' => <<'END_OF_FUNC',
+sub _script {
+ my ($self,$script) = @_;
+ my (@result);
+ my (@scripts) = ref($script) eq 'ARRAY' ? @$script : ($script);
+ foreach $script (@scripts) {
my($src,$code,$language);
if (ref($script)) { # script is a hash
($src,$code,$language) =
$self->rearrange([SRC,CODE,LANGUAGE],
'-foo'=>'bar', # a trick to allow the '-' to be omitted
ref($style) eq 'ARRAY' ? @$script : %$script);
-
+
} else {
($src,$code,$language) = ('',$script,'JavaScript');
}
@@ -1095,21 +1362,10 @@ sub start_html {
if $code && $language=~/perl/i;
push(@result,script({@satts},$code));
}
-
- # handle -noscript parameter
- push(@result,<<END) if $noscript;
-<NOSCRIPT>
-$noscript
-</NOSCRIPT>
-END
- ;
- my($other) = @other ? " @other" : '';
- push(@result,"</HEAD><BODY$other>");
- return join("\n",@result);
+ @result;
}
END_OF_FUNC
-
#### Method: end_html
# End an HTML document.
# Trivial method for completeness. Just returns "</BODY>"
@@ -1174,6 +1430,11 @@ sub start_form {
}
END_OF_FUNC
+'end_multipart_form' => <<'END_OF_FUNC',
+sub end_multipart_form {
+ &endform;
+}
+END_OF_FUNC
#### Method: start_multipart_form
# synonym for startform
@@ -1213,6 +1474,27 @@ sub end_form {
END_OF_FUNC
+'_textfield' => <<'END_OF_FUNC',
+sub _textfield {
+ my($self,$tag,@p) = self_or_default(@_);
+ my($name,$default,$size,$maxlength,$override,@other) =
+ $self->rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
+
+ my $current = $override ? $default :
+ (defined($self->param($name)) ? $self->param($name) : $default);
+
+ $current = defined($current) ? $self->escapeHTML($current) : '';
+ $name = defined($name) ? $self->escapeHTML($name) : '';
+ my($s) = defined($size) ? qq/ SIZE=$size/ : '';
+ my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : '';
+ my($other) = @other ? " @other" : '';
+ # this entered at cristy's request to fix problems with file upload fields
+ # and WebTV -- not sure it won't break stuff
+ my($value) = $current ne '' ? qq(VALUE="$current") : '';
+ return qq/<INPUT TYPE="$tag" NAME="$name" $value$s$m$other>/;
+}
+END_OF_FUNC
+
#### Method: textfield
# Parameters:
# $name -> Name of the text field
@@ -1226,18 +1508,7 @@ END_OF_FUNC
'textfield' => <<'END_OF_FUNC',
sub textfield {
my($self,@p) = self_or_default(@_);
- my($name,$default,$size,$maxlength,$override,@other) =
- $self->rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
-
- my $current = $override ? $default :
- (defined($self->param($name)) ? $self->param($name) : $default);
-
- $current = defined($current) ? $self->escapeHTML($current) : '';
- $name = defined($name) ? $self->escapeHTML($name) : '';
- my($s) = defined($size) ? qq/ SIZE=$size/ : '';
- my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : '';
- my($other) = @other ? " @other" : '';
- return qq/<INPUT TYPE="text" NAME="$name" VALUE="$current"$s$m$other>/;
+ $self->_textfield('text',@p);
}
END_OF_FUNC
@@ -1253,19 +1524,7 @@ END_OF_FUNC
'filefield' => <<'END_OF_FUNC',
sub filefield {
my($self,@p) = self_or_default(@_);
-
- my($name,$default,$size,$maxlength,$override,@other) =
- $self->rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
-
- $current = $override ? $default :
- (defined($self->param($name)) ? $self->param($name) : $default);
-
- $name = defined($name) ? $self->escapeHTML($name) : '';
- my($s) = defined($size) ? qq/ SIZE=$size/ : '';
- my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : '';
- $current = defined($current) ? $self->escapeHTML($current) : '';
- $other = ' ' . join(" ",@other);
- return qq/<INPUT TYPE="file" NAME="$name" VALUE="$current"$s$m$other>/;
+ $self->_textfield('file',@p);
}
END_OF_FUNC
@@ -1284,23 +1543,10 @@ END_OF_FUNC
'password_field' => <<'END_OF_FUNC',
sub password_field {
my ($self,@p) = self_or_default(@_);
-
- my($name,$default,$size,$maxlength,$override,@other) =
- $self->rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
-
- my($current) = $override ? $default :
- (defined($self->param($name)) ? $self->param($name) : $default);
-
- $name = defined($name) ? $self->escapeHTML($name) : '';
- $current = defined($current) ? $self->escapeHTML($current) : '';
- my($s) = defined($size) ? qq/ SIZE=$size/ : '';
- my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : '';
- my($other) = @other ? " @other" : '';
- return qq/<INPUT TYPE="password" NAME="$name" VALUE="$current"$s$m$other>/;
+ $self->_textfield('password',@p);
}
END_OF_FUNC
-
#### Method: textarea
# Parameters:
# $name -> Name of the text field
@@ -1383,8 +1629,8 @@ sub submit {
$value=$self->escapeHTML($value);
my($name) = ' NAME=".submit"';
- $name = qq/ NAME="$label"/ if $label;
- $value = $value || $label;
+ $name = qq/ NAME="$label"/ if defined($label);
+ $value = defined($value) ? $value : $label;
my($val) = '';
$val = qq/ VALUE="$value"/ if defined($value);
my($other) = @other ? " @other" : '';
@@ -1438,6 +1684,16 @@ sub defaults {
END_OF_FUNC
+#### Method: comment
+# Create an HTML <!-- comment -->
+# Parameters: a string
+'comment' => <<'END_OF_FUNC',
+sub comment {
+ my($self,@p) = self_or_CGI(@_);
+ return "<!-- @p -->";
+}
+END_OF_FUNC
+
#### Method: checkbox
# Create a checkbox that is not logically linked to any others.
# The field value is "on" when the button is checked.
@@ -1457,12 +1713,13 @@ sub checkbox {
my($name,$checked,$value,$label,$override,@other) =
$self->rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,[OVERRIDE,FORCE]],@p);
- if (!$override && defined($self->param($name))) {
- $value = $self->param($name) unless defined $value;
- $checked = $self->param($name) eq $value ? ' CHECKED' : '';
+ $value = defined $value ? $value : 'on';
+
+ if (!$override && ($self->{'.fieldnames'}->{$name} ||
+ defined $self->param($name))) {
+ $checked = grep($_ eq $value,$self->param($name)) ? ' CHECKED' : '';
} else {
$checked = $checked ? ' CHECKED' : '';
- $value = defined $value ? $value : 'on';
}
my($the_label) = defined $label ? $label : $name;
$name = $self->escapeHTML($name);
@@ -1517,33 +1774,37 @@ sub checkbox_group {
$name=$self->escapeHTML($name);
# Create the elements
- my(@elements);
- my(@values) = $values ? @$values : $self->param($name);
+ my(@elements,@values);
+
+ @values = $self->_set_values_and_labels($values,\$labels,$name);
+
my($other) = @other ? " @other" : '';
foreach (@values) {
$checked = $checked{$_} ? ' CHECKED' : '';
$label = '';
unless (defined($nolabels) && $nolabels) {
$label = $_;
- $label = $labels->{$_} if defined($labels) && $labels->{$_};
+ $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
$label = $self->escapeHTML($label);
}
$_ = $self->escapeHTML($_);
- push(@elements,qq/<INPUT TYPE="checkbox" NAME="$name" VALUE="$_"$checked$other>${label} ${break}/);
+ push(@elements,qq/<INPUT TYPE="checkbox" NAME="$name" VALUE="$_"$checked$other>${label}${break}/);
}
$self->register_parameter($name);
- return wantarray ? @elements : join('',@elements) unless $columns;
+ return wantarray ? @elements : join(' ',@elements)
+ unless defined($columns) || defined($rows);
return _tableize($rows,$columns,$rowheaders,$colheaders,@elements);
}
END_OF_FUNC
-
# Escape HTML -- used internally
'escapeHTML' => <<'END_OF_FUNC',
sub escapeHTML {
my($self,$toencode) = @_;
+ $toencode = $self unless ref($self);
return undef unless defined($toencode);
- return $toencode if $self->{'dontescape'};
+ return $toencode if ref($self) && $self->{'dontescape'};
+
$toencode=~s/&/&amp;/g;
$toencode=~s/\"/&quot;/g;
$toencode=~s/>/&gt;/g;
@@ -1552,6 +1813,25 @@ sub escapeHTML {
}
END_OF_FUNC
+# unescape HTML -- used internally
+'unescapeHTML' => <<'END_OF_FUNC',
+sub unescapeHTML {
+ my $string = ref($_[0]) ? $_[1] : $_[0];
+ return undef unless defined($string);
+ # thanks to Randal Schwartz for the correct solution to this one
+ $string=~ s[&(.*?);]{
+ local $_ = $1;
+ /^amp$/i ? "&" :
+ /^quot$/i ? '"' :
+ /^gt$/i ? ">" :
+ /^lt$/i ? "<" :
+ /^#(\d+)$/ ? chr($1) :
+ /^#x([0-9a-f]+)$/i ? chr(hex($1)) :
+ $_
+ }gex;
+ return $string;
+}
+END_OF_FUNC
# Internal procedure - don't use
'_tableize' => <<'END_OF_FUNC',
@@ -1559,20 +1839,27 @@ sub _tableize {
my($rows,$columns,$rowheaders,$colheaders,@elements) = @_;
my($result);
- $rows = int(0.99 + @elements/$columns) unless $rows;
+ if (defined($columns)) {
+ $rows = int(0.99 + @elements/$columns) unless defined($rows);
+ }
+ if (defined($rows)) {
+ $columns = int(0.99 + @elements/$rows) unless defined($columns);
+ }
+
# rearrange into a pretty table
$result = "<TABLE>";
my($row,$column);
- unshift(@$colheaders,'') if @$colheaders && @$rowheaders;
- $result .= "<TR>" if @{$colheaders};
+ unshift(@$colheaders,'') if defined(@$colheaders) && defined(@$rowheaders);
+ $result .= "<TR>" if defined(@{$colheaders});
foreach (@{$colheaders}) {
$result .= "<TH>$_</TH>";
}
for ($row=0;$row<$rows;$row++) {
$result .= "<TR>";
- $result .= "<TH>$rowheaders->[$row]</TH>" if @$rowheaders;
+ $result .= "<TH>$rowheaders->[$row]</TH>" if defined(@$rowheaders);
for ($column=0;$column<$columns;$column++) {
- $result .= "<TD>" . $elements[$column*$rows + $row] . "</TD>";
+ $result .= "<TD>" . $elements[$column*$rows + $row] . "</TD>"
+ if defined($elements[$column*$rows + $row]);
}
$result .= "</TR>";
}
@@ -1616,12 +1903,13 @@ sub radio_group {
} else {
$checked = $default;
}
+ my(@elements,@values);
+ @values = $self->_set_values_and_labels($values,\$labels,$name);
+
# If no check array is specified, check the first by default
- $checked = $values->[0] unless $checked;
+ $checked = $values[0] unless defined($checked) && $checked ne '';
$name=$self->escapeHTML($name);
- my(@elements);
- my(@values) = $values ? @$values : $self->param($name);
my($other) = @other ? " @other" : '';
foreach (@values) {
my($checkit) = $checked eq $_ ? ' CHECKED' : '';
@@ -1629,14 +1917,15 @@ sub radio_group {
my($label)='';
unless (defined($nolabels) && $nolabels) {
$label = $_;
- $label = $labels->{$_} if defined($labels) && $labels->{$_};
+ $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
$label = $self->escapeHTML($label);
}
$_=$self->escapeHTML($_);
- push(@elements,qq/<INPUT TYPE="radio" NAME="$name" VALUE="$_"$checkit$other>${label} ${break}/);
+ push(@elements,qq/<INPUT TYPE="radio" NAME="$name" VALUE="$_"$checkit$other>${label}${break}/);
}
$self->register_parameter($name);
- return wantarray ? @elements : join('',@elements) unless $columns;
+ return wantarray ? @elements : join(' ',@elements)
+ unless defined($columns) || defined($rows);
return _tableize($rows,$columns,$rowheaders,$colheaders,@elements);
}
END_OF_FUNC
@@ -1672,12 +1961,14 @@ sub popup_menu {
$name=$self->escapeHTML($name);
my($other) = @other ? " @other" : '';
- my(@values) = $values ? @$values : $self->param($name);
+ my(@values);
+ @values = $self->_set_values_and_labels($values,\$labels,$name);
+
$result = qq/<SELECT NAME="$name"$other>\n/;
foreach (@values) {
my($selectit) = defined($selected) ? ($selected eq $_ ? 'SELECTED' : '' ) : '';
my($label) = $_;
- $label = $labels->{$_} if defined($labels) && $labels->{$_};
+ $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
my($value) = $self->escapeHTML($_);
$label=$self->escapeHTML($label);
$result .= "<OPTION $selectit VALUE=\"$value\">$label\n";
@@ -1716,8 +2007,9 @@ sub scrolling_list {
= $self->rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
SIZE,MULTIPLE,LABELS,[OVERRIDE,FORCE]],@p);
- my($result);
- my(@values) = $values ? @$values : $self->param($name);
+ my($result,@values);
+ @values = $self->_set_values_and_labels($values,\$labels,$name);
+
$size = $size || scalar(@values);
my(%selected) = $self->previous_or_default($name,$defaults,$override);
@@ -1730,7 +2022,7 @@ sub scrolling_list {
foreach (@values) {
my($selectit) = $selected{$_} ? 'SELECTED' : '';
my($label) = $_;
- $label = $labels->{$_} if defined($labels) && $labels->{$_};
+ $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
$label=$self->escapeHTML($label);
my($value)=$self->escapeHTML($_);
$result .= "<OPTION $selectit VALUE=\"$value\">$label\n";
@@ -1762,7 +2054,7 @@ sub hidden {
$self->rearrange([NAME,[DEFAULT,VALUE,VALUES],[OVERRIDE,FORCE]],@p);
my $do_override = 0;
- if ( substr($p[0],0,1) eq '-' || $self->use_named_parameters ) {
+ if ( ref($p[0]) || substr($p[0],0,1) eq '-' || $self->use_named_parameters ) {
@value = ref($default) ? @{$default} : $default;
$do_override = $override;
} else {
@@ -1816,16 +2108,8 @@ END_OF_FUNC
####
'self_url' => <<'END_OF_FUNC',
sub self_url {
- my($self) = self_or_default(@_);
- my($query_string) = $self->query_string;
- my $protocol = $self->protocol();
- my $name = "$protocol://" . $self->server_name;
- $name .= ":" . $self->server_port
- unless $self->server_port == 80;
- $name .= $self->script_name;
- $name .= $self->path_info if $self->path_info;
- return $name unless $query_string;
- return "$name?$query_string";
+ my($self,@p) = self_or_default(@_);
+ return $self->url('-path_info'=>1,'-query'=>1,'-full'=>1,@p);
}
END_OF_FUNC
@@ -1845,13 +2129,34 @@ END_OF_FUNC
####
'url' => <<'END_OF_FUNC',
sub url {
- my($self) = self_or_default(@_);
- my $protocol = $self->protocol();
- my $name = "$protocol://" . $self->server_name;
- $name .= ":" . $self->server_port
- unless $self->server_port == 80;
- $name .= $self->script_name;
- return $name;
+ my($self,@p) = self_or_default(@_);
+ my ($relative,$absolute,$full,$path_info,$query) =
+ $self->rearrange(['RELATIVE','ABSOLUTE','FULL',['PATH','PATH_INFO'],['QUERY','QUERY_STRING']],@p);
+ my $url;
+ $full++ if !($relative || $absolute);
+
+ if ($full) {
+ my $protocol = $self->protocol();
+ $url = "$protocol://";
+ my $vh = http('host');
+ if ($vh) {
+ $url .= $vh;
+ } else {
+ $url .= server_name();
+ my $port = $self->server_port;
+ $url .= ":" . $port
+ unless (lc($protocol) eq 'http' && $port == 80)
+ || (lc($protocol) eq 'https' && $port == 443);
+ }
+ $url .= $self->script_name;
+ } elsif ($relative) {
+ ($url) = $self->script_name =~ m!([^/]+)$!;
+ } elsif ($absolute) {
+ $url = $self->script_name;
+ }
+ $url .= $self->path_info if $path_info and $self->path_info;
+ $url .= "?" . $self->query_string if $query and $self->query_string;
+ return $url;
}
END_OF_FUNC
@@ -1869,66 +2174,45 @@ END_OF_FUNC
# -expires -> expiry date in format Wdy, DD-Mon-YYYY HH:MM:SS GMT (optional)
####
'cookie' => <<'END_OF_FUNC',
-# temporary, for debugging.
sub cookie {
my($self,@p) = self_or_default(@_);
my($name,$value,$path,$domain,$secure,$expires) =
$self->rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@p);
+ require CGI::Cookie;
# if no value is supplied, then we retrieve the
# value of the cookie, if any. For efficiency, we cache the parsed
- # cookie in our state variables.
- unless (defined($value)) {
- unless ($self->{'.cookies'}) {
- my(@pairs) = split("; ",$self->raw_cookie);
- foreach (@pairs) {
- my($key,$value) = split("=");
- my(@values) = map unescape($_),split('&',$value);
- $self->{'.cookies'}->{unescape($key)} = [@values];
- }
- }
+ # cookies in our state variables.
+ unless ( defined($value) ) {
+ $self->{'.cookies'} = CGI::Cookie->fetch
+ unless $self->{'.cookies'};
# If no name is supplied, then retrieve the names of all our cookies.
return () unless $self->{'.cookies'};
- return wantarray ? @{$self->{'.cookies'}->{$name}} : $self->{'.cookies'}->{$name}->[0]
- if defined($name) && $name ne '';
- return keys %{$self->{'.cookies'}};
+ return keys %{$self->{'.cookies'}} unless $name;
+ return () unless $self->{'.cookies'}->{$name};
+ return $self->{'.cookies'}->{$name}->value if defined($name) && $name ne '';
}
- my(@values);
-
- # Pull out our parameters.
- if (ref($value)) {
- if (ref($value) eq 'ARRAY') {
- @values = @$value;
- } elsif (ref($value) eq 'HASH') {
- @values = %$value;
- }
- } else {
- @values = ($value);
- }
- @values = map escape($_),@values;
- # I.E. requires the path to be present.
- ($path = $ENV{'SCRIPT_NAME'})=~s![^/]+$!! unless $path;
+ # If we get here, we're creating a new cookie
+ return undef unless $name; # this is an error
- my(@constant_values);
- push(@constant_values,"domain=$domain") if $domain;
- push(@constant_values,"path=$path") if $path;
- push(@constant_values,"expires=".&date(&expire_calc($expires),'cookie'))
- if $expires;
- push(@constant_values,'secure') if $secure;
+ my @param;
+ push(@param,'-name'=>$name);
+ push(@param,'-value'=>$value);
+ push(@param,'-domain'=>$domain) if $domain;
+ push(@param,'-path'=>$path) if $path;
+ push(@param,'-expires'=>$expires) if $expires;
+ push(@param,'-secure'=>$secure) if $secure;
- my($key) = &escape($name);
- my($cookie) = join("=",$key,join("&",@values));
- return join("; ",$cookie,@constant_values);
+ return new CGI::Cookie(@param);
}
END_OF_FUNC
-
# This internal routine creates an expires time exactly some number of
# hours from the current time. It incorporates modifications from
-# Fisher Mark.
+# Mark Fisher.
'expire_calc' => <<'END_OF_FUNC',
sub expire_calc {
my($time) = @_;
@@ -1950,9 +2234,9 @@ sub expire_calc {
# If you don't supply one of these forms, we assume you are
# specifying the date yourself
my($offset);
- if (!$time || ($time eq 'now')) {
+ if (!$time || (lc($time) eq 'now')) {
$offset = 0;
- } elsif ($time=~/^([+-]?\d+)([mhdMy]?)/) {
+ } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([mhdMy]?)/) {
$offset = ($mult{$2} || 1)*$1;
} else {
return $time;
@@ -1964,16 +2248,17 @@ END_OF_FUNC
# This internal routine creates date strings suitable for use in
# cookies and HTTP headers. (They differ, unfortunately.)
# Thanks to Fisher Mark for this.
-'date' => <<'END_OF_FUNC',
-sub date {
+'expires' => <<'END_OF_FUNC',
+sub expires {
my($time,$format) = @_;
+ $format ||= 'http';
+
my(@MON)=qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
my(@WDAY) = qw/Sun Mon Tue Wed Thu Fri Sat/;
# pass through preformatted dates for the sake of expire_calc()
- if ("$time" =~ m/^[^0-9]/o) {
- return $time;
- }
+ $time = expire_calc($time);
+ return $time unless $time =~ /^\d+$/;
# make HTTP/cookie date string from GMT'ed time
# (cookies use '-' as date separator, HTTP uses ' ')
@@ -1986,6 +2271,29 @@ sub date {
}
END_OF_FUNC
+'parse_keywordlist' => <<'END_OF_FUNC',
+sub parse_keywordlist {
+ my($self,$tosplit) = @_;
+ $tosplit = unescape($tosplit); # unescape the keywords
+ $tosplit=~tr/+/ /; # pluses to spaces
+ my(@keywords) = split(/\s+/,$tosplit);
+ return @keywords;
+}
+END_OF_FUNC
+
+'param_fetch' => <<'END_OF_FUNC',
+sub param_fetch {
+ my($self,@p) = self_or_default(@_);
+ my($name) = $self->rearrange([NAME],@p);
+ unless (exists($self->{$name})) {
+ $self->add_parameter($name);
+ $self->{$name} = [];
+ }
+
+ return $self->{$name};
+}
+END_OF_FUNC
+
###############################################
# OTHER INFORMATION PROVIDED BY THE ENVIRONMENT
###############################################
@@ -1996,7 +2304,19 @@ END_OF_FUNC
####
'path_info' => <<'END_OF_FUNC',
sub path_info {
- return $ENV{'PATH_INFO'};
+ my ($self,$info) = self_or_default(@_);
+ if (defined($info)) {
+ $info = "/$info" if $info ne '' && substr($info,0,1) ne '/';
+ $self->{'.path_info'} = $info;
+ } elsif (! defined($self->{'.path_info'}) ) {
+ $self->{'.path_info'} = defined($ENV{'PATH_INFO'}) ?
+ $ENV{'PATH_INFO'} : '';
+
+ # hack to fix broken path info in IIS
+ $self->{'.path_info'} =~ s/^\Q$ENV{'SCRIPT_NAME'}\E// if $IIS;
+
+ }
+ return $self->{'.path_info'};
}
END_OF_FUNC
@@ -2030,13 +2350,13 @@ sub query_string {
my($self) = self_or_default(@_);
my($param,$value,@pairs);
foreach $param ($self->param) {
- my($eparam) = &escape($param);
+ my($eparam) = escape($param);
foreach $value ($self->param($param)) {
- $value = &escape($value);
+ $value = escape($value);
push(@pairs,"$eparam=$value");
}
}
- return join("&",@pairs);
+ return join($USE_PARAM_SEMICOLONS ? ';' : '&',@pairs);
}
END_OF_FUNC
@@ -2052,8 +2372,8 @@ END_OF_FUNC
# declares a quantitative score for it.
# This handles MIME type globs correctly.
####
-'accept' => <<'END_OF_FUNC',
-sub accept {
+'Accept' => <<'END_OF_FUNC',
+sub Accept {
my($self,$search) = self_or_CGI(@_);
my(%prefs,$type,$pref,$pat);
@@ -2102,14 +2422,28 @@ sub user_agent {
END_OF_FUNC
-#### Method: cookie
-# Returns the magic cookie for the session.
-# To set the magic cookie for new transations,
-# try print $q->header('-Set-cookie'=>'my cookie')
+#### Method: raw_cookie
+# Returns the magic cookies for the session.
+# The cookies are not parsed or altered in any way, i.e.
+# cookies are returned exactly as given in the HTTP
+# headers. If a cookie name is given, only that cookie's
+# value is returned, otherwise the entire raw cookie
+# is returned.
####
'raw_cookie' => <<'END_OF_FUNC',
sub raw_cookie {
- my($self) = self_or_CGI(@_);
+ my($self,$key) = self_or_CGI(@_);
+
+ require CGI::Cookie;
+
+ if (defined($key)) {
+ $self->{'.raw_cookies'} = CGI::Cookie->raw_fetch
+ unless $self->{'.raw_cookies'};
+
+ return () unless $self->{'.raw_cookies'};
+ return () unless $self->{'.raw_cookies'}->{$key};
+ return $self->{'.raw_cookies'}->{$key};
+ }
return $self->http('cookie') || $ENV{'COOKIE'} || '';
}
END_OF_FUNC
@@ -2120,7 +2454,9 @@ END_OF_FUNC
######
'virtual_host' => <<'END_OF_FUNC',
sub virtual_host {
- return http('host') || server_name();
+ my $vh = http('host') || server_name();
+ $vh =~ s/:\d+$//; # get rid of port number
+ return $vh;
}
END_OF_FUNC
@@ -2156,7 +2492,7 @@ END_OF_FUNC
####
'script_name' => <<'END_OF_FUNC',
sub script_name {
- return $ENV{'SCRIPT_NAME'} if $ENV{'SCRIPT_NAME'};
+ return $ENV{'SCRIPT_NAME'} if defined($ENV{'SCRIPT_NAME'});
# These are for debugging
return "/$0" unless $0=~/^\//;
return $0;
@@ -2254,7 +2590,7 @@ END_OF_FUNC
sub protocol {
local($^W)=0;
my $self = shift;
- return 'https' if $self->https() eq 'ON';
+ return 'https' if uc($self->https()) eq 'ON';
return 'https' if $self->server_port == 443;
my $prot = $self->server_protocol;
my($protocol,$version) = split('/',$prot);
@@ -2322,11 +2658,22 @@ END_OF_FUNC
'private_tempfiles' => <<'END_OF_FUNC',
sub private_tempfiles {
my ($self,$param) = self_or_CGI(@_);
- $CGI::$PRIVATE_TEMPFILES = $param if defined($param);
+ $CGI::PRIVATE_TEMPFILES = $param if defined($param);
return $CGI::PRIVATE_TEMPFILES;
}
END_OF_FUNC
+#### Method: default_dtd
+# Set or return the default_dtd global
+####
+'default_dtd' => <<'END_OF_FUNC',
+sub default_dtd {
+ my ($self,$param) = self_or_CGI(@_);
+ $CGI::DEFAULT_DTD = $param if defined($param);
+ return $CGI::DEFAULT_DTD;
+}
+END_OF_FUNC
+
# -------------- really private subroutines -----------------
'previous_or_default' => <<'END_OF_FUNC',
sub previous_or_default {
@@ -2357,30 +2704,30 @@ END_OF_FUNC
'get_fields' => <<'END_OF_FUNC',
sub get_fields {
my($self) = @_;
- return $self->hidden('-name'=>'.cgifields',
- '-values'=>[keys %{$self->{'.parametersToAdd'}}],
- '-override'=>1);
+ return $self->CGI::hidden('-name'=>'.cgifields',
+ '-values'=>[keys %{$self->{'.parametersToAdd'}}],
+ '-override'=>1);
}
END_OF_FUNC
'read_from_cmdline' => <<'END_OF_FUNC',
sub read_from_cmdline {
- require "shellwords.pl";
my($input,@words);
my($query_string);
if (@ARGV) {
- $input = join(" ",@ARGV);
+ @words = @ARGV;
} else {
+ require "shellwords.pl";
print STDERR "(offline mode: enter name=value pairs on standard input)\n";
- chomp(@lines = <>); # remove newlines
+ chomp(@lines = <STDIN>); # remove newlines
$input = join(" ",@lines);
+ @words = &shellwords($input);
+ }
+ foreach (@words) {
+ s/\\=/%3D/g;
+ s/\\&/%26/g;
}
- # minimal handling of escape characters
- $input=~s/\\=/%3D/g;
- $input=~s/\\&/%26/g;
-
- @words = &shellwords($input);
if ("@words"=~/=/) {
$query_string = join('&',@words);
} else {
@@ -2400,22 +2747,19 @@ END_OF_FUNC
#####
'read_multipart' => <<'END_OF_FUNC',
sub read_multipart {
- my($self,$boundary,$length) = @_;
- my($buffer) = $self->new_MultipartBuffer($boundary,$length);
+ my($self,$boundary,$length,$filehandle) = @_;
+ my($buffer) = $self->new_MultipartBuffer($boundary,$length,$filehandle);
return unless $buffer;
my(%header,$body);
+ my $filenumber = 0;
while (!$buffer->eof) {
%header = $buffer->readHeader;
die "Malformed multipart POST\n" unless %header;
- # In beta1 it was "Content-disposition". In beta2 it's "Content-Disposition"
- # Sheesh.
- my($key) = $header{'Content-disposition'} ? 'Content-disposition' : 'Content-Disposition';
- my($param)= $header{$key}=~/ name="([^\"]*)"/;
+ my($param)= $header{'Content-Disposition'}=~/ name="?([^\";]*)"?/;
- # possible bug: our regular expression expects the filename= part to fall
- # at the end of the line. Netscape doesn't escape quotation marks in file names!!!
- my($filename) = $header{$key}=~/ filename="(.*)"$/;
+ # Bug: Netscape doesn't escape quotation marks in file names!!!
+ my($filename) = $header{'Content-Disposition'}=~/ filename="?([^\";]*)"?/;
# add this parameter to our list
$self->add_parameter($param);
@@ -2428,60 +2772,44 @@ sub read_multipart {
next;
}
- # If we get here, then we are dealing with a potentially large
- # uploaded form. Save the data to a temporary file, then open
- # the file for reading.
- my($tmpfile) = new TempFile;
- my $tmp = $tmpfile->as_string;
-
- # Now create a new filehandle in the caller's namespace.
- # The name of this filehandle just happens to be identical
- # to the original filename (NOT the name of the temporary
- # file, which is hidden!)
- my($filehandle);
- if ($filename=~/^[a-zA-Z_]/) {
- my($frame,$cp)=(1);
- do { $cp = caller($frame++); } until !eval("'$cp'->isaCGI()");
- $filehandle = "$cp\:\:$filename";
- } else {
- $filehandle = "\:\:$filename";
- }
+ my ($tmpfile,$tmp,$filehandle);
+ UPLOADS: {
+ # If we get here, then we are dealing with a potentially large
+ # uploaded form. Save the data to a temporary file, then open
+ # the file for reading.
+
+ # skip the file if uploads disabled
+ if ($DISABLE_UPLOADS) {
+ while (defined($data = $buffer->read)) { }
+ last UPLOADS;
+ }
- # potential security problem -- this type of line can clobber
- # tempfile, and can be abused by malicious users.
- # open ($filehandle,">$tmp") || die "CGI open of $tmpfile: $!\n";
+ $tmpfile = new TempFile;
+ $tmp = $tmpfile->as_string;
+
+ $filehandle = Fh->new($filename,$tmp,$PRIVATE_TEMPFILES);
- # This technique causes open to fail if file already exists.
- unless (defined(&O_RDWR)) {
- require Fcntl;
- import Fcntl qw/O_RDWR O_CREAT O_EXCL/;
- }
- sysopen($filehandle,$tmp,&O_RDWR|&O_CREAT|&O_EXCL) || die "CGI open of $tmp: $!\n";
- unlink($tmp) if $PRIVATE_TEMPFILES;
-
- $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode;
- chmod 0600,$tmp; # only the owner can tamper with it
- my $data;
- while (defined($data = $buffer->read)) {
- print $filehandle $data;
- }
+ $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode;
+ chmod 0600,$tmp; # only the owner can tamper with it
- seek($filehandle,0,0); #rewind file
- push(@{$self->{$param}},$filename);
-
- # Under Unix, it would be safe to let the temporary file
- # be deleted immediately. However, I fear that other operating
- # systems are not so forgiving. Therefore we save a reference
- # to the temporary file in the CGI object so that the file
- # isn't unlinked until the CGI object itself goes out of
- # scope. This is a bit hacky, but it has the interesting side
- # effect that one can access the name of the tmpfile by
- # asking for $query->{$query->param('foo')}, where 'foo'
- # is the name of the file upload field.
- $self->{'.tmpfiles'}->{$filename}= {
- name=>($PRIVATE_TEMPFILES ? '' : $tmpfile),
- info=>{%header}
- }
+ my ($data);
+ local($\) = '';
+ while (defined($data = $buffer->read)) {
+ print $filehandle $data;
+ }
+
+ # back up to beginning of file
+ seek($filehandle,0,0);
+ $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode;
+
+ # Save some information about the uploaded file where we can get
+ # at it later.
+ $self->{'.tmpfiles'}->{$filename}= {
+ name => $tmpfile,
+ info => {%header},
+ };
+ push(@{$self->{$param}},$filehandle);
+ }
}
}
END_OF_FUNC
@@ -2495,30 +2823,123 @@ sub tmpFileName {
}
END_OF_FUNC
-'uploadInfo' => <<'END_OF_FUNC'
+'uploadInfo' => <<'END_OF_FUNC',
sub uploadInfo {
my($self,$filename) = self_or_default(@_);
return $self->{'.tmpfiles'}->{$filename}->{info};
}
END_OF_FUNC
+# internal routine, don't use
+'_set_values_and_labels' => <<'END_OF_FUNC',
+sub _set_values_and_labels {
+ my $self = shift;
+ my ($v,$l,$n) = @_;
+ $$l = $v if ref($v) eq 'HASH' && !ref($$l);
+ return $self->param($n) if !defined($v);
+ return $v if !ref($v);
+ return ref($v) eq 'HASH' ? keys %$v : @$v;
+}
+END_OF_FUNC
+
+'_compile_all' => <<'END_OF_FUNC',
+sub _compile_all {
+ foreach (@_) {
+ next if defined(&$_);
+ $AUTOLOAD = "CGI::$_";
+ _compile();
+ }
+}
+END_OF_FUNC
+
);
END_OF_AUTOLOAD
;
-# Globals and stubs for other packages that we use
+#########################################################
+# Globals and stubs for other packages that we use.
+#########################################################
+
+################### Fh -- lightweight filehandle ###############
+package Fh;
+use overload
+ '""' => \&asString,
+ 'cmp' => \&compare,
+ 'fallback'=>1;
+
+$FH='fh00000';
+
+*Fh::AUTOLOAD = \&CGI::AUTOLOAD;
+
+$AUTOLOADED_ROUTINES = ''; # prevent -w error
+$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
+%SUBS = (
+'asString' => <<'END_OF_FUNC',
+sub asString {
+ my $self = shift;
+ # get rid of package name
+ (my $i = $$self) =~ s/^\*(\w+::)+//;
+ $i =~ s/\\(.)/$1/g;
+ return $i;
+# BEGIN DEAD CODE
+# This was an extremely clever patch that allowed "use strict refs".
+# Unfortunately it relied on another bug that caused leaky file descriptors.
+# The underlying bug has been fixed, so this no longer works. However
+# "strict refs" still works for some reason.
+# my $self = shift;
+# return ${*{$self}{SCALAR}};
+# END DEAD CODE
+}
+END_OF_FUNC
+
+'compare' => <<'END_OF_FUNC',
+sub compare {
+ my $self = shift;
+ my $value = shift;
+ return "$self" cmp $value;
+}
+END_OF_FUNC
+
+'new' => <<'END_OF_FUNC',
+sub new {
+ my($pack,$name,$file,$delete) = @_;
+ require Fcntl unless defined &Fcntl::O_RDWR;
+ ++$FH;
+ my $ref = \*{'Fh::' . quotemeta($name)};
+ sysopen($ref,$file,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL())
+ || die "CGI open of $file: $!\n";
+ unlink($file) if $delete;
+ delete $Fh::{$FH};
+ return bless $ref,$pack;
+}
+END_OF_FUNC
+
+'DESTROY' => <<'END_OF_FUNC',
+sub DESTROY {
+ my $self = shift;
+ close $self;
+}
+END_OF_FUNC
+
+);
+END_OF_AUTOLOAD
+
+######################## MultipartBuffer ####################
package MultipartBuffer;
# how many bytes to read at a time. We use
-# a 5K buffer by default.
-$FILLUNIT = 1024 * 5;
-$TIMEOUT = 10*60; # 10 minute timeout
-$SPIN_LOOP_MAX = 1000; # bug fix for some Netscape servers
+# a 4K buffer by default.
+$INITIAL_FILLUNIT = 1024 * 4;
+$TIMEOUT = 240*60; # 4 hour timeout for big files
+$SPIN_LOOP_MAX = 2000; # bug fix for some Netscape servers
$CRLF=$CGI::CRLF;
#reuse the autoload function
*MultipartBuffer::AUTOLOAD = \&CGI::AUTOLOAD;
+# avoid autoloader warnings
+sub DESTROY {}
+
###############################################################################
################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
###############################################################################
@@ -2529,6 +2950,7 @@ $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
'new' => <<'END_OF_FUNC',
sub new {
my($package,$interface,$boundary,$length,$filehandle) = @_;
+ $FILLUNIT = $INITIAL_FILLUNIT;
my $IN;
if ($filehandle) {
my($package) = caller;
@@ -2551,10 +2973,11 @@ sub new {
# Under the MIME spec, the boundary consists of the
# characters "--" PLUS the Boundary string
- $boundary = "--$boundary";
- # Read the topmost (boundary) line plus the CRLF
- my($null) = '';
- $length -= $interface->read_from_client($IN,\$null,length($boundary)+2,0);
+
+ # BUG: IE 3.01 on the Macintosh uses just the boundary -- not
+ # the two extra hyphens. We do a special case here on the user-agent!!!!
+ $boundary = "--$boundary" unless CGI::user_agent('MSIE 3\.0[12]; ?Mac');
+
} else { # otherwise we find it ourselves
my($old);
($old,$/) = ($/,$CRLF); # read a CRLF-delimited line
@@ -2574,7 +2997,13 @@ sub new {
$FILLUNIT = length($boundary)
if length($boundary) > $FILLUNIT;
- return bless $self,ref $package || $package;
+ my $retval = bless $self,ref $package || $package;
+
+ # Read the preamble and the topmost (boundary) line plus the CRLF.
+ while ($self->read(0)) { }
+ die "Malformed multipart POST\n" if $self->eof;
+
+ return $retval;
}
END_OF_FUNC
@@ -2584,20 +3013,36 @@ sub readHeader {
my($end);
my($ok) = 0;
my($bad) = 0;
+
+ if ($CGI::OS eq 'VMS') { # tssk, tssk: inconsistency alert!
+ local($CRLF) = "\015\012";
+ }
+
do {
$self->fillBuffer($FILLUNIT);
$ok++ if ($end = index($self->{BUFFER},"${CRLF}${CRLF}")) >= 0;
$ok++ if $self->{BUFFER} eq '';
$bad++ if !$ok && $self->{LENGTH} <= 0;
- $FILLUNIT *= 2 if length($self->{BUFFER}) >= $FILLUNIT;
+ # this was a bad idea
+ # $FILLUNIT *= 2 if length($self->{BUFFER}) >= $FILLUNIT;
} until $ok || $bad;
return () if $bad;
my($header) = substr($self->{BUFFER},0,$end+2);
substr($self->{BUFFER},0,$end+4) = '';
my %return;
- while ($header=~/^([\w-]+): (.*)$CRLF/mog) {
- $return{$1}=$2;
+
+
+ # See RFC 2045 Appendix A and RFC 822 sections 3.4.8
+ # (Folding Long Header Fields), 3.4.3 (Comments)
+ # and 3.4.5 (Quoted-Strings).
+
+ my $token = '[-\w!\#$%&\'*+.^_\`|{}~]';
+ $header=~s/$CRLF\s+/ /og; # merge continuation lines
+ while ($header=~/($token+):\s+([^$CRLF]*)/mgox) {
+ my ($field_name,$field_value) = ($1,$2); # avoid taintedness
+ $field_name =~ s/\b(\w)/uc($1)/eg; #canonicalize
+ $return{$field_name}=$field_value;
}
return %return;
}
@@ -2688,6 +3133,7 @@ sub fillBuffer {
\$self->{BUFFER},
$bytesToRead,
$bufferLength);
+ $self->{BUFFER} = '' unless defined $self->{BUFFER};
# An apparent bug in the Apache server causes the read()
# to return zero bytes repeatedly without blocking if the
@@ -2725,15 +3171,20 @@ END_OF_AUTOLOAD
package TempFile;
$SL = $CGI::SL;
+$MAC = $CGI::OS eq 'MACINTOSH';
+my ($vol) = $MAC ? MacPerl::Volumes() =~ /:(.*)/ : "";
unless ($TMPDIRECTORY) {
- @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp","${SL}tmp","${SL}temp","${SL}Temporary Items");
+ @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp",
+ "C:${SL}temp","${SL}tmp","${SL}temp","${vol}${SL}Temporary Items",
+ "${SL}WWW_ROOT");
foreach (@TEMP) {
do {$TMPDIRECTORY = $_; last} if -d $_ && -w _;
}
}
-$TMPDIRECTORY = "." unless $TMPDIRECTORY;
-$SEQUENCE="CGItemp${$}0000";
+$TMPDIRECTORY = $MAC ? "" : "." unless $TMPDIRECTORY;
+$SEQUENCE=0;
+$MAXTRIES = 5000;
# cute feature, but overload implementation broke it
# %OVERLOAD = ('""'=>'as_string');
@@ -2749,8 +3200,12 @@ $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
'new' => <<'END_OF_FUNC',
sub new {
my($package) = @_;
- $SEQUENCE++;
- my $directory = "${TMPDIRECTORY}${SL}${SEQUENCE}";
+ my $directory;
+ my $i;
+ for ($i = 0; $i < $MAXTRIES; $i++) {
+ $directory = sprintf("${TMPDIRECTORY}${SL}CGItemp%d%04d",${$},++$SEQUENCE);
+ last if ! -f $directory;
+ }
return bless \$directory;
}
END_OF_FUNC
@@ -2784,13 +3239,13 @@ if ($^W) {
$MultipartBuffer::SPIN_LOOP_MAX;
$MultipartBuffer::CRLF;
$MultipartBuffer::TIMEOUT;
- $MultipartBuffer::FILLUNIT;
+ $MultipartBuffer::INITIAL_FILLUNIT;
$TempFile::SEQUENCE;
EOF
;
}
-$revision;
+1;
__END__
@@ -2800,72 +3255,218 @@ CGI - Simple Common Gateway Interface Class
=head1 SYNOPSIS
- use CGI;
- # the rest is too complicated for a synopsis; keep reading
+ # CGI script that creates a fill-out form
+ # and echoes back its values.
+
+ use CGI qw/:standard/;
+ print header,
+ start_html('A Simple Example'),
+ h1('A Simple Example'),
+ start_form,
+ "What's your name? ",textfield('name'),p,
+ "What's the combination?", p,
+ checkbox_group(-name=>'words',
+ -values=>['eenie','meenie','minie','moe'],
+ -defaults=>['eenie','minie']), p,
+ "What's your favorite color? ",
+ popup_menu(-name=>'color',
+ -values=>['red','green','blue','chartreuse']),p,
+ submit,
+ end_form,
+ hr;
+
+ if (param()) {
+ print "Your name is",em(param('name')),p,
+ "The keywords are: ",em(join(", ",param('words'))),p,
+ "Your favorite color is ",em(param('color')),
+ hr;
+ }
=head1 ABSTRACT
-This perl library uses perl5 objects to make it easy to create
-Web fill-out forms and parse their contents. This package
-defines CGI objects, entities that contain the values of the
-current query string and other state variables.
-Using a CGI object's methods, you can examine keywords and parameters
-passed to your script, and create forms whose initial values
-are taken from the current query (thereby preserving state
-information).
+This perl library uses perl5 objects to make it easy to create Web
+fill-out forms and parse their contents. This package defines CGI
+objects, entities that contain the values of the current query string
+and other state variables. Using a CGI object's methods, you can
+examine keywords and parameters passed to your script, and create
+forms whose initial values are taken from the current query (thereby
+preserving state information). The module provides shortcut functions
+that produce boilerplate HTML, reducing typing and coding errors. It
+also provides functionality for some of the more advanced features of
+CGI scripting, including support for file uploads, cookies, cascading
+style sheets, server push, and frames.
+
+CGI.pm also provides a simple function-oriented programming style for
+those who don't need its object-oriented features.
The current version of CGI.pm is available at
http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
-=head1 INSTALLATION
+=head1 DESCRIPTION
-CGI is a part of the base Perl installation. However, you may need
-to install a newer version someday. Therefore:
+=head2 PROGRAMMING STYLE
+
+There are two styles of programming with CGI.pm, an object-oriented
+style and a function-oriented style. In the object-oriented style you
+create one or more CGI objects and then use object methods to create
+the various elements of the page. Each CGI object starts out with the
+list of named parameters that were passed to your CGI script by the
+server. You can modify the objects, save them to a file or database
+and recreate them. Because each object corresponds to the "state" of
+the CGI script, and because each object's parameter list is
+independent of the others, this allows you to save the state of the
+script and restore it later.
+
+For example, using the object oriented style, here is how you create
+a simple "Hello World" HTML page:
+
+ #!/usr/local/bin/perl
+ use CGI; # load CGI routines
+ $q = new CGI; # create new CGI object
+ print $q->header, # create the HTTP header
+ $q->start_html('hello world'), # start the HTML
+ $q->h1('hello world'), # level 1 header
+ $q->end_html; # end the HTML
+
+In the function-oriented style, there is one default CGI object that
+you rarely deal with directly. Instead you just call functions to
+retrieve CGI parameters, create HTML tags, manage cookies, and so
+on. This provides you with a cleaner programming interface, but
+limits you to using one CGI object at a time. The following example
+prints the same page, but uses the function-oriented interface.
+The main differences are that we now need to import a set of functions
+into our name space (usually the "standard" functions), and we don't
+need to create the CGI object.
+
+ #!/usr/local/bin/perl
+ use CGI qw/:standard/; # load standard CGI routines
+ print header, # create the HTTP header
+ start_html('hello world'), # start the HTML
+ h1('hello world'), # level 1 header
+ end_html; # end the HTML
+
+The examples in this document mainly use the object-oriented style.
+See HOW TO IMPORT FUNCTIONS for important information on
+function-oriented programming in CGI.pm
+
+=head2 CALLING CGI.PM ROUTINES
+
+Most CGI.pm routines accept several arguments, sometimes as many as 20
+optional ones! To simplify this interface, all routines use a named
+argument calling style that looks like this:
+
+ print $q->header(-type=>'image/gif',-expires=>'+3d');
+
+Each argument name is preceded by a dash. Neither case nor order
+matters in the argument list. -type, -Type, and -TYPE are all
+acceptable. In fact, only the first argument needs to begin with a
+dash. If a dash is present in the first argument, CGI.pm assumes
+dashes for the subsequent ones.
+
+You don't have to use the hyphen at all if you don't want to. After
+creating a CGI object, call the B<use_named_parameters()> method with
+a nonzero value. This will tell CGI.pm that you intend to use named
+parameters exclusively:
-To install this package, just change to the directory in which this
-file is found and type the following:
+ $query = new CGI;
+ $query->use_named_parameters(1);
+ $field = $query->radio_group('name'=>'OS',
+ 'values'=>['Unix','Windows','Macintosh'],
+ 'default'=>'Unix');
- perl Makefile.PL
- make
- make install
+Several routines are commonly called with just one argument. In the
+case of these routines you can provide the single argument without an
+argument name. header() happens to be one of these routines. In this
+case, the single argument is the document type.
+
+ print $q->header('text/html');
+
+Other such routines are documented below.
+
+Sometimes named arguments expect a scalar, sometimes a reference to an
+array, and sometimes a reference to a hash. Often, you can pass any
+type of argument and the routine will do whatever is most appropriate.
+For example, the param() routine is used to set a CGI parameter to a
+single or a multi-valued value. The two cases are shown below:
+
+ $q->param(-name=>'veggie',-value=>'tomato');
+ $q->param(-name=>'veggie',-value=>'[tomato','tomahto','potato','potahto']);
+
+A large number of routines in CGI.pm actually aren't specifically
+defined in the module, but are generated automatically as needed.
+These are the "HTML shortcuts," routines that generate HTML tags for
+use in dynamically-generated pages. HTML tags have both attributes
+(the attribute="value" pairs within the tag itself) and contents (the
+part between the opening and closing pairs.) To distinguish between
+attributes and contents, CGI.pm uses the convention of passing HTML
+attributes as a hash reference as the first argument, and the
+contents, if any, as any subsequent arguments. It works out like
+this:
+
+ Code Generated HTML
+ ---- --------------
+ h1() <H1>
+ h1('some','contents'); <H1>some contents</H1>
+ h1({-align=>left}); <H1 ALIGN="LEFT">
+ h1({-align=>left},'contents'); <H1 ALIGN="LEFT">contents</H1>
+
+HTML tags are described in more detail later.
+
+Many newcomers to CGI.pm are puzzled by the difference between the
+calling conventions for the HTML shortcuts, which require curly braces
+around the HTML tag attributes, and the calling conventions for other
+routines, which manage to generate attributes without the curly
+brackets. Don't be confused. As a convenience the curly braces are
+optional in all but the HTML shortcuts. If you like, you can use
+curly braces when calling any routine that takes named arguments. For
+example:
+
+ print $q->header( {-type=>'image/gif',-expires=>'+3d'} );
+
+If you use the B<-w> switch, you will be warned that some CGI.pm argument
+names conflict with built-in Perl functions. The most frequent of
+these is the -values argument, used to create multi-valued menus,
+radio button clusters and the like. To get around this warning, you
+have several choices:
-This will copy CGI.pm to your perl library directory for use by all
-perl scripts. You probably must be root to do this. Now you can
-load the CGI routines in your Perl scripts with the line:
+=over 4
- use CGI;
+=item 1. Use another name for the argument, if one is available. For
+example, -value is an alias for -values.
-If you don't have sufficient privileges to install CGI.pm in the Perl
-library directory, you can put CGI.pm into some convenient spot, such
-as your home directory, or in cgi-bin itself and prefix all Perl
-scripts that call it with something along the lines of the following
-preamble:
+=item 2. Change the capitalization, e.g. -Values
- use lib '/home/davis/lib';
- use CGI;
+=item 3. Put quotes around the argument name, e.g. '-values'
-If you are using a version of perl earlier than 5.002 (such as NT perl), use
-this instead:
+=back
- BEGIN {
- unshift(@INC,'/home/davis/lib');
- }
- use CGI;
+Many routines will do something useful with a named argument that it
+doesn't recognize. For example, you can produce non-standard HTTP
+header fields by providing them as named arguments:
-The CGI distribution also comes with a cute module called L<CGI::Carp>.
-It redefines the die(), warn(), confess() and croak() error routines
-so that they write nicely formatted error messages into the server's
-error log (or to the output stream of your choice). This avoids long
-hours of groping through the error and access logs, trying to figure
-out which CGI script is generating error messages. If you choose,
-you can even have fatal error messages echoed to the browser to avoid
-the annoying and uninformative "Server Error" message.
+ print $q->header(-type => 'text/html',
+ -cost => 'Three smackers',
+ -annoyance_level => 'high',
+ -complaints_to => 'bit bucket');
-=head1 DESCRIPTION
+This will produce the following nonstandard HTTP header:
+
+ HTTP/1.0 200 OK
+ Cost: Three smackers
+ Annoyance-level: high
+ Complaints-to: bit bucket
+ Content-type: text/html
+
+Notice the way that underscores are translated automatically into
+hyphens. HTML-generating routines perform a different type of
+translation.
-=head2 CREATING A NEW QUERY OBJECT:
+This feature allows you to keep up with the rapidly changing HTTP and
+HTML "standards".
+
+=head2 CREATING A NEW QUERY OBJECT (OBJECT-ORIENTED STYLE):
$query = new CGI;
@@ -2876,12 +3477,12 @@ it into a perl5 object called $query.
$query = new CGI(INPUTFILE);
-If you provide a file handle to the new() method, it
-will read parameters from the file (or STDIN, or whatever). The
-file can be in any of the forms describing below under debugging
-(i.e. a series of newline delimited TAG=VALUE pairs will work).
-Conveniently, this type of file is created by the save() method
-(see below). Multiple records can be saved and restored.
+If you provide a file handle to the new() method, it will read
+parameters from the file (or STDIN, or whatever). The file can be in
+any of the forms describing below under debugging (i.e. a series of
+newline delimited TAG=VALUE pairs will work). Conveniently, this type
+of file is created by the save() method (see below). Multiple records
+can be saved and restored.
Perl purists will be pleased to know that this syntax accepts
references to file handles, or even references to filehandle globs,
@@ -2889,6 +3490,18 @@ which is the "official" way to pass a filehandle:
$query = new CGI(\*STDIN);
+You can also initialize the CGI object with a FileHandle or IO::File
+object.
+
+If you are using the function-oriented interface and want to
+initialize CGI state from a file handle, the way to do this is with
+B<restore_parameters()>. This will (re)initialize the
+default CGI object from the indicated file handle.
+
+ open (IN,"test.in") || die;
+ restore_parameters(IN);
+ close IN;
+
You can also initialize the query object from an associative array
reference:
@@ -2901,11 +3514,20 @@ or from a properly formatted, URL-escaped query string:
$query = new CGI('dinosaur=barney&color=purple');
+or from a previously existing CGI object (currently this clones the
+parameter list, but none of the other object-specific fields, such as
+autoescaping):
+
+ $old_query = new CGI;
+ $new_query = new CGI($old_query);
+
To create an empty query, initialize it from an empty string or hash:
- $empty_query = new CGI("");
- -or-
- $empty_query = new CGI({});
+ $empty_query = new CGI("");
+
+ -or-
+
+ $empty_query = new CGI({});
=head2 FETCHING A LIST OF KEYWORDS FROM THE QUERY:
@@ -2964,7 +3586,7 @@ in more detail later:
=head2 APPENDING ADDITIONAL VALUES TO A NAMED PARAMETER:
- $query->append(-name=>;'foo',-values=>['yet','more','values']);
+ $query->append(-name=>'foo',-values=>['yet','more','values']);
This adds a value or list of values to the named parameter. The
values are appended to the end of the parameter if it already exists.
@@ -2993,14 +3615,32 @@ This completely clears a parameter. It sometimes useful for
resetting parameters that you don't want passed down between
script invocations.
+If you are using the function call interface, use "Delete()" instead
+to avoid conflicts with Perl's built-in delete operator.
+
=head2 DELETING ALL PARAMETERS:
-$query->delete_all();
+ $query->delete_all();
This clears the CGI object completely. It might be useful to ensure
that all the defaults are taken when you create a fill-out form.
-=head2 SAVING THE STATE OF THE FORM TO A FILE:
+Use Delete_all() instead if you are using the function call interface.
+
+=head2 DIRECT ACCESS TO THE PARAMETER LIST:
+
+ $q->param_fetch('address')->[1] = '1313 Mockingbird Lane';
+ unshift @{$q->param_fetch(-name=>'address')},'George Munster';
+
+If you need access to the parameter list in a way that isn't covered
+by the methods above, you can obtain a direct reference to it by
+calling the B<param_fetch()> method with the name of the . This
+will return an array reference to the named parameters, which you then
+can manipulate in any way you like.
+
+You can also use a named argument style using the B<-name> argument.
+
+=head2 SAVING THE STATE OF THE SCRIPT TO A FILE:
$query->save(FILEHANDLE)
@@ -3051,115 +3691,298 @@ manipulated and even databased using Boulderio utilities. See
for further details.
-=head2 CREATING A SELF-REFERENCING URL THAT PRESERVES STATE INFORMATION:
+If you wish to use this method from the function-oriented (non-OO)
+interface, the exported name for this method is B<save_parameters()>.
- $myself = $query->self_url;
- print "<A HREF=$myself>I'm talking to myself.</A>";
+=head2 USING THE FUNCTION-ORIENTED INTERFACE
-self_url() will return a URL, that, when selected, will reinvoke
-this script with all its state information intact. This is most
-useful when you want to jump around within the document using
-internal anchors but you don't want to disrupt the current contents
-of the form(s). Something like this will do the trick.
+To use the function-oriented interface, you must specify which CGI.pm
+routines or sets of routines to import into your script's namespace.
+There is a small overhead associated with this importation, but it
+isn't much.
- $myself = $query->self_url;
- print "<A HREF=$myself#table1>See table 1</A>";
- print "<A HREF=$myself#table2>See table 2</A>";
- print "<A HREF=$myself#yourself>See for yourself</A>";
+ use CGI <list of methods>;
-If you don't want to get the whole query string, call
-the method url() to return just the URL for the script:
+The listed methods will be imported into the current package; you can
+call them directly without creating a CGI object first. This example
+shows how to import the B<param()> and B<header()>
+methods, and then use them directly:
- $myself = $query->url;
- print "<A HREF=$myself>No query string in this baby!</A>\n";
+ use CGI 'param','header';
+ print header('text/plain');
+ $zipcode = param('zipcode');
-You can also retrieve the unprocessed query string with query_string():
+More frequently, you'll import common sets of functions by referring
+to the groups by name. All function sets are preceded with a ":"
+character as in ":html3" (for tags defined in the HTML 3 standard).
- $the_string = $query->query_string;
+Here is a list of the function sets you can import:
-=head2 COMPATIBILITY WITH CGI-LIB.PL
+=over 4
-To make it easier to port existing programs that use cgi-lib.pl
-the compatibility routine "ReadParse" is provided. Porting is
-simple:
+=item B<:cgi>
-OLD VERSION
- require "cgi-lib.pl";
- &ReadParse;
- print "The value of the antique is $in{antique}.\n";
+Import all CGI-handling methods, such as B<param()>, B<path_info()>
+and the like.
-NEW VERSION
- use CGI;
- CGI::ReadParse
- print "The value of the antique is $in{antique}.\n";
+=item B<:form>
-CGI.pm's ReadParse() routine creates a tied variable named %in,
-which can be accessed to obtain the query variables. Like
-ReadParse, you can also provide your own variable. Infrequently
-used features of ReadParse, such as the creation of @in and $in
-variables, are not supported.
+Import all fill-out form generating methods, such as B<textfield()>.
-Once you use ReadParse, you can retrieve the query object itself
-this way:
+=item B<:html2>
- $q = $in{CGI};
- print $q->textfield(-name=>'wow',
- -value=>'does this really work?');
+Import all methods that generate HTML 2.0 standard elements.
-This allows you to start using the more interesting features
-of CGI.pm without rewriting your old scripts from scratch.
+=item B<:html3>
-=head2 CALLING CGI FUNCTIONS THAT TAKE MULTIPLE ARGUMENTS
+Import all methods that generate HTML 3.0 proposed elements (such as
+<table>, <super> and <sub>).
-In versions of CGI.pm prior to 2.0, it could get difficult to remember
-the proper order of arguments in CGI function calls that accepted five
-or six different arguments. As of 2.0, there's a better way to pass
-arguments to the various CGI functions. In this style, you pass a
-series of name=>argument pairs, like this:
+=item B<:netscape>
- $field = $query->radio_group(-name=>'OS',
- -values=>[Unix,Windows,Macintosh],
- -default=>'Unix');
+Import all methods that generate Netscape-specific HTML extensions.
-The advantages of this style are that you don't have to remember the
-exact order of the arguments, and if you leave out a parameter, in
-most cases it will default to some reasonable value. If you provide
-a parameter that the method doesn't recognize, it will usually do
-something useful with it, such as incorporating it into the HTML form
-tag. For example if Netscape decides next week to add a new
-JUSTIFICATION parameter to the text field tags, you can start using
-the feature without waiting for a new version of CGI.pm:
+=item B<:html>
- $field = $query->textfield(-name=>'State',
- -default=>'gaseous',
- -justification=>'RIGHT');
+Import all HTML-generating shortcuts (i.e. 'html2' + 'html3' +
+'netscape')...
-This will result in an HTML tag that looks like this:
+=item B<:standard>
- <INPUT TYPE="textfield" NAME="State" VALUE="gaseous"
- JUSTIFICATION="RIGHT">
+Import "standard" features, 'html2', 'html3', 'form' and 'cgi'.
-Parameter names are case insensitive: you can use -name, or -Name or
--NAME. You don't have to use the hyphen if you don't want to. After
-creating a CGI object, call the B<use_named_parameters()> method with
-a nonzero value. This will tell CGI.pm that you intend to use named
-parameters exclusively:
+=item B<:all>
- $query = new CGI;
- $query->use_named_parameters(1);
- $field = $query->radio_group('name'=>'OS',
- 'values'=>['Unix','Windows','Macintosh'],
- 'default'=>'Unix');
+Import all the available methods. For the full list, see the CGI.pm
+code, where the variable %TAGS is defined.
+
+=back
+
+If you import a function name that is not part of CGI.pm, the module
+will treat it as a new HTML tag and generate the appropriate
+subroutine. You can then use it like any other HTML tag. This is to
+provide for the rapidly-evolving HTML "standard." For example, say
+Microsoft comes out with a new tag called <GRADIENT> (which causes the
+user's desktop to be flooded with a rotating gradient fill until his
+machine reboots). You don't need to wait for a new version of CGI.pm
+to start using it immediately:
-Actually, CGI.pm only looks for a hyphen in the first parameter. So
-you can leave it off subsequent parameters if you like. Something to
-be wary of is the potential that a string constant like "values" will
-collide with a keyword (and in fact it does!) While Perl usually
-figures out when you're referring to a function and when you're
-referring to a string, you probably should put quotation marks around
-all string constants just to play it safe.
+ use CGI qw/:standard :html3 gradient/;
+ print gradient({-start=>'red',-end=>'blue'});
-=head2 CREATING THE HTTP HEADER:
+Note that in the interests of execution speed CGI.pm does B<not> use
+the standard L<Exporter> syntax for specifying load symbols. This may
+change in the future.
+
+If you import any of the state-maintaining CGI or form-generating
+methods, a default CGI object will be created and initialized
+automatically the first time you use any of the methods that require
+one to be present. This includes B<param()>, B<textfield()>,
+B<submit()> and the like. (If you need direct access to the CGI
+object, you can find it in the global variable B<$CGI::Q>). By
+importing CGI.pm methods, you can create visually elegant scripts:
+
+ use CGI qw/:standard/;
+ print
+ header,
+ start_html('Simple Script'),
+ h1('Simple Script'),
+ start_form,
+ "What's your name? ",textfield('name'),p,
+ "What's the combination?",
+ checkbox_group(-name=>'words',
+ -values=>['eenie','meenie','minie','moe'],
+ -defaults=>['eenie','moe']),p,
+ "What's your favorite color?",
+ popup_menu(-name=>'color',
+ -values=>['red','green','blue','chartreuse']),p,
+ submit,
+ end_form,
+ hr,"\n";
+
+ if (param) {
+ print
+ "Your name is ",em(param('name')),p,
+ "The keywords are: ",em(join(", ",param('words'))),p,
+ "Your favorite color is ",em(param('color')),".\n";
+ }
+ print end_html;
+
+=head2 PRAGMAS
+
+In addition to the function sets, there are a number of pragmas that
+you can import. Pragmas, which are always preceded by a hyphen,
+change the way that CGI.pm functions in various ways. Pragmas,
+function sets, and individual functions can all be imported in the
+same use() line. For example, the following use statement imports the
+standard set of functions and disables debugging mode (pragma
+-no_debug):
+
+ use CGI qw/:standard -no_debug/;
+
+The current list of pragmas is as follows:
+
+=over 4
+
+=item -any
+
+When you I<use CGI -any>, then any method that the query object
+doesn't recognize will be interpreted as a new HTML tag. This allows
+you to support the next I<ad hoc> Netscape or Microsoft HTML
+extension. This lets you go wild with new and unsupported tags:
+
+ use CGI qw(-any);
+ $q=new CGI;
+ print $q->gradient({speed=>'fast',start=>'red',end=>'blue'});
+
+Since using <cite>any</cite> causes any mistyped method name
+to be interpreted as an HTML tag, use it with care or not at
+all.
+
+=item -compile
+
+This causes the indicated autoloaded methods to be compiled up front,
+rather than deferred to later. This is useful for scripts that run
+for an extended period of time under FastCGI or mod_perl, and for
+those destined to be crunched by Malcom Beattie's Perl compiler. Use
+it in conjunction with the methods or method families you plan to use.
+
+ use CGI qw(-compile :standard :html3);
+
+or even
+
+ use CGI qw(-compile :all);
+
+Note that using the -compile pragma in this way will always have
+the effect of importing the compiled functions into the current
+namespace. If you want to compile without importing use the
+compile() method instead (see below).
+
+=item -nph
+
+This makes CGI.pm produce a header appropriate for an NPH (no
+parsed header) script. You may need to do other things as well
+to tell the server that the script is NPH. See the discussion
+of NPH scripts below.
+
+=item -newstyle_urls
+
+Separate the name=value pairs in CGI parameter query strings with
+semicolons rather than ampersands. For example:
+
+ ?name=fred;age=24;favorite_color=3
+
+Semicolon-delimited query strings are always accepted, but will not be
+emitted by self_url() and query_string() unless the -newstyle_urls
+pragma is specified.
+
+=item -autoload
+
+This overrides the autoloader so that any function in your program
+that is not recognized is referred to CGI.pm for possible evaluation.
+This allows you to use all the CGI.pm functions without adding them to
+your symbol table, which is of concern for mod_perl users who are
+worried about memory consumption. I<Warning:> when
+I<-autoload> is in effect, you cannot use "poetry mode"
+(functions without the parenthesis). Use I<hr()> rather
+than I<hr>, or add something like I<use subs qw/hr p header/>
+to the top of your script.
+
+=item -no_debug
+
+This turns off the command-line processing features. If you want to
+run a CGI.pm script from the command line to produce HTML, and you
+don't want it pausing to request CGI parameters from standard input or
+the command line, then use this pragma:
+
+ use CGI qw(-no_debug :standard);
+
+If you'd like to process the command-line parameters but not standard
+input, this should work:
+
+ use CGI qw(-no_debug :standard);
+ restore_parameters(join('&',@ARGV));
+
+See the section on debugging for more details.
+
+=item -private_tempfiles
+
+CGI.pm can process uploaded file. Ordinarily it spools the
+uploaded file to a temporary directory, then deletes the file
+when done. However, this opens the risk of eavesdropping as
+described in the file upload section.
+Another CGI script author could peek at this data during the
+upload, even if it is confidential information. On Unix systems,
+the -private_tempfiles pragma will cause the temporary file to be unlinked as soon
+as it is opened and before any data is written into it,
+eliminating the risk of eavesdropping.
+
+=back
+
+=head2 SPECIAL FORMS FOR IMPORTING HTML-TAG FUNCTIONS
+
+Many of the methods generate HTML tags. As described below, tag
+functions automatically generate both the opening and closing tags.
+For example:
+
+ print h1('Level 1 Header');
+
+produces
+
+ <H1>Level 1 Header</H1>
+
+There will be some times when you want to produce the start and end
+tags yourself. In this case, you can use the form start_I<tag_name>
+and end_I<tag_name>, as in:
+
+ print start_h1,'Level 1 Header',end_h1;
+
+With a few exceptions (described below), start_I<tag_name> and
+end_I<tag_name> functions are not generated automatically when you
+I<use CGI>. However, you can specify the tags you want to generate
+I<start/end> functions for by putting an asterisk in front of their
+name, or, alternatively, requesting either "start_I<tag_name>" or
+"end_I<tag_name>" in the import list.
+
+Example:
+
+ use CGI qw/:standard *table start_ul/;
+
+In this example, the following functions are generated in addition to
+the standard ones:
+
+=over 4
+
+=item 1. start_table() (generates a <TABLE> tag)
+
+=item 2. end_table() (generates a </TABLE> tag)
+
+=item 3. start_ul() (generates a <UL> tag)
+
+=item 4. end_ul() (generates a </UL> tag)
+
+=back
+
+=head1 GENERATING DYNAMIC DOCUMENTS
+
+Most of CGI.pm's functions deal with creating documents on the fly.
+Generally you will produce the HTTP header first, followed by the
+document itself. CGI.pm provides functions for generating HTTP
+headers of various types as well as for generating HTML. For creating
+GIF images, see the GD.pm module.
+
+Each of these functions produces a fragment of HTML or HTTP which you
+can print out directly so that it displays in the browser window,
+append to a string, or save to a file for later use.
+
+=head2 CREATING A STANDARD HTTP HEADER:
+
+Normally the first thing you will do in any CGI script is print out an
+HTTP header. This tells the browser what type of document to expect,
+and gives other optional information, such as the language, expiration
+date, and whether to cache the document. The header can also be
+manipulated for special purposes, such as server push and pay per view
+pages.
print $query->header;
@@ -3184,16 +4007,16 @@ header() returns the Content-type: header. You can provide your own
MIME type if you choose, otherwise it defaults to text/html. An
optional second parameter specifies the status code and a human-readable
message. For example, you can specify 204, "No response" to create a
-script that tells the browser to do nothing at all. If you want to
-add additional fields to the header, just tack them on to the end:
-
- print $query->header('text/html','200 OK','Content-Length: 3002');
+script that tells the browser to do nothing at all.
The last example shows the named argument style for passing arguments
to the CGI methods using named parameters. Recognized parameters are
-B<-type>, B<-status>, B<-expires>, and B<-cookie>. Any other
+B<-type>, B<-status>, B<-expires>, and B<-cookie>. Any other named
parameters will be stripped of their initial hyphens and turned into
header fields, allowing you to specify any HTTP header you desire.
+Internal underscores will be turned into hyphens:
+
+ print $query->header(-Content_length=>3002);
Most browsers will not cache the output from CGI scripts. Every time
the browser reloads the page, the script is invoked anew. You can
@@ -3210,11 +4033,7 @@ indicated expiration date. The following forms are all valid for the
now immediately
+3M in three months
+10y in ten years time
- Thursday, 25-Apr-96 00:40:33 GMT at the indicated time & date
-
-(CGI::expires() is the static function call used internally that turns
-relative time intervals into HTTP dates. You can call it directly if
-you wish.)
+ Thursday, 25-Apr-1999 00:40:33 GMT at the indicated time & date
The B<-cookie> parameter generates a header that tells the browser to provide
a "magic cookie" during all subsequent transactions with your script.
@@ -3227,14 +4046,19 @@ headers to work with a NPH (no-parse-header) script. This is important
to use with certain servers, such as Microsoft Internet Explorer, which
expect all their scripts to be NPH.
-=head2 GENERATING A REDIRECTION INSTRUCTION
+=head2 GENERATING A REDIRECTION HEADER
print $query->redirect('http://somewhere.else/in/movie/land');
-redirects the browser elsewhere. If you use redirection like this,
-you should B<not> print out a header as well. As of version 2.0, we
-produce both the unofficial Location: header and the official URI:
-header. This should satisfy most servers and browsers.
+Sometimes you don't want to produce a document yourself, but simply
+redirect the browser elsewhere, perhaps choosing a URL based on the
+time of day or the identity of the user.
+
+The redirect() function redirects the browser to a different URL. If
+you use redirection like this, you should B<not> print out a header as
+well. As of version 2.0, we produce both the unofficial Location:
+header and the official URI: header. This should satisfy most servers
+and browsers.
One hint I can offer is that relative links may not work correctly
when you generate a redirection to another document on your site.
@@ -3242,7 +4066,7 @@ This is due to a well-intentioned optimization that some servers use.
The solution to this is to use the full URL (including the http: part)
of the document you are redirecting to.
-You can use named parameters:
+You can also use named arguments:
print $query->redirect(-uri=>'http://somewhere.else/in/movie/land',
-nph=>1);
@@ -3252,8 +4076,7 @@ headers to work with a NPH (no-parse-header) script. This is important
to use with certain servers, such as Microsoft Internet Explorer, which
expect all their scripts to be NPH.
-
-=head2 CREATING THE HTML HEADER:
+=head2 CREATING THE HTML DOCUMENT HEADER
print $query->start_html(-title=>'Secrets of the Pyramids',
-author=>'fred@capricorn.org',
@@ -3264,17 +4087,17 @@ expect all their scripts to be NPH.
-style=>{'src'=>'/styles/style1.css'},
-BGCOLOR=>'blue');
- -or-
-
- print $query->start_html('Secrets of the Pyramids',
- 'fred@capricorn.org','true',
- 'BGCOLOR="blue"');
+After creating the HTTP header, most CGI scripts will start writing
+out an HTML document. The start_html() routine creates the top of the
+page, along with a lot of optional information that controls the
+page's appearance and behavior.
-This will return a canned HTML header and the opening <BODY> tag.
-All parameters are optional. In the named parameter form, recognized
-parameters are -title, -author, -base, -xbase and -target (see below for the
-explanation). Any additional parameters you provide, such as the
-Netscape unofficial BGCOLOR attribute, are added to the <BODY> tag.
+This method returns a canned HTML header and the opening <BODY> tag.
+All parameters are optional. In the named parameter form, recognized
+parameters are -title, -author, -base, -xbase and -target (see below
+for the explanation). Any additional parameters you provide, such as
+the Netscape unofficial BGCOLOR attribute, are added to the <BODY>
+tag. Additional parameters must be proceeded by a hyphen.
The argument B<-xbase> allows you to provide an HREF for the <BASE> tag
different from the current location, as in
@@ -3312,31 +4135,32 @@ You can place other arbitrary HTML elements to the <HEAD> section with the
B<-head> tag. For example, to place the rarely-used <LINK> element in the
head section, use this:
- print $q->header(-head=>link({-rel=>'next',
+ print $q->start_html(-head=>Link({-rel=>'next',
-href=>'http://www.capricorn.com/s2.html'}));
To incorporate multiple HTML elements into the <HEAD> section, just pass an
array reference:
- print $q->header(-head=>[ link({-rel=>'next',
+ print $q->start_html(-head=>[
+ Link({-rel=>'next',
-href=>'http://www.capricorn.com/s2.html'}),
- link({-rel=>'previous',
+ Link({-rel=>'previous',
-href=>'http://www.capricorn.com/s1.html'})
]
);
-
-JAVASCRIPTING: The B<-script>, B<-noScript>, B<-onLoad> and B<-onUnload> parameters
-are used to add Netscape JavaScript calls to your pages. B<-script>
-should point to a block of text containing JavaScript function
-definitions. This block will be placed within a <SCRIPT> block inside
-the HTML (not HTTP) header. The block is placed in the header in
-order to give your page a fighting chance of having all its JavaScript
-functions in place even if the user presses the stop button before the
-page has loaded completely. CGI.pm attempts to format the script in
-such a way that JavaScript-naive browsers will not choke on the code:
-unfortunately there are some browsers, such as Chimera for Unix, that
-get confused by it nevertheless.
+JAVASCRIPTING: The B<-script>, B<-noScript>, B<-onLoad>,
+B<-onMouseOver>, B<-onMouseOut> and B<-onUnload> parameters are used
+to add Netscape JavaScript calls to your pages. B<-script> should
+point to a block of text containing JavaScript function definitions.
+This block will be placed within a <SCRIPT> block inside the HTML (not
+HTTP) header. The block is placed in the header in order to give your
+page a fighting chance of having all its JavaScript functions in place
+even if the user presses the stop button before the page has loaded
+completely. CGI.pm attempts to format the script in such a way that
+JavaScript-naive browsers will not choke on the code: unfortunately
+there are some browsers, such as Chimera for Unix, that get confused
+by it nevertheless.
The B<-onLoad> and B<-onUnload> parameters point to fragments of JavaScript
code to execute when the page is respectively opened and closed by the
@@ -3386,6 +4210,31 @@ one or more of -language, -src, or -code:
);
+A final feature allows you to incorporate multiple <SCRIPT> sections into the
+header. Just pass the list of script sections as an array reference.
+this allows you to specify different source files for different dialects
+of JavaScript. Example:
+
+ print $q-&gt;start_html(-title=&gt;'The Riddle of the Sphinx',
+ -script=&gt;[
+ { -language =&gt; 'JavaScript1.0',
+ -src =&gt; '/javascript/utilities10.js'
+ },
+ { -language =&gt; 'JavaScript1.1',
+ -src =&gt; '/javascript/utilities11.js'
+ },
+ { -language =&gt; 'JavaScript1.2',
+ -src =&gt; '/javascript/utilities12.js'
+ },
+ { -language =&gt; 'JavaScript28.2',
+ -src =&gt; '/javascript/utilities219.js'
+ }
+ ]
+ );
+ </pre>
+
+If this looks a bit extreme, take my advice and stick with straight CGI scripting.
+
See
http://home.netscape.com/eng/mozilla/2.0/handbook/javascript/
@@ -3425,7 +4274,278 @@ place to put Netscape extensions, such as colors and wallpaper patterns.
This ends an HTML document by printing the </BODY></HTML> tags.
-=head1 CREATING FORMS
+=head2 CREATING A SELF-REFERENCING URL THAT PRESERVES STATE INFORMATION:
+
+ $myself = $query->self_url;
+ print "<A HREF=$myself>I'm talking to myself.</A>";
+
+self_url() will return a URL, that, when selected, will reinvoke
+this script with all its state information intact. This is most
+useful when you want to jump around within the document using
+internal anchors but you don't want to disrupt the current contents
+of the form(s). Something like this will do the trick.
+
+ $myself = $query->self_url;
+ print "<A HREF=$myself#table1>See table 1</A>";
+ print "<A HREF=$myself#table2>See table 2</A>";
+ print "<A HREF=$myself#yourself>See for yourself</A>";
+
+If you want more control over what's returned, using the B<url()>
+method instead.
+
+You can also retrieve the unprocessed query string with query_string():
+
+ $the_string = $query->query_string;
+
+=head2 OBTAINING THE SCRIPT'S URL
+
+ $full_url = $query->url();
+ $full_url = $query->url(-full=>1); #alternative syntax
+ $relative_url = $query->url(-relative=>1);
+ $absolute_url = $query->url(-absolute=>1);
+ $url_with_path = $query->url(-path_info=>1);
+ $url_with_path_and_query = $query->url(-path_info=>1,-query=>1);
+
+B<url()> returns the script's URL in a variety of formats. Called
+without any arguments, it returns the full form of the URL, including
+host name and port number
+
+ http://your.host.com/path/to/script.cgi
+
+You can modify this format with the following named arguments:
+
+=over 4
+
+=item B<-absolute>
+
+If true, produce an absolute URL, e.g.
+
+ /path/to/script.cgi
+
+=item B<-relative>
+
+Produce a relative URL. This is useful if you want to reinvoke your
+script with different parameters. For example:
+
+ script.cgi
+
+=item B<-full>
+
+Produce the full URL, exactly as if called without any arguments.
+This overrides the -relative and -absolute arguments.
+
+=item B<-path> (B<-path_info>)
+
+Append the additional path information to the URL. This can be
+combined with B<-full>, B<-absolute> or B<-relative>. B<-path_info>
+is provided as a synonym.
+
+=item B<-query> (B<-query_string>)
+
+Append the query string to the URL. This can be combined with
+B<-full>, B<-absolute> or B<-relative>. B<-query_string> is provided
+as a synonym.
+
+=back
+
+=head2 MIXING POST AND URL PARAMETERS
+
+ $color = $query-&gt;url_param('color');
+
+It is possible for a script to receive CGI parameters in the URL as
+well as in the fill-out form by creating a form that POSTs to a URL
+containing a query string (a "?" mark followed by arguments). The
+B<param()> method will always return the contents of the POSTed
+fill-out form, ignoring the URL's query string. To retrieve URL
+parameters, call the B<url_param()> method. Use it in the same way as
+B<param()>. The main difference is that it allows you to read the
+parameters, but not set them.
+
+
+Under no circumstances will the contents of the URL query string
+interfere with similarly-named CGI parameters in POSTed forms. If you
+try to mix a URL query string with a form submitted with the GET
+method, the results will not be what you expect.
+
+=head1 CREATING STANDARD HTML ELEMENTS:
+
+CGI.pm defines general HTML shortcut methods for most, if not all of
+the HTML 3 and HTML 4 tags. HTML shortcuts are named after a single
+HTML element and return a fragment of HTML text that you can then
+print or manipulate as you like. Each shortcut returns a fragment of
+HTML code that you can append to a string, save to a file, or, most
+commonly, print out so that it displays in the browser window.
+
+This example shows how to use the HTML methods:
+
+ $q = new CGI;
+ print $q->blockquote(
+ "Many years ago on the island of",
+ $q->a({href=>"http://crete.org/"},"Crete"),
+ "there lived a minotaur named",
+ $q->strong("Fred."),
+ ),
+ $q->hr;
+
+This results in the following HTML code (extra newlines have been
+added for readability):
+
+ <blockquote>
+ Many years ago on the island of
+ <a HREF="http://crete.org/">Crete</a> there lived
+ a minotaur named <strong>Fred.</strong>
+ </blockquote>
+ <hr>
+
+If you find the syntax for calling the HTML shortcuts awkward, you can
+import them into your namespace and dispense with the object syntax
+completely (see the next section for more details):
+
+ use CGI ':standard';
+ print blockquote(
+ "Many years ago on the island of",
+ a({href=>"http://crete.org/"},"Crete"),
+ "there lived a minotaur named",
+ strong("Fred."),
+ ),
+ hr;
+
+=head2 PROVIDING ARGUMENTS TO HTML SHORTCUTS
+
+The HTML methods will accept zero, one or multiple arguments. If you
+provide no arguments, you get a single tag:
+
+ print hr; # <HR>
+
+If you provide one or more string arguments, they are concatenated
+together with spaces and placed between opening and closing tags:
+
+ print h1("Chapter","1"); # <H1>Chapter 1</H1>"
+
+If the first argument is an associative array reference, then the keys
+and values of the associative array become the HTML tag's attributes:
+
+ print a({-href=>'fred.html',-target=>'_new'},
+ "Open a new frame");
+
+ <A HREF="fred.html",TARGET="_new">Open a new frame</A>
+
+You may dispense with the dashes in front of the attribute names if
+you prefer:
+
+ print img {src=>'fred.gif',align=>'LEFT'};
+
+ <IMG ALIGN="LEFT" SRC="fred.gif">
+
+Sometimes an HTML tag attribute has no argument. For example, ordered
+lists can be marked as COMPACT. The syntax for this is an argument that
+that points to an undef string:
+
+ print ol({compact=>undef},li('one'),li('two'),li('three'));
+
+Prior to CGI.pm version 2.41, providing an empty ('') string as an
+attribute argument was the same as providing undef. However, this has
+changed in order to accommodate those who want to create tags of the form
+<IMG ALT="">. The difference is shown in these two pieces of code:
+
+ CODE RESULT
+ img({alt=>undef}) <IMG ALT>
+ img({alt=>''}) <IMT ALT="">
+
+=head2 THE DISTRIBUTIVE PROPERTY OF HTML SHORTCUTS
+
+One of the cool features of the HTML shortcuts is that they are
+distributive. If you give them an argument consisting of a
+B<reference> to a list, the tag will be distributed across each
+element of the list. For example, here's one way to make an ordered
+list:
+
+ print ul(
+ li({-type=>'disc'},['Sneezy','Doc','Sleepy','Happy']);
+ );
+
+This example will result in HTML output that looks like this:
+
+ <UL>
+ <LI TYPE="disc">Sneezy</LI>
+ <LI TYPE="disc">Doc</LI>
+ <LI TYPE="disc">Sleepy</LI>
+ <LI TYPE="disc">Happy</LI>
+ </UL>
+
+This is extremely useful for creating tables. For example:
+
+ print table({-border=>undef},
+ caption('When Should You Eat Your Vegetables?'),
+ Tr({-align=>CENTER,-valign=>TOP},
+ [
+ th(['Vegetable', 'Breakfast','Lunch','Dinner']),
+ td(['Tomatoes' , 'no', 'yes', 'yes']),
+ td(['Broccoli' , 'no', 'no', 'yes']),
+ td(['Onions' , 'yes','yes', 'yes'])
+ ]
+ )
+ );
+
+=head2 HTML SHORTCUTS AND LIST INTERPOLATION
+
+Consider this bit of code:
+
+ print blockquote(em('Hi'),'mom!'));
+
+It will ordinarily return the string that you probably expect, namely:
+
+ <BLOCKQUOTE><EM>Hi</EM> mom!</BLOCKQUOTE>
+
+Note the space between the element "Hi" and the element "mom!".
+CGI.pm puts the extra space there using array interpolation, which is
+controlled by the magic $" variable. Sometimes this extra space is
+not what you want, for example, when you are trying to align a series
+of images. In this case, you can simply change the value of $" to an
+empty string.
+
+ {
+ local($") = '';
+ print blockquote(em('Hi'),'mom!'));
+ }
+
+I suggest you put the code in a block as shown here. Otherwise the
+change to $" will affect all subsequent code until you explicitly
+reset it.
+
+=head2 NON-STANDARD HTML SHORTCUTS
+
+A few HTML tags don't follow the standard pattern for various
+reasons.
+
+B<comment()> generates an HTML comment (<!-- comment -->). Call it
+like
+
+ print comment('here is my comment');
+
+Because of conflicts with built-in Perl functions, the following functions
+begin with initial caps:
+
+ Select
+ Tr
+ Link
+ Delete
+ Accept
+ Sub
+
+In addition, start_html(), end_html(), start_form(), end_form(),
+start_multipart_form() and all the fill-out form tags are special.
+See their respective sections.
+
+=head2 PRETTY-PRINTING HTML
+
+By default, all the HTML produced by these functions comes out as one
+long line without carriage returns or indentation. This is yuck, but
+it does reduce the size of the documents by 10-20%. To get
+pretty-printed output, please use L<CGI::Pretty>, a subclass
+contributed by Brian Paulsen.
+
+=head1 CREATING FILL-OUT FORMS:
I<General note> The various form-creating methods all return strings
to the caller, containing the tag or tags that will create the requested
@@ -3479,7 +4599,7 @@ default is to process the query with the current script.
print $query->startform(-method=>$method,
-action=>$action,
- -encoding=>$encoding);
+ -enctype=>$encoding);
<... various form stuff ...>
print $query->endform;
@@ -3494,11 +4614,11 @@ action and form encoding that you specify. The defaults are:
method: POST
action: this script
- encoding: application/x-www-form-urlencoded
+ enctype: application/x-www-form-urlencoded
endform() returns the closing </FORM> tag.
-Startform()'s encoding method tells the browser how to package the various
+Startform()'s enctype argument tells the browser how to package the various
fields of the form before sending the form to the server. Two
values are possible:
@@ -3519,7 +4639,7 @@ It is suitable for forms that contain very large fields or that
are intended for transferring binary data. Most importantly,
it enables the "file upload" feature of Netscape 2.0 forms. For
your convenience, CGI.pm stores the name of this encoding type
-in B<$CGI::MULTIPART>
+in B<&CGI::MULTIPART>
Forms that use this type of encoding are not easily interpreted
by CGI scripts unless they use CGI.pm or another library designed
@@ -3605,13 +4725,14 @@ parameter:
-size=>50,
-maxlength=>80);
-JAVASCRIPTING: You can also provide B<-onChange>, B<-onFocus>, B<-onBlur>
-and B<-onSelect> parameters to register JavaScript event handlers.
-The onChange handler will be called whenever the user changes the
-contents of the text field. You can do text validation if you like.
-onFocus and onBlur are called respectively when the insertion point
-moves into and out of the text field. onSelect is called when the
-user changes the portion of the text that is selected.
+JAVASCRIPTING: You can also provide B<-onChange>, B<-onFocus>,
+B<-onBlur>, B<-onMouseOver>, B<-onMouseOut> and B<-onSelect>
+parameters to register JavaScript event handlers. The onChange
+handler will be called whenever the user changes the contents of the
+text field. You can do text validation if you like. onFocus and
+onBlur are called respectively when the insertion point moves into and
+out of the text field. onSelect is called when the user changes the
+portion of the text that is selected.
=head2 CREATING A BIG TEXT FIELD
@@ -3629,8 +4750,9 @@ rows and columns for a multiline text entry box. You can provide
a starting value for the field, which can be long and contain
multiple lines.
-JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>
-and B<-onSelect> parameters are recognized. See textfield().
+JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur> ,
+B<-onMouseOver>, B<-onMouseOut>, and B<-onSelect> parameters are
+recognized. See textfield().
=head2 CREATING A PASSWORD FIELD
@@ -3645,8 +4767,9 @@ and B<-onSelect> parameters are recognized. See textfield().
password_field() is identical to textfield(), except that its contents
will be starred out on the web page.
-JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>
-and B<-onSelect> parameters are recognized. See textfield().
+JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>,
+B<-onMouseOver>, B<-onMouseOut> and B<-onSelect> parameters are
+recognized. See textfield().
=head2 CREATING A FILE UPLOAD FIELD
@@ -3678,12 +4801,11 @@ The first parameter is the required name for the field (-name).
The optional second parameter is the starting value for the field contents
to be used as the default file name (-default).
-The beta2 version of Netscape 2.0 currently doesn't pay any attention
-to this field, and so the starting value will always be blank. Worse,
-the field loses its "sticky" behavior and forgets its previous
-contents. The starting value field is called for in the HTML
-specification, however, and possibly later versions of Netscape will
-honor it.
+For security reasons, browsers don't pay any attention to this field,
+and so the starting value will always be blank. Worse, the field
+loses its "sticky" behavior and forgets its previous contents. The
+starting value field is called for in the HTML specification, however,
+and possibly some browser will eventually provide support for it.
=item 3.
@@ -3702,9 +4824,9 @@ by calling param().
$filename = $query->param('uploaded_file');
-In Netscape Gold, the filename that gets returned is the full local filename
-on the B<remote user's> machine. If the remote user is on a Unix
-machine, the filename will follow Unix conventions:
+In Netscape Navigator 2.0, the filename that gets returned is the full
+local filename on the B<remote user's> machine. If the remote user is
+on a Unix machine, the filename will follow Unix conventions:
/path/to/the/file
@@ -3747,9 +4869,9 @@ If you are using a machine that recognizes "text" and "binary" data
modes, be sure to understand when and how to use them (see the Camel book).
Otherwise you may find that binary files are corrupted during file uploads.
-JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>
-and B<-onSelect> parameters are recognized. See textfield()
-for details.
+JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>,
+B<-onMouseOver>, B<-onMouseOut> and B<-onSelect> parameters are
+recognized. See textfield() for details.
=head2 CREATING A POPUP MENU
@@ -3811,8 +4933,9 @@ be retrieved using:
$popup_menu_value = $query->param('menu_name');
JAVASCRIPTING: popup_menu() recognizes the following event handlers:
-B<-onChange>, B<-onFocus>, and B<-onBlur>. See the textfield()
-section for details on when these handlers are called.
+B<-onChange>, B<-onFocus>, B<-onMouseOver>, B<-onMouseOut>, and
+B<-onBlur>. See the textfield() section for details on when these
+handlers are called.
=head2 CREATING A SCROLLING LIST
@@ -3880,9 +5003,10 @@ selected items can be retrieved with:
=back
-JAVASCRIPTING: scrolling_list() recognizes the following event handlers:
-B<-onChange>, B<-onFocus>, and B<-onBlur>. See textfield() for
-the description of when these handlers are called.
+JAVASCRIPTING: scrolling_list() recognizes the following event
+handlers: B<-onChange>, B<-onFocus>, B<-onMouseOver>, B<-onMouseOut>
+and B<-onBlur>. See textfield() for the description of when these
+handlers are called.
=head2 CREATING A GROUP OF RELATED CHECKBOXES
@@ -3940,17 +5064,15 @@ be used as the default.
=item 5.
-B<HTML3-compatible browsers> (such as Netscape) can take advantage
-of the optional
-parameters B<-rows>, and B<-columns>. These parameters cause
-checkbox_group() to return an HTML3 compatible table containing
-the checkbox group formatted with the specified number of rows
-and columns. You can provide just the -columns parameter if you
-wish; checkbox_group will calculate the correct number of rows
-for you.
+B<HTML3-compatible browsers> (such as Netscape) can take advantage of
+the optional parameters B<-rows>, and B<-columns>. These parameters
+cause checkbox_group() to return an HTML3 compatible table containing
+the checkbox group formatted with the specified number of rows and
+columns. You can provide just the -columns parameter if you wish;
+checkbox_group will calculate the correct number of rows for you.
To include row and column headings in the returned table, you
-can use the B<-rowheader> and B<-colheader> parameters. Both
+can use the B<-rowheaders> and B<-colheaders> parameters. Both
of these accept a pointer to an array of headings to use.
The headings are just decorative. They don't reorganize the
interpretation of the checkboxes -- they're still a single named
@@ -4100,7 +5222,7 @@ To include row and column headings in the returned table, you
can use the B<-rowheader> and B<-colheader> parameters. Both
of these accept a pointer to an array of headings to use.
The headings are just decorative. They don't reorganize the
-interpetation of the radio buttons -- they're still a single named
+interpretation of the radio buttons -- they're still a single named
unit.
=back
@@ -4164,6 +5286,9 @@ reset() creates the "reset" button. Note that it restores the
form to its value from the last time the script was called,
NOT necessarily to the defaults.
+Note that this conflicts with the Perl reset() built-in. Use
+CORE::reset() to get the original reset function.
+
=head2 CREATING A DEFAULT BUTTON
print $query->defaults('button_label')
@@ -4270,11 +5395,12 @@ pointed to by the B<-onClick> parameter will be executed. On
non-Netscape browsers this form element will probably not even
display.
-=head1 NETSCAPE COOKIES
+=head1 HTTP COOKIES
-Netscape browsers versions 1.1 and higher support a so-called
-"cookie" designed to help maintain state within a browser session.
-CGI.pm has several methods that support cookies.
+Netscape browsers versions 1.1 and higher, and all versions of
+Internet Explorer, support a so-called "cookie" designed to help
+maintain state within a browser session. CGI.pm has several methods
+that support cookies.
A cookie is a name=value pair much like the named parameters in a CGI
query string. CGI scripts create one or more cookies and send
@@ -4292,15 +5418,15 @@ optional attributes:
This is a time/date string (in a special GMT format) that indicates
when a cookie expires. The cookie will be saved and returned to your
script until this expiration date is reached if the user exits
-Netscape and restarts it. If an expiration date isn't specified, the cookie
-will remain active until the user quits Netscape.
+the browser and restarts it. If an expiration date isn't specified, the cookie
+will remain active until the user quits the browser.
=item 2. a domain
This is a partial or complete domain name for which the cookie is
valid. The browser will return the cookie to any host that matches
the partial domain name. For example, if you specify a domain name
-of ".capricorn.com", then Netscape will return the cookie to
+of ".capricorn.com", then the browser will return the cookie to
Web servers running on any of the machines "www.capricorn.com",
"www2.capricorn.com", "feckless.capricorn.com", etc. Domain names
must contain at least two periods to prevent attempts to match
@@ -4325,7 +5451,7 @@ script if the CGI request is occurring on a secure channel, such as SSL.
=back
-The interface to Netscape cookies is the B<cookie()> method:
+The interface to HTTP cookies is the B<cookie()> method:
$cookie = $query->cookie(-name=>'sessionID',
-value=>'xyzzy',
@@ -4342,7 +5468,7 @@ B<cookie()> creates a new cookie. Its parameters include:
=item B<-name>
The name of the cookie (required). This can be any string at all.
-Although Netscape limits its cookie names to non-whitespace
+Although browsers limit their cookie names to non-whitespace
alphanumeric characters, CGI.pm removes this restriction by escaping
and unescaping cookies behind the scenes.
@@ -4413,19 +5539,11 @@ simple to turn a CGI parameter into a cookie, and vice-versa:
See the B<cookie.cgi> example script for some ideas on how to use
cookies effectively.
-B<NOTE:> There appear to be some (undocumented) restrictions on
-Netscape cookies. In Netscape 2.01, at least, I haven't been able to
-set more than three cookies at a time. There may also be limits on
-the length of cookies. If you need to store a lot of information,
-it's probably better to create a unique session ID, store it in a
-cookie, and use the session ID to locate an external file/database
-saved on the server's side of the connection.
+=head1 WORKING WITH FRAMES
-=head1 WORKING WITH NETSCAPE FRAMES
-
-It's possible for CGI.pm scripts to write into several browser
-panels and windows using Netscape's frame mechanism.
-There are three techniques for defining new frames programmatically:
+It's possible for CGI.pm scripts to write into several browser panels
+and windows using the HTML 4 frame mechanism. There are three
+techniques for defining new frames programmatically:
=over 4
@@ -4448,12 +5566,12 @@ You may provide a B<-target> parameter to the header() method:
print $q->header(-target=>'ResultsWindow');
-This will tell Netscape to load the output of your script into the
-frame named "ResultsWindow". If a frame of that name doesn't
-already exist, Netscape will pop up a new window and load your
-script's document into that. There are a number of magic names
-that you can use for targets. See the frame documents on Netscape's
-home pages for details.
+This will tell the browser to load the output of your script into the
+frame named "ResultsWindow". If a frame of that name doesn't already
+exist, the browser will pop up a new window and load your script's
+document into that. There are a number of magic names that you can
+use for targets. See the frame documents on Netscape's home pages for
+details.
=item 3. Specify the destination for the document in the <FORM> tag
@@ -4485,6 +5603,10 @@ stylesheet can be found. B<-code> points to a scalar value to be
incorporated into a <STYLE> section. Style definitions in B<-code>
override similarly-named ones in B<-src>, hence the name "cascading."
+You may also specify the type of the stylesheet by adding the optional
+B<-type> parameter to the hash pointed to by B<-style>. If not
+specified, the style defaults to 'text/css'.
+
To refer to a style within the body of your document, add the
B<-class> parameter to any HTML element:
@@ -4594,13 +5716,8 @@ Produces something that looks like:
</UL>
</UL>
-You can pass a value of 'true' to dump() in order to get it to
-print the results out as plain text, suitable for incorporating
-into a <PRE> section.
-
-As a shortcut, as of version 1.56 you can interpolate the entire CGI
-object into a string and it will be replaced with the a nice HTML dump
-shown above:
+As a shortcut, you can interpolate the entire CGI object into a string
+and it will be replaced with the a nice HTML dump shown above:
$query=new CGI;
print "<H2>Current Values</H2> $query\n";
@@ -4612,25 +5729,32 @@ through this interface. The methods are as follows:
=over 4
-=item B<accept()>
+=item B<Accept()>
+
+Return a list of MIME types that the remote browser accepts. If you
+give this method a single argument corresponding to a MIME type, as in
+$query->Accept('text/html'), it will return a floating point value
+corresponding to the browser's preference for this type from 0.0
+(don't want) to 1.0. Glob types (e.g. text/*) in the browser's accept
+list are handled correctly.
-Return a list of MIME types that the remote browser
-accepts. If you give this method a single argument
-corresponding to a MIME type, as in
-$query->accept('text/html'), it will return a
-floating point value corresponding to the browser's
-preference for this type from 0.0 (don't want) to 1.0.
-Glob types (e.g. text/*) in the browser's accept list
-are handled correctly.
+Note that the capitalization changed between version 2.43 and 2.44 in
+order to avoid conflict with Perl's accept() function.
=item B<raw_cookie()>
-Returns the HTTP_COOKIE variable, an HTTP extension
-implemented by Netscape browsers version 1.1
-and higher. Cookies have a special format, and this
-method call just returns the raw form (?cookie dough).
-See cookie() for ways of setting and retrieving
-cooked cookies.
+Returns the HTTP_COOKIE variable, an HTTP extension implemented by
+Netscape browsers version 1.1 and higher, and all versions of Internet
+Explorer. Cookies have a special format, and this method call just
+returns the raw form (?cookie dough). See cookie() for ways of
+setting and retrieving cooked cookies.
+
+Called with no parameters, raw_cookie() returns the packed cookie
+structure. You can separate it into individual cookies by splitting
+on the character sequence "; ". Called with the name of a cookie,
+retrieves the B<unescaped> form of the cookie. You can use the
+regular cookie() method to get the names, or use the raw_fetch()
+method from the CGI::Cookie module.
=item B<user_agent()>
@@ -4705,10 +5829,9 @@ verification, if this script is protected.
=item B<user_name ()>
-Attempt to obtain the remote user's name, using a variety
-of different techniques. This only works with older browsers
-such as Mosaic. Netscape does not reliably report the user
-name!
+Attempt to obtain the remote user's name, using a variety of different
+techniques. This only works with older browsers such as Mosaic.
+Newer browsers do not report the user name for privacy reasons!
=item B<request_method()>
@@ -4717,242 +5840,232 @@ one of 'POST', 'GET' or 'HEAD'.
=back
-=head1 CREATING HTML ELEMENTS
-
-In addition to its shortcuts for creating form elements, CGI.pm
-defines general HTML shortcut methods as well. HTML shortcuts are
-named after a single HTML element and return a fragment of HTML text
-that you can then print or manipulate as you like.
-
-This example shows how to use the HTML methods:
-
- $q = new CGI;
- print $q->blockquote(
- "Many years ago on the island of",
- $q->a({href=>"http://crete.org/"},"Crete"),
- "there lived a minotaur named",
- $q->strong("Fred."),
- ),
- $q->hr;
-
-This results in the following HTML code (extra newlines have been
-added for readability):
+=head1 USING NPH SCRIPTS
- <blockquote>
- Many years ago on the island of
- <a HREF="http://crete.org/">Crete</a> there lived
- a minotaur named <strong>Fred.</strong>
- </blockquote>
- <hr>
+NPH, or "no-parsed-header", scripts bypass the server completely by
+sending the complete HTTP header directly to the browser. This has
+slight performance benefits, but is of most use for taking advantage
+of HTTP extensions that are not directly supported by your server,
+such as server push and PICS headers.
-If you find the syntax for calling the HTML shortcuts awkward, you can
-import them into your namespace and dispense with the object syntax
-completely (see the next section for more details):
+Servers use a variety of conventions for designating CGI scripts as
+NPH. Many Unix servers look at the beginning of the script's name for
+the prefix "nph-". The Macintosh WebSTAR server and Microsoft's
+Internet Information Server, in contrast, try to decide whether a
+program is an NPH script by examining the first line of script output.
- use CGI shortcuts; # IMPORT HTML SHORTCUTS
- print blockquote(
- "Many years ago on the island of",
- a({href=>"http://crete.org/"},"Crete"),
- "there lived a minotaur named",
- strong("Fred."),
- ),
- hr;
-=head2 PROVIDING ARGUMENTS TO HTML SHORTCUTS
+CGI.pm supports NPH scripts with a special NPH mode. When in this
+mode, CGI.pm will output the necessary extra header information when
+the header() and redirect() methods are
+called.
-The HTML methods will accept zero, one or multiple arguments. If you
-provide no arguments, you get a single tag:
+The Microsoft Internet Information Server requires NPH mode. As of version
+2.30, CGI.pm will automatically detect when the script is running under IIS
+and put itself into this mode. You do not need to do this manually, although
+it won't hurt anything if you do.
- print hr;
- # gives "<hr>"
+There are a number of ways to put CGI.pm into NPH mode:
-If you provide one or more string arguments, they are concatenated
-together with spaces and placed between opening and closing tags:
+=over 4
- print h1("Chapter","1");
- # gives "<h1>Chapter 1</h1>"
+=item In the B<use> statement
-If the first argument is an associative array reference, then the keys
-and values of the associative array become the HTML tag's attributes:
+Simply add the "-nph" pragmato the list of symbols to be imported into
+your script:
- print a({href=>'fred.html',target=>'_new'},
- "Open a new frame");
- # gives <a href="fred.html",target="_new">Open a new frame</a>
+ use CGI qw(:standard -nph)
-You are free to use CGI.pm-style dashes in front of the attribute
-names if you prefer:
+=item By calling the B<nph()> method:
- print img {-src=>'fred.gif',-align=>'LEFT'};
- # gives <img ALIGN="LEFT" SRC="fred.gif">
+Call B<nph()> with a non-zero parameter at any point after using CGI.pm in your program.
-=head2 Generating new HTML tags
+ CGI->nph(1)
-Since no mere mortal can keep up with Netscape and Microsoft as they
-battle it out for control of HTML, the code that generates HTML tags
-is general and extensible. You can create new HTML tags freely just
-by referring to them on the import line:
+=item By using B<-nph> parameters in the B<header()> and B<redirect()> statements:
- use CGI shortcuts,winkin,blinkin,nod;
+ print $q->header(-nph=>1);
-Now, in addition to the standard CGI shortcuts, you've created HTML
-tags named "winkin", "blinkin" and "nod". You can use them like this:
+=back
- print blinkin {color=>'blue',rate=>'fast'},"Yahoo!";
- # <blinkin COLOR="blue" RATE="fast">Yahoo!</blinkin>
+=head1 Server Push
+
+CGI.pm provides three simple functions for producing multipart
+documents of the type needed to implement server push. These
+functions were graciously provided by Ed Jordan <ed@fidalgo.net>. To
+import these into your namespace, you must import the ":push" set.
+You are also advised to put the script into NPH mode and to set $| to
+1 to avoid buffering problems.
+
+Here is a simple script that demonstrates server push:
+
+ #!/usr/local/bin/perl
+ use CGI qw/:push -nph/;
+ $| = 1;
+ print multipart_init(-boundary=>'----------------here we go!');
+ while (1) {
+ print multipart_start(-type=>'text/plain'),
+ "The current time is ",scalar(localtime),"\n",
+ multipart_end;
+ sleep 1;
+ }
-=head1 IMPORTING CGI METHOD CALLS INTO YOUR NAME SPACE
+This script initializes server push by calling B<multipart_init()>.
+It then enters an infinite loop in which it begins a new multipart
+section by calling B<multipart_start()>, prints the current local time,
+and ends a multipart section with B<multipart_end()>. It then sleeps
+a second, and begins again.
-As a convenience, you can import most of the CGI method calls directly
-into your name space. The syntax for doing this is:
+=over 4
- use CGI <list of methods>;
+=item multipart_init()
+
+ multipart_init(-boundary=>$boundary);
-The listed methods will be imported into the current package; you can
-call them directly without creating a CGI object first. This example
-shows how to import the B<param()> and B<header()>
-methods, and then use them directly:
+Initialize the multipart system. The -boundary argument specifies
+what MIME boundary string to use to separate parts of the document.
+If not provided, CGI.pm chooses a reasonable boundary for you.
- use CGI param,header;
- print header('text/plain');
- $zipcode = param('zipcode');
+=item multipart_start()
-You can import groups of methods by referring to a number of special
-names:
+ multipart_start(-type=>$type)
-=over 4
+Start a new part of the multipart document using the specified MIME
+type. If not specified, text/html is assumed.
-=item B<cgi>
+=item multipart_end()
-Import all CGI-handling methods, such as B<param()>, B<path_info()>
-and the like.
+ multipart_end()
-=item B<form>
+End a part. You must remember to call multipart_end() once for each
+multipart_start().
-Import all fill-out form generating methods, such as B<textfield()>.
+=back
-=item B<html2>
+Users interested in server push applications should also have a look
+at the CGI::Push module.
-Import all methods that generate HTML 2.0 standard elements.
+=head1 Avoiding Denial of Service Attacks
-=item B<html3>
+A potential problem with CGI.pm is that, by default, it attempts to
+process form POSTings no matter how large they are. A wily hacker
+could attack your site by sending a CGI script a huge POST of many
+megabytes. CGI.pm will attempt to read the entire POST into a
+variable, growing hugely in size until it runs out of memory. While
+the script attempts to allocate the memory the system may slow down
+dramatically. This is a form of denial of service attack.
-Import all methods that generate HTML 3.0 proposed elements (such as
-<table>, <super> and <sub>).
+Another possible attack is for the remote user to force CGI.pm to
+accept a huge file upload. CGI.pm will accept the upload and store it
+in a temporary directory even if your script doesn't expect to receive
+an uploaded file. CGI.pm will delete the file automatically when it
+terminates, but in the meantime the remote user may have filled up the
+server's disk space, causing problems for other programs.
-=item B<netscape>
+The best way to avoid denial of service attacks is to limit the amount
+of memory, CPU time and disk space that CGI scripts can use. Some Web
+servers come with built-in facilities to accomplish this. In other
+cases, you can use the shell I<limit> or I<ulimit>
+commands to put ceilings on CGI resource usage.
-Import all methods that generate Netscape-specific HTML extensions.
-=item B<shortcuts>
+CGI.pm also has some simple built-in protections against denial of
+service attacks, but you must activate them before you can use them.
+These take the form of two global variables in the CGI name space:
-Import all HTML-generating shortcuts (i.e. 'html2' + 'html3' +
-'netscape')...
+=over 4
-=item B<standard>
+=item B<$CGI::POST_MAX>
-Import "standard" features, 'html2', 'form' and 'cgi'.
+If set to a non-negative integer, this variable puts a ceiling
+on the size of POSTings, in bytes. If CGI.pm detects a POST
+that is greater than the ceiling, it will immediately exit with an error
+message. This value will affect both ordinary POSTs and
+multipart POSTs, meaning that it limits the maximum size of file
+uploads as well. You should set this to a reasonably high
+value, such as 1 megabyte.
-=item B<all>
+=item B<$CGI::DISABLE_UPLOADS>
-Import all the available methods. For the full list, see the CGI.pm
-code, where the variable %TAGS is defined.
+If set to a non-zero value, this will disable file uploads
+completely. Other fill-out form values will work as usual.
=back
-Note that in the interests of execution speed CGI.pm does B<not> use
-the standard L<Exporter> syntax for specifying load symbols. This may
-change in the future.
-
-If you import any of the state-maintaining CGI or form-generating
-methods, a default CGI object will be created and initialized
-automatically the first time you use any of the methods that require
-one to be present. This includes B<param()>, B<textfield()>,
-B<submit()> and the like. (If you need direct access to the CGI
-object, you can find it in the global variable B<$CGI::Q>). By
-importing CGI.pm methods, you can create visually elegant scripts:
-
- use CGI standard,html2;
- print
- header,
- start_html('Simple Script'),
- h1('Simple Script'),
- start_form,
- "What's your name? ",textfield('name'),p,
- "What's the combination?",
- checkbox_group(-name=>'words',
- -values=>['eenie','meenie','minie','moe'],
- -defaults=>['eenie','moe']),p,
- "What's your favorite color?",
- popup_menu(-name=>'color',
- -values=>['red','green','blue','chartreuse']),p,
- submit,
- end_form,
- hr,"\n";
+You can use these variables in either of two ways.
- if (param) {
- print
- "Your name is ",em(param('name')),p,
- "The keywords are: ",em(join(", ",param('words'))),p,
- "Your favorite color is ",em(param('color')),".\n";
- }
- print end_html;
+=over 4
-=head1 USING NPH SCRIPTS
+=item B<1. On a script-by-script basis>
-NPH, or "no-parsed-header", scripts bypass the server completely by
-sending the complete HTTP header directly to the browser. This has
-slight performance benefits, but is of most use for taking advantage
-of HTTP extensions that are not directly supported by your server,
-such as server push and PICS headers.
+Set the variable at the top of the script, right after the "use" statement:
-Servers use a variety of conventions for designating CGI scripts as
-NPH. Many Unix servers look at the beginning of the script's name for
-the prefix "nph-". The Macintosh WebSTAR server and Microsoft's
-Internet Information Server, in contrast, try to decide whether a
-program is an NPH script by examining the first line of script output.
+ use CGI qw/:standard/;
+ use CGI::Carp 'fatalsToBrowser';
+ $CGI::POST_MAX=1024 * 100; # max 100K posts
+ $CGI::DISABLE_UPLOADS = 1; # no uploads
+=item B<2. Globally for all scripts>
-CGI.pm supports NPH scripts with a special NPH mode. When in this
-mode, CGI.pm will output the necessary extra header information when
-the header() and redirect() methods are
-called.
+Open up CGI.pm, find the definitions for $POST_MAX and
+$DISABLE_UPLOADS, and set them to the desired values. You'll
+find them towards the top of the file in a subroutine named
+initialize_globals().
-The Microsoft Internet Information Server requires NPH mode. As of version
-2.30, CGI.pm will automatically detect when the script is running under IIS
-and put itself into this mode. You do not need to do this manually, although
-it won't hurt anything if you do.
-
-There are a number of ways to put CGI.pm into NPH mode:
+=back
-=over 4
+Since an attempt to send a POST larger than $POST_MAX bytes
+will cause a fatal error, you might want to use CGI::Carp to echo the
+fatal error message to the browser window as shown in the example
+above. Otherwise the remote user will see only a generic "Internal
+Server" error message. See the L<CGI::Carp> manual page for more
+details.
-=item In the B<use> statement
-Simply add ":nph" to the list of symbols to be imported into your script:
+=head1 COMPATIBILITY WITH CGI-LIB.PL
- use CGI qw(:standard :nph)
+To make it easier to port existing programs that use cgi-lib.pl
+the compatibility routine "ReadParse" is provided. Porting is
+simple:
-=item By calling the B<nph()> method:
+OLD VERSION
+ require "cgi-lib.pl";
+ &ReadParse;
+ print "The value of the antique is $in{antique}.\n";
-Call B<nph()> with a non-zero parameter at any point after using CGI.pm in your program.
+NEW VERSION
+ use CGI;
+ CGI::ReadParse
+ print "The value of the antique is $in{antique}.\n";
- CGI->nph(1)
+CGI.pm's ReadParse() routine creates a tied variable named %in,
+which can be accessed to obtain the query variables. Like
+ReadParse, you can also provide your own variable. Infrequently
+used features of ReadParse, such as the creation of @in and $in
+variables, are not supported.
-=item By using B<-nph> parameters in the B<header()> and B<redirect()> statements:
+Once you use ReadParse, you can retrieve the query object itself
+this way:
- print $q->header(-nph=&gt;1);
+ $q = $in{CGI};
+ print $q->textfield(-name=>'wow',
+ -value=>'does this really work?');
-=back
+This allows you to start using the more interesting features
+of CGI.pm without rewriting your old scripts from scratch.
=head1 AUTHOR INFORMATION
-Copyright 1995,1996, Lincoln D. Stein. All rights reserved. It may
-be used and modified freely, but I do request that this copyright
-notice remain attached to the file. You may modify this module as you
-wish, but if you redistribute a modified version, please attach a note
-listing the modifications you have made.
+Copyright 1995-1998, Lincoln D. Stein. All rights reserved.
-Address bug reports and comments to:
-lstein@genome.wi.mit.edu
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+Address bug reports and comments to: lstein@cshl.org. When sending
+bug reports, please provide the version of CGI.pm, the version of
+Perl, the name and version of your Web server, and the name and
+version of the operating system you are using. If the problem is even
+remotely browser dependent, please provide information about the
+affected browers as well.
=head1 CREDITS
@@ -4972,7 +6085,7 @@ Thanks very much to:
=item Joergen Haegg (jh@axis.se)
-=item Laurent Delfosse (delfosse@csgrad1.cs.wvu.edu)
+=item Laurent Delfosse (delfosse@delfosse.com)
=item Richard Resnick (applepi1@aol.com)
@@ -4996,6 +6109,10 @@ Thanks very much to:
=item David Alan Pisoni (david@cnation.com)
+=item Doug MacEachern (dougm@opengroup.org)
+
+=item Robin Houston (robin@oneworld.org)
+
=item ...and many many more...
for suggestions and bug fixes.
@@ -5060,7 +6177,7 @@ for suggestions and bug fixes.
-rows=>10,
-columns=>50);
- print "<P>",$query->reset;
+ print "<P>",$query->Reset;
print $query->submit('Action','Shout');
print $query->submit('Action','Scream');
print $query->endform;
@@ -5101,8 +6218,8 @@ warnings when programs are run with the B<-w> switch.
=head1 SEE ALSO
L<CGI::Carp>, L<URI::URL>, L<CGI::Request>, L<CGI::MiniSvr>,
-L<CGI::Base>, L<CGI::Form>, L<CGI::Apache>, L<CGI::Switch>,
-L<CGI::Push>, L<CGI::Fast>
+L<CGI::Base>, L<CGI::Form>, L<CGI::Push>, L<CGI::Fast>,
+L<CGI::Pretty>
=cut
diff --git a/gnu/usr.bin/perl/lib/CGI/Apache.pm b/gnu/usr.bin/perl/lib/CGI/Apache.pm
index 6ea7523c571..d155f69439c 100644
--- a/gnu/usr.bin/perl/lib/CGI/Apache.pm
+++ b/gnu/usr.bin/perl/lib/CGI/Apache.pm
@@ -4,7 +4,7 @@ use vars qw(@ISA $VERSION);
require CGI;
@ISA = qw(CGI);
-$VERSION = (qw$Revision: 1.1 $)[1];
+$VERSION = (qw$Revision: 1.2 $)[1];
$CGI::DefaultClass = 'CGI::Apache';
$CGI::Apache::AutoloadClass = 'CGI';
@@ -78,7 +78,7 @@ CGI::Apache - Make things work with CGI.pm against Perl-Apache API
=head1 DESCRIPTION
When using the Perl-Apache API, your applications are faster, but the
-enviroment is different than CGI.
+environment is different than CGI.
This module attempts to set-up that environment as best it can.
=head1 NOTE 1
@@ -98,6 +98,6 @@ perl(1), Apache(3), CGI(3)
=head1 AUTHOR
-Doug MacEachern E<lt>dougm@osf.orgE<gt>, hacked over by Andreas König E<lt>a.koenig@mind.deE<gt>, modified by Lincoln Stein <lt>lstein@genome.wi.mit.edu<gt>
+Doug MacEachern E<lt>dougm@osf.orgE<gt>, hacked over by Andreas KE<ouml>nig E<lt>a.koenig@mind.deE<gt>, modified by Lincoln Stein <lt>lstein@genome.wi.mit.edu<gt>
=cut
diff --git a/gnu/usr.bin/perl/lib/CGI/Carp.pm b/gnu/usr.bin/perl/lib/CGI/Carp.pm
index 4cd79467fd8..dfae1a61b73 100644
--- a/gnu/usr.bin/perl/lib/CGI/Carp.pm
+++ b/gnu/usr.bin/perl/lib/CGI/Carp.pm
@@ -14,6 +14,12 @@ B<CGI::Carp> - CGI routines for writing to the HTTPD (or other) error log
warn "I'm confused";
die "I'm dying.\n";
+ use CGI::Carp qw(cluck);
+ cluck "I wouldn't do that if I were you";
+
+ use CGI::Carp qw(fatalsToBrowser);
+ die "Fatal error messages are now sent to browser";
+
=head1 DESCRIPTION
CGI scripts have a nasty habit of leaving warning messages in the error
@@ -87,6 +93,8 @@ accepted as well:
... and so on
+FileHandle and other objects work as well.
+
Use of carpout() is not great for performance, so it is recommended
for debugging purposes or for moderate-use applications. A future
version of this module may delay redirecting STDERR until one of the
@@ -106,6 +114,34 @@ occur in the early compile phase will be seen.
Nonfatal errors will still be directed to the log file only (unless redirected
with carpout).
+=head2 Changing the default message
+
+By default, the software error message is followed by a note to
+contact the Webmaster by e-mail with the time and date of the error.
+If this message is not to your liking, you can change it using the
+set_message() routine. This is not imported by default; you should
+import it on the use() line:
+
+ use CGI::Carp qw(fatalsToBrowser set_message);
+ set_message("It's not a bug, it's a feature!");
+
+You may also pass in a code reference in order to create a custom
+error message. At run time, your code will be called with the text
+of the error message that caused the script to die. Example:
+
+ use CGI::Carp qw(fatalsToBrowser set_message);
+ BEGIN {
+ sub handle_errors {
+ my $msg = shift;
+ print "<h1>Oh gosh</h1>";
+ print "Got an error: $msg";
+ }
+ set_message(\&handle_errors);
+ }
+
+In order to correctly intercept compile-time errors, you should call
+set_message() from within a BEGIN{} block.
+
=head1 CHANGE LOG
1.05 carpout() added and minor corrections by Marc Hedlund
@@ -114,11 +150,32 @@ with carpout).
1.06 fatalsToBrowser() no longer aborts for fatal errors within
eval() statements.
+1.08 set_message() added and carpout() expanded to allow for FileHandle
+ objects.
+
+1.09 set_message() now allows users to pass a code REFERENCE for
+ really custom error messages. croak and carp are now
+ exported by default. Thanks to Gunther Birznieks for the
+ patches.
+
+1.10 Patch from Chris Dean (ctdean@cogit.com) to allow
+ module to run correctly under mod_perl.
+
+1.11 Changed order of &gt; and &lt; escapes.
+
+1.12 Changed die() on line 217 to CORE::die to avoid B<-w> warning.
+
+1.13 Added cluck() to make the module orthogonal with Carp.
+ More mod_perl related fixes.
+
=head1 AUTHORS
-Lincoln D. Stein <lstein@genome.wi.mit.edu>. Feel free to redistribute
-this under the Perl Artistic License.
+Copyright 1995-1998, Lincoln D. Stein. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+Address bug reports and comments to: lstein@cshl.org
=head1 SEE ALSO
@@ -133,18 +190,19 @@ use Carp;
@ISA = qw(Exporter);
@EXPORT = qw(confess croak carp);
-@EXPORT_OK = qw(carpout fatalsToBrowser);
+@EXPORT_OK = qw(carpout fatalsToBrowser wrap set_message cluck);
$main::SIG{__WARN__}=\&CGI::Carp::warn;
$main::SIG{__DIE__}=\&CGI::Carp::die;
-$CGI::Carp::VERSION = '1.06';
+$CGI::Carp::VERSION = '1.13';
+$CGI::Carp::CUSTOM_MSG = undef;
# fancy import routine detects and handles 'errorWrap' specially.
sub import {
my $pkg = shift;
my(%routines);
- grep($routines{$_}++,@_);
- $WRAP++ if $routines{'fatalsToBrowser'};
+ grep($routines{$_}++,@_,@EXPORT);
+ $WRAP++ if $routines{'fatalsToBrowser'} || $routines{'wrap'};
my($oldlevel) = $Exporter::ExportLevel;
$Exporter::ExportLevel = 1;
Exporter::import($pkg,keys %routines);
@@ -152,8 +210,8 @@ sub import {
}
# These are the originals
-sub realwarn { warn(@_); }
-sub realdie { die(@_); }
+sub realwarn { CORE::warn(@_); }
+sub realdie { CORE::die(@_); }
sub id {
my $level = shift;
@@ -183,26 +241,40 @@ sub warn {
realwarn $message;
}
+# The mod_perl package Apache::Registry loads CGI programs by calling
+# eval. These evals don't count when looking at the stack backtrace.
+sub _longmess {
+ my $message = Carp::longmess();
+ my $mod_perl = exists $ENV{MOD_PERL};
+ $message =~ s,eval[^\n]+Apache/Registry\.pm.*,,s if $mod_perl;
+ return( $message );
+}
+
sub die {
my $message = shift;
my $time = scalar(localtime);
my($file,$line,$id) = id(1);
- return undef if $file=~/^\(eval/;
- $message .= " at $file line $line.\n" unless $message=~/\n$/;
- &fatalsToBrowser($message) if $WRAP;
+ $message .= " at $file line $line." unless $message=~/\n$/;
+ &fatalsToBrowser($message) if $WRAP && _longmess() !~ /eval [{\']/m;
my $stamp = stamp;
$message=~s/^/$stamp/gm;
realdie $message;
}
+sub set_message {
+ $CGI::Carp::CUSTOM_MSG = shift;
+ return $CGI::Carp::CUSTOM_MSG;
+}
+
# Avoid generating "subroutine redefined" warnings with the following
# hack:
{
local $^W=0;
eval <<EOF;
sub confess { CGI::Carp::die Carp::longmess \@_; }
-sub croak { CGI::Carp::die Carp::shortmess \@_; }
-sub carp { CGI::Carp::warn Carp::shortmess \@_; }
+sub croak { CGI::Carp::die Carp::shortmess \@_; }
+sub carp { CGI::Carp::warn Carp::shortmess \@_; }
+sub cluck { CGI::Carp::warn Carp::longmess \@_; }
EOF
;
}
@@ -211,14 +283,8 @@ EOF
# or a string.
sub carpout {
my($in) = @_;
- $in = $$in if ref($in); # compatability with Marc's method;
- my($no) = fileno($in);
- unless (defined($no)) {
- my($package) = caller;
- my($handle) = $in=~/[':]/ ? $in : "$package\:\:$in";
- $no = fileno($handle);
- }
- die "Invalid filehandle $in\n" unless $no;
+ my($no) = fileno(to_filehandle($in));
+ realdie("Invalid filehandle $in\n") unless defined $no;
open(SAVEERR, ">&STDERR");
open(STDERR, ">&$no") or
@@ -228,15 +294,72 @@ sub carpout {
# headers
sub fatalsToBrowser {
my($msg) = @_;
+ $msg=~s/&/&amp;/g;
$msg=~s/>/&gt;/g;
$msg=~s/</&lt;/g;
- print STDOUT "Content-type: text/html\n\n";
- print STDOUT <<END;
+ $msg=~s/\"/&quot;/g;
+ my($wm) = $ENV{SERVER_ADMIN} ?
+ qq[the webmaster (<a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a>)] :
+ "this site's webmaster";
+ my ($outer_message) = <<END;
+For help, please send mail to $wm, giving this error message
+and the time and date of the error.
+END
+ ;
+ my $mod_perl = exists $ENV{MOD_PERL};
+ print STDOUT "Content-type: text/html\n\n"
+ unless $mod_perl;
+
+ if ($CUSTOM_MSG) {
+ if (ref($CUSTOM_MSG) eq 'CODE') {
+ &$CUSTOM_MSG($msg); # nicer to perl 5.003 users
+ return;
+ } else {
+ $outer_message = $CUSTOM_MSG;
+ }
+ }
+
+ my $mess = <<END;
<H1>Software error:</H1>
<CODE>$msg</CODE>
<P>
-Please send mail to this site's webmaster for help.
+$outer_message
END
+ ;
+
+ if ($mod_perl) {
+ my $r = Apache->request;
+ # If bytes have already been sent, then
+ # we print the message out directly.
+ # Otherwise we make a custom error
+ # handler to produce the doc for us.
+ if ($r->bytes_sent) {
+ $r->print($mess);
+ $r->exit;
+ } else {
+ $r->status(500);
+ $r->custom_response(500,$mess);
+ }
+ } else {
+ print STDOUT $mess;
+ }
+}
+
+# Cut and paste from CGI.pm so that we don't have the overhead of
+# always loading the entire CGI module.
+sub to_filehandle {
+ my $thingy = shift;
+ return undef unless $thingy;
+ return $thingy if UNIVERSAL::isa($thingy,'GLOB');
+ return $thingy if UNIVERSAL::isa($thingy,'FileHandle');
+ if (!ref($thingy)) {
+ my $caller = 1;
+ while (my $package = caller($caller++)) {
+ my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy";
+ return $tmp if defined(fileno($tmp));
+ }
+ }
+ return undef;
}
1;
diff --git a/gnu/usr.bin/perl/lib/CGI/Fast.pm b/gnu/usr.bin/perl/lib/CGI/Fast.pm
index 03b54072c96..a39fe052e86 100644
--- a/gnu/usr.bin/perl/lib/CGI/Fast.pm
+++ b/gnu/usr.bin/perl/lib/CGI/Fast.pm
@@ -16,7 +16,7 @@ package CGI::Fast;
# The most recent version and complete docs are available at:
# http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
# ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
-$CGI::Fast::VERSION='1.00a';
+$CGI::Fast::VERSION='1.01';
use CGI;
use FCGI;
@@ -34,9 +34,11 @@ sub save_request {
# New is slightly different in that it calls FCGI's
# accept() method.
sub new {
- return undef unless FCGI::accept() >= 0;
- my($self,@param) = @_;
- return $CGI::Q = $self->SUPER::new(@param);
+ my ($self, $initializer, @param) = @_;
+ unless (defined $initializer) {
+ return undef unless FCGI::accept() >= 0;
+ }
+ return $CGI::Q = $self->SUPER::new($initializer, @param);
}
1;
@@ -154,13 +156,12 @@ I haven't tested this very much.
=head1 AUTHOR INFORMATION
-be used and modified freely, but I do request that this copyright
-notice remain attached to the file. You may modify this module as you
-wish, but if you redistribute a modified version, please attach a note
-listing the modifications you have made.
+Copyright 1996-1998, Lincoln D. Stein. All rights reserved.
-Address bug reports and comments to:
-lstein@genome.wi.mit.edu
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+Address bug reports and comments to: lstein@cshl.org
=head1 BUGS
diff --git a/gnu/usr.bin/perl/lib/CGI/Push.pm b/gnu/usr.bin/perl/lib/CGI/Push.pm
index 4390d0383e6..e4a66aee72d 100644
--- a/gnu/usr.bin/perl/lib/CGI/Push.pm
+++ b/gnu/usr.bin/perl/lib/CGI/Push.pm
@@ -14,23 +14,25 @@ package CGI::Push;
# listing the modifications you have made.
# The most recent version and complete docs are available at:
-# http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
-# ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
+# http://stein.cshl.org/WWW/software/CGI/
-$CGI::Push::VERSION='1.00';
+$CGI::Push::VERSION='1.01';
use CGI;
@ISA = ('CGI');
-# add do_push() to exported tags
-push(@{$CGI::EXPORT_TAGS{':standard'}},'do_push');
+$CGI::DefaultClass = 'CGI::Push';
+$CGI::Push::AutoloadClass = 'CGI';
+
+# add do_push() and push_delay() to exported tags
+push(@{$CGI::EXPORT_TAGS{':standard'}},'do_push','push_delay');
sub do_push {
- my ($self,@p) = CGI::self_or_CGI(@_);
+ my ($self,@p) = CGI::self_or_default(@_);
# unbuffer output
$| = 1;
srand;
- my ($random) = rand()*1E16;
+ my ($random) = sprintf("%16.0f",rand()*1E16);
my ($boundary) = "----------------------------------$random";
my (@header);
@@ -39,6 +41,7 @@ sub do_push {
$type = 'text/html' unless $type;
$callback = \&simple_counter unless $callback && ref($callback) eq 'CODE';
$delay = 1 unless defined($delay);
+ $self->push_delay($delay);
my(@o);
foreach (@other) { push(@o,split("=")); }
@@ -55,15 +58,18 @@ sub do_push {
my @contents;
while (1) {
last unless (@contents = &$callback($self,++$COUNTER)) && defined($contents[0]);
- print "Content-type: ${type}$CGI::CRLF$CGI::CRLF";
+ print "Content-type: ${type}$CGI::CRLF$CGI::CRLF"
+ unless $type eq 'dynamic';
print @contents,"$CGI::CRLF";
print "${boundary}$CGI::CRLF";
- do_sleep($delay) if $delay;
+ do_sleep($self->push_delay()) if $self->push_delay();
+ }
+
+ # Optional last page
+ if ($last_page && ref($last_page) eq 'CODE') {
+ print "Content-type: ${type}$CGI::CRLF$CGI::CRLF" unless $type =~ /^dynamic|heterogeneous$/i;
+ print &$last_page($self,$COUNTER),"$CGI::CRLF${boundary}$CGI::CRLF";
}
- print "Content-type: ${type}$CGI::CRLF$CGI::CRLF",
- &$last_page($self,++$COUNTER),
- "$CGI::CRLF${boundary}$CGI::CRLF"
- if $last_page && ref($last_page) eq 'CODE';
}
sub simple_counter {
@@ -87,6 +93,12 @@ sub do_sleep {
}
}
+sub push_delay {
+ my ($self,$delay) = CGI::self_or_default(@_);
+ return defined($delay) ? $self->{'.delay'} =
+ $delay : $self->{'.delay'};
+}
+
1;
=head1 NAME
@@ -176,6 +188,9 @@ redrawing loop and print out the final page (if any)
"This page called $counter times";
}
+You are of course free to refer to create and use global variables
+within your draw routine in order to achieve special effects.
+
=item -last_page
This optional parameter points to a reference to the subroutine
@@ -187,8 +202,12 @@ itself should have exactly the same calling conventions as the
=item -type
This optional parameter indicates the content type of each page. It
-defaults to "text/html". Currently, server push of heterogeneous
-document types is not supported.
+defaults to "text/html". Normally the module assumes that each page
+is of a homogenous MIME type. However if you provide either of the
+magic values "heterogeneous" or "dynamic" (the latter provided for the
+convenience of those who hate long parameter names), you can specify
+the MIME type -- and other header fields -- on a per-page basis. See
+"heterogeneous pages" for more details.
=item -delay
@@ -204,6 +223,60 @@ CGI::header().
=back
+=head2 Heterogeneous Pages
+
+Ordinarily all pages displayed by CGI::Push share a common MIME type.
+However by providing a value of "heterogeneous" or "dynamic" in the
+do_push() -type parameter, you can specify the MIME type of each page
+on a case-by-case basis.
+
+If you use this option, you will be responsible for producing the
+HTTP header for each page. Simply modify your draw routine to
+look like this:
+
+ sub my_draw_routine {
+ my($q,$counter) = @_;
+ return header('text/html'), # note we're producing the header here
+ start_html('testing'),
+ h1('testing'),
+ "This page called $counter times";
+ }
+
+You can add any header fields that you like, but some (cookies and
+status fields included) may not be interpreted by the browser. One
+interesting effect is to display a series of pages, then, after the
+last page, to redirect the browser to a new URL. Because redirect()
+does b<not> work, the easiest way is with a -refresh header field,
+as shown below:
+
+ sub my_draw_routine {
+ my($q,$counter) = @_;
+ return undef if $counter > 10;
+ return header('text/html'), # note we're producing the header here
+ start_html('testing'),
+ h1('testing'),
+ "This page called $counter times";
+ }
+
+ sub my_last_page {
+ header(-refresh=>'5; URL=http://somewhere.else/finished.html',
+ -type=>'text/html'),
+ start_html('Moved'),
+ h1('This is the last page'),
+ 'Goodbye!'
+ hr,
+ end_html;
+ }
+
+=head2 Changing the Page Delay on the Fly
+
+If you would like to control the delay between pages on a page-by-page
+basis, call push_delay() from within your draw routine. push_delay()
+takes a single numeric argument representing the number of seconds you
+wish to delay after the current page is displayed and before
+displaying the next one. The delay may be fractional. Without
+parameters, push_delay() just returns the current delay.
+
=head1 INSTALLING CGI::Push SCRIPTS
Server push scripts B<must> be installed as no-parsed-header (NPH)
@@ -213,19 +286,14 @@ Recognition of NPH scripts happens automatically with WebSTAR and
Microsoft IIS. Users of other servers should see their documentation
for help.
-=head1 CAVEATS
-
-This is a new module. It hasn't been extensively tested.
-
=head1 AUTHOR INFORMATION
-be used and modified freely, but I do request that this copyright
-notice remain attached to the file. You may modify this module as you
-wish, but if you redistribute a modified version, please attach a note
-listing the modifications you have made.
+Copyright 1995-1998, Lincoln D. Stein. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
-Address bug reports and comments to:
-lstein@genome.wi.mit.edu
+Address bug reports and comments to: lstein@cshl.org
=head1 BUGS
diff --git a/gnu/usr.bin/perl/lib/CGI/Switch.pm b/gnu/usr.bin/perl/lib/CGI/Switch.pm
index 420fff7643c..8afc6a6cb34 100644
--- a/gnu/usr.bin/perl/lib/CGI/Switch.pm
+++ b/gnu/usr.bin/perl/lib/CGI/Switch.pm
@@ -2,7 +2,7 @@ package CGI::Switch;
use Carp;
use strict;
use vars qw($VERSION @Pref);
-$VERSION = '0.05';
+$VERSION = '0.06';
@Pref = qw(CGI::Apache CGI); #default
sub import {
@@ -33,13 +33,6 @@ sub new {
Carp::croak "Couldn't load+construct any of @Pref\n";
}
-# there's a trick in Lincoln's package that determines the calling
-# package. The reason is to have a filehandle with the same name as
-# the filename. To tell this trick that we are not the calling
-# package we have to follow this dirty convention. It's a questionable
-# trick imho, but for now I want to have something working
-sub isaCGI { 1 }
-
1;
__END__
@@ -73,6 +66,6 @@ perl(1), Apache(3), CGI(3), CGI::XA(3)
=head1 AUTHOR
-Andreas König E<lt>a.koenig@mind.deE<gt>
+Andreas KE<ouml>nig E<lt>a.koenig@mind.deE<gt>
=cut
diff --git a/gnu/usr.bin/perl/lib/CPAN.pm b/gnu/usr.bin/perl/lib/CPAN.pm
index 2b0f6cce5dd..5e2126912b2 100644
--- a/gnu/usr.bin/perl/lib/CPAN.pm
+++ b/gnu/usr.bin/perl/lib/CPAN.pm
@@ -1,24 +1,25 @@
package CPAN;
-use vars qw{$Try_autoload $Revision
+use vars qw{$Try_autoload
+ $Revision
$META $Signal $Cwd $End
$Suppress_readline %Dontload
- $Frontend
- };
+ $Frontend $Defaultsite
+ }; #};
-$VERSION = '1.3102';
+$VERSION = '1.48';
-# $Id: CPAN.pm,v 1.1 1997/11/30 07:56:39 millert Exp $
+# $Id: CPAN.pm,v 1.2 1999/04/29 22:51:43 millert Exp $
# only used during development:
$Revision = "";
-# $Revision = "[".substr(q$Revision: 1.1 $, 10)."]";
+# $Revision = "[".substr(q$Revision: 1.2 $, 10)."]";
use Carp ();
use Config ();
use Cwd ();
use DirHandle;
use Exporter ();
-use ExtUtils::MakeMaker ();
+use ExtUtils::MakeMaker (); # $SelfLoader::DEBUG=1;
use File::Basename ();
use File::Copy ();
use File::Find;
@@ -27,10 +28,11 @@ use FileHandle ();
use Safe ();
use Text::ParseWords ();
use Text::Wrap;
+use File::Spec;
END { $End++; &cleanup; }
-%CPAN::DEBUG = qw(
+%CPAN::DEBUG = qw[
CPAN 1
Index 2
InfoObj 4
@@ -44,23 +46,19 @@ END { $End++; &cleanup; }
Shell 1024
Eval 2048
Config 4096
- );
+ Tarzip 8192
+];
$CPAN::DEBUG ||= 0;
$CPAN::Signal ||= 0;
$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);
-@CPAN::ISA = qw(CPAN::Debug Exporter MM); # MM will go away
- # soonish. Already version
- # 1.29 doesn't rely on
- # catfile and catdir being
- # available via
- # inheritance. Anything else
- # in danger?
+@CPAN::ISA = qw(CPAN::Debug Exporter);
@EXPORT = qw(
autobundle bundle expand force get
@@ -73,6 +71,7 @@ sub AUTOLOAD {
$l =~ s/.*:://;
my(%EXPORT);
@EXPORT{@EXPORT} = '';
+ CPAN::Config->load unless $CPAN::Config_loaded++;
if (exists $EXPORT{$l}){
CPAN::Shell->$l(@_);
} else {
@@ -90,7 +89,9 @@ sub AUTOLOAD {
#-> sub CPAN::shell ;
sub shell {
+ my($self) = @_;
$Suppress_readline ||= ! -t STDIN;
+ CPAN::Config->load unless $CPAN::Config_loaded++;
my $prompt = "cpan> ";
local($^W) = 1;
@@ -98,8 +99,20 @@ sub shell {
require Term::ReadLine;
# import Term::ReadLine;
$term = Term::ReadLine->new('CPAN Monitor');
- $readline::rl_completion_function =
- $readline::rl_completion_function = 'CPAN::Complete::cpl';
+ 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';
+ }
}
no strict;
@@ -107,6 +120,7 @@ sub shell {
my $getcwd;
$getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
my $cwd = CPAN->$getcwd();
+ my $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub";
my $rl_avail = $Suppress_readline ? "suppressed" :
($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
"available (try ``install Bundle::CPAN'')";
@@ -129,8 +143,8 @@ ReadLine support $rl_avail
$_ = "$continuation$_" if $continuation;
s/^\s+//;
next if /^$/;
- $_ = 'h' if $_ eq '?';
- if (/^q(?:uit)?$/i) {
+ $_ = 'h' if /^\s*\?/;
+ if (/^(?:q(?:uit)?|bye|exit)$/i) {
last;
} elsif (s/\\$//s) {
chomp;
@@ -165,12 +179,25 @@ ReadLine support $rl_avail
$prompt = "cpan> ";
}
} continue {
- &cleanup, $CPAN::Frontend->mydie("Goodbye\n") if $Signal;
+ $Signal=0;
+ CPAN::Queue->nullify_queue;
+ if ($try_detect_readline) {
+ if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
+ ||
+ $CPAN::META->has_inst("Term::ReadLine::Perl")
+ ) {
+ delete $INC{"Term/ReadLine.pm"};
+ my $redef;
+ local($SIG{__WARN__}) = CPAN::Shell::dotdot_onreload(\$redef);
+ require Term::ReadLine;
+ $CPAN::Frontend->myprint("\n$redef subroutines in Term::ReadLine redefined\n");
+ goto &shell;
+ }
+ }
}
}
package CPAN::CacheMgr;
-use vars qw($Du);
@CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
use File::Find;
@@ -220,6 +247,7 @@ use vars qw($AUTOLOAD $redef @ISA);
sub AUTOLOAD {
my($autoload) = $AUTOLOAD;
my $class = shift(@_);
+ # warn "autoload[$autoload] class[$class]";
$autoload =~ s/.*:://;
if ($autoload =~ /^w/) {
if ($CPAN::META->has_inst('CPAN::WAIT')) {
@@ -228,7 +256,7 @@ sub AUTOLOAD {
$CPAN::Frontend->mywarn(qq{
Commands starting with "w" require CPAN::WAIT to be installed.
Please consider installing CPAN::WAIT to use the fulltext index.
-For this you just need to type
+For this you just need to type
install CPAN::WAIT
});
}
@@ -258,7 +286,7 @@ sub try_dot_al {
if (defined($name=$INC{"$pkg.pm"}))
{
$name =~ s|^(.*)$pkg\.pm$|$1auto/$pkg/$func.al|;
- $name = undef unless (-r $name);
+ $name = undef unless (-r $name);
}
unless (defined $name)
{
@@ -273,7 +301,7 @@ sub try_dot_al {
*$autoload = sub {};
$ok = 1;
} else {
- if ($name =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){
+ if ($name =~ s{(\w{12,})\.al$}{substr($1,0,11).".al"}e){
eval {local $SIG{__DIE__};require $name};
}
if ($@){
@@ -284,7 +312,9 @@ sub try_dot_al {
}
}
} else {
- $ok = 1;
+
+ $ok = 1;
+
}
$@ = $save;
# my $lm = Carp::longmess();
@@ -301,7 +331,7 @@ sub try_dot_al {
# $Try_autoload = 1;
if ($CPAN::Try_autoload) {
- my $p;
+ my $p;
for $p (qw(
CPAN::Author CPAN::Bundle CPAN::CacheMgr CPAN::Complete
CPAN::Config CPAN::Debug CPAN::Distribution CPAN::FTP
@@ -311,14 +341,132 @@ if ($CPAN::Try_autoload) {
}
}
+package CPAN::Tarzip;
+use vars qw($AUTOLOAD @ISA);
+@CPAN::Tarzip::ISA = qw(CPAN::Debug);
+
+package CPAN::Queue;
+
+# One use of the queue is to determine if we should or shouldn't
+# announce the availability of a new CPAN module
+
+# Now we try to use it for dependency tracking. For that to happen
+# we need to draw a dependency tree and do the leaves first. This can
+# easily be reached by running CPAN.pm recursively, but we don't want
+# to waste memory and run into deep recursion. So what we can do is
+# this:
+
+# CPAN::Queue is the package where the queue is maintained. Dependencies
+# often have high priority and must be brought to the head of the queue,
+# possibly by jumping the queue if they are already there. My first code
+# attempt tried to be extremely correct. Whenever a module needed
+# immediate treatment, I either unshifted it to the front of the queue,
+# or, if it was already in the queue, I spliced and let it bypass the
+# others. This became a too correct model that made it impossible to put
+# an item more than once into the queue. Why would you need that? Well,
+# you need temporary duplicates as the manager of the queue is a loop
+# that
+#
+# (1) looks at the first item in the queue without shifting it off
+#
+# (2) cares for the item
+#
+# (3) removes the item from the queue, *even if its agenda failed and
+# even if the item isn't the first in the queue anymore* (that way
+# protecting against never ending queues)
+#
+# So if an item has prerequisites, the installation fails now, but we
+# want to retry later. That's easy if we have it twice in the queue.
+#
+# I also expect insane dependency situations where an item gets more
+# than two lives in the queue. Simplest example is triggered by 'install
+# Foo Foo Foo'. People make this kind of mistakes and I don't want to
+# get in the way. I wanted the queue manager to be a dumb servant, not
+# one that knows everything.
+#
+# Who would I tell in this model that the user wants to be asked before
+# processing? I can't attach that information to the module object,
+# because not modules are installed but distributions. So I'd have to
+# tell the distribution object that it should ask the user before
+# processing. Where would the question be triggered then? Most probably
+# in CPAN::Distribution::rematein.
+# Hope that makes sense, my head is a bit off:-) -- AK
+
+use vars qw{ @All };
-package CPAN;
+sub new {
+ my($class,$mod) = @_;
+ my $self = bless {mod => $mod}, $class;
+ push @All, $self;
+ # my @all = map { $_->{mod} } @All;
+ # warn "Adding Queue object for mod[$mod] all[@all]";
+ return $self;
+}
-$META ||= CPAN->new; # In case we reeval ourselves we
- # need a ||
+sub first {
+ my $obj = $All[0];
+ $obj->{mod};
+}
+
+sub delete_first {
+ my($class,$what) = @_;
+ my $i;
+ for my $i (0..$#All) {
+ if ( $All[$i]->{mod} eq $what ) {
+ splice @All, $i, 1;
+ return;
+ }
+ }
+}
+
+sub jumpqueue {
+ my $class = shift;
+ my @what = @_;
+ my $obj;
+ 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(
+qq{Object [$what] queued more than 100 times, ignoring}
+ );
+ next WHAT;
+ }
+ }
+ }
+ my $obj = bless { mod => $what }, $class;
+ unshift @All, $obj;
+ }
+}
-# Do this after you have set up the whole inheritance
-CPAN::Config->load unless defined $CPAN::No_Config_is_ok;
+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]";
+ $exists;
+}
+
+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]";
+}
+
+sub nullify_queue {
+ @All = ();
+}
+
+
+
+package CPAN;
+
+$META ||= CPAN->new; # In case we re-eval ourselves we need the ||
1;
@@ -342,12 +490,14 @@ sub clean;
sub test;
#-> sub CPAN::all ;
-sub all {
+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} };
}
+*all = \&all_objects;
# Called by shell, not in batch mode. Not clean XXX
#-> sub CPAN::checklock ;
@@ -420,13 +570,15 @@ or
$self->{LOCK} = $lockfile;
$fh->close;
$SIG{'TERM'} = sub {
- &cleanup;
- $CPAN::Frontend->mydie("Got SIGTERM, leaving");
+ &cleanup;
+ $CPAN::Frontend->mydie("Got SIGTERM, leaving");
};
$SIG{'INT'} = sub {
- my $s = $Signal == 2 ? "a second" : "another";
- &cleanup, $CPAN::Frontend->mydie("Got $s SIGINT") if $Signal;
- $Signal = 1;
+ # no blocks!!!
+ &cleanup if $Signal;
+ $CPAN::Frontend->mydie("Got another SIGINT") if $Signal;
+ print "Caught SIGINT\n";
+ $Signal++;
};
$SIG{'__DIE__'} = \&cleanup;
$self->debug("Signal handler set.") if $CPAN::DEBUG;
@@ -452,6 +604,12 @@ sub exists {
exists $META->{$class}{$id};
}
+#-> sub CPAN::delete ;
+sub delete {
+ my($mgr,$class,$id) = @_;
+ delete $META->{$class}{$id};
+}
+
#-> sub CPAN::has_inst
sub has_inst {
my($self,$mod,$message) = @_;
@@ -469,13 +627,18 @@ sub has_inst {
$file =~ s|/|\\|g if $^O eq 'MSWin32';
$file .= ".pm";
if ($INC{$file}) {
-# warn "$file in %INC"; #debug
+ # checking %INC is wrong, because $INC{LWP} may be true
+ # although $INC{"URI/URL.pm"} may have failed. But as
+ # I really want to say "bla loaded OK", I have to somehow
+ # cache results.
+ ### warn "$file in %INC"; #debug
return 1;
} elsif (eval { require $file }) {
# eval is good: if we haven't yet read the database it's
# perfect and if we have installed the module in the meantime,
# it tries again. The second require is only a NOOP returning
# 1 if we had success, otherwise it's retrying
+
$CPAN::Frontend->myprint("CPAN: $mod loaded ok\n");
if ($mod eq "CPAN::WAIT") {
push @CPAN::Shell::ISA, CPAN::WAIT;
@@ -496,6 +659,8 @@ sub has_inst {
});
sleep 2;
+ } else {
+ delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
}
return 0;
}
@@ -515,16 +680,30 @@ sub new {
#-> sub CPAN::cleanup ;
sub cleanup {
- local $SIG{__DIE__} = '';
- my $i = 0; my $ineval = 0; my $sub;
- while ((undef,undef,undef,$sub) = caller(++$i)) {
- $ineval = 1, last if $sub eq '(eval)';
+ # warn "cleanup called with arg[@_] End[$End] Signal[$Signal]";
+ local $SIG{__DIE__} = '';
+ my($message) = @_;
+ my $i = 0;
+ my $ineval = 0;
+ if (
+ 0 && # disabled, try reload cpan with it
+ $] > 5.004_60 # thereabouts
+ ) {
+ $ineval = $^S;
+ } else {
+ my($subroutine);
+ while ((undef,undef,undef,$subroutine) = caller(++$i)) {
+ $ineval = 1, last if
+ $subroutine eq '(eval)';
}
- return if $ineval && !$End;
- return unless defined $META->{'LOCK'};
- return unless -f $META->{'LOCK'};
- unlink $META->{'LOCK'};
- $CPAN::Frontend->mywarn("Lockfile removed.\n");
+ }
+ return if $ineval && !$End;
+ return unless defined $META->{'LOCK'};
+ return unless -f $META->{'LOCK'};
+ unlink $META->{'LOCK'};
+ # require Carp;
+ # Carp::cluck("DEBUGGING");
+ $CPAN::Frontend->mywarn("Lockfile removed.\n");
}
package CPAN::CacheMgr;
@@ -544,25 +723,21 @@ sub cachesize {
shift->{DU};
}
-# sub check {
-# my($self,@dirs) = @_;
-# return unless -d $self->{ID};
-# my $dir;
-# @dirs = $self->dirs unless @dirs;
-# for $dir (@dirs) {
-# $self->disk_usage($dir);
-# }
-# }
-
-#-> sub CPAN::CacheMgr::clean_cache ;
-#=# sub clean_cache {
-#=# my $self = shift;
-#=# my $dir;
-#=# while ($self->{DU} > $self->{'MAX'} and $dir = shift @{$self->{FIFO}}) {
-#=# $self->force_clean_cache($dir);
-#=# }
-#=# $self->debug("leaving clean_cache with $self->{DU}") if $CPAN::DEBUG;
-#=# }
+sub tidyup {
+ my($self) = @_;
+ return unless -d $self->{ID};
+ while ($self->{DU} > $self->{'MAX'} ) {
+ my($toremove) = shift @{$self->{FIFO}};
+ $CPAN::Frontend->myprint(sprintf(
+ "Deleting from cache".
+ ": $toremove (%.1f>%.1f MB)\n",
+ $self->{DU}, $self->{'MAX'})
+ );
+ return if $CPAN::Signal;
+ $self->force_clean_cache($toremove);
+ return if $CPAN::Signal;
+ }
+}
#-> sub CPAN::CacheMgr::dir ;
sub dir {
@@ -579,7 +754,8 @@ sub entries {
$getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
my($cwd) = CPAN->$getcwd();
chdir $dir or Carp::croak("Can't chdir to $dir: $!");
- my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!");
+ my $dh = DirHandle->new(File::Spec->curdir)
+ or Carp::croak("Couldn't opendir $dir: $!");
my(@entries);
for ($dh->read) {
next if $_ eq "." || $_ eq "..";
@@ -598,39 +774,35 @@ sub entries {
#-> sub CPAN::CacheMgr::disk_usage ;
sub disk_usage {
my($self,$dir) = @_;
-# if (! defined $dir or $dir eq "") {
-# $self->debug("Cannot determine disk usage for some reason") if $CPAN::DEBUG;
-# return;
-# }
- return if $self->{SIZE}{$dir};
- local($Du) = 0;
+ return if exists $self->{SIZE}{$dir};
+ return if $CPAN::Signal;
+ my($Du) = 0;
find(
sub {
- return if -l $_;
- $Du += -s _;
+ $File::Find::prune++ if $CPAN::Signal;
+ return if -l $_;
+ if ($^O eq 'MacOS') {
+ require Mac::Files;
+ my $cat = Mac::Files::FSpGetCatInfo($_);
+ $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen();
+ } else {
+ $Du += (-s _);
+ }
},
$dir
);
+ return if $CPAN::Signal;
$self->{SIZE}{$dir} = $Du/1024/1024;
push @{$self->{FIFO}}, $dir;
$self->debug("measured $dir is $Du") if $CPAN::DEBUG;
$self->{DU} += $Du/1024/1024;
- if ($self->{DU} > $self->{'MAX'} ) {
- my($toremove) = shift @{$self->{FIFO}};
- $CPAN::Frontend->myprint(sprintf(
- "...Hold on a sec... ".
- "cleaning from cache ".
- "(%.1f>%.1f MB): $toremove\n",
- $self->{DU}, $self->{'MAX'})
- );
- $self->force_clean_cache($toremove);
- }
$self->{DU};
}
#-> sub CPAN::CacheMgr::force_clean_cache ;
sub force_clean_cache {
my($self,$dir) = @_;
+ return unless -e $dir;
$self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
if $CPAN::DEBUG;
File::Path::rmtree($dir);
@@ -647,17 +819,13 @@ sub new {
my $self = {
ID => $CPAN::Config->{'build_dir'},
MAX => $CPAN::Config->{'build_cache'},
+ SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
DU => 0
};
File::Path::mkpath($self->{ID});
my $dh = DirHandle->new($self->{ID});
bless $self, $class;
- $self->debug("dir [$self->{ID}]") if $CPAN::DEBUG;
- my $e;
- for $e ($self->entries) {
- next if $e eq ".." || $e eq ".";
- $self->disk_usage($e);
- }
+ $self->scan_cache;
$t2 = time;
$debug .= "timing of CacheMgr->new: ".($t2 - $time);
$time = $t2;
@@ -665,6 +833,24 @@ sub new {
$self;
}
+#-> sub CPAN::CacheMgr::scan_cache ;
+sub scan_cache {
+ my $self = shift;
+ return if $self->{SCAN} eq 'never';
+ $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
+ unless $self->{SCAN} eq 'atstart';
+ $CPAN::Frontend->myprint(
+ sprintf("Scanning cache %s for sizes\n",
+ $self->{ID}));
+ my $e;
+ for $e ($self->entries($self->{ID})) {
+ next if $e eq ".." || $e eq ".";
+ $self->disk_usage($e);
+ return if $CPAN::Signal;
+ }
+ $self->tidyup;
+}
+
package CPAN::Debug;
#-> sub CPAN::Debug::debug ;
@@ -743,7 +929,7 @@ sub commit {
unless (defined $configpm){
$configpm ||= $INC{"CPAN/MyConfig.pm"};
$configpm ||= $INC{"CPAN/Config.pm"};
- $configpm || Carp::confess(qq{
+ $configpm || Carp::confess(q{
CPAN::Config::commit called without an argument.
Please specify a filename where to save the configuration or try
"o conf init" to have an interactive course through configing.
@@ -759,7 +945,7 @@ Please specify a filename where to save the configuration or try
my $msg = <<EOF unless $configpm =~ /MyConfig/;
-# This is CPAN.pm's systemwide configuration file. This file provides
+# This is CPAN.pm's systemwide configuration file. This file provides
# defaults for users, and the values can be changed in a per-user
# configuration file. The user-config file is being looked for as
# ~/.cpan/CPAN/MyConfig.pm.
@@ -767,6 +953,7 @@ Please specify a filename where to save the configuration or try
EOF
$msg ||= "\n";
my($fh) = FileHandle->new;
+ rename $configpm, "$configpm~" if -f $configpm;
open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!";
$fh->print(qq[$msg\$CPAN::Config = \{\n]);
foreach (sort keys %$CPAN::Config) {
@@ -811,11 +998,15 @@ sub init {
sub load {
my($self) = shift;
my(@miss);
+ use Carp;
eval {require CPAN::Config;}; # We eval because of some
# MakeMaker problems
- unshift @INC, MM->catdir($ENV{HOME},".cpan") unless $dot_cpan++;
- eval {require CPAN::MyConfig;}; # where you can override
+ unless ($dot_cpan++){
+ unshift @INC, MM->catdir($ENV{HOME},".cpan");
+ eval {require CPAN::MyConfig;}; # where you can override
# system wide settings
+ shift @INC;
+ }
return unless @miss = $self->not_loaded;
# XXX better check for arrayrefs too
require CPAN::FirstTime;
@@ -872,11 +1063,11 @@ sub load {
}
}
local($") = ", ";
- $CPAN::Frontend->myprint(qq{
+ $CPAN::Frontend->myprint(<<END) if $redo && ! $theycalled;
We have to reconfigure CPAN.pm due to following uninitialized parameters:
@miss
-}) if $redo && ! $theycalled;
+END
$CPAN::Frontend->myprint(qq{
$configpm initialized.
});
@@ -888,9 +1079,10 @@ $configpm initialized.
sub not_loaded {
my(@miss);
for (qw(
- cpan_home keep_source_where build_dir build_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
+ 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
)) {
push @miss, $_ unless defined $CPAN::Config->{$_};
}
@@ -903,10 +1095,9 @@ sub unload {
delete $INC{'CPAN/Config.pm'};
}
-*h = \&help;
#-> sub CPAN::Config::help ;
sub help {
- $CPAN::Frontend->myprint(qq{
+ $CPAN::Frontend->myprint(q[
Known options:
defaults reload default config values from disk
commit commit session changes to disk
@@ -922,7 +1113,7 @@ You may edit key values in the follow fashion:
o conf urllist unshift ftp://ftp.foo.bar/
-});
+]);
undef; #don't reprint CPAN::Config
}
@@ -933,9 +1124,13 @@ sub cpl {
CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
my(@words) = split " ", substr($line,0,$pos+1);
if (
- $words[2] =~ /list$/ && @words == 3
- ||
- $words[2] =~ /list$/ && @words == 4 && length($word)
+ defined($words[2])
+ and
+ (
+ $words[2] =~ /list$/ && @words == 3
+ ||
+ $words[2] =~ /list$/ && @words == 4 && length($word)
+ )
) {
return grep /^\Q$word\E/, qw(splice shift unshift pop push);
} elsif (@words >= 4) {
@@ -980,6 +1175,8 @@ q quit the shell subroutine
}
}
+*help = \&h;
+
#-> sub CPAN::Shell::a ;
sub a { $CPAN::Frontend->myprint(shift->format_result('Author',@_));}
#-> sub CPAN::Shell::b ;
@@ -1003,7 +1200,9 @@ sub b {
#-> sub CPAN::Shell::d ;
sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
#-> sub CPAN::Shell::m ;
-sub m { $CPAN::Frontend->myprint(shift->format_result('Module',@_));}
+sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
+ $CPAN::Frontend->myprint(shift->format_result('Module',@_));
+}
#-> sub CPAN::Shell::i ;
sub i {
@@ -1032,7 +1231,14 @@ sub o {
shift @o_what if @o_what && $o_what[0] eq 'help';
if (!@o_what) {
my($k,$v);
- $CPAN::Frontend->myprint("CPAN::Config options:\n");
+ $CPAN::Frontend->myprint("CPAN::Config options");
+ if (exists $INC{'CPAN/Config.pm'}) {
+ $CPAN::Frontend->myprint(" from $INC{'CPAN/Config.pm'}");
+ }
+ if (exists $INC{'CPAN/MyConfig.pm'}) {
+ $CPAN::Frontend->myprint(" and $INC{'CPAN/MyConfig.pm'}");
+ }
+ $CPAN::Frontend->myprint(":\n");
for $k (sort keys %CPAN::Config::can) {
$v = $CPAN::Config::can{$k};
$CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, $v);
@@ -1111,6 +1317,21 @@ Known options:
}
}
+sub dotdot_onreload {
+ my($ref) = shift;
+ sub {
+ if ( $_[0] =~ /Subroutine (\w+) redefined/ ) {
+ my($subr) = $1;
+ ++$$ref;
+ local($|) = 1;
+ # $CPAN::Frontend->myprint(".($subr)");
+ $CPAN::Frontend->myprint(".");
+ return;
+ }
+ warn @_;
+ };
+}
+
#-> sub CPAN::Shell::reload ;
sub reload {
my($self,$command,@arg) = @_;
@@ -1120,27 +1341,16 @@ sub reload {
CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
my $fh = FileHandle->new($INC{'CPAN.pm'});
local($/);
- undef $/;
$redef = 0;
- local($SIG{__WARN__})
- = sub {
- if ( $_[0] =~ /Subroutine \w+ redefined/ ) {
- ++$redef;
- local($|) = 1;
- $CPAN::Frontend->myprint(".");
- return;
- }
- warn @_;
- };
+ local($SIG{__WARN__}) = dotdot_onreload(\$redef);
eval <$fh>;
warn $@ if $@;
$CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
} elsif ($command =~ /index/) {
- CPAN::Index->force_reload;
+ CPAN::Index->force_reload;
} else {
- $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN.pm file
-index re-reads the index files
-});
+ $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN.pm file
+index re-reads the index files\n});
}
}
@@ -1205,6 +1415,7 @@ sub _u_r_common {
my($latest) = $module->cpan_version;
my($inst_file) = $module->inst_file;
my($have);
+ return if $CPAN::Signal;
if ($inst_file){
if ($what eq "a") {
$have = $module->inst_version;
@@ -1294,6 +1505,7 @@ sub u {
#-> sub CPAN::Shell::autobundle ;
sub autobundle {
my($self) = shift;
+ CPAN::Config->load unless $CPAN::Config_loaded++;
my(@bundle) = $self->_u_r_common("a",@_);
my($todir) = MM->catdir($CPAN::Config->{'cpan_home'},"Bundle");
File::Path::mkpath($todir);
@@ -1350,7 +1562,7 @@ sub expand {
my $class = "CPAN::$type";
my $obj;
if (defined $regex) {
- for $obj ( sort {$a->id cmp $b->id} $CPAN::META->all($class)) {
+ for $obj ( sort {$a->id cmp $b->id} $CPAN::META->all_objects($class)) {
push @m, $obj
if
$obj->id =~ /$regex/i
@@ -1412,7 +1624,8 @@ sub print_ornamented {
*color = sub { return "" };
}
}
- for my $line (split /\n/, $what) {
+ my $line;
+ for $line (split /\n/, $what) {
$longest = length($line) if length($line) > $longest;
}
my $sprintf = "%-" . $longest . "s";
@@ -1458,6 +1671,7 @@ sub mydie {
}
#-> sub CPAN::Shell::rematein ;
+# RE-adme||MA-ke||TE-st||IN-stall
sub rematein {
shift;
my($meth,@some) = @_;
@@ -1469,6 +1683,9 @@ sub rematein {
CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
my($s,@s);
foreach $s (@some) {
+ CPAN::Queue->new($s);
+ }
+ while ($s = CPAN::Queue->first) {
my $obj;
if (ref $s) {
$obj = $s;
@@ -1482,7 +1699,7 @@ sub rematein {
}
if (ref $obj) {
CPAN->debug(
- qq{pragma[$pragma] meth[$meth] obj[$obj] as_string\[}.
+ qq{pragma[$pragma]meth[$meth]obj[$obj]as_string\[}.
$obj->as_string.
qq{\]}
) if $CPAN::DEBUG;
@@ -1490,8 +1707,16 @@ sub rematein {
if
$pragma
&&
- ($] < 5.00303 || $obj->can($pragma)); ### compatibility with 5.003
- $obj->$meth();
+ ($] < 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
} elsif ($CPAN::META->exists('CPAN::Author',$s)) {
$obj = $CPAN::META->instance('CPAN::Author',$s);
$CPAN::Frontend->myprint(
@@ -1501,7 +1726,9 @@ sub rematein {
" ;-)\n"
);
} else {
- $CPAN::Frontend->myprint(qq{Warning: Cannot $meth $s, don\'t know what it is.
+ $CPAN::Frontend
+ ->myprint(qq{Warning: Cannot $meth $s, }.
+ qq{don\'t know what it is.
Try the command
i /$s/
@@ -1509,6 +1736,7 @@ Try the command
to find objects with similar identifiers.
});
}
+ CPAN::Queue->delete_first($s);
}
}
@@ -1533,47 +1761,85 @@ package CPAN::FTP;
#-> sub CPAN::FTP::ftp_get ;
sub ftp_get {
- my($class,$host,$dir,$file,$target) = @_;
- $class->debug(
- qq[Going to fetch file [$file] from dir [$dir]
+ my($class,$host,$dir,$file,$target) = @_;
+ $class->debug(
+ qq[Going to fetch file [$file] from dir [$dir]
on host [$host] as local [$target]\n]
) if $CPAN::DEBUG;
- 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]);
- unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
- warn "Couldn't login on $host";
- return;
- }
- unless ( $ftp->cwd($dir) ){
- warn "Couldn't cwd $dir";
- return;
- }
- $ftp->binary;
- $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
- unless ( $ftp->get($file,$target) ){
- warn "Couldn't fetch $file from $host\n";
- return;
- }
- $ftp->quit; # it's ok if this fails
- return 1;
+ 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]);
+ unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
+ warn "Couldn't login on $host";
+ return;
+ }
+ unless ( $ftp->cwd($dir) ){
+ warn "Couldn't cwd $dir";
+ return;
+ }
+ $ftp->binary;
+ $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
+ unless ( $ftp->get($file,$target) ){
+ warn "Couldn't fetch $file from $host\n";
+ return;
+ }
+ $ftp->quit; # it's ok if this fails
+ return 1;
}
+# 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;
+
+
+# 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|://([^/]+)|;
- my $host = $1;
+ 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");};
- eval {$p = Net::Ping->new("tcp");} if $@;
+ return 1 if $p && ref($p) && $p->ping($host, 10);
+ eval {$p = Net::Ping->new("tcp");};
$CPAN::Frontend->mydie($@) if $@;
- return $p->ping($host, 3);
+ return $p->ping($host, 10);
}
#-> sub CPAN::FTP::localize ;
@@ -1587,6 +1853,20 @@ sub localize {
$self->debug("file[$file] aslocal[$aslocal] force[$force]")
if $CPAN::DEBUG;
+ if ($^O eq 'MacOS') {
+ my($name, $path) = File::Basename::fileparse($aslocal, '');
+ if (length($name) > 31) {
+ $name =~ s/(\.(readme(\.(gz|Z))?|(tar\.)?(gz|Z)|tgz|zip|pm\.(gz|Z)))$//;
+ my $suf = $1;
+ my $size = 31 - length($suf);
+ while (length($name) > $size) {
+ chop $name;
+ }
+ $name .= $suf;
+ $aslocal = File::Spec->catfile($path, $name);
+ }
+ }
+
return $aslocal if -f $aslocal && -r _ && !($force & 1);
my($restore) = 0;
if (-f $aslocal){
@@ -1602,7 +1882,7 @@ 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')) {
+ if ($CPAN::META->has_inst('LWP::UserAgent')) {
require LWP::UserAgent;
unless ($Ua) {
$Ua = LWP::UserAgent->new;
@@ -1619,7 +1899,7 @@ sub localize {
# Try the list of urls for each single object. We keep a record
# where we did get a file from
my(@reordered,$last);
-#line 1621
+ $CPAN::Config->{urllist} ||= [];
$last = $#{$CPAN::Config->{urllist}};
if ($force & 2) { # local cpans probably out of date, don't reorder
@reordered = (0..$last);
@@ -1627,7 +1907,7 @@ sub localize {
@reordered =
sort {
(substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
- <=>
+ <=>
(substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
or
defined($Thesite)
@@ -1636,11 +1916,6 @@ sub localize {
<=>
($a == $Thesite)
} 0..$last;
-
-# ((grep { substr($CPAN::Config->{urllist}[$_],0,4)
-# eq "file" } 0..$last),
-# (grep { substr($CPAN::Config->{urllist}[$_],0,4)
-# ne "file" } 0..$last));
}
my($level,@levels);
if ($Themethod) {
@@ -1648,15 +1923,19 @@ sub localize {
} else {
@levels = qw/easy hard hardest/;
}
+ @levels = qw/easy/ if $^O eq 'MacOS';
for $level (@levels) {
my $method = "host$level";
my @host_seq = $level eq "easy" ?
@reordered : 0..$last; # reordered has CDROM up front
+ @host_seq = (0) unless @host_seq;
my $ret = $self->$method(\@host_seq,$file,$aslocal);
if ($ret) {
- $Themethod = $level;
- $self->debug("level[$level]") if $CPAN::DEBUG;
- return $ret;
+ $Themethod = $level;
+ $self->debug("level[$level]") if $CPAN::DEBUG;
+ return $ret;
+ } else {
+ unlink $aslocal;
}
}
my(@mess);
@@ -1681,7 +1960,7 @@ sub hosteasy {
my($self,$host_seq,$file,$aslocal) = @_;
my($i);
HOSTEASY: for $i (@$host_seq) {
- my $url = $CPAN::Config->{urllist}[$i];
+ 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;
@@ -1702,8 +1981,11 @@ sub hosteasy {
# fileurl = "file://" [ host | "localhost" ] "/" fpath
# Thanks to "Mark D. Baushke" <mdb@cisco.com> for
# the code
- ($l = $url) =~ s,^file://[^/]+,,; # discard the host part
- $l =~ s/^file://; # assume they meant file://localhost
+ ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
+ $l =~ s|^file:||; # assume they
+ # meant
+ # file://localhost
+ $l =~ s|^/|| unless -f $l; # e.g. /P:
}
if ( -f $l && -r _) {
$Thesite = $i;
@@ -1712,37 +1994,47 @@ sub hosteasy {
# Maybe mirror has compressed it?
if (-f "$l.gz") {
$self->debug("found compressed $l.gz") if $CPAN::DEBUG;
- system("$CPAN::Config->{gzip} -dc $l.gz > $aslocal");
+ CPAN::Tarzip->gunzip("$l.gz", $aslocal);
if ( -f $aslocal) {
$Thesite = $i;
return $aslocal;
}
}
}
- if ($CPAN::META->has_inst('LWP')) {
- $CPAN::Frontend->myprint("Fetching with LWP:
+ if ($CPAN::META->has_inst('LWP')) {
+ $CPAN::Frontend->myprint("Fetching with LWP:
$url
");
- my $res = $Ua->mirror($url, $aslocal);
- if ($res->is_success) {
- $Thesite = $i;
- return $aslocal;
- } elsif ($url !~ /\.gz$/) {
- my $gzurl = "$url.gz";
- $CPAN::Frontend->myprint("Fetching with LWP:
+ unless ($Ua) {
+ require LWP::UserAgent;
+ $Ua = LWP::UserAgent->new;
+ }
+ my $res = $Ua->mirror($url, $aslocal);
+ if ($res->is_success) {
+ $Thesite = $i;
+ return $aslocal;
+ } elsif ($url !~ /\.gz$/) {
+ my $gzurl = "$url.gz";
+ $CPAN::Frontend->myprint("Fetching with LWP:
$gzurl
");
- $res = $Ua->mirror($gzurl, "$aslocal.gz");
- if ($res->is_success &&
- system("$CPAN::Config->{gzip} -d $aslocal.gz")==0) {
- $Thesite = $i;
- return $aslocal;
- } else {
- next HOSTEASY ;
- }
+ $res = $Ua->mirror($gzurl, "$aslocal.gz");
+ if ($res->is_success &&
+ CPAN::Tarzip->gunzip("$aslocal.gz",$aslocal)
+ ) {
+ $Thesite = $i;
+ return $aslocal;
} else {
- next HOSTEASY ;
+ # 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 ;
+ }
+ } else {
+ $self->debug("LWP not installed") if $CPAN::DEBUG;
}
if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
# that's the nice and easy way thanks to Graham
@@ -1750,7 +2042,7 @@ sub hosteasy {
if ($CPAN::META->has_inst('Net::FTP')) {
$dir =~ s|/+|/|g;
$CPAN::Frontend->myprint("Fetching with Net::FTP:
- $aslocal
+ $url
");
$self->debug("getfile[$getfile]dir[$dir]host[$host]" .
"aslocal[$aslocal]") if $CPAN::DEBUG;
@@ -1761,50 +2053,58 @@ sub hosteasy {
if ($aslocal !~ /\.gz$/) {
my $gz = "$aslocal.gz";
$CPAN::Frontend->myprint("Fetching with Net::FTP
- $gz
+ $url.gz
");
- if (CPAN::FTP->ftp_get($host,
- $dir,
- "$getfile.gz",
- $gz) &&
- system("$CPAN::Config->{gzip} -d $gz")==0 ){
+ if (CPAN::FTP->ftp_get($host,
+ $dir,
+ "$getfile.gz",
+ $gz) &&
+ CPAN::Tarzip->gunzip($gz,$aslocal)
+ ){
$Thesite = $i;
return $aslocal;
}
}
- next HOSTEASY;
+ # next HOSTEASY;
}
}
}
}
sub hosthard {
- my($self,$host_seq,$file,$aslocal) = @_;
+ my($self,$host_seq,$file,$aslocal) = @_;
- # Came back if Net::FTP couldn't establish connection (or
- # failed otherwise) Maybe they are behind a firewall, but they
- # gave us a socksified (or other) ftp program...
+ # Came back if Net::FTP couldn't establish connection (or
+ # failed otherwise) Maybe they are behind a firewall, but they
+ # gave us a socksified (or other) ftp program...
- my($i);
- my($aslocal_dir) = File::Basename::dirname($aslocal);
- File::Path::mkpath($aslocal_dir);
+ my($i);
+ my($devnull) = $CPAN::Config->{devnull} || "";
+ # < /dev/null ";
+ my($aslocal_dir) = File::Basename::dirname($aslocal);
+ File::Path::mkpath($aslocal_dir);
HOSTHARD: for $i (@$host_seq) {
- my $url = $CPAN::Config->{urllist}[$i];
+ 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($host,$dir,$getfile);
- if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
- ($host,$dir,$getfile) = ($1,$2,$3);
+ my($proto,$host,$dir,$getfile);
+
+ # Courtesy Mark Conty mark_conty@cargill.com change from
+ # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
+ # to
+ if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
+ # proto not yet used
+ ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
} else {
next HOSTHARD; # who said, we could ftp anything except ftp?
}
$self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
my($f,$funkyftp);
- for $f ('lynx','ncftp') {
+ for $f ('lynx','ncftpget','ncftp') {
next unless exists $CPAN::Config->{$f};
$funkyftp = $CPAN::Config->{$f};
next unless defined $funkyftp;
@@ -1813,14 +2113,14 @@ sub hosthard {
my $aslocal_uncompressed;
($aslocal_uncompressed = $aslocal) =~ s/\.gz//;
my($source_switch) = "";
- $source_switch = "-source" if $funkyftp =~ /\blynx$/;
- $source_switch = "-c" if $funkyftp =~ /\bncftp$/;
+ $source_switch = " -source" if $funkyftp =~ /\blynx$/;
+ $source_switch = " -c" if $funkyftp =~ /\bncftp$/;
$CPAN::Frontend->myprint(
- qq{
-Trying with "$funkyftp $source_switch" to get
+ qq[
+Trying with "$funkyftp$source_switch" to get
$url
-});
- my($system) = "$funkyftp $source_switch '$url' > ".
+]);
+ my($system) = "$funkyftp$source_switch '$url' $devnull > ".
"$aslocal_uncompressed";
$self->debug("system[$system]") if $CPAN::DEBUG;
my($wstatus);
@@ -1830,51 +2130,49 @@ Trying with "$funkyftp $source_switch" to get
# system even if it fails
) {
if ($aslocal_uncompressed ne $aslocal) {
- # test gzip integrity
- $system =
- "$CPAN::Config->{'gzip'} -dt $aslocal_uncompressed";
- if (system($system) == 0) {
- rename $aslocal_uncompressed, $aslocal;
- } else {
- $system =
- "$CPAN::Config->{'gzip'} $aslocal_uncompressed";
- system($system);
- }
- $Thesite = $i;
- return $aslocal;
+ # test gzip integrity
+ if (
+ CPAN::Tarzip->gtest($aslocal_uncompressed)
+ ) {
+ rename $aslocal_uncompressed, $aslocal;
+ } else {
+ CPAN::Tarzip->gzip($aslocal_uncompressed,
+ "$aslocal_uncompressed.gz");
+ }
}
+ $Thesite = $i;
+ return $aslocal;
} elsif ($url !~ /\.gz$/) {
- my $gz = "$aslocal.gz";
- my $gzurl = "$url.gz";
- $CPAN::Frontend->myprint(
- qq{
-Trying with "$funkyftp $source_switch" to get
+ unlink $aslocal_uncompressed if
+ -f $aslocal_uncompressed && -s _ == 0;
+ my $gz = "$aslocal.gz";
+ my $gzurl = "$url.gz";
+ $CPAN::Frontend->myprint(
+ qq[
+Trying with "$funkyftp$source_switch" to get
$url.gz
-});
- my($system) = "$funkyftp $source_switch '$url.gz' > ".
- "$aslocal_uncompressed.gz";
- $self->debug("system[$system]") if $CPAN::DEBUG;
- my($wstatus);
- if (($wstatus = system($system)) == 0
- &&
- -s "$aslocal_uncompressed.gz"
- ) {
- # test gzip integrity
- $system =
- "$CPAN::Config->{'gzip'} -dt $aslocal_uncompressed.gz";
- $CPAN::Frontend->mywarn("system[$system]");
- if (system($system) == 0) {
- $system = "$CPAN::Config->{'gzip'} -dc ".
- "$aslocal_uncompressed.gz > $aslocal";
- $CPAN::Frontend->mywarn("system[$system]");
- system($system);
- } else {
- rename $aslocal_uncompressed, $aslocal;
- }
-#line 1739
- $Thesite = $i;
- return $aslocal;
+]);
+ my($system) = "$funkyftp$source_switch '$url.gz' $devnull > ".
+ "$aslocal_uncompressed.gz";
+ $self->debug("system[$system]") if $CPAN::DEBUG;
+ my($wstatus);
+ if (($wstatus = system($system)) == 0
+ &&
+ -s "$aslocal_uncompressed.gz"
+ ) {
+ # test gzip integrity
+ if (CPAN::Tarzip->gtest("$aslocal_uncompressed.gz")) {
+ CPAN::Tarzip->gunzip("$aslocal_uncompressed.gz",
+ $aslocal);
+ } else {
+ rename $aslocal_uncompressed, $aslocal;
}
+ $Thesite = $i;
+ return $aslocal;
+ } else {
+ unlink "$aslocal_uncompressed.gz" if
+ -f "$aslocal_uncompressed.gz";
+ }
} else {
my $estatus = $wstatus >> 8;
my $size = -f $aslocal ? ", left\n$aslocal with size ".-s _ : "";
@@ -1898,7 +2196,7 @@ sub hosthardest {
$CPAN::Frontend->myprint("No external ftp command available\n\n");
last HOSTHARDEST;
}
- my $url = $CPAN::Config->{urllist}[$i];
+ my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
unless ($self->is_reachable($url)) {
$CPAN::Frontend->myprint("Skipping $url (not reachable)\n");
next;
@@ -1963,7 +2261,7 @@ sub hosthardest {
$CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
nor does it have a default entry\n");
}
-
+
# OK, they don't have a valid ~/.netrc. Use 'ftp -n'
# then and login manually to host, using e-mail as
# password.
@@ -2001,11 +2299,11 @@ sub talk_ftp {
Subprocess "|$command"
returned status $estatus (wstat $wstatus)
}) if $wstatus;
-
}
# find2perl needs modularization, too, all the following is stolen
# from there
+# CPAN::FTP::ls
sub ls {
my($self,$name) = @_;
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
@@ -2127,6 +2425,27 @@ sub contains {
package CPAN::Complete;
+sub gnu_cpl {
+ my($text, $line, $start, $end) = @_;
+ my(@perlret) = cpl($text, $line, $start);
+ # find longest common match. Can anybody show me how to peruse
+ # T::R::Gnu to have this done automatically? Seems expensive.
+ return () unless @perlret;
+ my($newtext) = $text;
+ for (my $i = length($text)+1;;$i++) {
+ last unless length($perlret[0]) && length($perlret[0]) >= $i;
+ my $try = substr($perlret[0],0,$i);
+ my @tries = grep {substr($_,0,$i) eq $try} @perlret;
+ # warn "try[$try]tries[@tries]";
+ if (@tries == @perlret) {
+ $newtext = $try;
+ } else {
+ last;
+ }
+ }
+ ($newtext,@perlret);
+}
+
#-> sub CPAN::Complete::cpl ;
sub cpl {
my($word,$line,$pos) = @_;
@@ -2172,7 +2491,7 @@ sub cpl {
#-> sub CPAN::Complete::cplx ;
sub cplx {
my($class, $word) = @_;
- grep /^\Q$word\E/, map { $_->id } $CPAN::META->all($class);
+ grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
}
#-> sub CPAN::Complete::cpl_any ;
@@ -2242,26 +2561,35 @@ sub reload {
my $needshort = $^O eq "dos";
- $cl->rd_authindex($cl->reload_x(
- "authors/01mailrc.txt.gz",
- $needshort ? "01mailrc.gz" : "",
- $force));
+ $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 ? "02packag.gz" : "",
- $force));
+ $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 ? "03mlist.gz" : "",
- $force));
+ $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;
@@ -2294,15 +2622,20 @@ sub reload_x {
#-> sub CPAN::Index::rd_authindex ;
sub rd_authindex {
- my($cl,$index_target) = @_;
+ my($cl, $index_target) = @_;
+ my @lines;
return unless defined $index_target;
- my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
$CPAN::Frontend->myprint("Going to read $index_target\n");
- my $fh = FileHandle->new("$pipe|");
- while (<$fh>) {
- chomp;
+# my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
+# while ($_ = $fh->READLINE) {
+ # no strict 'refs';
+ local(*FH);
+ tie *FH, CPAN::Tarzip, $index_target;
+ local($/) = "\n";
+ push @lines, split /\012/ while <FH>;
+ foreach (@lines) {
my($userid,$fullname,$email) =
- /alias\s+(\S+)\s+\"([^\"\<]+)\s+<([^\>]+)\>\"/;
+ m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
next unless $userid && $fullname && $email;
# instantiate an author object
@@ -2310,35 +2643,53 @@ sub rd_authindex {
$userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
return if $CPAN::Signal;
}
- $fh->close;
- $? and Carp::croak "FAILED $pipe: exit status [$?]";
+}
+
+sub userid {
+ my($self,$dist) = @_;
+ $dist = $self->{'id'} unless defined $dist;
+ my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
+ $ret;
}
#-> sub CPAN::Index::rd_modpacks ;
sub rd_modpacks {
- my($cl,$index_target) = @_;
+ my($cl, $index_target) = @_;
+ my @lines;
return unless defined $index_target;
- my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
$CPAN::Frontend->myprint("Going to read $index_target\n");
- my $fh = FileHandle->new("$pipe|");
- while (<$fh>) {
- last if /^\s*$/;
+ my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
+ local($/) = "\n";
+ while ($_ = $fh->READLINE) {
+ s/\012/\n/g;
+ my @ls = map {"$_\n"} split /\n/, $_;
+ unshift @ls, "\n" x length($1) if /^(\n+)/;
+ push @lines, @ls;
}
- while (<$fh>) {
+ while (@lines) {
+ my $shift = shift(@lines);
+ last if $shift =~ /^\s*$/;
+ }
+ foreach (@lines) {
chomp;
my($mod,$version,$dist) = split;
### $version =~ s/^\+//;
- # if it as a bundle, instatiate a bundle object
+ # if it is a bundle, instatiate a bundle object
my($bundle,$id,$userid);
-
- if ($mod eq 'CPAN') {
+
+ if ($mod eq 'CPAN' &&
+ ! (
+ CPAN::Queue->exists('Bundle::CPAN') ||
+ 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!
You might want to try
- install CPAN
+ install Bundle::CPAN
reload cpan
without quitting the current session. It should be a seamless upgrade
while we are running...
@@ -2353,9 +2704,11 @@ 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";
# 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.
@@ -2369,8 +2722,7 @@ sub rd_modpacks {
}
if ($id->cpan_file ne $dist){
- # determine the author
- ($userid) = $dist =~ /([^\/]+)/;
+ $userid = $cl->userid($dist);
$id->set(
'CPAN_USERID' => $userid,
'CPAN_VERSION' => $version,
@@ -2389,31 +2741,36 @@ sub rd_modpacks {
return if $CPAN::Signal;
}
- $fh->close;
- $? and Carp::croak "FAILED $pipe: exit status [$?]";
+ undef $fh;
}
#-> sub CPAN::Index::rd_modlist ;
sub rd_modlist {
my($cl,$index_target) = @_;
return unless defined $index_target;
- my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
$CPAN::Frontend->myprint("Going to read $index_target\n");
- my $fh = FileHandle->new("$pipe|");
- my $eval;
- while (<$fh>) {
- if (/^Date:\s+(.*)/){
+ my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
+ my @eval;
+ local($/) = "\n";
+ while ($_ = $fh->READLINE) {
+ s/\012/\n/g;
+ my @ls = map {"$_\n"} split /\n/, $_;
+ unshift @ls, "\n" x length($1) if /^(\n+)/;
+ push @eval, @ls;
+ }
+ while (@eval) {
+ my $shift = shift(@eval);
+ if ($shift =~ /^Date:\s+(.*)/){
return if $date_of_03 eq $1;
($date_of_03) = $1;
}
- last if /^\s*$/;
+ last if $shift =~ /^\s*$/;
}
- local($/) = undef;
- $eval = <$fh>;
- $fh->close;
- $eval .= q{CPAN::Modulelist->data;};
+ undef $fh;
+ push @eval, q{CPAN::Modulelist->data;};
local($^W) = 0;
my($comp) = Safe->new("CPAN::Safe1");
+ my($eval) = join("", @eval);
my $ret = $comp->reval($eval);
Carp::confess($@) if $@;
return if $CPAN::Signal;
@@ -2459,8 +2816,19 @@ sub as_string {
for (sort keys %$self) {
next if $_ eq 'ID';
my $extra = "";
- $_ eq "CPAN_USERID" and $extra = " (".$self->author.")";
- if (ref($self->{$_}) eq "ARRAY") { # Should we setup a language interface? XXX
+ if ($_ eq "CPAN_USERID") {
+ $extra .= " (".$self->author;
+ my $email; # old perls!
+ if ($email = $CPAN::META->instance(CPAN::Author,
+ $self->{$_}
+ )->email) {
+ $extra .= " <$email>";
+ } else {
+ $extra .= " <no email>";
+ }
+ $extra .= ")";
+ }
+ if (ref($self->{$_}) eq "ARRAY") { # language interface? XXX
push @m, sprintf " %-12s %s%s\n", $_, "@{$self->{$_}}", $extra;
} else {
push @m, sprintf " %-12s %s%s\n", $_, $self->{$_}, $extra;
@@ -2496,6 +2864,7 @@ sub as_glimpse {
#-> sub CPAN::Author::fullname ;
sub fullname { shift->{'FULLNAME'} }
*name = \&fullname;
+
#-> sub CPAN::Author::email ;
sub email { shift->{'EMAIL'} }
@@ -2559,11 +2928,12 @@ sub get {
} else {
$self->{archived} = "NO";
}
- chdir "..";
+ chdir File::Spec->updir;
if ($self->{archived} ne 'NO') {
- chdir "tmp";
+ chdir File::Spec->catdir(File::Spec->curdir, "tmp");
# Let's check if the package has its own directory.
- my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir .: $!");
+ my $dh = DirHandle->new(File::Spec->curdir)
+ or Carp::croak("Couldn't opendir .: $!");
my @readdir = grep $_ !~ /^\.\.?$/, $dh->read; ### MAC??
$dh->close;
my ($distdir,$packagedir);
@@ -2586,7 +2956,7 @@ sub get {
}
}
$self->{'build_dir'} = $packagedir;
- chdir "..";
+ chdir File::Spec->updir;
$self->debug("Changed directory to .. (self is $self [".$self->as_string."])")
if $CPAN::DEBUG;
@@ -2597,25 +2967,32 @@ sub get {
}
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;
- } else {
- my $fh = FileHandle->new(">$makefilepl")
- or Carp::croak("Could not open >$makefilepl");
- my $cf = $self->called_for || "unknown";
- $fh->print(
+ 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(
qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
# because there was no Makefile.PL supplied.
# Autogenerated on: }.scalar localtime().qq{
- use ExtUtils::MakeMaker;
- WriteMakefile(NAME => q[$cf]);
+use ExtUtils::MakeMaker;
+WriteMakefile(NAME => q[$cf]);
});
- $CPAN::Frontend->myprint(qq{Package comes without Makefile.PL.\n}.
- qq{ Writing one on our own (calling it $cf)\n});
+ $CPAN::Frontend->myprint(qq{Package comes without Makefile.PL.
+ Writing one on our own (calling it $cf)\n});
}
}
}
@@ -2625,9 +3002,7 @@ qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
sub untar_me {
my($self,$local_file) = @_;
$self->{archived} = "tar";
- my $system = "$CPAN::Config->{gzip} --decompress --stdout " .
- "$local_file | $CPAN::Config->{tar} xvf -";
- if (system($system)== 0) {
+ if (CPAN::Tarzip->untar($local_file)) {
$self->{unwrapped} = "YES";
} else {
$self->{unwrapped} = "NO";
@@ -2650,9 +3025,7 @@ sub pm2dir_me {
$self->{archived} = "pm";
my $to = File::Basename::basename($local_file);
$to =~ s/\.(gz|Z)$//;
- my $system = "$CPAN::Config->{gzip} --decompress --stdout ".
- "$local_file > $to";
- if (system($system) == 0) {
+ if (CPAN::Tarzip->gunzip($local_file,$to)) {
$self->{unwrapped} = "YES";
} else {
$self->{unwrapped} = "NO";
@@ -2672,6 +3045,12 @@ sub new {
#-> sub CPAN::Distribution::look ;
sub look {
my($self) = @_;
+
+ if ($^O eq 'MacOS') {
+ $self->ExtUtils::MM_MacOS::look;
+ return;
+ }
+
if ( $CPAN::Config->{'shell'} ) {
$CPAN::Frontend->myprint(qq{
Trying to open a subshell in the build directory...
@@ -2714,6 +3093,12 @@ sub readme {
$local_file = CPAN::FTP->localize("authors/id/$sans.readme",
$local_wanted)
or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
+
+ if ($^O eq 'MacOS') {
+ ExtUtils::MM_MacOS::launch_file($local_file);
+ return;
+ }
+
my $fh_pager = FileHandle->new;
local($SIG{PIPE}) = "IGNORE";
$fh_pager->open("|$CPAN::Config->{'pager'}")
@@ -2761,9 +3146,8 @@ sub verifyMD5 {
$lc_file = CPAN::FTP->localize("authors/id/@local",
"$lc_want.gz",1);
if ($lc_file) {
- my @system = ($CPAN::Config->{gzip}, '--decompress', $lc_file);
- system(@system) == 0 or die "Could not uncompress $lc_file";
$lc_file =~ s/\.gz$//;
+ CPAN::Tarzip->gunzip("$lc_file.gz",$lc_file);
} else {
return;
}
@@ -2781,6 +3165,7 @@ sub MD5_check_file {
if (open $fh, $chk_file){
local($/);
my $eval = <$fh>;
+ $eval =~ s/\015?\012/\n/g;
close $fh;
my($comp) = Safe->new();
$cksum = $comp->reval($eval);
@@ -2791,22 +3176,33 @@ sub MD5_check_file {
} else {
Carp::carp "Could not open $chk_file for reading";
}
- if ($cksum->{$basename}->{md5}) {
+
+ if (exists $cksum->{$basename}{md5}) {
$self->debug("Found checksum for $basename:" .
- "$cksum->{$basename}->{md5}\n") if $CPAN::DEBUG;
- my $pipe = "$CPAN::Config->{gzip} --decompress ".
- "--stdout $file|";
- if (
- open($fh, $file) &&
- binmode $fh &&
- $self->eq_MD5($fh,$cksum->{$basename}->{md5})
- or
- open($fh, $pipe) &&
- binmode $fh &&
- $self->eq_MD5($fh,$cksum->{$basename}->{'md5-ungz'})
- ){
- $CPAN::Frontend->myprint("Checksum for $file ok\n");
- return $self->{MD5_STATUS} = "OK";
+ "$cksum->{$basename}{md5}\n") if $CPAN::DEBUG;
+
+ open($fh, $file);
+ binmode $fh;
+ my $eq = $self->eq_MD5($fh,$cksum->{$basename}{'md5'});
+ $fh->close;
+ $fh = CPAN::Tarzip->TIEHANDLE($file);
+
+ unless ($eq) {
+ # had to inline it, when I tied it, the tiedness got lost on
+ # the call to eq_MD5. (Jan 1998)
+ my $md5 = MD5->new;
+ my($data,$ref);
+ $ref = \$data;
+ while ($fh->READ($ref, 4096)){
+ $md5->add($data);
+ }
+ my $hexdigest = $md5->hexdigest;
+ $eq += $hexdigest eq $cksum->{$basename}{'md5-ungz'};
+ }
+
+ if ($eq) {
+ $CPAN::Frontend->myprint("Checksum for $file ok\n");
+ return $self->{MD5_STATUS} = "OK";
} else {
$CPAN::Frontend->myprint(qq{Checksum mismatch for }.
qq{distribution file. }.
@@ -2817,15 +3213,15 @@ sub MD5_check_file {
$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
+be a bogus file. 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;
}
- close $fh if fileno($fh);
+ # close $fh if fileno($fh);
} else {
$self->{MD5_STATUS} ||= "";
if ($self->{MD5_STATUS} eq "NIL") {
@@ -2845,23 +3241,39 @@ Removing $chk_file
sub eq_MD5 {
my($self,$fh,$expectMD5) = @_;
my $md5 = MD5->new;
- $md5->addfile($fh);
+ my($data);
+ while (read($fh, $data, 4096)){
+ $md5->add($data);
+ }
+ # $md5->addfile($fh);
my $hexdigest = $md5->hexdigest;
+ # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
$hexdigest eq $expectMD5;
}
#-> sub CPAN::Distribution::force ;
sub force {
- my($self) = @_;
- $self->{'force_update'}++;
- delete $self->{'MD5_STATUS'};
- delete $self->{'archived'};
- delete $self->{'build_dir'};
- delete $self->{'localfile'};
- delete $self->{'make'};
- delete $self->{'install'};
- delete $self->{'unwrapped'};
- delete $self->{'writemakefile'};
+ my($self) = @_;
+ $self->{'force_update'}++;
+ for my $att (qw(
+ MD5_STATUS archived build_dir localfile make install unwrapped
+ writemakefile have_sponsored
+ )) {
+ delete $self->{$att};
+ }
+}
+
+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
+ $
+ }x;
+ "$1.$3";
}
#-> sub CPAN::Distribution::perl ;
@@ -2893,6 +3305,29 @@ sub perl {
sub make {
my($self) = @_;
$CPAN::Frontend->myprint(sprintf "Running make for %s\n", $self->id);
+ # 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'}
+ ) {
+ $CPAN::Frontend->mydie(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
+ force install %s
+or
+ install %s
+},
+ $CPAN::META->instance(
+ 'CPAN::Module',
+ $self->called_for
+ )->cpan_version,
+ $self->called_for,
+ $self->isa_perl,
+ $self->called_for,
+ $self->id);
+ }
+ }
$self->get;
EXCUSE: {
my @e;
@@ -2916,9 +3351,14 @@ sub make {
chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
$self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
+ if ($^O eq 'MacOS') {
+ ExtUtils::MM_MacOS::make($self);
+ return;
+ }
+
my $system;
if ($self->{'configure'}) {
- $system = $self->{'configure'};
+ $system = $self->{'configure'};
} else {
my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
my $switch = "";
@@ -2928,19 +3368,23 @@ sub make {
# if $] > 5.00310;
$system = "$perl $switch Makefile.PL $CPAN::Config->{makepl_arg}";
}
- {
+ unless (exists $self->{writemakefile}) {
local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
my($ret,$pid);
$@ = "";
if ($CPAN::Config->{inactivity_timeout}) {
eval {
alarm $CPAN::Config->{inactivity_timeout};
- local $SIG{CHLD} = sub { wait };
+ local $SIG{CHLD}; # = sub { wait };
if (defined($pid = fork)) {
if ($pid) { #parent
- wait;
+ # wait;
+ waitpid $pid, 0;
} else { #child
- exec $system;
+ # note, this exec isn't necessary if
+ # inactivity_timeout is 0. On the Mac I'd
+ # suggest, we set it always to 0.
+ exec $system;
}
} else {
$CPAN::Frontend->myprint("Cannot fork: $!");
@@ -2957,15 +3401,41 @@ sub make {
return;
}
} else {
- $ret = system($system);
- if ($ret != 0) {
- $self->{writemakefile} = "NO";
- return;
- }
+ $ret = system($system);
+ if ($ret != 0) {
+ $self->{writemakefile} = "NO";
+ return;
+ }
}
+ $self->{writemakefile} = "YES";
}
- $self->{writemakefile} = "YES";
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;
+ }
+ }
$system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
if (system($system) == 0) {
$CPAN::Frontend->myprint(" $system -- OK\n");
@@ -2977,6 +3447,44 @@ sub make {
}
}
+#-> sub CPAN::Distribution::needs_prereq ;
+sub needs_prereq {
+ my($self) = @_;
+ return unless -f "Makefile"; # we cannot say much
+ my $fh = FileHandle->new("<Makefile") or
+ $CPAN::Frontend->mydie("Couldn't open Makefile: $!");
+ local($/) = "\n";
+
+ my(@p,@need);
+ 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]";
+
+ while ( $p =~ m/(?:\s)([\w\:]+)=>q\[.*?\],?/g ){
+ push @p, $1;
+ }
+ 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;
+}
+
#-> sub CPAN::Distribution::test ;
sub test {
my($self) = @_;
@@ -2999,6 +3507,12 @@ sub test {
Carp::croak("Couldn't chdir to $self->{'build_dir'}");
$self->debug("Changed directory to $self->{'build_dir'}")
if $CPAN::DEBUG;
+
+ if ($^O eq 'MacOS') {
+ ExtUtils::MM_MacOS::make_test($self);
+ return;
+ }
+
my $system = join " ", $CPAN::Config->{'make'}, "test";
if (system($system) == 0) {
$CPAN::Frontend->myprint(" $system -- OK\n");
@@ -3021,6 +3535,12 @@ sub clean {
chdir $self->{'build_dir'} or
Carp::croak("Couldn't chdir to $self->{'build_dir'}");
$self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
+
+ if ($^O eq 'MacOS') {
+ ExtUtils::MM_MacOS::make_clean($self);
+ return;
+ }
+
my $system = join " ", $CPAN::Config->{'make'}, "clean";
if (system($system) == 0) {
$CPAN::Frontend->myprint(" $system -- OK\n");
@@ -3063,9 +3583,16 @@ sub install {
Carp::croak("Couldn't chdir to $self->{'build_dir'}");
$self->debug("Changed directory to $self->{'build_dir'}")
if $CPAN::DEBUG;
+
+ if ($^O eq 'MacOS') {
+ ExtUtils::MM_MacOS::make_install($self);
+ return;
+ }
+
my $system = join(" ", $CPAN::Config->{'make'},
"install", $CPAN::Config->{make_install_arg});
- my($pipe) = FileHandle->new("$system 2>&1 |");
+ my($stderr) = $^O =~ /Win/i ? "" : " 2>&1 ";
+ my($pipe) = FileHandle->new("$system $stderr |");
my($makeout) = "";
while (<$pipe>){
$CPAN::Frontend->myprint($_);
@@ -3074,7 +3601,7 @@ sub install {
$pipe->close;
if ($?==0) {
$CPAN::Frontend->myprint(" $system -- OK\n");
- $self->{'install'} = "YES";
+ return $self->{'install'} = "YES";
} else {
$self->{'install'} = "NO";
$CPAN::Frontend->myprint(" $system -- NOT OK\n");
@@ -3102,58 +3629,67 @@ sub 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 $inpod = 0;
- $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
- while (<$fh>) {
- $inpod = /^=(?!head1\s+CONTENTS)/ ? 0 :
- /^=head1\s+CONTENTS/ ? 1 : $inpod;
- next unless $inpod;
- next if /^=/;
- 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;
- @result;
+ 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 $inpod = 0;
+ $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
+ while (<$fh>) {
+ $inpod = m/^=(?!head1\s+CONTENTS)/ ? 0 :
+ m/^=head1\s+CONTENTS/ ? 1 : $inpod;
+ next unless $inpod;
+ next if /^=/;
+ 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
+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;
}
#-> sub CPAN::Bundle::find_bundle_file
sub find_bundle_file {
my($self,$where,$what) = @_;
$self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
- my $bu = MM->catfile($where,$what);
- return $bu if -f $bu;
+### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
+### my $bu = MM->catfile($where,$what);
+### return $bu if -f $bu;
my $manifest = MM->catfile($where,"MANIFEST");
unless (-f $manifest) {
require ExtUtils::Manifest;
@@ -3166,20 +3702,30 @@ sub find_bundle_file {
my $fh = FileHandle->new($manifest)
or Carp::croak("Couldn't open $manifest: $!");
local($/) = "\n";
+ my $what2 = $what;
+ if ($^O eq 'MacOS') {
+ $what =~ s/^://;
+ $what2 =~ tr|:|/|;
+ $what2 =~ s/:Bundle://;
+ $what2 =~ tr|:|/|;
+ } else {
+ $what2 =~ s|Bundle/||;
+ }
+ my $bu;
while (<$fh>) {
next if /^\s*\#/;
my($file) = /(\S+)/;
if ($file =~ m|\Q$what\E$|) {
$bu = $file;
- return MM->catfile($where,$bu);
- } elsif ($what =~ s|Bundle/||) { # retry if she managed to
- # have no Bundle directory
- if ($file =~ m|\Q$what\E$|) {
- $bu = $file;
- return MM->catfile($where,$bu);
- }
+ # return MM->catfile($where,$bu); # bad
+ last;
}
+ # retry if she managed to
+ # have no Bundle directory
+ $bu = $file if $file =~ m|\Q$what2\E$|;
}
+ $bu =~ tr|/|:| if $^O eq 'MacOS';
+ return MM->catfile($where, $bu) if $bu;
Carp::croak("Couldn't find a Bundle file in $where");
}
@@ -3208,7 +3754,7 @@ sub rematein {
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};
- my($s);
+ my($s,%fail);
for $s ($self->contains) {
my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
$s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
@@ -3219,7 +3765,26 @@ explicitly a file $s.
});
sleep 3;
}
- $CPAN::META->instance($type,$s)->$meth();
+ # possibly noisy action:
+ 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;
+ }
+ # recap with less noise
+ if ( $meth eq "install") {
+ if (%fail) {
+ $CPAN::Frontend->myprint(qq{\nBundle summary: }.
+ qq{The following items seem to }.
+ qq{have had installation problems:\n});
+ for $s ($self->contains) {
+ $CPAN::Frontend->myprint( "$s " ) if $fail{$s};
+ }
+ $CPAN::Frontend->myprint(qq{\n});
+ } else {
+ $self->{'install'} = 'YES';
+ }
}
}
@@ -3239,7 +3804,10 @@ sub make { shift->rematein('make',@_); }
#-> sub CPAN::Bundle::test ;
sub test { shift->rematein('test',@_); }
#-> sub CPAN::Bundle::install ;
-sub install { shift->rematein('install',@_); }
+sub install {
+ my $self = shift;
+ $self->rematein('install',@_);
+}
#-> sub CPAN::Bundle::clean ;
sub clean { shift->rematein('clean',@_); }
@@ -3282,12 +3850,17 @@ sub as_string {
if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){
my $author;
if ($author = CPAN::Shell->expand('Author',$userid)) {
- push @m, sprintf(
- $sprintf2,
- 'CPAN_USERID',
- $userid,
- $author->fullname
- );
+ my $email = "";
+ my $m; # old perls
+ if ($m = $author->email) {
+ $email = " <$m>";
+ }
+ push @m, sprintf(
+ $sprintf2,
+ 'CPAN_USERID',
+ $userid,
+ $author->fullname . $email
+ );
}
}
push @m, sprintf($sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION})
@@ -3300,9 +3873,9 @@ sub as_string {
pre-alpha alpha beta released mature standard,;
@stats{qw,? m d u n,} = qw,unknown mailing-list
developer comp.lang.perl.* none,;
- @statl{qw,? p c + o,} = qw,unknown perl C C++ other,;
- @stati{qw,? f r O,} = qw,unknown functions
- references+ties object-oriented,;
+ @statl{qw,? p c + o h,} = qw,unknown perl C C++ other hybrid,;
+ @stati{qw,? f r O h,} = qw,unknown functions
+ references+ties object-oriented hybrid,;
$statd{' '} = 'unknown';
$stats{' '} = 'unknown';
$statl{' '} = 'unknown';
@@ -3320,23 +3893,8 @@ sub as_string {
$stati{$self->{stati}}
) if $self->{statd};
my $local_file = $self->inst_file;
- if ($local_file && ! exists $self->{MANPAGE}) {
- my $fh = FileHandle->new($local_file)
- or Carp::croak("Couldn't open $local_file: $!");
- my $inpod = 0;
- my(@result);
- local $/ = "\n";
- while (<$fh>) {
- $inpod = /^=(?!head1\s+NAME)/ ? 0 :
- /^=head1\s+NAME/ ? 1 : $inpod;
- next unless $inpod;
- next if /^=/;
- next if /^\s+$/;
- chomp;
- push @result, $_;
- }
- close $fh;
- $self->{MANPAGE} = join " ", @result;
+ if ($local_file) {
+ $self->{MANPAGE} ||= $self->manpage_headline($local_file);
}
my($item);
for $item (qw/MANPAGE CONTAINS/) {
@@ -3350,6 +3908,33 @@ sub as_string {
join "", @m, "\n";
}
+sub manpage_headline {
+ my($self,$local_file) = @_;
+ my(@local_file) = $local_file;
+ $local_file =~ s/\.pm$/.pod/;
+ push @local_file, $local_file;
+ my(@result,$locf);
+ for $locf (@local_file) {
+ next unless -f $locf;
+ my $fh = FileHandle->new($locf)
+ or $Carp::Frontend->mydie("Couldn't open $locf: $!");
+ my $inpod = 0;
+ local $/ = "\n";
+ while (<$fh>) {
+ $inpod = m/^=(?!head1\s+NAME)/ ? 0 :
+ m/^=head1\s+NAME/ ? 1 : $inpod;
+ next unless $inpod;
+ next if /^=/;
+ next if /^\s+$/;
+ chomp;
+ push @result, $_;
+ }
+ close $fh;
+ last if @result;
+ }
+ join " ", @result;
+}
+
#-> sub CPAN::Module::cpan_file ;
sub cpan_file {
my $self = shift;
@@ -3362,12 +3947,12 @@ sub cpan_file {
} elsif (exists $self->{'userid'} && defined $self->{'userid'}) {
my $fullname = $CPAN::META->instance(CPAN::Author,
$self->{'userid'})->fullname;
- unless (defined $fullname) {
- $CPAN::Frontend->mywarn(qq{Full name of author }.
- qq{$self->{userid} not known});
- return "Contact Author $self->{userid}";
+ 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 $self->{userid} ($fullname)"
+ return "Contact Author $fullname <$email>";
} else {
return "N/A";
}
@@ -3378,7 +3963,7 @@ sub cpan_file {
#-> sub CPAN::Module::cpan_version ;
sub cpan_version {
my $self = shift;
- $self->{'CPAN_VERSION'} = 'undef'
+ $self->{'CPAN_VERSION'} = 'undef'
unless defined $self->{'CPAN_VERSION'}; # I believe this is
# always a bug in the
# index and should be
@@ -3402,8 +3987,19 @@ sub rematein {
my($self,$meth) = @_;
$self->debug($self->id) if $CPAN::DEBUG;
my $cpan_file = $self->cpan_file;
- return if $cpan_file eq "N/A";
- return if $cpan_file =~ /^Contact Author/;
+ if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
+ $CPAN::Frontend->mywarn(sprintf qq{
+ The module %s isn\'t available on CPAN.
+
+ 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''.
+},
+ $self->id,
+ $self->id,
+ );
+ return;
+ }
my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
$pack->called_for($self->id);
$pack->force if exists $self->{'force_update'};
@@ -3421,10 +4017,9 @@ sub get { shift->rematein('get',@_); }
sub make { shift->rematein('make') }
#-> sub CPAN::Module::test ;
sub test { shift->rematein('test') }
-#-> sub CPAN::Module::install ;
-sub install {
+#-> sub CPAN::Module::uptodate ;
+sub uptodate {
my($self) = @_;
- my($doit) = 0;
my($latest) = $self->cpan_version;
$latest ||= 0;
my($inst_file) = $self->inst_file;
@@ -3432,19 +4027,26 @@ sub install {
if (defined $inst_file) {
$have = $self->inst_version;
}
- if (1){ # A block for scoping $^W, the if is just for the visual
- # appeal
- local($^W)=0;
- if ($inst_file
- &&
- $have >= $latest
- &&
- not exists $self->{'force_update'}
- ) {
- $CPAN::Frontend->myprint( $self->id. " is up to date.\n");
- } else {
- $doit = 1;
- }
+ local($^W)=0;
+ if ($inst_file
+ &&
+ $have >= $latest
+ ) {
+ return 1;
+ }
+ return;
+}
+#-> sub CPAN::Module::install ;
+sub install {
+ my($self) = @_;
+ my($doit) = 0;
+ if ($self->uptodate
+ &&
+ not exists $self->{'force_update'}
+ ) {
+ $CPAN::Frontend->myprint( $self->id. " is up to date.\n");
+ } else {
+ $doit = 1;
}
$self->rematein('install') if $doit;
}
@@ -3487,11 +4089,174 @@ 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";
$have =~ s/\s+//g;
$have;
}
+package CPAN::Tarzip;
+
+sub gzip {
+ my($class,$read,$write) = @_;
+ if ($CPAN::META->has_inst("Compress::Zlib")) {
+ my($buffer,$fhw);
+ $fhw = FileHandle->new($read)
+ or $CPAN::Frontend->mydie("Could not open $read: $!");
+ my $gz = Compress::Zlib::gzopen($write, "wb")
+ or $CPAN::Frontend->mydie("Cannot gzopen $write: $!\n");
+ $gz->gzwrite($buffer)
+ while read($fhw,$buffer,4096) > 0 ;
+ $gz->gzclose() ;
+ $fhw->close;
+ return 1;
+ } else {
+ system("$CPAN::Config->{'gzip'} -c $read > $write")==0;
+ }
+}
+
+sub gunzip {
+ my($class,$read,$write) = @_;
+ if ($CPAN::META->has_inst("Compress::Zlib")) {
+ my($buffer,$fhw);
+ $fhw = FileHandle->new(">$write")
+ or $CPAN::Frontend->mydie("Could not open >$write: $!");
+ my $gz = Compress::Zlib::gzopen($read, "rb")
+ or $CPAN::Frontend->mydie("Cannot gzopen $read: $!\n");
+ $fhw->print($buffer)
+ while $gz->gzread($buffer) > 0 ;
+ $CPAN::Frontend->mydie("Error reading from $read: $!\n")
+ if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
+ $gz->gzclose() ;
+ $fhw->close;
+ return 1;
+ } else {
+ system("$CPAN::Config->{'gzip'} -dc $read > $write")==0;
+ }
+}
+
+sub gtest {
+ my($class,$read) = @_;
+ if ($CPAN::META->has_inst("Compress::Zlib")) {
+ my($buffer);
+ 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;
+ } else {
+ return system("$CPAN::Config->{'gzip'} -dt $read")==0;
+ }
+}
+
+sub TIEHANDLE {
+ my($class,$file) = @_;
+ my $ret;
+ $class->debug("file[$file]");
+ if ($CPAN::META->has_inst("Compress::Zlib")) {
+ my $gz = Compress::Zlib::gzopen($file,"rb") or
+ 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]: $!";
+ binmode $fh;
+ $ret = bless {FH => $fh}, $class;
+ }
+ $ret;
+}
+
+sub READLINE {
+ my($self) = @_;
+ if (exists $self->{GZ}) {
+ my $gz = $self->{GZ};
+ my($line,$bytesread);
+ $bytesread = $gz->gzreadline($line);
+ return undef if $bytesread == 0;
+ return $line;
+ } else {
+ my $fh = $self->{FH};
+ return scalar <$fh>;
+ }
+}
+
+sub READ {
+ my($self,$ref,$length,$offset) = @_;
+ die "read with offset not implemented" if defined $offset;
+ if (exists $self->{GZ}) {
+ my $gz = $self->{GZ};
+ my $byteread = $gz->gzread($$ref,$length);# 30eaf79e8b446ef52464b5422da328a8
+ return $byteread;
+ } else {
+ my $fh = $self->{FH};
+ return read($fh,$$ref,$length);
+ }
+}
+
+sub DESTROY {
+ my($self) = @_;
+ if (exists $self->{GZ}) {
+ my $gz = $self->{GZ};
+ $gz->gzclose();
+ } else {
+ my $fh = $self->{FH};
+ $fh->close;
+ }
+ undef $self;
+}
+
+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'})) {
+ if ($^O =~ /win/i) { # irgggh
+ # 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$//;
+ $system = "$CPAN::Config->{tar} xvf $file";
+ 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 {
+ my $system = "$CPAN::Config->{'gzip'} --decompress --stdout " .
+ "< $file | $CPAN::Config->{tar} xvf -";
+ return system($system) == 0;
+ }
+ } 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
+
+ ExtUtils::MM_MacOS::convert_files([$tar->list_files], 1)
+ if ($^O eq 'MacOS');
+
+ return 1;
+ } else {
+ $CPAN::Frontend->mydie(qq{
+CPAN.pm needs either both external programs tar and gzip installed or
+both the modules Archive::Tar and Compress::Zlib. Neither prerequisite
+is available. Can\'t continue.
+});
+ }
+}
+
package CPAN;
1;
@@ -3536,7 +4301,15 @@ session. The cache manager keeps track of the disk space occupied by
the make processes and deletes excess space according to a simple FIFO
mechanism.
-All methods provided are accessible in a programmer style and in an
+For extended searching capabilities there's a plugin for CPAN available,
+L<CPAN::WAIT>. C<CPAN::WAIT> is a full-text search engine that indexes
+all documents available in CPAN authors directories. If C<CPAN::WAIT>
+is installed on your system, the interactive shell of <CPAN.pm> will
+enable the C<wq>, C<wr>, C<wd>, C<wl>, and C<wh> 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
interactive shell style.
=head2 Interactive Mode
@@ -3545,9 +4318,9 @@ The interactive mode is entered by running
perl -MCPAN -e shell
-which puts you into a readline interface. You will have most fun if
+which puts you into a readline interface. You will have the most fun if
you install Term::ReadKey and Term::ReadLine to enjoy both history and
-completion.
+command completion.
Once you are on the command line, type 'h' and the rest should be
self-explanatory.
@@ -3563,15 +4336,15 @@ for each of the four categories and another, C<i> for any of the
mentioned four. Each of the four entities is implemented as a class
with slightly differing methods for displaying an object.
-Arguments you pass to these commands are either strings matching exact
+Arguments you pass to these commands are either strings exactly matching
the identification string of an object or regular expressions that are
then matched case-insensitively against various attributes of the
-objects. The parser recognizes a regualar expression only if you
+objects. The parser recognizes a regular expression only if you
enclose it between two slashes.
The principle is that the number of found objects influences how an
-item is displayed. If the search finds one item, we display the result
-of object-E<gt>as_string, but if we find more than one, we display
+item is displayed. If the search finds one item, the result is displayed
+as object-E<gt>as_string, but if we find more than one, we display
each as object-E<gt>as_glimpse. E.g.
cpan> a ANDK
@@ -3592,27 +4365,30 @@ each as object-E<gt>as_glimpse. E.g.
=item make, test, install, clean modules or distributions
-These commands do indeed exist just as written above. Each of them
-takes any number of arguments and investigates for each what it might
-be. Is it a distribution file (recognized by embedded slashes), this
-file is being processed. Is it a module, CPAN determines the
-distribution file where this module is included and processes that.
+These commands take any number of arguments and investigates what is
+necessary to perform the action. If the argument is a distribution
+file name (recognized by embedded slashes), it is processed. If it is
+a module, CPAN determines the distribution file in which this module
+is included and processes that, following any dependencies named in
+the module's Makefile.PL (this behavior is controlled by
+I<prerequisites_policy>.)
-Any C<make>, C<test>, and C<readme> are run unconditionally. A
+Any C<make> or C<test> are run unconditionally. An
install <distribution_file>
-also is run unconditionally. But for
+also is run unconditionally. But for
install <module>
CPAN checks if an install is actually needed for it and prints
-I<Foo up to date> in case the module doesnE<39>t need to be updated.
+I<module up to date> in the case that the distribution file containing
+the module doesnE<39>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
-succeeded or not. The C<force > command takes as first argument the
-method to invoke (currently: make, test, or install) and executes the
+succeeded or not. The C<force> command takes as a first argument the
+method to invoke (currently: C<make>, C<test>, or C<install>) and executes the
command from scratch.
Example:
@@ -3625,13 +4401,31 @@ Example:
OpenGL-0.4/COPYRIGHT
[...]
+A C<clean> command results in a
+
+ make clean
+
+being executed within the distribution file's working directory.
+
=item readme, look module or distribution
These two commands take only one argument, be it a module or a
-distribution file. C<readme> displays the README of the associated
-distribution file. C<Look> gets and untars (if not yet done) the
-distribution file, changes to the appropriate directory and opens a
-subshell process in that directory.
+distribution file. C<readme> unconditionally runs, displaying the
+README of the associated distribution file. C<Look> gets and
+untars (if not yet done) the distribution file, changes to the
+appropriate directory and opens a subshell process in that directory.
+
+=item Signals
+
+CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
+in the cpan-shell it is intended that you can press C<^C> anytime and
+return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
+to clean up and leave the shell loop. You can emulate the effect of a
+SIGTERM by sending two consecutive SIGINTs, which usually means by
+pressing C<^C> twice.
+
+CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
+SIGALRM is used during the run of the C<perl Makefile.PL> subprocess.
=back
@@ -3658,15 +4452,14 @@ current date and a counter.
recompile() is a very special command in that it takes no argument and
runs the make/test/install cycle with brute force over all installed
dynamically loadable extensions (aka XS modules) with 'force' in
-effect. Primary purpose of this command is to finish a network
+effect. The primary purpose of this command is to finish a network
installation. Imagine, you have a common source tree for two different
architectures. You decide to do a completely independent fresh
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
-will be glad to run recompile in the second architecture and
-youE<39>re done.
+invoke CPAN's recompile on the second architecture and youE<39>re done.
Another popular use for C<recompile> is to act as a rescue in case your
perl breaks binary compatibility. If one of the modules that CPAN uses
@@ -3675,13 +4468,13 @@ commands), then you should try the CPAN::Nox module for recovery.
=head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
-Although it may be considered internal, the class hierarchie does
-matter for both users and programmer. CPAN.pm deals with above
-mentioned four classes, and all those classes share a set of
-methods. It is a classical single polymorphism that is in effect. A
-metaclass object registers all objects of all kinds and indexes them
-with a string. The strings referencing objects have a separated
-namespace (well, not completely separated):
+Although it may be considered internal, the class hierarchy does matter
+for both users and programmer. CPAN.pm deals with above mentioned four
+classes, and all those classes share a set of methods. A classical
+single polymorphism is in effect. A metaclass object registers all
+objects of all kinds and indexes them with a string. The strings
+referencing objects have a separated namespace (well, not completely
+separated):
Namespace Class
@@ -3690,20 +4483,20 @@ namespace (well, not completely separated):
everything else Module or Author
Modules know their associated Distribution objects. They always refer
-to the most recent official release. Developers may mark their
-releases as unstable development versions (by inserting an underbar
-into the visible version number), so not always is the default
-distribution for a given module the really hottest and newest. If a
-module Foo circulates on CPAN in both version 1.23 and 1.23_90,
-CPAN.pm offers a convenient way to install version 1.23 by saying
+to the most recent official release. Developers may mark their releases
+as unstable development versions (by inserting an underbar into the
+visible version number), so the really hottest and newest distribution
+file is not always the default. If a module Foo circulates on CPAN in
+both version 1.23 and 1.23_90, CPAN.pm offers a convenient way to
+install version 1.23 by saying
install Foo
This would install the complete distribution file (say
-BAR/Foo-1.23.tar.gz) with all accompanying material in there. But if
-you would like to install version 1.23_90, you need to know where the
+BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
+like to install version 1.23_90, you need to know where the
distribution file resides on CPAN relative to the authors/id/
-directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz,
+directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
so you would have to say
install BAR/Foo-1.23_90.tar.gz
@@ -3717,7 +4510,7 @@ If you do not enter the shell, the available shell commands are both
available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
functions in the calling package (C<install(...)>).
-There's currently only one class that has a stable interface,
+There's currently only one class that has a stable interface -
CPAN::Shell. All commands that are available in the CPAN shell are
methods of the class CPAN::Shell. Each of the commands that produce
listings of modules (C<r>, C<autobundle>, C<u>) returns a list of the
@@ -3758,7 +4551,7 @@ functionalities that are available in the shell.
=back
-=head2 Methods in the four
+=head2 Methods in the four Classes
=head2 Cache Manager
@@ -3785,7 +4578,7 @@ define any functions or methods. It usually only contains documentation.
It starts like a perl module with a package declaration and a $VERSION
variable. After that the pod section looks like any other pod with the
-only difference, that I<one special pod section> exists starting with
+only difference being that I<one special pod section> exists starting with
(verbatim):
=head1 CONTENTS
@@ -3795,7 +4588,7 @@ In this pod section each line obeys the format
Module_Name [Version_String] [- optional text]
The only required part is the first field, the name of a module
-(eg. Foo::Bar, ie. I<not> the name of the distribution file). The rest
+(e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
of the line is optional. The comment part is delimited by a dash just
as in the man page header.
@@ -3804,7 +4597,7 @@ other distributions.
Bundles are treated specially in the CPAN package. If you say 'install
Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
-the modules in the CONTENTS section of the pod. You can install your
+the modules in the CONTENTS section of the pod. You can install your
own Bundles locally by placing a conformant Bundle file somewhere into
your @INC path. The autobundle() command which is available in the
shell interface does that for you by including all currently installed
@@ -3822,6 +4615,8 @@ If you have neither Net::FTP nor LWP, there is a fallback mechanism
implemented for an external ftp command or for an external lynx
command.
+=head2 Finding packages and VERSION
+
This module presumes that all packages on CPAN
=over 2
@@ -3829,13 +4624,13 @@ This module presumes that all packages on CPAN
=item *
declare their $VERSION variable in an easy to parse manner. This
-prerequisite can hardly be relaxed because it consumes by far too much
+prerequisite can hardly be relaxed because it consumes far too much
memory to load all packages into the running program just to determine
-the $VERSION variable . Currently all programs that are dealing with
+the $VERSION variable. Currently all programs that are dealing with
version use something like this
perl -MExtUtils::MakeMaker -le \
- 'print MM->parse_version($ARGV[0])' filename
+ 'print MM->parse_version(shift)' filename
If you are author of a package and wonder if your $VERSION can be
parsed, please try the above method.
@@ -3843,7 +4638,7 @@ parsed, please try the above method.
=item *
come as compressed or gzipped tarfiles or as zip files and contain a
-Makefile.PL (well we try to handle a bit more, but without much
+Makefile.PL (well, we try to handle a bit more, but without much
enthusiasm).
=back
@@ -3857,12 +4652,12 @@ 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 byproduct of my own testing, but if you
+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.
-=head2 Floppy, Zip, and all that Jazz
+=head2 Floppy, Zip, Offline Mode
CPAN.pm works nicely without network too. If you maintain machines
that are not networked at all, you should consider working with file:
@@ -3875,7 +4670,7 @@ with this floppy.
=head1 CONFIGURATION
-When the CPAN module is installed a site wide configuration file is
+When the CPAN module is installed, a site wide configuration file is
created as CPAN/Config.pm. The default values defined there can be
overridden in another configuration file: CPAN/MyConfig.pm. You can
store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
@@ -3887,23 +4682,31 @@ defined:
build_cache size of cache for directories to build modules
build_dir locally accessible directory to build modules
- index_expire after how many days refetch index files
+ index_expire after this many days refetch index files
cpan_home local directory reserved for this package
gzip location of external program gzip
- inactivity_timeout breaks interactive Makefile.PLs after that
+ inactivity_timeout breaks interactive Makefile.PLs after this
many seconds inactivity. Set to 0 to never break.
inhibit_startup_message
if true, does not print the startup message
keep_source keep the source in a local directory?
- keep_source_where where keep the source (if we do)
- make location of external program make
+ keep_source_where directory in which to keep the source (if we do)
+ make location of external make program
make_arg arguments that should always be passed to 'make'
make_install_arg same as make_arg for 'make install'
makepl_arg arguments passed to 'perl Makefile.PL'
pager location of external program more (or any pager)
+ prerequisites_policy
+ what to do if you are missing module prerequisites
+ ('follow' automatically, 'ask' me, or 'ignore')
+ scan_cache controls scanning of cache ('atstart' or 'never')
tar location of external program tar
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)
+ ftp_proxy, } the three usual variables for configuring
+ http_proxy, } proxy requests. Both as CPAN::Config variables
+ no_proxy } and as environment variables configurable.
You can set and query each of these options interactively in the cpan
shell with the command set defined within the C<o conf> command:
@@ -3933,7 +4736,7 @@ works like the corresponding perl commands.
=back
-=head2 CD-ROM support
+=head2 urllist parameter has CD-ROM support
The C<urllist> parameter of the configuration table contains a list of
URLs that are to be used for downloading. If the list contains any
@@ -3948,6 +4751,14 @@ CPAN.pm will then fetch the index files from one of the CPAN sites
that come at the beginning of urllist. It will later check for each
module if there is a local copy of the most recent version.
+Another peculiarity of urllist is that the site that we could
+successfully fetch the last file from automatically gets a preference
+token and is tried as the first site for the next request. So if you
+add a new site at runtime it may happen that the previously preferred
+site will be tried another time. This means that if you want to disallow
+a site for the next transfer, it must be explicitly removed from
+urllist.
+
=head1 SECURITY
There's no strong security layer in CPAN.pm. CPAN.pm helps you to
@@ -3955,7 +4766,7 @@ install foreign, unmasked, unsigned code on your machine. We compare
to a checksum that comes from the net just as the distribution file
itself. If somebody has managed to tamper with the distribution file,
they may have as well tampered with the CHECKSUMS file. Future
-development will go towards strong authentification.
+development will go towards strong authentication.
=head1 EXPORT
@@ -3963,19 +4774,108 @@ Most functions in package CPAN are exported per default. The reason
for this is that the primary use is intended for the cpan shell or for
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
+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 re installed for the currently running perl
+interpreter. It's recommended to run this command only once and from then
+on maintain the file manually under a private name, say
+Bundle/my_bundle.pm. With a clever bundle file you can then simply say
+
+ cpan> install Bundle::my_bundle
+
+then answer a few questions and then go out.
+
+Maintaining a bundle definition file means to keep track of two things:
+dependencies and interactivity. CPAN.pm (currently) does not take into
+account dependencies between distributions, so a bundle definition file
+should specify distributions that depend on others B<after> the others.
+On the other hand, it's a bit 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.
+
+=head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
+
+Thanks to Graham Barr for contributing the firewall following howto.
+
+Firewalls can be categorized into three basic types.
+
+=over
+
+=item http firewall
+
+This is where the firewall machine runs a web server and to access the
+outside world you must do it via the web server. If you set environment
+variables like http_proxy or ftp_proxy to a values beginning with http://
+or in your web browser you have to set proxy information then you know
+you are running a http firewall.
+
+To access servers outside these types of firewalls with perl (even for
+ftp) you will need to use LWP.
+
+=item ftp firewall
+
+This where the firewall machine runs a ftp server. This kind of firewall will
+only let you access ftp serves outside the firewall. This is usually done by
+connecting to the firewall with ftp, then entering a username like
+"user@outside.host.com"
+
+To access servers outside these type of firewalls with perl you
+will need to use Net::FTP.
+
+=item One way visibility
+
+I say one way visibility as these firewalls try to make themselve look
+invisible to the users inside the firewall. An FTP data connection is
+normally created by sending the remote server your IP address and then
+listening for the connection. But the remote server will not be able to
+connect to you because of the firewall. So for these types of firewall
+FTP connections need to be done in a passive mode.
+
+There are two that I can think off.
+
+=over
+
+=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''
+perl. With this executable you will be able to connect to servers outside
+the firewall as if it is not there.
+
+=item IP Masquerade
+
+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.
+
+=back
+
+=back
+
=head1 BUGS
-we should give coverage for _all_ 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/.
+We should give coverage for _all_ 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/.
Future development should be directed towards a better integration of
the other parts.
+If a Makefile.PL requires special customization of libraries, prompts
+the user for special input, etc. then you may find CPAN is not able to
+build the distribution. In that case, you should attempt the
+traditional method of building a Perl module package from a shell.
+
=head1 AUTHOR
-Andreas König E<lt>a.koenig@mind.deE<gt>
+Andreas König E<lt>a.koenig@kulturbox.deE<gt>
=head1 SEE ALSO
diff --git a/gnu/usr.bin/perl/lib/CPAN/FirstTime.pm b/gnu/usr.bin/perl/lib/CPAN/FirstTime.pm
index ae09240c0f3..801304aa19a 100644
--- a/gnu/usr.bin/perl/lib/CPAN/FirstTime.pm
+++ b/gnu/usr.bin/perl/lib/CPAN/FirstTime.pm
@@ -13,9 +13,10 @@ package CPAN::FirstTime;
use strict;
use ExtUtils::MakeMaker qw(prompt);
use FileHandle ();
+use File::Basename ();
use File::Path ();
use vars qw($VERSION);
-$VERSION = substr q$Revision: 1.1 $, 10;
+$VERSION = substr q$Revision: 1.2 $, 10;
=head1 NAME
@@ -36,22 +37,61 @@ file. Nothing special.
sub init {
my($configpm) = @_;
use Config;
- require CPAN::Nox;
+ unless ($CPAN::VERSION) {
+ require CPAN::Nox;
+ }
eval {require CPAN::Config;};
$CPAN::Config ||= {};
local($/) = "\n";
local($\) = "";
+ local($|) = 1;
my($ans,$default,$local,$cont,$url,$expected_size);
-
+
#
# Files, directories
#
+ print qq[
+
+CPAN is the world-wide archive of perl resources. It consists of about
+100 sites that all replicate the same contents all around the globe.
+Many countries have at least one CPAN site already. The resources
+found on CPAN are easily accessible with the CPAN.pm module. If you
+want to use CPAN.pm, you have to configure it properly.
+
+If you do not want to enter a dialog now, you can answer 'no' to this
+question and I\'ll try to autoconfigure. (Note: you can revisit this
+dialog anytime later by typing 'o conf init' at the cpan prompt.)
+
+];
+
+ my $manual_conf =
+ ExtUtils::MakeMaker::prompt("Are you ready for manual configuration?",
+ "yes");
+ my $fastread;
+ {
+ local $^W;
+ if ($manual_conf =~ /^\s*y/i) {
+ $fastread = 0;
+ *prompt = \&ExtUtils::MakeMaker::prompt;
+ } else {
+ $fastread = 1;
+ *prompt = sub {
+ my($q,$a) = @_;
+ my($ret) = defined $a ? $a : "";
+ printf qq{%s [%s]\n\n}, $q, $ret;
+ $ret;
+ };
+ }
+ }
print qq{
-The CPAN module needs a directory of its own to cache important
-index files and maybe keep a temporary mirror of CPAN files. This may
-be a site-wide directory or a personal directory.
+
+The following questions are intended to help you with the
+configuration. The CPAN module needs a directory of its own to cache
+important index files and maybe keep a temporary mirror of CPAN files.
+This may be a site-wide directory or a personal directory.
+
};
my $cpan_home = $CPAN::Config->{cpan_home} || MM->catdir($ENV{HOME}, ".cpan");
@@ -73,16 +113,21 @@ First of all, I\'d like to create this directory. Where?
$default = $cpan_home;
while ($ans = prompt("CPAN build and cache directory?",$default)) {
- File::Path::mkpath($ans); # dies if it can't
- if (-d $ans && -w _) {
- last;
- } else {
- warn "Couldn't find directory $ans
+ eval { File::Path::mkpath($ans); }; # dies if it can't
+ if ($@) {
+ warn "Couldn't create directory $ans.
+Please retry.\n";
+ next;
+ }
+ if (-d $ans && -w _) {
+ last;
+ } else {
+ warn "Couldn't find directory $ans
or directory is not writable. Please retry.\n";
- }
+ }
}
$CPAN::Config->{cpan_home} = $ans;
-
+
print qq{
If you want, I can keep the source files after a build in the cpan
@@ -113,6 +158,42 @@ with all the intermediate files?
# XXX This the time when we refetch the index files (in days)
$CPAN::Config->{'index_expire'} = 1;
+ print qq{
+
+By default, each time the CPAN module is started, cache scanning
+is performed to keep the cache size in sync. To prevent from this,
+disable the cache scanning with 'never'.
+
+};
+
+ $default = $CPAN::Config->{scan_cache} || 'atstart';
+ do {
+ $ans = prompt("Perform cache scanning (atstart or never)?", $default);
+ } while ($ans ne 'atstart' && $ans ne 'never');
+ $CPAN::Config->{scan_cache} = $ans;
+
+ #
+ # prerequisites_policy
+ # Do we follow PREREQ_PM?
+ #
+ print qq{
+
+The CPAN module can detect when a module that which you are trying to
+build depends on prerequisites. If this happens, it can build the
+prerequisites for you automatically ('follow'), ask you for
+confirmation ('ask'), or just ignore them ('ignore'). Please set your
+policy to one of the three values.
+
+};
+
+ $default = $CPAN::Config->{prerequisites_policy} || 'follow';
+ do {
+ $ans =
+ prompt("Policy on building prerequisites (follow, ask or ignore)?",
+ $default);
+ } while ($ans ne 'follow' && $ans ne 'ask' && $ans ne 'ignore');
+ $CPAN::Config->{prerequisites_policy} = $ans;
+
#
# External programs
#
@@ -126,24 +207,46 @@ those.
};
+ my $old_warn = $^W;
+ local $^W if $^O eq 'MacOS';
my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
- my $prog;
- for $prog (qw/gzip tar unzip make lynx ncftp ftp/){
- my $path = $CPAN::Config->{$prog} || "";
- if (MM->file_name_is_absolute($path)) {
- warn "Warning: configured $path does not exist\n" unless -e $path;
- $path = "";
- } else {
- $path = '';
- }
- $path ||= find_exe($prog,[@path]);
- warn "Warning: $prog not found in PATH\n" unless -e $path;
- $ans = prompt("Where is your $prog program?",$path) || $path;
- $CPAN::Config->{$prog} = $ans;
+ local $^W = $old_warn;
+ my $progname;
+ for $progname (qw/gzip tar unzip make lynx ncftpget ncftp ftp/){
+ if ($^O eq 'MacOS') {
+ $CPAN::Config->{$progname} = 'not_here';
+ next;
+ }
+ my $progcall = $progname;
+ # we don't need ncftp if we have ncftpget
+ next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
+ my $path = $CPAN::Config->{$progname}
+ || $Config::Config{$progname}
+ || "";
+ if (MM->file_name_is_absolute($path)) {
+ # testing existence is not good enough, some have these exe
+ # extensions
+
+ # warn "Warning: configured $path does not exist\n" unless -e $path;
+ # $path = "";
+ } else {
+ $path = '';
+ }
+ unless ($path) {
+ # e.g. make -> nmake
+ $progcall = $Config::Config{$progname} if $Config::Config{$progname};
+ }
+
+ $path ||= find_exe($progcall,[@path]);
+ warn "Warning: $progcall not found in PATH\n" unless
+ $path; # not -e $path, because find_exe already checked that
+ $ans = prompt("Where is your $progname program?",$path) || $path;
+ $CPAN::Config->{$progname} = $ans;
}
my $path = $CPAN::Config->{'pager'} ||
$ENV{PAGER} || find_exe("less",[@path]) ||
- find_exe("more",[@path]) || "more";
+ find_exe("more",[@path]) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
+ || "more";
$ans = prompt("What is your favorite pager program?",$path);
$CPAN::Config->{'pager'} = $ans;
$path = $CPAN::Config->{'shell'};
@@ -152,8 +255,13 @@ those.
$path = "";
}
$path ||= $ENV{SHELL};
- $ans = prompt("What is your favorite shell?",$path);
- $CPAN::Config->{'shell'} = $ans;
+ if ($^O eq 'MacOS') {
+ $CPAN::Config->{'shell'} = 'not_here';
+ } else {
+ $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
+ $ans = prompt("What is your favorite shell?",$path);
+ $CPAN::Config->{'shell'} = $ans;
+ }
#
# Arguments to make etc.
@@ -198,53 +306,29 @@ the default and recommended setting.
$default = $CPAN::Config->{inactivity_timeout} || 0;
$CPAN::Config->{inactivity_timeout} =
- prompt("Timeout for inacivity during Makefile.PL?",$default);
+ prompt("Timeout for inactivity during Makefile.PL?",$default);
+ # Proxies
- #
- # MIRRORED.BY
- #
+ print qq{
- $local = 'MIRRORED.BY';
- $local = MM->catfile($CPAN::Config->{keep_source_where},"MIRRORED.BY") unless -f $local;
- if (@{$CPAN::Config->{urllist}||[]}) {
- print qq{
-I found a list of URLs in CPAN::Config and will use this.
-You can change it later with the 'o conf urllist' command.
+If you\'re accessing the net via proxies, you can specify them in the
+CPAN configuration or via environment variables. The variable in
+the \$CPAN::Config takes precedence.
-}
- } elsif (
- -s $local
- &&
- -M $local < 30
- ) {
- read_mirrored_by($local);
- } else {
- $CPAN::Config->{urllist} ||= [];
- while (! @{$CPAN::Config->{urllist}}) {
- my($input) = prompt(qq{
-We need to know the URL of your favorite CPAN site.
-Please enter it here:});
- $input =~ s/\s//g;
- next unless $input;
- my($wanted) = "MIRRORED.BY";
- print qq{
-Testing "$input" ...
-};
- push @{$CPAN::Config->{urllist}}, $input;
- CPAN::FTP->localize($wanted,$local,"force");
- if (-s $local) {
- print qq{
-"$input" seems to work
};
- } else {
- my $ans = prompt(qq{$input doesn\'t seem to work. Keep it in the list?},"n");
- last unless $ans =~ /^n/i;
- pop @{$CPAN::Config->{urllist}};
- }
- }
+
+ for (qw/ftp_proxy http_proxy no_proxy/) {
+ $default = $CPAN::Config->{$_} || $ENV{$_};
+ $CPAN::Config->{$_} = prompt("Your $_?",$default);
}
+ #
+ # MIRRORED.BY
+ #
+
+ conf_sites() unless $fastread;
+
unless (@{$CPAN::Config->{'wait_list'}||[]}) {
print qq{
@@ -258,19 +342,6 @@ you don\'t know a WAIT server near you, just press ENTER.
push @{$CPAN::Config->{'wait_list'}}, $ans;
}
- print qq{
-
-If you\'re accessing the net via proxies, you can specify them in the
-CPAN configuration or via environment variables. The variable in
-the \$CPAN::Config takes precedence.
-
-};
-
- for (qw/ftp_proxy http_proxy no_proxy/) {
- $default = $CPAN::Config->{$_} || $ENV{$_};
- $CPAN::Config->{$_} = prompt("Your $_?",$default);
- }
-
# We don't ask that now, it will be noticed in time, won't it?
$CPAN::Config->{'inhibit_startup_message'} = 0;
$CPAN::Config->{'getcwd'} = 'cwd';
@@ -279,23 +350,72 @@ the \$CPAN::Config takes precedence.
CPAN::Config->commit($configpm);
}
+sub conf_sites {
+ my $m = 'MIRRORED.BY';
+ my $mby = MM->catfile($CPAN::Config->{keep_source_where},$m);
+ File::Path::mkpath(File::Basename::dirname($mby));
+ if (-f $mby && -f $m && -M $m < -M $mby) {
+ require File::Copy;
+ File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
+ }
+ if ( ! -f $mby ){
+ print qq{You have no $mby
+ I\'m trying to fetch one
+};
+ $mby = CPAN::FTP->localize($m,$mby,3);
+ } elsif (-M $mby > 30 ) {
+ print qq{Your $mby is older than 30 days,
+ I\'m trying to fetch one
+};
+ $mby = CPAN::FTP->localize($m,$mby,3);
+ }
+ read_mirrored_by($mby);
+}
+
sub find_exe {
my($exe,$path) = @_;
my($dir);
#warn "in find_exe exe[$exe] path[@$path]";
for $dir (@$path) {
my $abs = MM->catfile($dir,$exe);
- if (MM->maybe_command($abs)) {
+ if (($abs = MM->maybe_command($abs))) {
return $abs;
}
}
}
+sub picklist {
+ my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
+ $default ||= '';
+
+ my ($item, $i);
+ for $item (@$items) {
+ printf "(%d) %s\n", ++$i, $item;
+ }
+
+ my @nums;
+ while (1) {
+ my $num = prompt($prompt,$default);
+ @nums = split (' ', $num);
+ (warn "invalid items entered, try again\n"), next
+ if grep (/\D/ || $_ < 1 || $_ > $i, @nums);
+ if ($require_nonempty) {
+ (warn "$empty_warning\n"), next
+ unless @nums;
+ }
+ last;
+ }
+ print "\n";
+ for (@nums) { $_-- }
+ @{$items}[@nums];
+}
+
sub read_mirrored_by {
my($local) = @_;
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: $!";
+ local $/ = "\012";
while (<$fh>) {
($host) = /^([\w\.\-]+)/ unless defined $host;
next unless defined $host;
@@ -303,6 +423,7 @@ sub read_mirrored_by {
/location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
($continent, $country) = @location[-1,-2];
$continent =~ s/\s\(.*//;
+ $continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude
/dst_dst\s+=\s+\"([^\"]+)/ and $dst = $1;
next unless $host && $dst && $continent && $country;
$all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
@@ -311,92 +432,97 @@ sub read_mirrored_by {
}
$fh->close;
$CPAN::Config->{urllist} ||= [];
- if ($expected_size = @{$CPAN::Config->{urllist}}) {
- for $url (@{$CPAN::Config->{urllist}}) {
- # sanity check, scheme+colon, not "q" there:
- next unless $url =~ /^\w+:\/./;
- $all{"[From previous setup]"}{"found URL"}{$url}=CPAN::Mirrored::By->new('[From previous setup]','found URL',$url);
- }
+ my(@previous_urls);
+ if (@previous_urls = @{$CPAN::Config->{urllist}}) {
$CPAN::Config->{urllist} = [];
- } else {
- $expected_size = 6;
}
-
+
print qq{
-Now we need to know, where your favorite CPAN sites are located. Push
+Now we need to know where your favorite CPAN sites are located. Push
a few sites onto the array (just in case the first on the array won\'t
work). If you are mirroring CPAN to your local workstation, specify a
file: URL.
-You can enter the number in front of the URL on the next screen, a
-file:, ftp: or http: URL, or "q" to finish selecting.
+First, pick a nearby continent and country (you can pick several of
+each, separated by spaces, or none if you just want to keep your
+existing selections). Then, you will be presented with a list of URLs
+of CPAN mirrors in the countries you selected, along with previously
+selected URLs. Select some of those URLs, or just keep the old list.
+Finally, you will be prompted for any extra URLs -- file:, ftp:, or
+http: -- that host a CPAN mirror.
};
- $ans = prompt("Press RETURN to continue");
- my $other;
- $ans = $other = "";
- my(%seen);
-
- my $pipe = -t *STDIN ? "| $CPAN::Config->{'pager'}" : ">/dev/null";
- while () {
- my(@valid,$previous_best);
- my $fh = FileHandle->new;
- $fh->open($pipe);
- {
- my($cont,$country,$url,$item);
- my(@cont) = sort keys %all;
- for $cont (@cont) {
- $fh->print(" $cont\n");
- for $country (sort {lc $a cmp lc $b} keys %{$all{$cont}}) {
- for $url (sort {lc $a cmp lc $b} keys %{$all{$cont}{$country}}) {
- my $t = sprintf(
- " %-18s (%2d) %s\n",
- $country,
- ++$item,
- $url
- );
- if ($cont =~ /^\[/) {
- $previous_best ||= $item;
- }
- push @valid, $all{$cont}{$country}{$url};
- $fh->print($t);
- }
- }
- }
- }
- $fh->close;
- $previous_best ||= 1;
- $default =
- @{$CPAN::Config->{urllist}} >= $expected_size ? "q" : $previous_best;
- $ans = prompt(
- "\nSelect an$other ftp or file URL or a number (q to finish)",
- $default
- );
- my $sel;
- if ($ans =~ /^\d/) {
- my $this = $valid[$ans-1];
- my($con,$cou,$url) = ($this->continent,$this->country,$this->url);
- push @{$CPAN::Config->{urllist}}, $url unless $seen{$url}++;
- delete $all{$con}{$cou}{$url};
- # print "Was a number [$ans] con[$con] cou[$cou] url[$url]\n";
- } elsif (@{$CPAN::Config->{urllist}} && $ans =~ /^q/i) {
- last;
- } else {
- $ans =~ s|/?$|/|; # has to end with one slash
- $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
- if ($ans =~ /^\w+:\/./) {
- push @{$CPAN::Config->{urllist}}, $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 lib/CPAN/Config.pm
-later and report a bug in my Makefile.PL to me (andreas koenig).
-Thanks.\n};
- }
- }
- $other ||= "other";
+ my (@cont, $cont, %cont, @countries, @urls, %seen);
+ my $no_previous_warn =
+ "Sorry! since you don't have any existing picks, you must make a\n" .
+ "geographic selection.";
+ @cont = picklist([sort keys %all],
+ "Select your continent (or several nearby continents)",
+ '',
+ ! @previous_urls,
+ $no_previous_warn);
+
+
+ foreach $cont (@cont) {
+ my @c = sort keys %{$all{$cont}};
+ @cont{@c} = map ($cont, 0..$#c);
+ @c = map ("$_ ($cont)", @c) if @cont > 1;
+ push (@countries, @c);
}
+
+ if (@countries) {
+ @countries = picklist (\@countries,
+ "Select your country (or several nearby countries)",
+ '',
+ ! @previous_urls,
+ $no_previous_warn);
+ %seen = map (($_ => 1), @previous_urls);
+ # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
+ foreach $country (@countries) {
+ (my $bare_country = $country) =~ s/ \(.*\)//;
+ my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}};
+ @u = grep (! $seen{$_}, @u);
+ @u = map ("$_ ($bare_country)", @u)
+ if @countries > 1;
+ push (@urls, @u);
+ }
+ }
+ push (@urls, map ("$_ (previous pick)", @previous_urls));
+ my $prompt = "Select as many URLs as you like";
+ if (@previous_urls) {
+ $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
+ (scalar @urls));
+ $prompt .= "\n(or just hit RETURN to keep your previous picks)";
+ }
+
+ @urls = picklist (\@urls, $prompt, $default);
+ foreach (@urls) { s/ \(.*\)//; }
+ %seen = map (($_ => 1), @urls);
+
+ do {
+ $ans = prompt ("Enter another URL or RETURN to quit:", "");
+
+ if ($ans) {
+ $ans =~ s|/?$|/|; # 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};
+ }
+ }
+ } while $ans;
+
+ push @{$CPAN::Config->{urllist}}, @urls;
+ # xxx delete or comment these out when you're happy that it works
+ print "New set of picks:\n";
+ map { print " $_\n" } @{$CPAN::Config->{urllist}};
}
1;
diff --git a/gnu/usr.bin/perl/lib/CPAN/Nox.pm b/gnu/usr.bin/perl/lib/CPAN/Nox.pm
index 23ad760b87b..e9cb189f297 100644
--- a/gnu/usr.bin/perl/lib/CPAN/Nox.pm
+++ b/gnu/usr.bin/perl/lib/CPAN/Nox.pm
@@ -1,9 +1,13 @@
+package CPAN::Nox;
+
BEGIN{$CPAN::Suppress_readline=1 unless defined $CPAN::term;}
use CPAN;
+$VERSION = "1.00";
$CPAN::META->has_inst('MD5','no');
$CPAN::META->has_inst('LWP','no');
+$CPAN::META->has_inst('Compress::Zlib','no');
@EXPORT = @CPAN::EXPORT;
*AUTOLOAD = \&CPAN::AUTOLOAD;
diff --git a/gnu/usr.bin/perl/lib/Carp.pm b/gnu/usr.bin/perl/lib/Carp.pm
index 685a7933d05..f8f750a5d71 100644
--- a/gnu/usr.bin/perl/lib/Carp.pm
+++ b/gnu/usr.bin/perl/lib/Carp.pm
@@ -35,7 +35,7 @@ and a carp as a cluck across I<all> modules. In other words, force a
detailed stack trace to be given. This can be very helpful when trying
to understand why, or from where, a warning or error is being generated.
-This feature is enabled by 'importing' the non-existant symbol
+This feature is enabled by 'importing' the non-existent symbol
'verbose'. You would typically enable it by saying
perl -MCarp=verbose script.pl
@@ -43,14 +43,30 @@ This feature is enabled by 'importing' the non-existant symbol
or by including the string C<MCarp=verbose> in the L<PERL5OPT>
environment variable.
+=head1 BUGS
+
+The Carp routines don't handle exception objects currently.
+If called with a first argument that is a reference, they simply
+call die() or warn(), as appropriate.
+
=cut
# This package is heavily used. Be small. Be fast. Be good.
+# Comments added by Andy Wardley <abw@kfs.org> 09-Apr-98, based on an
+# _almost_ complete understanding of the package. Corrections and
+# comments are welcome.
+
+# The $CarpLevel variable can be set to "strip off" extra caller levels for
+# those times when Carp calls are buried inside other functions. The
+# $Max(EvalLen|(Arg(Len|Nums)) variables are used to specify how the eval
+# text and function arguments should be formatted when printed.
+
$CarpLevel = 0; # How many extra package levels to skip on carp.
$MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all.
$MaxArgLen = 64; # How much of each argument to print. 0 = all.
$MaxArgNums = 8; # How many arguments to print. 0 = all.
+$Verbose = 0; # If true then make shortmess call longmess instead
require Exporter;
@ISA = ('Exporter');
@@ -58,30 +74,59 @@ require Exporter;
@EXPORT_OK = qw(cluck verbose);
@EXPORT_FAIL = qw(verbose); # hook to enable verbose mode
+
+# if the caller specifies verbose usage ("perl -MCarp=verbose script.pl")
+# then the following method will be called by the Exporter which knows
+# to do this thanks to @EXPORT_FAIL, above. $_[1] will contain the word
+# 'verbose'.
+
sub export_fail {
shift;
- if ($_[0] eq 'verbose') {
- local $^W = 0;
- *shortmess = \&longmess;
- shift;
- }
+ $Verbose = shift if $_[0] eq 'verbose';
return @_;
}
+# longmess() crawls all the way up the stack reporting on all the function
+# calls made. The error string, $error, is originally constructed from the
+# arguments passed into longmess() via confess(), cluck() or shortmess().
+# This gets appended with the stack trace messages which are generated for
+# each function call on the stack.
+
sub longmess {
+ return @_ if ref $_[0];
my $error = join '', @_;
my $mess = "";
my $i = 1 + $CarpLevel;
my ($pack,$file,$line,$sub,$hargs,$eval,$require);
my (@a);
+ #
+ # crawl up the stack....
+ #
while (do { { package DB; @a = caller($i++) } } ) {
- ($pack,$file,$line,$sub,$hargs,undef,$eval,$require) = @a;
+ # get copies of the variables returned from caller()
+ ($pack,$file,$line,$sub,$hargs,undef,$eval,$require) = @a;
+ #
+ # 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
+ # 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
+ # at $file line $line" which now actually reads "called at $file line
+ # $line". Thus, the stack trace message is constructed:
+ #
+ # first time: $mess = $error at $file line $line
+ # subsequent times: $mess .= $sub $error at $file line $line
+ # ^^^^^^
+ # "called"
if ($error =~ m/\n$/) {
$mess .= $error;
} else {
+ # Build a string, $sub, which names the sub-routine called.
+ # This may also be "require ...", "eval '...' or "eval {...}"
if (defined $eval) {
- if ($require) {
+ if ($require) {
$sub = "require $eval";
} else {
$eval =~ s/([\\\'])/\\$1/g;
@@ -93,32 +138,48 @@ sub longmess {
} elsif ($sub eq '(eval)') {
$sub = 'eval {...}';
}
+ # if there are any arguments in the sub-routine call, format
+ # them according to the format variables defined earlier in
+ # this file and join them onto the $sub sub-routine string
if ($hargs) {
- @a = @DB::args; # must get local copy of args
- if ($MaxArgNums and @a > $MaxArgNums) {
- $#a = $MaxArgNums;
- $a[$#a] = "...";
- }
- for (@a) {
- $_ = "undef", next unless defined $_;
- if (ref $_) {
- $_ .= '';
- s/'/\\'/g;
+ # we may trash some of the args so we take a copy
+ @a = @DB::args; # must get local copy of args
+ # don't print any more than $MaxArgNums
+ if ($MaxArgNums and @a > $MaxArgNums) {
+ # cap the length of $#a and set the last element to '...'
+ $#a = $MaxArgNums;
+ $a[$#a] = "...";
}
- else {
- s/'/\\'/g;
- substr($_,$MaxArgLen) = '...'
- if $MaxArgLen and $MaxArgLen < length;
+ for (@a) {
+ # set args to the string "undef" if undefined
+ $_ = "undef", next unless defined $_;
+ if (ref $_) {
+ # dunno what this is for...
+ $_ .= '';
+ s/'/\\'/g;
+ }
+ else {
+ s/'/\\'/g;
+ # terminate the string early with '...' if too long
+ substr($_,$MaxArgLen) = '...'
+ if $MaxArgLen and $MaxArgLen < length;
+ }
+ # 'quote' arg unless it looks like a number
+ $_ = "'$_'" unless /^-?[\d.]+$/;
+ # print high-end chars as 'M-<char>' or '^<char>'
+ s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+ s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
}
- $_ = "'$_'" unless /^-?[\d.]+$/;
- s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
- s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
- }
- $sub .= '(' . join(', ', @a) . ')';
+ # append ('all', 'the', 'arguments') to the $sub string
+ $sub .= '(' . join(', ', @a) . ')';
}
+ # here's where the error message, $mess, gets constructed
$mess .= "\t$sub " if $error eq "called";
$mess .= "$error at $file line $line\n";
}
+ # we don't need to print the actual error message again so we can
+ # change this to "called" so that the string "$error at $file line
+ # $line" makes sense as "called at $file line $line".
$error = "called";
}
# this kludge circumvents die's incorrect handling of NUL
@@ -127,36 +188,72 @@ sub longmess {
$$msg;
}
+
+# shortmess() is called by carp() and croak() to skip all the way up to
+# the top-level caller's package and report the error from there. confess()
+# and cluck() generate a full stack trace so they call longmess() to
+# generate that. In verbose mode shortmess() calls longmess() so
+# you always get a stack trace
+
sub shortmess { # Short-circuit &longmess if called via multiple packages
+ goto &longmess if $Verbose;
+ return @_ if ref $_[0];
my $error = join '', @_;
my ($prevpack) = caller(1);
my $extra = $CarpLevel;
my $i = 2;
my ($pack,$file,$line);
+ # when reporting an error, we want to report it from the context of the
+ # calling package. So what is the calling package? Within a module,
+ # there may be many calls between methods and perhaps between sub-classes
+ # and super-classes, but the user isn't interested in what happens
+ # inside the package. We start by building a hash array which keeps
+ # track of all the packages to which the calling package belongs. We
+ # do this by examining its @ISA variable. Any call from a base class
+ # method (one of our caller's @ISA packages) can be ignored
my %isa = ($prevpack,1);
+ # merge all the caller's @ISA packages into %isa.
@isa{@{"${prevpack}::ISA"}} = ()
if(defined @{"${prevpack}::ISA"});
+ # now we crawl up the calling stack and look at all the packages in
+ # there. For each package, we look to see if it has an @ISA and then
+ # we see if our caller features in that list. That would imply that
+ # our caller is a derived class of that package and its calls can also
+ # be ignored
while (($pack,$file,$line) = caller($i++)) {
if(defined @{$pack . "::ISA"}) {
my @i = @{$pack . "::ISA"};
my %i;
@i{@i} = ();
+ # merge any relevant packages into %isa
@isa{@i,$pack} = ()
if(exists $i{$prevpack} || exists $isa{$pack});
}
+ # and here's where we do the ignoring... if the package in
+ # question is one of our caller's base or derived packages then
+ # we can ignore it (skip it) and go onto the next (but note that
+ # the continue { } block below gets called every time)
next
if(exists $isa{$pack});
+ # Hey! We've found a package that isn't one of our caller's
+ # clan....but wait, $extra refers to the number of 'extra' levels
+ # we should skip up. If $extra > 0 then this is a false alarm.
+ # We must merge the package into the %isa hash (so we can ignore it
+ # if it pops up again), decrement $extra, and continue.
if ($extra-- > 0) {
%isa = ($pack,1);
@isa{@{$pack . "::ISA"}} = ()
if(defined @{$pack . "::ISA"});
}
else {
- # this kludge circumvents die's incorrect handling of NUL
+ # 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.
(my $msg = "$error at $file line $line\n") =~ tr/\0//d;
return $msg;
}
@@ -165,12 +262,23 @@ sub shortmess { # Short-circuit &longmess if called via multiple packages
$prevpack = $pack;
}
+ # uh-oh! It looks like we crawled all the way up the stack and
+ # never found a candidate package. Oh well, let's call longmess
+ # to generate a full stack trace. We use the magical form of 'goto'
+ # so that this shortmess() function doesn't appear on the stack
+ # to further confuse longmess() about it's calling package.
goto &longmess;
}
-sub confess { die longmess @_; }
-sub croak { die shortmess @_; }
-sub carp { warn shortmess @_; }
-sub cluck { warn longmess @_; }
+
+# the following four functions call longmess() or shortmess() depending on
+# whether they should generate a full stack trace (confess() and cluck())
+# or simply report the caller's package (croak() and carp()), respectively.
+# confess() and croak() die, carp() and cluck() warn.
+
+sub croak { die shortmess @_ }
+sub confess { die longmess @_ }
+sub carp { warn shortmess @_ }
+sub cluck { warn longmess @_ }
1;
diff --git a/gnu/usr.bin/perl/lib/Class/Struct.pm b/gnu/usr.bin/perl/lib/Class/Struct.pm
index 09ab196254e..8fddfbf68ef 100644
--- a/gnu/usr.bin/perl/lib/Class/Struct.pm
+++ b/gnu/usr.bin/perl/lib/Class/Struct.pm
@@ -40,6 +40,11 @@ sub printem {
$self->[$index];
}
+ sub FETCHSIZE {
+ my $self = shift;
+ return scalar(@$self);
+ }
+
sub DESTROY { }
}
@@ -180,7 +185,7 @@ sub struct {
}
elsif( defined $classes{$name} ){
if ( $CHECK_CLASS_MEMBERSHIP ) {
- $out .= " croak '$name argument is wrong class' if \@_ && ! UNIVERSAL::isa(\$_[0], '$type');\n";
+ $out .= " croak '$name argument is wrong class' if \@_ && ! UNIVERSAL::isa(\$_[0], '$classes{$name}');\n";
}
}
$out .= " croak 'Too many args to $name' if \@_ > 1;\n";
diff --git a/gnu/usr.bin/perl/lib/Cwd.pm b/gnu/usr.bin/perl/lib/Cwd.pm
index 3bd0085c730..5c10e8e1686 100644
--- a/gnu/usr.bin/perl/lib/Cwd.pm
+++ b/gnu/usr.bin/perl/lib/Cwd.pm
@@ -20,11 +20,21 @@ getcwd - get pathname of current working directory
chdir "/tmp";
print $ENV{'PWD'};
+ use Cwd 'abs_path';
+ print abs_path($ENV{'PWD'});
+
+ use Cwd 'fast_abs_path';
+ print fast_abs_path($ENV{'PWD'});
+
=head1 DESCRIPTION
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("."))
+
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
@@ -35,6 +45,9 @@ that it leaves you in the same directory that it started in. If it has
changed it will C<die> 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 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
@@ -54,7 +67,7 @@ kept up to date if all packages which use chdir import it from Cwd.
use Carp;
-$VERSION = '2.00';
+$VERSION = '2.01';
require Exporter;
@ISA = qw(Exporter);
@@ -82,66 +95,9 @@ sub _backtick_pwd {
sub getcwd
{
- my($dotdots, $cwd, @pst, @cst, $dir, @tst);
-
- unless (@cst = stat('.'))
- {
- warn "stat(.): $!";
- return '';
- }
- $cwd = '';
- $dotdots = '';
- do
- {
- $dotdots .= '/' if $dotdots;
- $dotdots .= '..';
- @pst = @cst;
- unless (opendir(PARENT, $dotdots))
- {
- warn "opendir($dotdots): $!";
- return '';
- }
- unless (@cst = stat($dotdots))
- {
- warn "stat($dotdots): $!";
- closedir(PARENT);
- return '';
- }
- if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
- {
- $dir = undef;
- }
- else
- {
- do
- {
- unless (defined ($dir = readdir(PARENT)))
- {
- warn "readdir($dotdots): $!";
- closedir(PARENT);
- return '';
- }
- unless (@tst = lstat("$dotdots/$dir"))
- {
- # warn "lstat($dotdots/$dir): $!";
- # Just because you can't lstat this directory
- # doesn't mean you'll never find the right one.
- # closedir(PARENT);
- # return '';
- }
- }
- while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
- $tst[1] != $pst[1]);
- }
- $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
- closedir(PARENT);
- } while (defined $dir);
- chop($cwd) unless $cwd eq '/'; # drop the trailing /
- $cwd;
+ abs_path('.');
}
-
-
# By John Bazik
#
# Usage: $cwd = &fastcwd;
@@ -162,7 +118,7 @@ sub fastcwd {
for (;;) {
my $direntry;
($odev, $oino) = ($cdev, $cino);
- chdir('..') || return undef;
+ CORE::chdir('..') || return undef;
($cdev, $cino) = stat('.');
last if $odev == $cdev && $oino == $cino;
opendir(DIR, '.') || return undef;
@@ -183,7 +139,7 @@ sub fastcwd {
# At this point $path may be tainted (if tainting) and chdir would fail.
# To be more useful we untaint it then check that we landed where we started.
$path = $1 if $path =~ /^(.*)$/; # untaint
- chdir($path) || return undef;
+ CORE::chdir($path) || return undef;
($cdev, $cino) = stat('.');
die "Unstable directory path, current directory changed unexpectedly"
if $cdev != $orig_cdev || $cino != $orig_cino;
@@ -199,7 +155,7 @@ sub fastcwd {
my $chdir_init = 0;
sub chdir_init {
- if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'msdos') {
+ if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos') {
my($dd,$di) = stat('.');
my($pd,$pi) = stat($ENV{'PWD'});
if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
@@ -249,7 +205,7 @@ sub chdir {
sub abs_path
{
- my $start = shift || '.';
+ my $start = @_ ? shift : '.';
my($dotdots, $cwd, @pst, @cst, $dir, @tst);
unless (@cst = stat( $start ))
@@ -276,7 +232,7 @@ sub abs_path
}
if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
{
- $dir = '';
+ $dir = undef;
}
else
{
@@ -293,19 +249,19 @@ sub abs_path
while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
$tst[1] != $pst[1]);
}
- $cwd = "$dir/$cwd";
+ $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
closedir(PARENT);
- } while ($dir);
- chop($cwd); # drop the trailing /
+ } while (defined $dir);
+ chop($cwd) unless $cwd eq '/'; # drop the trailing /
$cwd;
}
sub fast_abs_path {
my $cwd = getcwd();
my $path = shift || '.';
- chdir($path) || croak "Cannot chdir to $path:$!";
+ CORE::chdir($path) || croak "Cannot chdir to $path:$!";
my $realpath = getcwd();
- chdir($cwd) || croak "Cannot chdir back to $cwd:$!";
+ CORE::chdir($cwd) || croak "Cannot chdir back to $cwd:$!";
$realpath;
}
@@ -313,7 +269,7 @@ sub fast_abs_path {
# --- PORTING SECTION ---
# VMS: $ENV{'DEFAULT'} points to default directory at all times
-# 06-Mar-1996 Charles Bailey bailey@genetics.upenn.edu
+# 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
# in the process logical name table as the default device and directory
# seen by Perl. This may not be the same as the default device
@@ -339,23 +295,40 @@ sub _os2_cwd {
}
sub _win32_cwd {
- $ENV{'PWD'} = Win32::GetCurrentDirectory();
+ $ENV{'PWD'} = Win32::GetCwd();
$ENV{'PWD'} =~ s:\\:/:g ;
return $ENV{'PWD'};
}
*_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd &&
- defined &Win32::GetCurrentDirectory);
+ defined &Win32::GetCwd);
*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
-sub _msdos_cwd {
- $ENV{'PWD'} = `command /c cd`;
+sub _dos_cwd {
+ if (!defined &Dos::GetCwd) {
+ $ENV{'PWD'} = `command /c cd`;
+ chop $ENV{'PWD'};
+ $ENV{'PWD'} =~ s:\\:/:g ;
+ } else {
+ $ENV{'PWD'} = Dos::GetCwd();
+ }
+ return $ENV{'PWD'};
+}
+
+sub _qnx_cwd {
+ $ENV{'PWD'} = `/usr/bin/fullpath -t`;
chop $ENV{'PWD'};
- $ENV{'PWD'} =~ s:\\:/:g ;
return $ENV{'PWD'};
}
+sub _qnx_abs_path {
+ my $path = shift || '.';
+ my $realpath=`/usr/bin/fullpath -t $path`;
+ chop $realpath;
+ return $realpath;
+}
+
{
local $^W = 0; # assignments trigger 'subroutine redefined' warning
@@ -383,13 +356,21 @@ sub _msdos_cwd {
*fastcwd = \&cwd;
*abs_path = \&fast_abs_path;
}
- elsif ($^O eq 'msdos') {
- *cwd = \&_msdos_cwd;
- *getcwd = \&_msdos_cwd;
- *fastgetcwd = \&_msdos_cwd;
- *fastcwd = \&_msdos_cwd;
+ elsif ($^O eq 'dos') {
+ *cwd = \&_dos_cwd;
+ *getcwd = \&_dos_cwd;
+ *fastgetcwd = \&_dos_cwd;
+ *fastcwd = \&_dos_cwd;
*abs_path = \&fast_abs_path;
}
+ elsif ($^O eq 'qnx') {
+ *cwd = \&_qnx_cwd;
+ *getcwd = \&_qnx_cwd;
+ *fastgetcwd = \&_qnx_cwd;
+ *fastcwd = \&_qnx_cwd;
+ *abs_path = \&_qnx_abs_path;
+ *fast_abs_path = \&_qnx_abs_path;
+ }
}
# package main; eval join('',<DATA>) || die $@; # quick test
diff --git a/gnu/usr.bin/perl/lib/English.pm b/gnu/usr.bin/perl/lib/English.pm
index bbb6bd7b280..9f29a487dc7 100644
--- a/gnu/usr.bin/perl/lib/English.pm
+++ b/gnu/usr.bin/perl/lib/English.pm
@@ -15,6 +15,14 @@ English - use nice English (or awk) names for ugly punctuation variables
=head1 DESCRIPTION
+You should I<not> use this module in programs intended to be portable
+among Perl versions, programs that must perform regular expression
+matching operations efficiently, or libraries intended for use with
+such programs. In a sense, this module is deprecated. The reasons
+for this have to do with implementation details of the Perl
+interpreter which are too thorny to go into here. Perhaps someday
+they will be fixed to make "C<use English>" more practical.
+
This module provides aliases for the built-in variables whose
names no one seems to like to read. Variables with side-effects
which get triggered just by accessing them (like $0) will still
@@ -160,6 +168,7 @@ sub import {
*PERL_VERSION = *] ;
*ACCUMULATOR = *^A ;
+ *COMPILING = *^C ;
*DEBUGGING = *^D ;
*SYSTEM_FD_MAX = *^F ;
*INPLACE_EDIT = *^I ;
diff --git a/gnu/usr.bin/perl/lib/Env.pm b/gnu/usr.bin/perl/lib/Env.pm
index f2fe4af422e..b0afc3b2dbf 100644
--- a/gnu/usr.bin/perl/lib/Env.pm
+++ b/gnu/usr.bin/perl/lib/Env.pm
@@ -45,14 +45,14 @@ Chip Salzenberg E<lt>F<chip@fin.uucp>E<gt>
sub import {
my ($callpack) = caller(0);
my $pack = shift;
- my @vars = @_ ? @_ : keys(%ENV);
+ my @vars = grep /^[A-Za-z_]\w*$/, (@_ ? @_ : keys(%ENV));
return unless @vars;
eval "package $callpack; use vars qw("
. join(' ', map { '$'.$_ } @vars) . ")";
die $@ if $@;
foreach (@vars) {
- tie ${"${callpack}::$_"}, Env, $_ if /^[A-Za-z_]\w*$/;
+ tie ${"${callpack}::$_"}, Env, $_;
}
}
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Command.pm b/gnu/usr.bin/perl/lib/ExtUtils/Command.pm
index d37d0f3c25e..e900e51ffa4 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/Command.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Command.pm
@@ -31,8 +31,8 @@ ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc.
=head1 DESCRIPTION
-The module is used in Win32 port to replace common UNIX commands.
-Most commands are wrapers on generic modules File::Path and File::Basename.
+The module is used in the Win32 port to replace common UNIX commands.
+Most commands are wrappers on generic modules File::Path and File::Basename.
=over 4
@@ -107,11 +107,13 @@ Makes files exist, with current timestamp
sub touch
{
expand_wildcards();
+ my $t = time;
while (@ARGV)
{
my $file = shift(@ARGV);
open(FILE,">>$file") || die "Cannot write $file:$!";
close(FILE);
+ utime($t,$t,$file);
}
}
@@ -187,6 +189,7 @@ sub test_f
exit !-f shift(@ARGV);
}
+
1;
__END__
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Embed.pm b/gnu/usr.bin/perl/lib/ExtUtils/Embed.pm
index 04ce1763da7..4b56e88b260 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/Embed.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Embed.pm
@@ -43,10 +43,15 @@ sub my_return {
}
}
+sub is_perl_object {
+ $Config{ccflags} =~ /-DPERL_OBJECT/;
+}
+
sub xsinit {
my($file, $std, $mods) = @_;
my($fh,@mods,%seen);
$file ||= "perlxsi.c";
+ my $xsinit_proto = is_perl_object() ? "CPERLarg" : "void";
if (@_) {
@mods = @$mods if $mods;
@@ -70,10 +75,10 @@ sub xsinit {
@mods = grep(!$seen{$_}++, @mods);
print $fh &xsi_header();
- print $fh "EXTERN_C void xs_init _((void));\n\n";
+ print $fh "EXTERN_C void xs_init _(($xsinit_proto));\n\n";
print $fh &xsi_protos(@mods);
- print $fh "\nEXTERN_C void\nxs_init()\n{\n";
+ print $fh "\nEXTERN_C void\nxs_init($xsinit_proto)\n{\n";
print $fh &xsi_body(@mods);
print $fh "}\n";
@@ -81,14 +86,24 @@ sub xsinit {
sub xsi_header {
return <<EOF;
-#ifdef __cplusplus
+#if defined(__cplusplus) && !defined(PERL_OBJECT)
+#define is_cplusplus
+#endif
+
+#ifdef is_cplusplus
extern "C" {
#endif
#include <EXTERN.h>
#include <perl.h>
-
-#ifdef __cplusplus
+#ifdef PERL_OBJECT
+#define NO_XSLOCKS
+#include <XSUB.h>
+#include "win32iop.h"
+#include <fcntl.h>
+#include <perlhost.h>
+#endif
+#ifdef is_cplusplus
}
# ifndef EXTERN_C
# define EXTERN_C extern "C"
@@ -105,13 +120,14 @@ EOF
sub xsi_protos {
my(@exts) = @_;
my(@retval,%seen);
-
+ my $boot_proto = is_perl_object() ?
+ "CV* cv _CPERLarg" : "CV* cv";
foreach $_ (@exts){
my($pname) = canon('/', $_);
my($mname, $cname);
($mname = $pname) =~ s!/!::!g;
($cname = $pname) =~ s!/!__!g;
- my($ccode) = "EXTERN_C void boot_${cname} _((CV* cv));\n";
+ my($ccode) = "EXTERN_C void boot_${cname} _(($boot_proto));\n";
next if $seen{$ccode}++;
push(@retval, $ccode);
}
@@ -185,7 +201,7 @@ sub ldopts {
my($mod,@ns,$root,$sub,$extra,$archive,@archives);
print STDERR "Searching (@path) for archives\n" if $Verbose;
foreach $mod (@mods) {
- @ns = split('::', $mod);
+ @ns = split(/::|\/|\\/, $mod);
$sub = $ns[-1];
$root = $MM->catdir(@ns);
@@ -400,7 +416,7 @@ This will print arguments for linking with B<libperl.a>, B<DynaLoader> and
extensions found in B<$Config{static_ext}>. This includes libraries
found in B<$Config{libs}> and the first ModuleName.a library
for each extension that is found by searching B<@INC> or the path
-specifed by the B<-I> option.
+specified by the B<-I> option.
In addition, when ModuleName.a is found, additional linker arguments
are picked up from the B<extralibs.ld> file in the same directory.
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Install.pm b/gnu/usr.bin/perl/lib/ExtUtils/Install.pm
index 2c1dd8ae341..a11c445ad73 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/Install.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Install.pm
@@ -1,7 +1,7 @@
package ExtUtils::Install;
-$VERSION = substr q$Revision: 1.2 $, 10;
-# $Date: 1997/11/30 07:57:24 $
+$VERSION = substr q$Revision: 1.3 $, 10;
+# $Date: 1999/04/29 22:51:50 $
use Exporter;
use Carp ();
@@ -11,7 +11,7 @@ use vars qw(@ISA @EXPORT $VERSION);
@EXPORT = ('install','uninstall','pm_to_blib', 'install_default');
$Is_VMS = $^O eq 'VMS';
-my $splitchar = $^O eq 'VMS' ? '|' : $^O eq 'os2' ? ';' : ':';
+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;
@@ -30,6 +30,7 @@ sub install {
use Cwd qw(cwd);
use ExtUtils::MakeMaker; # to implement a MY class
+ use ExtUtils::Packlist;
use File::Basename qw(dirname);
use File::Copy qw(copy);
use File::Find qw(find);
@@ -37,10 +38,11 @@ sub install {
use File::Compare qw(compare);
my(%hash) = %$hash;
- my(%pack, %write, $dir, $warn_permissions);
+ my(%pack, $dir, $warn_permissions);
+ my($packlist) = ExtUtils::Packlist->new();
# -w doesn't work reliably on FAT dirs
$warn_permissions++ if $^O eq 'MSWin32';
- local(*DIR, *P);
+ local(*DIR);
for (qw/read write/) {
$pack{$_}=$hash{$_};
delete $hash{$_};
@@ -52,32 +54,21 @@ 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})) {
+ if (-w $hash{$source_dir_or_file} ||
+ mkpath($hash{$source_dir_or_file})) {
last;
} else {
- warn "Warning: You do not have permissions to install into $hash{$source_dir_or_file}"
+ warn "Warning: You do not have permissions to " .
+ "install into $hash{$source_dir_or_file}"
unless $warn_permissions++;
}
}
closedir DIR;
}
- if (-f $pack{"read"}) {
- open P, $pack{"read"} or Carp::croak("Couldn't read $pack{'read'}");
- # Remember what you found
- while (<P>) {
- chomp;
- $write{$_}++;
- }
- close P;
- }
+ $packlist->read($pack{"read"}) if (-f $pack{"read"});
my $cwd = cwd();
my $umask = umask 0 unless $Is_VMS;
- # This silly reference is just here to be able to call MY->catdir
- # without a warning (Waiting for a proper path/directory module,
- # Charles!)
- my $MY = {};
- bless $MY, 'MY';
my($source);
MOD_INSTALL: foreach $source (sort keys %hash) {
#copy the tree to the target directory without altering
@@ -85,14 +76,27 @@ sub install {
#file. The packlist file contains the absolute paths of the
#install locations. AFS users may call this a bug. We'll have
#to reconsider how to add the means to satisfy AFS users also.
+
+ #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};
+ if ($source eq "blib/lib" and
+ exists $hash{"blib/arch"} and
+ directory_not_empty("blib/arch")) {
+ $targetroot = $hash{"blib/arch"};
+ print "Files found in blib/arch --> Installing files in "
+ . "blib/lib into architecture dependend library tree!\n"
+ ; #if $verbose>1;
+ }
chdir($source) or next;
find(sub {
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks) = stat;
return unless -f _;
return if $_ eq ".exists";
- my $targetdir = $MY->catdir($hash{$source},$File::Find::dir);
- my $targetfile = $MY->catfile($targetdir,$_);
+ my $targetdir = MY->catdir($targetroot,$File::Find::dir);
+ my $targetfile = MY->catfile($targetdir,$_);
my $diff = 0;
if ( -f $targetfile && -s _ == $size) {
@@ -127,7 +131,7 @@ sub install {
} else {
inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0
}
- $write{$targetfile}++;
+ $packlist->{$targetfile}++;
}, ".");
chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
@@ -137,14 +141,23 @@ sub install {
$dir = dirname($pack{'write'});
mkpath($dir,0,0755);
print "Writing $pack{'write'}\n";
- open P, ">$pack{'write'}" or Carp::croak("Couldn't write $pack{'write'}: $!");
- for (sort keys %write) {
- print P "$_\n";
- }
- close P;
+ $packlist->write($pack{'write'});
}
}
+sub directory_not_empty ($) {
+ my($dir) = @_;
+ my $files = 0;
+ find(sub {
+ return if $_ eq ".exists";
+ if (-f) {
+ $File::Find::prune++;
+ $files = 1;
+ }
+ }, $dir);
+ return $files;
+}
+
sub install_default {
@_ < 2 or die "install_default should be called with 0 or 1 argument";
my $FULLEXT = @_ ? shift : $ARGV[0];
@@ -158,7 +171,9 @@ sub install_default {
install({
read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
- $INST_LIB => $Config{installsitelib},
+ $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
+ $Config{installsitearch} :
+ $Config{installsitelib},
$INST_ARCHLIB => $Config{installsitearch},
$INST_BIN => $Config{installbin} ,
$INST_SCRIPT => $Config{installscript},
@@ -168,31 +183,33 @@ sub install_default {
}
sub uninstall {
+ use ExtUtils::Packlist;
my($fil,$verbose,$nonono) = @_;
die "no packlist file found: $fil" unless -f $fil;
# my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
# require $my_req; # Hairy, but for the first
- local *P;
- open P, $fil or Carp::croak("uninstall: Could not read packlist file $fil: $!");
- while (<P>) {
+ my ($packlist) = ExtUtils::Packlist->new($fil);
+ foreach (sort(keys(%$packlist))) {
chomp;
print "unlink $_\n" if $verbose;
forceunlink($_) unless $nonono;
}
print "unlink $fil\n" if $verbose;
+ close P;
forceunlink($fil) unless $nonono;
}
sub inc_uninstall {
my($file,$libdir,$verbose,$nonono) = @_;
my($dir);
- my $MY = {};
- bless $MY, 'MY';
my %seen_dir = ();
- foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw/archlibexp privlibexp sitearchexp sitelibexp/}) {
+ foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp
+ privlibexp
+ sitearchexp
+ sitelibexp)}) {
next if $dir eq ".";
next if $seen_dir{$dir}++;
- my($targetfile) = $MY->catfile($dir,$libdir,$file);
+ my($targetfile) = MY->catfile($dir,$libdir,$file);
next unless -f $targetfile;
# The reason why we compare file's contents is, that we cannot
@@ -337,7 +354,7 @@ The argument is the value of MakeMaker's C<FULLEXT> key, like F<Tk/Canvas>.
This function calls install() with the same arguments as the defaults
the MakeMaker would use.
-The argumement-less form is convenient for install scripts like
+The argument-less form is convenient for install scripts like
perl -MExtUtils::Install -e install_default Tk/Canvas
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Liblist.pm b/gnu/usr.bin/perl/lib/ExtUtils/Liblist.pm
index 5b4d6abecb4..be7aed7b9bb 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/Liblist.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Liblist.pm
@@ -2,7 +2,7 @@ package ExtUtils::Liblist;
use vars qw($VERSION);
# Broken out of MakeMaker from version 4.11
-$VERSION = substr q$Revision: 1.2 $, 10;
+$VERSION = substr q$Revision: 1.3 $, 10;
use Config;
use Cwd 'cwd';
@@ -182,16 +182,23 @@ sub _unix_os2_ext {
}
sub _win32_ext {
+
+ require Text::ParseWords;
+
my($self, $potential_libs, $verbose) = @_;
# If user did not supply a list, we punt.
# (caller should probably use the list in $Config{libs})
return ("", "", "", "") unless $potential_libs;
- my($so) = $Config{'so'};
- my($libs) = $Config{'libs'};
- my($libpth) = $Config{'libpth'};
- my($libext) = $Config{'lib_ext'} || ".lib";
+ 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 $libpth = $Config{'libpth'};
+ my $libext = $Config{'lib_ext'} || ".lib";
if ($libs and $potential_libs !~ /:nodefault/i) {
# If Config.pm defines a set of default libs, we always
@@ -203,55 +210,120 @@ sub _win32_ext {
}
warn "Potential libraries are '$potential_libs':\n" if $verbose;
+ # normalize to forward slashes
+ $libpth =~ s,\\,/,g;
+ $potential_libs =~ s,\\,/,g;
+
# compute $extralibs from $potential_libs
- my(@searchpath); # from "-L/path" entries in $potential_libs
- my(@libpath) = split " ", $libpth;
- my(@extralibs);
+ my @searchpath; # from "-L/path" in $potential_libs
+ my @libpath = Text::ParseWords::quotewords('\s+', 0, $libpth);
+ my @extralibs;
+ my $pwd = cwd(); # from Cwd.pm
+ my $lib = '';
+ my $found = 0;
+ my $search = 1;
my($fullname, $thislib, $thispth);
- my($pwd) = cwd(); # from Cwd.pm
- my($lib) = '';
- my($found) = 0;
- foreach $thislib (split ' ', $potential_libs){
+ # add "$Config{installarchlib}/CORE" to default search path
+ push @libpath, "$Config{installarchlib}/CORE";
- # Handle possible linker path arguments.
- if ($thislib =~ s/^-L// and not -d $thislib) {
- warn "-L$thislib ignored, directory does not exist\n"
+ foreach (Text::ParseWords::quotewords('\s+', 0, $potential_libs)){
+
+ $thislib = $_;
+
+ # see if entry is a flag
+ if (/^:\w+$/) {
+ $search = 0 if lc eq ':nosearch';
+ $search = 1 if lc eq ':search';
+ warn "Ignoring unknown flag '$thislib'\n"
+ if $verbose and !/^:(no)?(search|default)$/i;
+ next;
+ }
+
+ # if searching is disabled, do compiler-specific translations
+ unless ($search) {
+ s/^-l(.+)$/$1.lib/ unless $GC;
+ s/^-L/-libpath:/ if $VC;
+ push(@extralibs, $_);
+ $found++;
+ next;
+ }
+
+ # handle possible linker path arguments
+ if (s/^-L// and not -d) {
+ warn "$thislib ignored, directory does not exist\n"
if $verbose;
next;
}
- elsif (-d $thislib) {
- unless ($self->file_name_is_absolute($thislib)) {
- warn "Warning: -L$thislib changed to -L$pwd/$thislib\n";
- $thislib = $self->catdir($pwd,$thislib);
+ elsif (-d) {
+ unless ($self->file_name_is_absolute($_)) {
+ warn "Warning: '$thislib' changed to '-L$pwd/$_'\n";
+ $_ = $self->catdir($pwd,$_);
}
- push(@searchpath, $thislib);
+ push(@searchpath, $_);
next;
}
- # Handle possible library arguments.
- $thislib =~ s/^-l//;
- $thislib .= $libext if $thislib !~ /\Q$libext\E$/i;
+ # handle possible library arguments
+ if (s/^-l// and $GC and !/^lib/i) {
+ $_ = "lib$_";
+ }
+ $_ .= $libext if !/\Q$libext\E$/i;
- my($found_lib)=0;
+ my $secondpass = 0;
+ LOOKAGAIN:
+
+ # look for the file itself
+ if (-f) {
+ warn "'$thislib' found as '$_'\n" if $verbose;
+ $found++;
+ push(@extralibs, $_);
+ next;
+ }
+
+ my $found_lib = 0;
foreach $thispth (@searchpath, @libpath){
- unless (-f ($fullname="$thispth\\$thislib")) {
- warn "$thislib not found in $thispth\n" if $verbose;
+ unless (-f ($fullname="$thispth\\$_")) {
+ warn "'$thislib' not found as '$fullname'\n" if $verbose;
next;
}
- warn "'$thislib' found at $fullname\n" if $verbose;
+ warn "'$thislib' found as '$fullname'\n" if $verbose;
$found++;
$found_lib++;
push(@extralibs, $fullname);
last;
}
+
+ # do another pass with (or without) leading 'lib' if they used -l
+ if (!$found_lib and $thislib =~ /^-l/ and !$secondpass++) {
+ if ($GC) {
+ goto LOOKAGAIN if s/^lib//i;
+ }
+ elsif (!/^lib/i) {
+ $_ = "lib$_";
+ goto LOOKAGAIN;
+ }
+ }
+
+ # give up
warn "Note (probably harmless): "
."No library found for '$thislib'\n"
unless $found_lib>0;
+
}
+
return ('','','','') unless $found;
+
+ # make sure paths with spaces are properly quoted
+ @extralibs = map { (/\s/ && !/^".*"$/) ? qq["$_"] : $_ } @extralibs;
$lib = join(' ',@extralibs);
+
+ # normalize back to backward slashes (to help braindead tools)
+ # XXX this may break equally braindead GNU tools that don't understand
+ # backslashes, either. Seems like one can't win here. Cursed be CP/M.
+ $lib =~ s,/,\\,g;
+
warn "Result: $lib\n" if $verbose;
wantarray ? ($lib, '', $lib, '') : $lib;
}
@@ -259,9 +331,38 @@ sub _win32_ext {
sub _vms_ext {
my($self, $potential_libs,$verbose) = @_;
- return ('', '', '', '') unless $potential_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{'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
+ # a library spec could be resolved via a logical name, we go to some trouble
+ # to insure that the copy in the local tree is used, rather than one to
+ # which a system-wide logical may point.
+ if ($self->{PERL_SRC}) {
+ my($lib,$locspec,$type);
+ foreach $lib (@crtls) {
+ if (($locspec,$type) = $lib =~ m-^([\w$\-]+)(/\w+)?- and $locspec =~ /perl/i) {
+ if (lc $type eq '/share') { $locspec .= $Config{'exe_ext'}; }
+ elsif (lc $type eq '/library') { $locspec .= $Config{'lib_ext'}; }
+ else { $locspec .= $Config{'obj_ext'}; }
+ $locspec = $self->catfile($self->{PERL_SRC},$locspec);
+ $lib = "$locspec$type" if -e $locspec;
+ }
+ }
+ }
+ $crtlstr = @crtls ? join(' ',@crtls) : '';
- my(@dirs,@libs,$dir,$lib,%sh,%olb,%obj);
+ unless ($potential_libs) {
+ warn "Result:\n\tEXTRALIBS: \n\tLDLOADLIBS: $crtlstr\n" if $verbose;
+ return ('', '', $crtlstr, '');
+ }
+
+ my(@dirs,@libs,$dir,$lib,%sh,%olb,%obj,$ldlib);
my $cwd = cwd();
my($so,$lib_ext,$obj_ext) = @Config{'so','lib_ext','obj_ext'};
# List of common Unix library names and there VMS equivalents
@@ -386,8 +487,10 @@ sub _vms_ext {
push(@libs, map { "$_/Library" } sort keys %olb);
push(@libs, map { "$_/Share" } sort keys %sh);
$lib = join(' ',@libs);
- warn "Result: $lib\n" if $verbose;
- wantarray ? ($lib, '', $lib, '') : $lib;
+
+ $ldlib = $crtlstr ? "$lib $crtlstr" : $lib;
+ warn "Result:\n\tEXTRALIBS: $lib\n\tLDLOADLIBS: $ldlib\n" if $verbose;
+ wantarray ? ($lib, '', $ldlib, '') : $lib;
}
1;
@@ -475,7 +578,7 @@ Unix-OS/2 version in several respects:
=item *
Input library and path specifications are accepted with or without the
-C<-l> and C<-L> prefices used by Unix linkers. If neither prefix is
+C<-l> and C<-L> prefixes used by Unix linkers. If neither prefix is
present, a token is considered a directory to search if it is in fact
a directory, and a library to search for otherwise. Authors who wish
their extensions to be portable to Unix or OS/2 should use the Unix
@@ -486,7 +589,7 @@ prefixes, since the Unix-OS/2 version of ext() requires them.
Wherever possible, shareable images are preferred to object libraries,
and object libraries to plain object files. In accordance with VMS
naming conventions, ext() looks for files named I<lib>shr and I<lib>rtl;
-it also looks for I<lib>lib and libI<lib> to accomodate Unix conventions
+it also looks for I<lib>lib and libI<lib> to accommodate Unix conventions
used in some ported software.
=item *
@@ -497,8 +600,10 @@ these directives, rather than elements used on the linker command line.
=item *
-LDLOADLIBS and EXTRALIBS are always identical under VMS, and BSLOADLIBS
-and LD_RIN_PATH are always empty.
+LDLOADLIBS contains both the libraries found based on C<$potential_libs> and
+the CRTLs, if any, specified in Config.pm. EXTRALIBS contains just those
+libraries found based on C<$potential_libs>. BSLOADLIBS and LD_RUN_PATH
+are always empty.
=back
@@ -520,16 +625,39 @@ 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)
+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>.
+For each library that is found, a space-separated list of fully qualified
+library pathnames is generated.
+
+=item *
+
Input library and path specifications are accepted with or without the
-C<-l> and C<-L> prefices used by Unix linkers. C<-lfoo> specifies the
-library C<foo.lib> and C<-Ls:ome\dir> specifies a directory to look for
-the libraries that follow. If neither prefix is present, a token is
+C<-l> and C<-L> prefixes used by Unix linkers.
+
+An entry of the form C<-La:\foo> specifies the C<a:\foo> directory to look
+for the libraries that follow.
+
+An entry of the form C<-lfoo> specifies the library C<foo>, which may be
+spelled differently depending on what kind of compiler you are using. If
+you are using GCC, it gets translated to C<libfoo.a>, but for other win32
+compilers, it becomes C<foo.lib>. If no files are found by those translated
+names, one more attempt is made to find them using either C<foo.a> or
+C<libfoo.lib>, depending on whether GCC or some other win32 compiler is
+being used, respectively.
+
+If neither the C<-L> or C<-l> prefix is present in an entry, the entry is
considered a directory to search if it is in fact a directory, and a
library to search for otherwise. The C<$Config{lib_ext}> suffix will
-be appended to any entries that are not directories and don't already
-have the suffix. Authors who wish their extensions to be portable to
-Unix or OS/2 should use the Unix prefixes, since the Unix-OS/2 version
-of ext() requires them.
+be appended to any entries that are not directories and don't already have
+the suffix.
+
+Note that the C<-L> and C<-l> prefixes are B<not required>, but authors
+who wish their extensions to be portable to Unix or OS/2 should use the
+prefixes, since the Unix-OS/2 version of ext() requires them.
=item *
@@ -538,15 +666,21 @@ not handle object files in the place of libraries.
=item *
-If C<$potential_libs> is empty, the return value will be empty.
-Otherwise, the libraries specified by C<$Config{libs}> (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>
-as well as in C<$Config{libpth}>. For each library that is found, a
-space-separated list of fully qualified library pathnames is generated.
-You may specify an entry that matches C</:nodefault/i> in
-C<$potential_libs> to disable the appending of default libraries
-found in C<$Config{libs}> (this should be only needed very rarely).
+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</:nodefault/i> disables the appending of default
+libraries found in C<$Config{libs}> (this should be only needed very rarely).
+
+An entry that matches C</:nosearch/i> disables all searching for
+the libraries specified after it. Translation of C<-Lfoo> and
+C<-lfoo> still happens as appropriate (depending on compiler being used,
+as reflected by C<$Config{cc}>), but the entries are not verified to be
+valid files or directories.
+
+An entry that matches C</:search/i> 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}>.
=item *
@@ -560,6 +694,55 @@ distinguish between them.
LDLOADLIBS and EXTRALIBS are always identical under Win32, and BSLOADLIBS
and LD_RUN_PATH are always empty (this may change in future).
+=item *
+
+You must make sure that any paths and path components are properly
+surrounded with double-quotes if they contain spaces. For example,
+C<$potential_libs> could be (literally):
+
+ "-Lc:\Program Files\vc\lib" msvcrt.lib "la test\foo bar.lib"
+
+Note how the first and last entries are protected by quotes in order
+to protect the spaces.
+
+=item *
+
+Since this module is most often used only indirectly from extension
+C<Makefile.PL> files, here is an example C<Makefile.PL> entry to add
+a library to the build process for an extension:
+
+ LIBS => ['-lgl']
+
+When using GCC, that entry specifies that MakeMaker should first look
+for C<libgl.a> (followed by C<gl.a>) in all the locations specified by
+C<$Config{libpth}>.
+
+When using a compiler other than GCC, the above entry will search for
+C<gl.lib> (followed by C<libgl.lib>).
+
+If the library happens to be in a location not in C<$Config{libpth}>,
+you need:
+
+ LIBS => ['-Lc:\gllibs -lgl']
+
+Here is a less often used example:
+
+ LIBS => ['-lgl', ':nosearch -Ld:\mesalibs -lmesa -luser32']
+
+This specifies a search for library C<gl> as before. If that search
+fails to find the library, it looks at the next item in the list. The
+C<:nosearch> flag will prevent searching for the libraries that follow,
+so it simply returns the value as C<-Ld:\mesalibs -lmesa -luser32>,
+since GCC can use that value as is with its linker.
+
+When using the Visual C compiler, the second item is returned as
+C<-libpath:d:\mesalibs mesa.lib user32.lib>.
+
+When using the Borland compiler, the second item is returned as
+C<-Ld:\mesalibs mesa.lib user32.lib>, and MakeMaker takes care of
+moving the C<-Ld:\mesalibs> to the correct place in the linker
+command line.
+
=back
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MM_OS2.pm b/gnu/usr.bin/perl/lib/ExtUtils/MM_OS2.pm
index 65abfc2d99c..5d6034ce349 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/MM_OS2.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MM_OS2.pm
@@ -8,7 +8,6 @@ require Exporter;
Exporter::import('ExtUtils::MakeMaker',
qw( $Verbose &neatvalue));
-$ENV{EMXSHELL} = 'sh'; # to run `commands`
unshift @MM::ISA, 'ExtUtils::MM_OS2';
sub dlsyms {
@@ -16,6 +15,7 @@ sub dlsyms {
my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || [];
+ my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
my($imports) = $attribs{IMPORTS} || $self->{IMPORTS} || {};
my(@m);
(my $boot = $self->{NAME}) =~ s/:/_/g;
@@ -28,13 +28,46 @@ $self->{BASEEXT}.def: Makefile.PL
Mksymlists("NAME" => "', $self->{NAME},
'", "DLBASE" => "',$self->{DLBASE},
'", "DL_FUNCS" => ',neatvalue($funcs),
+ ', "FUNCLIST" => ',neatvalue($funclist),
', "IMPORTS" => ',neatvalue($imports),
- ', "DL_VARS" => ', neatvalue($vars), ');\'
+ ', "VERSION" => "',$self->{VERSION},
+ '", "DL_VARS" => ', neatvalue($vars), ');\'
');
}
+ if (%{$self->{IMPORTS}}) {
+ # Make import files (needed for static build)
+ -d 'tmp_imp' or mkdir 'tmp_imp', 0777 or die "Can't mkdir tmp_imp";
+ open IMP, '>tmpimp.imp' or die "Can't open tmpimp.imp";
+ my ($name, $exp);
+ while (($name, $exp)= each %{$self->{IMPORTS}}) {
+ my ($lib, $id) = ($exp =~ /(.*)\.(.*)/) or die "Malformed IMPORT `$exp'";
+ print IMP "$name $lib $id ?\n";
+ }
+ close IMP or die "Can't close tmpimp.imp";
+ # print "emximp -o tmpimp$Config::Config{lib_ext} tmpimp.imp\n";
+ system "emximp -o tmpimp$Config::Config{lib_ext} tmpimp.imp"
+ and die "Cannot make import library: $!, \$?=$?";
+ unlink <tmp_imp/*>;
+ system "cd tmp_imp; $Config::Config{ar} x ../tmpimp$Config::Config{lib_ext}"
+ and die "Cannot extract import objects: $!, \$?=$?";
+ }
join('',@m);
}
+sub static_lib {
+ my($self) = @_;
+ my $old = $self->ExtUtils::MM_Unix::static_lib();
+ return $old unless %{$self->{IMPORTS}};
+
+ my @chunks = split /\n{2,}/, $old;
+ shift @chunks unless length $chunks[0]; # Empty lines at the start
+ $chunks[0] .= <<'EOC';
+
+ $(AR) $(AR_STATIC_ARGS) $@ tmp_imp/* && $(RANLIB) $@
+EOC
+ return join "\n\n". '', @chunks;
+}
+
sub replace_manpage_separator {
my($self,$man) = @_;
$man =~ s,/+,.,g;
@@ -43,6 +76,7 @@ sub replace_manpage_separator {
sub maybe_command {
my($self,$file) = @_;
+ $file =~ s,[/\\]+,/,g;
return $file if -x $file && ! -d _;
return "$file.exe" if -x "$file.exe" && ! -d _;
return "$file.cmd" if -x "$file.cmd" && ! -d _;
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm b/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm
index b308c4aad6f..35346577202 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm
@@ -5,11 +5,11 @@ use Config;
use File::Basename qw(basename dirname fileparse);
use DirHandle;
use strict;
-use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32
+use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32 $Is_Dos $Is_PERL_OBJECT
$Verbose %pm %static $Xsubpp_Version);
-$VERSION = substr q$Revision: 1.3 $, 10;
-# $Id: MM_Unix.pm,v 1.3 1997/11/30 07:57:26 millert Exp $
+$VERSION = substr q$Revision: 1.4 $, 10;
+# $Id: MM_Unix.pm,v 1.4 1999/04/29 22:51:51 millert Exp $
Exporter::import('ExtUtils::MakeMaker',
qw( $Verbose &neatvalue));
@@ -17,6 +17,9 @@ Exporter::import('ExtUtils::MakeMaker',
$Is_OS2 = $^O eq 'os2';
$Is_Mac = $^O eq 'MacOS';
$Is_Win32 = $^O eq 'MSWin32';
+$Is_Dos = $^O eq 'dos';
+
+$Is_PERL_OBJECT = $Config{'ccflags'} =~ /-DPERL_OBJECT/;
if ($Is_VMS = $^O eq 'VMS') {
require VMS::Filespec;
@@ -77,11 +80,15 @@ path. On UNIX eliminated successive slashes and successive "/.".
sub canonpath {
my($self,$path) = @_;
- $path =~ s|/+|/|g ; # xx////xx -> xx/xx
+ my $node = '';
+ if ( $^O eq 'qnx' && $path =~ s|^(//\d+)/|/| ) {
+ $node = $1;
+ }
+ $path =~ s|(?<=[^/])/+|/|g ; # xx////xx -> xx/xx
$path =~ s|(/\.)+/|/|g ; # xx/././xx -> xx/xx
$path =~ s|^(\./)+|| unless $path eq "./"; # ./xx -> xx
- $path =~ s|/$|| unless $path eq "/"; # xx/ -> xx
- $path;
+ $path =~ s|(?<=[^/])/$|| ; # xx/ -> xx
+ "$node$path";
}
=item catdir
@@ -97,17 +104,13 @@ trailing slash :-)
# ';
sub catdir {
- shift;
+ my $self = shift @_;
my @args = @_;
for (@args) {
# append a slash to each argument unless it has one there
$_ .= "/" if $_ eq '' or substr($_,-1) ne "/";
}
- my $result = join('', @args);
- # remove a trailing slash unless we are root
- substr($result,-1) = ""
- if length($result) > 1 && substr($result,-1) eq "/";
- $result;
+ $self->canonpath(join('', @args));
}
=item catfile
@@ -120,12 +123,12 @@ complete path ending with a filename
sub catfile {
my $self = shift @_;
my $file = pop @_;
- return $file unless @_;
+ return $self->canonpath($file) unless @_;
my $dir = $self->catdir(@_);
for ($dir) {
$_ .= "/" unless substr($_,length($_)-1,1) eq "/";
}
- return $dir.$file;
+ return $self->canonpath($dir.$file);
}
=item curdir
@@ -211,6 +214,7 @@ sub ExtUtils::MM_Unix::pm_to_blib ;
sub ExtUtils::MM_Unix::post_constants ;
sub ExtUtils::MM_Unix::post_initialize ;
sub ExtUtils::MM_Unix::postamble ;
+sub ExtUtils::MM_Unix::ppd ;
sub ExtUtils::MM_Unix::prefixify ;
sub ExtUtils::MM_Unix::processPL ;
sub ExtUtils::MM_Unix::realclean ;
@@ -229,6 +233,7 @@ sub ExtUtils::MM_Unix::tools_other ;
sub ExtUtils::MM_Unix::top_targets ;
sub ExtUtils::MM_Unix::writedoc ;
sub ExtUtils::MM_Unix::xs_c ;
+sub ExtUtils::MM_Unix::xs_cpp ;
sub ExtUtils::MM_Unix::xs_o ;
sub ExtUtils::MM_Unix::xsubpp_version ;
@@ -266,7 +271,7 @@ sub c_o {
push @m, '
.C$(OBJ_EXT):
$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.C
-' if $^O ne 'os2' and $^O ne 'MSWin32'; # Case-specific
+' if $^O ne 'os2' and $^O ne 'MSWin32' and $^O ne 'dos'; #Case-specific
push @m, '
.cpp$(OBJ_EXT):
$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cpp
@@ -370,6 +375,15 @@ sub cflags {
$self->{uc $_} ||= $cflags{$_}
}
+ if ($self->{CAPI} && $Is_PERL_OBJECT) {
+ $self->{CCFLAGS} =~ s/-DPERL_OBJECT(\s|$)//;
+ $self->{CCFLAGS} .= ' -DPERL_CAPI ';
+ if ($Is_Win32 && $Config{'cc'} =~ /^cl.exe/i) {
+ # Turn off C++ mode of the MSC compiler
+ $self->{CCFLAGS} =~ s/-TP(\s|$)//;
+ $self->{OPTIMIZE} =~ s/-TP(\s|$)//;
+ }
+ }
return $self->{CFLAGS} = qq{
CCFLAGS = $self->{CCFLAGS}
OPTIMIZE = $self->{OPTIMIZE}
@@ -557,6 +571,15 @@ MAN3PODS = ".join(" \\\n\t", sort keys %{$self->{MAN3PODS}})."
push @m, "$tmp = $self->{$tmp}\n";
}
+ for $tmp (qw(
+ PERM_RW PERM_RWX
+ )
+ ) {
+ my $method = lc($tmp);
+ # warn "self[$self] method[$method]";
+ push @m, "$tmp = ", $self->$method(), "\n";
+ }
+
push @m, q{
.NO_CONFIG_REC: Makefile
} if $ENV{CLEARCASE_ROOT};
@@ -681,8 +704,8 @@ $targ :: $src
$self->{NOECHO}\$(MKPATH) $targdir
$self->{NOECHO}\$(EQUALIZE_TIMESTAMP) $src $targ
};
- push(@m,qq{
- -$self->{NOECHO}\$(CHMOD) 755 $targdir
+ push(@m, qq{
+ -$self->{NOECHO}\$(CHMOD) \$(PERM_RWX) $targdir
}) unless $Is_VMS;
}
join "", @m;
@@ -705,8 +728,8 @@ sub dist {
my($tarflags) = $attribs{TARFLAGS} || 'cvf';
my($zip) = $attribs{ZIP} || 'zip'; # eg pkzip Yuck!
my($zipflags) = $attribs{ZIPFLAGS} || '-r';
- my($compress) = $attribs{COMPRESS} || 'compress'; # eg gzip
- my($suffix) = $attribs{SUFFIX} || '.Z'; # eg .gz
+ my($compress) = $attribs{COMPRESS} || 'gzip --best';
+ my($suffix) = $attribs{SUFFIX} || '.gz'; # eg .gz
my($shar) = $attribs{SHAR} || 'shar'; # eg "shar --gzip"
my($preop) = $attribs{PREOP} || "$self->{NOECHO}\$(NOOP)"; # eg update MANIFEST
my($postop) = $attribs{POSTOP} || "$self->{NOECHO}\$(NOOP)"; # eg remove the distdir
@@ -796,7 +819,7 @@ ci :
=item dist_core (o)
-Defeines the targets dist, tardist, zipdist, uutardist, shdist
+Defines the targets dist, tardist, zipdist, uutardist, shdist
=cut
@@ -893,6 +916,7 @@ sub dlsyms {
my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || [];
+ my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
my(@m);
push(@m,"
@@ -909,7 +933,8 @@ static :: $self->{BASEEXT}.exp
$self->{BASEEXT}.exp: Makefile.PL
",' $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e \'use ExtUtils::Mksymlists; \\
Mksymlists("NAME" => "',$self->{NAME},'", "DL_FUNCS" => ',
- neatvalue($funcs),', "DL_VARS" => ', neatvalue($vars), ');\'
+ neatvalue($funcs), ', "FUNCLIST" => ', neatvalue($funclist),
+ ', "DL_VARS" => ', neatvalue($vars), ');\'
');
join('',@m);
@@ -958,12 +983,12 @@ $(BOOTSTRAP): '."$self->{MAKEFILE} $self->{BOOTDEP}".' $(INST_ARCHAUTODIR)/.exis
-MExtUtils::Mkbootstrap \
-e "Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');"
'.$self->{NOECHO}.'$(TOUCH) $(BOOTSTRAP)
- $(CHMOD) 644 $@
+ $(CHMOD) $(PERM_RW) $@
$(INST_BOOT): $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists
'."$self->{NOECHO}$self->{RM_RF}".' $(INST_BOOT)
-'.$self->{CP}.' $(BOOTSTRAP) $(INST_BOOT)
- $(CHMOD) 644 $@
+ $(CHMOD) $(PERM_RW) $@
';
}
@@ -1007,10 +1032,14 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists
$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}"}
+ 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)');
push @m, '
- $(CHMOD) 755 $@
+ $(CHMOD) $(PERM_RWX) $@
';
push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
@@ -1049,7 +1078,12 @@ Takes as argument a path and returns true, if it is an absolute path.
sub file_name_is_absolute {
my($self,$file) = @_;
- $file =~ m:^/: ;
+ if ($Is_Dos){
+ $file =~ m{^([a-z]:)?[\\/]}i ;
+ }
+ else {
+ $file =~ m:^/: ;
+ }
}
=item find_perl
@@ -1149,6 +1183,7 @@ sub fixin { # stolen from the pink Camel book, more or less
my($shb) = "";
if ($interpreter) {
print STDOUT "Changing sharpbang in $file to $interpreter" if $Verbose;
+ # this is probably value-free on DOSISH platforms
if ($does_shbang) {
$shb .= "$Config{'sharpbang'}$interpreter";
$shb .= ' ' . $arg if defined $arg;
@@ -1157,23 +1192,22 @@ sub fixin { # stolen from the pink Camel book, more or less
$shb .= qq{
eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}'
if 0; # not running under some shell
-};
+} unless $Is_Win32; # this won't work on win32, so don't
} else {
warn "Can't find $cmd in PATH, $file unchanged"
if $Verbose;
next;
}
- unless ( rename($file, "$file.bak") ) {
- warn "Can't modify $file";
- next;
- }
- unless ( open(FIXOUT,">$file") ) {
+ unless ( open(FIXOUT,">$file.new") ) {
warn "Can't create new $file: $!\n";
next;
}
my($dev,$ino,$mode) = stat FIXIN;
- $mode = 0755 unless $dev;
+ # 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).
@@ -1182,9 +1216,23 @@ eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}'
print FIXOUT $shb, <FIXIN>;
close FIXIN;
close FIXOUT;
+ # can't rename open files on some DOSISH platforms
+ unless ( rename($file, "$file.bak") ) {
+ warn "Can't rename $file to $file.bak: $!";
+ next;
+ }
+ unless ( rename("$file.new", $file) ) {
+ warn "Can't rename $file.new to $file: $!";
+ unless ( rename("$file.bak", $file) ) {
+ warn "Can't rename $file.bak back to $file either: $!";
+ warn "Leaving $file renamed as $file.bak\n";
+ }
+ next;
+ }
unlink "$file.bak";
} continue {
- chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+ chmod oct($self->perm_rwx), $file or
+ die "Can't reset permissions for $file: $!\n";
system("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';;
}
}
@@ -1252,7 +1300,7 @@ sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc)
my($self) = @_;
my($name, %dir, %xs, %c, %h, %ignore, %pl_files, %manifypods);
local(%pm); #the sub in find() has to see this hash
- $ignore{'test.pl'} = 1;
+ @ignore{qw(Makefile.PL test.pl)} = (1,1);
$ignore{'makefile.pl'} = 1 if $Is_VMS;
foreach $name ($self->lsdir($self->curdir)){
next if $name =~ /\#/;
@@ -1270,13 +1318,16 @@ sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc)
unless $name =~ m/perlmain\.c/; # See MAP_TARGET
} elsif ($name =~ /\.h$/i){
$h{$name} = 1;
+ } elsif ($name =~ /\.PL$/) {
+ ($pl_files{$name} = $name) =~ s/\.PL$// ;
+ } elsif ($Is_VMS && $name =~ /\.pl$/) { # case-insensitive filesystem
+ local($/); open(PL,$name); my $txt = <PL>; close PL;
+ if ($txt =~ /Extracting \S+ \(with variable substitutions/) {
+ ($pl_files{$name} = $name) =~ s/\.pl$// ;
+ }
+ else { $pm{$name} = $self->catfile('$(INST_LIBDIR)',$name); }
} elsif ($name =~ /\.(p[ml]|pod)$/){
$pm{$name} = $self->catfile('$(INST_LIBDIR)',$name);
- } elsif ($name =~ /\.PL$/ && $name ne "Makefile.PL") {
- ($pl_files{$name} = $name) =~ s/\.PL$// ;
- } elsif ($Is_VMS && $name =~ /\.pl$/ && $name ne 'makefile.pl' &&
- $name ne 'test.pl') { # case-insensitive filesystem
- ($pl_files{$name} = $name) =~ s/\.pl$// ;
}
}
@@ -1480,7 +1531,7 @@ sub init_main {
$modfname = &DynaLoader::mod2fname(\@modparts);
}
- ($self->{PARENT_NAME}, $self->{BASEEXT}) = $self->{NAME} =~ m!([\w:]+::)?(\w+)$! ;
+ ($self->{PARENT_NAME}, $self->{BASEEXT}) = $self->{NAME} =~ m!(?:([\w:]+)::)?(\w+)$! ;
if (defined &DynaLoader::mod2fname) {
# As of 5.001m, dl_os2 appends '_'
@@ -1934,7 +1985,7 @@ pure_site_install ::
}.$self->catdir('$(PERL_ARCHLIB)','auto','$(FULLEXT)').q{
doc_perl_install ::
- }.$self->{NOECHO}.q{$(DOC_INSTALL) \
+ -}.$self->{NOECHO}.q{$(DOC_INSTALL) \
"Module" "$(NAME)" \
"installed into" "$(INSTALLPRIVLIB)" \
LINKTYPE "$(LINKTYPE)" \
@@ -1943,7 +1994,7 @@ doc_perl_install ::
>> }.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q{
doc_site_install ::
- }.$self->{NOECHO}.q{$(DOC_INSTALL) \
+ -}.$self->{NOECHO}.q{$(DOC_INSTALL) \
"Module" "$(NAME)" \
"installed into" "$(INSTALLSITELIB)" \
LINKTYPE "$(LINKTYPE)" \
@@ -1970,7 +2021,7 @@ uninstall_from_sitedirs ::
=item installbin (o)
-Defines targets to install EXE_FILES.
+Defines targets to make and to install EXE_FILES.
=cut
@@ -1991,10 +2042,13 @@ sub installbin {
push(@m, qq{
EXE_FILES = @{$self->{EXE_FILES}}
-FIXIN = \$(PERL) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) -MExtUtils::MakeMaker \\
+} . ($Is_Win32
+ ? q{FIXIN = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
+ -e "system qq[pl2bat.bat ].shift"
+} : q{FIXIN = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::MakeMaker \
-e "MY->fixin(shift)"
-
-all :: @to
+}).qq{
+pure_all :: @to
$self->{NOECHO}\$(NOOP)
realclean ::
@@ -2009,6 +2063,7 @@ $to: $from $self->{MAKEFILE} " . $self->catdir($todir,'.exists') . "
$self->{NOECHO}$self->{RM_F} $to
$self->{CP} $from $to
\$(FIXIN) $to
+ -$self->{NOECHO}\$(CHMOD) \$(PERM_RWX) $to
";
}
join "", @m;
@@ -2281,7 +2336,7 @@ MAP_LIBPERL = $libperl
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 $llibperl \$(MAP_STATIC) `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'
@@ -2295,14 +2350,17 @@ $tmp/perlmain\$(OBJ_EXT): $tmp/perlmain.c
$tmp/perlmain.c: $makefilename}, q{
}.$self->{NOECHO}.q{echo Writing $@
}.$self->{NOECHO}.q{$(PERL) $(MAP_PERLINC) -MExtUtils::Miniperl \\
- -e "writemain(grep s#.*/auto/##, qw|$(MAP_STATIC)|)" > $@t && $(MV) $@t $@
+ -e "writemain(grep s#.*/auto/##, split(q| |, q|$(MAP_STATIC)|))" > $@t && $(MV) $@t $@
};
+ push @m, "\t",$self->{NOECHO}.q{$(PERL) $(INSTALLSCRIPT)/fixpmain
+} if (defined (&Dos::UseLFN) && Dos::UseLFN()==0);
+
push @m, q{
doc_inst_perl:
}.$self->{NOECHO}.q{echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod
- }.$self->{NOECHO}.q{$(DOC_INSTALL) \
+ -}.$self->{NOECHO}.q{$(DOC_INSTALL) \
"Perl binary" "$(MAP_TARGET)" \
MAP_STATIC "$(MAP_STATIC)" \
MAP_EXTRA "`cat $(INST_ARCHAUTODIR)/extralibs.all`" \
@@ -2348,6 +2406,7 @@ $(OBJECT) : $(FIRST_MAKEFILE)
}.$self->{MAKEFILE}.q{ : Makefile.PL $(CONFIGDEP)
}.$self->{NOECHO}.q{echo "Makefile out-of-date with respect to $?"
}.$self->{NOECHO}.q{echo "Cleaning current config before rebuilding Makefile..."
+ -}.$self->{NOECHO}.q{$(RM_F) }."$self->{MAKEFILE}.old".q{
-}.$self->{NOECHO}.q{$(MV) }."$self->{MAKEFILE} $self->{MAKEFILE}.old".q{
-$(MAKE) -f }.$self->{MAKEFILE}.q{.old clean $(DEV_NULL) || $(NOOP)
$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL }.join(" ",map(qq["$_"],@ARGV)).q{
@@ -2373,7 +2432,8 @@ put them into the INST_* directories.
sub manifypods {
my($self, %attribs) = @_;
- return "\nmanifypods :\n\t$self->{NOECHO}\$(NOOP)\n" unless %{$self->{MAN3PODS}} or %{$self->{MAN1PODS}};
+ return "\nmanifypods : pure_all\n\t$self->{NOECHO}\$(NOOP)\n" unless
+ %{$self->{MAN3PODS}} or %{$self->{MAN1PODS}};
my($dist);
my($pod2man_exe);
if (defined $self->{PERL_SRC}) {
@@ -2394,13 +2454,14 @@ END
my(@m);
push @m,
qq[POD2MAN_EXE = $pod2man_exe\n],
-q[POD2MAN = $(PERL) -we '%m=@ARGV;for (keys %m){' \\
--e 'next if -e $$m{$$_} && -M $$m{$$_} < -M $$_ && -M $$m{$$_} < -M "].$self->{MAKEFILE}.q[";' \\
+qq[POD2MAN = \$(PERL) -we '%m=\@ARGV;for (keys %m){' \\\n],
+q[-e 'next if -e $$m{$$_} && -M $$m{$$_} < -M $$_ && -M $$m{$$_} < -M "],
+ $self->{MAKEFILE}, q[";' \\
-e 'print "Manifying $$m{$$_}\n";' \\
-e 'system(qq[$$^X ].q["-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" $(POD2MAN_EXE) ].qq[$$_>$$m{$$_}])==0 or warn "Couldn\\047t install $$m{$$_}\n";' \\
--e 'chmod 0644, $$m{$$_} or warn "chmod 644 $$m{$$_}: $$!\n";}'
+-e 'chmod(oct($(PERM_RW))), $$m{$$_} or warn "chmod $(PERM_RW) $$m{$$_}: $$!\n";}'
];
- push @m, "\nmanifypods : ";
+ push @m, "\nmanifypods : pure_all ";
push @m, join " \\\n\t", keys %{$self->{MAN1PODS}}, keys %{$self->{MAN3PODS}};
push(@m,"\n");
@@ -2543,6 +2604,32 @@ sub parse_version {
return $result;
}
+=item parse_abstract
+
+parse a file and return what you think is the ABSTRACT
+
+=cut
+
+sub parse_abstract {
+ my($self,$parsefile) = @_;
+ my $result;
+ local *FH;
+ local $/ = "\n";
+ open(FH,$parsefile) or die "Could not open '$parsefile': $!";
+ my $inpod = 0;
+ my $package = $self->{DISTNAME};
+ $package =~ s/-/::/;
+ while (<FH>) {
+ $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
+ next if !$inpod;
+ chop;
+ next unless /^($package\s-\s)(.*)/;
+ $result = $2;
+ last;
+ }
+ close FH;
+ return $result;
+}
=item pasthru (o)
@@ -2575,7 +2662,7 @@ Takes no argument, returns the environment variable PATH as an array.
sub path {
my($self) = @_;
- my $path_sep = $Is_OS2 ? ";" : ":";
+ my $path_sep = ($Is_OS2 || $Is_Dos) ? ";" : ":";
my $path = $ENV{PATH};
$path =~ s:\\:/:g if $Is_OS2;
my @path = split $path_sep, $path;
@@ -2631,7 +2718,7 @@ $(PERL_INC)/config.h $(PERL_INC)/mg.h $(PERL_INC)/scope.h \
$(PERL_INC)/cop.h $(PERL_INC)/op.h $(PERL_INC)/sv.h \
$(PERL_INC)/cv.h $(PERL_INC)/opcode.h $(PERL_INC)/unixish.h \
$(PERL_INC)/dosish.h $(PERL_INC)/patchlevel.h $(PERL_INC)/util.h \
-$(PERL_INC)/embed.h $(PERL_INC)/perl.h \
+$(PERL_INC)/embed.h $(PERL_INC)/perl.h $(PERL_INC)/iperlsys.h \
$(PERL_INC)/form.h $(PERL_INC)/perly.h
$(OBJECT) : $(PERL_HDRS)
@@ -2642,6 +2729,91 @@ $(OBJECT) : $(PERL_HDRS)
join "\n", @m;
}
+=item ppd
+
+Defines target that creates a PPD (Perl Package Description) file
+for a binary distribution.
+
+=cut
+
+sub ppd {
+ my($self) = @_;
+ my(@m);
+ if ($self->{ABSTRACT_FROM}){
+ $self->{ABSTRACT} = $self->parse_abstract($self->{ABSTRACT_FROM}) or
+ Carp::carp "WARNING: Setting ABSTRACT via file '$self->{ABSTRACT_FROM}' failed\n";
+ }
+ my ($pack_ver) = join ",", (split (/\./, $self->{VERSION}), (0) x 4) [0 .. 3];
+ push(@m, "# Creates a PPD (Perl Package Description) for a binary distribution.\n");
+ push(@m, "ppd:\n");
+ push(@m, "\t\@\$(PERL) -e \"print qq{<SOFTPKG NAME=\\\"$self->{DISTNAME}\\\" VERSION=\\\"$pack_ver\\\">\\n}");
+ push(@m, ". qq{\\t<TITLE>$self->{DISTNAME}</TITLE>\\n}");
+ my $abstract = $self->{ABSTRACT};
+ $abstract =~ s/\n/\\n/sg;
+ $abstract =~ s/</&lt;/g;
+ $abstract =~ s/>/&gt;/g;
+ push(@m, ". qq{\\t<ABSTRACT>$abstract</ABSTRACT>\\n}");
+ my ($author) = $self->{AUTHOR};
+ $author =~ s/</&lt;/g;
+ $author =~ s/>/&gt;/g;
+ $author =~ s/@/\\@/g;
+ push(@m, ". qq{\\t<AUTHOR>$author</AUTHOR>\\n}");
+ push(@m, ". qq{\\t<IMPLEMENTATION>\\n}");
+ my ($prereq);
+ foreach $prereq (sort keys %{$self->{PREREQ_PM}}) {
+ my $pre_req = $prereq;
+ $pre_req =~ s/::/-/g;
+ my ($dep_ver) = join ",", (split (/\./, $self->{PREREQ_PM}{$prereq}), (0) x 4) [0 .. 3];
+ push(@m, ". qq{\\t\\t<DEPENDENCY NAME=\\\"$pre_req\\\" VERSION=\\\"$dep_ver\\\" />\\n}");
+ }
+ push(@m, ". qq{\\t\\t<OS NAME=\\\"\$(OSNAME)\\\" />\\n}");
+ push(@m, ". qq{\\t\\t<ARCHITECTURE NAME=\\\"$Config{'archname'}\\\" />\\n}");
+ my ($bin_location) = $self->{BINARY_LOCATION};
+ $bin_location =~ s/\\/\\\\/g;
+ if ($self->{PPM_INSTALL_SCRIPT}) {
+ if ($self->{PPM_INSTALL_EXEC}) {
+ push(@m, " . qq{\\t\\t<INSTALL EXEC=\\\"$self->{PPM_INSTALL_EXEC}\\\">$self->{PPM_INSTALL_SCRIPT}</INSTALL>\\n}");
+ }
+ else {
+ push(@m, " . qq{\\t\\t<INSTALL>$self->{PPM_INSTALL_SCRIPT}</INSTALL>\\n}");
+ }
+ }
+ push(@m, ". qq{\\t\\t<CODEBASE HREF=\\\"$bin_location\\\" />\\n}");
+ push(@m, ". qq{\\t</IMPLEMENTATION>\\n}");
+ push(@m, ". qq{</SOFTPKG>\\n}\" > $self->{DISTNAME}.ppd");
+
+ join("", @m);
+}
+
+=item perm_rw (o)
+
+Returns the attribute C<PERM_RW> or the string C<644>.
+Used as the string that is passed
+to the C<chmod> command to set the permissions for read/writeable files.
+MakeMaker chooses C<644> because it has turned out in the past that
+relying on the umask provokes hard-to-track bug reports.
+When the return value is used by the perl function C<chmod>, it is
+interpreted as an octal value.
+
+=cut
+
+sub perm_rw {
+ shift->{PERM_RW} || "644";
+}
+
+=item perm_rwx (o)
+
+Returns the attribute C<PERM_RWX> or the string C<755>,
+i.e. the string that is passed
+to the C<chmod> command to set the permissions for executable files.
+See also perl_rw.
+
+=cut
+
+sub perm_rwx {
+ shift->{PERM_RWX} || "755";
+}
+
=item pm_to_blib
Defines target that copies all files in the hash PM to their
@@ -2725,13 +2897,18 @@ sub processPL {
return "" unless $self->{PL_FILES};
my(@m, $plfile);
foreach $plfile (sort keys %{$self->{PL_FILES}}) {
+ my $list = ref($self->{PL_FILES}->{$plfile})
+ ? $self->{PL_FILES}->{$plfile}
+ : [$self->{PL_FILES}->{$plfile}];
+ foreach $target (@$list) {
push @m, "
-all :: $self->{PL_FILES}->{$plfile}
+all :: $target
$self->{NOECHO}\$(NOOP)
-$self->{PL_FILES}->{$plfile} :: $plfile
- \$(PERL) -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) $plfile
+$target :: $plfile
+ \$(PERL) -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) $plfile $target
";
+ }
}
join "", @m;
}
@@ -2760,7 +2937,8 @@ 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");
+ push(@m, " $self->{RM_F} " . join(" ", values %{$self->{PM}}) . "\n")
+ if keys %{$self->{PM}};
my(@otherfiles) = ($self->{MAKEFILE},
"$self->{MAKEFILE}.old"); # Makefiles last
push(@otherfiles, $attribs{FILES}) if $attribs{FILES};
@@ -2778,7 +2956,11 @@ form Foo/Bar and replaces the slash with C<::>. Returns the replacement.
sub replace_manpage_separator {
my($self,$man) = @_;
- $man =~ s,/+,::,g;
+ if ($^O eq 'uwin') {
+ $man =~ s,/+,.,g;
+ } else {
+ $man =~ s,/+,::,g;
+ }
$man;
}
@@ -2825,7 +3007,7 @@ END
push @m,
q{ $(AR) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@
- $(CHMOD) 755 $@
+ $(CHMOD) $(PERM_RWX) $@
}.$self->{NOECHO}.q{echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld
};
# Old mechanism - still available:
@@ -3139,9 +3321,11 @@ sub tool_xsubpp {
}
}
+ my $xsubpp = $self->{CAPI} ? "xsubpp -object_capi" : "xsubpp";
+
return qq{
XSUBPPDIR = $xsdir
-XSUBPP = \$(XSUBPPDIR)/xsubpp
+XSUBPP = \$(XSUBPPDIR)/$xsubpp
XSPROTOARG = $self->{XSPROTOARG}
XSUBPPDEPS = @tmdeps
XSUBPPARGS = @tmargs
@@ -3287,7 +3471,7 @@ Version_check:
=item writedoc
-Obsolete, depecated method. Not used since Version 5.21.
+Obsolete, deprecated method. Not used since Version 5.21.
=cut
@@ -3311,7 +3495,22 @@ sub xs_c {
return '' unless $self->needs_linking();
'
.xs.c:
- $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >$*.tc && $(MV) $*.tc $@
+ $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >xstmp.c && $(MV) xstmp.c $*.c
+';
+}
+
+=item xs_cpp (o)
+
+Defines the suffix rules to compile XS files to C++.
+
+=cut
+
+sub xs_cpp {
+ my($self) = shift;
+ return '' unless $self->needs_linking();
+ '
+.xs.cpp:
+ $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >xstmp.c && $(MV) xstmp.c $*.cpp
';
}
@@ -3342,6 +3541,7 @@ and Win32 do.
sub perl_archive
{
+ return '$(PERL_INC)' . "/$Config{libperl}" if $^O eq "beos";
return "";
}
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MM_VMS.pm b/gnu/usr.bin/perl/lib/ExtUtils/MM_VMS.pm
index dc3b4ceca64..8f8ac1787c4 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/MM_VMS.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MM_VMS.pm
@@ -3,7 +3,7 @@
# This package is inserted into @ISA of MakeMaker's MM before the
# built-in ExtUtils::MM_Unix methods if MakeMaker.pm is run under VMS.
#
-# Author: Charles Bailey bailey@genetics.upenn.edu
+# Author: Charles Bailey bailey@newman.upenn.edu
package ExtUtils::MM_VMS;
@@ -14,7 +14,7 @@ use VMS::Filespec;
use File::Basename;
use vars qw($Revision);
-$Revision = '5.3901 (6-Mar-1997)';
+$Revision = '5.52 (12-Sep-1998)';
unshift @MM::ISA, 'ExtUtils::MM_VMS';
@@ -61,15 +61,22 @@ sub eliminate_macros {
if ($self->{$2}) {
($head,$macro,$tail) = ($1,$2,$3);
if (ref $self->{$macro}) {
- carp "Can't expand macro containing " . ref $self->{$macro};
- $npath = "$head\cB$macro\cB$tail";
- $complex = 1;
+ if (ref $self->{$macro} eq 'ARRAY') {
+ print "Note: expanded array macro \$($macro) in $path\n" if $Verbose;
+ $macro = join ' ', @{$self->{$macro}};
+ }
+ else {
+ print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}),
+ "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n";
+ $macro = "\cB$macro\cB";
+ $complex = 1;
+ }
}
else { ($macro = unixify($self->{$macro})) =~ s#/$##; }
$npath = "$head$macro$tail";
}
}
- if ($complex) { $npath =~ s#\cB(.*?)\cB#\$($1)#g; }
+ if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#g; }
print "eliminate_macros($path) = |$npath|\n" if $Verbose >= 3;
$npath;
}
@@ -83,8 +90,10 @@ are all macro, so that we can tell how long the expansion is, and avoid
overrunning DCL's command buffer when MM[KS] is running.
If optional second argument has a TRUE value, then the return string is
-a VMS-syntax directory specification, otherwise it is a VMS-syntax file
-specification.
+a VMS-syntax directory specification, if it is FALSE, the return string
+is a VMS-syntax file specification, and if it is not specified, fixpath()
+checks to see whether it matches the name of a directory in the current
+default directory, and returns a directory or file specification accordingly.
=cut
@@ -115,8 +124,10 @@ sub fixpath {
$fixedpath = $path;
$fixedpath = vmspath($fixedpath) if $force_path;
}
- # Convert names without directory or type to paths
- if (!$force_path and $fixedpath !~ /[:>(.\]]/) { $fixedpath = vmspath($fixedpath); }
+ # No hints, so we try to guess
+ if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) {
+ $fixedpath = vmspath($fixedpath) if -d $fixedpath;
+ }
# Trim off root dirname if it's had other dirs inserted in front of it.
$fixedpath =~ s/\.000000([\]>])/$1/;
print "fixpath($path) = |$fixedpath|\n" if $Verbose >= 3;
@@ -193,7 +204,7 @@ sub wraplist {
# traversing array (scalar(@array) doesn't show them, but
# foreach(@array) does) (5.00307)
next unless $word =~ /\w/;
- $line .= ', ' if length($line);
+ $line .= ' ' if length($line);
if ($hlen > 80) { $line .= "\\\n\t"; $hlen = 0; }
$line .= $word;
$hlen += length($word) + 2;
@@ -429,7 +440,7 @@ sub find_perl {
}
foreach $name (@snames){
if ($name !~ m![/:>\]]!) { push(@cand,$self->catfile($dir,$name)); }
- else { push(@cand,$self->fixpath($name)); }
+ else { push(@cand,$self->fixpath($name,0)); }
}
}
foreach $name (@cand) {
@@ -632,9 +643,9 @@ sub constants {
if ($self->{OBJECT} =~ /\s/) {
$self->{OBJECT} =~ s/(\\)?\n+\s+/ /g;
- $self->{OBJECT} = join(' ',map($self->fixpath($_),split(/,?\s+/,$self->{OBJECT})));
+ $self->{OBJECT} = $self->wraplist(map($self->fixpath($_,0),split(/,?\s+/,$self->{OBJECT})));
}
- $self->{LDFROM} = join(' ',map($self->fixpath($_),split(/,?\s+/,$self->{LDFROM})));
+ $self->{LDFROM} = $self->wraplist(map($self->fixpath($_,0),split(/,?\s+/,$self->{LDFROM})));
# Fix up directory specs
@@ -657,7 +668,7 @@ sub constants {
# Fix up file specs
foreach $macro ( qw[LIBPERL_A FIRST_MAKEFILE MAKE_APERL_FILE MYEXTLIB] ) {
next unless defined $self->{$macro};
- $self->{$macro} = $self->fixpath($self->{$macro});
+ $self->{$macro} = $self->fixpath($self->{$macro},0);
}
foreach $macro (qw/
@@ -695,7 +706,7 @@ MM_VMS_REVISION = $ExtUtils::MM_VMS::Revision
FULLEXT VERSION_FROM OBJECT LDFROM
/ ) {
next unless defined $self->{$tmp};
- push @m, "$tmp = ",$self->fixpath($self->{$tmp}),"\n";
+ push @m, "$tmp = ",$self->fixpath($self->{$tmp},0),"\n";
}
for $tmp (qw/
@@ -709,7 +720,7 @@ MM_VMS_REVISION = $ExtUtils::MM_VMS::Revision
next unless defined $self->{$tmp};
my(%tmp,$key);
for $key (keys %{$self->{$tmp}}) {
- $tmp{$self->fixpath($key)} = $self->fixpath($self->{$tmp}{$key});
+ $tmp{$self->fixpath($key,0)} = $self->fixpath($self->{$tmp}{$key},0);
}
$self->{$tmp} = \%tmp;
}
@@ -718,7 +729,7 @@ MM_VMS_REVISION = $ExtUtils::MM_VMS::Revision
next unless defined $self->{$tmp};
my(@tmp,$val);
for $val (@{$self->{$tmp}}) {
- push(@tmp,$self->fixpath($val));
+ push(@tmp,$self->fixpath($val,0));
}
$self->{$tmp} = \@tmp;
}
@@ -726,12 +737,12 @@ MM_VMS_REVISION = $ExtUtils::MM_VMS::Revision
push @m,'
# Handy lists of source code files:
-XS_FILES = ',$self->wraplist(', ', sort keys %{$self->{XS}}),'
-C_FILES = ',$self->wraplist(', ', @{$self->{C}}),'
-O_FILES = ',$self->wraplist(', ', @{$self->{O_FILES}} ),'
-H_FILES = ',$self->wraplist(', ', @{$self->{H}}),'
-MAN1PODS = ',$self->wraplist(', ', sort keys %{$self->{MAN1PODS}}),'
-MAN3PODS = ',$self->wraplist(', ', sort keys %{$self->{MAN3PODS}}),'
+XS_FILES = ',$self->wraplist(sort keys %{$self->{XS}}),'
+C_FILES = ',$self->wraplist(@{$self->{C}}),'
+O_FILES = ',$self->wraplist(@{$self->{O_FILES}} ),'
+H_FILES = ',$self->wraplist(@{$self->{H}}),'
+MAN1PODS = ',$self->wraplist(sort keys %{$self->{MAN1PODS}}),'
+MAN3PODS = ',$self->wraplist(sort keys %{$self->{MAN3PODS}}),'
';
@@ -764,21 +775,22 @@ INST_DYNAMIC = $(INST_ARCHAUTODIR)$(BASEEXT).$(DLEXT)
INST_BOOT = $(INST_ARCHAUTODIR)$(BASEEXT).bs
';
} else {
+ my $shr = $Config{'dbgprefix'} . 'PERLSHR';
push @m,'
INST_STATIC =
INST_DYNAMIC =
INST_BOOT =
EXPORT_LIST = $(BASEEXT).opt
-PERL_ARCHIVE = ',($ENV{'PERLSHR'} ? $ENV{'PERLSHR'} : "Sys\$Share:PerlShr.$Config{'dlext'}"),'
+PERL_ARCHIVE = ',($ENV{$shr} ? $ENV{$shr} : "Sys\$Share:$shr.$Config{'dlext'}"),'
';
}
$self->{TO_INST_PM} = [ sort keys %{$self->{PM}} ];
$self->{PM_TO_BLIB} = [ %{$self->{PM}} ];
push @m,'
-TO_INST_PM = ',$self->wraplist(', ',@{$self->{TO_INST_PM}}),'
+TO_INST_PM = ',$self->wraplist(@{$self->{TO_INST_PM}}),'
-PM_TO_BLIB = ',$self->wraplist(', ',@{$self->{PM_TO_BLIB}}),'
+PM_TO_BLIB = ',$self->wraplist(@{$self->{PM_TO_BLIB}}),'
';
join('',@m);
@@ -795,18 +807,41 @@ instance of this qualifier on the command line.
sub cflags {
my($self,$libperl) = @_;
- my($quals) = $Config{'ccflags'};
+ my($quals) = $self->{CCFLAGS} || $Config{'ccflags'};
+ my($definestr,$undefstr,$flagoptstr) = ('','','');
+ my($incstr) = '/Include=($(PERL_INC)';
my($name,$sys,@m);
- my($optimize) = '/Optimize';
( $name = $self->{NAME} . "_cflags" ) =~ s/:/_/g ;
print STDOUT "Unix shell script ".$Config{"$self->{'BASEEXT'}_cflags"}.
" required to modify CC command for $self->{'BASEEXT'}\n"
if ($Config{$name});
+ if ($quals =~ / -[DIUOg]/) {
+ while ($quals =~ / -([Og])(\d*)\b/) {
+ my($type,$lvl) = ($1,$2);
+ $quals =~ s/ -$type$lvl\b\s*//;
+ if ($type eq 'g') { $flagoptstr = '/NoOptimize'; }
+ else { $flagoptstr = '/Optimize' . (defined($lvl) ? "=$lvl" : ''); }
+ }
+ while ($quals =~ / -([DIU])(\S+)/) {
+ my($type,$def) = ($1,$2);
+ $quals =~ s/ -$type$def\s*//;
+ $def =~ s/"/""/g;
+ if ($type eq 'D') { $definestr .= qq["$def",]; }
+ elsif ($type eq 'I') { $incstr .= ',' . $self->fixpath($def,1); }
+ else { $undefstr .= qq["$def",]; }
+ }
+ }
+ if (length $quals and $quals !~ m!/!) {
+ warn "MM_VMS: Ignoring unrecognized CCFLAGS elements \"$quals\"\n";
+ $quals = '';
+ }
+ if (length $definestr) { chop($definestr); $quals .= "/Define=($definestr)"; }
+ if (length $undefstr) { chop($undefstr); $quals .= "/Undef=($undefstr)"; }
# Deal with $self->{DEFINE} here since some C compilers pay attention
# to only one /Define clause on command line, so we have to
- # conflate the ones from $Config{'cc'} and $self->{DEFINE}
+ # conflate the ones from $Config{'ccflags'} and $self->{DEFINE}
if ($quals =~ m:(.*)/define=\(?([^\(\/\)\s]+)\)?(.*)?:i) {
$quals = "$1/Define=($2," . ($self->{DEFINE} ? "$self->{DEFINE}," : '') .
"\$(DEFINE_VERSION),\$(XS_DEFINE_VERSION))$3";
@@ -817,32 +852,45 @@ sub cflags {
}
$libperl or $libperl = $self->{LIBPERL_A} || "libperl.olb";
- if ($libperl =~ /libperl(\w+)\./i) {
- my($type) = uc $1;
- my(%map) = ( 'D' => 'DEBUGGING', 'E' => 'EMBED', 'M' => 'MULTIPLICITY',
- 'DE' => 'DEBUGGING,EMBED', 'DM' => 'DEBUGGING,MULTIPLICITY',
- 'EM' => 'EMBED,MULTIPLICITY', 'DEM' => 'DEBUGGING,EMBED,MULTIPLICITY' );
- $quals =~ s:/define=\(([^\)]+)\):/Define=($1,$map{$type}):i
- }
+# This whole section is commented out, since I don't think it's necessary (or applicable)
+# if ($libperl =~ s/^$Config{'dbgprefix'}//) { $libperl =~ s/perl([^Dd]*)\./perld$1./; }
+# if ($libperl =~ /libperl(\w+)\./i) {
+# my($type) = uc $1;
+# my(%map) = ( 'D' => 'DEBUGGING', 'E' => 'EMBED', 'M' => 'MULTIPLICITY',
+# 'DE' => 'DEBUGGING,EMBED', 'DM' => 'DEBUGGING,MULTIPLICITY',
+# 'EM' => 'EMBED,MULTIPLICITY', 'DEM' => 'DEBUGGING,EMBED,MULTIPLICITY' );
+# my($add) = join(',', grep { $quals !~ /\b$_\b/ } split(/,/,$map{$type}));
+# $quals =~ s:/define=\(([^\)]+)\):/Define=($1,$add):i if $add;
+# $self->{PERLTYPE} ||= $type;
+# }
# Likewise with $self->{INC} and /Include
- my($incstr) = '/Include=($(PERL_INC)';
if ($self->{'INC'}) {
my(@includes) = split(/\s+/,$self->{INC});
foreach (@includes) {
s/^-I//;
- $incstr .= ', '.$self->fixpath($_,1);
+ $incstr .= ','.$self->fixpath($_,1);
}
}
$quals .= "$incstr)";
+ $self->{CCFLAGS} = $quals;
- $optimize = '/Debug/NoOptimize'
- if ($self->{OPTIMIZE} =~ /-g/ or $self->{OPTIMIZE} =~ m!/Debug!i);
+ $self->{OPTIMIZE} ||= $flagoptstr || $Config{'optimize'};
+ if ($self->{OPTIMIZE} !~ m!/!) {
+ if ($self->{OPTIMIZE} =~ m!\b-g\b!) { $self->{OPTIMIZE} = '/Debug/NoOptimize' }
+ elsif ($self->{OPTIMIZE} =~ /-O(\d*)/) {
+ $self->{OPTIMIZE} = '/Optimize' . (defined($1) ? "=$1" : '');
+ }
+ else {
+ warn "MM_VMS: Can't parse OPTIMIZE \"$self->{OPTIMIZE}\"; using default\n" if length $self->{OPTIMIZE};
+ $self->{OPTIMIZE} = '/Optimize';
+ }
+ }
return $self->{CFLAGS} = qq{
-CCFLAGS = $quals
-OPTIMIZE = $optimize
-PERLTYPE =
+CCFLAGS = $self->{CCFLAGS}
+OPTIMIZE = $self->{OPTIMIZE}
+PERLTYPE = $self->{PERLTYPE}
SPLIT =
LARGE =
};
@@ -968,7 +1016,7 @@ sub tool_xsubpp {
warn "Typemap $typemap not found.\n";
}
else{
- push(@tmdeps, $self->fixpath($typemap));
+ push(@tmdeps, $self->fixpath($typemap,0));
}
}
}
@@ -1274,30 +1322,14 @@ sub dlsyms {
my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || [];
- my($srcdir)= $attribs{PERL_SRC} || $self->{PERL_SRC} || '';
+ my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
my(@m);
unless ($self->{SKIPHASH}{'dynamic'}) {
push(@m,'
-dynamic :: rtls.opt $(INST_ARCHAUTODIR)$(BASEEXT).opt
+dynamic :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
$(NOECHO) $(NOOP)
');
- if ($srcdir) {
- my($popt) = $self->catfile($srcdir,'perlshr.opt');
- my($lopt) = $self->catfile($srcdir,'crtl.opt');
- push(@m,"# Depend on \$(BASEEXT).opt to insure we copy here *after* autogenerating (wrong) rtls.opt in Mksymlists
-rtls.opt : $popt $lopt \$(BASEEXT).opt
- Copy/Log $popt Sys\$Disk:[]rtls.opt
- Append/Log $lopt Sys\$Disk:[]rtls.opt
-");
- }
- else {
- push(@m,'
-# rtls.opt is built in the same step as $(BASEEXT).opt
-rtls.opt : $(BASEEXT).opt
- $(TOUCH) $(MMS$TARGET)
-');
- }
}
push(@m,'
@@ -1312,7 +1344,8 @@ $(INST_ARCHAUTODIR)$(BASEEXT).opt : $(BASEEXT).opt
$(BASEEXT).opt : Makefile.PL
$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Mksymlists;" -
',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ],
- neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars),')"
+ neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars),
+ q[, 'FUNCLIST' => ],neatvalue($funclist),')"
$(PERL) -e "print ""$(INST_STATIC)/Include=$(BASEEXT)\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)
');
@@ -1347,6 +1380,7 @@ sub dynamic_lib {
my($otherldflags) = $attribs{OTHERLDFLAGS} || "";
my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
+ my $shr = $Config{'dbgprefix'} . 'PerlShr';
my(@m);
push @m,"
@@ -1355,10 +1389,10 @@ INST_DYNAMIC_DEP = $inst_dynamic_dep
";
push @m, '
-$(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt rtls.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
+$(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
$(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
- $(NOECHO) If F$TrnLNm("PerlShr").eqs."" Then Define/NoLog/User PerlShr Sys$Share:PerlShr.',$Config{'dlext'},'
- Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,rtls.opt/Option,$(PERL_INC)perlshr_attr.opt/Option
+ If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",'
+ Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option
';
push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
@@ -1409,7 +1443,7 @@ $(INST_STATIC) :
$(NOECHO) $(NOOP)
' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB});
- my(@m);
+ my(@m,$lib);
push @m,'
# Rely on suffix rule for update action
$(OBJECT) : $(INST_ARCHAUTODIR).exists
@@ -1418,43 +1452,28 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
';
# If this extension has it's own library (eg SDBM_File)
# then copy that to $(INST_STATIC) and add $(OBJECT) into it.
- push(@m, ' $(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB};
+ push(@m, "\t",'$(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB};
- push(@m,'
- If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)
- Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)
- $(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;"
-');
+ push(@m,"\t",'If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)',"\n");
+
+ # if there was a library to copy, then we can't use MMS$SOURCE_LIST,
+ # 'cause it's a library and you can't stick them in other libraries.
+ # In that case, we use $OBJECT instead and hope for the best
+ if ($self->{MYEXTLIB}) {
+ push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(OBJECT)',"\n");
+ } else {
+ push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n");
+ }
+
+ foreach $lib (split $self->{EXTRALIBS}) {
+ $lib = '""' if $lib eq '"';
+ push(@m,"\t",'$(NOECHO) $(PERL) -e "print qq{',$lib,'\n}" >>$(INST_ARCHAUTODIR)extralibs.ld',"\n");
+ }
push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
join('',@m);
}
-# sub installpm_x { # called by installpm perl file
-# my($self, $dist, $inst, $splitlib) = @_;
-# if ($inst =~ m!#!) {
-# warn "Warning: MM[SK] would have problems processing this file: $inst, SKIPPED\n";
-# return '';
-# }
-# $inst = $self->fixpath($inst);
-# $dist = $self->fixpath($dist);
-# my($instdir) = $inst =~ /([^\)]+\))[^\)]*$/ ? $1 : dirname($inst);
-# my(@m);
-#
-# push(@m, "
-# $inst : $dist \$(MAKEFILE) ${instdir}.exists \$(INST_ARCHAUTODIR).exists
-# ",' $(NOECHO) $(RM_F) $(MMS$TARGET)
-# $(NOECHO) $(CP) ',"$dist $inst",'
-# $(CHMOD) 644 $(MMS$TARGET)
-# ');
-# push(@m, ' $(AUTOSPLITFILE) $(MMS$TARGET) ',
-# $self->catdir($splitlib,'auto')."\n\n")
-# if ($splitlib and $inst =~ /\.pm$/);
-# push(@m,$self->dir_target($instdir));
-#
-# join('',@m);
-# }
-
=item manifypods (override)
Use VMS-style quoting on command line, and VMS logical name
@@ -1516,15 +1535,20 @@ sub processPL {
return "" unless $self->{PL_FILES};
my(@m, $plfile);
foreach $plfile (sort keys %{$self->{PL_FILES}}) {
- my $vmsplfile = vmsify($plfile);
- my $vmsfile = vmsify($self->{PL_FILES}->{$plfile});
- push @m, "
+ my $list = ref($self->{PL_FILES}->{$plfile})
+ ? $self->{PL_FILES}->{$plfile}
+ : [$self->{PL_FILES}->{$plfile}];
+ foreach $target (@$list) {
+ my $vmsplfile = vmsify($plfile);
+ my $vmsfile = vmsify($target);
+ push @m, "
all :: $vmsfile
\$(NOECHO) \$(NOOP)
$vmsfile :: $vmsplfile
-",' $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '," $vmsplfile
+",' $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '," $vmsplfile $vmsfile
";
+ }
}
join "", @m;
}
@@ -1640,13 +1664,16 @@ clean ::
if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
push(@otherfiles, @{$self->{$key}});
}
- else { push(@otherfiles, $attribs{FILES}); }
+ else { push(@otherfiles, $word); }
}
}
push(@otherfiles, qw[ blib $(MAKE_APERL_FILE) extralibs.ld perlmain.c pm_to_blib.ts ]);
push(@otherfiles,$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'));
my($file,$line);
$line = ''; #avoid unitialized var warning
+ # Occasionally files are repeated several times from different sources
+ { my(%of) = map { ($_,1) } @otherfiles; @otherfiles = keys %of; }
+
foreach $file (@otherfiles) {
$file = $self->fixpath($file);
if (length($line) + length($file) > 80) {
@@ -1691,6 +1718,8 @@ realclean :: clean
}
push(@files, values %{$self->{PM}});
$line = ''; #avoid unitialized var warning
+ # Occasionally files are repeated several times from different sources
+ { my(%f) = map { ($_,1) } @files; @files = keys %f; }
foreach $file (@files) {
$file = $self->fixpath($file);
if (length($line) + length($file) > 80 || ++$fcnt >= 2) {
@@ -1709,9 +1738,11 @@ realclean :: clean
if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
push(@allfiles, @{$self->{$key}});
}
- else { push(@allfiles, $attribs{FILES}); }
+ else { push(@allfiles, $word); }
}
$line = '';
+ # Occasionally files are repeated several times from different sources
+ { my(%af) = map { ($_,1) } @allfiles; @allfiles = keys %af; }
foreach $file (@allfiles) {
$file = $self->fixpath($file);
if (length($line) + length($file) > 80) {
@@ -1950,9 +1981,7 @@ uninstall_from_sitedirs ::
=item perldepend (override)
Use VMS-style syntax for files; it's cheaper to just do it directly here
-than to have the MM_Unix method call C<catfile> repeatedly. Also use
-config.vms as source of original config data if the Perl distribution
-is available; config.sh is an ancillary file under VMS. Finally, if
+than to have the MM_Unix method call C<catfile> repeatedly. Also, if
we have to rebuild Config.pm, use MM[SK] to do it.
=cut
@@ -1969,6 +1998,7 @@ $(OBJECT) : $(PERL_INC)mg.h, $(PERL_INC)op.h, $(PERL_INC)opcode.h, $(PERL_INC)pa
$(OBJECT) : $(PERL_INC)perl.h, $(PERL_INC)perly.h, $(PERL_INC)pp.h, $(PERL_INC)proto.h
$(OBJECT) : $(PERL_INC)regcomp.h, $(PERL_INC)regexp.h, $(PERL_INC)scope.h, $(PERL_INC)sv.h
$(OBJECT) : $(PERL_INC)vmsish.h, $(PERL_INC)util.h, $(PERL_INC)config.h
+$(OBJECT) : $(PERL_INC)iperlsys.h
' if $self->{OBJECT};
@@ -1985,18 +2015,15 @@ $(OBJECT) : $(PERL_INC)vmsish.h, $(PERL_INC)util.h, $(PERL_INC)config.h
# Check for unpropagated config.sh changes. Should never happen.
# 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
-$(PERL_INC)config.h : $(PERL_VMS)config.vms
- $(NOECHO) Write Sys$Error "Warning: $(PERL_INC)config.h out of date with $(PERL_VMS)config.vms"
+$(PERL_INC)config.h : $(PERL_SRC)config.sh
-#$(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh
-$(PERL_ARCHLIB)Config.pm : $(PERL_VMS)config.vms $(PERL_VMS)genconfig.pl
- $(NOECHO) Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.vms or genconfig.pl"
+$(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"
olddef = F$Environment("Default")
Set Default $(PERL_SRC)
$(MMS)],$mmsquals,);
if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) {
- my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm'));
+ my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm',0));
$target =~ s/\Q$prefix/[/;
push(@m," $target");
}
@@ -2006,7 +2033,7 @@ $(PERL_ARCHLIB)Config.pm : $(PERL_VMS)config.vms $(PERL_VMS)genconfig.pl
]);
}
- push(@m, join(" ", map($self->fixpath($_),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n")
+ push(@m, join(" ", map($self->fixpath($_,0),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n")
if %{$self->{XS}};
join('',@m);
@@ -2171,7 +2198,8 @@ $(MAP_TARGET) :: $(MAKE_APERL_FILE)
}
- my($linkcmd,@staticopts,@staticpkgs,$extralist,$targdir,$libperldir);
+ my($linkcmd,@optlibs,@staticpkgs,$extralist,$targdir,$libperldir,%libseen);
+ local($_);
# The front matter of the linkcommand...
$linkcmd = join ' ', $Config{'ld'},
@@ -2234,28 +2262,46 @@ $(MAP_TARGET) :: $(MAKE_APERL_FILE)
# (e.g. Intuit::DWIM will precede Intuit, so unresolved
# references from [.intuit.dwim]dwim.obj can be found
# in [.intuit]intuit.olb).
- for (sort keys %olbs) {
+ for (sort { length($a) <=> length($b) } keys %olbs) {
next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/;
my($dir) = $self->fixpath($_,1);
my($extralibs) = $dir . "extralibs.ld";
my($extopt) = $dir . $olbs{$_};
$extopt =~ s/$self->{LIB_EXT}$/.opt/;
+ push @optlibs, "$dir$olbs{$_}";
+ # Get external libraries this extension will need
if (-f $extralibs ) {
+ my %seenthis;
open LIST,$extralibs or warn $!,next;
- push @$extra, <LIST>;
+ while (<LIST>) {
+ chomp;
+ # Include a library in the link only once, unless it's mentioned
+ # multiple times within a single extension's options file, in which
+ # case we assume the builder needed to search it again later in the
+ # link.
+ my $skip = exists($libseen{$_}) && !exists($seenthis{$_});
+ $libseen{$_}++; $seenthis{$_}++;
+ next if $skip;
+ push @$extra,$_;
+ }
close LIST;
}
+ # Get full name of extension for ExtUtils::Miniperl
if (-f $extopt) {
open OPT,$extopt or die $!;
while (<OPT>) {
next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/;
- # ExtUtils::Miniperl expects Unix paths
- (my($pkg) = "$1_$1$self->{LIB_EXT}") =~ s#_*#/#g;
+ my $pkg = $1;
+ $pkg =~ s#__*#::#g;
push @staticpkgs,$pkg;
}
- push @staticopts, $extopt;
}
}
+ # Place all of the external libraries after all of the Perl extension
+ # libraries in the final link, in order to maximize the opportunity
+ # for XS code from multiple extensions to resolve symbols against the
+ # same external library while only including that library once.
+ push @optlibs, @$extra;
$target = "Perl$Config{'exe_ext'}" unless $target;
($shrtarget,$targdir) = fileparse($target);
@@ -2264,11 +2310,11 @@ $(MAP_TARGET) :: $(MAKE_APERL_FILE)
$target = "Perlshr.$Config{'dlext'}" unless $target;
$tmp = "[]" unless $tmp;
$tmp = $self->fixpath($tmp,1);
- if (@$extra) {
- $extralist = join(' ',@$extra);
- $extralist =~ s/[,\s\n]+/, /g;
- }
- else { $extralist = ''; }
+ if (@optlibs) { $extralist = join(' ',@optlibs); }
+ else { $extralist = ''; }
+ # Let ExtUtils::Liblist find the necessary for us (but skip PerlShr;
+ # that's what we're building here).
+ push @optlibs, grep { !/PerlShr/i } split +($self->ext())[2];
if ($libperl) {
unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) {
print STDOUT "Warning: $libperl not found\n";
@@ -2289,22 +2335,25 @@ $(MAP_TARGET) :: $(MAKE_APERL_FILE)
push @m, '
# Fill in the target you want to produce if it\'s not perl
-MAP_TARGET = ',$self->fixpath($target),'
-MAP_SHRTARGET = ',$self->fixpath($shrtarget),"
+MAP_TARGET = ',$self->fixpath($target,0),'
+MAP_SHRTARGET = ',$self->fixpath($shrtarget,0),"
MAP_LINKCMD = $linkcmd
-MAP_PERLINC = ", $perlinc ? map('"$_" ',@{$perlinc}) : '','
-# We use the linker options files created with each extension, rather than
-#specifying the object files directly on the command line.
-MAP_STATIC = ',@staticopts ? join(' ', @staticopts) : '','
-MAP_OPTS = ',@staticopts ? ','.join(',', map($_.'/Option', @staticopts)) : '',"
+MAP_PERLINC = ", $perlinc ? map('"$_" ',@{$perlinc}) : '',"
MAP_EXTRA = $extralist
-MAP_LIBPERL = ",$self->fixpath($libperl),'
+MAP_LIBPERL = ",$self->fixpath($libperl,0),'
';
- push @m,'
-$(MAP_SHRTARGET) : $(MAP_LIBPERL) $(MAP_STATIC) ',"${libperldir}Perlshr_Attr.Opt",'
- $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_OPTS), $(MAP_EXTRA), $(MAP_LIBPERL) ',"${libperldir}Perlshr_Attr.Opt",'
+ push @m,"\n${tmp}Makeaperl.Opt : \$(MAP_EXTRA)\n";
+ foreach (@optlibs) {
+ push @m,' $(NOECHO) $(PERL) -e "print q{',$_,'}" >>$(MMS$TARGET)',"\n";
+ }
+ push @m,"\n${tmp}PerlShr.Opt :\n\t";
+ push @m,'$(NOECHO) $(PERL) -e "print q{$(MAP_SHRTARGET)}" >$(MMS$TARGET)',"\n";
+
+push @m,'
+$(MAP_SHRTARGET) : $(MAP_LIBPERL) Makeaperl.Opt ',"${libperldir}Perlshr_Attr.Opt",'
+ $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_LIBPERL), Makeaperl.Opt/Option ',"${libperldir}Perlshr_Attr.Opt/Option",'
$(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt",'
$(MAP_LINKCMD) ',"${tmp}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
$(NOECHO) $(SAY) "To install the new ""$(MAP_TARGET)"" binary, say"
@@ -2312,13 +2361,17 @@ $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt"
$(NOECHO) $(SAY) "To remove the intermediate files, say
$(NOECHO) $(SAY) " $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
';
- push @m,'
-',"${tmp}perlmain.c",' : $(MAKEFILE)
- $(NOECHO) $(PERL) $(MAP_PERLINC) -e "use ExtUtils::Miniperl; writemain(qw|',@staticpkgs,'|)" >$(MMS$TARGET)
-';
+ push @m,"\n${tmp}perlmain.c : \$(MAKEFILE)\n\t\$(NOECHO) \$(PERL) -e 1 >${tmp}Writemain.tmp\n";
+ push @m, "# More from the 255-char line length limit\n";
+ foreach (@staticpkgs) {
+ push @m,' $(NOECHO) $(PERL) -e "print q{',$_,qq[}" >>${tmp}Writemain.tmp\n];
+ }
+ push @m,'
+ $(NOECHO) $(PERL) $(MAP_PERLINC) -ane "use ExtUtils::Miniperl; writemain(@F)" ',$tmp,'Writemain.tmp >$(MMS$TARGET)
+ $(NOECHO) $(RM_F) ',"${tmp}Writemain.tmp\n";
push @m, q[
-# More from the 255-char line length limit
+# Still more from the 255-char line length limit
doc_inst_perl :
$(NOECHO) $(PERL) -e "print 'Perl binary $(MAP_TARGET)|'" >.MM_tmp
$(NOECHO) $(PERL) -e "print 'MAP_STATIC|$(MAP_STATIC)|'" >>.MM_tmp
@@ -2341,7 +2394,7 @@ clean :: map_clean
map_clean :
\$(RM_F) ${tmp}perlmain\$(OBJ_EXT) ${tmp}perlmain.c \$(MAKEFILE)
- \$(RM_F) ${tmp}PerlShr.Opt \$(MAP_TARGET)
+ \$(RM_F) ${tmp}Makeaperl.Opt ${tmp}PerlShr.Opt \$(MAP_TARGET)
";
join '', @m;
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MM_Win32.pm b/gnu/usr.bin/perl/lib/ExtUtils/MM_Win32.pm
index 3545f2c5a4e..4070b2e10b0 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/MM_Win32.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MM_Win32.pm
@@ -30,14 +30,18 @@ $ENV{EMXSHELL} = 'sh'; # to run `commands`
unshift @MM::ISA, 'ExtUtils::MM_Win32';
$BORLAND = 1 if $Config{'cc'} =~ /^bcc/i;
+$GCC = 1 if $Config{'cc'} =~ /^gcc/i;
$DMAKE = 1 if $Config{'make'} =~ /^dmake/i;
$NMAKE = 1 if $Config{'make'} =~ /^nmake/i;
+$PERLMAKE = 1 if $Config{'make'} =~ /^pmake/i;
+$OBJ = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i;
sub dlsyms {
my($self,%attribs) = @_;
my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || [];
+ my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
my($imports) = $attribs{IMPORTS} || $self->{IMPORTS} || {};
my(@m);
(my $boot = $self->{NAME}) =~ s/:/_/g;
@@ -50,6 +54,7 @@ $self->{BASEEXT}.def: Makefile.PL
-e "Mksymlists('NAME' => '!, $self->{NAME},
q!', 'DLBASE' => '!,$self->{DLBASE},
q!', 'DL_FUNCS' => !,neatvalue($funcs),
+ q!, 'FUNCLIST' => !,neatvalue($funclist),
q!, 'IMPORTS' => !,neatvalue($imports),
q!, 'DL_VARS' => !, neatvalue($vars), q!);"
!);
@@ -65,7 +70,21 @@ sub replace_manpage_separator {
sub maybe_command {
my($self,$file) = @_;
- return "$file.exe" if -e "$file.exe";
+ my @e = exists($ENV{'PATHEXT'})
+ ? split(/;/, $ENV{PATHEXT})
+ : qw(.com .exe .bat .cmd);
+ my $e = '';
+ for (@e) { $e .= "\Q$_\E|" }
+ chop $e;
+ # see if file ends in one of the known extensions
+ if ($file =~ /($e)$/i) {
+ return $file if -e $file;
+ }
+ else {
+ for (@e) {
+ return "$file$_" if -e "$file$_";
+ }
+ }
return;
}
@@ -153,13 +172,19 @@ sub init_others
$self->{'TEST_F'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e test_f';
$self->{'LD'} = $Config{'ld'} || 'link';
$self->{'AR'} = $Config{'ar'} || 'lib';
- $self->{'LDLOADLIBS'}
- ||= ( $BORLAND
- ? 'import32.lib cw32mti.lib '
- : 'msvcrt.lib oldnames.lib kernel32.lib comdlg32.lib winspool.lib gdi32.lib '
- .'advapi32.lib user32.lib shell32.lib netapi32.lib ole32.lib '
- .'oleaut32.lib uuid.lib wsock32.lib mpr.lib winmm.lib version.lib '
- ) . ' odbc32.lib odbccp32.lib';
+ $self->{'LDLOADLIBS'} ||= $Config{'libs'};
+ # -Lfoo must come first for Borland, so we put it in LDDLFLAGS
+ if ($BORLAND) {
+ my $libs = $self->{'LDLOADLIBS'};
+ my $libpath = '';
+ while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) {
+ $libpath .= ' ' if length $libpath;
+ $libpath .= $1;
+ }
+ $self->{'LDLOADLIBS'} = $libs;
+ $self->{'LDDLFLAGS'} ||= $Config{'lddlflags'};
+ $self->{'LDDLFLAGS'} .= " $libpath";
+ }
$self->{'DEV_NULL'} = '> NUL';
# $self->{'NOECHO'} = ''; # till we have it working
}
@@ -344,7 +369,9 @@ END
push(@m, "\t$self->{CP} \$(MYEXTLIB) \$\@\n") if $self->{MYEXTLIB};
push @m,
-q{ $(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")' : '-out:$@ $(OBJECT)').q{
+q{ $(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")'
+ : ($GCC ? '-ru $@ $(OBJECT)'
+ : '-out:$@ $(OBJECT)')).q{
}.$self->{NOECHO}.q{echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld
$(CHMOD) 755 $@
};
@@ -415,11 +442,25 @@ INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)\.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
');
-
- push(@m, $BORLAND ?
-q{ $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) $(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,),$(RESFILES)} :
-q{ $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)}
- );
+ if ($GCC) {
+ push(@m,
+ q{ dlltool --def $(EXPORT_LIST) --output-exp dll.exp
+ $(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp
+ dlltool --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp
+ $(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp });
+ } elsif ($BORLAND) {
+ push(@m,
+ q{ $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,}
+ .($DMAKE ? q{$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) }
+ .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)}
+ : q{$(subst /,\,$(PERL_ARCHIVE)) $(subst /,\,$(LDLOADLIBS)) }
+ .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))})
+ .q{,$(RESFILES)});
+ } else { # VC
+ push(@m,
+ q{ $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) }
+ .q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)});
+ }
push @m, '
$(CHMOD) 755 $@
';
@@ -430,7 +471,13 @@ q{ $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_AR
sub perl_archive
{
- return '$(PERL_INC)\perl$(LIB_EXT)';
+ my ($self) = @_;
+ if($OBJ) {
+ if ($self->{CAPI}) {
+ return '$(PERL_INC)\perlCAPI$(LIB_EXT)';
+ }
+ }
+ return '$(PERL_INC)\\'.$Config{'libperl'};
}
sub export_list
@@ -487,10 +534,11 @@ 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[ }.
- ($NMAKE ? '<<pmfiles.dat'
- : '$(mktmp,pmfiles.dat $(PM_TO_BLIB:s,\\,\\\\,)\n)').
- q{ ],'}.$autodir.q{')"
+ -e "pm_to_blib(}.
+ ($NMAKE ? 'qw[ <<pmfiles.dat ],'
+ : $DMAKE ? 'qw[ $(mktmp,pmfiles.dat $(PM_TO_BLIB:s,\\,\\\\,)\n) ],'
+ : '{ qw[$(PM_TO_BLIB)] },'
+ ).q{'}.$autodir.q{')"
}. ($NMAKE ? q{
$(PM_TO_BLIB)
<<
@@ -693,6 +741,7 @@ We don't want manpage process. XXX add pod2html support later.
=cut
sub manifypods {
+ my($self) = shift;
return "\nmanifypods :\n\t$self->{NOECHO}\$(NOOP)\n";
}
@@ -782,3 +831,4 @@ __END__
=cut
+
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker.pm b/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker.pm
index b3e8a926099..1a177973f53 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker.pm
@@ -2,10 +2,10 @@ BEGIN {require 5.002;} # MakeMaker 5.17 was the last MakeMaker that was compatib
package ExtUtils::MakeMaker;
-$Version = $VERSION = "5.42";
+$VERSION = "5.4302";
$Version_OK = "5.17"; # Makefiles older than $Version_OK will die
# (Will be checked from MakeMaker version 4.13 onwards)
-($Revision = substr(q$Revision: 1.2 $, 10)) =~ s/\s+$//;
+($Revision = substr(q$Revision: 1.3 $, 10)) =~ s/\s+$//;
@@ -35,9 +35,7 @@ use vars qw(
#
@ISA = qw(Exporter);
@EXPORT = qw(&WriteMakefile &writeMakefile $Verbose &prompt);
-@EXPORT_OK = qw($VERSION &Version_check &neatvalue &mkbootstrap &mksymlists
- $Version);
- # $Version in mixed case will go away!
+@EXPORT_OK = qw($VERSION &Version_check &neatvalue &mkbootstrap &mksymlists);
#
# Dummy package MM inherits actual methods from OS-specific
@@ -176,17 +174,19 @@ sub WriteMakefile {
sub prompt ($;$) {
my($mess,$def)=@_;
- $ISA_TTY = -t STDIN && -t STDOUT ;
+ $ISA_TTY = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ; # Pipe?
Carp::confess("prompt function called without an argument") unless defined $mess;
my $dispdef = defined $def ? "[$def] " : " ";
$def = defined $def ? $def : "";
my $ans;
+ local $|=1;
+ print "$mess $dispdef";
if ($ISA_TTY) {
- local $|=1;
- print "$mess $dispdef";
chomp($ans = <STDIN>);
+ } else {
+ print "$def\n";
}
- return $ans || $def;
+ return ($ans ne '') ? $ans : $def;
}
sub eval_in_subdirs {
@@ -235,27 +235,23 @@ sub full_setup {
@Attrib_help = qw/
- C CCFLAGS CONFIG CONFIGURE DEFINE DIR DISTNAME DL_FUNCS DL_VARS
- EXE_FILES EXCLUDE_EXT INCLUDE_EXT NO_VC FIRST_MAKEFILE FULLPERL H
- INC INSTALLARCHLIB INSTALLBIN INSTALLDIRS INSTALLMAN1DIR
+ 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 IMPORTS
+ INC INCLUDE_EXT INSTALLARCHLIB INSTALLBIN INSTALLDIRS INSTALLMAN1DIR
INSTALLMAN3DIR INSTALLPRIVLIB INSTALLSCRIPT INSTALLSITEARCH
INSTALLSITELIB INST_ARCHLIB INST_BIN INST_EXE INST_LIB
- INST_MAN1DIR INST_MAN3DIR INST_SCRIPT LDFROM LIBPERL_A LIB LIBS
+ INST_MAN1DIR INST_MAN3DIR INST_SCRIPT LDFROM LIB LIBPERL_A LIBS
LINKTYPE MAKEAPERL MAKEFILE MAN1PODS MAN3PODS MAP_TARGET MYEXTLIB
- NAME NEEDS_LINKING NOECHO NORECURS OBJECT OPTIMIZE PERL PERLMAINCC
- PERL_ARCHLIB PERL_LIB PERL_SRC PL_FILES PM PMLIBDIRS PREFIX
+ 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 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
-
- IMPORTS
-
- installpm
/;
- # IMPORTS is used under OS/2
-
- # ^^^ installpm is deprecated, will go about Summer 96
+ # IMPORTS is used under OS/2 and Win32
# @Overridable is close to @MM_Sections but not identical. The
# order is important. Many subroutines declare macros. These
@@ -278,15 +274,15 @@ sub full_setup {
c_o xs_c xs_o top_targets linkext dlsyms dynamic dynamic_bs
dynamic_lib static static_lib manifypods processPL installbin subdirs
clean realclean dist_basics dist_core dist_dir dist_test dist_ci
- install force perldepend makefile staticmake test
+ install force perldepend makefile staticmake test ppd
); # loses section ordering
@Overridable = @MM_Sections;
push @Overridable, qw[
- dir_target libscan makeaperl needs_linking subdir_x test_via_harness
- test_via_script
+ dir_target libscan makeaperl needs_linking perm_rw perm_rwx
+ subdir_x test_via_harness test_via_script
];
@@ -307,7 +303,7 @@ sub full_setup {
@Get_from_Config =
qw(
ar cc cccdlflags ccdlflags dlext dlsrc ld lddlflags ldflags libc
- lib_ext obj_ext ranlib sitelibexp sitearchexp so exe_ext
+ lib_ext obj_ext osname osvers ranlib sitelibexp sitearchexp so exe_ext
);
my $item;
@@ -381,8 +377,9 @@ sub ExtUtils::MakeMaker::new {
eval $eval;
if ($@){
warn "Warning: prerequisite $prereq $self->{PREREQ_PM}->{$prereq} not found";
- } else {
- delete $self->{PREREQ_PM}{$prereq};
+# Why is/was this 'delete' here? We need PREREQ_PM later to make PPDs.
+# } else {
+# delete $self->{PREREQ_PM}{$prereq};
}
}
# if (@unsatisfied){
@@ -419,6 +416,7 @@ sub ExtUtils::MakeMaker::new {
}
my $newclass = ++$PACKNAME;
+ local @Parent = @Parent; # Protect against non-local exits
{
# no strict;
print "Blessing Object into class [$newclass]\n" if $Verbose>=2;
@@ -441,9 +439,17 @@ sub ExtUtils::MakeMaker::new {
unless $self->file_name_is_absolute($self->{$key})
|| ($^O eq 'VMS' and ($key =~ /PERL$/ && $self->{$key} =~ /^[\w\-\$]+$/));
}
- $self->{PARENT}->{CHILDREN}->{$newclass} = $self if $self->{PARENT};
+ if ($self->{PARENT}) {
+ $self->{PARENT}->{CHILDREN}->{$newclass} = $self;
+ if (exists $self->{PARENT}->{CAPI}
+ and not exists $self->{CAPI})
+ {
+ # inherit, but only if already unspecified
+ $self->{CAPI} = $self->{PARENT}->{CAPI};
+ }
+ }
} else {
- parse_args($self,@ARGV);
+ parse_args($self,split(' ', $ENV{PERL_MM_OPT} || ''),@ARGV);
}
$self->{NAME} ||= $self->guess_name;
@@ -478,6 +484,9 @@ END
$self->init_dirscan();
$self->init_others();
+ my($argv) = neatvalue(\@ARGV);
+ $argv =~ s/^\[/(/;
+ $argv =~ s/\]$/)/;
push @{$self->{RESULT}}, <<END;
# This Makefile is for the $self->{NAME} extension to perl.
@@ -488,6 +497,8 @@ END
#
# ANY CHANGES MADE HERE WILL BE LOST!
#
+# MakeMaker ARGV: $argv
+#
# MakeMaker Parameters:
END
@@ -532,11 +543,33 @@ END
}
push @{$self->{RESULT}}, "\n# End.";
- pop @Parent;
$self;
}
+sub WriteEmptyMakefile {
+ if (-f 'Makefile.old') {
+ chmod 0666, 'Makefile.old';
+ unlink 'Makefile.old' or warn "unlink Makefile.old: $!";
+ }
+ rename 'Makefile', 'Makefile.old' or warn "rename Makefile Makefile.old: $!"
+ if -f 'Makefile';
+ open MF, '> Makefile' or die "open Makefile for write: $!";
+ print MF <<'EOP';
+all:
+
+clean:
+
+install:
+
+makemakerdflt:
+
+test:
+
+EOP
+ close MF or die "close Makefile for write: $!";
+}
+
sub check_manifest {
print STDOUT "Checking if your kit is complete...\n";
require ExtUtils::Manifest;
@@ -994,7 +1027,7 @@ This will replace the string specified by $Config{prefix} in all
$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 parmeters LIB,
+by perl by default, nor by make. Conflicts between parameters LIB,
PREFIX and the various INSTALL* arguments are resolved so that
XXX
@@ -1144,12 +1177,33 @@ recommends it (or you know what you're doing).
The following attributes can be specified as arguments to WriteMakefile()
or as NAME=VALUE pairs on the command line:
-=cut
+=over 2
-# The following "=item C" is used by the attrib_help routine
-# likewise the "=back" below. So be careful when changing it!
+=item AUTHOR
-=over 2
+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.
+
+=item ABSTRACT_FROM
+
+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 BINARY_LOCATION
+
+Used when creating PPD files for binary packages. It can be set to a
+full or relative path or URL to the binary archive for a particular
+architecture. For example:
+
+ perl Makefile.PL BINARY_LOCATION=x86/Agent.tar.gz
+
+builds a PPD package that references a binary of the C<Agent> package,
+located in the C<x86> directory relative to the PPD itself.
=item C
@@ -1157,6 +1211,14 @@ Ref to array of *.c file names. Initialised from a directory scan
and the values portion of the XS attribute hash. This is not
currently used by MakeMaker but may be handy in Makefile.PLs.
+=item CAPI
+
+Switch to force usage of the Perl C API even when compiling for PERL_OBJECT.
+
+Note that this attribute is passed through to any recursive build,
+but if and only if the submodule's Makefile.PL itself makes no mention
+of the 'CAPI' attribute.
+
=item CCFLAGS
String that will be included in the compiler call command line between
@@ -1205,12 +1267,12 @@ NAME above.
=item DL_FUNCS
-Hashref of symbol names for routines to be made available as
-universal symbols. Each key/value pair consists of the package name
-and an array of routine names in that package. Used only under AIX
-(export lists) and VMS (linker options) at present. The routine
-names supplied will be expanded in the same way as XSUB names are
-expanded by the XS() macro. Defaults to
+Hashref of symbol names for routines to be made available as universal
+symbols. Each key/value pair consists of the package name and an
+array of routine names in that package. Used only under AIX, OS/2,
+VMS and Win32 at present. The routine names supplied will be expanded
+in the same way as XSUB names are expanded by the XS() macro.
+Defaults to
{"$(NAME)" => ["boot_$(NAME)" ] }
@@ -1219,12 +1281,14 @@ e.g.
{"RPC" => [qw( boot_rpcb rpcb_gettime getnetconfigent )],
"NetconfigPtr" => [ 'DESTROY'] }
+Please see the L<ExtUtils::Mksymlists> documentation for more information
+about the DL_FUNCS, DL_VARS and FUNCLIST attributes.
+
=item DL_VARS
-Array of symbol names for variables to be made available as
-universal symbols. Used only under AIX (export lists) and VMS
-(linker options) at present. Defaults to []. (e.g. [ qw(
-Foo_version Foo_numstreams Foo_tree ) ])
+Array of symbol names for variables to be made available as universal symbols.
+Used only under AIX, OS/2, VMS and Win32 at present. Defaults to [].
+(e.g. [ qw(Foo_version Foo_numstreams Foo_tree ) ])
=item EXCLUDE_EXT
@@ -1233,7 +1297,7 @@ is ignored if INCLUDE_EXT is present. Consult INCLUDE_EXT for more
details. (e.g. [ qw( Socket POSIX ) ] )
This attribute may be most useful when specified as a string on the
-commandline: perl Makefile.PL EXCLUDE_EXT='Socket Safe'
+command line: perl Makefile.PL EXCLUDE_EXT='Socket Safe'
=item EXE_FILES
@@ -1241,13 +1305,6 @@ Ref to array of executable files. The files will be copied to the
INST_SCRIPT directory. Make realclean will delete them from there
again.
-=item NO_VC
-
-In general any generated Makefile checks for the current version of
-MakeMaker and the version the Makefile was built under. If NO_VC is
-set, the version check is neglected. Do not write this into your
-Makefile.PL, use it interactively instead.
-
=item FIRST_MAKEFILE
The name of the Makefile to be produced. Defaults to the contents of
@@ -1258,13 +1315,21 @@ that will be produced for the MAP_TARGET.
Perl binary able to run this extension.
+=item FUNCLIST
+
+This provides an alternate means to specify function names to be
+exported from the extension. Its value is a reference to an
+array of function names to be exported by the extension. These
+names are passed through unaltered to the linker options file.
+
=item H
Ref to array of *.h file names. Similar to C.
=item IMPORTS
-IMPORTS is only used on OS/2.
+This attribute is used to specify names to be imported into the
+extension. It is only used on OS/2 and Win32.
=item INC
@@ -1283,7 +1348,7 @@ filling in INCLUDE_EXT. If the INCLUDE_EXT is mentioned but is empty then
only DynaLoader and the current extension will be included in the build.
This attribute may be most useful when specified as a string on the
-commandline: perl Makefile.PL INCLUDE_EXT='POSIX Socket Devel::Peek'
+command line: perl Makefile.PL INCLUDE_EXT='POSIX Socket Devel::Peek'
=item INSTALLARCHLIB
@@ -1321,14 +1386,14 @@ directory if INSTALLDIRS is set to perl.
Used by 'make install' which copies files from INST_SCRIPT to this
directory.
-=item INSTALLSITELIB
+=item INSTALLSITEARCH
-Used by 'make install', which copies files from INST_LIB to this
+Used by 'make install', which copies files from INST_ARCHLIB to this
directory if INSTALLDIRS is set to site (default).
-=item INSTALLSITEARCH
+=item INSTALLSITELIB
-Used by 'make install', which copies files from INST_ARCHLIB to this
+Used by 'make install', which copies files from INST_LIB to this
directory if INSTALLDIRS is set to site (default).
=item INST_ARCHLIB
@@ -1371,16 +1436,16 @@ defaults to "$(OBJECT)" and is used in the ld command to specify
what files to link/load from (also see dynamic_lib below for how to
specify ld flags)
-=item LIBPERL_A
-
-The filename of the perllibrary that will be used together with this
-extension. Defaults to libperl.a.
-
=item LIB
LIB can only be set at C<perl Makefile.PL> time. It has the effect of
setting both INSTALLPRIVLIB and INSTALLSITELIB to that value regardless any
+=item LIBPERL_A
+
+The filename of the perllibrary that will be used together with this
+extension. Defaults to libperl.a.
+
=item LIBS
An anonymous array of alternative library
@@ -1465,6 +1530,13 @@ itself.
Boolean. Attribute to inhibit descending into subdirectories.
+=item NO_VC
+
+In general any generated Makefile checks for the current version of
+MakeMaker and the version the Makefile was built under. If NO_VC is
+set, the version check is neglected. Do not write this into your
+Makefile.PL, use it interactively instead.
+
=item OBJECT
List of object files, defaults to '$(BASEEXT)$(OBJ_EXT)', but can be a long
@@ -1498,6 +1570,16 @@ Directory containing the Perl library to use.
Directory containing the Perl source code (use of this should be
avoided, it may be undefined)
+=item PERM_RW
+
+Desired permission for read/writable files. Defaults to C<644>.
+See also L<MM_Unix/perm_rw>.
+
+=item PERM_RWX
+
+Desired permission for executable files. Defaults to C<755>.
+See also L<MM_Unix/perm_rwx>.
+
=item PL_FILES
Ref to hash of files to be processed as perl programs. MakeMaker
@@ -1507,7 +1589,11 @@ and the basename of the file being the value. E.g.
{'foobar.PL' => 'foobar'}
The *.PL files are expected to produce output to the target files
-themselves.
+themselves. If multiple files can be generated from the same *.PL
+file then the value in the hash can be a reference to an array of
+target file names. E.g.
+
+ {'foobar.PL' => ['foobar1','foobar2']}
=item PM
@@ -1515,19 +1601,27 @@ Hashref of .pm files and *.pl files to be installed. e.g.
{'name_of_file.pm' => '$(INST_LIBDIR)/install_as.pm'}
-By default this will include *.pm and *.pl. If a lib directory
-exists and is not listed in DIR (above) then any *.pm and *.pl files
-it contains will also be included by default. Defining PM in the
+By default this will include *.pm and *.pl and the files found in
+the PMLIBDIRS directories. Defining PM in the
Makefile.PL will override PMLIBDIRS.
=item PMLIBDIRS
Ref to array of subdirectories containing library files. Defaults to
-[ 'lib', $(BASEEXT) ]. The directories will be scanned and any files
+[ 'lib', $(BASEEXT) ]. The directories will be scanned and I<any> files
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.
+=item PPM_INSTALL_EXEC
+
+Name of the executable used to run C<PPM_INSTALL_SCRIPT> below. (e.g. perl)
+
+=item PPM_INSTALL_SCRIPT
+
+Name of the script that gets executed by the Perl Package Manager after
+the installation of a package.
+
=item PREFIX
Can be used to set the three INSTALL* attributes in one go (except for
@@ -1581,7 +1675,7 @@ MakeMaker object. The following lines will be parsed o.k.:
$VERSION = '1.00';
*VERSION = \'1.01';
- ( $VERSION ) = '$Revision: 1.2 $ ' =~ /\$Revision:\s+([^\s]+)/;
+ ( $VERSION ) = '$Revision: 1.3 $ ' =~ /\$Revision:\s+([^\s]+)/;
$FOO::VERSION = '1.10';
*FOO::VERSION = \'1.11';
@@ -1647,7 +1741,7 @@ part of the Makefile.
=item dist
- {TARFLAGS => 'cvfF', COMPRESS => 'gzip', SUFFIX => 'gz',
+ {TARFLAGS => 'cvfF', COMPRESS => 'gzip', SUFFIX => '.gz',
SHAR => 'shar -m', DIST_CP => 'ln', ZIP => '/bin/zip',
ZIPFLAGS => '-rl', DIST_DEFAULT => 'private tardist' }
@@ -1662,10 +1756,6 @@ links the rest. Default is 'best'.
{ARMAYBE => 'ar', OTHERLDFLAGS => '...', INST_DYNAMIC_DEP => '...'}
-=item installpm
-
-Deprecated as of MakeMaker 5.23. See L<ExtUtils::MM_Unix/pm_to_blib>.
-
=item linkext
{LINKTYPE => 'static', 'dynamic' or ''}
@@ -1692,12 +1782,6 @@ be linked.
=back
-=cut
-
-# bug in pod2html, so leave the =back
-
-# Don't delete this cut, MM depends on it!
-
=head2 Overriding MakeMaker Methods
If you cannot achieve the desired Makefile behaviour by specifying
@@ -1717,14 +1801,14 @@ or you can edit the default by saying something like:
$inherited;
}
-If you running experiments with embedding perl as a library into other
-applications, you might find MakeMaker not sufficient. You'd better
-have a look at ExtUtils::embed which is a collection of utilities for
-embedding.
+If you are running experiments with embedding perl as a library into
+other applications, you might find MakeMaker is not sufficient. You'd
+better have a look at ExtUtils::Embed which is a collection of utilities
+for embedding.
If you still need a different solution, try to develop another
-subroutine, that fits your needs and submit the diffs to
-F<perl5-porters@nicoh.com> or F<comp.lang.perl.misc> as appropriate.
+subroutine that fits your needs and submit the diffs to
+F<perl5-porters@perl.org> or F<comp.lang.perl.moderated> as appropriate.
For a complete description of all MakeMaker methods see L<ExtUtils::MM_Unix>.
@@ -1842,13 +1926,13 @@ reference to the dist attribute of the WriteMakefile call. The
following parameters are recognized:
CI ('ci -u')
- COMPRESS ('compress')
+ COMPRESS ('gzip --best')
POSTOP ('@ :')
PREOP ('@ :')
TO_UNIX (depends on the system)
RCS_LABEL ('rcs -q -Nv$(VERSION_SYM):')
SHAR ('shar')
- SUFFIX ('Z')
+ SUFFIX ('.gz')
TAR ('tar')
TARFLAGS ('cvf')
ZIP ('zip')
@@ -1856,18 +1940,47 @@ following parameters are recognized:
An example:
- WriteMakefile( 'dist' => { COMPRESS=>"gzip", SUFFIX=>"gz" })
+ WriteMakefile( 'dist' => { COMPRESS=>"bzip2", SUFFIX=>".bz2" })
+
+=head2 Disabling an extension
+
+If some events detected in F<Makefile.PL> imply that there is no way
+to create the Module, but this is a normal state of things, then you
+can create a F<Makefile> which does nothing, but succeeds on all the
+"usual" build targets. To do so, use
+
+ ExtUtils::MakeMaker::WriteEmptyMakefile();
+
+instead of WriteMakefile().
+
+This may be useful if other modules expect this module to be I<built>
+OK, as opposed to I<work> OK (say, this system-dependent module builds
+in a subdirectory of some other distribution, or is listed as a
+dependency in a CPAN::Bundle, but the functionality is supported by
+different means on the current architecture).
+
+=head1 ENVIRONMENT
+
+=over 8
+
+=item PERL_MM_OPT
+
+Command line options used by C<MakeMaker-E<gt>new()>, and thus by
+C<WriteMakefile()>. The string is split on whitespace, and the result
+is processed before any actual command line arguments are processed.
+
+=back
=head1 SEE ALSO
ExtUtils::MM_Unix, ExtUtils::Manifest, ExtUtils::testlib,
-ExtUtils::Install, ExtUtils::embed
+ExtUtils::Install, ExtUtils::Embed
=head1 AUTHORS
Andy Dougherty <F<doughera@lafcol.lafayette.edu>>, Andreas KE<ouml>nig
<F<A.Koenig@franz.ww.TU-Berlin.DE>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>.
-VMS support by Charles Bailey <F<bailey@genetics.upenn.edu>>. OS/2
+VMS support by Charles Bailey <F<bailey@newman.upenn.edu>>. OS/2
support by Ilya Zakharevich <F<ilya@math.ohio-state.edu>>. Contact the
makemaker mailing list C<mailto:makemaker@franz.ww.tu-berlin.de>, if
you have any questions.
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Manifest.pm b/gnu/usr.bin/perl/lib/ExtUtils/Manifest.pm
index cc323c8924f..f2f62dec39d 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/Manifest.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Manifest.pm
@@ -10,7 +10,7 @@ use strict;
use vars qw($VERSION @ISA @EXPORT_OK
$Is_VMS $Debug $Verbose $Quiet $MANIFEST $found);
-$VERSION = substr(q$Revision: 1.2 $, 10);
+$VERSION = substr(q$Revision: 1.3 $, 10);
@ISA=('Exporter');
@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck',
'skipcheck', 'maniread', 'manicopy');
@@ -87,10 +87,16 @@ sub _manicheck {
my $read = maniread();
my $found = manifind();
my $file;
+ my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
my(@missfile,@missentry);
if ($arg & 1){
foreach $file (sort keys %$read){
warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
+ if ($dosnames){
+ $file = lc $file;
+ $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge;
+ $file =~ s=((\w|-)+)=substr ($1,0,8)=ge;
+ }
unless ( exists $found->{$file} ) {
warn "No such file: $file\n" unless $Quiet;
push @missfile, $file;
@@ -236,7 +242,11 @@ sub ln {
link($srcFile, $dstFile);
local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
my $mode= 0444 | (stat)[2] & 0700;
- chmod( $mode | ( $mode & 0100 ? 0111 : 0 ), $_ );
+ if (! chmod( $mode | ( $mode & 0100 ? 0111 : 0 ), $_ )) {
+ unlink $dstFile;
+ return;
+ }
+ 1;
}
sub best {
@@ -288,7 +298,7 @@ but in doing so checks each line in an existing C<MANIFEST> file and
includes any comments that are found in the existing C<MANIFEST> file
in the new one. Anything between white space and an end of line within
a C<MANIFEST> file is considered to be a comment. Filenames and
-comments are seperated by one or more TAB characters in the
+comments are separated by one or more TAB characters in the
output. All files that match any regular expression in a file
C<MANIFEST.SKIP> (if such a file exists) are ignored.
@@ -307,7 +317,7 @@ Fullcheck() does both a manicheck() and a filecheck().
Skipcheck() lists all the files that are skipped due to your
C<MANIFEST.SKIP> file.
-Manifind() retruns a hash reference. The keys of the hash are the
+Manifind() returns a hash reference. The keys of the hash are the
files found below the current directory.
Maniread($file) reads a named C<MANIFEST> file (defaults to
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Mkbootstrap.pm b/gnu/usr.bin/perl/lib/ExtUtils/Mkbootstrap.pm
index ff0aa096b3e..907c168b434 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/Mkbootstrap.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Mkbootstrap.pm
@@ -1,7 +1,7 @@
package ExtUtils::Mkbootstrap;
-$VERSION = substr q$Revision: 1.2 $, 10;
-# $Date: 1997/11/30 07:57:31 $
+$VERSION = substr q$Revision: 1.3 $, 10;
+# $Date: 1999/04/29 22:51:53 $
use Config;
use Exporter;
@@ -49,7 +49,7 @@ sub Mkbootstrap {
print BS "# $baseext DynaLoader bootstrap file for $^O architecture.\n";
print BS "# Do not edit this file, changes will be lost.\n";
print BS "# This file was automatically generated by the\n";
- print BS "# Mkbootstrap routine in ExtUtils::Mkbootstrap (v$Version).\n";
+ print BS "# Mkbootstrap routine in ExtUtils::Mkbootstrap (v$VERSION).\n";
print BS "\@DynaLoader::dl_resolve_using = ";
# If @all contains names in the form -lxxx or -Lxxx then it's asking for
# runtime library location so we automatically add a call to dl_findfile()
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Mksymlists.pm b/gnu/usr.bin/perl/lib/ExtUtils/Mksymlists.pm
index f47235d990b..1f2819dc221 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/Mksymlists.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Mksymlists.pm
@@ -7,7 +7,7 @@ use Exporter;
use vars qw( @ISA @EXPORT $VERSION );
@ISA = 'Exporter';
@EXPORT = '&Mksymlists';
-$VERSION = substr q$Revision: 1.2 $, 10;
+$VERSION = substr q$Revision: 1.3 $, 10;
sub Mksymlists {
my(%spec) = @_;
@@ -19,10 +19,10 @@ sub Mksymlists {
$spec{DL_VARS} = [] unless $spec{DL_VARS};
($spec{FILE} = $spec{NAME}) =~ s/.*::// unless $spec{FILE};
+ $spec{FUNCLIST} = [] unless $spec{FUNCLIST};
$spec{DL_FUNCS} = { $spec{NAME} => [] }
unless ( ($spec{DL_FUNCS} and keys %{$spec{DL_FUNCS}}) or
- $spec{FUNCLIST});
- $spec{FUNCLIST} = [] unless $spec{FUNCLIST};
+ @{$spec{FUNCLIST}});
if (defined $spec{DL_FUNCS}) {
my($package);
foreach $package (keys %{$spec{DL_FUNCS}}) {
@@ -69,6 +69,8 @@ sub _write_aix {
sub _write_os2 {
my($data) = @_;
+ require Config;
+ my $threaded = ($Config::Config{archname} =~ /-thread/ ? " threaded" : "");
if (not $data->{DLBASE}) {
($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
@@ -79,6 +81,7 @@ sub _write_os2 {
open(DEF,">$data->{FILE}.def")
or croak("Can't create $data->{FILE}.def: $!\n");
print DEF "LIBRARY '$data->{DLBASE}' INITINSTANCE TERMINSTANCE\n";
+ print DEF "DESCRIPTION 'Perl (v$]$threaded) module $data->{NAME} v$data->{VERSION}'\n";
print DEF "CODE LOADONCALL\n";
print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n";
print DEF "EXPORTS\n ";
@@ -86,10 +89,10 @@ sub _write_os2 {
print DEF join("\n ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
if (%{$data->{IMPORTS}}) {
print DEF "IMPORTS\n";
-my ($name, $exp);
-while (($name, $exp)= each %{$data->{IMPORTS}}) {
- print DEF " $name=$exp\n";
-}
+ my ($name, $exp);
+ while (($name, $exp)= each %{$data->{IMPORTS}}) {
+ print DEF " $name=$exp\n";
+ }
}
close DEF;
}
@@ -107,9 +110,9 @@ sub _write_win32 {
open(DEF,">$data->{FILE}.def")
or croak("Can't create $data->{FILE}.def: $!\n");
# put library name in quotes (it could be a keyword, like 'Alias')
- print DEF "LIBRARY \"$data->{DLBASE}\"\n";
- print DEF "CODE LOADONCALL\n";
- print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n";
+ if ($Config::Config{'cc'} !~ /^gcc/i) {
+ print DEF "LIBRARY \"$data->{DLBASE}\"\n";
+ }
print DEF "EXPORTS\n ";
my @syms;
# Export public symbols both with and without underscores to
@@ -174,13 +177,6 @@ sub _write_vms {
}
close OPT;
- # Options file specifying RTLs to which this extension must be linked.
- # Eventually, the list of libraries will be supplied by a working
- # extliblist routine.
- open OPT,'>rtls.opt';
- print OPT "PerlShr/Share\n";
- foreach $rtl (split(/\s+/,$Config::Config{'libs'})) { print OPT "$rtl\n"; }
- close OPT;
}
1;
@@ -211,10 +207,13 @@ keys are recognized:
=over
-=item NAME
+=item DLBASE
-This gives the name of the extension (I<e.g.> Tk::Canvas) for which
-the linker option file will be produced.
+This item specifies the name by which the linker knows the
+extension, which may be different from the name of the
+extension itself (for instance, some linkers add an '_' to the
+name of the extension). If it is not specified, it is derived
+from the NAME attribute. It is presently used only by OS2 and Win32.
=item DL_FUNCS
@@ -223,7 +222,7 @@ from which it is usually taken. Its value is a reference to an
associative array, in which each key is the name of a package, and
each value is an a reference to an array of function names which
should be exported by the extension. For instance, one might say
-C<DL_FUNCS =E<gt> { Homer::Iliad =E<gt> [ qw(trojans greeks) ],
+C<DL_FUNCS =E<gt> { Homer::Iliad =E<gt> [ qw(trojans greeks) ],
Homer::Odyssey =E<gt> [ qw(travellers family suitors) ] }>. The
function names should be identical to those in the XSUB code;
C<Mksymlists> will alter the names written to the linker option
@@ -247,7 +246,7 @@ be exported by the extension.
This key can be used to specify the name of the linker option file
(minus the OS-specific extension), if for some reason you do not
want to use the default value, which is the last word of the NAME
-attribute (I<e.g.> for Tk::Canvas, FILE defaults to 'Canvas').
+attribute (I<e.g.> for C<Tk::Canvas>, FILE defaults to C<Canvas>).
=item FUNCLIST
@@ -255,14 +254,25 @@ This provides an alternate means to specify function names to be
exported from the extension. Its value is a reference to an
array of function names to be exported by the extension. These
names are passed through unaltered to the linker options file.
+Specifying a value for the FUNCLIST attribute suppresses automatic
+generation of the bootstrap function for the package. To still create
+the bootstrap name you have to specify the package name in the
+DL_FUNCS hash:
-=item DLBASE
+ Mksymlists({ NAME => $name ,
+ FUNCLIST => [ $func1, $func2 ],
+ DL_FUNCS => { $pkg => [] } });
-This item specifies the name by which the linker knows the
-extension, which may be different from the name of the
-extension itself (for instance, some linkers add an '_' to the
-name of the extension). If it is not specified, it is derived
-from the NAME attribute. It is presently used only by OS2.
+
+=item IMPORTS
+
+This attribute is used to specify names to be imported into the
+extension. It is currently only used by OS/2 and Win32.
+
+=item NAME
+
+This gives the name of the extension (I<e.g.> C<Tk::Canvas>) for which
+the linker option file will be produced.
=back
@@ -273,7 +283,7 @@ can be used to provide additional information to the linker.
=head1 AUTHOR
-Charles Bailey I<E<lt>bailey@genetics.upenn.eduE<gt>>
+Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>>
=head1 REVISION
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/testlib.pm b/gnu/usr.bin/perl/lib/ExtUtils/testlib.pm
index 57ea87c82fe..91ea6596dd6 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/testlib.pm
+++ b/gnu/usr.bin/perl/lib/ExtUtils/testlib.pm
@@ -1,6 +1,6 @@
package ExtUtils::testlib;
-$VERSION = substr q$Revision: 1.2 $, 10;
-# $Id: testlib.pm,v 1.2 1997/11/30 07:57:32 millert Exp $
+$VERSION = substr q$Revision: 1.3 $, 10;
+# $Id: testlib.pm,v 1.3 1999/04/29 22:51:53 millert Exp $
use lib qw(blib/arch blib/lib);
1;
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/typemap b/gnu/usr.bin/perl/lib/ExtUtils/typemap
index 20cc96f0b55..b1ec063dd75 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/typemap
+++ b/gnu/usr.bin/perl/lib/ExtUtils/typemap
@@ -1,12 +1,12 @@
# $Header$
# basic C types
int T_IV
-unsigned T_IV
-unsigned int T_IV
+unsigned T_UV
+unsigned int T_UV
long T_IV
-unsigned long T_IV
+unsigned long T_UV
short T_IV
-unsigned short T_IV
+unsigned short T_UV
char T_CHAR
unsigned char T_U_CHAR
char * T_PV
@@ -34,7 +34,7 @@ I16 T_IV
I8 T_IV
U32 T_U_LONG
U16 T_U_SHORT
-U8 T_IV
+U8 T_UV
Result T_U_CHAR
Boolean T_IV
double T_DOUBLE
@@ -73,6 +73,8 @@ T_CVREF
croak(\"$var is not of type ${ntype}\")
T_SYSRET
$var NOT IMPLEMENTED
+T_UV
+ $var = ($type)SvUV($arg)
T_IV
$var = ($type)SvIV($arg)
T_INT
@@ -82,19 +84,19 @@ T_ENUM
T_BOOL
$var = (int)SvIV($arg)
T_U_INT
- $var = (unsigned int)SvIV($arg)
+ $var = (unsigned int)SvUV($arg)
T_SHORT
$var = (short)SvIV($arg)
T_U_SHORT
- $var = (unsigned short)SvIV($arg)
+ $var = (unsigned short)SvUV($arg)
T_LONG
$var = (long)SvIV($arg)
T_U_LONG
- $var = (unsigned long)SvIV($arg)
+ $var = (unsigned long)SvUV($arg)
T_CHAR
- $var = (char)*SvPV($arg,na)
+ $var = (char)*SvPV($arg,PL_na)
T_U_CHAR
- $var = (unsigned char)SvIV($arg)
+ $var = (unsigned char)SvUV($arg)
T_FLOAT
$var = (float)SvNV($arg)
T_NV
@@ -102,7 +104,7 @@ T_NV
T_DOUBLE
$var = (double)SvNV($arg)
T_PV
- $var = ($type)SvPV($arg,na)
+ $var = ($type)SvPV($arg,PL_na)
T_PTR
$var = ($type)SvIV($arg)
T_PTRREF
@@ -158,7 +160,7 @@ T_REFOBJ
T_OPAQUE
$var NOT IMPLEMENTED
T_OPAQUEPTR
- $var = ($type)SvPV($arg,na)
+ $var = ($type)SvPV($arg,PL_na)
T_PACKED
$var = XS_unpack_$ntype($arg)
T_PACKEDARRAY
@@ -191,6 +193,8 @@ T_CVREF
$arg = newRV((SV*)$var);
T_IV
sv_setiv($arg, (IV)$var);
+T_UV
+ sv_setuv($arg, (UV)$var);
T_INT
sv_setiv($arg, (IV)$var);
T_SYSRET
@@ -205,19 +209,19 @@ T_ENUM
T_BOOL
$arg = boolSV($var);
T_U_INT
- sv_setiv($arg, (IV)$var);
+ sv_setuv($arg, (UV)$var);
T_SHORT
sv_setiv($arg, (IV)$var);
T_U_SHORT
- sv_setiv($arg, (IV)$var);
+ sv_setuv($arg, (UV)$var);
T_LONG
sv_setiv($arg, (IV)$var);
T_U_LONG
- sv_setiv($arg, (IV)$var);
+ sv_setuv($arg, (UV)$var);
T_CHAR
sv_setpvn($arg, (char *)&$var, 1);
T_U_CHAR
- sv_setiv($arg, (IV)$var);
+ sv_setuv($arg, (UV)$var);
T_FLOAT
sv_setnv($arg, (double)$var);
T_NV
@@ -262,14 +266,14 @@ T_ARRAY
ST(ix_$var) = sv_newmortal();
DO_ARRAY_ELEM
}
- sp += $var.size - 1;
+ SP += $var.size - 1;
T_IN
{
GV *gv = newGVgen("$Package");
if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
else
- $arg = &sv_undef;
+ $arg = &PL_sv_undef;
}
T_INOUT
{
@@ -277,7 +281,7 @@ T_INOUT
if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
else
- $arg = &sv_undef;
+ $arg = &PL_sv_undef;
}
T_OUT
{
@@ -285,5 +289,5 @@ T_OUT
if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
else
- $arg = &sv_undef;
+ $arg = &PL_sv_undef;
}
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/xsubpp b/gnu/usr.bin/perl/lib/ExtUtils/xsubpp
index 04de166ad67..1ee7b29449e 100644
--- a/gnu/usr.bin/perl/lib/ExtUtils/xsubpp
+++ b/gnu/usr.bin/perl/lib/ExtUtils/xsubpp
@@ -6,7 +6,7 @@ xsubpp - compiler to convert Perl XS code into C code
=head1 SYNOPSIS
-B<xsubpp> [B<-v>] [B<-C++>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-nolinenumbers>] [B<-typemap typemap>]... file.xs
+B<xsubpp> [B<-v>] [B<-C++>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-nolinenumbers>] [B<-typemap typemap>] [B<-object_capi>]... file.xs
=head1 DESCRIPTION
@@ -59,7 +59,11 @@ number.
Prevents the inclusion of `#line' directives in the output.
-=back
+=item B<-object_capi>
+
+Compile code as C in a PERL_OBJECT environment.
+
+back
=head1 ENVIRONMENT
@@ -82,12 +86,15 @@ perl(1), perlxs(1), perlxstut(1)
require 5.002;
use Cwd;
use vars '$cplusplus';
+use vars '%v';
+
+use Config;
sub Q ;
# Global Constants
-$XSUBPP_version = "1.9505";
+$XSUBPP_version = "1.9507";
my ($Is_VMS, $SymSet);
if ($^O eq 'VMS') {
@@ -103,6 +110,8 @@ $FH = 'File0000' ;
$usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-s pattern] [-typemap typemap]... file.xs\n";
$proto_re = "[" . quotemeta('\$%&*@;') . "]" ;
+# mjn
+$OBJ = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i;
$except = "";
$WantPrototypes = -1 ;
@@ -118,6 +127,7 @@ SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) {
$WantPrototypes = 1, next SWITCH if $flag eq 'prototypes';
$WantVersionChk = 0, next SWITCH if $flag eq 'noversioncheck';
$WantVersionChk = 1, next SWITCH if $flag eq 'versioncheck';
+ $WantCAPI = 1, next SWITCH if $flag eq 'object_capi';
$except = " TRY", next SWITCH if $flag eq 'except';
push(@tm,shift), next SWITCH if $flag eq 'typemap';
$WantLineNumbers = 0, next SWITCH if $flag eq 'nolinenumbers';
@@ -234,7 +244,7 @@ $END = "!End!\n\n"; # "impossible" keyword (multiple newline)
$BLOCK_re= '\s*(' . join('|', qw(
REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT
CLEANUP ALIAS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
- SCOPE
+ SCOPE INTERFACE INTERFACE_MACRO C_ARGS
)) . "|$END)\\s*:";
# Input: ($_, @line) == unparsed input.
@@ -301,6 +311,20 @@ sub print_section {
print "$xsubpp::counter::SECTION_END_MARKER\n" if $WantLineNumbers;
}
+sub merge_section {
+ my $in = '';
+
+ while (!/\S/ && @line) {
+ $_ = shift(@line);
+ }
+
+ for (; defined($_) && !/^$BLOCK_re/o; $_ = shift(@line)) {
+ $in .= "$_\n";
+ }
+ chomp $in;
+ return $in;
+}
+
sub process_keyword($)
{
my($pattern) = @_ ;
@@ -328,11 +352,11 @@ sub INPUT_handler {
my $line = $_ ;
# remove trailing semicolon if no initialisation
- s/\s*;$//g unless /=/ ;
+ s/\s*;$//g unless /[=;+].*\S/ ;
# check for optional initialisation code
my $var_init = '' ;
- $var_init = $1 if s/\s*(=.*)$//s ;
+ $var_init = $1 if s/\s*([=;+].*)$//s ;
$var_init =~ s/"/\\"/g;
s/\s+/ /g;
@@ -355,10 +379,10 @@ sub INPUT_handler {
$var_addr{$var_name} = 1;
$func_args =~ s/\b($var_name)\b/&$1/;
}
- if ($var_init =~ /^=\s*NO_INIT\s*;?\s*$/) {
+ if ($var_init =~ /^[=;]\s*NO_INIT\s*;?\s*$/) {
print "\t$var_name;\n";
} elsif ($var_init =~ /\S/) {
- &output_init($var_type, $var_num, "$var_name $var_init");
+ &output_init($var_type, $var_num, $var_name, $var_init);
} elsif ($var_num) {
# generate initialization code
&generate_init($var_type, $var_num, $var_name);
@@ -371,6 +395,10 @@ sub INPUT_handler {
sub OUTPUT_handler {
for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
next unless /\S/;
+ if (/^\s*SETMAGIC\s*:\s*(ENABLE|DISABLE)\s*/) {
+ $DoSetMagic = ($1 eq "ENABLE" ? 1 : 0);
+ next;
+ }
my ($outarg, $outcode) = /^\s*(\S+)\s*(.*?)\s*$/s ;
blurt ("Error: duplicate OUTPUT argument '$outarg' ignored"), next
if $outargs{$outarg} ++ ;
@@ -384,15 +412,52 @@ sub OUTPUT_handler {
unless defined($args_match{$outarg});
blurt("Error: No input definition for OUTPUT argument '$outarg' - ignored"), next
unless defined $var_types{$outarg} ;
+ $var_num = $args_match{$outarg};
if ($outcode) {
print "\t$outcode\n";
+ print "\tSvSETMAGIC(ST(" , $var_num-1 , "));\n" if $DoSetMagic;
} else {
- $var_num = $args_match{$outarg};
- &generate_output($var_types{$outarg}, $var_num, $outarg);
+ &generate_output($var_types{$outarg}, $var_num, $outarg, $DoSetMagic);
}
}
}
+sub C_ARGS_handler() {
+ my $in = merge_section();
+
+ TrimWhitespace($in);
+ $func_args = $in;
+}
+
+sub INTERFACE_MACRO_handler() {
+ my $in = merge_section();
+
+ TrimWhitespace($in);
+ if ($in =~ /\s/) { # two
+ ($interface_macro, $interface_macro_set) = split ' ', $in;
+ } else {
+ $interface_macro = $in;
+ $interface_macro_set = 'UNKNOWN_CVT'; # catch later
+ }
+ $interface = 1; # local
+ $Interfaces = 1; # global
+}
+
+sub INTERFACE_handler() {
+ my $in = merge_section();
+
+ TrimWhitespace($in);
+
+ foreach (split /[\s,]+/, $in) {
+ $Interfaces{$_} = $_;
+ }
+ print Q<<"EOF";
+# XSFUNCTION = $interface_macro($ret_type,cv,XSANY.any_dptr);
+EOF
+ $interface = 1; # local
+ $Interfaces = 1; # global
+}
+
sub CLEANUP_handler() { print_section() }
sub PREINIT_handler() { print_section() }
sub INIT_handler() { print_section() }
@@ -709,10 +774,16 @@ print("#line 1 \"$filename\"\n")
while (<$FH>) {
last if ($Module, $Package, $Prefix) =
/^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/;
+
+ if ($OBJ) {
+ s/#if(?:def\s|\s+defined)\s*(\(__cplusplus\)|__cplusplus)/#if defined(__cplusplus) && !defined(PERL_OBJECT)/;
+ }
print $_;
}
&Exit unless defined $_;
+print "$xsubpp::counter::SECTION_END_MARKER\n" if $WantLineNumbers;
+
$lastline = $_;
$lastline_no = $.;
@@ -829,6 +900,9 @@ while (fetch_para()) {
undef(@proto_arg) ;
undef($proto_in_this_xsub) ;
undef($scope_in_this_xsub) ;
+ undef($interface);
+ $interface_macro = 'XSINTERFACE_FUNC' ;
+ $interface_macro_set = 'XSINTERFACE_FUNC_SET' ;
$ProtoThisXSUB = $WantPrototypes ;
$ScopeThisXSUB = 0;
@@ -849,7 +923,7 @@ while (fetch_para()) {
# extract return type, function name and arguments
- my($ret_type) = TidyType($_);
+ ($ret_type) = TidyType($_);
# a function definition needs at least 2 lines
blurt ("Error: Function definition too short '$ret_type'"), next PARAGRAPH
@@ -859,9 +933,10 @@ while (fetch_para()) {
$func_header = shift(@line);
blurt ("Error: Cannot parse function definition from '$func_header'"), next PARAGRAPH
- unless $func_header =~ /^(?:([\w:]*)::)?(\w+)\s*\(\s*(.*?)\s*\)\s*$/s;
+ unless $func_header =~ /^(?:([\w:]*)::)?(\w+)\s*\(\s*(.*?)\s*\)\s*(const)?\s*$/s;
($class, $func_name, $orig_args) = ($1, $2, $3) ;
+ $class = "$4 $class" if $4;
($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/;
($clean_func_name = $func_name) =~ s/^$Prefix//;
$Full_func_name = "${Packid}_$clean_func_name";
@@ -874,7 +949,8 @@ while (fetch_para()) {
last;
}
$XSStack[$XSS_work_idx]{functions}{$Full_func_name} ++ ;
- %XsubAliases = %XsubAliasValues = ();
+ %XsubAliases = %XsubAliasValues = %Interfaces = ();
+ $DoSetMagic = 1;
@args = split(/\s*,\s*/, $orig_args);
if (defined($class)) {
@@ -916,6 +992,7 @@ while (fetch_para()) {
$EXPLICIT_RETURN = ($CODE &&
("@line" =~ /(\bST\s*\([^;]*=) | (\bXST_m\w+\s*\()/x ));
$ALIAS = grep(/^\s*ALIAS\s*:/, @line);
+ $INTERFACE = grep(/^\s*INTERFACE\s*:/, @line);
# print function header
print Q<<"EOF";
@@ -926,6 +1003,9 @@ EOF
print Q<<"EOF" if $ALIAS ;
# dXSI32;
EOF
+ print Q<<"EOF" if $INTERFACE ;
+# dXSFUNCTION($ret_type);
+EOF
if ($elipsis) {
$cond = ($min_args ? qq(items < $min_args) : 0);
}
@@ -978,7 +1058,7 @@ EOF
$gotRETVAL = 0;
INPUT_handler() ;
- process_keyword("INPUT|PREINIT|ALIAS|PROTOTYPE|SCOPE") ;
+ process_keyword("INPUT|PREINIT|INTERFACE_MACRO|C_ARGS|ALIAS|PROTOTYPE|SCOPE") ;
print Q<<"EOF" if $ScopeThisXSUB;
# ENTER;
@@ -1012,7 +1092,7 @@ EOF
print $deferred;
- process_keyword("INIT|ALIAS|PROTOTYPE") ;
+ process_keyword("INIT|ALIAS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS") ;
if (check_keyword("PPCODE")) {
print_section();
@@ -1045,6 +1125,7 @@ EOF
}
$func_name =~ s/^($spat)//
if defined($spat);
+ $func_name = 'XSFUNCTION' if $interface;
print "$func_name($func_args);\n";
}
}
@@ -1059,7 +1140,8 @@ EOF
if ($gotRETVAL && $RETVAL_code) {
print "\t$RETVAL_code\n";
} elsif ($gotRETVAL || $wantRETVAL) {
- &generate_output($ret_type, 0, 'RETVAL');
+ # RETVAL almost never needs SvSETMAGIC()
+ &generate_output($ret_type, 0, 'RETVAL', 0);
}
# do cleanup
@@ -1152,6 +1234,18 @@ EOF
# sv_setpv((SV*)cv$proto) ;
EOF
}
+ }
+ elsif ($interface) {
+ while ( ($name, $value) = each %Interfaces) {
+ $name = "$Package\::$name" unless $name =~ /::/;
+ push(@InitFileCode, Q<<"EOF");
+# cv = newXS(\"$name\", XS_$Full_func_name, file);
+# $interface_macro_set(cv,$value) ;
+EOF
+ push(@InitFileCode, Q<<"EOF") if $proto;
+# sv_setpv((SV*)cv$proto) ;
+EOF
+ }
}
else {
push(@InitFileCode,
@@ -1160,11 +1254,32 @@ EOF
}
# print initialization routine
+
print Q<<"EOF";
##ifdef __cplusplus
#extern "C"
##endif
+EOF
+
+if ($WantCAPI) {
+print Q<<"EOF";
+##ifdef PERL_CAPI
+#XS(boot__CAPI_entry)
+##else
+EOF
+}
+
+print Q<<"EOF";
#XS(boot_$Module_cname)
+EOF
+
+if ($WantCAPI) {
+print Q<<"EOF";
+##endif /* PERL_CAPI */
+EOF
+}
+
+print Q<<"EOF";
#[[
# dXSARGS;
# char* file = __FILE__;
@@ -1176,7 +1291,7 @@ print Q<<"EOF" if $WantVersionChk ;
#
EOF
-print Q<<"EOF" if defined $XsubAliases ;
+print Q<<"EOF" if defined $XsubAliases or defined $Interfaces ;
# {
# CV * cv ;
#
@@ -1184,7 +1299,7 @@ EOF
print @InitFileCode;
-print Q<<"EOF" if defined $XsubAliases ;
+print Q<<"EOF" if defined $XsubAliases or defined $Interfaces ;
# }
EOF
@@ -1197,21 +1312,50 @@ if (@BootCode)
}
print Q<<"EOF";;
-# ST(0) = &sv_yes;
-# XSRETURN(1);
+# XSRETURN_YES;
#]]
+#
EOF
+if ($WantCAPI) {
+print Q<<"EOF";
+##ifdef PERL_CAPI
+##define XSCAPI(name) void name(CV* cv, void* pPerl)
+#
+##ifdef __cplusplus
+#extern "C"
+##endif
+#XSCAPI(boot_$Module_cname)
+#[[
+# SetCPerlObj(pPerl);
+# boot__CAPI_entry(cv);
+#]]
+##endif /* PERL_CAPI */
+EOF
+}
+
warn("Please specify prototyping behavior for $filename (see perlxs manual)\n")
unless $ProtoUsed ;
&Exit;
-
sub output_init {
- local($type, $num, $init) = @_;
+ local($type, $num, $var, $init) = @_;
local($arg) = "ST(" . ($num - 1) . ")";
- eval qq/print " $init\\\n"/;
+ if( $init =~ /^=/ ) {
+ eval qq/print "\\t$var $init\\n"/;
+ warn $@ if $@;
+ } else {
+ if( $init =~ s/^\+// && $num ) {
+ &generate_init($type, $num, $var);
+ } else {
+ eval qq/print "\\t$var;\\n"/;
+ warn $@ if $@;
+ $init =~ s/^;//;
+ }
+ $deferred .= eval qq/"\\n\\t$init\\n"/;
+ warn $@ if $@;
+ }
}
sub Warn
@@ -1273,17 +1417,22 @@ sub generate_init {
$expr =~ s/(\t+)/$1 /g;
$expr =~ s/ /\t/g;
eval qq/print "\\t$var;\\n"/;
+ warn $@ if $@;
$deferred .= eval qq/"\\n\\tif (items < $num)\\n\\t $var = $defaults{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/;
+ warn $@ if $@;
} elsif ($ScopeThisXSUB or $expr !~ /^\t\$var =/) {
eval qq/print "\\t$var;\\n"/;
+ warn $@ if $@;
$deferred .= eval qq/"\\n$expr;\\n"/;
+ warn $@ if $@;
} else {
eval qq/print "$expr;\\n"/;
+ warn $@ if $@;
}
}
sub generate_output {
- local($type, $num, $var) = @_;
+ local($type, $num, $var, $do_setmagic) = @_;
local($arg) = "ST(" . ($num - ($num != 0)) . ")";
local($argoff) = $num - 1;
local($ntype);
@@ -1291,6 +1440,7 @@ sub generate_output {
$type = TidyType($type) ;
if ($type =~ /^array\(([^,]*),(.*)\)/) {
print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1)), XFree((char *)$var);\n";
+ print "\tSvSETMAGIC($arg);\n" if $do_setmagic;
} else {
blurt("Error: '$type' not in typemap"), return
unless defined($type_kind{$type});
@@ -1312,23 +1462,25 @@ sub generate_output {
$subexpr =~ s/\n\t/\n\t\t/g;
$expr =~ s/DO_ARRAY_ELEM\n/$subexpr/;
eval "print qq\a$expr\a";
+ warn $@ if $@;
+ print "\t\tSvSETMAGIC(ST(ix_$var));\n" if $do_setmagic;
}
elsif ($var eq 'RETVAL') {
if ($expr =~ /^\t\$arg = new/) {
# We expect that $arg has refcnt 1, so we need to
# mortalize it.
eval "print qq\a$expr\a";
+ warn $@ if $@;
print "\tsv_2mortal(ST(0));\n";
+ print "\tSvSETMAGIC(ST(0));\n" if $do_setmagic;
}
elsif ($expr =~ /^\s*\$arg\s*=/) {
# We expect that $arg has refcnt >=1, so we need
- # to mortalize it. However, the extension may have
- # returned the built-in perl value, which is
- # read-only, thus not mortalizable. However, it is
- # safe to leave it as it is, since it would be
- # ignored by REFCNT_dec. Builtin values have REFCNT==0.
+ # to mortalize it!
eval "print qq\a$expr\a";
- print "\tif (SvREFCNT(ST(0))) sv_2mortal(ST(0));\n";
+ warn $@ if $@;
+ print "\tsv_2mortal(ST(0));\n";
+ print "\tSvSETMAGIC(ST(0));\n" if $do_setmagic;
}
else {
# Just hope that the entry would safely write it
@@ -1337,10 +1489,14 @@ sub generate_output {
# works too.
print "\tST(0) = sv_newmortal();\n";
eval "print qq\a$expr\a";
+ warn $@ if $@;
+ # new mortals don't have set magic
}
}
elsif ($arg =~ /^ST\(\d+\)$/) {
eval "print qq\a$expr\a";
+ warn $@ if $@;
+ print "\tSvSETMAGIC($arg);\n" if $do_setmagic;
}
}
}
diff --git a/gnu/usr.bin/perl/lib/File/Basename.pm b/gnu/usr.bin/perl/lib/File/Basename.pm
index e4863f8911a..69bb1fa5fdc 100644
--- a/gnu/usr.bin/perl/lib/File/Basename.pm
+++ b/gnu/usr.bin/perl/lib/File/Basename.pm
@@ -122,13 +122,15 @@ directory name to be F<.>).
=cut
-require 5.002;
+
+## use strict;
+use re 'taint';
+
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
-#use strict;
-#use vars qw($VERSION $Fileparse_fstype $Fileparse_igncase);
-$VERSION = "2.5";
+use vars qw($VERSION $Fileparse_fstype $Fileparse_igncase);
+$VERSION = "2.6";
# fileparse_set_fstype() - specify OS-based rules used in future
@@ -141,7 +143,7 @@ sub fileparse_set_fstype {
my @old = ($Fileparse_fstype, $Fileparse_igncase);
if (@_) {
$Fileparse_fstype = $_[0];
- $Fileparse_igncase = ($_[0] =~ /^(?:MacOS|VMS|AmigaOS|os2|RISCOS|MSWin32)/i);
+ $Fileparse_igncase = ($_[0] =~ /^(?:MacOS|VMS|AmigaOS|os2|RISCOS|MSWin32|MSDOS)/i);
}
wantarray ? @old : $old[0];
}
@@ -155,11 +157,13 @@ sub fileparse {
my($fullname,@suffices) = @_;
my($fstype,$igncase) = ($Fileparse_fstype, $Fileparse_igncase);
my($dirpath,$tail,$suffix,$basename);
+ my($taint) = substr($fullname,0,0); # Is $fullname tainted?
if ($fstype =~ /^VMS/i) {
if ($fullname =~ m#/#) { $fstype = '' } # We're doing Unix emulation
else {
($dirpath,$basename) = ($fullname =~ /^(.*[:>\]])?(.*)/);
+ $dirpath ||= ''; # should always be defined
}
}
if ($fstype =~ /^MS(DOS|Win32)/i) {
@@ -175,6 +179,10 @@ sub fileparse {
}
elsif ($fstype !~ /^VMS/i) { # default to Unix
($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#);
+ if ($^O eq 'VMS' and $fullname =~ m:/[^/]+/000000/?:) {
+ # dev:[000000] is top of VMS tree, similar to Unix '/'
+ ($basename,$dirpath) = ('',$fullname);
+ }
$dirpath = './' unless $dirpath;
}
@@ -183,12 +191,15 @@ sub fileparse {
foreach $suffix (@suffices) {
my $pat = ($igncase ? '(?i)' : '') . "($suffix)\$";
if ($basename =~ s/$pat//) {
+ $taint .= substr($suffix,0,0);
$tail = $1 . $tail;
}
}
}
- wantarray ? ($basename,$dirpath,$tail) : $basename;
+ $tail .= $taint if defined $tail; # avoid warning if $tail == undef
+ wantarray ? ($basename . $taint, $dirpath . $taint, $tail)
+ : $basename . $taint;
}
diff --git a/gnu/usr.bin/perl/lib/File/CheckTree.pm b/gnu/usr.bin/perl/lib/File/CheckTree.pm
index a39308b6c96..dca7f6aff31 100644
--- a/gnu/usr.bin/perl/lib/File/CheckTree.pm
+++ b/gnu/usr.bin/perl/lib/File/CheckTree.pm
@@ -137,13 +137,13 @@ sub valmess {
$mess =~ s/ does not / should not / ||
$mess =~ s/ not / /;
}
- print STDERR $mess,"\n";
}
else {
$this =~ s/\$file/'$file'/g;
- print STDERR "Can't do $this.\n";
+ $mess = "Can't do $this.\n";
}
- if ($disposition eq 'die') { exit 1; }
+ die "$mess\n" if $disposition eq 'die';
+ warn "$mess\n";
++$warnings;
}
diff --git a/gnu/usr.bin/perl/lib/File/Copy.pm b/gnu/usr.bin/perl/lib/File/Copy.pm
index e95168e24b8..e1da6b6e59c 100644
--- a/gnu/usr.bin/perl/lib/File/Copy.pm
+++ b/gnu/usr.bin/perl/lib/File/Copy.pm
@@ -62,7 +62,9 @@ sub copy {
if (defined &syscopy && \&syscopy != \&copy
&& !$to_a_handle
- && !($from_a_handle && $^O eq 'os2')) # OS/2 cannot handle handles
+ && !($from_a_handle && $^O eq 'os2' ) # OS/2 cannot handle handles
+ && !($from_a_handle && $^O eq 'mpeix') # and neither can MPE/iX.
+ )
{
return syscopy($from, $to);
}
@@ -174,7 +176,20 @@ sub move {
*mv = \&move;
# &syscopy is an XSUB under OS/2
-*syscopy = ($^O eq 'VMS' ? \&rmscopy : \&copy) unless defined &syscopy;
+unless (defined &syscopy) {
+ if ($^O eq 'VMS') {
+ *syscopy = \&rmscopy;
+ } elsif ($^O eq 'mpeix') {
+ *syscopy = sub {
+ return 0 unless @_ == 2;
+ # Use the MPE cp program in order to
+ # preserve MPE file attributes.
+ return system('/bin/cp', '-f', $_[0], $_[1]) == 0;
+ };
+ } else {
+ *syscopy = \&copy;
+ }
+}
1;
@@ -220,7 +235,7 @@ B<Note that passing in
files as handles instead of names may lead to loss of information
on some operating systems; it is recommended that you use file
names whenever possible.> Files are opened in binary mode where
-applicable. To get a consistent behavour when copying from a
+applicable. To get a consistent behaviour when copying from a
filehandle to a file, use C<binmode> on the filehandle.
An optional third parameter can be used to specify the buffer
@@ -259,7 +274,7 @@ C<copy> routine. For VMS systems, this calls the C<rmscopy>
routine (see below). For OS/2 systems, this calls the C<syscopy>
XSUB directly.
-=head2 Special behavior if C<syscopy> is defined (VMS and OS/2)
+=head2 Special behaviour if C<syscopy> is defined (VMS and OS/2)
If both arguments to C<copy> are not file handles,
then C<copy> will perform a "system copy" of
@@ -321,7 +336,7 @@ $! will be set if an error was encountered.
=head1 AUTHOR
File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995,
-and updated by Charles Bailey I<E<lt>bailey@genetics.upenn.eduE<gt>> in 1996.
+and updated by Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>> in 1996.
=cut
diff --git a/gnu/usr.bin/perl/lib/File/DosGlob.pm b/gnu/usr.bin/perl/lib/File/DosGlob.pm
index 4597c715640..594ee2ec843 100644
--- a/gnu/usr.bin/perl/lib/File/DosGlob.pm
+++ b/gnu/usr.bin/perl/lib/File/DosGlob.pm
@@ -6,21 +6,6 @@
package File::DosGlob;
-unless (caller) {
- $| = 1;
- while (@ARGV) {
- #
- # We have to do this one by one for compatibility reasons.
- # If an arg doesn't match anything, we are supposed to return
- # the original arg. I know, it stinks, eh?
- #
- my $arg = shift;
- my @m = doglob(1,$arg);
- print (@m ? join("\0", sort @m) : $arg);
- print "\0" if @ARGV;
- }
-}
-
sub doglob {
my $cond = shift;
my @retval = ();
@@ -112,17 +97,27 @@ my %entries;
sub glob {
my $pat = shift;
my $cxix = shift;
+ my @pat;
# glob without args defaults to $_
$pat = $_ unless defined $pat;
+ # extract patterns
+ if ($pat =~ /\s/) {
+ require Text::ParseWords;
+ @pat = Text::ParseWords::parse_line('\s+',0,$pat);
+ }
+ else {
+ push @pat, $pat;
+ }
+
# assume global context if not provided one
$cxix = '_G_' unless defined $cxix;
$iter{$cxix} = 0 unless exists $iter{$cxix};
# if we're just beginning, do it all first
if ($iter{$cxix} == 0) {
- $entries{$cxix} = [doglob(1,$pat)];
+ $entries{$cxix} = [doglob(1,@pat)];
}
# chuck it all out, quick or slow
@@ -145,10 +140,10 @@ sub glob {
sub import {
my $pkg = shift;
- my $callpkg = caller(0);
+ return unless @_;
my $sym = shift;
- *{$callpkg.'::'.$sym} = \&{$pkg.'::'.$sym}
- if defined($sym) and $sym eq 'glob';
+ my $callpkg = ($sym =~ s/^GLOBAL_// ? 'CORE::GLOBAL' : caller(0));
+ *{$callpkg.'::'.$sym} = \&{$pkg.'::'.$sym} if $sym eq 'glob';
}
1;
@@ -159,8 +154,6 @@ __END__
File::DosGlob - DOS like globbing and then some
-perlglob.bat - a more capable perlglob.exe replacement
-
=head1 SYNOPSIS
require 5.004;
@@ -168,19 +161,19 @@ perlglob.bat - a more capable perlglob.exe replacement
# override CORE::glob in current package
use File::DosGlob 'glob';
+ # override CORE::glob in ALL packages (use with extreme caution!)
+ use File::DosGlob 'GLOBAL_glob';
+
@perlfiles = glob "..\\pe?l/*.p?";
print <..\\pe?l/*.p?>;
# from the command line (overrides only in main::)
> perl -MFile::DosGlob=glob -e "print <../pe*/*p?>"
-
- > perlglob ../pe*/*p?
=head1 DESCRIPTION
A module that implements DOS-like globbing with a few enhancements.
-This file is also a portable replacement for perlglob.exe. It
-is largely compatible with perlglob.exe (the M$ setargv.obj
+It is largely compatible with perlglob.exe (the M$ setargv.obj
version) in all but one respect--it understands wildcards in
directory components.
@@ -191,16 +184,14 @@ backslashes and forward slashes are both accepted, and preserved.
You may have to double the backslashes if you are putting them in
literally, due to double-quotish parsing of the pattern by perl.
-When invoked as a program, it will print null-separated filenames
-to standard output.
-
-While one may replace perlglob.exe with this, usage by overriding
-CORE::glob via importation should be much more efficient, because
-it avoids launching a separate process, and is therefore strongly
-recommended. Note that it is currently possible to override
-builtins like glob() only on a per-package basis, not "globally".
-Thus, every namespace that wants to override glob() must explicitly
-request the override. See L<perlsub>.
+Spaces in the argument delimit distinct patterns, so
+C<glob('*.exe *.dll')> globs all filenames that end in C<.exe>
+or C<.dll>. If you want to put in literal spaces in the glob
+pattern, you can escape them with either double quotes, or backslashes.
+e.g. C<glob('c:/"Program Files"/*/*.dll')>, or
+C<glob('c:/Program\ Files/*/*.dll')>. The argument is tokenized using
+C<Text::ParseWords::parse_line()>, so see L<Text::ParseWords> for details
+of the quoting rules used.
Extending it to csh patterns is left as an exercise to the reader.
@@ -223,6 +214,10 @@ Gurusamy Sarathy <gsar@umich.edu>
=item *
+Support for globally overriding glob() (GSAR 3-JUN-98)
+
+=item *
+
Scalar context, independent iterator context fixes (GSAR 15-SEP-97)
=item *
@@ -246,5 +241,9 @@ Initial version (GSAR 20-FEB-97)
perl
+perlglob.bat
+
+Text::ParseWords
+
=cut
diff --git a/gnu/usr.bin/perl/lib/File/Find.pm b/gnu/usr.bin/perl/lib/File/Find.pm
index 033cfe5e9de..7e670032a30 100644
--- a/gnu/usr.bin/perl/lib/File/Find.pm
+++ b/gnu/usr.bin/perl/lib/File/Find.pm
@@ -1,10 +1,7 @@
package File::Find;
require 5.000;
require Exporter;
-use Config;
require Cwd;
-require File::Basename;
-
=head1 NAME
@@ -17,13 +14,24 @@ finddepth - traverse a directory structure depth-first
use File::Find;
find(\&wanted, '/foo','/bar');
sub wanted { ... }
-
+
use File::Find;
finddepth(\&wanted, '/foo','/bar');
sub wanted { ... }
=head1 DESCRIPTION
+The first argument to find() is either a hash reference describing the
+operations to be performed for each file, a code reference, or a string
+that contains a subroutine name. If it is a hash reference, then the
+value for the key C<wanted> should be a code reference. This code
+reference is called I<the wanted() function> below.
+
+Currently the only other supported key for the above hash is
+C<bydepth>, in presense of which the walk over directories is
+performed depth-first. Entry point finddepth() is a shortcut for
+specifying C<{ bydepth => 1}> in the first argument of find().
+
The wanted() function does whatever verifications you want.
$File::Find::dir contains the current directory name, and $_ the
current filename within that directory. $File::Find::name contains
@@ -34,7 +42,7 @@ prune the tree.
File::Find assumes that you don't alter the $_ variable. If you do then
make sure you return it to its original value before exiting your function.
-This library is primarily for the C<find2perl> tool, which when fed,
+This library is useful for the C<find2perl> tool, which when fed,
find2perl / -name .nfs\* -mtime +7 \
-exec rm -f {} \; -o -fstype nfs -prune
@@ -63,7 +71,7 @@ that don't resolve:
sub wanted {
-l && !-e && print "bogus link: $File::Find::name\n";
- }
+ }
=head1 BUGS
@@ -75,9 +83,10 @@ There is no way to make find or finddepth follow symlinks.
@EXPORT = qw(find finddepth);
-sub find {
+sub find_opt {
my $wanted = shift;
- my $cwd = Cwd::cwd();
+ my $bydepth = $wanted->{bydepth};
+ my $cwd = $bydepth ? Cwd::fastcwd() : Cwd::cwd();
# Localize these rather than lexicalizing them for backwards
# compatibility.
local($topdir,$topdev,$topino,$topmode,$topnlink);
@@ -87,16 +96,21 @@ sub find {
|| (warn("Can't stat $topdir: $!\n"), next);
if (-d _) {
if (chdir($topdir)) {
- ($dir,$_) = ($topdir,'.');
- $name = $topdir;
$prune = 0;
- &$wanted;
- if (!$prune) {
- my $fixtopdir = $topdir;
- $fixtopdir =~ s,/$,, ;
- $fixtopdir =~ s/\.dir$// if $Is_VMS;
- $fixtopdir =~ s/\\dir$// if $Is_NT;
- &finddir($wanted,$fixtopdir,$topnlink);
+ unless ($bydepth) {
+ ($dir,$_) = ($topdir,'.');
+ $name = $topdir;
+ $wanted->{wanted}->();
+ }
+ next if $prune;
+ my $fixtopdir = $topdir;
+ $fixtopdir =~ s,/$,, ;
+ $fixtopdir =~ s/\.dir$// if $Is_VMS;
+ &finddir($wanted,$fixtopdir,$topnlink, $bydepth);
+ if ($bydepth) {
+ ($dir,$_) = ($fixtopdir,'.');
+ $name = $fixtopdir;
+ $wanted->{wanted}->();
}
}
else {
@@ -104,25 +118,31 @@ sub find {
}
}
else {
+ require File::Basename;
unless (($_,$dir) = File::Basename::fileparse($topdir)) {
($dir,$_) = ('.', $topdir);
}
- $name = $topdir;
- chdir $dir && &$wanted;
+ if (chdir($dir)) {
+ $name = $topdir;
+ $wanted->{wanted}->();
+ }
+ else {
+ warn "Can't cd to $dir: $!\n";
+ }
}
chdir $cwd;
}
}
sub finddir {
- my($wanted, $nlink);
+ my($wanted, $nlink, $bydepth);
local($dir, $name);
- ($wanted, $dir, $nlink) = @_;
+ ($wanted, $dir, $nlink, $bydepth) = @_;
my($dev, $ino, $mode, $subcount);
# Get the list of files in the current directory.
- opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return);
+ opendir(DIR,'.') || (warn("Can't open $dir: $!\n"), $bydepth || return);
my(@filenames) = readdir(DIR);
closedir(DIR);
@@ -132,149 +152,81 @@ sub finddir {
next if $_ eq '..';
$name = "$dir/$_";
$nlink = 0;
- &$wanted;
+ $wanted->{wanted}->();
}
}
- else { # This dir has subdirectories.
+ else { # This dir has subdirectories.
$subcount = $nlink - 2;
for (@filenames) {
next if $_ eq '.';
next if $_ eq '..';
- $nlink = $prune = 0;
+ $nlink = 0;
+ $prune = 0 unless $bydepth;
$name = "$dir/$_";
- &$wanted;
+ $wanted->{wanted}->() unless $bydepth;
if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs?
# Get link count and check for directoriness.
($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
# unless ($nlink || $dont_use_nlink);
-
+
if (-d _) {
# It really is a directory, so do it recursively.
- if (!$prune && chdir $_) {
+ --$subcount;
+ next if $prune;
+ # Untaint $_, so that we can do a chdir
+ $_ = $1 if /^(.*)/;
+ if (chdir $_) {
$name =~ s/\.dir$// if $Is_VMS;
- $name =~ s/\\dir$// if $Is_NT;
- &finddir($wanted,$name,$nlink);
+ &finddir($wanted,$name,$nlink, $bydepth);
chdir '..';
}
- --$subcount;
+ else {
+ warn "Can't cd to $_: $!\n";
+ }
}
}
+ $wanted->{wanted}->() if $bydepth;
}
}
}
-
-sub finddepth {
- my $wanted = shift;
-
- $cwd = Cwd::fastcwd();;
-
- # Localize these rather than lexicalizing them for backwards
- # compatibility.
- local($topdir, $topdev, $topino, $topmode, $topnlink);
- foreach $topdir (@_) {
- (($topdev,$topino,$topmode,$topnlink) =
- ($Is_VMS ? stat($topdir) : lstat($topdir)))
- || (warn("Can't stat $topdir: $!\n"), next);
- if (-d _) {
- if (chdir($topdir)) {
- my $fixtopdir = $topdir;
- $fixtopdir =~ s,/$,, ;
- $fixtopdir =~ s/\.dir$// if $Is_VMS;
- $fixtopdir =~ s/\\dir$// if $Is_NT;
- &finddepthdir($wanted,$fixtopdir,$topnlink);
- ($dir,$_) = ($fixtopdir,'.');
- $name = $fixtopdir;
- &$wanted;
- }
- else {
- warn "Can't cd to $topdir: $!\n";
- }
- }
- else {
- unless (($_,$dir) = File::Basename::fileparse($topdir)) {
- ($dir,$_) = ('.', $topdir);
- }
- $name = $topdir;
- chdir $dir && &$wanted;
- }
- chdir $cwd;
- }
+sub wrap_wanted {
+ my $wanted = shift;
+ ref($wanted) eq 'HASH' ? $wanted : { wanted => $wanted };
}
-sub finddepthdir {
- my($wanted, $nlink);
- local($dir, $name);
- ($wanted,$dir,$nlink) = @_;
- my($dev, $ino, $mode, $subcount);
-
- # Get the list of files in the current directory.
- opendir(DIR,'.') || warn "Can't open $dir: $!\n";
- my(@filenames) = readdir(DIR);
- closedir(DIR);
-
- if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories.
- for (@filenames) {
- next if $_ eq '.';
- next if $_ eq '..';
- $name = "$dir/$_";
- $nlink = 0;
- &$wanted;
- }
- }
- else { # This dir has subdirectories.
- $subcount = $nlink - 2;
- for (@filenames) {
- next if $_ eq '.';
- next if $_ eq '..';
- $nlink = 0;
- $name = "$dir/$_";
- if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs?
-
- # Get link count and check for directoriness.
-
- ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
-
- if (-d _) {
-
- # It really is a directory, so do it recursively.
-
- if (chdir $_) {
- $name =~ s/\.dir$// if $Is_VMS;
- $name =~ s/\\dir$// if $Is_NT;
- &finddepthdir($wanted,$name,$nlink);
- chdir '..';
- }
- --$subcount;
- }
- }
- &$wanted;
- }
- }
+sub find {
+ my $wanted = shift;
+ find_opt(wrap_wanted($wanted), @_);
}
-# 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
-# of the number of files.
-# See, e.g. hints/machten.sh for MachTen 2.2.
-$dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
+sub finddepth {
+ my $wanted = wrap_wanted(shift);
+ $wanted->{bydepth} = 1;
+ find_opt($wanted, @_);
+}
# These are hard-coded for now, but may move to hint files.
if ($^O eq 'VMS') {
$Is_VMS = 1;
$dont_use_nlink = 1;
}
-if ($^O =~ m:^mswin32:i) {
- $Is_NT = 1;
- $dont_use_nlink = 1;
-}
$dont_use_nlink = 1
- if $^O eq 'os2' || $^O eq 'msdos' || $^O eq 'amigaos';
+ if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32';
+
+# 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
+# of the number of files.
+# See, e.g. hints/machten.sh for MachTen 2.2.
+unless ($dont_use_nlink) {
+ require Config;
+ $dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
+}
1;
diff --git a/gnu/usr.bin/perl/lib/File/Path.pm b/gnu/usr.bin/perl/lib/File/Path.pm
index 43856dfe7b9..225ecab4b61 100644
--- a/gnu/usr.bin/perl/lib/File/Path.pm
+++ b/gnu/usr.bin/perl/lib/File/Path.pm
@@ -88,11 +88,11 @@ in situations where security is an issue.
=head1 AUTHORS
Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
-Charles Bailey <F<bailey@genetics.upenn.edu>>
+Charles Bailey <F<bailey@newman.upenn.edu>>
=head1 REVISION
-Current $VERSION is 1.04.
+Current $VERSION is 1.0401.
=cut
@@ -103,7 +103,7 @@ use Exporter ();
use strict;
use vars qw( $VERSION @ISA @EXPORT );
-$VERSION = "1.04";
+$VERSION = "1.0401";
@ISA = qw( Exporter );
@EXPORT = qw( mkpath rmtree );
@@ -111,7 +111,7 @@ my $Is_VMS = $^O eq 'VMS';
# 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 'msdos' || $^O eq 'MSWin32'
+my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32'
|| $^O eq 'amigaos');
sub mkpath {
@@ -124,15 +124,20 @@ sub mkpath {
$paths = [$paths] unless ref $paths;
my(@created,$path);
foreach $path (@$paths) {
+ $path .= '/' if $^O eq 'os2' and $path =~ /^\w:$/; # 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);
- push(@created,mkpath($parent, $verbose, $mode)) unless (-d $parent);
+ # Allow for creation of new logical filesystems under VMS
+ if (not $Is_VMS or $parent !~ m:/[^/]+/000000/?:) {
+ push(@created,mkpath($parent, $verbose, $mode)) unless (-d $parent);
+ }
print "mkdir $path\n" if $verbose;
unless (mkdir($path,$mode)) {
- # allow for another process to have created it meanwhile
- croak "mkdir $path: $!" unless -d $path;
+ my $e = $!;
+ # allow for another process to have created it meanwhile
+ croak "mkdir $path: $e" unless -d $path;
}
push(@created, $path);
}
@@ -202,18 +207,18 @@ sub rmtree {
if $force_writeable;
print "unlink $root\n" if $verbose;
# delete all versions under VMS
- while (-e $root || -l $root) {
- if (unlink $root) {
- ++$count;
- }
- else {
+ for (;;) {
+ unless (unlink $root) {
carp "Can't unlink file $root: $!";
if ($force_writeable) {
chmod $rp, $root
or carp("and can't restore permissions to "
. sprintf("0%o",$rp) . "\n");
}
+ last;
}
+ ++$count;
+ last unless $Is_VMS && lstat $root;
}
}
}
diff --git a/gnu/usr.bin/perl/lib/FileHandle.pm b/gnu/usr.bin/perl/lib/FileHandle.pm
index 455fc63917d..eec9b61f31b 100644
--- a/gnu/usr.bin/perl/lib/FileHandle.pm
+++ b/gnu/usr.bin/perl/lib/FileHandle.pm
@@ -112,7 +112,7 @@ FileHandle - supply object methods for filehandles
use FileHandle;
$fh = new FileHandle;
- if ($fh->open "< file") {
+ if ($fh->open("< file")) {
print <$fh>;
$fh->close;
}
@@ -249,6 +249,10 @@ It will also croak() if accidentally called in a scalar context.
=back
+There are many other functions available since FileHandle is descended
+from IO::File, IO::Seekable, and IO::Handle. Please see those
+respective pages for documentation on more functions.
+
=head1 SEE ALSO
The B<IO> extension,
diff --git a/gnu/usr.bin/perl/lib/FindBin.pm b/gnu/usr.bin/perl/lib/FindBin.pm
index 918775cda7f..9e1c0a06bf2 100644
--- a/gnu/usr.bin/perl/lib/FindBin.pm
+++ b/gnu/usr.bin/perl/lib/FindBin.pm
@@ -55,7 +55,10 @@ Workaround is to invoke perl as
=head1 AUTHORS
-Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>
+FindBin is supported as part of the core perl distribution. Please send bug
+reports to E<lt>F<perlbug@perl.org>E<gt> using the perlbug program included with perl.
+
+Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
Nick Ing-Simmons E<lt>F<nik@tiuk.ti.com>E<gt>
=head1 COPYRIGHT
@@ -64,10 +67,6 @@ Copyright (c) 1995 Graham Barr & Nick Ing-Simmons. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
-=head1 REVISION
-
-$Revision: 1.4 $
-
=cut
package FindBin;
@@ -77,31 +76,13 @@ require Exporter;
use Cwd qw(getcwd abs_path);
use Config;
use File::Basename;
+use File::Spec;
@EXPORT_OK = qw($Bin $Script $RealBin $RealScript $Dir $RealDir);
%EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]);
@ISA = qw(Exporter);
-$VERSION = $VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
-
-sub is_abs_path
-{
- local $_ = shift if (@_);
- if ($^O eq 'MSWin32')
- {
- return m#^[a-z]:[\\/]#i;
- }
- elsif ($^O eq 'VMS')
- {
- # If it's a logical name, expand it.
- $_ = $ENV{$_} while /^[\w\$\-]+$/ and $ENV{$_};
- return m!^/! or m![<\[][^.\-\]>]! or /:[^<\[]/;
- }
- else
- {
- return m#^/#;
- }
-}
+$VERSION = $VERSION = "1.42";
BEGIN
{
@@ -131,13 +112,12 @@ BEGIN
&& -f $script)
{
my $dir;
- my $pathvar = ($IsWin32) ? 'Path' : 'PATH';
-
- foreach $dir (split(/$Config{'path_sep'}/,$ENV{$pathvar}))
+ foreach $dir (File::Spec->path)
{
- if(-r "$dir/$script" && (!$IsWin32 || -x _))
+ my $scr = File::Spec->catfile($dir, $script);
+ if(-r $scr && (!$IsWin32 || -x _))
{
- $script = "$dir/$script";
+ $script = $scr;
if (-f $0)
{
@@ -160,7 +140,8 @@ BEGIN
# Ensure $script contains the complete path incase we C<chdir>
- $script = getcwd() . "/" . $script unless is_abs_path($script);
+ $script = File::Spec->catfile(getcwd(), $script)
+ unless File::Spec->file_name_is_absolute($script);
($Script,$Bin) = fileparse($script);
@@ -172,9 +153,9 @@ BEGIN
($RealScript,$RealBin) = fileparse($script);
last unless defined $linktext;
- $script = (is_abs_path($linktext))
+ $script = (File::Spec->file_name_is_absolute($linktext))
? $linktext
- : $RealBin . "/" . $linktext;
+ : File::Spec->catfile($RealBin, $linktext);
}
# Get absolute paths to directories
diff --git a/gnu/usr.bin/perl/lib/Getopt/Long.pm b/gnu/usr.bin/perl/lib/Getopt/Long.pm
index 4f23f5d6c13..e9a8f1a1cc8 100644
--- a/gnu/usr.bin/perl/lib/Getopt/Long.pm
+++ b/gnu/usr.bin/perl/lib/Getopt/Long.pm
@@ -2,508 +2,17 @@
package Getopt::Long;
-# RCS Status : $Id: Long.pm,v 1.2 1997/11/30 07:57:41 millert Exp $
+# RCS Status : $Id: Long.pm,v 1.3 1999/04/29 22:51:55 millert Exp $
# Author : Johan Vromans
# Created On : Tue Sep 11 15:00:12 1990
# Last Modified By: Johan Vromans
-# Last Modified On: Wed Sep 17 12:20:10 1997
-# Update Count : 608
+# Last Modified On: Fri Jan 8 14:48:43 1999
+# Update Count : 707
# Status : Released
-=head1 NAME
-
-GetOptions - extended processing of command line options
-
-=head1 SYNOPSIS
-
- use Getopt::Long;
- $result = GetOptions (...option-descriptions...);
-
-=head1 DESCRIPTION
-
-The Getopt::Long module implements an extended getopt function called
-GetOptions(). This function adheres to the POSIX syntax for command
-line options, with GNU extensions. In general, this means that options
-have long names instead of single letters, and are introduced with a
-double dash "--". Support for bundling of command line options, as was
-the case with the more traditional single-letter approach, is provided
-but not enabled by default. For example, the UNIX "ps" command can be
-given the command line "option"
-
- -vax
-
-which means the combination of B<-v>, B<-a> and B<-x>. With the new
-syntax B<--vax> would be a single option, probably indicating a
-computer architecture.
-
-Command line options can be used to set values. These values can be
-specified in one of two ways:
-
- --size 24
- --size=24
-
-GetOptions is called with a list of option-descriptions, each of which
-consists of two elements: the option specifier and the option linkage.
-The option specifier defines the name of the option and, optionally,
-the value it can take. The option linkage is usually a reference to a
-variable that will be set when the option is used. For example, the
-following call to GetOptions:
-
- GetOptions("size=i" => \$offset);
-
-will accept a command line option "size" that must have an integer
-value. With a command line of "--size 24" this will cause the variable
-$offset to get the value 24.
-
-Alternatively, the first argument to GetOptions may be a reference to
-a HASH describing the linkage for the options, or an object whose
-class is based on a HASH. The following call is equivalent to the
-example above:
-
- %optctl = ("size" => \$offset);
- GetOptions(\%optctl, "size=i");
-
-Linkage may be specified using either of the above methods, or both.
-Linkage specified in the argument list takes precedence over the
-linkage specified in the HASH.
-
-The command line options are taken from array @ARGV. Upon completion
-of GetOptions, @ARGV will contain the rest (i.e. the non-options) of
-the command line.
-
-Each option specifier designates the name of the option, optionally
-followed by an argument specifier. Values for argument specifiers are:
-
-=over 8
-
-=item E<lt>noneE<gt>
-
-Option does not take an argument.
-The option variable will be set to 1.
-
-=item !
-
-Option does not take an argument and may be negated, i.e. prefixed by
-"no". E.g. "foo!" will allow B<--foo> (with value 1) and B<-nofoo>
-(with value 0).
-The option variable will be set to 1, or 0 if negated.
-
-=item =s
-
-Option takes a mandatory string argument.
-This string will be assigned to the option variable.
-Note that even if the string argument starts with B<-> or B<-->, it
-will not be considered an option on itself.
-
-=item :s
-
-Option takes an optional string argument.
-This string will be assigned to the option variable.
-If omitted, it will be assigned "" (an empty string).
-If the string argument starts with B<-> or B<-->, it
-will be considered an option on itself.
-
-=item =i
-
-Option takes a mandatory integer argument.
-This value will be assigned to the option variable.
-Note that the value may start with B<-> to indicate a negative
-value.
-
-=item :i
-
-Option takes an optional integer argument.
-This value will be assigned to the option variable.
-If omitted, the value 0 will be assigned.
-Note that the value may start with B<-> to indicate a negative
-value.
-
-=item =f
-
-Option takes a mandatory real number argument.
-This value will be assigned to the option variable.
-Note that the value may start with B<-> to indicate a negative
-value.
-
-=item :f
-
-Option takes an optional real number argument.
-This value will be assigned to the option variable.
-If omitted, the value 0 will be assigned.
-
-=back
-
-A lone dash B<-> is considered an option, the corresponding option
-name is the empty string.
-
-A double dash on itself B<--> signals end of the options list.
-
-=head2 Linkage specification
-
-The linkage specifier is optional. If no linkage is explicitly
-specified but a ref HASH is passed, GetOptions will place the value in
-the HASH. For example:
-
- %optctl = ();
- GetOptions (\%optctl, "size=i");
-
-will perform the equivalent of the assignment
-
- $optctl{"size"} = 24;
-
-For array options, a reference to an array is used, e.g.:
-
- %optctl = ();
- GetOptions (\%optctl, "sizes=i@");
-
-with command line "-sizes 24 -sizes 48" will perform the equivalent of
-the assignment
-
- $optctl{"sizes"} = [24, 48];
-
-For hash options (an option whose argument looks like "name=value"),
-a reference to a hash is used, e.g.:
-
- %optctl = ();
- GetOptions (\%optctl, "define=s%");
-
-with command line "--define foo=hello --define bar=world" will perform the
-equivalent of the assignment
-
- $optctl{"define"} = {foo=>'hello', bar=>'world')
-
-If no linkage is explicitly specified and no ref HASH is passed,
-GetOptions will put the value in a global variable named after the
-option, prefixed by "opt_". To yield a usable Perl variable,
-characters that are not part of the syntax for variables are
-translated to underscores. For example, "--fpp-struct-return" will set
-the variable $opt_fpp_struct_return. Note that this variable resides
-in the namespace of the calling program, not necessarily B<main>.
-For example:
-
- GetOptions ("size=i", "sizes=i@");
-
-with command line "-size 10 -sizes 24 -sizes 48" will perform the
-equivalent of the assignments
-
- $opt_size = 10;
- @opt_sizes = (24, 48);
-
-A lone dash B<-> is considered an option, the corresponding Perl
-identifier is $opt_ .
-
-The linkage specifier can be a reference to a scalar, a reference to
-an array, a reference to a hash or a reference to a subroutine.
-
-If a REF SCALAR is supplied, the new value is stored in the referenced
-variable. If the option occurs more than once, the previous value is
-overwritten.
-
-If a REF ARRAY is supplied, the new value is appended (pushed) to the
-referenced array.
-
-If a REF HASH is supplied, the option value should look like "key" or
-"key=value" (if the "=value" is omitted then a value of 1 is implied).
-In this case, the element of the referenced hash with the key "key"
-is assigned "value".
-
-If a REF CODE is supplied, the referenced subroutine is called with
-two arguments: the option name and the option value.
-The option name is always the true name, not an abbreviation or alias.
-
-=head2 Aliases and abbreviations
-
-The option name may actually be a list of option names, separated by
-"|"s, e.g. "foo|bar|blech=s". In this example, "foo" is the true name
-of this option. If no linkage is specified, options "foo", "bar" and
-"blech" all will set $opt_foo.
-
-Option names may be abbreviated to uniqueness, depending on
-configuration option B<auto_abbrev>.
-
-=head2 Non-option call-back routine
-
-A special option specifier, E<lt>E<gt>, can be used to designate a subroutine
-to handle non-option arguments. GetOptions will immediately call this
-subroutine for every non-option it encounters in the options list.
-This subroutine gets the name of the non-option passed.
-This feature requires configuration option B<permute>, see section
-CONFIGURATION OPTIONS.
-
-See also the examples.
-
-=head2 Option starters
-
-On the command line, options can start with B<-> (traditional), B<-->
-(POSIX) and B<+> (GNU, now being phased out). The latter is not
-allowed if the environment variable B<POSIXLY_CORRECT> has been
-defined.
-
-Options that start with "--" may have an argument appended, separated
-with an "=", e.g. "--foo=bar".
-
-=head2 Return value
-
-A return status of 0 (false) indicates that the function detected
-one or more errors.
-
-=head1 COMPATIBILITY
-
-Getopt::Long::GetOptions() is the successor of
-B<newgetopt.pl> that came with Perl 4. It is fully upward compatible.
-In fact, the Perl 5 version of newgetopt.pl is just a wrapper around
-the module.
-
-If an "@" sign is appended to the argument specifier, the option is
-treated as an array. Value(s) are not set, but pushed into array
-@opt_name. If explicit linkage is supplied, this must be a reference
-to an ARRAY.
-
-If an "%" sign is appended to the argument specifier, the option is
-treated as a hash. Value(s) of the form "name=value" are set by
-setting the element of the hash %opt_name with key "name" to "value"
-(if the "=value" portion is omitted it defaults to 1). If explicit
-linkage is supplied, this must be a reference to a HASH.
-
-If configuration option B<getopt_compat> is set (see section
-CONFIGURATION OPTIONS), options that start with "+" or "-" may also
-include their arguments, e.g. "+foo=bar". This is for compatiblity
-with older implementations of the GNU "getopt" routine.
-
-If the first argument to GetOptions is a string consisting of only
-non-alphanumeric characters, it is taken to specify the option starter
-characters. Everything starting with one of these characters from the
-starter will be considered an option. B<Using a starter argument is
-strongly deprecated.>
-
-For convenience, option specifiers may have a leading B<-> or B<-->,
-so it is possible to write:
-
- GetOptions qw(-foo=s --bar=i --ar=s);
-
-=head1 EXAMPLES
-
-If the option specifier is "one:i" (i.e. takes an optional integer
-argument), then the following situations are handled:
-
- -one -two -> $opt_one = '', -two is next option
- -one -2 -> $opt_one = -2
-
-Also, assume specifiers "foo=s" and "bar:s" :
-
- -bar -xxx -> $opt_bar = '', '-xxx' is next option
- -foo -bar -> $opt_foo = '-bar'
- -foo -- -> $opt_foo = '--'
-
-In GNU or POSIX format, option names and values can be combined:
-
- +foo=blech -> $opt_foo = 'blech'
- --bar= -> $opt_bar = ''
- --bar=-- -> $opt_bar = '--'
-
-Example of using variable references:
-
- $ret = GetOptions ('foo=s', \$foo, 'bar=i', 'ar=s', \@ar);
-
-With command line options "-foo blech -bar 24 -ar xx -ar yy"
-this will result in:
-
- $foo = 'blech'
- $opt_bar = 24
- @ar = ('xx','yy')
-
-Example of using the E<lt>E<gt> option specifier:
-
- @ARGV = qw(-foo 1 bar -foo 2 blech);
- GetOptions("foo=i", \$myfoo, "<>", \&mysub);
-
-Results:
-
- mysub("bar") will be called (with $myfoo being 1)
- mysub("blech") will be called (with $myfoo being 2)
-
-Compare this with:
-
- @ARGV = qw(-foo 1 bar -foo 2 blech);
- GetOptions("foo=i", \$myfoo);
-
-This will leave the non-options in @ARGV:
-
- $myfoo -> 2
- @ARGV -> qw(bar blech)
-
-=head1 CONFIGURATION OPTIONS
-
-B<GetOptions> can be configured by calling subroutine
-B<Getopt::Long::config>. This subroutine takes a list of quoted
-strings, each specifying a configuration option to be set, e.g.
-B<ignore_case>. Options can be reset by prefixing with B<no_>, e.g.
-B<no_ignore_case>. Case does not matter. Multiple calls to B<config>
-are possible.
-
-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 B<config> routine. Besides, it
-is much easier.
-
-The following options are available:
-
-=over 12
-
-=item default
-
-This option causes all configuration options to be reset to their
-default values.
-
-=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 B<auto_abbrev> is reset.
-
-=item getopt_compat
-
-Allow '+' to start options.
-Default is set unless environment variable
-POSIXLY_CORRECT has been set, in which case B<getopt_compat> is reset.
-
-=item require_order
-
-Whether non-options are allowed to be mixed with
-options.
-Default is set unless environment variable
-POSIXLY_CORRECT has been set, in which case b<require_order> is reset.
-
-See also B<permute>, which is the opposite of B<require_order>.
-
-=item permute
-
-Whether non-options are allowed to be mixed with
-options.
-Default is set unless environment variable
-POSIXLY_CORRECT has been set, in which case B<permute> is reset.
-Note that B<permute> is the opposite of B<require_order>.
-
-If B<permute> is set, this means that
-
- -foo arg1 -bar arg2 arg3
-
-is equivalent to
-
- -foo -bar arg1 arg2 arg3
-
-If a non-option call-back routine is specified, @ARGV will always be
-empty upon succesful return of GetOptions since all options have been
-processed, except when B<--> is used:
-
- -foo arg1 -bar arg2 -- arg3
-
-will call the call-back routine for arg1 and arg2, and terminate
-leaving arg2 in @ARGV.
-
-If B<require_order> is set, options processing
-terminates when the first non-option is encountered.
-
- -foo arg1 -bar arg2 arg3
-
-is equivalent to
-
- -foo -- arg1 -bar arg2 arg3
-
-=item bundling (default: reset)
-
-Setting this variable to a non-zero value will allow single-character
-options to be bundled. To distinguish bundles from long option names,
-long options must be introduced with B<--> and single-character
-options (and bundles) with B<->. For example,
-
- ps -vax --vax
-
-would be equivalent to
-
- ps -v -a -x --vax
-
-provided "vax", "v", "a" and "x" have been defined to be valid
-options.
-
-Bundled options can also include a value in the bundle; this value has
-to be the last part of the bundle, e.g.
-
- scale -h24 -w80
-
-is equivalent to
-
- scale -h 24 -w 80
-
-Note: resetting B<bundling> also resets B<bundling_override>.
-
-=item bundling_override (default: reset)
-
-If B<bundling_override> is set, bundling is enabled as with
-B<bundling> but now long option names override option bundles. In the
-above example, B<-vax> would be interpreted as the option "vax", not
-the bundle "v", "a", "x".
-
-Note: resetting B<bundling_override> also resets B<bundling>.
-
-B<Note:> Using option bundling can easily lead to unexpected results,
-especially when mixing long options and bundles. Caveat emptor.
-
-=item ignore_case (default: set)
-
-If set, case is ignored when matching options.
-
-Note: resetting B<ignore_case> also resets B<ignore_case_always>.
-
-=item ignore_case_always (default: reset)
-
-When bundling is in effect, case is ignored on single-character
-options also.
-
-Note: resetting B<ignore_case_always> also resets B<ignore_case>.
-
-=item pass_through (default: reset)
-
-Unknown options are passed through in @ARGV instead of being flagged
-as errors. This makes it possible to write wrapper scripts that
-process only part of the user supplied options, and passes the
-remaining options to some other program.
-
-This can be very confusing, especially when B<permute> is also set.
-
-=item debug (default: reset)
-
-Enable copious debugging output.
-
-=back
-
-=head1 OTHER USEFUL VARIABLES
-
-=over 12
-
-=item $Getopt::Long::VERSION
-
-The version number of this Getopt::Long implementation in the format
-C<major>.C<minor>. This can be used to have Exporter check the
-version, e.g.
-
- use Getopt::Long 3.00;
-
-You can inspect $Getopt::Long::major_version and
-$Getopt::Long::minor_version for the individual components.
-
-=item $Getopt::Long::error
-
-Internal error flag. May be incremented from a call-back routine to
-cause options parsing to fail.
-
-=back
-
-=cut
-
################ Copyright ################
-# This program is Copyright 1990,1997 by Johan Vromans.
+# This program is Copyright 1990,1999 by Johan Vromans.
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
@@ -523,72 +32,124 @@ cause options parsing to fail.
use strict;
BEGIN {
- require 5.003;
+ require 5.004;
use Exporter ();
- use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
- $VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
-
- @ISA = qw(Exporter);
- @EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
- %EXPORT_TAGS = ();
- @EXPORT_OK = qw();
+ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+ $VERSION = "2.19";
+
+ @ISA = qw(Exporter);
+ @EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
+ %EXPORT_TAGS = qw();
+ @EXPORT_OK = qw();
+ use AutoLoader qw(AUTOLOAD);
}
-use vars @EXPORT, @EXPORT_OK;
# User visible variables.
+use vars @EXPORT, @EXPORT_OK;
use vars qw($error $debug $major_version $minor_version);
# Deprecated visible variables.
use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
$passthrough);
+# Official invisible variables.
+use vars qw($genprefix);
+
+# Public subroutines.
+sub Configure (@);
+sub config (@); # deprecated name
+sub GetOptions;
+
+# Private subroutines.
+sub ConfigDefaults ();
+sub FindOption ($$$$$$$);
+sub Croak (@); # demand loading the real Croak
################ Local Variables ################
-my $gen_prefix; # generic prefix (option starters)
-my $argend; # option list terminator
-my %opctl; # table of arg.specs (long and abbrevs)
-my %bopctl; # table of arg.specs (bundles)
-my @opctl; # the possible long option names
-my $pkg; # current context. Needed if no linkage.
-my %aliases; # alias table
-my $genprefix; # so we can call the same module more
-my $opt; # current option
-my $arg; # current option value, if any
-my $array; # current option is array typed
-my $hash; # current option is hash typed
-my $key; # hash key for a hash option
- # than once in differing environments
-my $config_defaults; # set config defaults
-my $find_option; # helper routine
-
-################ Subroutines ################
+################ Resident subroutines ################
+
+sub ConfigDefaults () {
+ # Handle POSIX compliancy.
+ if ( defined $ENV{"POSIXLY_CORRECT"} ) {
+ $genprefix = "(--|-)";
+ $autoabbrev = 0; # no automatic abbrev of options
+ $bundling = 0; # no bundling of single letter switches
+ $getopt_compat = 0; # disallow '+' to start options
+ $order = $REQUIRE_ORDER;
+ }
+ else {
+ $genprefix = "(--|-|\\+)";
+ $autoabbrev = 1; # automatic abbrev of options
+ $bundling = 0; # bundling off by default
+ $getopt_compat = 1; # allow '+' to start options
+ $order = $PERMUTE;
+ }
+ # Other configurable settings.
+ $debug = 0; # for debugging
+ $error = 0; # error tally
+ $ignorecase = 1; # ignore case when matching options
+ $passthrough = 0; # leave unrecognized options alone
+}
+
+################ Initialization ################
+
+# Values for $order. See GNU getopt.c for details.
+($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
+# Version major/minor numbers.
+($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
+
+# Set defaults.
+ConfigDefaults ();
+
+################ Package return ################
+
+1;
+
+__END__
+
+################ AutoLoading subroutines ################
+
+# RCS Status : $Id: Long.pm,v 1.3 1999/04/29 22:51:55 millert Exp $
+# Author : Johan Vromans
+# Created On : Fri Mar 27 11:50:30 1998
+# Last Modified By: Johan Vromans
+# Last Modified On: Sun Jun 14 13:54:35 1998
+# Update Count : 24
+# Status : Released
sub GetOptions {
my @optionlist = @_; # local copy of the option descriptions
- $argend = '--'; # option list terminator
- %opctl = (); # table of arg.specs (long and abbrevs)
- %bopctl = (); # table of arg.specs (bundles)
- $pkg = (caller)[0]; # current context
+ my $argend = '--'; # option list terminator
+ my %opctl = (); # table of arg.specs (long and abbrevs)
+ my %bopctl = (); # table of arg.specs (bundles)
+ my $pkg = (caller)[0]; # current context
# Needed if linkage is omitted.
- %aliases= (); # alias table
+ my %aliases= (); # alias table
my @ret = (); # accum for non-options
my %linkage; # linkage
my $userlinkage; # user supplied HASH
- $genprefix = $gen_prefix; # so we can call the same module many times
- $error = 0;
-
- print STDERR ('GetOptions $Revision: 1.2 $ ',
- "[GetOpt::Long $Getopt::Long::VERSION] -- ",
- "called from package \"$pkg\".\n",
- " (@ARGV)\n",
- " autoabbrev=$autoabbrev".
- ",bundling=$bundling",
- ",getopt_compat=$getopt_compat",
- ",order=$order",
- ",\n ignorecase=$ignorecase",
- ",passthrough=$passthrough",
- ",genprefix=\"$genprefix\"",
- ".\n")
+ my $opt; # current option
+ my $genprefix = $genprefix; # so we can call the same module many times
+ my @opctl; # the possible long option names
+
+ $error = '';
+
+ print STDERR ("GetOpt::Long $Getopt::Long::VERSION ",
+ "called from package \"$pkg\".",
+ "\n ",
+ 'GetOptionsAl $Revision: 1.3 $ ',
+ "\n ",
+ "ARGV: (@ARGV)",
+ "\n ",
+ "autoabbrev=$autoabbrev,".
+ "bundling=$bundling,",
+ "getopt_compat=$getopt_compat,",
+ "order=$order,",
+ "\n ",
+ "ignorecase=$ignorecase,",
+ "passthrough=$passthrough,",
+ "genprefix=\"$genprefix\".",
+ "\n")
if $debug;
# Check for ref HASH as first argument.
@@ -605,9 +166,9 @@ sub GetOptions {
# starter characters.
if ( $optionlist[0] =~ /^\W+$/ ) {
$genprefix = shift (@optionlist);
- # Turn into regexp.
+ # Turn into regexp. Needs to be parenthesized!
$genprefix =~ s/(\W)/\\$1/g;
- $genprefix = "[" . $genprefix . "]";
+ $genprefix = "([" . $genprefix . "])";
}
# Verify correctness of optionlist.
@@ -617,7 +178,7 @@ sub GetOptions {
my $opt = shift (@optionlist);
# Strip leading prefix so people can specify "--foo=i" if they like.
- $opt = $' if $opt =~ /^($genprefix)+/;
+ $opt = $+ if $opt =~ /^$genprefix+(.*)$/s;
if ( $opt eq '<>' ) {
if ( (defined $userlinkage)
@@ -628,20 +189,19 @@ sub GetOptions {
}
unless ( @optionlist > 0
&& ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
- warn ("Option spec <> requires a reference to a subroutine\n");
- $error++;
+ $error .= "Option spec <> requires a reference to a subroutine\n";
next;
}
$linkage{'<>'} = shift (@optionlist);
next;
}
- if ( $opt !~ /^(\w+[-\w|]*)?(!|[=:][infse][@%]?)?$/ ) {
- warn ("Error in option spec: \"", $opt, "\"\n");
- $error++;
+ # Match option spec. Allow '?' as an alias.
+ if ( $opt !~ /^((\w+[-\w]*)(\|(\?|\w[-\w]*)?)*)?([!~+]|[=:][infse][@%]?)?$/ ) {
+ $error .= "Error in option spec: \"$opt\"\n";
next;
}
- my ($o, $c, $a) = ($1, $2);
+ my ($o, $c, $a) = ($1, $5);
$c = '' unless defined $c;
if ( ! defined $o ) {
@@ -718,18 +278,19 @@ sub GetOptions {
$opctl{$o} .= '@'
if $opctl{$o} ne '' and $opctl{$o} !~ /\@$/;
$bopctl{$o} .= '@'
- if $bundling and $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/;
+ if $bundling and defined $bopctl{$o} and
+ $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/;
}
elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) {
$linkage{$o} = shift (@optionlist);
$opctl{$o} .= '%'
if $opctl{$o} ne '' and $opctl{$o} !~ /\%$/;
$bopctl{$o} .= '%'
- if $bundling and $bopctl{$o} ne '' and $bopctl{$o} !~ /\%$/;
+ if $bundling and defined $bopctl{$o} and
+ $bopctl{$o} ne '' and $bopctl{$o} !~ /\%$/;
}
else {
- warn ("Invalid option linkage for \"", $opt, "\"\n");
- $error++;
+ $error .= "Invalid option linkage for \"$opt\"\n";
}
}
else {
@@ -756,7 +317,8 @@ sub GetOptions {
}
# Bail out if errors found.
- return 0 if $error;
+ die ($error) if $error;
+ $error = 0;
# Sort the possible long option names.
@opctl = sort(keys (%opctl)) if $autoabbrev;
@@ -782,8 +344,6 @@ sub GetOptions {
#### Get next argument ####
$opt = shift (@ARGV);
- $arg = undef;
- $array = $hash = 0;
print STDERR ("=> option \"", $opt, "\"\n") if $debug;
#### Determine what we have ####
@@ -797,11 +357,19 @@ sub GetOptions {
}
my $tryopt = $opt;
+ my $found; # success status
+ my $dsttype; # destination type ('@' or '%')
+ my $incr; # destination increment
+ my $key; # key (if hash type)
+ my $arg; # option argument
- # find_option operates on the GLOBAL $opt and $arg!
- if ( &$find_option () ) {
+ ($found, $opt, $arg, $dsttype, $incr, $key) =
+ FindOption ($genprefix, $argend, $opt,
+ \%opctl, \%bopctl, \@opctl, \%aliases);
+
+ if ( $found ) {
- # find_option undefines $opt in case of errors.
+ # FindOption undefines $opt in case of errors.
next unless defined $opt;
if ( defined $arg ) {
@@ -812,8 +380,21 @@ sub GetOptions {
ref($linkage{$opt}), "\n") if $debug;
if ( ref($linkage{$opt}) eq 'SCALAR' ) {
- print STDERR ("=> \$\$L{$opt} = \"$arg\"\n") if $debug;
- ${$linkage{$opt}} = $arg;
+ if ( $incr ) {
+ print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
+ if $debug;
+ if ( defined ${$linkage{$opt}} ) {
+ ${$linkage{$opt}} += $arg;
+ }
+ else {
+ ${$linkage{$opt}} = $arg;
+ }
+ }
+ else {
+ print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")
+ if $debug;
+ ${$linkage{$opt}} = $arg;
+ }
}
elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
@@ -833,11 +414,11 @@ sub GetOptions {
else {
print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
"\" in linkage\n");
- die ("Getopt::Long -- internal error!\n");
+ Croak ("Getopt::Long -- internal error!\n");
}
}
# No entry in linkage means entry in userlinkage.
- elsif ( $array ) {
+ elsif ( $dsttype eq '@' ) {
if ( defined $userlinkage->{$opt} ) {
print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
if $debug;
@@ -849,7 +430,7 @@ sub GetOptions {
$userlinkage->{$opt} = [$arg];
}
}
- elsif ( $hash ) {
+ elsif ( $dsttype eq '%' ) {
if ( defined $userlinkage->{$opt} ) {
print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
if $debug;
@@ -862,8 +443,20 @@ sub GetOptions {
}
}
else {
- print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
- $userlinkage->{$opt} = $arg;
+ if ( $incr ) {
+ print STDERR ("=> \$L{$opt} += \"$arg\"\n")
+ if $debug;
+ if ( defined $userlinkage->{$opt} ) {
+ $userlinkage->{$opt} += $arg;
+ }
+ else {
+ $userlinkage->{$opt} = $arg;
+ }
+ }
+ else {
+ print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
+ $userlinkage->{$opt} = $arg;
+ }
}
}
}
@@ -873,7 +466,7 @@ sub GetOptions {
# Try non-options call-back.
my $cb;
if ( (defined ($cb = $linkage{'<>'})) ) {
- &$cb($tryopt);
+ &$cb ($tryopt);
}
else {
print STDERR ("=> saving \"$tryopt\" ",
@@ -903,92 +496,33 @@ sub GetOptions {
return ($error == 0);
}
-sub config (@) {
- my (@options) = @_;
- my $opt;
- foreach $opt ( @options ) {
- my $try = lc ($opt);
- my $action = 1;
- if ( $try =~ /^no_?/ ) {
- $action = 0;
- $try = $';
- }
- if ( $try eq 'default' or $try eq 'defaults' ) {
- &$config_defaults () if $action;
- }
- elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
- $autoabbrev = $action;
- }
- elsif ( $try eq 'getopt_compat' ) {
- $getopt_compat = $action;
- }
- elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
- $ignorecase = $action;
- }
- elsif ( $try eq 'ignore_case_always' ) {
- $ignorecase = $action ? 2 : 0;
- }
- elsif ( $try eq 'bundling' ) {
- $bundling = $action;
- }
- elsif ( $try eq 'bundling_override' ) {
- $bundling = $action ? 2 : 0;
- }
- elsif ( $try eq 'require_order' ) {
- $order = $action ? $REQUIRE_ORDER : $PERMUTE;
- }
- elsif ( $try eq 'permute' ) {
- $order = $action ? $PERMUTE : $REQUIRE_ORDER;
- }
- elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
- $passthrough = $action;
- }
- elsif ( $try eq 'debug' ) {
- $debug = $action;
- }
- else {
- $Carp::CarpLevel = 1;
- Carp::croak("Getopt::Long: unknown config parameter \"$opt\"")
- }
- }
-}
+# Option lookup.
+sub FindOption ($$$$$$$) {
-# Modified from Exporter. This one handles 2.001 and 2.01 etc just like 2.1.
-sub require_version {
- no strict;
- my ($self, $wanted) = @_;
- my $pkg = ref $self || $self;
- my $version = $ {"${pkg}::VERSION"} || "(undef)";
-
- $wanted .= '.0' unless $wanted =~ /\./;
- $wanted = $1 * 1000 + $2 if $wanted =~ /^(\d+)\.(\d+)$/;
- $version = $1 * 1000 + $2 if $version =~ /^(\d+)\.(\d+)$/;
- if ( $version < $wanted ) {
- $version =~ s/^(\d+)(\d\d\d)$/$1.'.'.(0+$2)/e;
- $wanted =~ s/^(\d+)(\d\d\d)$/$1.'.'.(0+$2)/e;
- $Carp::CarpLevel = 1;
- Carp::croak("$pkg $wanted required--this is only version $version")
- }
- $version;
-}
+ # returns (1, $opt, $arg, $dsttype, $incr, $key) if okay,
+ # returns (0) otherwise.
+
+ my ($prefix, $argend, $opt, $opctl, $bopctl, $names, $aliases) = @_;
+ my $key; # hash key for a hash option
+ my $arg;
-################ Private Subroutines ################
+ print STDERR ("=> find \"$opt\", prefix=\"$prefix\"\n") if $debug;
-$find_option = sub {
+ return (0) unless $opt =~ /^$prefix(.*)$/s;
- return 0 unless $opt =~ /^$genprefix/;
+ $opt = $+;
+ my ($starter) = $1;
- $opt = $';
- my ($starter) = $&;
+ print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug;
my $optarg = undef; # value supplied with --opt=value
my $rest = undef; # remainder from unbundling
# If it is a long option, it may include the value.
- if (($starter eq "--" || $getopt_compat)
- && $opt =~ /^([^=]+)=/ ) {
+ if (($starter eq "--" || ($getopt_compat && !$bundling))
+ && $opt =~ /^([^=]+)=(.*)$/s ) {
$opt = $1;
- $optarg = $';
+ $optarg = $2;
print STDERR ("=> option \"", $opt,
"\", optarg = \"$optarg\"\n") if $debug;
}
@@ -996,8 +530,10 @@ $find_option = sub {
#### Look it up ###
my $tryopt = $opt; # option to try
- my $optbl = \%opctl; # table to look it up (long names)
+ my $optbl = $opctl; # table to look it up (long names)
my $type;
+ my $dsttype = '';
+ my $incr = 0;
if ( $bundling && $starter eq '-' ) {
# Unbundle single letter option.
@@ -1007,11 +543,12 @@ $find_option = sub {
print STDERR ("=> $starter$tryopt unbundled from ",
"$starter$tryopt$rest\n") if $debug;
$rest = undef unless $rest ne '';
- $optbl = \%bopctl; # look it up in the short names table
+ $optbl = $bopctl; # look it up in the short names table
# If bundling == 2, long options can override bundles.
if ( $bundling == 2 and
- defined ($type = $opctl{$tryopt.$rest}) ) {
+ defined ($rest) and
+ defined ($type = $opctl->{$tryopt.$rest}) ) {
print STDERR ("=> $starter$tryopt rebundled to ",
"$starter$tryopt$rest\n") if $debug;
$tryopt .= $rest;
@@ -1026,26 +563,26 @@ $find_option = sub {
# Turn option name into pattern.
my $pat = quotemeta ($opt);
# Look up in option names.
- my @hits = grep (/^$pat/, @opctl);
+ my @hits = grep (/^$pat/, @{$names});
print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
- "out of ", scalar(@opctl), "\n") if $debug;
+ "out of ", scalar(@{$names}), "\n") if $debug;
# Check for ambiguous results.
unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
# See if all matches are for the same option.
my %hit;
foreach ( @hits ) {
- $_ = $aliases{$_} if defined $aliases{$_};
+ $_ = $aliases->{$_} if defined $aliases->{$_};
$hit{$_} = 1;
}
# Now see if it really is ambiguous.
unless ( keys(%hit) == 1 ) {
- return 0 if $passthrough;
- print STDERR ("Option ", $opt, " is ambiguous (",
- join(", ", @hits), ")\n");
+ return (0) if $passthrough;
+ warn ("Option ", $opt, " is ambiguous (",
+ join(", ", @hits), ")\n");
$error++;
undef $opt;
- return 1;
+ return (1, $opt,$arg,$dsttype,$incr,$key);
}
@hits = keys(%hit);
}
@@ -1067,10 +604,10 @@ $find_option = sub {
# Check validity by fetching the info.
$type = $optbl->{$tryopt} unless defined $type;
unless ( defined $type ) {
- return 0 if $passthrough;
+ return (0) if $passthrough;
warn ("Unknown option: ", $opt, "\n");
$error++;
- return 1;
+ return (1, $opt,$arg,$dsttype,$incr,$key);
}
# Apparently valid.
$opt = $tryopt;
@@ -1079,42 +616,43 @@ $find_option = sub {
#### Determine argument status ####
# If it is an option w/o argument, we're almost finished with it.
- if ( $type eq '' || $type eq '!' ) {
+ if ( $type eq '' || $type eq '!' || $type eq '+' ) {
if ( defined $optarg ) {
- return 0 if $passthrough;
- print STDERR ("Option ", $opt, " does not take an argument\n");
+ return (0) if $passthrough;
+ warn ("Option ", $opt, " does not take an argument\n");
$error++;
undef $opt;
}
- elsif ( $type eq '' ) {
+ elsif ( $type eq '' || $type eq '+' ) {
$arg = 1; # supply explicit value
+ $incr = $type eq '+';
}
else {
substr ($opt, 0, 2) = ''; # strip NO prefix
$arg = 0; # supply explicit value
}
unshift (@ARGV, $starter.$rest) if defined $rest;
- return 1;
+ return (1, $opt,$arg,$dsttype,$incr,$key);
}
# Get mandatory status and type info.
my $mand;
- ($mand, $type, $array, $hash) = $type =~ /^(.)(.)(@?)(%?)$/;
+ ($mand, $type, $dsttype, $key) = $type =~ /^(.)(.)([@%]?)$/;
# 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 "=" ) {
- return 0 if $passthrough;
- print STDERR ("Option ", $opt, " requires an argument\n");
+ return (0) if $passthrough;
+ warn ("Option ", $opt, " requires an argument\n");
$error++;
undef $opt;
}
if ( $mand eq ":" ) {
$arg = $type eq "s" ? '' : 0;
}
- return 1;
+ return (1, $opt,$arg,$dsttype,$incr,$key);
}
# Get (possibly optional) argument.
@@ -1123,23 +661,24 @@ $find_option = sub {
# Get key if this is a "name=value" pair for a hash option.
$key = undef;
- if ($hash && defined $arg) {
- ($key, $arg) = ($arg =~ /=/o) ? ($`, $') : ($arg, 1);
+ if ($dsttype eq '%' && defined $arg) {
+ ($key, $arg) = ($arg =~ /^(.*)=(.*)$/s) ? ($1, $2) : ($arg, 1);
}
#### Check if the argument is valid for this option ####
if ( $type eq "s" ) { # string
# A mandatory string takes anything.
- return 1 if $mand eq "=";
+ return (1, $opt,$arg,$dsttype,$incr,$key) if $mand eq "=";
# An optional string takes almost anything.
- return 1 if defined $optarg || defined $rest;
- return 1 if $arg eq "-"; # ??
+ return (1, $opt,$arg,$dsttype,$incr,$key)
+ if defined $optarg || defined $rest;
+ return (1, $opt,$arg,$dsttype,$incr,$key) if $arg eq "-"; # ??
# Check for option or option list terminator.
if ($arg eq $argend ||
- $arg =~ /^$genprefix.+/) {
+ $arg =~ /^$prefix.+/) {
# Push back.
unshift (@ARGV, $arg);
# Supply empty value.
@@ -1148,15 +687,20 @@ $find_option = sub {
}
elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer
- if ( $arg !~ /^-?[0-9]+$/ ) {
+ if ( $bundling && defined $rest && $rest =~ /^(-?[0-9]+)(.*)$/s ) {
+ $arg = $1;
+ $rest = $2;
+ unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
+ }
+ elsif ( $arg !~ /^-?[0-9]+$/ ) {
if ( defined $optarg || $mand eq "=" ) {
if ( $passthrough ) {
unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
unless defined $optarg;
- return 0;
+ return (0);
}
- print STDERR ("Value \"", $arg, "\" invalid for option ",
- $opt, " (number expected)\n");
+ warn ("Value \"", $arg, "\" invalid for option ",
+ $opt, " (number expected)\n");
$error++;
undef $opt;
# Push back.
@@ -1172,15 +716,24 @@ $find_option = sub {
}
elsif ( $type eq "f" ) { # real number, int is also ok
- if ( $arg !~ /^-?[0-9.]+([eE]-?[0-9]+)?$/ ) {
+ # We require at least one digit before a point or 'e',
+ # and at least one digit following the point and 'e'.
+ # [-]NN[.NN][eNN]
+ if ( $bundling && defined $rest &&
+ $rest =~ /^(-?[0-9]+(\.[0-9]+)?([eE]-?[0-9]+)?)(.*)$/s ) {
+ $arg = $1;
+ $rest = $+;
+ unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
+ }
+ elsif ( $arg !~ /^-?[0-9.]+(\.[0-9]+)?([eE]-?[0-9]+)?$/ ) {
if ( defined $optarg || $mand eq "=" ) {
if ( $passthrough ) {
unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
unless defined $optarg;
- return 0;
+ return (0);
}
- print STDERR ("Value \"", $arg, "\" invalid for option ",
- $opt, " (real number expected)\n");
+ warn ("Value \"", $arg, "\" invalid for option ",
+ $opt, " (real number expected)\n");
$error++;
undef $opt;
# Push back.
@@ -1195,44 +748,635 @@ $find_option = sub {
}
}
else {
- die ("GetOpt::Long internal error (Can't happen)\n");
+ Croak ("GetOpt::Long internal error (Can't happen)\n");
}
- return 1;
-};
+ return (1, $opt, $arg, $dsttype, $incr, $key);
+}
-$config_defaults = sub {
- # Handle POSIX compliancy.
- if ( defined $ENV{"POSIXLY_CORRECT"} ) {
- $gen_prefix = "(--|-)";
- $autoabbrev = 0; # no automatic abbrev of options
- $bundling = 0; # no bundling of single letter switches
- $getopt_compat = 0; # disallow '+' to start options
- $order = $REQUIRE_ORDER;
- }
- else {
- $gen_prefix = "(--|-|\\+)";
- $autoabbrev = 1; # automatic abbrev of options
- $bundling = 0; # bundling off by default
- $getopt_compat = 1; # allow '+' to start options
- $order = $PERMUTE;
+# Getopt::Long Configuration.
+sub Configure (@) {
+ my (@options) = @_;
+ my $opt;
+ foreach $opt ( @options ) {
+ my $try = lc ($opt);
+ my $action = 1;
+ if ( $try =~ /^no_?(.*)$/s ) {
+ $action = 0;
+ $try = $+;
+ }
+ if ( $try eq 'default' or $try eq 'defaults' ) {
+ ConfigDefaults () if $action;
+ }
+ elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
+ $autoabbrev = $action;
+ }
+ elsif ( $try eq 'getopt_compat' ) {
+ $getopt_compat = $action;
+ }
+ elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
+ $ignorecase = $action;
+ }
+ elsif ( $try eq 'ignore_case_always' ) {
+ $ignorecase = $action ? 2 : 0;
+ }
+ elsif ( $try eq 'bundling' ) {
+ $bundling = $action;
+ }
+ elsif ( $try eq 'bundling_override' ) {
+ $bundling = $action ? 2 : 0;
+ }
+ elsif ( $try eq 'require_order' ) {
+ $order = $action ? $REQUIRE_ORDER : $PERMUTE;
+ }
+ elsif ( $try eq 'permute' ) {
+ $order = $action ? $PERMUTE : $REQUIRE_ORDER;
+ }
+ elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
+ $passthrough = $action;
+ }
+ elsif ( $try =~ /^prefix=(.+)$/ ) {
+ $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=(.+)$/ ) {
+ $genprefix = $1;
+ # Parenthesize if needed.
+ $genprefix = "(" . $genprefix . ")"
+ unless $genprefix =~ /^\(.*\)$/;
+ eval { '' =~ /$genprefix/; };
+ Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
+ }
+ elsif ( $try eq 'debug' ) {
+ $debug = $action;
+ }
+ else {
+ Croak ("Getopt::Long: unknown config parameter \"$opt\"")
+ }
}
- # Other configurable settings.
- $debug = 0; # for debugging
- $error = 0; # error tally
- $ignorecase = 1; # ignore case when matching options
- $passthrough = 0; # leave unrecognized options alone
+}
+
+# Deprecated name.
+sub config (@) {
+ Configure (@_);
+}
+
+# To prevent Carp from being loaded unnecessarily.
+sub Croak (@) {
+ require 'Carp.pm';
+ $Carp::CarpLevel = 1;
+ Carp::croak(@_);
};
-################ Initialization ################
+################ Documentation ################
-# Values for $order. See GNU getopt.c for details.
-($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
-# Version major/minor numbers.
-($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
+=head1 NAME
-# Set defaults.
-&$config_defaults ();
+GetOptions - extended processing of command line options
-################ Package return ################
+=head1 SYNOPSIS
-1;
+ use Getopt::Long;
+ $result = GetOptions (...option-descriptions...);
+
+=head1 DESCRIPTION
+
+The Getopt::Long module implements an extended getopt function called
+GetOptions(). This function adheres to the POSIX syntax for command
+line options, with GNU extensions. In general, this means that options
+have long names instead of single letters, and are introduced with a
+double dash "--". Support for bundling of command line options, as was
+the case with the more traditional single-letter approach, is provided
+but not enabled by default. For example, the UNIX "ps" command can be
+given the command line "option"
+
+ -vax
+
+which means the combination of B<-v>, B<-a> and B<-x>. With the new
+syntax B<--vax> would be a single option, probably indicating a
+computer architecture.
+
+Command line options can be used to set values. These values can be
+specified in one of two ways:
+
+ --size 24
+ --size=24
+
+GetOptions is called with a list of option-descriptions, each of which
+consists of two elements: the option specifier and the option linkage.
+The option specifier defines the name of the option and, optionally,
+the value it can take. The option linkage is usually a reference to a
+variable that will be set when the option is used. For example, the
+following call to GetOptions:
+
+ GetOptions("size=i" => \$offset);
+
+will accept a command line option "size" that must have an integer
+value. With a command line of "--size 24" this will cause the variable
+$offset to get the value 24.
+
+Alternatively, the first argument to GetOptions may be a reference to
+a HASH describing the linkage for the options, or an object whose
+class is based on a HASH. The following call is equivalent to the
+example above:
+
+ %optctl = ("size" => \$offset);
+ GetOptions(\%optctl, "size=i");
+
+Linkage may be specified using either of the above methods, or both.
+Linkage specified in the argument list takes precedence over the
+linkage specified in the HASH.
+
+The command line options are taken from array @ARGV. Upon completion
+of GetOptions, @ARGV will contain the rest (i.e. the non-options) of
+the command line.
+
+Each option specifier designates the name of the option, optionally
+followed by an argument specifier.
+
+Options that do not take arguments will have no argument specifier.
+The option variable will be set to 1 if the option is used.
+
+For the other options, the values for argument specifiers are:
+
+=over 8
+
+=item !
+
+Option does not take an argument and may be negated, i.e. prefixed by
+"no". E.g. "foo!" will allow B<--foo> (with value 1) and B<-nofoo>
+(with value 0).
+The option variable will be set to 1, or 0 if negated.
+
+=item +
+
+Option does not take an argument and will be incremented by 1 every
+time it appears on the command line. E.g. "more+", when used with
+B<--more --more --more>, will set the option variable to 3 (provided
+it was 0 or undefined at first).
+
+The B<+> specifier is ignored if the option destination is not a SCALAR.
+
+=item =s
+
+Option takes a mandatory string argument.
+This string will be assigned to the option variable.
+Note that even if the string argument starts with B<-> or B<-->, it
+will not be considered an option on itself.
+
+=item :s
+
+Option takes an optional string argument.
+This string will be assigned to the option variable.
+If omitted, it will be assigned "" (an empty string).
+If the string argument starts with B<-> or B<-->, it
+will be considered an option on itself.
+
+=item =i
+
+Option takes a mandatory integer argument.
+This value will be assigned to the option variable.
+Note that the value may start with B<-> to indicate a negative
+value.
+
+=item :i
+
+Option takes an optional integer argument.
+This value will be assigned to the option variable.
+If omitted, the value 0 will be assigned.
+Note that the value may start with B<-> to indicate a negative
+value.
+
+=item =f
+
+Option takes a mandatory real number argument.
+This value will be assigned to the option variable.
+Note that the value may start with B<-> to indicate a negative
+value.
+
+=item :f
+
+Option takes an optional real number argument.
+This value will be assigned to the option variable.
+If omitted, the value 0 will be assigned.
+
+=back
+
+A lone dash B<-> is considered an option, the corresponding option
+name is the empty string.
+
+A double dash on itself B<--> signals end of the options list.
+
+=head2 Linkage specification
+
+The linkage specifier is optional. If no linkage is explicitly
+specified but a ref HASH is passed, GetOptions will place the value in
+the HASH. For example:
+
+ %optctl = ();
+ GetOptions (\%optctl, "size=i");
+
+will perform the equivalent of the assignment
+
+ $optctl{"size"} = 24;
+
+For array options, a reference to an array is used, e.g.:
+
+ %optctl = ();
+ GetOptions (\%optctl, "sizes=i@");
+
+with command line "-sizes 24 -sizes 48" will perform the equivalent of
+the assignment
+
+ $optctl{"sizes"} = [24, 48];
+
+For hash options (an option whose argument looks like "name=value"),
+a reference to a hash is used, e.g.:
+
+ %optctl = ();
+ GetOptions (\%optctl, "define=s%");
+
+with command line "--define foo=hello --define bar=world" will perform the
+equivalent of the assignment
+
+ $optctl{"define"} = {foo=>'hello', bar=>'world')
+
+If no linkage is explicitly specified and no ref HASH is passed,
+GetOptions will put the value in a global variable named after the
+option, prefixed by "opt_". To yield a usable Perl variable,
+characters that are not part of the syntax for variables are
+translated to underscores. For example, "--fpp-struct-return" will set
+the variable $opt_fpp_struct_return. Note that this variable resides
+in the namespace of the calling program, not necessarily B<main>.
+For example:
+
+ GetOptions ("size=i", "sizes=i@");
+
+with command line "-size 10 -sizes 24 -sizes 48" will perform the
+equivalent of the assignments
+
+ $opt_size = 10;
+ @opt_sizes = (24, 48);
+
+A lone dash B<-> is considered an option, the corresponding Perl
+identifier is $opt_ .
+
+The linkage specifier can be a reference to a scalar, a reference to
+an array, a reference to a hash or a reference to a subroutine.
+
+Note that, if your code is running under the recommended C<use strict
+'vars'> pragma, it may be helpful to declare these package variables
+via C<use vars> perhaps something like this:
+
+ use vars qw/ $opt_size @opt_sizes $opt_bar /;
+
+If a REF SCALAR is supplied, the new value is stored in the referenced
+variable. If the option occurs more than once, the previous value is
+overwritten.
+
+If a REF ARRAY is supplied, the new value is appended (pushed) to the
+referenced array.
+
+If a REF HASH is supplied, the option value should look like "key" or
+"key=value" (if the "=value" is omitted then a value of 1 is implied).
+In this case, the element of the referenced hash with the key "key"
+is assigned "value".
+
+If a REF CODE is supplied, the referenced subroutine is called with
+two arguments: the option name and the option value.
+The option name is always the true name, not an abbreviation or alias.
+
+=head2 Aliases and abbreviations
+
+The option name may actually be a list of option names, separated by
+"|"s, e.g. "foo|bar|blech=s". In this example, "foo" is the true name
+of this option. If no linkage is specified, options "foo", "bar" and
+"blech" all will set $opt_foo. For convenience, the single character
+"?" is allowed as an alias, e.g. "help|?".
+
+Option names may be abbreviated to uniqueness, depending on
+configuration option B<auto_abbrev>.
+
+=head2 Non-option call-back routine
+
+A special option specifier, E<lt>E<gt>, can be used to designate a subroutine
+to handle non-option arguments. GetOptions will immediately call this
+subroutine for every non-option it encounters in the options list.
+This subroutine gets the name of the non-option passed.
+This feature requires configuration option B<permute>, see section
+CONFIGURATION OPTIONS.
+
+See also the examples.
+
+=head2 Option starters
+
+On the command line, options can start with B<-> (traditional), B<-->
+(POSIX) and B<+> (GNU, now being phased out). The latter is not
+allowed if the environment variable B<POSIXLY_CORRECT> has been
+defined.
+
+Options that start with "--" may have an argument appended, separated
+with an "=", e.g. "--foo=bar".
+
+=head2 Return values and Errors
+
+Configuration errors and errors in the option definitions are
+signalled using C<die()> and will terminate the calling
+program unless the call to C<Getopt::Long::GetOptions()> was embedded
+in C<eval { ... }> or C<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
+C<warn()> and can be trapped with C<$SIG{__WARN__}>.
+
+Errors that can't happen are signalled using C<Carp::croak()>.
+
+=head1 COMPATIBILITY
+
+Getopt::Long::GetOptions() is the successor of
+B<newgetopt.pl> that came with Perl 4. It is fully upward compatible.
+In fact, the Perl 5 version of newgetopt.pl is just a wrapper around
+the module.
+
+If an "@" sign is appended to the argument specifier, the option is
+treated as an array. Value(s) are not set, but pushed into array
+@opt_name. If explicit linkage is supplied, this must be a reference
+to an ARRAY.
+
+If an "%" sign is appended to the argument specifier, the option is
+treated as a hash. Value(s) of the form "name=value" are set by
+setting the element of the hash %opt_name with key "name" to "value"
+(if the "=value" portion is omitted it defaults to 1). If explicit
+linkage is supplied, this must be a reference to a HASH.
+
+If configuration option B<getopt_compat> is set (see section
+CONFIGURATION OPTIONS), options that start with "+" or "-" may also
+include their arguments, e.g. "+foo=bar". This is for compatiblity
+with older implementations of the GNU "getopt" routine.
+
+If the first argument to GetOptions is a string consisting of only
+non-alphanumeric characters, it is taken to specify the option starter
+characters. Everything starting with one of these characters from the
+starter will be considered an option. B<Using a starter argument is
+strongly deprecated.>
+
+For convenience, option specifiers may have a leading B<-> or B<-->,
+so it is possible to write:
+
+ GetOptions qw(-foo=s --bar=i --ar=s);
+
+=head1 EXAMPLES
+
+If the option specifier is "one:i" (i.e. takes an optional integer
+argument), then the following situations are handled:
+
+ -one -two -> $opt_one = '', -two is next option
+ -one -2 -> $opt_one = -2
+
+Also, assume specifiers "foo=s" and "bar:s" :
+
+ -bar -xxx -> $opt_bar = '', '-xxx' is next option
+ -foo -bar -> $opt_foo = '-bar'
+ -foo -- -> $opt_foo = '--'
+
+In GNU or POSIX format, option names and values can be combined:
+
+ +foo=blech -> $opt_foo = 'blech'
+ --bar= -> $opt_bar = ''
+ --bar=-- -> $opt_bar = '--'
+
+Example of using variable references:
+
+ $ret = GetOptions ('foo=s', \$foo, 'bar=i', 'ar=s', \@ar);
+
+With command line options "-foo blech -bar 24 -ar xx -ar yy"
+this will result in:
+
+ $foo = 'blech'
+ $opt_bar = 24
+ @ar = ('xx','yy')
+
+Example of using the E<lt>E<gt> option specifier:
+
+ @ARGV = qw(-foo 1 bar -foo 2 blech);
+ GetOptions("foo=i", \$myfoo, "<>", \&mysub);
+
+Results:
+
+ mysub("bar") will be called (with $myfoo being 1)
+ mysub("blech") will be called (with $myfoo being 2)
+
+Compare this with:
+
+ @ARGV = qw(-foo 1 bar -foo 2 blech);
+ GetOptions("foo=i", \$myfoo);
+
+This will leave the non-options in @ARGV:
+
+ $myfoo -> 2
+ @ARGV -> qw(bar blech)
+
+=head1 CONFIGURATION OPTIONS
+
+B<GetOptions> can be configured by calling subroutine
+B<Getopt::Long::Configure>. This subroutine takes a list of quoted
+strings, each specifying a configuration option to be set, e.g.
+B<ignore_case>. Options can be reset by prefixing with B<no_>, e.g.
+B<no_ignore_case>. Case does not matter. Multiple calls to B<config>
+are possible.
+
+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 B<config> routine. Besides, it
+is much easier.
+
+The following options are available:
+
+=over 12
+
+=item default
+
+This option causes all configuration options to be reset to their
+default values.
+
+=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 B<auto_abbrev> is reset.
+
+=item getopt_compat
+
+Allow '+' to start options.
+Default is set unless environment variable
+POSIXLY_CORRECT has been set, in which case B<getopt_compat> is reset.
+
+=item require_order
+
+Whether non-options are allowed to be mixed with
+options.
+Default is set unless environment variable
+POSIXLY_CORRECT has been set, in which case b<require_order> is reset.
+
+See also B<permute>, which is the opposite of B<require_order>.
+
+=item permute
+
+Whether non-options are allowed to be mixed with
+options.
+Default is set unless environment variable
+POSIXLY_CORRECT has been set, in which case B<permute> is reset.
+Note that B<permute> is the opposite of B<require_order>.
+
+If B<permute> is set, this means that
+
+ -foo arg1 -bar arg2 arg3
+
+is equivalent to
+
+ -foo -bar arg1 arg2 arg3
+
+If a non-option call-back routine is specified, @ARGV will always be
+empty upon succesful return of GetOptions since all options have been
+processed, except when B<--> is used:
+
+ -foo arg1 -bar arg2 -- arg3
+
+will call the call-back routine for arg1 and arg2, and terminate
+leaving arg2 in @ARGV.
+
+If B<require_order> is set, options processing
+terminates when the first non-option is encountered.
+
+ -foo arg1 -bar arg2 arg3
+
+is equivalent to
+
+ -foo -- arg1 -bar arg2 arg3
+
+=item bundling (default: reset)
+
+Setting this variable to a non-zero value will allow single-character
+options to be bundled. To distinguish bundles from long option names,
+long options must be introduced with B<--> and single-character
+options (and bundles) with B<->. For example,
+
+ ps -vax --vax
+
+would be equivalent to
+
+ ps -v -a -x --vax
+
+provided "vax", "v", "a" and "x" have been defined to be valid
+options.
+
+Bundled options can also include a value in the bundle; for strings
+this value is the rest of the bundle, but integer and floating values
+may be combined in the bundle, e.g.
+
+ scale -h24w80
+
+is equivalent to
+
+ scale -h 24 -w 80
+
+Note: resetting B<bundling> also resets B<bundling_override>.
+
+=item bundling_override (default: reset)
+
+If B<bundling_override> is set, bundling is enabled as with
+B<bundling> but now long option names override option bundles. In the
+above example, B<-vax> would be interpreted as the option "vax", not
+the bundle "v", "a", "x".
+
+Note: resetting B<bundling_override> also resets B<bundling>.
+
+B<Note:> Using option bundling can easily lead to unexpected results,
+especially when mixing long options and bundles. Caveat emptor.
+
+=item ignore_case (default: set)
+
+If set, case is ignored when matching options.
+
+Note: resetting B<ignore_case> also resets B<ignore_case_always>.
+
+=item ignore_case_always (default: reset)
+
+When bundling is in effect, case is ignored on single-character
+options also.
+
+Note: resetting B<ignore_case_always> also resets B<ignore_case>.
+
+=item pass_through (default: reset)
+
+Unknown options are passed through in @ARGV instead of being flagged
+as errors. This makes it possible to write wrapper scripts that
+process only part of the user supplied options, and passes the
+remaining options to some other program.
+
+This can be very confusing, especially when B<permute> is also set.
+
+=item prefix
+
+The string that starts options. See also B<prefix_pattern>.
+
+=item prefix_pattern
+
+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)
+
+Enable copious debugging output.
+
+=back
+
+=head1 OTHER USEFUL VARIABLES
+
+=over 12
+
+=item $Getopt::Long::VERSION
+
+The version number of this Getopt::Long implementation in the format
+C<major>.C<minor>. This can be used to have Exporter check the
+version, e.g.
+
+ use Getopt::Long 3.00;
+
+You can inspect $Getopt::Long::major_version and
+$Getopt::Long::minor_version for the individual components.
+
+=item $Getopt::Long::error
+
+Internal error flag. May be incremented from a call-back routine to
+cause options parsing to fail.
+
+=back
+
+=head1 AUTHOR
+
+Johan Vromans E<lt>jvromans@squirrel.nlE<gt>
+
+=head1 COPYRIGHT AND DISCLAIMER
+
+This program is Copyright 1990,1999 by Johan Vromans.
+This program is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public License
+as published by the Free Software Foundation; either version 2
+of the License, or (at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+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,
+MA 02139, USA.
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/Getopt/Std.pm b/gnu/usr.bin/perl/lib/Getopt/Std.pm
index 27882935f99..390bf14e96c 100644
--- a/gnu/usr.bin/perl/lib/Getopt/Std.pm
+++ b/gnu/usr.bin/perl/lib/Getopt/Std.pm
@@ -27,6 +27,12 @@ switch name) to the value of the argument, or 1 if no argument. Switches
which take an argument don't care whether there is a space between the
switch and the argument.
+Note that, if your code is running under the recommended C<use strict
+'vars'> pragma, it may be helpful to declare these package variables
+via C<use vars> perhaps something like this:
+
+ use vars qw/ $opt_foo $opt_bar /;
+
For those of you who don't like additional variables being created, getopt()
and getopts() will also accept a hash reference as an optional second argument.
Hash keys will be x (where x is the switch name) with key values the value of
@@ -36,8 +42,7 @@ the argument or 1 if no argument is specified.
@ISA = qw(Exporter);
@EXPORT = qw(getopt getopts);
-
-# $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
+$VERSION = $VERSION = '1.01';
# Process single-character switches with switch clustering. Pass one argument
# which is a string containing all switches that take an argument. For each
@@ -51,7 +56,7 @@ the argument or 1 if no argument is specified.
sub getopt ($;$) {
local($argumentative, $hash) = @_;
local($_,$first,$rest);
- local $Exporter::ExportLevel;
+ local @EXPORT;
while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
($first,$rest) = ($1,$2);
@@ -87,8 +92,10 @@ sub getopt ($;$) {
}
}
}
- $Exporter::ExportLevel++;
- import Getopt::Std;
+ unless (ref $hash) {
+ local $Exporter::ExportLevel = 1;
+ import Getopt::Std;
+ }
}
# Usage:
@@ -99,7 +106,7 @@ sub getopts ($;$) {
local($argumentative, $hash) = @_;
local(@args,$_,$first,$rest);
local($errs) = 0;
- local $Exporter::ExportLevel;
+ local @EXPORT;
@args = split( / */, $argumentative );
while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
@@ -137,7 +144,7 @@ sub getopts ($;$) {
}
}
else {
- print STDERR "Unknown option: $first\n";
+ warn "Unknown option: $first\n";
++$errs;
if($rest ne '') {
$ARGV[0] = "-$rest";
@@ -147,8 +154,10 @@ sub getopts ($;$) {
}
}
}
- $Exporter::ExportLevel++;
- import Getopt::Std;
+ unless (ref $hash) {
+ local $Exporter::ExportLevel = 1;
+ import Getopt::Std;
+ }
$errs == 0;
}
diff --git a/gnu/usr.bin/perl/lib/IPC/Open3.pm b/gnu/usr.bin/perl/lib/IPC/Open3.pm
index 5bae5057367..e1cf12f7068 100644
--- a/gnu/usr.bin/perl/lib/IPC/Open3.pm
+++ b/gnu/usr.bin/perl/lib/IPC/Open3.pm
@@ -2,15 +2,15 @@ package IPC::Open3;
use strict;
no strict 'refs'; # because users pass me bareword filehandles
-use vars qw($VERSION @ISA @EXPORT $Fh $Me);
+use vars qw($VERSION @ISA @EXPORT $Me);
require 5.001;
require Exporter;
use Carp;
-use Symbol 'qualify';
+use Symbol qw(gensym qualify);
-$VERSION = 1.0101;
+$VERSION = 1.0103;
@ISA = qw(Exporter);
@EXPORT = qw(open3);
@@ -66,8 +66,9 @@ C<cat -v> and continually read and write a line from it.
# &open3: Marc Horowitz <marc@mit.edu>
# derived mostly from &open2 by tom christiansen, <tchrist@convex.com>
# fixed for 5.001 by Ulrich Kunitz <kunitz@mai-koeln.com>
+# ported to Win32 by Ron Schmidt, Merrill Lynch almost ended my career
#
-# $Id: Open3.pm,v 1.2 1997/11/30 07:57:45 millert Exp $
+# $Id: Open3.pm,v 1.3 1999/04/29 22:51:56 millert Exp $
#
# usage: $pid = open3('wtr', 'rdr', 'err' 'some cmd and args', 'optarg', ...);
#
@@ -93,7 +94,6 @@ C<cat -v> and continually read and write a line from it.
# rdr or wtr are null
# a system call fails
-$Fh = 'FHOPEN000'; # package static in case called more than once
$Me = 'open3 (bug)'; # you should never see this, it's always localized
# Fatal.pm needs to be fixed WRT prototypes.
@@ -119,7 +119,7 @@ sub xclose {
close $_[0] or croak "$Me: close($_[0]) failed: $!";
}
-my $do_spawn = $^O eq 'os2';
+my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32';
sub _open3 {
local $Me = shift;
@@ -139,9 +139,9 @@ sub _open3 {
$dad_rdr = qualify $dad_rdr, $package;
$dad_err = qualify $dad_err, $package;
- my $kid_rdr = ++$Fh;
- my $kid_wtr = ++$Fh;
- my $kid_err = ++$Fh;
+ my $kid_rdr = gensym;
+ my $kid_wtr = gensym;
+ my $kid_err = gensym;
xpipe $kid_rdr, $dad_wtr if !$dup_wtr;
xpipe $dad_rdr, $kid_wtr if !$dup_rdr;
@@ -153,7 +153,7 @@ sub _open3 {
# 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)) {
- my $tmp = ++$Fh;
+ my $tmp = gensym;
xopen($tmp, ">&$dad_err");
$dad_err = $tmp;
}
@@ -162,54 +162,54 @@ sub _open3 {
xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != fileno($dad_wtr);
} else {
xclose $dad_wtr;
- xopen \*STDIN, "<&$kid_rdr";
- xclose $kid_rdr;
+ xopen \*STDIN, "<&=" . fileno $kid_rdr;
}
if ($dup_rdr) {
xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != fileno($dad_rdr);
} else {
xclose $dad_rdr;
- xopen \*STDOUT, ">&$kid_wtr";
- xclose $kid_wtr;
+ xopen \*STDOUT, ">&=" . fileno $kid_wtr;
}
if ($dad_rdr ne $dad_err) {
if ($dup_err) {
- xopen \*STDERR, ">&$dad_err"
+ # 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);
} else {
xclose $dad_err;
- xopen \*STDERR, ">&$kid_err";
- xclose $kid_err;
+ xopen \*STDERR, ">&=" . fileno $kid_err;
}
} else {
xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT);
}
local($")=(" ");
exec @cmd
- or croak "open3: exec of @cmd failed";
+ or croak "$Me: exec of @cmd failed";
} elsif ($do_spawn) {
# All the bookkeeping of coincidence between handles is
# handled in spawn_with_handles.
my @close;
if ($dup_wtr) {
- $kid_rdr = $dad_wtr;
- push @close, \*{$kid_rdr};
+ $kid_rdr = \*{$dad_wtr};
+ push @close, $kid_rdr;
} else {
- push @close, \*{$dad_wtr}, \*{$kid_rdr};
+ push @close, \*{$dad_wtr}, $kid_rdr;
}
if ($dup_rdr) {
- $kid_wtr = $dad_rdr;
- push @close, \*{$kid_wtr};
+ $kid_wtr = \*{$dad_rdr};
+ push @close, $kid_wtr;
} else {
- push @close, \*{$dad_rdr}, \*{$kid_wtr};
+ push @close, \*{$dad_rdr}, $kid_wtr;
}
if ($dad_rdr ne $dad_err) {
if ($dup_err) {
- $kid_err = $dad_err ;
- push @close, \*{$kid_err};
+ $kid_err = \*{$dad_err};
+ push @close, $kid_err;
} else {
- push @close, \*{$dad_err}, \*{$kid_err};
+ push @close, \*{$dad_err}, $kid_err;
}
} else {
$kid_err = $kid_wtr;
@@ -217,17 +217,17 @@ sub _open3 {
require IO::Pipe;
$kidpid = eval {
spawn_with_handles( [ { mode => 'r',
- open_as => \*{$kid_rdr},
+ open_as => $kid_rdr,
handle => \*STDIN },
{ mode => 'w',
- open_as => \*{$kid_wtr},
+ open_as => $kid_wtr,
handle => \*STDOUT },
{ mode => 'w',
- open_as => \*{$kid_err},
+ open_as => $kid_err,
handle => \*STDERR },
], \@close, @cmd);
};
- die "open3: $@" if $@;
+ die "$Me: $@" if $@;
}
xclose $kid_rdr if !$dup_wtr;
@@ -267,10 +267,12 @@ sub spawn_with_handles {
$fd->{handle}->fdopen($saved{fileno $fd->{open_as}} || $fd->{open_as},
$fd->{mode});
}
- # Stderr may be redirected below, so we save the err text:
- foreach $fd (@$close_in_child) {
- fcntl($fd, Fcntl::F_SETFD(), 1) or push @errs, "fcntl $fd: $!"
- unless $saved{fileno $fd}; # Do not close what we redirect!
+ unless ($^O eq 'MSWin32') {
+ # Stderr may be redirected below, so we save the err text:
+ foreach $fd (@$close_in_child) {
+ fcntl($fd, Fcntl::F_SETFD(), 1) or push @errs, "fcntl $fd: $!"
+ unless $saved{fileno $fd}; # Do not close what we redirect!
+ }
}
unless (@errs) {
diff --git a/gnu/usr.bin/perl/lib/Math/BigInt.pm b/gnu/usr.bin/perl/lib/Math/BigInt.pm
index 422dca42fd6..b61b8845693 100644
--- a/gnu/usr.bin/perl/lib/Math/BigInt.pm
+++ b/gnu/usr.bin/perl/lib/Math/BigInt.pm
@@ -36,6 +36,12 @@ sub stringify { "${$_[0]}" }
sub numify { 0 + "${$_[0]}" } # Not needed, additional overhead
# comparing to direct compilation based on
# stringify
+sub import {
+ shift;
+ return unless @_;
+ die "unknown import: @_" unless @_ == 1 and $_[0] eq ':constant';
+ overload::constant integer => sub {Math::BigInt->new(shift)};
+}
$zero = 0;
@@ -76,8 +82,8 @@ sub external { #(int_num_array) return num_str
# Negate input value.
sub bneg { #(num_str) return num_str
local($_) = &bnorm(@_);
- vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0';
- s/^H/N/;
+ return $_ if $_ eq '+0' or $_ eq 'NaN';
+ vec($_,0,8) ^= ord('+') ^ ord('-');
$_;
}
@@ -100,7 +106,7 @@ sub bcmp { #(num_str, num_str) return cond_code
} elsif ($y eq 'NaN') {
undef;
} else {
- &cmp($x,$y);
+ &cmp($x,$y) <=> 0;
}
}
@@ -171,7 +177,7 @@ sub add { #(int_num_array, int_num_array) return int_num_array
$car = 0;
for $x (@x) {
last unless @y || $car;
- $x -= 1e5 if $car = (($x += shift(@y) + $car) >= 1e5) ? 1 : 0;
+ $x -= 1e5 if $car = (($x += (@y ? shift(@y) : 0) + $car) >= 1e5) ? 1 : 0;
}
for $y (@y) {
last unless $car;
@@ -185,8 +191,8 @@ sub sub { #(int_num_array, int_num_array) return int_num_array
local(*sx, *sy) = @_;
$bar = 0;
for $sx (@sx) {
- last unless @y || $bar;
- $sx += 1e5 if $bar = (($sx -= shift(@sy) + $bar) < 0);
+ last unless @sy || $bar;
+ $sx += 1e5 if $bar = (($sx -= (@sy ? shift(@sy) : 0) + $bar) < 0);
}
@sx;
}
@@ -252,9 +258,9 @@ sub bdiv { #(dividend: num_str, divisor: num_str) return num_str
else {
push(@x, 0);
}
- @q = (); ($v2,$v1) = @y[-2,-1];
+ @q = (); ($v2,$v1) = ($y[-2] || 0, $y[-1]);
while ($#x > $#y) {
- ($u2,$u1,$u0) = @x[-3..-1];
+ ($u2,$u1,$u0) = ($x[-3] || 0, $x[-2] || 0, $x[-1]);
$q = (($u0 == $v1) ? 99999 : int(($u0*1e5+$u1)/$v1));
--$q while ($v2*$q > ($u0*1e5+$u1-$q*$v1)*1e5+$u2);
if ($q) {
@@ -384,6 +390,19 @@ are not numbers, as well as the result of dividing by zero.
'1 23 456 7890' canonical value '+1234567890'
+=head1 Autocreating constants
+
+After C<use Math::BigInt ':constant'> all the integer decimal constants
+in the given scope are converted to C<Math::BigInt>. This conversion
+happens at compile time.
+
+In particular
+
+ perl -MMath::BigInt=:constant -e 'print 2**100'
+
+print the integer value of C<2**100>. Note that without conversion of
+constants the expression 2**100 will be calculated as floating point number.
+
=head1 BUGS
The current version of this module is a preliminary version of the
diff --git a/gnu/usr.bin/perl/lib/Math/Complex.pm b/gnu/usr.bin/perl/lib/Math/Complex.pm
index b3d7e6084f2..0db5966e5c9 100644
--- a/gnu/usr.bin/perl/lib/Math/Complex.pm
+++ b/gnu/usr.bin/perl/lib/Math/Complex.pm
@@ -1,23 +1,20 @@
#
# Complex numbers and associated mathematical functions
-# -- Raphael Manfredi September 1996
-# -- Jarkko Hietaniemi March-October 1997
-# -- Daniel S. Lewart September-October 1997
+# -- Raphael Manfredi Since Sep 1996
+# -- Jarkko Hietaniemi Since Mar 1997
+# -- Daniel S. Lewart Since Sep 1997
#
require Exporter;
package Math::Complex;
-$VERSION = 1.05;
+use strict;
-# $Id: Complex.pm,v 1.2 1997/11/30 07:57:47 millert Exp $
+use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS);
-use strict;
+my ( $i, $ip2, %logn );
-use vars qw($VERSION @ISA
- @EXPORT %EXPORT_TAGS
- $package $display
- $i $ip2 $logn %logn);
+$VERSION = sprintf("%s", q$Id: Complex.pm,v 1.3 1999/04/29 22:51:56 millert Exp $ =~ /(\d+\.\d+)/);
@ISA = qw(Exporter);
@@ -34,7 +31,7 @@ my @trig = qw(
);
@EXPORT = (qw(
- i Re Im arg
+ i Re Im rho theta arg
sqrt log ln
log10 logn cbrt root
cplx cplxe
@@ -65,11 +62,12 @@ use overload
qw("" stringify);
#
-# Package globals
+# Package "privates"
#
-$package = 'Math::Complex'; # Package name
-$display = 'cartesian'; # Default display format
+my $package = 'Math::Complex'; # Package name
+my $display = 'cartesian'; # Default display format
+my $eps = 1e-14; # Epsilon
#
# Object attributes (internal):
@@ -80,6 +78,12 @@ $display = 'cartesian'; # Default display format
# display display format (package's global when not set)
#
+# Die on bad *make() arguments.
+
+sub _cannot_make {
+ die "@{[(caller(1))[3]]}: Cannot take $_[0] of $_[1].\n";
+}
+
#
# ->make
#
@@ -88,9 +92,26 @@ $display = 'cartesian'; # Default display format
sub make {
my $self = bless {}, shift;
my ($re, $im) = @_;
- $self->{'cartesian'} = [$re, $im];
+ my $rre = ref $re;
+ if ( $rre ) {
+ if ( $rre eq ref $self ) {
+ $re = Re($re);
+ } else {
+ _cannot_make("real part", $rre);
+ }
+ }
+ my $rim = ref $im;
+ if ( $rim ) {
+ if ( $rim eq ref $self ) {
+ $im = Im($im);
+ } else {
+ _cannot_make("imaginary part", $rim);
+ }
+ }
+ $self->{'cartesian'} = [ $re, $im ];
$self->{c_dirty} = 0;
$self->{p_dirty} = 1;
+ $self->display_format('cartesian');
return $self;
}
@@ -102,6 +123,22 @@ sub make {
sub emake {
my $self = bless {}, shift;
my ($rho, $theta) = @_;
+ my $rrh = ref $rho;
+ if ( $rrh ) {
+ if ( $rrh eq ref $self ) {
+ $rho = rho($rho);
+ } else {
+ _cannot_make("rho", $rrh);
+ }
+ }
+ my $rth = ref $theta;
+ if ( $rth ) {
+ if ( $rth eq ref $self ) {
+ $theta = theta($theta);
+ } else {
+ _cannot_make("theta", $rth);
+ }
+ }
if ($rho < 0) {
$rho = -$rho;
$theta = ($theta <= 0) ? $theta + pi() : $theta - pi();
@@ -109,6 +146,7 @@ sub emake {
$self->{'polar'} = [$rho, $theta];
$self->{p_dirty} = 0;
$self->{c_dirty} = 1;
+ $self->display_format('polar');
return $self;
}
@@ -141,7 +179,7 @@ sub cplxe {
#
# The number defined as pi = 180 degrees
#
-use constant pi => 4 * atan2(1, 1);
+use constant pi => 4 * CORE::atan2(1, 1);
#
# pit2
@@ -158,11 +196,19 @@ use constant pit2 => 2 * pi;
use constant pip2 => pi / 2;
#
+# deg1
+#
+# One degree in radians, used in stringify_polar.
+#
+
+use constant deg1 => pi / 180;
+
+#
# uplog10
#
# Used in log10().
#
-use constant uplog10 => 1 / log(10);
+use constant uplog10 => 1 / CORE::log(10);
#
# i
@@ -200,7 +246,7 @@ sub update_cartesian {
my $self = shift;
my ($r, $t) = @{$self->{'polar'}};
$self->{c_dirty} = 0;
- return $self->{'cartesian'} = [$r * cos $t, $r * sin $t];
+ return $self->{'cartesian'} = [$r * CORE::cos($t), $r * CORE::sin($t)];
}
#
@@ -214,7 +260,7 @@ 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'} = [sqrt($x*$x + $y*$y), atan2($y, $x)];
+ return $self->{'polar'} = [CORE::sqrt($x*$x + $y*$y), CORE::atan2($y, $x)];
}
#
@@ -355,45 +401,32 @@ sub divide {
}
#
-# _zerotozero
-#
-# Die on zero raised to the zeroth.
-#
-sub _zerotozero {
- my $mess = "The zero raised to the zeroth power is not defined.\n";
-
- my @up = caller(1);
-
- $mess .= "Died at $up[1] line $up[2].\n";
-
- die $mess;
-}
-
-#
# (power)
#
# Computes z1**z2 = exp(z2 * log z1)).
#
sub power {
my ($z1, $z2, $inverted) = @_;
- my $z1z = $z1 == 0;
- my $z2z = $z2 == 0;
- _zerotozero if ($z1z and $z2z);
if ($inverted) {
- return 0 if ($z2z);
- return 1 if ($z1z or $z2 == 1);
+ return 1 if $z1 == 0 || $z2 == 1;
+ return 0 if $z2 == 0 && Re($z1) > 0;
} else {
- return 0 if ($z1z);
- return 1 if ($z2z or $z1 == 1);
+ return 1 if $z2 == 0 || $z1 == 1;
+ return 0 if $z1 == 0 && Re($z2) > 0;
}
- return $inverted ? exp($z1 * log $z2) : exp($z2 * log $z1);
+ my $w = $inverted ? CORE::exp($z1 * CORE::log($z2))
+ : CORE::exp($z2 * CORE::log($z1));
+ # If both arguments cartesian, return cartesian, else polar.
+ return $z1->{c_dirty} == 0 &&
+ (not ref $z2 or $z2->{c_dirty} == 0) ?
+ cplx(@{$w->cartesian}) : $w;
}
#
# (spaceship)
#
# Computes z1 <=> z2.
-# Sorts on the real part first, then on the imaginary part. Thus 2-4i > 3+8i.
+# Sorts on the real part first, then on the imaginary part. Thus 2-4i < 3+8i.
#
sub spaceship {
my ($z1, $z2, $inverted) = @_;
@@ -438,26 +471,46 @@ sub conjugate {
#
# (abs)
#
-# Compute complex's norm (rho).
+# Compute or set complex's norm (rho).
#
sub abs {
- my ($z) = @_;
- my ($r, $t) = @{$z->polar};
- return $r;
+ my ($z, $rho) = @_;
+ return $z unless ref $z;
+ if (defined $rho) {
+ $z->{'polar'} = [ $rho, ${$z->polar}[1] ];
+ $z->{p_dirty} = 0;
+ $z->{c_dirty} = 1;
+ return $rho;
+ } else {
+ return ${$z->polar}[0];
+ }
+}
+
+sub _theta {
+ my $theta = $_[0];
+
+ if ($$theta > pi()) { $$theta -= pit2 }
+ elsif ($$theta <= -pi()) { $$theta += pit2 }
}
#
# arg
#
-# Compute complex's argument (theta).
+# Compute or set complex's argument (theta).
#
sub arg {
- my ($z) = @_;
- return ($z < 0 ? pi : 0) unless ref $z;
- my ($r, $t) = @{$z->polar};
- if ($t > pi()) { $t -= pit2 }
- elsif ($t <= -pi()) { $t += pit2 }
- return $t;
+ my ($z, $theta) = @_;
+ return $z unless ref $z;
+ if (defined $theta) {
+ _theta(\$theta);
+ $z->{'polar'} = [ ${$z->polar}[0], $theta ];
+ $z->{p_dirty} = 0;
+ $z->{c_dirty} = 1;
+ } else {
+ $theta = ${$z->polar}[1];
+ _theta(\$theta);
+ }
+ return $theta;
}
#
@@ -465,13 +518,22 @@ sub arg {
#
# Compute sqrt(z).
#
+# It is quite tempting to use wantarray here so that in list context
+# sqrt() would return the two solutions. This, however, would
+# break things like
+#
+# print "sqrt(z) = ", sqrt($z), "\n";
+#
+# The two values would be printed side by side without no intervening
+# whitespace, quite confusing.
+# Therefore if you want the two solutions use the root().
+#
sub sqrt {
my ($z) = @_;
- return $z >= 0 ? sqrt($z) : cplx(0, sqrt(-$z)) unless ref $z;
- my ($re, $im) = @{$z->cartesian};
- return cplx($re < 0 ? (0, sqrt(-$re)) : (sqrt($re), 0)) if $im == 0;
+ my ($re, $im) = ref $z ? @{$z->cartesian} : ($z, 0);
+ return $re < 0 ? cplx(0, CORE::sqrt(-$re)) : CORE::sqrt($re) if $im == 0;
my ($r, $t) = @{$z->polar};
- return (ref $z)->emake(sqrt($r), $t/2);
+ return (ref $z)->emake(CORE::sqrt($r), $t/2);
}
#
@@ -479,12 +541,14 @@ sub sqrt {
#
# Compute cbrt(z) (cubic root).
#
+# Why are we not returning three values? The same answer as for sqrt().
+#
sub cbrt {
my ($z) = @_;
- return $z < 0 ? -exp(log(-$z)/3) : ($z > 0 ? exp(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 (ref $z)->emake(exp(log($r)/3), $t/3);
+ return (ref $z)->emake(CORE::exp(CORE::log($r)/3), $t/3);
}
#
@@ -515,15 +579,17 @@ sub _rootbad {
sub root {
my ($z, $n) = @_;
_rootbad($n) if ($n < 1 or int($n) != $n);
- my ($r, $t) = ref $z ? @{$z->polar} : (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;
my $rho = $r ** (1/$n);
my $theta;
- my $complex = ref($z) || $package;
+ my $cartesian = ref $z && $z->{c_dirty} == 0;
for ($k = 0, $theta = $t / $n; $k < $n; $k++, $theta += $theta_inc) {
- push(@root, $complex->emake($rho, $theta));
+ my $w = cplxe($rho, $theta);
+ # Yes, $cartesian is loop invariant.
+ push @root, $cartesian ? cplx(@{$w->cartesian}) : $w;
}
return @root;
}
@@ -531,25 +597,53 @@ sub root {
#
# Re
#
-# Return Re(z).
+# Return or set Re(z).
#
sub Re {
- my ($z) = @_;
+ my ($z, $Re) = @_;
return $z unless ref $z;
- my ($re, $im) = @{$z->cartesian};
- return $re;
+ if (defined $Re) {
+ $z->{'cartesian'} = [ $Re, ${$z->cartesian}[1] ];
+ $z->{c_dirty} = 0;
+ $z->{p_dirty} = 1;
+ } else {
+ return ${$z->cartesian}[0];
+ }
}
#
# Im
#
-# Return Im(z).
+# Return or set Im(z).
#
sub Im {
- my ($z) = @_;
- return 0 unless ref $z;
- my ($re, $im) = @{$z->cartesian};
- return $im;
+ my ($z, $Im) = @_;
+ return $z unless ref $z;
+ if (defined $Im) {
+ $z->{'cartesian'} = [ ${$z->cartesian}[0], $Im ];
+ $z->{c_dirty} = 0;
+ $z->{p_dirty} = 1;
+ } else {
+ return ${$z->cartesian}[1];
+ }
+}
+
+#
+# rho
+#
+# Return or set rho(w).
+#
+sub rho {
+ Math::Complex::abs(@_);
+}
+
+#
+# theta
+#
+# Return or set theta(w).
+#
+sub theta {
+ Math::Complex::arg(@_);
}
#
@@ -560,7 +654,7 @@ sub Im {
sub exp {
my ($z) = @_;
my ($x, $y) = @{$z->cartesian};
- return (ref $z)->emake(exp($x), $y);
+ return (ref $z)->emake(CORE::exp($x), $y);
}
#
@@ -593,13 +687,13 @@ sub log {
my ($z) = @_;
unless (ref $z) {
_logofzero("log") if $z == 0;
- return $z > 0 ? log($z) : cplx(log(-$z), pi);
+ return $z > 0 ? CORE::log($z) : cplx(CORE::log(-$z), pi);
}
my ($r, $t) = @{$z->polar};
_logofzero("log") if $r == 0;
if ($t > pi()) { $t -= pit2 }
elsif ($t <= -pi()) { $t += pit2 }
- return (ref $z)->make(log($r), $t);
+ return (ref $z)->make(CORE::log($r), $t);
}
#
@@ -628,8 +722,8 @@ sub logn {
my ($z, $n) = @_;
$z = cplx($z, 0) unless ref $z;
my $logn = $logn{$n};
- $logn = $logn{$n} = log($n) unless defined $logn; # Cache log(n)
- return log($z) / $logn;
+ $logn = $logn{$n} = CORE::log($n) unless defined $logn; # Cache log(n)
+ return CORE::log($z) / $logn;
}
#
@@ -640,10 +734,10 @@ sub logn {
sub cos {
my ($z) = @_;
my ($x, $y) = @{$z->cartesian};
- my $ey = exp($y);
+ my $ey = CORE::exp($y);
my $ey_1 = 1 / $ey;
- return (ref $z)->make(cos($x) * ($ey + $ey_1)/2,
- sin($x) * ($ey_1 - $ey)/2);
+ return (ref $z)->make(CORE::cos($x) * ($ey + $ey_1)/2,
+ CORE::sin($x) * ($ey_1 - $ey)/2);
}
#
@@ -654,10 +748,10 @@ sub cos {
sub sin {
my ($z) = @_;
my ($x, $y) = @{$z->cartesian};
- my $ey = exp($y);
+ my $ey = CORE::exp($y);
my $ey_1 = 1 / $ey;
- return (ref $z)->make(sin($x) * ($ey + $ey_1)/2,
- cos($x) * ($ey - $ey_1)/2);
+ return (ref $z)->make(CORE::sin($x) * ($ey + $ey_1)/2,
+ CORE::cos($x) * ($ey - $ey_1)/2);
}
#
@@ -667,9 +761,9 @@ sub sin {
#
sub tan {
my ($z) = @_;
- my $cz = cos($z);
- _divbyzero "tan($z)", "cos($z)" if ($cz == 0);
- return sin($z) / $cz;
+ my $cz = CORE::cos($z);
+ _divbyzero "tan($z)", "cos($z)" if (CORE::abs($cz) < $eps);
+ return CORE::sin($z) / $cz;
}
#
@@ -679,7 +773,7 @@ sub tan {
#
sub sec {
my ($z) = @_;
- my $cz = cos($z);
+ my $cz = CORE::cos($z);
_divbyzero "sec($z)", "cos($z)" if ($cz == 0);
return 1 / $cz;
}
@@ -691,7 +785,7 @@ sub sec {
#
sub csc {
my ($z) = @_;
- my $sz = sin($z);
+ my $sz = CORE::sin($z);
_divbyzero "csc($z)", "sin($z)" if ($sz == 0);
return 1 / $sz;
}
@@ -710,9 +804,9 @@ sub cosec { Math::Complex::csc(@_) }
#
sub cot {
my ($z) = @_;
- my $sz = sin($z);
+ my $sz = CORE::sin($z);
_divbyzero "cot($z)", "sin($z)" if ($sz == 0);
- return cos($z) / $sz;
+ return CORE::cos($z) / $sz;
}
#
@@ -729,17 +823,17 @@ sub cotan { Math::Complex::cot(@_) }
#
sub acos {
my $z = $_[0];
- return atan2(sqrt(1-$z*$z), $z) if (! ref $z) && abs($z) <= 1;
+ 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);
- my $t1 = sqrt(($x+1)*($x+1) + $y*$y);
- my $t2 = sqrt(($x-1)*($x-1) + $y*$y);
+ 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;
my $beta = ($t1 - $t2)/2;
$alpha = 1 if $alpha < 1;
if ($beta > 1) { $beta = 1 }
elsif ($beta < -1) { $beta = -1 }
- my $u = atan2(sqrt(1-$beta*$beta), $beta);
- my $v = log($alpha + sqrt($alpha*$alpha-1));
+ 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);
}
@@ -751,17 +845,17 @@ sub acos {
#
sub asin {
my $z = $_[0];
- return atan2($z, sqrt(1-$z*$z)) if (! ref $z) && abs($z) <= 1;
+ 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);
- my $t1 = sqrt(($x+1)*($x+1) + $y*$y);
- my $t2 = sqrt(($x-1)*($x-1) + $y*$y);
+ 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;
my $beta = ($t1 - $t2)/2;
$alpha = 1 if $alpha < 1;
if ($beta > 1) { $beta = 1 }
elsif ($beta < -1) { $beta = -1 }
- my $u = atan2($beta, sqrt(1-$beta*$beta));
- my $v = -log($alpha + sqrt($alpha*$alpha-1));
+ 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);
}
@@ -773,10 +867,10 @@ sub asin {
#
sub atan {
my ($z) = @_;
- return atan2($z, 1) unless ref $z;
+ return CORE::atan2($z, 1) unless ref $z;
_divbyzero "atan(i)" if ( $z == i);
_divbyzero "atan(-i)" if (-$z == i);
- my $log = log((i + $z) / (i - $z));
+ my $log = CORE::log((i + $z) / (i - $z));
$ip2 = 0.5 * i unless defined $ip2;
return $ip2 * $log;
}
@@ -817,9 +911,10 @@ sub acosec { Math::Complex::acsc(@_) }
#
sub acot {
my ($z) = @_;
- return ($z >= 0) ? atan2(1, $z) : atan2(-1, -$z) unless ref $z;
- _divbyzero "acot(i)", if ( $z == i);
- _divbyzero "acot(-i)" if (-$z == i);
+ _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);
return atan(1 / $z);
}
@@ -839,14 +934,14 @@ sub cosh {
my ($z) = @_;
my $ex;
unless (ref $z) {
- $ex = exp($z);
+ $ex = CORE::exp($z);
return ($ex + 1/$ex)/2;
}
my ($x, $y) = @{$z->cartesian};
- $ex = exp($x);
+ $ex = CORE::exp($x);
my $ex_1 = 1 / $ex;
- return (ref $z)->make(cos($y) * ($ex + $ex_1)/2,
- sin($y) * ($ex - $ex_1)/2);
+ return (ref $z)->make(CORE::cos($y) * ($ex + $ex_1)/2,
+ CORE::sin($y) * ($ex - $ex_1)/2);
}
#
@@ -858,14 +953,14 @@ sub sinh {
my ($z) = @_;
my $ex;
unless (ref $z) {
- $ex = exp($z);
+ $ex = CORE::exp($z);
return ($ex - 1/$ex)/2;
}
my ($x, $y) = @{$z->cartesian};
- $ex = exp($x);
+ $ex = CORE::exp($x);
my $ex_1 = 1 / $ex;
- return (ref $z)->make(cos($y) * ($ex - $ex_1)/2,
- sin($y) * ($ex + $ex_1)/2);
+ return (ref $z)->make(CORE::cos($y) * ($ex - $ex_1)/2,
+ CORE::sin($y) * ($ex + $ex_1)/2);
}
#
@@ -938,15 +1033,15 @@ sub cotanh { Math::Complex::coth(@_) }
sub acosh {
my ($z) = @_;
unless (ref $z) {
- return log($z + sqrt($z*$z-1)) if $z >= 1;
+ 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(log($re + sqrt($re*$re - 1)), 0) if $re >= 1;
- return cplx(0, atan2(sqrt(1-$re*$re), $re)) if abs($re) <= 1;
+ 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 log($z + sqrt($z*$z - 1));
+ return CORE::log($z + CORE::sqrt($z*$z - 1));
}
#
@@ -956,7 +1051,7 @@ sub acosh {
#
sub asinh {
my ($z) = @_;
- return log($z + sqrt($z*$z + 1));
+ return CORE::log($z + CORE::sqrt($z*$z + 1));
}
#
@@ -967,12 +1062,12 @@ sub asinh {
sub atanh {
my ($z) = @_;
unless (ref $z) {
- return log((1 + $z)/(1 - $z))/2 if abs($z) < 1;
+ 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 * log((1 + $z) / (1 - $z));
+ return 0.5 * CORE::log((1 + $z) / (1 - $z));
}
#
@@ -1011,13 +1106,14 @@ sub acosech { Math::Complex::acsch(@_) }
#
sub acoth {
my ($z) = @_;
+ _divbyzero 'acoth(0)' if (CORE::abs($z) < $eps);
unless (ref $z) {
- return log(($z + 1)/($z - 1))/2 if abs($z) > 1;
+ return CORE::log(($z + 1)/($z - 1))/2 if CORE::abs($z) > 1;
$z = cplx($z, 0);
}
- _divbyzero 'acoth(1)', "$z - 1" if ($z == 1);
- _logofzero 'acoth(-1)' if ($z == -1);
- return log((1 + $z) / ($z - 1)) / 2;
+ _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;
}
#
@@ -1043,7 +1139,7 @@ sub atan2 {
($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
}
if ($im2 == 0) {
- return cplx(atan2($re1, $re2), 0) if $im1 == 0;
+ return cplx(CORE::atan2($re1, $re2), 0) if $im1 == 0;
return cplx(($im1<=>0) * pip2, 0) if $re2 == 0;
}
my $w = atan($z1/$z2);
@@ -1117,28 +1213,58 @@ sub stringify_cartesian {
my $z = shift;
my ($x, $y) = @{$z->cartesian};
my ($re, $im);
- my $eps = 1e-14;
$x = int($x + ($x < 0 ? -1 : 1) * $eps)
- if int(abs($x)) != int(abs($x) + $eps);
+ if int(CORE::abs($x)) != int(CORE::abs($x) + $eps);
$y = int($y + ($y < 0 ? -1 : 1) * $eps)
- if int(abs($y)) != int(abs($y) + $eps);
+ if int(CORE::abs($y)) != int(CORE::abs($y) + $eps);
- $re = "$x" if abs($x) >= $eps;
+ $re = "$x" if CORE::abs($x) >= $eps;
if ($y == 1) { $im = 'i' }
elsif ($y == -1) { $im = '-i' }
- elsif (abs($y) >= $eps) { $im = $y . "i" }
+ elsif (CORE::abs($y) >= $eps) { $im = $y . "i" }
my $str = '';
$str = $re if defined $re;
$str .= "+$im" if defined $im;
$str =~ s/\+-/-/;
$str =~ s/^\+//;
+ $str =~ s/([-+])1i/$1i/; # Not redundant with the above 1/-1 tests.
$str = '0' unless $str;
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
#
@@ -1148,7 +1274,6 @@ sub stringify_polar {
my $z = shift;
my ($r, $t) = @{$z->polar};
my $theta;
- my $eps = 1e-14;
return '[0,0]' if $r <= $eps;
@@ -1156,15 +1281,15 @@ sub stringify_polar {
$nt = ($nt - int($nt)) * pit2;
$nt += pit2 if $nt < 0; # Range [0, 2pi]
- if (abs($nt) <= $eps) { $theta = 0 }
- elsif (abs(pi-$nt) <= $eps) { $theta = 'pi' }
+ 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(abs($r)) != int(abs($r) + $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(abs($theta)) != int(abs($theta) + $eps));
+ int(CORE::abs($theta)) != int(CORE::abs($theta) + $eps));
return "\[$r,$theta\]";
}
@@ -1173,24 +1298,35 @@ sub stringify_polar {
#
$nt -= pit2 if $nt > pi;
- my ($n, $k, $kpi);
- for ($k = 1, $kpi = pi; $k < 10; $k++, $kpi += pi) {
+ if (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 (abs($kpi/$n - $nt) <= $eps) {
- $theta = ($nt < 0 ? '-':'').
- ($k == 1 ? 'pi':"${k}pi").'/'.abs($n);
- last;
+ 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;
+ last;
}
+ }
}
$theta = $nt unless defined $theta;
$r = int($r + ($r < 0 ? -1 : 1) * $eps)
- if int(abs($r)) != int(abs($r) + $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(abs($theta)) != int(abs($theta) + $eps));
+ int(CORE::abs($theta)) != int(CORE::abs($theta) + $eps));
return "\[$r,$theta\]";
}
@@ -1323,6 +1459,8 @@ number) and the above definition states that
sqrt([x,pi]) = sqrt(x) * exp(i*pi/2) = [sqrt(x),pi/2] = sqrt(x)*i
which is exactly what we had defined for negative real numbers above.
+The C<sqrt> returns only one of the solutions: if you want the both,
+use the C<root> function.
All the common mathematical functions defined on real numbers that
are extended to complex numbers share that same property of working
@@ -1375,13 +1513,13 @@ the following (overloaded) operations are supported on complex numbers:
z1 * z2 = (r1 * r2) * exp(i * (t1 + t2))
z1 / z2 = (r1 / r2) * exp(i * (t1 - t2))
z1 ** z2 = exp(z2 * log z1)
- ~z1 = a - bi
- abs(z1) = r1 = sqrt(a*a + b*b)
- sqrt(z1) = sqrt(r1) * exp(i * t1/2)
- exp(z1) = exp(a) * exp(i * b)
- log(z1) = log(r1) + i*t1
- sin(z1) = 1/2i (exp(i * z1) - exp(-i * z1))
- cos(z1) = 1/2 (exp(i * z1) + exp(-i * z1))
+ ~z = a - bi
+ abs(z) = r1 = sqrt(a*a + b*b)
+ sqrt(z) = sqrt(r1) * exp(i * t/2)
+ exp(z) = exp(a) * exp(i * b)
+ log(z) = log(r1) + i*t
+ sin(z) = 1/2i (exp(i * z1) - exp(-i * z))
+ cos(z) = 1/2 (exp(i * z1) + exp(-i * z))
atan2(z1, z2) = atan(z1/z2)
The following extra operations are supported on both real and complex
@@ -1390,6 +1528,7 @@ numbers:
Re(z) = a
Im(z) = b
arg(z) = t
+ abs(z) = r
cbrt(z) = z ** (1/3)
log10(z) = log(z) / log(10)
@@ -1425,10 +1564,13 @@ numbers:
asech(z) = acosh(1 / z)
acoth(z) = atanh(1 / z) = 1/2 * log((1+z) / (z-1))
-I<log>, I<csc>, I<cot>, I<acsc>, I<acot>, I<csch>, I<coth>,
-I<acosech>, I<acotanh>, have aliases I<ln>, I<cosec>, I<cotan>,
-I<acosec>, I<acotan>, I<cosech>, I<cotanh>, I<acosech>, I<acotanh>,
-respectively.
+I<arg>, I<abs>, I<log>, I<csc>, I<cot>, I<acsc>, I<acot>, I<csch>,
+I<coth>, I<acosech>, I<acotanh>, have aliases I<rho>, I<theta>, I<ln>,
+I<cosec>, I<cotan>, I<acosec>, I<acotan>, I<cosech>, I<cotanh>,
+I<acosech>, I<acotanh>, respectively. C<Re>, C<Im>, C<arg>, C<abs>,
+C<rho>, and C<theta> can be used also also mutators. The C<cbrt>
+returns only one of the solutions: if you want all three, use the
+C<root> function.
The I<root> function is available to compute all the I<n>
roots of some complex, where I<n> is a strictly positive integer.
@@ -1479,6 +1621,13 @@ but that will be silently converted into C<[3,-3pi/4]>, since the modulus
must be non-negative (it represents the distance to the origin in the complex
plane).
+It is also possible to have a complex number as either argument of
+either the C<make> or C<emake>: the appropriate component of
+the argument will be used.
+
+ $z1 = cplx(-2, 1);
+ $z2 = cplx($z1, 4);
+
=head1 STRINGIFICATION
When printed, a complex number is usually shown under its cartesian
@@ -1527,26 +1676,19 @@ Here are some examples:
$k = exp(i * 2*pi/3);
print "$j - $k = ", $j - $k, "\n";
-=head1 ERRORS DUE TO DIVISION BY ZERO
+ $z->Re(3); # Re, Im, arg, abs,
+ $j->arg(2); # (the last two aka rho, theta)
+ # can be used also as mutators.
+
+=head1 ERRORS DUE TO DIVISION BY ZERO OR LOGARITHM OF ZERO
The division (/) and the following functions
- tan
- sec
- csc
- cot
- asec
- acsc
- atan
- acot
- tanh
- sech
- csch
- coth
- atanh
- asech
- acsch
- acoth
+ log ln log10 logn
+ tan sec csc cot
+ atan asec acsc acot
+ tanh sech csch coth
+ atanh asech acsch acoth
cannot be computed for all arguments because that would mean dividing
by zero or taking logarithm of zero. These situations cause fatal
@@ -1562,13 +1704,30 @@ or
Died at...
For the C<csc>, C<cot>, C<asec>, C<acsc>, C<acot>, C<csch>, C<coth>,
-C<asech>, C<acsch>, the argument cannot be C<0> (zero). For the
-C<atanh>, C<acoth>, the argument cannot be C<1> (one). For the
-C<atanh>, C<acoth>, the argument cannot be C<-1> (minus one). For the
-C<atan>, C<acot>, the argument cannot be C<i> (the imaginary unit).
-For the C<atan>, C<acoth>, the argument cannot be C<-i> (the negative
-imaginary unit). For the C<tan>, C<sec>, C<tanh>, C<sech>, the
-argument cannot be I<pi/2 + k * pi>, where I<k> is any integer.
+C<asech>, C<acsch>, the argument cannot be C<0> (zero). For the the
+logarithmic functions and the C<atanh>, C<acoth>, the argument cannot
+be C<1> (one). For the C<atanh>, C<acoth>, the argument cannot be
+C<-1> (minus one). For the C<atan>, C<acot>, the argument cannot be
+C<i> (the imaginary unit). For the C<atan>, C<acoth>, the argument
+cannot be C<-i> (the negative imaginary unit). For the C<tan>,
+C<sec>, C<tanh>, the argument cannot be I<pi/2 + k * pi>, where I<k>
+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<tan(2*atan2(1,1)+1e-15)> will die of
+division by zero.
+
+=head1 ERRORS DUE TO INDIGESTIBLE ARGUMENTS
+
+The C<make> and C<emake> accept both real and complex arguments.
+When they cannot recognize the arguments they will die with error
+messages like the following
+
+ Math::Complex::make: Cannot take real part of ...
+ Math::Complex::make: Cannot take real part of ...
+ Math::Complex::emake: Cannot take rho of ...
+ Math::Complex::emake: Cannot take theta of ...
=head1 BUGS
@@ -1580,6 +1739,11 @@ All routines expect to be given real or complex numbers. Don't attempt to
use BigFloat, since Perl has currently no rule to disambiguate a '+'
operation (for instance) between two overloaded entities.
+In Cray UNICOS there is some strange numerical instability that results
+in root(), cos(), sin(), cosh(), sinh(), losing accuracy fast. Beware.
+The bug may be in UNICOS math libs, in UNICOS C compiler, in Math::Complex.
+Whatever it is, it does not manifest itself anywhere else where Perl runs.
+
=head1 AUTHORS
Raphael Manfredi <F<Raphael_Manfredi@grenoble.hp.com>> and
@@ -1589,4 +1753,6 @@ Extensive patches by Daniel S. Lewart <F<d-lewart@uiuc.edu>>.
=cut
+1;
+
# eof
diff --git a/gnu/usr.bin/perl/lib/Math/Trig.pm b/gnu/usr.bin/perl/lib/Math/Trig.pm
index a1cbb072340..924286d2049 100644
--- a/gnu/usr.bin/perl/lib/Math/Trig.pm
+++ b/gnu/usr.bin/perl/lib/Math/Trig.pm
@@ -1,6 +1,6 @@
#
# Trigonometric functions, mostly inherited from Math::Complex.
-# -- Jarkko Hietaniemi, April 1997
+# -- Jarkko Hietaniemi, since April 1997
# -- Raphael Manfredi, September 1996 (indirectly: because of Math::Complex)
#
@@ -13,7 +13,7 @@ use Math::Complex qw(:trig);
use vars qw($VERSION $PACKAGE
@ISA
- @EXPORT);
+ @EXPORT @EXPORT_OK %EXPORT_TAGS);
@ISA = qw(Exporter);
@@ -26,13 +26,25 @@ my @angcnv = qw(rad2deg rad2grad
@EXPORT = (@{$Math::Complex::EXPORT_TAGS{'trig'}},
@angcnv);
-use constant pi2 => 2 * pi;
-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;
+my @rdlcnv = qw(cartesian_to_cylindrical
+ cartesian_to_spherical
+ cylindrical_to_cartesian
+ cylindrical_to_spherical
+ spherical_to_cartesian
+ spherical_to_cylindrical);
+
+@EXPORT_OK = (@rdlcnv, 'great_circle_distance');
+
+%EXPORT_TAGS = ('radial' => [ @rdlcnv ]);
+
+use constant pi2 => 2 * pi;
+use constant pip2 => pi / 2;
+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;
#
# Truncating remainder.
@@ -59,6 +71,61 @@ sub rad2grad ($) { remt(RG * $_[0], 400) }
sub grad2rad ($) { remt(GR * $_[0], pi2) }
+sub cartesian_to_spherical {
+ my ( $x, $y, $z ) = @_;
+
+ my $rho = sqrt( $x * $x + $y * $y + $z * $z );
+
+ return ( $rho,
+ atan2( $y, $x ),
+ $rho ? acos( $z / $rho ) : 0 );
+}
+
+sub spherical_to_cartesian {
+ my ( $rho, $theta, $phi ) = @_;
+
+ return ( $rho * cos( $theta ) * sin( $phi ),
+ $rho * sin( $theta ) * sin( $phi ),
+ $rho * cos( $phi ) );
+}
+
+sub spherical_to_cylindrical {
+ my ( $x, $y, $z ) = spherical_to_cartesian( @_ );
+
+ return ( sqrt( $x * $x + $y * $y ), $_[1], $z );
+}
+
+sub cartesian_to_cylindrical {
+ my ( $x, $y, $z ) = @_;
+
+ return ( sqrt( $x * $x + $y * $y ), atan2( $y, $x ), $z );
+}
+
+sub cylindrical_to_cartesian {
+ my ( $rho, $theta, $z ) = @_;
+
+ return ( $rho * cos( $theta ), $rho * sin( $theta ), $z );
+}
+
+sub cylindrical_to_spherical {
+ return ( cartesian_to_spherical( cylindrical_to_cartesian( @_ ) ) );
+}
+
+sub great_circle_distance {
+ my ( $theta0, $phi0, $theta1, $phi1, $rho ) = @_;
+
+ $rho = 1 unless defined $rho; # Default to the unit sphere.
+
+ my $lat0 = pip2 - $phi0;
+ my $lat1 = pip2 - $phi1;
+
+ return $rho *
+ acos(cos( $lat0 ) * cos( $lat1 ) * cos( $theta0 - $theta1 ) +
+ sin( $lat0 ) * sin( $lat1 ) );
+}
+
+=pod
+
=head1 NAME
Math::Trig - trigonometric functions
@@ -86,68 +153,72 @@ conversions.
The tangent
- tan
+=over 4
+
+=item B<tan>
+
+=back
The cofunctions of the sine, cosine, and tangent (cosec/csc and cotan/cot
are aliases)
- csc cosec sec cot cotan
+B<csc>, B<cosec>, B<sec>, B<sec>, B<cot>, B<cotan>
The arcus (also known as the inverse) functions of the sine, cosine,
and tangent
- asin acos atan
+B<asin>, B<acos>, B<atan>
The principal value of the arc tangent of y/x
- atan2(y, x)
+B<atan2>(y, x)
The arcus cofunctions of the sine, cosine, and tangent (acosec/acsc
and acotan/acot are aliases)
- acsc acosec asec acot acotan
+B<acsc>, B<acosec>, B<asec>, B<acot>, B<acotan>
The hyperbolic sine, cosine, and tangent
- sinh cosh tanh
+B<sinh>, B<cosh>, B<tanh>
The cofunctions of the hyperbolic sine, cosine, and tangent (cosech/csch
and cotanh/coth are aliases)
- csch cosech sech coth cotanh
+B<csch>, B<cosech>, B<sech>, B<coth>, B<cotanh>
The arcus (also known as the inverse) functions of the hyperbolic
sine, cosine, and tangent
- asinh acosh atanh
+B<asinh>, B<acosh>, B<atanh>
The arcus cofunctions of the hyperbolic sine, cosine, and tangent
(acsch/acosech and acoth/acotanh are aliases)
- acsch acosech asech acoth acotanh
+B<acsch>, B<acosech>, B<asech>, B<acoth>, B<acotanh>
The trigonometric constant B<pi> is also defined.
- $pi2 = 2 * pi;
+$pi2 = 2 * B<pi>;
=head2 ERRORS DUE TO DIVISION BY ZERO
The following functions
- tan
- sec
- csc
- cot
- asec
+ acoth
acsc
- tanh
- sech
- csch
- coth
- atanh
- asech
acsch
- acoth
+ asec
+ asech
+ atanh
+ cot
+ coth
+ csc
+ csch
+ sec
+ sech
+ tan
+ tanh
cannot be computed for all arguments because that would mean dividing
by zero or taking logarithm of zero. These situations cause fatal
@@ -196,7 +267,7 @@ should produce something like this (take or leave few last decimals):
That is, a complex number with the real part of approximately C<1.571>
and the imaginary part of approximately C<-1.317>.
-=head1 ANGLE CONVERSIONS
+=head1 PLANE ANGLE CONVERSIONS
(Plane, 2-dimensional) angles may be converted with the following functions.
@@ -211,6 +282,135 @@ and the imaginary part of approximately C<-1.317>.
The full circle is 2 I<pi> radians or I<360> degrees or I<400> gradians.
+=head1 RADIAL COORDINATE CONVERSIONS
+
+B<Radial coordinate systems> are the B<spherical> and the B<cylindrical>
+systems, explained shortly in more detail.
+
+You can import radial coordinate conversion functions by using the
+C<:radial> tag:
+
+ use Math::Trig ':radial';
+
+ ($rho, $theta, $z) = cartesian_to_cylindrical($x, $y, $z);
+ ($rho, $theta, $phi) = cartesian_to_spherical($x, $y, $z);
+ ($x, $y, $z) = cylindrical_to_cartesian($rho, $theta, $z);
+ ($rho_s, $theta, $phi) = cylindrical_to_spherical($rho_c, $theta, $z);
+ ($x, $y, $z) = spherical_to_cartesian($rho, $theta, $phi);
+ ($rho_c, $theta, $z) = spherical_to_cylindrical($rho_s, $theta, $phi);
+
+B<All angles are in radians>.
+
+=head2 COORDINATE SYSTEMS
+
+B<Cartesian> coordinates are the usual rectangular I<(x, y,
+z)>-coordinates.
+
+Spherical coordinates, I<(rho, theta, pi)>, are three-dimensional
+coordinates which define a point in three-dimensional space. They are
+based on a sphere surface. The radius of the sphere is B<rho>, also
+known as the I<radial> coordinate. The angle in the I<xy>-plane
+(around the I<z>-axis) is B<theta>, also known as the I<azimuthal>
+coordinate. The angle from the I<z>-axis is B<phi>, also known as the
+I<polar> coordinate. The `North Pole' is therefore I<0, 0, rho>, and
+the `Bay of Guinea' (think of the missing big chunk of Africa) I<0,
+pi/2, rho>. In geographical terms I<phi> is latitude (northward
+positive, southward negative) and I<theta> is longitude (eastward
+positive, westward negative).
+
+B<BEWARE>: some texts define I<theta> and I<phi> the other way round,
+some texts define the I<phi> to start from the horizontal plane, some
+texts use I<r> in place of I<rho>.
+
+Cylindrical coordinates, I<(rho, theta, z)>, are three-dimensional
+coordinates which define a point in three-dimensional space. They are
+based on a cylinder surface. The radius of the cylinder is B<rho>,
+also known as the I<radial> coordinate. The angle in the I<xy>-plane
+(around the I<z>-axis) is B<theta>, also known as the I<azimuthal>
+coordinate. The third coordinate is the I<z>, pointing up from the
+B<theta>-plane.
+
+=head2 3-D ANGLE CONVERSIONS
+
+Conversions to and from spherical and cylindrical coordinates are
+available. Please notice that the conversions are not necessarily
+reversible because of the equalities like I<pi> angles being equal to
+I<-pi> angles.
+
+=over 4
+
+=item cartesian_to_cylindrical
+
+ ($rho, $theta, $z) = cartesian_to_cylindrical($x, $y, $z);
+
+=item cartesian_to_spherical
+
+ ($rho, $theta, $phi) = cartesian_to_spherical($x, $y, $z);
+
+=item cylindrical_to_cartesian
+
+ ($x, $y, $z) = cylindrical_to_cartesian($rho, $theta, $z);
+
+=item cylindrical_to_spherical
+
+ ($rho_s, $theta, $phi) = cylindrical_to_spherical($rho_c, $theta, $z);
+
+Notice that when C<$z> is not 0 C<$rho_s> is not equal to C<$rho_c>.
+
+=item spherical_to_cartesian
+
+ ($x, $y, $z) = spherical_to_cartesian($rho, $theta, $phi);
+
+=item spherical_to_cylindrical
+
+ ($rho_c, $theta, $z) = spherical_to_cylindrical($rho_s, $theta, $phi);
+
+Notice that when C<$z> is not 0 C<$rho_c> is not equal to C<$rho_s>.
+
+=back
+
+=head1 GREAT CIRCLE DISTANCES
+
+You can compute spherical distances, called B<great circle distances>,
+by importing the C<great_circle_distance> function:
+
+ use Math::Trig 'great_circle_distance'
+
+ $distance = great_circle_distance($theta0, $phi0, $theta1, $phi1, [, $rho]);
+
+The I<great circle distance> is the shortest distance between two
+points on a sphere. The distance is in C<$rho> units. The C<$rho> is
+optional, it defaults to 1 (the unit sphere), therefore the distance
+defaults to radians.
+
+If you think geographically the I<theta> are longitudes: zero at the
+Greenwhich meridian, eastward positive, westward negative--and the
+I<phi> are latitudes: zero at the North Pole, northward positive,
+southward negative. B<NOTE>: this formula thinks in mathematics, not
+geographically: the I<phi> zero is at the North Pole, not at the
+Equator on the west coast of Africa (Bay of Guinea). You need to
+subtract your geographical coordinates from I<pi/2> (also known as 90
+degrees).
+
+ $distance = great_circle_distance($lon0, pi/2 - $lat0,
+ $lon1, pi/2 - $lat1, $rho);
+
+=head1 EXAMPLES
+
+To calculate the distance between London (51.3N 0.5W) and Tokyo (35.7N
+139.8E) in kilometers:
+
+ use Math::Trig qw(great_circle_distance deg2rad);
+
+ # Notice the 90 - latitude: phi zero is at the North Pole.
+ @L = (deg2rad(-0.5), deg2rad(90 - 51.3));
+ @T = (deg2rad(139.8),deg2rad(90 - 35.7));
+
+ $km = great_circle_distance(@L, @T, 6378);
+
+The answer may be off by few percentages because of the irregular
+(slightly aspherical) form of the Earth.
+
=head1 BUGS
Saying C<use Math::Trig;> exports many mathematical routines in the
diff --git a/gnu/usr.bin/perl/lib/Net/Ping.pm b/gnu/usr.bin/perl/lib/Net/Ping.pm
index 91077ddad1c..495b82f95bb 100644
--- a/gnu/usr.bin/perl/lib/Net/Ping.pm
+++ b/gnu/usr.bin/perl/lib/Net/Ping.pm
@@ -106,7 +106,7 @@ sub new
}
elsif ($self->{"proto"} eq "icmp")
{
- croak("icmp ping requires root privilege") if $>;
+ croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS');
$self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
croak("Can't get icmp protocol by name");
$self->{"pid"} = $$ & 0xffff; # Save lower 16 bits of pid
diff --git a/gnu/usr.bin/perl/lib/Net/hostent.pm b/gnu/usr.bin/perl/lib/Net/hostent.pm
index 96b090dae5a..d586358f0a5 100644
--- a/gnu/usr.bin/perl/lib/Net/hostent.pm
+++ b/gnu/usr.bin/perl/lib/Net/hostent.pm
@@ -89,7 +89,7 @@ $h_name if you import the fields. Array references are available as
regular array variables, so for example C<@{ $host_obj-E<gt>aliases()
}> would be simply @h_aliases.
-The gethost() funtion is a simple front-end that forwards a numeric
+The gethost() function is a simple front-end that forwards a numeric
argument to gethostbyaddr() by way of Socket::inet_aton, and the rest
to gethostbyname().
diff --git a/gnu/usr.bin/perl/lib/Net/netent.pm b/gnu/usr.bin/perl/lib/Net/netent.pm
index b82447cad71..fbc6d987fe5 100644
--- a/gnu/usr.bin/perl/lib/Net/netent.pm
+++ b/gnu/usr.bin/perl/lib/Net/netent.pm
@@ -92,7 +92,7 @@ $n_name if you import the fields. Array references are available as
regular array variables, so for example C<@{ $net_obj-E<gt>aliases()
}> would be simply @n_aliases.
-The getnet() funtion is a simple front-end that forwards a numeric
+The getnet() function is a simple front-end that forwards a numeric
argument to getnetbyaddr(), and the rest
to getnetbyname().
diff --git a/gnu/usr.bin/perl/lib/Pod/Html.pm b/gnu/usr.bin/perl/lib/Pod/Html.pm
index ffeb0b21361..e71afa814bd 100644
--- a/gnu/usr.bin/perl/lib/Pod/Html.pm
+++ b/gnu/usr.bin/perl/lib/Pod/Html.pm
@@ -3,21 +3,27 @@ package Pod::Html;
use Pod::Functions;
use Getopt::Long; # package for handling command-line parameters
require Exporter;
+use vars qw($VERSION);
+$VERSION = 1.01;
@ISA = Exporter;
@EXPORT = qw(pod2html htmlify);
use Cwd;
use Carp;
+use locale; # make \w work right in non-ASCII lands
+
use strict;
+use Config;
+
=head1 NAME
-Pod::HTML - module to convert pod files to HTML
+Pod::Html - module to convert pod files to HTML
=head1 SYNOPSIS
- use Pod::HTML;
+ use Pod::Html;
pod2html([options]);
=head1 DESCRIPTION
@@ -199,6 +205,8 @@ my %pages = (); # associative array used to find the location
my %sections = (); # sections within this page
my %items = (); # associative array used to find the location
# of =item directives referenced by C<> links
+my $Is83; # is dos with short filenames (8.3)
+
sub init_globals {
$dircache = "pod2html-dircache";
$itemcache = "pod2html-itemcache";
@@ -244,7 +252,7 @@ $paragraph = ''; # which paragraph we're processing (used
# of pages referenced by L<> links.
#%items = (); # associative array used to find the location
# of =item directives referenced by C<> links
-
+$Is83=$^O eq 'dos';
}
sub pod2html {
@@ -254,6 +262,8 @@ sub pod2html {
init_globals();
+ $Is83 = 0 if (defined (&Dos::UseLFN) && Dos::UseLFN());
+
# cache of %pages and %items from last time we ran pod2html
#undef $opt_help if defined $opt_help;
@@ -292,18 +302,20 @@ sub pod2html {
open(HTML, ">$htmlfile")
|| die "$0: cannot open $htmlfile file for output: $!\n";
- # put a title in the HTML file
- $title = '';
- TITLE_SEARCH: {
- for (my $i = 0; $i < @poddata; $i++) {
- if ($poddata[$i] =~ /^=head1\s*NAME\b/m) {
- for my $para ( @poddata[$i, $i+1] ) {
- last TITLE_SEARCH if ($title) = $para =~ /(\S+\s+-+\s*.*)/s;
- }
- }
+ # put a title in the HTML file if one wasn't specified
+ if ($title eq '') {
+ TITLE_SEARCH: {
+ for (my $i = 0; $i < @poddata; $i++) {
+ if ($poddata[$i] =~ /^=head1\s*NAME\b/m) {
+ for my $para ( @poddata[$i, $i+1] ) {
+ last TITLE_SEARCH
+ if ($title) = $para =~ /(\S+\s+-+.*\S)/s;
+ }
+ }
- }
- }
+ }
+ }
+ }
if (!$title and $podfile =~ /\.pod$/) {
# probably a split pod so take first =head[12] as title
for (my $i = 0; $i < @poddata; $i++) {
@@ -312,19 +324,22 @@ sub pod2html {
warn "adopted '$title' as title for $podfile\n"
if $verbose and $title;
}
- unless ($title) {
+ if ($title) {
+ $title =~ s/\s*\(.*\)//;
+ } else {
warn "$0: no title for $podfile";
$podfile =~ /^(.*)(\.[^.\/]+)?$/;
$title = ($podfile eq "-" ? 'No Title' : $1);
warn "using $title" if $verbose;
}
print HTML <<END_OF_HEAD;
- <HTML>
- <HEAD>
- <TITLE>$title</TITLE>
- </HEAD>
+<HTML>
+<HEAD>
+<TITLE>$title</TITLE>
+<LINK REV="made" HREF="mailto:$Config{perladmin}">
+</HEAD>
- <BODY>
+<BODY>
END_OF_HEAD
@@ -364,9 +379,9 @@ END_OF_HEAD
} else {
next if @begin_stack && $begin_stack[-1] ne 'html';
- if (/^=(head[1-6])\s+(.*)/s) { # =head[1-6] heading
+ if (/^=(head[1-6])\s+(.*\S)/s) { # =head[1-6] heading
process_head($1, $2);
- } elsif (/^=item\s*(.*)/sm) { # =item text
+ } elsif (/^=item\s*(.*\S)/sm) { # =item text
process_item($1);
} elsif (/^=over\s*(.*)/) { # =over N
process_over();
@@ -387,16 +402,16 @@ END_OF_HEAD
next if @begin_stack && $begin_stack[-1] ne 'html';
my $text = $_;
process_text(\$text, 1);
- print HTML "$text\n<P>\n\n";
+ print HTML "<P>\n$text";
}
}
# finish off any pending directives
finish_list();
print HTML <<END_OF_TAIL;
- </BODY>
+</BODY>
- </HTML>
+</HTML>
END_OF_TAIL
# close the html file
@@ -766,17 +781,19 @@ sub scan_headings {
chomp($title);
$$sections{htmlify(0,$title)} = 1;
- if ($which_head > $listdepth) {
- $index .= "\n" . ("\t" x $listdepth) . "<UL>\n";
- } elsif ($which_head < $listdepth) {
- $listdepth--;
- $index .= "\n" . ("\t" x $listdepth) . "</UL>\n";
+ while ($which_head != $listdepth) {
+ if ($which_head > $listdepth) {
+ $index .= "\n" . ("\t" x $listdepth) . "<UL>\n";
+ $listdepth++;
+ } elsif ($which_head < $listdepth) {
+ $listdepth--;
+ $index .= "\n" . ("\t" x $listdepth) . "</UL>\n";
+ }
}
- $listdepth = $which_head;
$index .= "\n" . ("\t" x $listdepth) . "<LI>" .
"<A HREF=\"#" . htmlify(0,$title) . "\">" .
- process_text(\$title, 0) . "</A>";
+ html_escape(process_text(\$title, 0)) . "</A>";
}
}
@@ -817,8 +834,8 @@ sub scan_items {
if ($1 eq "*") { # bullet list
/\A=item\s+\*\s*(.*?)\s*\Z/s;
$item = $1;
- } elsif ($1 =~ /^[0-9]+/) { # numbered list
- /\A=item\s+[0-9]+\.?(.*?)\s*\Z/s;
+ } elsif ($1 =~ /^\d+/) { # numbered list
+ /\A=item\s+\d+\.?(.*?)\s*\Z/s;
$item = $1;
} else {
# /\A=item\s+(.*?)\s*\Z/s;
@@ -850,6 +867,7 @@ sub process_head {
print HTML "<H$level>"; # unless $listlevel;
#print HTML "<H$level>" unless $listlevel;
my $convert = $heading; process_text(\$convert, 0);
+ $convert = html_escape($convert);
print HTML '<A NAME="' . htmlify(0,$heading) . "\">$convert</A>";
print HTML "</H$level>"; # unless $listlevel;
print HTML "\n";
@@ -892,30 +910,36 @@ sub process_item {
print HTML "<UL>\n";
}
- print HTML "<LI><STRONG>";
- $text =~ /\A\*\s*(.*)\Z/s;
- print HTML "<A NAME=\"item_" . htmlify(1,$1) . "\">" if $1 && !$items_named{$1}++;
- $quote = 1;
- #print HTML process_puretext($1, \$quote);
- print HTML $1;
- print HTML "</A>" if $1;
- print HTML "</STRONG>";
+ print HTML '<LI>';
+ if ($text =~ /\A\*\s*(.+)\Z/s) {
+ print HTML '<STRONG>';
+ if ($items_named{$1}++) {
+ print HTML html_escape($1);
+ } else {
+ my $name = 'item_' . htmlify(1,$1);
+ print HTML qq(<A NAME="$name">), html_escape($1), '</A>';
+ }
+ print HTML '</STRONG>';
+ }
- } elsif ($text =~ /\A[0-9#]+/) { # numbered list
+ } elsif ($text =~ /\A[\d#]+/) { # numbered list
if ($need_preamble) {
push(@listend, "</OL>");
print HTML "<OL>\n";
}
- print HTML "<LI><STRONG>";
- $text =~ /\A[0-9]+\.?(.*)\Z/s;
- print HTML "<A NAME=\"item_" . htmlify(0,$1) . "\">" if $1;
- $quote = 1;
- #print HTML process_puretext($1, \$quote);
- print HTML $1 if $1;
- print HTML "</A>" if $1;
- print HTML "</STRONG>";
+ print HTML '<LI>';
+ if ($text =~ /\A\d+\.?\s*(.+)\Z/s) {
+ print HTML '<STRONG>';
+ if ($items_named{$1}++) {
+ print HTML html_escape($1);
+ } else {
+ my $name = 'item_' . htmlify(0,$1);
+ print HTML qq(<A NAME="$name">), html_escape($1), '</A>';
+ }
+ print HTML '</STRONG>';
+ }
} else { # all others
@@ -924,18 +948,17 @@ sub process_item {
print HTML "<DL>\n";
}
- print HTML "<DT><STRONG>";
- print HTML "<A NAME=\"item_" . htmlify(1,$text) . "\">"
- if $text && !$items_named{($text =~ /(\S+)/)[0]}++;
- # preceding craziness so that the duplicate leading bits in
- # perlfunc work to find just the first one. otherwise
- # open etc would have many names
- $quote = 1;
- #print HTML process_puretext($text, \$quote);
- print HTML $text;
- print HTML "</A>" if $text;
- print HTML "</STRONG>";
-
+ print HTML '<DT>';
+ if ($text =~ /(\S+)/) {
+ print HTML '<STRONG>';
+ if ($items_named{$1}++) {
+ print HTML html_escape($text);
+ } else {
+ my $name = 'item_' . htmlify(1,$text);
+ print HTML qq(<A NAME="$name">), html_escape($text), '</A>';
+ }
+ print HTML '</STRONG>';
+ }
print HTML '<DD>';
}
@@ -991,13 +1014,19 @@ sub process_pod {
#
# process_for - process a =for pod tag. if it's for html, split
-# it out verbatim, otherwise ignore it.
+# it out verbatim, if illustration, center it, otherwise ignore it.
#
sub process_for {
my($whom, $text) = @_;
if ( $whom =~ /^(pod2)?html$/i) {
print HTML $text;
- }
+ } elsif ($whom =~ /^illustration$/i) {
+ 1 while chomp $text;
+ for my $ext (qw[.png .gif .jpeg .jpg .tga .pcl .bmp]) {
+ $text .= $ext, last if -r "$text$ext";
+ }
+ print HTML qq{<p align = "center"><img src = "$text" alt = "$text illustration"></p>};
+ }
}
#
@@ -1063,6 +1092,8 @@ sub process_text {
}{
if (defined $pages{$2}) { # is a link
qq($1<A HREF="$htmlroot/$pages{$2}">$2</A>);
+ } elsif (defined $pages{dosify($2)}) { # is a link
+ qq($1<A HREF="$htmlroot/$pages{dosify($2)}">$2</A>);
} else {
"$1$2";
}
@@ -1110,7 +1141,7 @@ sub process_text {
# parse through the string, stopping each time we find a
# pod-escape. once the string has been throughly processed
# we can output it.
- while ($rest) {
+ while (length $rest) {
# check to see if there are any possible pod directives in
# the remaining part of the text.
if ($rest =~ m/[BCEIFLSZ]</) {
@@ -1266,14 +1297,17 @@ sub process_puretext {
} elsif ($word =~ m,^\w+://\w,) {
# looks like a URL
$word = qq(<A HREF="$word">$word</A>);
- } elsif ($word =~ /[\w.-]+\@\w+\.\w/) {
+ } elsif ($word =~ /[\w.-]+\@[\w-]+\.\w/) {
# looks like an e-mail address
- $word = qq(<A HREF="MAILTO:$word">$word</A>);
+ my ($w1, $w2, $w3) = ("", $word, "");
+ ($w1, $w2, $w3) = ("(", $1, ")$2") if $word =~ /^\((.*?)\)(,?)/;
+ ($w1, $w2, $w3) = ("&lt;", $1, "&gt;$2") if $word =~ /^<(.*?)>(,?)/;
+ $word = qq($w1<A HREF="mailto:$w2">$w2</A>$w3);
} elsif ($word !~ /[a-z]/ && $word =~ /[A-Z]/) { # all uppercase?
- $word = html_escape($word) if $word =~ /[&<>]/;
+ $word = html_escape($word) if $word =~ /["&<>]/;
$word = "\n<FONT SIZE=-1>$word</FONT>" if $netscape;
} else {
- $word = html_escape($word) if $word =~ /[&<>]/;
+ $word = html_escape($word) if $word =~ /["&<>]/;
}
}
@@ -1309,6 +1343,19 @@ sub pre_escape {
}
#
+# dosify - convert filenames to 8.3
+#
+sub dosify {
+ my($str) = @_;
+ if ($Is83) {
+ $str = lc $str;
+ $str =~ s/(\.\w+)/substr ($1,0,4)/ge;
+ $str =~ s/(\w+)/substr ($1,0,8)/ge;
+ }
+ return $str;
+}
+
+#
# process_L - convert a pod L<> directive to a corresponding HTML link.
# most of the links made are inferred rather than known about directly
# (i.e it's not known whether the =head\d section exists in the target file,
@@ -1320,13 +1367,13 @@ sub pre_escape {
#
sub process_L {
my($str) = @_;
- my($s1, $s2, $linktext, $page, $section, $link); # work strings
+ my($s1, $s2, $linktext, $page, $page83, $section, $link); # work strings
$str =~ s/\n/ /g; # undo word-wrapped tags
$s1 = $str;
for ($s1) {
- # a :: acts like a /
- s,::,/,;
+ # LREF: a la HREF L<show this text|man/section>
+ $linktext = $1 if s:^([^|]+)\|::;
# make sure sections start with a /
s,^",/",g;
@@ -1346,15 +1393,22 @@ sub process_L {
}
}
+ $page83=dosify($page);
+ $page=$page83 if (defined $pages{$page83});
if ($page eq "") {
$link = "#" . htmlify(0,$section);
- $linktext = $section;
+ $linktext = $section unless defined($linktext);
+ } elsif ( $page =~ /::/ ) {
+ $linktext = ($section ? "$section" : "$page");
+ $page =~ s,::,/,g;
+ $link = "$htmlroot/$page.html";
+ $link .= "#" . htmlify(0,$section) if ($section);
} elsif (!defined $pages{$page}) {
warn "$0: $podfile: cannot resolve L<$str> in paragraph $paragraph: no such page '$page'\n";
$link = "";
- $linktext = $page;
+ $linktext = $page unless defined($linktext);
} else {
- $linktext = ($section ? "$section" : "the $page manpage");
+ $linktext = ($section ? "$section" : "the $page manpage") unless defined($linktext);
$section = htmlify(0,$section) if $section ne "";
# if there is a directory by the name of the page, then assume that an
@@ -1376,7 +1430,7 @@ sub process_L {
warn "$0: $podfile: cannot resolve L$str in paragraph $paragraph: ".
"no .pod or .pm found\n";
$link = "";
- $linktext = $section;
+ $linktext = $section unless defined($linktext);
}
}
}
@@ -1417,6 +1471,7 @@ sub process_C {
$s1 =~ s/\([^()]*\)//g; # delete parentheses
$s2 = $s1;
$s1 =~ s/\W//g; # delete bogus characters
+ $str = html_escape($str);
# if there was a pod file that we found earlier with an appropriate
# =item directive, then create a link to that page.
@@ -1486,7 +1541,7 @@ sub process_X {
# after the entire pod file has been read and converted.
#
sub finish_list {
- while ($listlevel >= 0) {
+ while ($listlevel > 0) {
print HTML "</DL>\n";
$listlevel--;
}
@@ -1520,4 +1575,3 @@ BEGIN {
}
1;
-
diff --git a/gnu/usr.bin/perl/lib/Pod/Text.pm b/gnu/usr.bin/perl/lib/Pod/Text.pm
index 2b6c6b62971..549bab5a8e2 100644
--- a/gnu/usr.bin/perl/lib/Pod/Text.pm
+++ b/gnu/usr.bin/perl/lib/Pod/Text.pm
@@ -52,6 +52,8 @@ require Exporter;
use vars qw($VERSION);
$VERSION = "1.0203";
+use locale; # make \w work right in non-ASCII lands
+
$termcap=0;
$opt_alt_format = 0;
@@ -79,7 +81,7 @@ if($termcap and !$setuptermcap) {
$SCREEN = ($_[0] =~ /^-(\d+)/ && (shift, $1))
|| $ENV{COLUMNS}
|| ($ENV{TERMCAP} =~ /co#(\d+)/)[0]
- || ($^O ne 'MSWin32' && (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0])
+ || ($^O ne 'MSWin32' && $^O ne 'dos' && (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0])
|| 72;
@_ = ("<&STDIN") unless @_;
@@ -165,6 +167,10 @@ sub prepare_for_output {
s/I<(.*?)>/*$1*/sg;
# s/[CB]<(.*?)>/bold($1)/ge;
s/X<.*?>//sg;
+
+ # LREF: a la HREF L<show this text|man/section>
+ s:L<([^|>]+)\|[^>]+>:$1:g;
+
# LREF: a manpage(3f)
s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the $1$2 manpage:g;
# LREF: an =item on another manpage
@@ -269,14 +275,14 @@ sub prepare_for_output {
my $paratag = $_;
$_ = <IN>;
if (/^=/) { # tricked!
- local($indent) = $indent[$#index - 1] || $DEF_INDENT;
+ local($indent) = $indent[$#indent - 1] || $DEF_INDENT;
output($paratag);
redo POD_DIRECTIVE;
}
&prepare_for_output;
IP_output($paratag, $_);
} else {
- local($indent) = $indent[$#index - 1] || $DEF_INDENT;
+ local($indent) = $indent[$#indent - 1] || $DEF_INDENT;
output($_, 0);
}
}
@@ -364,7 +370,7 @@ sub fill {
sub IP_output {
local($tag, $_) = @_;
- local($tag_indent) = $indent[$#index - 1] || $DEF_INDENT;
+ local($tag_indent) = $indent[$#indent - 1] || $DEF_INDENT;
$tag_cols = $SCREEN - $tag_indent;
$cols = $SCREEN - $indent;
$tag =~ s/\s*$//;
diff --git a/gnu/usr.bin/perl/lib/SelfLoader.pm b/gnu/usr.bin/perl/lib/SelfLoader.pm
index f93841c862a..311d953721f 100644
--- a/gnu/usr.bin/perl/lib/SelfLoader.pm
+++ b/gnu/usr.bin/perl/lib/SelfLoader.pm
@@ -3,7 +3,8 @@ use Carp;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(AUTOLOAD);
-$VERSION = 1.07; sub Version {$VERSION}
+$VERSION = "1.08";
+sub Version {$VERSION}
$DEBUG = 0;
my %Cache; # private cache for all SelfLoader's client packages
@@ -45,6 +46,7 @@ sub _load_stubs {
unless fileno($fh);
$Cache{"${currpack}::<DATA"} = 1; # indicate package is cached
+ local($/) = "\n";
while(defined($line = <$fh>) and $line !~ m/^__END__/) {
if ($line =~ m/^sub\s+([\w:]+)\s*(\([\\\$\@\%\&\*\;]*\))?/) {
push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
@@ -131,7 +133,7 @@ is available for reading via the filehandle FOOBAR::DATA,
where FOOBAR is the name of the current package when the C<__DATA__>
token is reached. This works just the same as C<__END__> does in
package 'main', but for other modules data after C<__END__> is not
-automatically retreivable , whereas data after C<__DATA__> is.
+automatically retrievable, whereas data after C<__DATA__> is.
The C<__DATA__> token is not recognized in versions of perl prior to
5.001m.
@@ -201,7 +203,7 @@ There is no need to inherit from the B<SelfLoader>.
The B<SelfLoader> works similarly to the AutoLoader, but picks up the
subs from after the C<__DATA__> instead of in the 'lib/auto' directory.
-There is a maintainance gain in not needing to run AutoSplit on the module
+There is a maintenance gain in not needing to run AutoSplit on the module
at installation, and a runtime gain in not needing to keep opening and
closing files to load subs. There is a runtime loss in needing
to parse the code after the C<__DATA__>. Details of the B<AutoLoader> and
diff --git a/gnu/usr.bin/perl/lib/Symbol.pm b/gnu/usr.bin/perl/lib/Symbol.pm
index 6807e74479a..a842c1cd7be 100644
--- a/gnu/usr.bin/perl/lib/Symbol.pm
+++ b/gnu/usr.bin/perl/lib/Symbol.pm
@@ -27,6 +27,11 @@ Symbol - manipulate Perl symbols and their names
print { qualify_to_ref $fh } "foo!\n";
$ref = qualify_to_ref $name, $pkg;
+ use Symbol qw(delete_package);
+ delete_package('Foo::Bar');
+ print "deleted\n" unless exists $Foo::{'Bar::'};
+
+
=head1 DESCRIPTION
C<Symbol::gensym> creates an anonymous glob and returns a reference
@@ -41,7 +46,7 @@ C<Symbol::qualify> turns unqualified symbol names into qualified
variable names (e.g. "myvar" -E<gt> "MyPackage::myvar"). If it is given a
second parameter, C<qualify> uses it as the default package;
otherwise, it uses the package of its caller. Regardless, global
-variable names (e.g. "STDOUT", "ENV", "SIG") are always qualfied with
+variable names (e.g. "STDOUT", "ENV", "SIG") are always qualified with
"main::".
Qualification applies only to symbol names (strings). References are
@@ -52,6 +57,10 @@ C<Symbol::qualify_to_ref> is just like C<Symbol::qualify> except that it
returns a glob ref rather than a symbol name, so you can use the result
even if C<use strict 'refs'> is in effect.
+C<Symbol::delete_package> wipes out a whole package namespace. Note
+this routine is not exported by default--you may want to import it
+explicitly.
+
=cut
BEGIN { require 5.002; }
@@ -59,6 +68,7 @@ BEGIN { require 5.002; }
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(gensym ungensym qualify qualify_to_ref);
+@EXPORT_OK = qw(delete_package);
$VERSION = 1.02;
@@ -101,4 +111,29 @@ sub qualify_to_ref ($;$) {
return \*{ qualify $_[0], @_ > 1 ? $_[1] : caller };
}
+#
+# of Safe.pm lineage
+#
+sub delete_package ($) {
+ my $pkg = shift;
+
+ # expand to full symbol table name if needed
+
+ unless ($pkg =~ /^main::.*::$/) {
+ $pkg = "main$pkg" if $pkg =~ /^::/;
+ $pkg = "main::$pkg" unless $pkg =~ /^main::/;
+ $pkg .= '::' unless $pkg =~ /::$/;
+ }
+
+ my($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
+ my $stem_symtab = *{$stem}{HASH};
+ return unless defined $stem_symtab and exists $stem_symtab->{$leaf};
+
+ my $leaf_glob = $stem_symtab->{$leaf};
+ my $leaf_symtab = *{$leaf_glob}{HASH};
+
+ %$leaf_symtab = ();
+ delete $stem_symtab->{$leaf};
+}
+
1;
diff --git a/gnu/usr.bin/perl/lib/Sys/Syslog.pm b/gnu/usr.bin/perl/lib/Sys/Syslog.pm
index 709f5785f5d..e8faac71262 100644
--- a/gnu/usr.bin/perl/lib/Sys/Syslog.pm
+++ b/gnu/usr.bin/perl/lib/Sys/Syslog.pm
@@ -5,6 +5,7 @@ use Carp;
@ISA = qw(Exporter);
@EXPORT = qw(openlog closelog setlogmask syslog);
+@EXPORT_OK = qw(setlogsock);
use Socket;
use Sys::Hostname;
@@ -14,6 +15,10 @@ use Sys::Hostname;
# Tom Christiansen <tchrist@convex.com>
# modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
# NOTE: openlog now takes three arguments, just like openlog(3)
+# Modified to add UNIX domain sockets by Sean Robinson <robinson_s@sc.maricopa.edu>
+# with support from Tim Bunce <Tim.Bunce@ig.co.uk> and the perl5-porters mailing list
+
+# Todo: enable connect to try all three types before failing (auto setlogsock)?
=head1 NAME
@@ -21,8 +26,10 @@ Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl interface to the UNIX
=head1 SYNOPSIS
- use Sys::Syslog;
+ use Sys::Syslog; # all except setlogsock, or:
+ use Sys::Syslog qw(:DEFAULT setlogsock); # default set, plus setlogsock
+ setlogsock $sock_type;
openlog $ident, $logopt, $facility;
syslog $priority, $format, @args;
$oldmask = setlogmask $mask_priority;
@@ -41,7 +48,7 @@ Syslog provides the functions:
=item openlog $ident, $logopt, $facility
I<$ident> is prepended to every message.
-I<$logopt> contains one or more of the words I<pid>, I<ndelay>, I<cons>, I<nowait>.
+I<$logopt> contains zero or more of the words I<pid>, I<ndelay>, I<cons>, I<nowait>.
I<$facility> specifies the part of the system
=item syslog $priority, $format, @args
@@ -54,20 +61,18 @@ is replaced with C<"$!"> (the latest error message).
Sets log mask I<$mask_priority> and returns the old mask.
-=item setlogsock $sock_type (added in 5.004_03)
-
+=item setlogsock $sock_type (added in 5.004_02)
+
Sets the socket type to be used for the next call to
-C<openlog()> or C<syslog()>.
-
+C<openlog()> or C<syslog()> 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<syslog.ph>. If F<syslog.ph> fails to define
-C<_PATH_LOG>, C<setlogsock> returns C<undef>; otherwise a true value is
-returned. A value of 'inet' will connect to an INET socket returned by
-getservbyname(). Any other value croaks.
+C<_PATH_LOG> in F<syslog.ph>. A value of 'inet' will connect to an
+INET socket returned by getservbyname(). Any other value croaks.
The default is for the INET socket to be used.
-
=item closelog
Closes the log file.
@@ -135,14 +140,19 @@ sub setlogmask {
sub setlogsock {
local($setsock) = shift;
+ &disconnect if $connected;
if (lc($setsock) eq 'unix') {
- if (defined &_PATH_LOG) {
- $sock_unix = 1;
- } else {
- return undef;
- }
+ if (defined &_PATH_LOG) {
+ $sock_type = 1;
+ } else {
+ return undef;
+ }
} elsif (lc($setsock) eq 'inet') {
- undef($sock_unix);
+ if (getservbyname('syslog','udp')) {
+ undef($sock_type);
+ } else {
+ return undef;
+ }
} else {
croak "Invalid argument passed to setlogsock; must be 'unix' or 'inet'";
}
@@ -238,7 +248,7 @@ sub connect {
my($host_uniq) = Sys::Hostname::hostname();
($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _)
}
- unless ( $sock_unix ) {
+ unless ( $sock_type ) {
my $udp = getprotobyname('udp');
my $syslog = getservbyname('syslog','udp');
my $this = sockaddr_in($syslog, INADDR_ANY);
@@ -248,8 +258,11 @@ sub connect {
} else {
my $syslog = &_PATH_LOG || croak "_PATH_LOG not found in syslog.ph";
my $that = sockaddr_un($syslog) || croak "Can't locate $syslog";
- socket(SYSLOG,AF_UNIX,SOCK_STREAM,0) || croak "open: $!";
- connect(SYSLOG,$that) || croak "connect: $!";
+ socket(SYSLOG,AF_UNIX,SOCK_STREAM,0) || croak "socket: $!";
+ if (!connect(SYSLOG,$that)) {
+ socket(SYSLOG,AF_UNIX,SOCK_DGRAM,0) || croak "socket: $!";
+ connect(SYSLOG,$that) || croak "connect: $! (SOCK_DGRAM after trying SOCK_STREAM)";
+ }
}
local($old) = select(SYSLOG); $| = 1; select($old);
$connected = 1;
diff --git a/gnu/usr.bin/perl/lib/Term/Cap.pm b/gnu/usr.bin/perl/lib/Term/Cap.pm
index 5703405c9d2..1e95ec33b69 100644
--- a/gnu/usr.bin/perl/lib/Term/Cap.pm
+++ b/gnu/usr.bin/perl/lib/Term/Cap.pm
@@ -106,7 +106,7 @@ sub termcap_path { ## private
# $TERMCAP, if it's a filespec
push(@termcap_path, $ENV{TERMCAP})
if ((exists $ENV{TERMCAP}) &&
- (($^O eq 'os2' || $^O eq 'MSWin32')
+ (($^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos')
? $ENV{TERMCAP} =~ /^[a-z]:[\\\/]/i
: $ENV{TERMCAP} =~ /^\//));
if ((exists $ENV{TERMPATH}) && ($ENV{TERMPATH})) {
diff --git a/gnu/usr.bin/perl/lib/Term/Complete.pm b/gnu/usr.bin/perl/lib/Term/Complete.pm
index 275aadeb651..445dfca02a2 100644
--- a/gnu/usr.bin/perl/lib/Term/Complete.pm
+++ b/gnu/usr.bin/perl/lib/Term/Complete.pm
@@ -5,7 +5,7 @@ require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(Complete);
-# @(#)complete.pl,v1.1 (me@anywhere.EBay.Sun.COM) 09/23/91
+# @(#)complete.pl,v1.2 (me@anywhere.EBay.Sun.COM) 09/23/91
=head1 NAME
@@ -13,8 +13,8 @@ Term::Complete - Perl word completion module
=head1 SYNOPSIS
- $input = complete('prompt_string', \@completion_list);
- $input = complete('prompt_string', @completion_list);
+ $input = Complete('prompt_string', \@completion_list);
+ $input = Complete('prompt_string', @completion_list);
=head1 DESCRIPTION
@@ -56,7 +56,7 @@ Bell sounds when word completion fails.
=head1 BUGS
-The completion charater E<lt>tabE<gt> cannot be changed.
+The completion character E<lt>tabE<gt> cannot be changed.
=head1 AUTHOR
@@ -72,7 +72,11 @@ CONFIG: {
}
sub Complete {
- my($prompt, @cmp_list, $return, @match, $l, $test, $cmp, $r);
+ my($prompt, @cmp_list, $cmp, $test, $l, @match);
+ my ($return, $r) = ("", 0);
+
+ $return = "";
+ $r = 0;
$prompt = shift;
if (ref $_[0] || $_[0] =~ /^\*/) {
@@ -90,17 +94,17 @@ sub Complete {
# (TAB) attempt completion
$_ eq "\t" && do {
@match = grep(/^$return/, @cmp_lst);
- $l = length($test = shift(@match));
unless ($#match < 0) {
+ $l = length($test = shift(@match));
foreach $cmp (@match) {
until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
$l--;
}
}
print("\a");
+ print($test = substr($test, $r, $l - $r));
+ $r = length($return .= $test);
}
- print($test = substr($test, $r, $l - $r));
- $r = length($return .= $test);
last CASE;
};
@@ -113,8 +117,8 @@ sub Complete {
# (^U) kill
$_ eq $kill && do {
if ($r) {
- undef $r;
- undef $return;
+ $r = 0;
+ $return = "";
print("\r\n");
redo LOOP;
}
diff --git a/gnu/usr.bin/perl/lib/Term/ReadLine.pm b/gnu/usr.bin/perl/lib/Term/ReadLine.pm
index b6923dd1e7c..e7cf00cb8d1 100644
--- a/gnu/usr.bin/perl/lib/Term/ReadLine.pm
+++ b/gnu/usr.bin/perl/lib/Term/ReadLine.pm
@@ -139,12 +139,23 @@ None
=head1 ENVIRONMENT
-The variable C<PERL_RL> governs which ReadLine clone is loaded. If the
-value is false, a dummy interface is used. If the value is true, it
-should be tail of the name of the package to use, such as C<Perl> or
-C<Gnu>.
+The environment variable C<PERL_RL> governs which ReadLine clone is
+loaded. If the value is false, a dummy interface is used. If the value
+is true, it should be tail of the name of the package to use, such as
+C<Perl> or C<Gnu>.
-If the variable is not set, the best available package is loaded.
+As a special case, if the value of this variable is space-separated,
+the tail might be used to disable the ornaments by setting the tail to
+be C<o=0> or C<ornaments=0>. The head should be as described above, say
+
+If the variable is not set, or if the head of space-separated list is
+empty, the best available package is loaded.
+
+ export "PERL_RL=Perl o=0" # Use Perl ReadLine without ornaments
+ export "PERL_RL= o=0" # Use best available ReadLine without ornaments
+
+(Note that processing of C<PERL_RL> for ornaments is in the discretion of the
+particular used C<Term::ReadLine::*> package).
=cut
@@ -182,7 +193,7 @@ sub findConsole {
$console = "sys\$command";
}
- if ($^O eq 'amigaos') {
+ if (($^O eq 'amigaos') || ($^O eq 'beos')) {
$console = undef;
}
elsif ($^O eq 'os2') {
@@ -205,7 +216,7 @@ sub new {
die "method new called with wrong number of arguments"
unless @_==2 or @_==4;
#local (*FIN, *FOUT);
- my ($FIN, $FOUT);
+ my ($FIN, $FOUT, $ret);
if (@_==2) {
($console, $consoleOUT) = findConsole;
@@ -215,15 +226,21 @@ sub new {
$sel = select(FOUT);
$| = 1; # for DB::OUT
select($sel);
- bless [\*FIN, \*FOUT];
+ $ret = bless [\*FIN, \*FOUT];
} else { # Filehandles supplied
$FIN = $_[2]; $FOUT = $_[3];
#OUT->autoflush(1); # Conflicts with debugger?
$sel = select($FOUT);
$| = 1; # for DB::OUT
select($sel);
- bless [$FIN, $FOUT];
+ $ret = bless [$FIN, $FOUT];
}
+ if ($ret->Features->{ornaments}
+ and not ($ENV{PERL_RL} and $ENV{PERL_RL} =~ /\bo\w*=0/)) {
+ local $Term::ReadLine::termcap_nowarn = 1;
+ $ret->ornaments(1);
+ }
+ return $ret;
}
sub newTTY {
@@ -245,7 +262,7 @@ sub Features { \%features }
package Term::ReadLine; # So late to allow the above code be defined?
-my $which = $ENV{PERL_RL};
+my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef;
if ($which) {
if ($which =~ /\bgnu\b/i){
eval "use Term::ReadLine::Gnu;";
@@ -254,7 +271,7 @@ if ($which) {
} else {
eval "use Term::ReadLine::$which;";
}
-} elsif (defined $which) { # Defined but false
+} elsif (defined $which and $which ne '') { # Defined but false
# Do nothing fancy
} else {
eval "use Term::ReadLine::Gnu; 1" or eval "use Term::ReadLine::Perl; 1";
@@ -293,10 +310,14 @@ sub ornaments {
return $rl_term_set unless @_;
$rl_term_set = shift;
$rl_term_set ||= ',,,';
- $rl_term_set = 'us,ue,md,me' if $rl_term_set == 1;
+ $rl_term_set = 'us,ue,md,me' if $rl_term_set eq '1';
my @ts = split /,/, $rl_term_set, 4;
eval { LoadTermCap };
- warn("Cannot find termcap: $@\n"), return unless defined $terminal;
+ unless (defined $terminal) {
+ warn("Cannot find termcap: $@\n") unless $Term::ReadLine::termcap_nowarn;
+ $rl_term_set = ',,,';
+ return;
+ }
@rl_term_set = map {$_ ? $terminal->Tputs($_,1) || '' : ''} @ts;
return $rl_term_set;
}
@@ -336,6 +357,7 @@ sub get_line {
my $self = shift;
$self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
my $in = $self->IN;
+ local ($/) = "\n";
return scalar <$in>;
}
diff --git a/gnu/usr.bin/perl/lib/Test/Harness.pm b/gnu/usr.bin/perl/lib/Test/Harness.pm
index f5fc3d8cc55..935e8f07d22 100644
--- a/gnu/usr.bin/perl/lib/Test/Harness.pm
+++ b/gnu/usr.bin/perl/lib/Test/Harness.pm
@@ -11,7 +11,15 @@ use vars qw($VERSION $verbose $switches $have_devel_corestack $curtest
@ISA @EXPORT @EXPORT_OK);
$have_devel_corestack = 0;
-$VERSION = "1.1502";
+$VERSION = "1.1602";
+
+# Some experimental versions of OS/2 build have broken $?
+my $ignore_exitcode = $ENV{HARNESS_IGNORE_EXITCODE};
+
+my $files_in_dir = $ENV{HARNESS_FILELEAK_IN_DIR};
+
+my $tests_skipped = 0;
+my $subtests_skipped = 0;
@ISA=('Exporter');
@EXPORT= qw(&runtests);
@@ -40,10 +48,12 @@ format STDOUT =
$verbose = 0;
$switches = "-w";
+sub globdir { opendir DIRH, shift; my @f = readdir DIRH; closedir DIRH; @f }
+
sub runtests {
my(@tests) = @_;
local($|) = 1;
- my($test,$te,$ok,$next,$max,$pct,$totok,@failed,%failedtests);
+ my($test,$te,$ok,$next,$max,$pct,$totok,$totbonus,@failed,%failedtests);
my $totmax = 0;
my $files = 0;
my $bad = 0;
@@ -56,6 +66,7 @@ sub runtests {
if ($^O eq 'VMS') { $switches =~ s/-(\S*[A-Z]\S*)/"-$1"/g }
+ my @dir_files = globdir $files_in_dir if defined $files_in_dir;
my $t_start = new Benchmark;
while ($test = shift(@tests)) {
$te = $test;
@@ -68,16 +79,27 @@ sub runtests {
my $s = $switches;
$s .= q[ "-T"] if $first =~ /^#!.*\bperl.*-\w*T/;
$fh->close or print "can't close $test. $!\n";
- my $cmd = "$^X $s $test|";
+ my $cmd = ($ENV{'COMPILE_TEST'})?
+"./perl -I../lib ../utils/perlcc $test -run -verbose dcf -log ./compilelog |"
+ : "$^X $s $test|";
$cmd = "MCR $cmd" if $^O eq 'VMS';
$fh->open($cmd) or print "can't run $test. $!\n";
$ok = $next = $max = 0;
@failed = ();
+ my %todo = ();
+ my $bonus = 0;
+ my $skipped = 0;
while (<$fh>) {
if( $verbose ){
print $_;
}
- if (/^1\.\.([0-9]+)/) {
+ if (/^1\.\.([0-9]+) todo([\d\s]+)\;/) {
+ $max = $1;
+ for (split(/\s+/, $2)) { $todo{$_} = 1; }
+ $totmax += $max;
+ $files++;
+ $next = 1;
+ } elsif (/^1\.\.([0-9]+)/) {
$max = $1;
$totmax += $max;
$files++;
@@ -86,11 +108,18 @@ sub runtests {
my $this = $next;
if (/^not ok\s*(\d*)/){
$this = $1 if $1 > 0;
- push @failed, $this;
- } elsif (/^ok\s*(\d*)/) {
+ if (!$todo{$this}) {
+ push @failed, $this;
+ } else {
+ $ok++;
+ $totok++;
+ }
+ } elsif (/^ok\s*(\d*)(\s*\#\s*[Ss]kip)?/) {
$this = $1 if $1 > 0;
$ok++;
$totok++;
+ $skipped++ if defined $2;
+ $bonus++, $totbonus++ if $todo{$this};
}
if ($this > $next) {
# warn "Test output counter mismatch [test $this]\n";
@@ -105,7 +134,7 @@ sub runtests {
}
}
$fh->close; # must close to reap child resource values
- my $wstatus = $?;
+ my $wstatus = $ignore_exitcode ? 0 : $?; # Can trust $? ?
my $estatus;
$estatus = ($^O eq 'VMS'
? eval 'use vmsish "status"; $estatus = $?'
@@ -131,7 +160,7 @@ sub runtests {
} else {
push @failed, $next..$max;
$failed = @failed;
- (my $txt, $canon) = canonfailed($max,@failed);
+ (my $txt, $canon) = canonfailed($max,$skipped,@failed);
$percent = 100*(scalar @failed)/$max;
print "DIED. ",$txt;
}
@@ -142,10 +171,19 @@ sub runtests {
estat => $estatus, wstat => $wstatus,
};
} elsif ($ok == $max && $next == $max+1) {
- if ($max) {
+ if ($max and $skipped + $bonus) {
+ my @msg;
+ push(@msg, "$skipped/$max subtest".($skipped>1?'s':'')." skipped")
+ if $skipped;
+ push(@msg, "$bonus subtest".($bonus>1?'s':'').
+ " unexpectedly succeeded")
+ if $bonus;
+ print "ok, ".join(', ', @msg)."\n";
+ } elsif ($max) {
print "ok\n";
} else {
print "skipping test on this platform\n";
+ $tests_skipped++;
}
$good++;
} elsif ($max) {
@@ -153,7 +191,7 @@ sub runtests {
push @failed, $next..$max;
}
if (@failed) {
- my ($txt, $canon) = canonfailed($max,@failed);
+ my ($txt, $canon) = canonfailed($max,$skipped,@failed);
print $txt;
$failedtests{$test} = { canon => $canon, max => $max,
failed => scalar @failed,
@@ -178,6 +216,18 @@ sub runtests {
estat => '', wstat => '',
};
}
+ $subtests_skipped += $skipped;
+ if (defined $files_in_dir) {
+ my @new_dir_files = globdir $files_in_dir;
+ if (@new_dir_files != @dir_files) {
+ my %f;
+ @f{@new_dir_files} = (1) x @new_dir_files;
+ delete @f{@dir_files};
+ my @f = sort keys %f;
+ print "LEAKED FILES: @f\n";
+ @dir_files = @new_dir_files;
+ }
+ }
}
my $t_total = timediff(new Benchmark, $t_start);
@@ -188,8 +238,22 @@ sub runtests {
delete $ENV{PERL5LIB};
}
}
+ my $bonusmsg = '';
+ $bonusmsg = (" ($totbonus subtest".($totbonus>1?'s':'').
+ " UNEXPECTEDLY SUCCEEDED)")
+ if $totbonus;
+ if ($tests_skipped) {
+ $bonusmsg .= ", $tests_skipped test" . ($tests_skipped != 1 ? 's' : '') .
+ ' skipped';
+ }
+ if ($subtests_skipped) {
+ $bonusmsg .= ($tests_skipped ? ', plus ' : ', ').
+ "$subtests_skipped subtest"
+ . ($subtests_skipped != 1 ? 's' : '') .
+ " skipped";
+ }
if ($bad == 0 && $totmax) {
- print "All tests successful.\n";
+ print "All tests successful$bonusmsg.\n";
} elsif ($total==0){
die "FAILED--no tests were run for some reason.\n";
} elsif ($totmax==0) {
@@ -205,6 +269,8 @@ sub runtests {
write;
}
if ($bad) {
+ $bonusmsg =~ s/^,\s*//;
+ print "$bonusmsg.\n" if $bonusmsg;
die "Failed $bad/$total test scripts, $pct% okay.$subpct\n";
}
}
@@ -234,7 +300,7 @@ sub corestatus {
}
sub canonfailed ($@) {
- my($max,@failed) = @_;
+ my($max,$skipped,@failed) = @_;
my %seen;
@failed = sort {$a <=> $b} grep !$seen{$_}++, @failed;
my $failed = @failed;
@@ -264,7 +330,12 @@ sub canonfailed ($@) {
}
push @result, "\tFailed $failed/$max tests, ";
- push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay\n";
+ push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay";
+ my $ender = 's' x ($skipped > 1);
+ my $good = $max - $failed - $skipped;
+ my $goodper = sprintf("%.2f",100*($good/$max));
+ push @result, " (-$skipped skipped test$ender: $good okay, $goodper%)" if $skipped;
+ push @result, "\n";
my $txt = join "", @result;
($txt, $canon);
}
@@ -284,6 +355,10 @@ runtests(@tests);
=head1 DESCRIPTION
+(By using the L<Test> module, you can write test scripts without
+knowing the exact output this module expects. However, if you need to
+know the specifics, read on!)
+
Perl test scripts print to standard output C<"ok N"> for each single
test, where C<N> is an increasing sequence of integers. The first line
output by a standard test script is C<"1..M"> with C<M> being the
@@ -328,6 +403,11 @@ The global variable $Test::Harness::switches is exportable and can be
used to set perl command line options used for running the test
script(s). The default value is C<-w>.
+If the standard output line contains substring C< # Skip> (with
+variations in spacing and case) after C<ok> or C<ok NUMBER>, it is
+counted as a skipped test. If the whole testscript succeeds, the
+count of skipped tests is included in the generated output.
+
=head1 EXPORT
C<&runtests> is exported by Test::Harness per default.
@@ -360,9 +440,25 @@ above messages.
=back
+=head1 ENVIRONMENT
+
+Setting C<HARNESS_IGNORE_EXITCODE> makes harness ignore the exit status
+of child processes.
+
+If C<HARNESS_FILELEAK_IN_DIR> is set to the name of a directory, harness
+will check after each test whether new files appeared in that directory,
+and report them as
+
+ LEAKED FILES: scr.tmp 0 my.db
+
+If relative, directory name is with respect to the current directory at
+the moment runtests() was called. Putting absolute path into
+C<HARNESS_FILELEAK_IN_DIR> may give more predicatable results.
+
=head1 SEE ALSO
-See L<Benchmark> for the underlying timing routines.
+L<Test> for writing test scripts and also L<Benchmark> for the
+underlying timing routines.
=head1 AUTHORS
diff --git a/gnu/usr.bin/perl/lib/Text/ParseWords.pm b/gnu/usr.bin/perl/lib/Text/ParseWords.pm
index 62da1d273fe..065c2f72551 100644
--- a/gnu/usr.bin/perl/lib/Text/ParseWords.pm
+++ b/gnu/usr.bin/perl/lib/Text/ParseWords.pm
@@ -1,140 +1,102 @@
package Text::ParseWords;
-require 5.000;
-use Carp;
+use vars qw($VERSION @ISA @EXPORT $PERL_SINGLE_QUOTE);
+$VERSION = "3.1";
-require AutoLoader;
-*AUTOLOAD = \&AutoLoader::AUTOLOAD;
+require 5.000;
-require Exporter;
+use Exporter;
@ISA = qw(Exporter);
-@EXPORT = qw(shellwords quotewords);
+@EXPORT = qw(shellwords quotewords nested_quotewords parse_line);
@EXPORT_OK = qw(old_shellwords);
-=head1 NAME
-
-Text::ParseWords - parse text into an array of tokens
-
-=head1 SYNOPSIS
-
- use Text::ParseWords;
- @words = &quotewords($delim, $keep, @lines);
- @words = &shellwords(@lines);
- @words = &old_shellwords(@lines);
-
-=head1 DESCRIPTION
-&quotewords() accepts a delimiter (which can be a regular expression)
-and a list of lines and then breaks those lines up into a list of
-words ignoring delimiters that appear inside quotes.
-
-The $keep argument is a boolean flag. If true, the quotes are kept
-with each word, otherwise quotes are stripped in the splitting process.
-$keep also defines whether unprotected backslashes are retained.
-
-A &shellwords() replacement is included to demonstrate the new package.
-This version differs from the original in that it will _NOT_ default
-to using $_ if no arguments are given. I personally find the old behavior
-to be a mis-feature.
-
-&quotewords() works by simply jamming all of @lines into a single
-string in $_ and then pulling off words a bit at a time until $_
-is exhausted.
+sub shellwords {
+ local(@lines) = @_;
+ $lines[$#lines] =~ s/\s+$//;
+ return(quotewords('\s+', 0, @lines));
+}
-=head1 AUTHORS
-Hal Pomeranz (pomeranz@netcom.com), 23 March 1994
-Basically an update and generalization of the old shellwords.pl.
-Much code shamelessly stolen from the old version (author unknown).
+sub quotewords {
+ my($delim, $keep, @lines) = @_;
+ my($line, @words, @allwords);
+
+
+ foreach $line (@lines) {
+ @words = parse_line($delim, $keep, $line);
+ return() unless (@words || !length($line));
+ push(@allwords, @words);
+ }
+ return(@allwords);
+}
-=cut
-1;
-__END__
-sub shellwords {
- local(@lines) = @_;
- $lines[$#lines] =~ s/\s+$//;
- &quotewords('\s+', 0, @lines);
+sub nested_quotewords {
+ my($delim, $keep, @lines) = @_;
+ my($i, @allwords);
+
+ for ($i = 0; $i < @lines; $i++) {
+ @{$allwords[$i]} = parse_line($delim, $keep, $lines[$i]);
+ return() unless (@{$allwords[$i]} || !length($lines[$i]));
+ }
+ return(@allwords);
}
-sub quotewords {
+sub parse_line {
+ # We will be testing undef strings
+ local($^W) = 0;
-# The inner "for" loop builds up each word (or $field) one $snippet
-# at a time. A $snippet is a quoted string, a backslashed character,
-# or an unquoted string. We fall out of the "for" loop when we reach
-# the end of $_ or when we hit a delimiter. Falling out of the "for"
-# loop, we push the $field we've been building up onto the list of
-# @words we'll be returning, and then loop back and pull another word
-# off of $_.
-#
-# The first two cases inside the "for" loop deal with quoted strings.
-# The first case matches a double quoted string, removes it from $_,
-# and assigns the double quoted string to $snippet in the body of the
-# conditional. The second case handles single quoted strings. In
-# the third case we've found a quote at the current beginning of $_,
-# but it didn't match the quoted string regexps in the first two cases,
-# so it must be an unbalanced quote and we croak with an error (which can
-# be caught by eval()).
-#
-# The next case handles backslashed characters, and the next case is the
-# exit case on reaching the end of the string or finding a delimiter.
-#
-# Otherwise, we've found an unquoted thing and we pull of characters one
-# at a time until we reach something that could start another $snippet--
-# a quote of some sort, a backslash, or the delimiter. This one character
-# at a time behavior was necessary if the delimiter was going to be a
-# regexp (love to hear it if you can figure out a better way).
-
- my ($delim, $keep, @lines) = @_;
- my (@words, $snippet, $field);
-
- local $_ = join ('', @lines);
-
- while (length) {
- $field = '';
+ my($delimiter, $keep, $line) = @_;
+ my($quote, $quoted, $unquoted, $delim, $word, @pieces);
- for (;;) {
- $snippet = '';
+ while (length($line)) {
- if (s/^"([^"\\]*(\\.[^"\\]*)*)"//) {
- $snippet = $1;
- $snippet = qq|"$snippet"| if $keep;
- }
- elsif (s/^'([^'\\]*(\\.[^'\\]*)*)'//) {
- $snippet = $1;
- $snippet = "'$snippet'" if $keep;
- }
- elsif (/^["']/) {
- croak 'Unmatched quote';
- }
- elsif (s/^\\(.)//) {
- $snippet = $1;
- $snippet = "\\$snippet" if $keep;
- }
- elsif (!length || s/^$delim//) {
- last;
- }
- else {
- while (length && !(/^$delim/ || /^['"\\]/)) {
- $snippet .= substr ($_, 0, 1);
- substr($_, 0, 1) = '';
- }
- }
+ ($quote, $quoted, undef, $unquoted, $delim, undef) =
+ $line =~ m/^(["']) # a $quote
+ ((?:\\.|(?!\1)[^\\])*) # and $quoted text
+ \1 # followed by the same quote
+ ([\000-\377]*) # and the rest
+ | # --OR--
+ ^((?:\\.|[^\\"'])*?) # an $unquoted text
+ (\Z(?!\n)|(?-x:$delimiter)|(?!^)(?=["']))
+ # plus EOL, delimiter, or quote
+ ([\000-\377]*) # the rest
+ /x; # extended layout
+ return() unless( $quote || length($unquoted) || length($delim));
- $field .= $snippet;
- }
+ $line = $+;
- push @words, $field;
+ if ($keep) {
+ $quoted = "$quote$quoted$quote";
+ }
+ else {
+ $unquoted =~ s/\\(.)/$1/g;
+ if (defined $quote) {
+ $quoted =~ s/\\(.)/$1/g if ($quote eq '"');
+ $quoted =~ s/\\([\\'])/$1/g if ( $PERL_SINGLE_QUOTE && $quote eq "'");
+ }
+ }
+ $word .= defined $quote ? $quoted : $unquoted;
+
+ if (length($delim)) {
+ push(@pieces, $word);
+ push(@pieces, $delim) if ($keep eq 'delimiters');
+ undef $word;
+ }
+ if (!length($line)) {
+ push(@pieces, $word);
+ }
}
-
- return @words;
+ return(@pieces);
}
+
sub old_shellwords {
# Usage:
@@ -154,13 +116,13 @@ sub old_shellwords {
($snippet = $1) =~ s#\\(.)#$1#g;
}
elsif (/^"/) {
- croak "Unmatched double quote: $_";
+ return();
}
elsif (s/^'(([^'\\]|\\.)*)'//) {
($snippet = $1) =~ s#\\(.)#$1#g;
}
elsif (/^'/) {
- croak "Unmatched single quote: $_";
+ return();
}
elsif (s/^\\(.)//) {
$snippet = $1;
@@ -178,3 +140,117 @@ sub old_shellwords {
}
@words;
}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Text::ParseWords - parse text into an array of tokens or array of arrays
+
+=head1 SYNOPSIS
+
+ use Text::ParseWords;
+ @lists = &nested_quotewords($delim, $keep, @lines);
+ @words = &quotewords($delim, $keep, @lines);
+ @words = &shellwords(@lines);
+ @words = &parse_line($delim, $keep, $line);
+ @words = &old_shellwords(@lines); # DEPRECATED!
+
+=head1 DESCRIPTION
+
+The &nested_quotewords() and &quotewords() functions accept a delimiter
+(which can be a regular expression)
+and a list of lines and then breaks those lines up into a list of
+words ignoring delimiters that appear inside quotes. &quotewords()
+returns all of the tokens in a single long list, while &nested_quotewords()
+returns a list of token lists corresponding to the elements of @lines.
+&parse_line() does tokenizing on a single string. The &*quotewords()
+functions simply call &parse_lines(), so if you're only splitting
+one line you can call &parse_lines() directly and save a function
+call.
+
+The $keep argument is a boolean flag. If true, then the tokens are
+split on the specified delimiter, but all other characters (quotes,
+backslashes, etc.) are kept in the tokens. If $keep is false then the
+&*quotewords() functions remove all quotes and backslashes that are
+not themselves backslash-escaped or inside of single quotes (i.e.,
+&quotewords() tries to interpret these characters just like the Bourne
+shell). NB: these semantics are significantly different from the
+original version of this module shipped with Perl 5.000 through 5.004.
+As an additional feature, $keep may be the keyword "delimiters" which
+causes the functions to preserve the delimiters in each string as
+tokens in the token lists, in addition to preserving quote and
+backslash characters.
+
+&shellwords() is written as a special case of &quotewords(), and it
+does token parsing with whitespace as a delimiter-- similar to most
+Unix shells.
+
+=head1 EXAMPLES
+
+The sample program:
+
+ use Text::ParseWords;
+ @words = &quotewords('\s+', 0, q{this is "a test" of\ quotewords \"for you});
+ $i = 0;
+ foreach (@words) {
+ print "$i: <$_>\n";
+ $i++;
+ }
+
+produces:
+
+ 0: <this>
+ 1: <is>
+ 2: <a test>
+ 3: <of quotewords>
+ 4: <"for>
+ 5: <you>
+
+demonstrating:
+
+=over 4
+
+=item 0
+a simple word
+
+=item 1
+multiple spaces are skipped because of our $delim
+
+=item 2
+use of quotes to include a space in a word
+
+=item 3
+use of a backslash to include a space in a word
+
+=item 4
+use of a backslash to remove the special meaning of a double-quote
+
+=item 5
+another simple word (note the lack of effect of the
+backslashed double-quote)
+
+=back
+
+Replacing C<&quotewords('\s+', 0, q{this is...})>
+with C<&shellwords(q{this is...})>
+is a simpler way to accomplish the same thing.
+
+=head1 AUTHORS
+
+Maintainer is Hal Pomeranz <pomeranz@netcom.com>, 1994-1997 (Original
+author unknown). Much of the code for &parse_line() (including the
+primary regexp) from Joerk Behrends <jbehrends@multimediaproduzenten.de>.
+
+Examples section another documentation provided by John Heidemann
+<johnh@ISI.EDU>
+
+Bug reports, patches, and nagging provided by lots of folks-- thanks
+everybody! Special thanks to Michael Schwern <schwern@envirolink.org>
+for assuring me that a &nested_quotewords() would be useful, and to
+Jeff Friedl <jfriedl@yahoo-inc.com> for telling me not to worry about
+error-checking (sort of-- you had to be there).
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/Text/Soundex.pm b/gnu/usr.bin/perl/lib/Text/Soundex.pm
index a70c14219a5..c8619011b8e 100644
--- a/gnu/usr.bin/perl/lib/Text/Soundex.pm
+++ b/gnu/usr.bin/perl/lib/Text/Soundex.pm
@@ -5,7 +5,7 @@ require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(&soundex $soundex_nocode);
-# $Id: Soundex.pm,v 1.2 1997/11/30 07:58:05 millert Exp $
+# $Id: Soundex.pm,v 1.3 1999/04/29 22:52:00 millert Exp $
#
# Implementation of soundex algorithm as described by Knuth in volume
# 3 of The Art of Computer Programming, with ideas stolen from Ian
@@ -23,8 +23,8 @@ require Exporter;
# Lukasiewicz, Lissajous -> L222
#
# $Log: Soundex.pm,v $
-# Revision 1.2 1997/11/30 07:58:05 millert
-# perl 5.004_04
+# Revision 1.3 1999/04/29 22:52:00 millert
+# perl5.005_03 (stock)
#
# Revision 1.2 1994/03/24 00:30:27 mike
# Subtle bug (any excuse :-) spotted by Rich Pinder <rpinder@hsc.usc.edu>
diff --git a/gnu/usr.bin/perl/lib/Text/Wrap.pm b/gnu/usr.bin/perl/lib/Text/Wrap.pm
index 0910a2ab345..5f95edb69c7 100644
--- a/gnu/usr.bin/perl/lib/Text/Wrap.pm
+++ b/gnu/usr.bin/perl/lib/Text/Wrap.pm
@@ -2,18 +2,20 @@ package Text::Wrap;
require Exporter;
-@ISA = (Exporter);
-@EXPORT = qw(wrap);
-@EXPORT_OK = qw($columns);
+@ISA = qw(Exporter);
+@EXPORT = qw(wrap fill);
+@EXPORT_OK = qw($columns $break $huge);
-$VERSION = 97.011701;
+$VERSION = 98.112902;
-use vars qw($VERSION $columns $debug);
+use vars qw($VERSION $columns $debug $break $huge);
use strict;
BEGIN {
$columns = 76; # <= screen width
$debug = 0;
+ $break = '\s';
+ $huge = 'wrap'; # alternatively: 'die'
}
use Text::Tabs qw(expand unexpand);
@@ -25,38 +27,29 @@ sub wrap
my $r = "";
my $t = expand(join(" ",@t));
my $lead = $ip;
- my $ll = $columns - length(expand($lead)) - 1;
+ my $ll = $columns - length(expand($ip)) - 1;
+ my $nll = $columns - length(expand($xp)) - 1;
my $nl = "";
-
- # remove up to a line length of things that aren't
- # new lines and tabs.
-
- if ($t =~ s/^([^\n]{0,$ll})(\s|\Z(?!\n))//xm) {
-
- # accept it.
- $r .= unexpand($lead . $1);
-
- # recompute the leader
- $lead = $xp;
- $ll = $columns - length(expand($lead)) - 1;
- $nl = $2;
-
- # repeat the above until there's none left
- while ($t) {
- if ( $t =~ s/^([^\n]{0,$ll})(\s|\Z(?!\n))//xm ) {
- print "\$2 is '$2'\n" if $debug;
- $nl = $2;
- $r .= unexpand("\n" . $lead . $1);
- } elsif ($t =~ s/^([^\n]{$ll})//) {
- $nl = "\n";
- $r .= unexpand("\n" . $lead . $1);
- }
+ my $remainder = "";
+
+ while ($t !~ /^\s*$/) {
+ if ($t =~ s/^([^\n]{0,$ll})($break|\Z(?!\n))//xm) {
+ $r .= unexpand($nl . $lead . $1);
+ $remainder = $2;
+ } elsif ($huge eq 'wrap' && $t =~ s/^([^\n]{$ll})//) {
+ $r .= unexpand($nl . $lead . $1);
+ $remainder = "\n";
+ } elsif ($huge eq 'die') {
+ die "couldn't wrap '$t'";
+ } else {
+ die "This shouldn't happen";
}
- $r .= $nl;
- }
-
- die "couldn't wrap '$t'"
- if length($t) > $ll;
+
+ $lead = $xp;
+ $ll = $nll;
+ $nl = "\n";
+ }
+ $r .= $remainder;
print "-----------$r---------\n" if $debug;
@@ -68,6 +61,24 @@ sub wrap
return $r;
}
+sub fill
+{
+ my ($ip, $xp, @raw) = @_;
+ my @para;
+ my $pp;
+
+ for $pp (split(/\n\s+/, join("\n",@raw))) {
+ $pp =~ s/\s+/ /g;
+ my $x = wrap($ip, $xp, $pp);
+ push(@para, $x);
+ }
+
+ # if paragraph_indent is the same as line_indent,
+ # separate paragraphs with blank lines
+
+ return join ($ip eq $xp ? "\n\n" : "\n", @para);
+}
+
1;
__END__
@@ -80,66 +91,42 @@ Text::Wrap - line wrapping to form simple paragraphs
use Text::Wrap
print wrap($initial_tab, $subsequent_tab, @text);
+ print fill($initial_tab, $subsequent_tab, @text);
- use Text::Wrap qw(wrap $columns);
+ use Text::Wrap qw(wrap $columns $huge);
$columns = 132;
+ $huge = 'die';
+ $huge = 'wrap';
=head1 DESCRIPTION
Text::Wrap::wrap() is a very simple paragraph formatter. It formats a
-single paragraph at a time by breaking lines at word boundries.
+single paragraph at a time by breaking lines at word boundaries.
Indentation is controlled for the first line ($initial_tab) and
-all subsquent lines ($subsequent_tab) independently. $Text::Wrap::columns
-should be set to the full width of your output device.
+all subsequent lines ($subsequent_tab) independently.
-=head1 EXAMPLE
-
- print wrap("\t","","This is a bit of text that forms
- a normal book-style paragraph");
+Lines are wrapped at $Text::Wrap::columns columns.
+$Text::Wrap::columns should be set to the full width of your output device.
-=head1 BUGS
-
-It's not clear what the correct behavior should be when Wrap() is
-presented with a word that is longer than a line. The previous
-behavior was to die. Now the word is split at line-length.
-
-=head1 AUTHOR
-
-David Muir Sharnoff <muir@idiom.com> with help from Tim Pierce and
-others.
-
-=cut
-
-Latest change by Andreas Koenig <k@anna.in-berlin.de> - 1/17/97
-
- print fill($initial_tab, $subsequent_tab, @text);
-
- print fill("", "", `cat book`);
+When words that are longer than $columns are encountered, they
+are broken up. Previous versions of wrap() die()ed instead.
+To restore the old (dying) behavior, set $Text::Wrap::huge to
+'die'.
Text::Wrap::fill() is a simple multi-paragraph formatter. It formats
each paragraph separately and then joins them together when it's done. It
-will destory any whitespace in the original text. It breaks text into
+will destroy any whitespace in the original text. It breaks text into
paragraphs by looking for whitespace after a newline. In other respects
it acts like wrap().
-# Tim Pierce did a faster version of this:
-
-sub fill
-{
- my ($ip, $xp, @raw) = @_;
- my @para;
- my $pp;
+=head1 EXAMPLE
- for $pp (split(/\n\s+/, join("\n",@raw))) {
- $pp =~ s/\s+/ /g;
- my $x = wrap($ip, $xp, $pp);
- push(@para, $x);
- }
+ print wrap("\t","","This is a bit of text that forms
+ a normal book-style paragraph");
- # if paragraph_indent is the same as line_indent,
- # separate paragraphs with blank lines
+=head1 AUTHOR
- return join ($ip eq $xp ? "\n\n" : "\n", @para);
-}
+David Muir Sharnoff <muir@idiom.com> with help from Tim Pierce and
+many many others.
diff --git a/gnu/usr.bin/perl/lib/Tie/Hash.pm b/gnu/usr.bin/perl/lib/Tie/Hash.pm
index 2117c54c183..2902efb4d0d 100644
--- a/gnu/usr.bin/perl/lib/Tie/Hash.pm
+++ b/gnu/usr.bin/perl/lib/Tie/Hash.pm
@@ -67,7 +67,7 @@ Return the (key, value) pair for the first key in the hash.
=item NEXTKEY this, lastkey
-Return the next (key, value) pair for the hash.
+Return the next key for the hash.
=item EXISTS this, key
@@ -92,7 +92,7 @@ but may be omitted in favor of a simple default.
=head1 MORE INFORMATION
-The packages relating to various DBM-related implemetations (F<DB_File>,
+The packages relating to various DBM-related implementations (F<DB_File>,
F<NDBM_File>, etc.) show examples of general tied hashes, as does the
L<Config> module. While these do not utilize B<Tie::Hash>, they serve as
good working examples.
@@ -110,7 +110,7 @@ sub new {
sub TIEHASH {
my $pkg = shift;
- if (defined &{"{$pkg}::new"}) {
+ if (defined &{"${pkg}::new"}) {
carp "WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing"
if $^W;
$pkg->new(@_);
diff --git a/gnu/usr.bin/perl/lib/Tie/SubstrHash.pm b/gnu/usr.bin/perl/lib/Tie/SubstrHash.pm
index 44c2140c7be..4b18a58e122 100644
--- a/gnu/usr.bin/perl/lib/Tie/SubstrHash.pm
+++ b/gnu/usr.bin/perl/lib/Tie/SubstrHash.pm
@@ -69,7 +69,7 @@ sub FETCH {
sub STORE {
local($self,$key,$val) = @_;
local($klen, $vlen, $tsize, $rlen) = @$self[1..4];
- croak("Table is full") if $self[5] == $tsize;
+ croak("Table is full") if $$self[5] == $tsize;
croak(qq/Value "$val" is not $vlen characters long./)
if length($val) != $vlen;
my $writeoffset;
diff --git a/gnu/usr.bin/perl/lib/Time/Local.pm b/gnu/usr.bin/perl/lib/Time/Local.pm
index eef412d46d7..b2fba7ccc1e 100644
--- a/gnu/usr.bin/perl/lib/Time/Local.pm
+++ b/gnu/usr.bin/perl/lib/Time/Local.pm
@@ -17,16 +17,18 @@ Time::Local - efficiently compute time from local and GMT time
=head1 DESCRIPTION
-These routines are quite efficient and yet are always guaranteed to agree
-with localtime() and gmtime(). We manage this by caching the start times
-of any months we've seen before. If we know the start time of the month,
-we can always calculate any time within the month. The start times
-themselves are guessed by successive approximation starting at the
-current time, since most dates seen in practice are close to the
-current date. Unlike algorithms that do a binary search (calling gmtime
-once for each bit of the time value, resulting in 32 calls), this algorithm
-calls it at most 6 times, and usually only once or twice. If you hit
-the month cache, of course, it doesn't call it at all.
+These routines are quite efficient and yet are always guaranteed to
+agree with localtime() and gmtime(), the most notable points being
+that year is year-1900 and month is 0..11. We manage this by caching
+the start times of any months we've seen before. If we know the start
+time of the month, we can always calculate any time within the month.
+The start times themselves are guessed by successive approximation
+starting at the current time, since most dates seen in practice are
+close to the current date. Unlike algorithms that do a binary search
+(calling gmtime once for each bit of the time value, resulting in 32
+calls), this algorithm calls it at most 6 times, and usually only once
+or twice. If you hit the month cache, of course, it doesn't call it
+at all.
timelocal is implemented using the same cache. We just assume that we're
translating a GMT time, and then fudge it when we're done for the timezone
diff --git a/gnu/usr.bin/perl/lib/Time/gmtime.pm b/gnu/usr.bin/perl/lib/Time/gmtime.pm
index c1d11d74dbb..9b823f601e3 100644
--- a/gnu/usr.bin/perl/lib/Time/gmtime.pm
+++ b/gnu/usr.bin/perl/lib/Time/gmtime.pm
@@ -69,7 +69,7 @@ still overrides your core functions.) Access these fields as variables
named with a preceding C<tm_> in front their method names. Thus,
C<$tm_obj-E<gt>mday()> corresponds to $tm_mday if you import the fields.
-The gmctime() funtion provides a way of getting at the
+The gmctime() function provides a way of getting at the
scalar sense of the original CORE::gmtime() function.
To access this functionality without the core overrides,
diff --git a/gnu/usr.bin/perl/lib/Time/localtime.pm b/gnu/usr.bin/perl/lib/Time/localtime.pm
index 94377525973..18a36c7fb91 100644
--- a/gnu/usr.bin/perl/lib/Time/localtime.pm
+++ b/gnu/usr.bin/perl/lib/Time/localtime.pm
@@ -65,7 +65,7 @@ variables named with a preceding C<tm_> in front their method names.
Thus, C<$tm_obj-E<gt>mday()> corresponds to $tm_mday if you import
the fields.
-The ctime() funtion provides a way of getting at the
+The ctime() function provides a way of getting at the
scalar sense of the original CORE::localtime() function.
To access this functionality without the core overrides,
diff --git a/gnu/usr.bin/perl/lib/User/grent.pm b/gnu/usr.bin/perl/lib/User/grent.pm
index deb0a8d1be9..e4e226d119a 100644
--- a/gnu/usr.bin/perl/lib/User/grent.pm
+++ b/gnu/usr.bin/perl/lib/User/grent.pm
@@ -74,7 +74,7 @@ to $gr_gid if you import the fields. Array references are available as
regular array variables, so C<@{ $group_obj-E<gt>members() }> would be
simply @gr_members.
-The getpw() funtion is a simple front-end that forwards
+The getpw() function is a simple front-end that forwards
a numeric argument to getpwuid() and the rest to getpwnam().
To access this functionality without the core overrides,
diff --git a/gnu/usr.bin/perl/lib/User/pwent.pm b/gnu/usr.bin/perl/lib/User/pwent.pm
index 32301cadfc5..bb2dace6823 100644
--- a/gnu/usr.bin/perl/lib/User/pwent.pm
+++ b/gnu/usr.bin/perl/lib/User/pwent.pm
@@ -84,7 +84,7 @@ variables named with a preceding C<pw_> in front their method names.
Thus, C<$passwd_obj-E<gt>shell()> corresponds to $pw_shell if you import
the fields.
-The getpw() funtion is a simple front-end that forwards
+The getpw() function is a simple front-end that forwards
a numeric argument to getpwuid() and the rest to getpwnam().
To access this functionality without the core overrides,
diff --git a/gnu/usr.bin/perl/lib/autouse.pm b/gnu/usr.bin/perl/lib/autouse.pm
index ab95a19d8ab..4445c6c419b 100644
--- a/gnu/usr.bin/perl/lib/autouse.pm
+++ b/gnu/usr.bin/perl/lib/autouse.pm
@@ -146,15 +146,6 @@ The first line ensures that the errors in your argument specification
are found early. When you ship your application you should comment
out the first line, since it makes the second one useless.
-=head1 BUGS
-
-If Module::func3() is autoused, and the module is loaded between the
-C<autouse> directive and a call to Module::func3(), warnings about
-redefinition would appear if warnings are enabled.
-
-If Module::func3() is autoused, warnings are disabled when loading the
-module via autoused functions.
-
=head1 AUTHOR
Ilya Zakharevich (ilya@math.ohio-state.edu)
diff --git a/gnu/usr.bin/perl/lib/base.pm b/gnu/usr.bin/perl/lib/base.pm
index e20a64bc9a4..3500cbfb898 100644
--- a/gnu/usr.bin/perl/lib/base.pm
+++ b/gnu/usr.bin/perl/lib/base.pm
@@ -5,7 +5,6 @@ base - Establish IS-A relationship with base class at compile time
=head1 SYNOPSIS
package Baz;
-
use base qw(Foo Bar);
=head1 DESCRIPTION
@@ -18,11 +17,19 @@ Roughly similar in effect to
push @ISA, qw(Foo Bar);
}
+Will also initialize the %FIELDS hash if one of the base classes has
+it. Multiple inheritance of %FIELDS is not supported. The 'base'
+pragma will croak if multiple base classes has a %FIELDS hash. See
+L<fields> for a description of this feature.
+
+When strict 'vars' is in scope I<base> also let you assign to @ISA
+without having to declare @ISA with the 'vars' pragma first.
+
This module was introduced with Perl 5.004_04.
-=head1 BUGS
+=head1 SEE ALSO
-Needs proper documentation!
+L<fields>
=cut
@@ -30,10 +37,14 @@ package base;
sub import {
my $class = shift;
+ my $fields_base;
foreach my $base (@_) {
unless (defined %{"$base\::"}) {
eval "require $base";
+ # Only ignore "Can't locate" errors from our eval require.
+ # Other fatal errors (syntax etc) must be reported.
+ die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
unless (defined %{"$base\::"}) {
require Carp;
Carp::croak("Base class package \"$base\" is empty.\n",
@@ -41,9 +52,26 @@ sub import {
"which defines that package first.)");
}
}
+
+ # A simple test like (defined %{"$base\::FIELDS"}) will
+ # sometimes produce typo warnings because it would create
+ # the hash if it was not present before.
+ my $fglob;
+ if ($fglob = ${"$base\::"}{"FIELDS"} and *$fglob{HASH}) {
+ if ($fields_base) {
+ require Carp;
+ Carp::croak("Can't multiply inherit %FIELDS");
+ } else {
+ $fields_base = $base;
+ }
+ }
+ }
+ my $pkg = caller(0);
+ push @{"$pkg\::ISA"}, @_;
+ if ($fields_base) {
+ require fields;
+ fields::inherit($pkg, $fields_base);
}
-
- push @{caller(0) . '::ISA'}, @_;
}
1;
diff --git a/gnu/usr.bin/perl/lib/bigint.pl b/gnu/usr.bin/perl/lib/bigint.pl
index bfd2efa88c8..adeb17f28a9 100644
--- a/gnu/usr.bin/perl/lib/bigint.pl
+++ b/gnu/usr.bin/perl/lib/bigint.pl
@@ -74,7 +74,7 @@ sub external { #(int_num_array) return num_str
sub main'bneg { #(num_str) return num_str
local($_) = &'bnorm(@_);
vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0';
- s/^H/N/;
+ s/^./N/ unless /^[-+]/; # works both in ASCII and EBCDIC
$_;
}
diff --git a/gnu/usr.bin/perl/lib/blib.pm b/gnu/usr.bin/perl/lib/blib.pm
index 9e0f6c07c3d..1d56a58174e 100644
--- a/gnu/usr.bin/perl/lib/blib.pm
+++ b/gnu/usr.bin/perl/lib/blib.pm
@@ -45,6 +45,7 @@ sub import
{
my $package = shift;
my $dir = getcwd;
+ if ($^O eq 'VMS') { ($dir = VMS::Filespec::unixify($dir)) =~ s-/$--; }
if (@_)
{
$dir = shift;
diff --git a/gnu/usr.bin/perl/lib/constant.pm b/gnu/usr.bin/perl/lib/constant.pm
index a0d4f9d5cda..5d3dd91b46f 100644
--- a/gnu/usr.bin/perl/lib/constant.pm
+++ b/gnu/usr.bin/perl/lib/constant.pm
@@ -20,6 +20,18 @@ constant - Perl pragma to declare constants
print "This line does nothing" unless DEBUGGING;
+ # references can be declared constant
+ use constant CHASH => { foo => 42 };
+ use constant CARRAY => [ 1,2,3,4 ];
+ use constant CPSEUDOHASH => [ { foo => 1}, 42 ];
+ use constant CCODE => sub { "bite $_[0]\n" };
+
+ print CHASH->{foo};
+ print CARRAY->[$i];
+ print CPSEUDOHASH->{foo};
+ print CCODE->("me");
+ print CHASH->[10]; # compile-time error
+
=head1 DESCRIPTION
This will declare a symbol to be a constant with the given scalar
@@ -86,6 +98,8 @@ constants at compile time, allowing for way cool stuff like this.
print E2BIG, "\n"; # something like "Arg list too long"
print 0+E2BIG, "\n"; # "7"
+Errors in dereferencing constant references are trapped at compile-time.
+
=head1 TECHNICAL NOTE
In the current implementation, scalar constants are actually
@@ -106,6 +120,15 @@ name as a constant. This is probably a Good Thing.
Unlike constants in some languages, these cannot be overridden
on the command line or via environment variables.
+You can get into trouble if you use constants in a context which
+automatically quotes barewords (as is true for any subroutine call).
+For example, you can't say C<$hash{CONSTANT}> because C<CONSTANT> will
+be interpreted as a string. Use C<$hash{CONSTANT()}> or
+C<$hash{+CONSTANT}> to prevent the bareword quoting mechanism from
+kicking in. Similarly, since the C<=E<gt>> operator quotes a bareword
+immediately to its left you have to say C<CONSTANT() =E<gt> 'value'>
+instead of C<CONSTANT =E<gt> 'value'>.
+
=head1 AUTHOR
Tom Phoenix, E<lt>F<rootbeer@teleport.com>E<gt>, with help from
diff --git a/gnu/usr.bin/perl/lib/diagnostics.pm b/gnu/usr.bin/perl/lib/diagnostics.pm
index 78bf4457cba..b9aaba5c392 100644
--- a/gnu/usr.bin/perl/lib/diagnostics.pm
+++ b/gnu/usr.bin/perl/lib/diagnostics.pm
@@ -27,7 +27,7 @@ Aa a program:
=head2 The C<diagnostics> Pragma
This module extends the terse diagnostics normally emitted by both the
-perl compiler and the perl interpeter, augmenting them with the more
+perl compiler and the perl interpreter, augmenting them with the more
explicative and endearing descriptions found in L<perldiag>. Like the
other pragmata, it affects the compilation phase of your program rather
than merely the execution phase.
diff --git a/gnu/usr.bin/perl/lib/dumpvar.pl b/gnu/usr.bin/perl/lib/dumpvar.pl
index c32bc2fb5e1..32d4692d13a 100644
--- a/gnu/usr.bin/perl/lib/dumpvar.pl
+++ b/gnu/usr.bin/perl/lib/dumpvar.pl
@@ -22,6 +22,8 @@ $printUndef = 1 unless defined $printUndef;
$tick = "auto" unless defined $tick;
$unctrl = 'quote' unless defined $unctrl;
$subdump = 1;
+$dumpReused = 0 unless defined $dumpReused;
+$bareStringify = 1 unless defined $bareStringify;
sub main::dumpValue {
local %address;
@@ -49,6 +51,10 @@ sub stringify {
return 'undef' unless defined $_ or not $printUndef;
return $_ . "" if ref \$_ eq 'GLOB';
+ $_ = &{'overload::StrVal'}($_)
+ if $bareStringify and ref $_
+ and defined %overload:: and defined &{'overload::StrVal'};
+
if ($tick eq 'auto') {
if (/[\000-\011\013-\037\177]/) {
$tick = '"';
@@ -109,7 +115,7 @@ sub unwrap {
return if $DB::signal;
local($v) = shift ;
local($s) = shift ; # extra no of spaces
- local(%v,@v,$sp,$value,$key,$type,@sortKeys,$more,$shortmore,$short) ;
+ local(%v,@v,$sp,$value,$key,@sortKeys,$more,$shortmore,$short) ;
local($tHashDepth,$tArrayDepth) ;
$sp = " " x $s ;
@@ -117,9 +123,11 @@ sub unwrap {
# Check for reused addresses
if (ref $v) {
- ($address) = $v =~ /(0x[0-9a-f]+)\)$/ ;
- if (defined $address) {
- ($type) = $v =~ /=(.*?)\([^=]+$/ ;
+ my $val = $v;
+ $val = &{'overload::StrVal'}($v)
+ if defined %overload:: and defined &{'overload::StrVal'};
+ ($address) = $val =~ /(0x[0-9a-f]+)\)$/ ;
+ if (!$dumpReused && defined $address) {
$address{$address}++ ;
if ( $address{$address} > 1 ) {
print "${sp}-> REUSED_ADDRESS\n" ;
diff --git a/gnu/usr.bin/perl/lib/ftp.pl b/gnu/usr.bin/perl/lib/ftp.pl
index 0a77114b6b0..2b34b12a023 100644
--- a/gnu/usr.bin/perl/lib/ftp.pl
+++ b/gnu/usr.bin/perl/lib/ftp.pl
@@ -5,10 +5,10 @@
# based on original version by Alan R. Martello <al@ee.pitt.edu>
# And by A.Macpherson@bnr.co.uk for multi-homed hosts
#
-# $Header: /home/cvs/src/gnu/usr.bin/perl/lib/Attic/ftp.pl,v 1.2 1997/11/30 07:56:58 millert Exp $
+# $Header: /home/cvs/src/gnu/usr.bin/perl/lib/Attic/ftp.pl,v 1.3 1999/04/29 22:51:46 millert Exp $
# $Log: ftp.pl,v $
-# Revision 1.2 1997/11/30 07:56:58 millert
-# perl 5.004_04
+# Revision 1.3 1999/04/29 22:51:46 millert
+# perl5.005_03 (stock)
#
# Revision 1.17 1993/04/21 10:06:54 lmjm
# Send all status reports to STDERR not to STDOUT (to allow use by ftpcat).
diff --git a/gnu/usr.bin/perl/lib/lib.pm b/gnu/usr.bin/perl/lib/lib.pm
index 4d32f963551..6e6e15e4ce9 100644
--- a/gnu/usr.bin/perl/lib/lib.pm
+++ b/gnu/usr.bin/perl/lib/lib.pm
@@ -18,6 +18,10 @@ sub import {
Carp::carp("Empty compile time value given to use lib");
# at foo.pl line ...
}
+ if (-e && ! -d _) {
+ require Carp;
+ Carp::carp("Parameter to use lib must be directory, not file");
+ }
unshift(@INC, $_);
# Put a corresponding archlib directory infront of $_ if it
# looks like $_ has an archlib directory below it.
diff --git a/gnu/usr.bin/perl/lib/overload.pm b/gnu/usr.bin/perl/lib/overload.pm
index c9044db0dc5..f06b49cd5ea 100644
--- a/gnu/usr.bin/perl/lib/overload.pm
+++ b/gnu/usr.bin/perl/lib/overload.pm
@@ -62,7 +62,10 @@ sub OverloadedStringify {
my $package = shift;
$package = ref $package if ref $package;
#$package->can('(""')
- ov_method mycan($package, '(""'), $package;
+ ov_method mycan($package, '(""'), $package
+ or ov_method mycan($package, '(0+'), $package
+ or ov_method mycan($package, '(bool'), $package
+ or ov_method mycan($package, '(nomethod'), $package;
}
sub Method {
@@ -100,6 +103,44 @@ sub mycan { # Real can would leave stubs.
return undef;
}
+%constants = (
+ 'integer' => 0x1000,
+ 'float' => 0x2000,
+ 'binary' => 0x4000,
+ 'q' => 0x8000,
+ 'qr' => 0x10000,
+ );
+
+%ops = ( with_assign => "+ - * / % ** << >> x .",
+ assign => "+= -= *= /= %= **= <<= >>= x= .=",
+ str_comparison => "< <= > >= == !=",
+ '3way_comparison'=> "<=> cmp",
+ num_comparison => "lt le gt ge eq ne",
+ binary => "& | ^",
+ unary => "neg ! ~",
+ mutators => '++ --',
+ func => "atan2 cos sin exp abs log sqrt",
+ conversion => 'bool "" 0+',
+ special => 'nomethod fallback =');
+
+sub constant {
+ # Arguments: what, sub
+ while (@_) {
+ $^H{$_[0]} = $_[1];
+ $^H |= $constants{$_[0]} | 0x20000;
+ shift, shift;
+ }
+}
+
+sub remove_constant {
+ # Arguments: what, sub
+ while (@_) {
+ delete $^H{$_[0]};
+ $^H &= ~ $constants{$_[0]};
+ shift, shift;
+ }
+}
+
1;
__END__
@@ -126,13 +167,6 @@ overload - Package for overloading perl operations
...
$strval = overload::StrVal $b;
-=head1 CAVEAT SCRIPTOR
-
-Overloading of operators is a subject not to be taken lightly.
-Neither its precise implementation, syntax, nor semantics are
-100% endorsed by Larry Wall. So any of these may be changed
-at some point in the future.
-
=head1 DESCRIPTION
=head2 Declaration of overloaded functions
@@ -194,7 +228,8 @@ the arguments are reversed.
the current operation is an assignment variant (as in
C<$a+=7>), but the usual function is called instead. This additional
-information can be used to generate some optimizations.
+information can be used to generate some optimizations. Compare
+L<Calling Conventions for Mutators>.
=back
@@ -204,9 +239,67 @@ Unary operation are considered binary operations with the second
argument being C<undef>. Thus the functions that overloads C<{"++"}>
is called with arguments C<($a,undef,'')> when $a++ is executed.
+=head2 Calling Conventions for Mutators
+
+Two types of mutators have different calling conventions:
+
+=over
+
+=item C<++> and C<-->
+
+The routines which implement these operators are expected to actually
+I<mutate> their arguments. So, assuming that $obj is a reference to a
+number,
+
+ sub incr { my $n = $ {$_[0]}; ++$n; $_[0] = bless \$n}
+
+is an appropriate implementation of overloaded C<++>. Note that
+
+ sub incr { ++$ {$_[0]} ; shift }
+
+is OK if used with preincrement and with postincrement. (In the case
+of postincrement a copying will be performed, see L<Copy Constructor>.)
+
+=item C<x=> and other assignment versions
+
+There is nothing special about these methods. They may change the
+value of their arguments, and may leave it as is. The result is going
+to be assigned to the value in the left-hand-side if different from
+this value.
+
+This allows for the same method to be used as overloaded C<+=> and
+C<+>. Note that this is I<allowed>, but not recommended, since by the
+semantic of L<"Fallback"> Perl will call the method for C<+> anyway,
+if C<+=> is not overloaded.
+
+=back
+
+B<Warning.> Due to the presense of assignment versions of operations,
+routines which may be called in assignment context may create
+self-referential structures. Currently Perl will not free self-referential
+structures until cycles are C<explicitly> broken. You may get problems
+when traversing your structures too.
+
+Say,
+
+ use overload '+' => sub { bless [ \$_[0], \$_[1] ] };
+
+is asking for trouble, since for code C<$obj += $foo> the subroutine
+is called as C<$obj = add($obj, $foo, undef)>, or C<$obj = [\$obj,
+\$foo]>. If using such a subroutine is an important optimization, one
+can overload C<+=> explicitly by a non-"optimized" version, or switch
+to non-optimized version if C<not defined $_[2]> (see
+L<Calling Conventions for Binary Operations>).
+
+Even if no I<explicit> assignment-variants of operators are present in
+the script, they may be generated by the optimizer. Say, C<",$obj,"> or
+C<',' . $obj . ','> may be both optimized to
+
+ my $tmp = ',' . $obj; $tmp .= ',';
+
=head2 Overloadable Operations
-The following symbols can be specified in C<use overload>:
+The following symbols can be specified in C<use overload> directive:
=over 5
@@ -221,6 +314,10 @@ the assignment variant is not available. Methods for operations "C<+>",
increment and decrement methods. The operation "C<->" can be used to
autogenerate missing methods for unary minus or C<abs>.
+See L<"MAGIC AUTOGENERATION">, L<"Calling Conventions for Mutators"> and
+L<"Calling Conventions for Binary Operations">) for details of these
+substitutions.
+
=item * I<Comparison operations>
"<", "<=", ">", ">=", "==", "!=", "<=>",
@@ -272,7 +369,23 @@ see L<SPECIAL SYMBOLS FOR C<use overload>>.
=back
-See L<"Fallback"> for an explanation of when a missing method can be autogenerated.
+See L<"Fallback"> for an explanation of when a missing method can be
+autogenerated.
+
+A computer-readable form of the above table is available in the hash
+%overload::ops, with values being space-separated lists of names:
+
+ with_assign => '+ - * / % ** << >> x .',
+ assign => '+= -= *= /= %= **= <<= >>= x= .=',
+ str_comparison => '< <= > >= == !=',
+ '3way_comparison'=> '<=> cmp',
+ num_comparison => 'lt le gt ge eq ne',
+ binary => '& | ^',
+ unary => 'neg ! ~',
+ mutators => '++ --',
+ func => 'atan2 cos sin exp abs log sqrt',
+ conversion => 'bool "" 0+',
+ special => 'nomethod fallback ='
=head2 Inheritance and overloading
@@ -375,15 +488,15 @@ to a reference that shares its object with some other reference, such
as
$a=$b;
- $a++;
+ ++$a;
To make this change $a and not change $b, a copy of C<$$a> is made,
and $a is assigned a reference to this new object. This operation is
-done during execution of the C<$a++>, and not during the assignment,
+done during execution of the C<++$a>, and not during the assignment,
(so before the increment C<$$a> coincides with C<$$b>). This is only
-done if C<++> is expressed via a method for C<'++'> or C<'+='>. Note
-that if this operation is expressed via C<'+'> a nonmutator, i.e., as
-in
+done if C<++> is expressed via a method for C<'++'> or C<'+='> (or
+C<nomethod>). Note that if this operation is expressed via C<'+'>
+a nonmutator, i.e., as in
$a=$b;
$a=$a+1;
@@ -417,6 +530,9 @@ C<'='> was overloaded with C<\&clone>.
=back
+Same behaviour is triggered by C<$b = $a++>, which is consider a synonym for
+C<$b = $a; ++$a>.
+
=head1 MAGIC AUTOGENERATION
If a method for an operation is not found, and the value for C<"fallback"> is
@@ -473,7 +589,7 @@ value is a scalar and not a reference.
=back
-=head1 WARNING
+=head1 Losing overloading
The restriction for the comparison operation is that even if, for example,
`C<cmp>' should return a blessed reference, the autogenerated `C<lt>'
@@ -522,6 +638,72 @@ Returns C<undef> or a reference to the method that implements C<op>.
=back
+=head1 Overloading constants
+
+For some application Perl parser mangles constants too much. It is possible
+to hook into this process via overload::constant() and overload::remove_constant()
+functions.
+
+These functions take a hash as an argument. The recognized keys of this hash
+are
+
+=over 8
+
+=item integer
+
+to overload integer constants,
+
+=item float
+
+to overload floating point constants,
+
+=item binary
+
+to overload octal and hexadecimal constants,
+
+=item q
+
+to overload C<q>-quoted strings, constant pieces of C<qq>- and C<qx>-quoted
+strings and here-documents,
+
+=item qr
+
+to overload constant pieces of regular expressions.
+
+=back
+
+The corresponding values are references to functions which take three arguments:
+the first one is the I<initial> string form of the constant, the second one
+is how Perl interprets this constant, the third one is how the constant is used.
+Note that the initial string form does not
+contain string delimiters, and has backslashes in backslash-delimiter
+combinations stripped (thus the value of delimiter is not relevant for
+processing of this string). The return value of this function is how this
+constant is going to be interpreted by Perl. The third argument is undefined
+unless for overloaded C<q>- and C<qr>- constants, it is C<q> in single-quote
+context (comes from strings, regular expressions, and single-quote HERE
+documents), it is C<tr> for arguments of C<tr>/C<y> operators,
+it is C<s> for right-hand side of C<s>-operator, and it is C<qq> otherwise.
+
+Since an expression C<"ab$cd,,"> is just a shortcut for C<'ab' . $cd . ',,'>,
+it is expected that overloaded constant strings are equipped with reasonable
+overloaded catenation operator, otherwise absurd results will result.
+Similarly, negative numbers are considered as negations of positive constants.
+
+Note that it is probably meaningless to call the functions overload::constant()
+and overload::remove_constant() from anywhere but import() and unimport() methods.
+From these methods they may be called as
+
+ sub import {
+ shift;
+ return unless @_;
+ die "unknown import: @_" unless @_ == 1 and $_[0] eq ':constant';
+ overload::constant integer => sub {Math::BigInt->new(shift)};
+ }
+
+B<BUGS> Currently overloaded-ness of constants does not propagate
+into C<eval '...'>.
+
=head1 IMPLEMENTATION
What follows is subject to change RSN.
@@ -559,7 +741,7 @@ There is no size penalty for data if overload is not used. The only
size penalty if overload is used in some package is that I<all> the
packages acquire a magic during the next C<bless>ing into the
package. This magic is three-words-long for packages without
-overloading, and carries the cache tabel if the package is overloaded.
+overloading, and carries the cache table if the package is overloaded.
Copying (C<$a=$b>) is shallow; however, a one-level-deep copying is
carried out before any operation that can imply an assignment to the
@@ -569,6 +751,416 @@ behavior by defining your own copy constructor (see L<"Copy Constructor">).
It is expected that arguments to methods that are not explicitly supposed
to be changed are constant (but this is not enforced).
+=head1 Metaphor clash
+
+One may wonder why the semantic of overloaded C<=> is so counter intuitive.
+If it I<looks> counter intuitive to you, you are subject to a metaphor
+clash.
+
+Here is a Perl object metaphor:
+
+I< object is a reference to blessed data>
+
+and an arithmetic metaphor:
+
+I< object is a thing by itself>.
+
+The I<main> problem of overloading C<=> is the fact that these metaphors
+imply different actions on the assignment C<$a = $b> if $a and $b are
+objects. Perl-think implies that $a becomes a reference to whatever
+$b was referencing. Arithmetic-think implies that the value of "object"
+$a is changed to become the value of the object $b, preserving the fact
+that $a and $b are separate entities.
+
+The difference is not relevant in the absence of mutators. After
+a Perl-way assignment an operation which mutates the data referenced by $a
+would change the data referenced by $b too. Effectively, after
+C<$a = $b> values of $a and $b become I<indistinguishable>.
+
+On the other hand, anyone who has used algebraic notation knows the
+expressive power of the arithmetic metaphor. Overloading works hard
+to enable this metaphor while preserving the Perlian way as far as
+possible. Since it is not not possible to freely mix two contradicting
+metaphors, overloading allows the arithmetic way to write things I<as
+far as all the mutators are called via overloaded access only>. The
+way it is done is described in L<Copy Constructor>.
+
+If some mutator methods are directly applied to the overloaded values,
+one may need to I<explicitly unlink> other values which references the
+same value:
+
+ $a = new Data 23;
+ ...
+ $b = $a; # $b is "linked" to $a
+ ...
+ $a = $a->clone; # Unlink $b from $a
+ $a->increment_by(4);
+
+Note that overloaded access makes this transparent:
+
+ $a = new Data 23;
+ $b = $a; # $b is "linked" to $a
+ $a += 4; # would unlink $b automagically
+
+However, it would not make
+
+ $a = new Data 23;
+ $a = 4; # Now $a is a plain 4, not 'Data'
+
+preserve "objectness" of $a. But Perl I<has> a way to make assignments
+to an object do whatever you want. It is just not the overload, but
+tie()ing interface (see L<perlfunc/tie>). Adding a FETCH() method
+which returns the object itself, and STORE() method which changes the
+value of the object, one can reproduce the arithmetic metaphor in its
+completeness, at least for variables which were tie()d from the start.
+
+(Note that a workaround for a bug may be needed, see L<"BUGS">.)
+
+=head1 Cookbook
+
+Please add examples to what follows!
+
+=head2 Two-face scalars
+
+Put this in F<two_face.pm> in your Perl library directory:
+
+ package two_face; # Scalars with separate string and
+ # numeric values.
+ sub new { my $p = shift; bless [@_], $p }
+ use overload '""' => \&str, '0+' => \&num, fallback => 1;
+ sub num {shift->[1]}
+ sub str {shift->[0]}
+
+Use it as follows:
+
+ require two_face;
+ my $seven = new two_face ("vii", 7);
+ printf "seven=$seven, seven=%d, eight=%d\n", $seven, $seven+1;
+ print "seven contains `i'\n" if $seven =~ /i/;
+
+(The second line creates a scalar which has both a string value, and a
+numeric value.) This prints:
+
+ seven=vii, seven=7, eight=8
+ seven contains `i'
+
+=head2 Symbolic calculator
+
+Put this in F<symbolic.pm> in your Perl library directory:
+
+ package symbolic; # Primitive symbolic calculator
+ use overload nomethod => \&wrap;
+
+ sub new { shift; bless ['n', @_] }
+ sub wrap {
+ my ($obj, $other, $inv, $meth) = @_;
+ ($obj, $other) = ($other, $obj) if $inv;
+ bless [$meth, $obj, $other];
+ }
+
+This module is very unusual as overloaded modules go: it does not
+provide any usual overloaded operators, instead it provides the L<Last
+Resort> operator C<nomethod>. In this example the corresponding
+subroutine returns an object which encapsulates operations done over
+the objects: C<new symbolic 3> contains C<['n', 3]>, C<2 + new
+symbolic 3> contains C<['+', 2, ['n', 3]]>.
+
+Here is an example of the script which "calculates" the side of
+circumscribed octagon using the above package:
+
+ require symbolic;
+ my $iter = 1; # 2**($iter+2) = 8
+ my $side = new symbolic 1;
+ my $cnt = $iter;
+
+ while ($cnt--) {
+ $side = (sqrt(1 + $side**2) - 1)/$side;
+ }
+ print "OK\n";
+
+The value of $side is
+
+ ['/', ['-', ['sqrt', ['+', 1, ['**', ['n', 1], 2]],
+ undef], 1], ['n', 1]]
+
+Note that while we obtained this value using a nice little script,
+there is no simple way to I<use> this value. In fact this value may
+be inspected in debugger (see L<perldebug>), but ony if
+C<bareStringify> B<O>ption is set, and not via C<p> command.
+
+If one attempts to print this value, then the overloaded operator
+C<""> will be called, which will call C<nomethod> operator. The
+result of this operator will be stringified again, but this result is
+again of type C<symbolic>, which will lead to an infinite loop.
+
+Add a pretty-printer method to the module F<symbolic.pm>:
+
+ sub pretty {
+ my ($meth, $a, $b) = @{+shift};
+ $a = 'u' unless defined $a;
+ $b = 'u' unless defined $b;
+ $a = $a->pretty if ref $a;
+ $b = $b->pretty if ref $b;
+ "[$meth $a $b]";
+ }
+
+Now one can finish the script by
+
+ print "side = ", $side->pretty, "\n";
+
+The method C<pretty> is doing object-to-string conversion, so it
+is natural to overload the operator C<""> using this method. However,
+inside such a method it is not necessary to pretty-print the
+I<components> $a and $b of an object. In the above subroutine
+C<"[$meth $a $b]"> is a catenation of some strings and components $a
+and $b. If these components use overloading, the catenation operator
+will look for an overloaded operator C<.>, if not present, it will
+look for an overloaded operator C<"">. Thus it is enough to use
+
+ use overload nomethod => \&wrap, '""' => \&str;
+ sub str {
+ my ($meth, $a, $b) = @{+shift};
+ $a = 'u' unless defined $a;
+ $b = 'u' unless defined $b;
+ "[$meth $a $b]";
+ }
+
+Now one can change the last line of the script to
+
+ print "side = $side\n";
+
+which outputs
+
+ side = [/ [- [sqrt [+ 1 [** [n 1 u] 2]] u] 1] [n 1 u]]
+
+and one can inspect the value in debugger using all the possible
+methods.
+
+Something is is still amiss: consider the loop variable $cnt of the
+script. It was a number, not an object. We cannot make this value of
+type C<symbolic>, since then the loop will not terminate.
+
+Indeed, to terminate the cycle, the $cnt should become false.
+However, the operator C<bool> for checking falsity is overloaded (this
+time via overloaded C<"">), and returns a long string, thus any object
+of type C<symbolic> is true. To overcome this, we need a way to
+compare an object to 0. In fact, it is easier to write a numeric
+conversion routine.
+
+Here is the text of F<symbolic.pm> with such a routine added (and
+slightly modified str()):
+
+ package symbolic; # Primitive symbolic calculator
+ use overload
+ nomethod => \&wrap, '""' => \&str, '0+' => \&num;
+
+ sub new { shift; bless ['n', @_] }
+ sub wrap {
+ my ($obj, $other, $inv, $meth) = @_;
+ ($obj, $other) = ($other, $obj) if $inv;
+ bless [$meth, $obj, $other];
+ }
+ sub str {
+ my ($meth, $a, $b) = @{+shift};
+ $a = 'u' unless defined $a;
+ if (defined $b) {
+ "[$meth $a $b]";
+ } else {
+ "[$meth $a]";
+ }
+ }
+ my %subr = ( n => sub {$_[0]},
+ sqrt => sub {sqrt $_[0]},
+ '-' => sub {shift() - shift()},
+ '+' => sub {shift() + shift()},
+ '/' => sub {shift() / shift()},
+ '*' => sub {shift() * shift()},
+ '**' => sub {shift() ** shift()},
+ );
+ sub num {
+ my ($meth, $a, $b) = @{+shift};
+ my $subr = $subr{$meth}
+ or die "Do not know how to ($meth) in symbolic";
+ $a = $a->num if ref $a eq __PACKAGE__;
+ $b = $b->num if ref $b eq __PACKAGE__;
+ $subr->($a,$b);
+ }
+
+All the work of numeric conversion is done in %subr and num(). Of
+course, %subr is not complete, it contains only operators used in the
+example below. Here is the extra-credit question: why do we need an
+explicit recursion in num()? (Answer is at the end of this section.)
+
+Use this module like this:
+
+ require symbolic;
+ my $iter = new symbolic 2; # 16-gon
+ my $side = new symbolic 1;
+ my $cnt = $iter;
+
+ while ($cnt) {
+ $cnt = $cnt - 1; # Mutator `--' not implemented
+ $side = (sqrt(1 + $side**2) - 1)/$side;
+ }
+ printf "%s=%f\n", $side, $side;
+ printf "pi=%f\n", $side*(2**($iter+2));
+
+It prints (without so many line breaks)
+
+ [/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1]
+ [n 1]] 2]]] 1]
+ [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]=0.198912
+ pi=3.182598
+
+The above module is very primitive. It does not implement
+mutator methods (C<++>, C<-=> and so on), does not do deep copying
+(not required without mutators!), and implements only those arithmetic
+operations which are used in the example.
+
+To implement most arithmetic operations is easy, one should just use
+the tables of operations, and change the code which fills %subr to
+
+ my %subr = ( 'n' => sub {$_[0]} );
+ foreach my $op (split " ", $overload::ops{with_assign}) {
+ $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
+ }
+ my @bins = qw(binary 3way_comparison num_comparison str_comparison);
+ foreach my $op (split " ", "@overload::ops{ @bins }") {
+ $subr{$op} = eval "sub {shift() $op shift()}";
+ }
+ foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
+ print "defining `$op'\n";
+ $subr{$op} = eval "sub {$op shift()}";
+ }
+
+Due to L<Calling Conventions for Mutators>, we do not need anything
+special to make C<+=> and friends work, except filling C<+=> entry of
+%subr, and defining a copy constructor (needed since Perl has no
+way to know that the implementation of C<'+='> does not mutate
+the argument, compare L<Copy Constructor>).
+
+To implement a copy constructor, add C<'=' => \&cpy> to C<use overload>
+line, and code (this code assumes that mutators change things one level
+deep only, so recursive copying is not needed):
+
+ sub cpy {
+ my $self = shift;
+ bless [@$self], ref $self;
+ }
+
+To make C<++> and C<--> work, we need to implement actual mutators,
+either directly, or in C<nomethod>. We continue to do things inside
+C<nomethod>, thus add
+
+ if ($meth eq '++' or $meth eq '--') {
+ @$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
+ return $obj;
+ }
+
+after the first line of wrap(). This is not a most effective
+implementation, one may consider
+
+ sub inc { $_[0] = bless ['++', shift, 1]; }
+
+instead.
+
+As a final remark, note that one can fill %subr by
+
+ my %subr = ( 'n' => sub {$_[0]} );
+ foreach my $op (split " ", $overload::ops{with_assign}) {
+ $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
+ }
+ my @bins = qw(binary 3way_comparison num_comparison str_comparison);
+ foreach my $op (split " ", "@overload::ops{ @bins }") {
+ $subr{$op} = eval "sub {shift() $op shift()}";
+ }
+ foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
+ $subr{$op} = eval "sub {$op shift()}";
+ }
+ $subr{'++'} = $subr{'+'};
+ $subr{'--'} = $subr{'-'};
+
+This finishes implementation of a primitive symbolic calculator in
+50 lines of Perl code. Since the numeric values of subexpressions
+are not cached, the calculator is very slow.
+
+Here is the answer for the exercise: In the case of str(), we need no
+explicit recursion since the overloaded C<.>-operator will fall back
+to an existing overloaded operator C<"">. Overloaded arithmetic
+operators I<do not> fall back to numeric conversion if C<fallback> is
+not explicitly requested. Thus without an explicit recursion num()
+would convert C<['+', $a, $b]> to C<$a + $b>, which would just rebuild
+the argument of num().
+
+If you wonder why defaults for conversion are different for str() and
+num(), note how easy it was to write the symbolic calculator. This
+simplicity is due to an appropriate choice of defaults. One extra
+note: due to the explicit recursion num() is more fragile than sym():
+we need to explicitly check for the type of $a and $b. If components
+$a and $b happen to be of some related type, this may lead to problems.
+
+=head2 I<Really> symbolic calculator
+
+One may wonder why we call the above calculator symbolic. The reason
+is that the actual calculation of the value of expression is postponed
+until the value is I<used>.
+
+To see it in action, add a method
+
+ sub STORE {
+ my $obj = shift;
+ $#$obj = 1;
+ @$obj->[0,1] = ('=', shift);
+ }
+
+to the package C<symbolic>. After this change one can do
+
+ my $a = new symbolic 3;
+ my $b = new symbolic 4;
+ my $c = sqrt($a**2 + $b**2);
+
+and the numeric value of $c becomes 5. However, after calling
+
+ $a->STORE(12); $b->STORE(5);
+
+the numeric value of $c becomes 13. There is no doubt now that the module
+symbolic provides a I<symbolic> calculator indeed.
+
+To hide the rough edges under the hood, provide a tie()d interface to the
+package C<symbolic> (compare with L<Metaphor clash>). Add methods
+
+ sub TIESCALAR { my $pack = shift; $pack->new(@_) }
+ sub FETCH { shift }
+ sub nop { } # Around a bug
+
+(the bug is described in L<"BUGS">). One can use this new interface as
+
+ tie $a, 'symbolic', 3;
+ tie $b, 'symbolic', 4;
+ $a->nop; $b->nop; # Around a bug
+
+ my $c = sqrt($a**2 + $b**2);
+
+Now numeric value of $c is 5. After C<$a = 12; $b = 5> the numeric value
+of $c becomes 13. To insulate the user of the module add a method
+
+ sub vars { my $p = shift; tie($_, $p), $_->nop foreach @_; }
+
+Now
+
+ my ($a, $b);
+ symbolic->vars($a, $b);
+ my $c = sqrt($a**2 + $b**2);
+
+ $a = 3; $b = 4;
+ printf "c5 %s=%f\n", $c, $c;
+
+ $a = 12; $b = 5;
+ printf "c13 %s=%f\n", $c, $c;
+
+shows that the numeric value of $c follows changes to the values of $a
+and $b.
+
=head1 AUTHOR
Ilya Zakharevich E<lt>F<ilya@math.mps.ohio-state.edu>E<gt>.
@@ -584,7 +1176,7 @@ this overloading). Say, if C<eq> is overloaded, then the method C<(eq>
is shown by debugger. The method C<()> corresponds to the C<fallback>
key (in fact a presence of this method shows that this package has
overloading enabled, and it is what is used by the C<Overloaded>
-function).
+function of module C<overload>).
=head1 BUGS
@@ -597,7 +1189,21 @@ C<fallback> is present (possibly undefined). This may create
interesting effects if some package is not overloaded, but inherits
from two overloaded packages.
-This document is confusing.
+Relation between overloading and tie()ing is broken. Overloading is
+triggered or not basing on the I<previous> class of tie()d value.
+
+This happens because the presence of overloading is checked too early,
+before any tie()d access is attempted. If the FETCH()ed class of the
+tie()d value does not change, a simple workaround is to access the value
+immediately after tie()ing, so that after this call the I<previous> class
+coincides with the current one.
+
+B<Needed:> a way to fix this without a speed penalty.
+
+Barewords are not covered by overloaded string constants.
+
+This document is confusing. There are grammos and misleading language
+used in places. It would seem a total rewrite is needed.
=cut
diff --git a/gnu/usr.bin/perl/lib/perl5db.pl b/gnu/usr.bin/perl/lib/perl5db.pl
index d5dbfbdd68b..4d05e6d9307 100644
--- a/gnu/usr.bin/perl/lib/perl5db.pl
+++ b/gnu/usr.bin/perl/lib/perl5db.pl
@@ -2,7 +2,7 @@ package DB;
# Debugger for Perl 5.00x; perl5db.pl patch level:
-$VERSION = 1.01;
+$VERSION = 1.0402;
$header = "perl5db.pl version $VERSION";
# Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
@@ -173,26 +173,30 @@ $trace = $signal = $single = 0; # Uninitialized warning suppression
# (local $^W cannot help - other packages!).
$inhibit_exit = $option{PrintRet} = 1;
-@options = qw(hashDepth arrayDepth DumpDBFiles DumpPackages
+@options = qw(hashDepth arrayDepth DumpDBFiles DumpPackages DumpReused
compactDump veryCompact quote HighBit undefPrint
globPrint PrintRet UsageOnly frame AutoTrace
TTY noTTY ReadLine NonStop LineInfo maxTraceLen
recallCommand ShellBang pager tkRunning ornaments
- signalLevel warnLevel dieLevel inhibit_exit);
+ signalLevel warnLevel dieLevel inhibit_exit
+ ImmediateStop bareStringify);
%optionVars = (
hashDepth => \$dumpvar::hashDepth,
arrayDepth => \$dumpvar::arrayDepth,
DumpDBFiles => \$dumpvar::dumpDBFiles,
DumpPackages => \$dumpvar::dumpPackages,
+ DumpReused => \$dumpvar::dumpReused,
HighBit => \$dumpvar::quoteHighBit,
undefPrint => \$dumpvar::printUndef,
globPrint => \$dumpvar::globPrint,
UsageOnly => \$dumpvar::usageOnly,
+ bareStringify => \$dumpvar::bareStringify,
frame => \$frame,
AutoTrace => \$trace,
inhibit_exit => \$inhibit_exit,
maxTraceLen => \$maxtrace,
+ ImmediateStop => \$ImmediateStop,
);
%optionAction = (
@@ -231,7 +235,11 @@ $pretype = [] unless defined $pretype;
warnLevel($warnLevel);
dieLevel($dieLevel);
signalLevel($signalLevel);
-&pager(defined($ENV{PAGER}) ? $ENV{PAGER} : "|more") unless defined $pager;
+&pager((defined($ENV{PAGER})
+ ? $ENV{PAGER}
+ : ($^O eq 'os2'
+ ? 'cmd /c more'
+ : 'more'))) unless defined $pager;
&recallCommand("!") unless defined $prc;
&shellBang("!") unless defined $psh;
$maxtrace = 400 unless defined $maxtrace;
@@ -290,7 +298,7 @@ if ($notty) {
if (-e "/dev/tty") {
$console = "/dev/tty";
- } elsif (-e "con" or $^O eq 'MSWin32') {
+ } elsif ($^O eq 'dos' or -e "con" or $^O eq 'MSWin32') {
$console = "con";
} else {
$console = "sys\$command";
@@ -357,18 +365,21 @@ sub DB {
# _After_ the perl program is compiled, $single is set to 1:
if ($single and not $second_time++) {
if ($runnonstop) { # Disable until signal
- for ($i=0; $i <= $#stack; ) {
+ for ($i=0; $i <= $stack_depth; ) {
$stack[$i++] &= ~1;
}
$single = 0;
# return; # Would not print trace!
+ } elsif ($ImmediateStop) {
+ $ImmediateStop = 0;
+ $signal = 1;
}
}
$runnonstop = 0 if $single or $signal; # Disable it if interactive.
&save;
($package, $filename, $line) = caller;
$filename_ini = $filename;
- $usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' .
+ $usercontext = '($@, $!, $^E, $,, $/, $\, $^W) = @saved;' .
"package $package;"; # this won't let them modify, alas
local(*dbline) = $main::{'_<' . $filename};
$max = $#dbline;
@@ -376,17 +387,48 @@ sub DB {
if ($stop eq '1') {
$signal |= 1;
} elsif ($stop) {
- $evalarg = "\$DB::signal |= do {$stop;}"; &eval;
+ $evalarg = "\$DB::signal |= 1 if do {$stop}"; &eval;
$dbline{$line} =~ s/;9($|\0)/$1/;
}
}
my $was_signal = $signal;
+ if ($trace & 2) {
+ for (my $n = 0; $n <= $#to_watch; $n++) {
+ $evalarg = $to_watch[$n];
+ local $onetimeDump; # Do not output results
+ my ($val) = &eval; # Fix context (&eval is doing array)?
+ $val = ( (defined $val) ? "'$val'" : 'undef' );
+ if ($val ne $old_watch[$n]) {
+ $signal = 1;
+ print $OUT <<EOP;
+Watchpoint $n:\t$to_watch[$n] changed:
+ old value:\t$old_watch[$n]
+ new value:\t$val
+EOP
+ $old_watch[$n] = $val;
+ }
+ }
+ }
+ if ($trace & 4) { # User-installed watch
+ return if watchfunction($package, $filename, $line)
+ and not $single and not $was_signal and not ($trace & ~4);
+ }
+ $was_signal = $signal;
$signal = 0;
- if ($single || $trace || $was_signal) {
- $term || &setterm;
+ if ($single || ($trace & 1) || $was_signal) {
if ($emacs) {
$position = "\032\032$filename:$line:0\n";
print $LINEINFO $position;
+ } elsif ($package eq 'DB::fake') {
+ $term || &setterm;
+ print_help(<<EOP);
+Debugged program terminated. Use B<q> to quit or B<R> to restart,
+ use B<O> I<inhibit_exit> to avoid stopping after program termination,
+ B<h q>, B<h R> or B<h O> to get additional info.
+EOP
+ $package = 'main';
+ $usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' .
+ "package $package;"; # this won't let them modify, alas
} else {
$sub =~ s/\'/::/;
$prefix = $sub =~ /::/ ? "" : "${'package'}::";
@@ -401,7 +443,7 @@ sub DB {
$position = "$prefix$line$infix$dbline[$line]$after";
}
if ($frame) {
- print $LINEINFO ' ' x $#stack, "$line:\t$dbline[$line]$after";
+ print $LINEINFO ' ' x $stack_depth, "$line:\t$dbline[$line]$after";
} else {
print $LINEINFO $position;
}
@@ -412,7 +454,7 @@ sub DB {
$incr_pos = "$prefix$i$infix$dbline[$i]$after";
$position .= $incr_pos;
if ($frame) {
- print $LINEINFO ' ' x $#stack, "$i:\t$dbline[$i]$after";
+ print $LINEINFO ' ' x $stack_depth, "$i:\t$dbline[$i]$after";
} else {
print $LINEINFO $incr_pos;
}
@@ -425,7 +467,7 @@ sub DB {
foreach $evalarg (@$pre) {
&eval;
}
- print $OUT $#stack . " levels deep in subroutine calls!\n"
+ print $OUT $stack_depth . " levels deep in subroutine calls!\n"
if $single & 4;
$start = $line;
$incr = -1; # for backward motion.
@@ -449,24 +491,25 @@ sub DB {
eval "\$cmd =~ $alias{$i}", print $OUT $@ if $alias{$i};
$cmd =~ /^q$/ && ($exiting = 1) && exit 0;
$cmd =~ /^h$/ && do {
- print $OUT $help;
+ print_help($help);
next CMD; };
$cmd =~ /^h\s+h$/ && do {
- print $OUT $summary;
+ print_help($summary);
next CMD; };
$cmd =~ /^h\s+(\S)$/ && do {
my $asked = "\Q$1";
- if ($help =~ /^$asked/m) {
- while ($help =~ /^($asked([\s\S]*?)\n)(\Z|[^\s$asked])/mg) {
- print $OUT $1;
+ if ($help =~ /^(?:[IB]<)$asked/m) {
+ while ($help =~ /^((?:[IB]<)$asked([\s\S]*?)\n)(?!\s)/mg) {
+ print_help($1);
}
} else {
- print $OUT "`$asked' is not a debugger command.\n";
+ print_help("B<$asked> is not a debugger command.\n");
}
next CMD; };
$cmd =~ /^t$/ && do {
- $trace = !$trace;
- print $OUT "Trace = ".($trace?"on":"off")."\n";
+ ($trace & 1) ? ($trace &= ~1) : ($trace |= 1);
+ print $OUT "Trace = " .
+ (($trace & 1) ? "on" : "off" ) . "\n";
next CMD; };
$cmd =~ /^S(\s+(!)?(.+))?$/ && do {
$Srev = defined $2; $Spatt = $3; $Snocheck = ! defined $1;
@@ -601,8 +644,9 @@ sub DB {
$arrow .= 'b' if $stop;
$arrow .= 'a' if $action;
print $OUT "$i$arrow\t", $dbline[$i];
- last if $signal;
+ $i++, last if $signal;
}
+ print $OUT "\n" unless $dbline[$i-1] =~ /\n$/;
}
$start = $i; # remember in case they want more
$start = $max if $start > $max;
@@ -686,6 +730,14 @@ sub DB {
last if $signal;
}
}
+ if ($trace & 2) {
+ print $OUT "Watch-expressions:\n";
+ my $expr;
+ for $expr (@to_watch) {
+ print $OUT " $expr\n";
+ last if $signal;
+ }
+ }
next CMD; };
$cmd =~ /^b\b\s*load\b\s*(.*)/ && do {
my $file = $1; $file =~ s/\s+$//;
@@ -832,14 +884,14 @@ sub DB {
}
$dbline{$i} =~ s/($|\0)/;9$1/; # add one-time-only b.p.
}
- for ($i=0; $i <= $#stack; ) {
+ for ($i=0; $i <= $stack_depth; ) {
$stack[$i++] &= ~1;
}
last CMD; };
$cmd =~ /^r$/ && do {
end_report(), next CMD if $finished and $level <= 1;
- $stack[$#stack] |= 1;
- $doret = $option{PrintRet} ? $#stack - 1 : -2;
+ $stack[$stack_depth] |= 1;
+ $doret = $option{PrintRet} ? $stack_depth - 1 : -2;
last CMD; };
$cmd =~ /^R$/ && do {
print $OUT "Warning: some settings and command-line options may be lost!\n";
@@ -925,6 +977,18 @@ sub DB {
$cmd =~ /^T$/ && do {
print_trace($OUT, 1); # skip DB
next CMD; };
+ $cmd =~ /^W\s*$/ && do {
+ $trace &= ~2;
+ @to_watch = @old_watch = ();
+ next CMD; };
+ $cmd =~ /^W\b\s*(.*)/s && do {
+ push @to_watch, $1;
+ $evalarg = $1;
+ my ($val) = &eval;
+ $val = (defined $val) ? "'$val'" : 'undef' ;
+ push @old_watch, $val;
+ $trace |= 2;
+ next CMD; };
$cmd =~ /^\/(.*)$/ && do {
$inpat = $1;
$inpat =~ s:([^\\])/$:$1:;
@@ -986,7 +1050,7 @@ sub DB {
$cmd =~ /^$rc+\s*(-)?(\d+)?$/ && do {
pop(@hist) if length($cmd) > 1;
$i = $1 ? ($#hist-($2?$2:1)) : ($2?$2:$#hist);
- $cmd = $hist[$i] . "\n";
+ $cmd = $hist[$i];
print $OUT $cmd;
redo CMD; };
$cmd =~ /^$sh$sh\s*([\x00-\xff]*)/ && do {
@@ -1002,7 +1066,7 @@ sub DB {
print $OUT "No such command!\n\n";
next CMD;
}
- $cmd = $hist[$i] . "\n";
+ $cmd = $hist[$i];
print $OUT $cmd;
redo CMD; };
$cmd =~ /^$sh$/ && do {
@@ -1062,7 +1126,7 @@ sub DB {
$cmd =~ s/^\|+\s*//;
redo PIPE; };
# XXX Local variants do not work!
- $cmd =~ s/^t\s/\$DB::trace = 1;\n/;
+ $cmd =~ s/^t\s/\$DB::trace |= 1;\n/;
$cmd =~ s/^s\s/\$DB::single = 1;\n/ && do {$laststep = 's'};
$cmd =~ s/^n\s/\$DB::single = 2;\n/ && do {$laststep = 'n'};
} # PIPE:
@@ -1098,7 +1162,7 @@ sub DB {
&eval;
}
} # if ($single || $signal)
- ($@, $!, $,, $/, $\, $^W) = @saved;
+ ($@, $!, $^E, $,, $/, $\, $^W) = @saved;
();
}
@@ -1110,24 +1174,30 @@ sub sub {
if (length($sub) > 10 && substr($sub, -10, 10) eq '::AUTOLOAD') {
$al = " for $$sub";
}
- push(@stack, $single);
+ local $stack_depth = $stack_depth + 1; # Protect from non-local exits
+ $#stack = $stack_depth;
+ $stack[-1] = $single;
$single &= 1;
- $single |= 4 if $#stack == $deep;
+ $single |= 4 if $stack_depth == $deep;
($frame & 4
- ? ( (print $LINEINFO ' ' x ($#stack - 1), "in "),
+ ? ( (print $LINEINFO ' ' x ($stack_depth - 1), "in "),
# Why -1? But it works! :-(
print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
- : print $LINEINFO ' ' x ($#stack - 1), "entering $sub$al\n") if $frame;
+ : print $LINEINFO ' ' x ($stack_depth - 1), "entering $sub$al\n") if $frame;
if (wantarray) {
@ret = &$sub;
- $single |= pop(@stack);
+ $single |= $stack[$stack_depth--];
($frame & 4
- ? ( (print $LINEINFO ' ' x $#stack, "out "),
+ ? ( (print $LINEINFO ' ' x $stack_depth, "out "),
print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
- : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2;
- print ($OUT ($frame & 16 ? ' ' x $#stack : ""),
- "list context return from $sub:\n"), dumpit( \@ret ),
- $doret = -2 if $doret eq $#stack or $frame & 16;
+ : print $LINEINFO ' ' x $stack_depth, "exited $sub$al\n") if $frame & 2;
+ if ($doret eq $stack_depth or $frame & 16) {
+ my $fh = ($doret eq $stack_depth ? $OUT : $LINEINFO);
+ print $fh ' ' x $stack_depth if $frame & 16;
+ print $fh "list context return from $sub:\n";
+ dumpit($fh, \@ret );
+ $doret = -2;
+ }
@ret;
} else {
if (defined wantarray) {
@@ -1135,20 +1205,26 @@ sub sub {
} else {
&$sub; undef $ret;
};
- $single |= pop(@stack);
+ $single |= $stack[$stack_depth--];
($frame & 4
- ? ( (print $LINEINFO ' ' x $#stack, "out "),
+ ? ( (print $LINEINFO ' ' x $stack_depth, "out "),
print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
- : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2;
- print ($OUT ($frame & 16 ? ' ' x $#stack : ""),
- "scalar context return from $sub: "), dumpit( $ret ),
- $doret = -2 if $doret eq $#stack or $frame & 16;
+ : print $LINEINFO ' ' x $stack_depth, "exited $sub$al\n") if $frame & 2;
+ if ($doret eq $stack_depth or $frame & 16 and defined wantarray) {
+ my $fh = ($doret eq $stack_depth ? $OUT : $LINEINFO);
+ print $fh (' ' x $stack_depth) if $frame & 16;
+ print $fh (defined wantarray
+ ? "scalar context return from $sub: "
+ : "void context return from $sub\n");
+ dumpit( $fh, $ret ) if defined wantarray;
+ $doret = -2;
+ }
$ret;
}
}
sub save {
- @saved = ($@, $!, $,, $/, $\, $^W);
+ @saved = ($@, $!, $^E, $,, $/, $\, $^W);
$, = ""; $/ = "\n"; $\ = ""; $^W = 0;
}
@@ -1157,7 +1233,6 @@ sub save {
sub eval {
my @res;
{
- local (@stack) = @stack; # guard against recursive debugging
my $otrace = $trace;
my $osingle = $single;
my $od = $^D;
@@ -1168,14 +1243,15 @@ sub eval {
}
my $at = $@;
local $saved[0]; # Preserve the old value of $@
- eval "&DB::save";
+ eval { &DB::save };
if ($at) {
print $OUT $at;
} elsif ($onetimeDump eq 'dump') {
- dumpit(\@res);
+ dumpit($OUT, \@res);
} elsif ($onetimeDump eq 'methods') {
methods($res[0]);
}
+ @res;
}
sub postponed_sub {
@@ -1202,6 +1278,10 @@ sub postponed_sub {
}
sub postponed {
+ if ($ImmediateStop) {
+ $ImmediateStop = 0;
+ $signal = 1;
+ }
return &postponed_sub
unless ref \$_[0] eq 'GLOB'; # A subroutine is compiled.
# Cannot be done before the file is compiled
@@ -1210,7 +1290,7 @@ sub postponed {
$filename =~ s/^_<//;
$signal = 1, print $OUT "'$filename' loaded...\n"
if $break_on_load{$filename};
- print $LINEINFO ' ' x $#stack, "Package $filename.\n" if $frame;
+ print $LINEINFO ' ' x $stack_depth, "Package $filename.\n" if $frame;
return unless $postponed_file{$filename};
$had_breakpoints{$filename}++;
#%dbline = %{$postponed_file{$filename}}; # Cannot be done: unsufficient magic
@@ -1222,7 +1302,7 @@ sub postponed {
}
sub dumpit {
- local ($savout) = select($OUT);
+ local ($savout) = select(shift);
my $osingle = $single;
my $otrace = $trace;
$single = $trace = 0;
@@ -1303,7 +1383,7 @@ sub dump_trace {
push(@a, $_);
}
}
- $context = $context ? '@' : "\$";
+ $context = $context ? '@' : (defined $context ? "\$" : '.');
$args = $h ? [@a] : undef;
$e =~ s/\n\s*\;\s*\Z// if $e;
$e =~ s/([\\\'])/\\$1/g if $e;
@@ -1342,7 +1422,7 @@ sub system {
# We save, change, then restore STDIN and STDOUT to avoid fork() since
# many non-Unix systems can do system() but have problems with fork().
open(SAVEIN,"<&STDIN") || &warn("Can't save STDIN");
- open(SAVEOUT,">&OUT") || &warn("Can't save STDOUT");
+ open(SAVEOUT,">&STDOUT") || &warn("Can't save STDOUT");
open(STDIN,"<&IN") || &warn("Can't redirect STDIN");
open(STDOUT,">&OUT") || &warn("Can't redirect STDOUT");
system(@_);
@@ -1358,7 +1438,6 @@ sub system {
sub setterm {
local $frame = 0;
local $doret = -2;
- local @stack = @stack; # Prevent growth by failing `use'.
eval { require Term::ReadLine } or die $@;
if ($notty) {
if ($tty) {
@@ -1417,8 +1496,14 @@ sub resetterm { # We forked, so we need a different TTY
TTY($fork_TTY);
undef $fork_TTY;
} else {
- print $OUT "Forked, but do not know how to change a TTY.\n",
- "Define \$DB::fork_TTY or get_fork_TTY().\n";
+ print_help(<<EOP);
+I<#########> Forked, but do not know how to change a B<TTY>. I<#########>
+ Define B<\$DB::fork_TTY>
+ - or a function B<DB::get_fork_TTY()> which will set B<\$DB::fork_TTY>.
+ The value of B<\$DB::fork_TTY> should be the name of I<TTY> to use.
+ On I<UNIX>-like systems one can get the name of a I<TTY> for the given window
+ by typing B<tty>, and disconnect the I<shell> from I<TTY> by B<sleep 1000000>.
+EOP
}
}
@@ -1667,146 +1752,155 @@ sub list_versions {
}
$version{$file} .= $INC{$file};
}
- do 'dumpvar.pl' unless defined &main::dumpValue;
- if (defined &main::dumpValue) {
- local $frame = 0;
- &main::dumpValue(\%version);
- } else {
- print $OUT "dumpvar.pl not available.\n";
- }
+ dumpit($OUT,\%version);
}
sub sethelp {
$help = "
-T Stack trace.
-s [expr] Single step [in expr].
-n [expr] Next, steps over subroutine calls [in expr].
-<CR> Repeat last n or s command.
-r Return from current subroutine.
-c [line|sub] Continue; optionally inserts a one-time-only breakpoint
+B<T> Stack trace.
+B<s> [I<expr>] Single step [in I<expr>].
+B<n> [I<expr>] Next, steps over subroutine calls [in I<expr>].
+<B<CR>> Repeat last B<n> or B<s> command.
+B<r> Return from current subroutine.
+B<c> [I<line>|I<sub>] Continue; optionally inserts a one-time-only breakpoint
at the specified position.
-l min+incr List incr+1 lines starting at min.
-l min-max List lines min through max.
-l line List single line.
-l subname List first window of lines from subroutine.
-l List next window of lines.
-- List previous window of lines.
-w [line] List window around line.
-. Return to the executed line.
-f filename Switch to viewing filename. Must be loaded.
-/pattern/ Search forwards for pattern; final / is optional.
-?pattern? Search backwards for pattern; final ? is optional.
-L List all breakpoints and actions.
-S [[!]pattern] List subroutine names [not] matching pattern.
-t Toggle trace mode.
-t expr Trace through execution of expr.
-b [line] [condition]
- Set breakpoint; line defaults to the current execution line;
- condition breaks if it evaluates to true, defaults to '1'.
-b subname [condition]
+B<l> I<min>B<+>I<incr> List I<incr>+1 lines starting at I<min>.
+B<l> I<min>B<->I<max> List lines I<min> through I<max>.
+B<l> I<line> List single I<line>.
+B<l> I<subname> List first window of lines from subroutine.
+B<l> List next window of lines.
+B<-> List previous window of lines.
+B<w> [I<line>] List window around I<line>.
+B<.> Return to the executed line.
+B<f> I<filename> Switch to viewing I<filename>. Must be loaded.
+B</>I<pattern>B</> Search forwards for I<pattern>; final B</> is optional.
+B<?>I<pattern>B<?> Search backwards for I<pattern>; final B<?> is optional.
+B<L> List all breakpoints and actions.
+B<S> [[B<!>]I<pattern>] List subroutine names [not] matching I<pattern>.
+B<t> Toggle trace mode.
+B<t> I<expr> Trace through execution of I<expr>.
+B<b> [I<line>] [I<condition>]
+ Set breakpoint; I<line> defaults to the current execution line;
+ I<condition> breaks if it evaluates to true, defaults to '1'.
+B<b> I<subname> [I<condition>]
Set breakpoint at first line of subroutine.
-b load filename Set breakpoint on `require'ing the given file.
-b postpone subname [condition]
+B<b> B<load> I<filename> Set breakpoint on `require'ing the given file.
+B<b> B<postpone> I<subname> [I<condition>]
Set breakpoint at first line of subroutine after
it is compiled.
-b compile subname
+B<b> B<compile> I<subname>
Stop after the subroutine is compiled.
-d [line] Delete the breakpoint for line.
-D Delete all breakpoints.
-a [line] command
- Set an action to be done before the line is executed.
- Sequence is: check for breakpoint, print line if necessary,
- do action, prompt user if breakpoint or step, evaluate line.
-A Delete all actions.
-V [pkg [vars]] List some (default all) variables in package (default current).
- Use ~pattern and !pattern for positive and negative regexps.
-X [vars] Same as \"V currentpackage [vars]\".
-x expr Evals expression in array context, dumps the result.
-m expr Evals expression in array context, prints methods callable
+B<d> [I<line>] Delete the breakpoint for I<line>.
+B<D> Delete all breakpoints.
+B<a> [I<line>] I<command>
+ Set an action to be done before the I<line> is executed.
+ Sequence is: check for breakpoint/watchpoint, print line
+ if necessary, do action, prompt user if necessary,
+ execute expression.
+B<A> Delete all actions.
+B<W> I<expr> Add a global watch-expression.
+B<W> Delete all watch-expressions.
+B<V> [I<pkg> [I<vars>]] List some (default all) variables in package (default current).
+ Use B<~>I<pattern> and B<!>I<pattern> for positive and negative regexps.
+B<X> [I<vars>] Same as \"B<V> I<currentpackage> [I<vars>]\".
+B<x> I<expr> Evals expression in array context, dumps the result.
+B<m> I<expr> Evals expression in array context, prints methods callable
on the first element of the result.
-m class Prints methods callable via the given class.
-O [opt[=val]] [opt\"val\"] [opt?]...
- Set or query values of options. val defaults to 1. opt can
+B<m> I<class> Prints methods callable via the given class.
+B<O> [I<opt>[B<=>I<val>]] [I<opt>B<\">I<val>B<\">] [I<opt>B<?>]...
+ Set or query values of options. I<val> defaults to 1. I<opt> can
be abbreviated. Several options can be listed.
- recallCommand, ShellBang: chars used to recall command or spawn shell;
- pager: program for output of \"|cmd\";
- tkRunning: run Tk while prompting (with ReadLine);
- signalLevel warnLevel dieLevel: level of verbosity;
- inhibit_exit Allows stepping off the end of the script.
- The following options affect what happens with V, X, and x commands:
- arrayDepth, hashDepth: print only first N elements ('' for all);
- compactDump, veryCompact: change style of array and hash dump;
- globPrint: whether to print contents of globs;
- DumpDBFiles: dump arrays holding debugged files;
- DumpPackages: dump symbol tables of packages;
- quote, HighBit, undefPrint: change style of string dump;
- Option PrintRet affects printing of return value after r command,
- frame affects printing messages on entry and exit from subroutines.
- AutoTrace affects printing messages on every possible breaking point.
- maxTraceLen gives maximal length of evals/args listed in stack trace.
- ornaments affects screen appearance of the command line.
+ I<recallCommand>, I<ShellBang>: chars used to recall command or spawn shell;
+ I<pager>: program for output of \"|cmd\";
+ I<tkRunning>: run Tk while prompting (with ReadLine);
+ I<signalLevel> I<warnLevel> I<dieLevel>: level of verbosity;
+ I<inhibit_exit> Allows stepping off the end of the script.
+ I<ImmediateStop> Debugger should stop as early as possible.
+ The following options affect what happens with B<V>, B<X>, and B<x> commands:
+ I<arrayDepth>, I<hashDepth>: print only first N elements ('' for all);
+ I<compactDump>, I<veryCompact>: change style of array and hash dump;
+ I<globPrint>: whether to print contents of globs;
+ I<DumpDBFiles>: dump arrays holding debugged files;
+ I<DumpPackages>: dump symbol tables of packages;
+ I<DumpReused>: dump contents of \"reused\" addresses;
+ I<quote>, I<HighBit>, I<undefPrint>: change style of string dump;
+ I<bareStringify>: Do not print the overload-stringified value;
+ Option I<PrintRet> affects printing of return value after B<r> command,
+ I<frame> affects printing messages on entry and exit from subroutines.
+ I<AutoTrace> affects printing messages on every possible breaking point.
+ I<maxTraceLen> gives maximal length of evals/args listed in stack trace.
+ I<ornaments> affects screen appearance of the command line.
During startup options are initialized from \$ENV{PERLDB_OPTS}.
- You can put additional initialization options TTY, noTTY,
- ReadLine, and NonStop there (or use `R' after you set them).
-< command Define Perl command to run before each prompt.
-<< command Add to the list of Perl commands to run before each prompt.
-> command Define Perl command to run after each prompt.
->> command Add to the list of Perl commands to run after each prompt.
-\{ commandline Define debugger command to run before each prompt.
-\{{ commandline Add to the list of debugger commands to run before each prompt.
-$prc number Redo a previous command (default previous command).
-$prc -number Redo number'th-to-last command.
-$prc pattern Redo last command that started with pattern.
- See 'O recallCommand' too.
-$psh$psh cmd Run cmd in a subprocess (reads from DB::IN, writes to DB::OUT)"
+ You can put additional initialization options I<TTY>, I<noTTY>,
+ I<ReadLine>, and I<NonStop> there (or use `B<R>' after you set them).
+B<<> I<expr> Define Perl command to run before each prompt.
+B<<<> I<expr> Add to the list of Perl commands to run before each prompt.
+B<>> I<expr> Define Perl command to run after each prompt.
+B<>>B<>> I<expr> Add to the list of Perl commands to run after each prompt.
+B<{> I<db_command> Define debugger command to run before each prompt.
+B<{{> I<db_command> Add to the list of debugger commands to run before each prompt.
+B<$prc> I<number> Redo a previous command (default previous command).
+B<$prc> I<-number> Redo number'th-to-last command.
+B<$prc> I<pattern> Redo last command that started with I<pattern>.
+ See 'B<O> I<recallCommand>' too.
+B<$psh$psh> I<cmd> Run cmd in a subprocess (reads from DB::IN, writes to DB::OUT)"
. ( $rc eq $sh ? "" : "
-$psh [cmd] Run cmd in subshell (forces \"\$SHELL -c 'cmd'\")." ) . "
- See 'O shellBang' too.
-H -number Display last number commands (default all).
-p expr Same as \"print {DB::OUT} expr\" in current package.
-|dbcmd Run debugger command, piping DB::OUT to current pager.
-||dbcmd Same as |dbcmd but DB::OUT is temporarilly select()ed as well.
-\= [alias value] Define a command alias, or list current aliases.
-command Execute as a perl statement in current package.
-v Show versions of loaded modules.
-R Pure-man-restart of debugger, some of debugger state
+B<$psh> [I<cmd>] Run I<cmd> in subshell (forces \"\$SHELL -c 'cmd'\")." ) . "
+ See 'B<O> I<shellBang>' too.
+B<H> I<-number> Display last number commands (default all).
+B<p> I<expr> Same as \"I<print {DB::OUT} expr>\" in current package.
+B<|>I<dbcmd> Run debugger command, piping DB::OUT to current pager.
+B<||>I<dbcmd> Same as B<|>I<dbcmd> but DB::OUT is temporarilly select()ed as well.
+B<\=> [I<alias> I<value>] Define a command alias, or list current aliases.
+I<command> Execute as a perl statement in current package.
+B<v> Show versions of loaded modules.
+B<R> Pure-man-restart of debugger, some of debugger state
and command-line options may be lost.
Currently the following setting are preserved:
- history, breakpoints and actions, debugger Options
- and the following command-line options: -w, -I, -e.
-h [db_command] Get help [on a specific debugger command], enter |h to page.
-h h Summary of debugger commands.
-q or ^D Quit. Set \$DB::finished to 0 to debug global destruction.
+ history, breakpoints and actions, debugger B<O>ptions
+ and the following command-line options: I<-w>, I<-I>, I<-e>.
+B<h> [I<db_command>] Get help [on a specific debugger command], enter B<|h> to page.
+B<h h> Summary of debugger commands.
+B<q> or B<^D> Quit. Set B<\$DB::finished = 0> to debug global destruction.
";
$summary = <<"END_SUM";
-List/search source lines: Control script execution:
- l [ln|sub] List source code T Stack trace
- - or . List previous/current line s [expr] Single step [in expr]
- w [line] List around line n [expr] Next, steps over subs
- f filename View source in file <CR> Repeat last n or s
- /pattern/ ?patt? Search forw/backw r Return from subroutine
- v Show versions of modules c [ln|sub] Continue until position
-Debugger controls: L List break pts & actions
- O [...] Set debugger options t [expr] Toggle trace [trace expr]
- <[<] or {[{] [cmd] Do before prompt b [ln/event] [c] Set breakpoint
- >[>] [cmd] Do after prompt b sub [c] Set breakpoint for sub
- $prc [N|pat] Redo a previous command d [line] Delete a breakpoint
- H [-num] Display last num commands D Delete all breakpoints
- = [a val] Define/list an alias a [ln] cmd Do cmd before line
- h [db_cmd] Get help on command A Delete all actions
- |[|]dbcmd Send output to pager $psh\[$psh\] syscmd Run cmd in a subprocess
- q or ^D Quit R Attempt a restart
-Data Examination: expr Execute perl code, also see: s,n,t expr
- x|m expr Evals expr in array context, dumps the result or lists methods.
- p expr Print expression (uses script's current package).
- S [[!]pat] List subroutine names [not] matching pattern
- V [Pk [Vars]] List Variables in Package. Vars can be ~pattern or !pattern.
- X [Vars] Same as \"V current_package [Vars]\".
+I<List/search source lines:> I<Control script execution:>
+ B<l> [I<ln>|I<sub>] List source code B<T> Stack trace
+ B<-> or B<.> List previous/current line B<s> [I<expr>] Single step [in expr]
+ B<w> [I<line>] List around line B<n> [I<expr>] Next, steps over subs
+ B<f> I<filename> View source in file <B<CR>> Repeat last B<n> or B<s>
+ B</>I<pattern>B</> B<?>I<patt>B<?> Search forw/backw B<r> Return from subroutine
+ B<v> Show versions of modules B<c> [I<ln>|I<sub>] Continue until position
+I<Debugger controls:> B<L> List break/watch/actions
+ B<O> [...] Set debugger options B<t> [I<expr>] Toggle trace [trace expr]
+ B<<>[B<<>] or B<{>[B<{>] [I<cmd>] Do before prompt B<b> [I<ln>|I<event>] [I<cnd>] Set breakpoint
+ B<>>[B<>>] [I<cmd>] Do after prompt B<b> I<sub> [I<cnd>] Set breakpoint for sub
+ B<$prc> [I<N>|I<pat>] Redo a previous command B<d> [I<ln>] or B<D> Delete a/all breakpoints
+ B<H> [I<-num>] Display last num commands B<a> [I<ln>] I<cmd> Do cmd before line
+ B<=> [I<a> I<val>] Define/list an alias B<W> I<expr> Add a watch expression
+ B<h> [I<db_cmd>] Get help on command B<A> or B<W> Delete all actions/watch
+ B<|>[B<|>]I<dbcmd> Send output to pager B<$psh>\[B<$psh>\] I<syscmd> Run cmd in a subprocess
+ B<q> or B<^D> Quit B<R> Attempt a restart
+I<Data Examination:> B<expr> Execute perl code, also see: B<s>,B<n>,B<t> I<expr>
+ B<x>|B<m> I<expr> Evals expr in array context, dumps the result or lists methods.
+ B<p> I<expr> Print expression (uses script's current package).
+ B<S> [[B<!>]I<pat>] List subroutine names [not] matching pattern
+ B<V> [I<Pk> [I<Vars>]] List Variables in Package. Vars can be ~pattern or !pattern.
+ B<X> [I<Vars>] Same as \"B<V> I<current_package> [I<Vars>]\".
END_SUM
# ')}}; # Fix balance of Emacs parsing
}
+sub print_help {
+ my $message = shift;
+ if (@Term::ReadLine::TermCap::rl_term_set) {
+ $message =~ s/B<([^>]+|>)>/$Term::ReadLine::TermCap::rl_term_set[2]$1$Term::ReadLine::TermCap::rl_term_set[3]/g;
+ $message =~ s/I<([^>]+|>)>/$Term::ReadLine::TermCap::rl_term_set[0]$1$Term::ReadLine::TermCap::rl_term_set[1]/g;
+ }
+ print $OUT $message;
+}
+
sub diesignal {
local $frame = 0;
local $doret = -2;
@@ -1978,6 +2072,7 @@ BEGIN { # This does not compile, alas.
# @stack and $doret are needed in sub sub, which is called for DB::postponed.
# Triggers bug (?) in perl is we postpone this until runtime:
@postponed = @stack = (0);
+ $stack_depth = 0; # Localized $#stack
$doret = -2;
$frame = 0;
}
diff --git a/gnu/usr.bin/perl/lib/strict.pm b/gnu/usr.bin/perl/lib/strict.pm
index 8492e933fd6..940e8bf7ff3 100644
--- a/gnu/usr.bin/perl/lib/strict.pm
+++ b/gnu/usr.bin/perl/lib/strict.pm
@@ -38,6 +38,7 @@ use symbolic references (see L<perlref>).
=item C<strict vars>
This generates a compile-time error if you access a variable that wasn't
+declared via C<use vars>,
localized via C<my()> or wasn't fully qualified. Because this is to avoid
variable suicide problems and subtle dynamic scoping issues, a merely
local() variable isn't good enough. See L<perlfunc/my> and
@@ -48,6 +49,10 @@ L<perlfunc/local>.
my $foo = 10; # ok, my() var
local $foo = 9; # blows up
+ package Cinna;
+ use vars qw/ $bar /; # Declares $bar in current package
+ $bar = 'HgS'; # ok, global declared via pragma
+
The local() generated a compile-time error because you just touched a global
name without fully qualifying it.
@@ -67,19 +72,22 @@ appears in curly braces or on the left hand side of the "=E<gt>" symbol.
=back
-See L<perlmod/Pragmatic Modules>.
+See L<perlmodlib/Pragmatic Modules>.
=cut
+$strict::VERSION = "1.01";
+
+my %bitmask = (
+refs => 0x00000002,
+subs => 0x00000200,
+vars => 0x00000400
+);
+
sub bits {
my $bits = 0;
- my $sememe;
- foreach $sememe (@_) {
- $bits |= 0x00000002, next if $sememe eq 'refs';
- $bits |= 0x00000200, next if $sememe eq 'subs';
- $bits |= 0x00000400, next if $sememe eq 'vars';
- }
+ foreach my $s (@_){ $bits |= $bitmask{$s} || 0; };
$bits;
}
diff --git a/gnu/usr.bin/perl/lib/subs.pm b/gnu/usr.bin/perl/lib/subs.pm
index 512bc9be9a5..aa332a67858 100644
--- a/gnu/usr.bin/perl/lib/subs.pm
+++ b/gnu/usr.bin/perl/lib/subs.pm
@@ -20,7 +20,7 @@ C<use subs> declarations are not BLOCK-scoped. They are thus effective
for the entire file in which they appear. You may not rescind such
declarations with C<no vars> or C<no subs>.
-See L<perlmod/Pragmatic Modules> and L<strict/strict subs>.
+See L<perlmodlib/Pragmatic Modules> and L<strict/strict subs>.
=cut
diff --git a/gnu/usr.bin/perl/lib/vars.pm b/gnu/usr.bin/perl/lib/vars.pm
index 5723ac6c2cb..334af9630ad 100644
--- a/gnu/usr.bin/perl/lib/vars.pm
+++ b/gnu/usr.bin/perl/lib/vars.pm
@@ -13,11 +13,20 @@ sub import {
my $callpack = caller;
my ($pack, @imports, $sym, $ch) = @_;
foreach $sym (@imports) {
- if ($sym =~ /::/) {
- require Carp;
- Carp::croak("Can't declare another package's variables");
- }
($ch, $sym) = unpack('a1a*', $sym);
+ if ($sym =~ tr/A-Za-Z_0-9//c) {
+ # time for a more-detailed check-up
+ if ($sym =~ /::/) {
+ require Carp;
+ Carp::croak("Can't declare another package's variables");
+ } elsif ($sym =~ /^\w+[[{].*[]}]$/) {
+ require Carp;
+ Carp::croak("Can't declare individual elements of hash or array");
+ } elsif ($^W and length($sym) == 1 and $sym !~ tr/a-zA-Z//) {
+ require Carp;
+ Carp::carp("No need to declare built-in vars");
+ }
+ }
*{"${callpack}::$sym"} =
( $ch eq "\$" ? \$ {"${callpack}::$sym"}
: $ch eq "\@" ? \@ {"${callpack}::$sym"}
@@ -26,7 +35,7 @@ sub import {
: $ch eq "\&" ? \& {"${callpack}::$sym"}
: do {
require Carp;
- Carp::croak("'$ch$sym' is not a valid variable name\n");
+ Carp::croak("'$ch$sym' is not a valid variable name");
});
}
};
@@ -61,6 +70,6 @@ outside of the package), it can act as an acceptable substitute by
pre-declaring global symbols, ensuring their availability to the
later-loaded routines.
-See L<perlmod/Pragmatic Modules>.
+See L<perlmodlib/Pragmatic Modules>.
=cut
diff --git a/gnu/usr.bin/perl/makedepend.SH b/gnu/usr.bin/perl/makedepend.SH
index 7a89fa98210..0f32da33c66 100644
--- a/gnu/usr.bin/perl/makedepend.SH
+++ b/gnu/usr.bin/perl/makedepend.SH
@@ -25,6 +25,7 @@ $startsh
# makedepend.SH
#
MAKE=$make
+trnl='$trnl'
!GROK!THIS!
$spitshell >>makedepend <<'!NO!SUBS!'
@@ -54,7 +55,7 @@ esac
# cppstdin wrapper script.
# Put .. and . first so that we pick up the present cppstdin, not
# an older one lying about in /usr/local/bin.
-PATH=".:..:$PATH"
+PATH=".$path_sep..$path_sep$PATH"
export PATH
$cat /dev/null >.deptmp
@@ -66,6 +67,7 @@ if test -f Makefile; then
# to be out of date. I don't know if OS/2 has touch, so do this:
case "$osname" in
os2) ;;
+ netbsd) ;;
*) $touch $firstmakefile ;;
esac
fi
@@ -94,9 +96,18 @@ esac
$test -d UU || mkdir UU
$MAKE clist || ($echo "Searching for .c files..."; \
- $echo *.c | $tr ' ' '\012' | $egrep -v '\*' >.clist)
+ $echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist)
for file in `$cat .clist`; do
# for file in `cat /dev/null`; do
+ if [ "$osname" = uwin ]; then
+ uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g"
+ else
+ if [ "$osname" = os2 ]; then
+ uwinfix="-e s,\\\\\\\\,/,g"
+ else
+ uwinfix=
+ fi
+ fi
case "$file" in
*.c) filebase=`basename $file .c` ;;
*.y) filebase=`basename $file .y` ;;
@@ -105,7 +116,7 @@ for file in `$cat .clist`; do
*/*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;;
*) finc= ;;
esac
- $echo "Finding dependencies for $filebase$obj_ext."
+ $echo "Finding dependencies for $filebase$_o."
( $echo "#line 1 \"$file\""; \
$sed -n <$file \
-e "/^${filebase}_init(/q" \
@@ -115,7 +126,7 @@ for file in `$cat .clist`; do
-e 's|\\$||' \
-e p \
-e '}' ) >UU/$file.c
- $cppstdin $finc -I/usr/local/include -I. $cppflags $cppminus <UU/$file.c |
+ $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c |
$sed \
-e '/^#.*<stdin>/d' \
-e '/^#.*"-"/d' \
@@ -125,23 +136,27 @@ for file in `$cat .clist`; do
-e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \
-e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \
-e 's|: \./|: |' \
- -e 's|\.c\.c|.c|' | \
+ -e 's|\.c\.c|.c|' $uwinfix | \
$uniq | $sort | $uniq >> .deptmp
done
$sed <$mf >$mf.new -e '1,/^# AUTOMATICALLY/!d'
$MAKE shlist || ($echo "Searching for .SH files..."; \
- $echo *.SH | $tr ' ' '\012' | $egrep -v '\*' >.shlist)
+ $echo *.SH | $tr ' ' $trnl | $egrep -v '\*' >.shlist)
# Now extract the dependencies on makedepend.SH and Makefile.SH
# (they should reside in the main Makefile):
+rm -f .shlist.old
mv .shlist .shlist.old
$egrep -v '^makedepend\.SH' <.shlist.old >.shlist
+rm -f .shlist.old
mv .shlist .shlist.old
$egrep -v '^Makefile\.SH' <.shlist.old >.shlist
+rm -f .shlist.old
mv .shlist .shlist.old
$egrep -v '^perl_exp\.SH' <.shlist.old >.shlist
+rm -f .shlist.old
mv .shlist .shlist.old
$egrep -v '^config_h\.SH' <.shlist.old >.shlist
rm .shlist.old
@@ -158,7 +173,7 @@ if $test -s .deptmp; then
>>$mf.new
else
$MAKE hlist || ($echo "Searching for .h files..."; \
- $echo *.h | $tr ' ' '\012' | $egrep -v '\*' >.hlist)
+ $echo *.h | $tr ' ' $trnl | $egrep -v '\*' >.hlist)
$echo "You don't seem to have a proper C preprocessor. Using grep instead."
$egrep '^#include ' `cat .clist` `cat .hlist` >.deptmp
$echo "Updating $mf..."
diff --git a/gnu/usr.bin/perl/malloc.c b/gnu/usr.bin/perl/malloc.c
index e8e9ca3eb12..eca7322a7d7 100644
--- a/gnu/usr.bin/perl/malloc.c
+++ b/gnu/usr.bin/perl/malloc.c
@@ -2,14 +2,161 @@
*
*/
-#if defined(PERL_CORE) && !defined(DEBUGGING_MSTATS)
-# define DEBUGGING_MSTATS
+/*
+ Here are some notes on configuring Perl's malloc.
+
+ There are two macros which serve as bulk disablers of advanced
+ features of this malloc: NO_FANCY_MALLOC, PLAIN_MALLOC (undef by
+ default). Look in the list of default values below to understand
+ their exact effect. Defining NO_FANCY_MALLOC returns malloc.c to the
+ state of the malloc in Perl 5.004. Additionally defining PLAIN_MALLOC
+ returns it to the state as of Perl 5.000.
+
+ Note that some of the settings below may be ignored in the code based
+ on values of other macros. The PERL_CORE symbol is only defined when
+ perl itself is being compiled (so malloc can make some assumptions
+ about perl's facilities being available to it).
+
+ Each config option has a short description, followed by its name,
+ default value, and a comment about the default (if applicable). Some
+ options take a precise value, while the others are just boolean.
+ The boolean ones are listed first.
+
+ # Enable code for an emergency memory pool in $^M. See perlvar.pod
+ # for a description of $^M.
+ PERL_EMERGENCY_SBRK (!PLAIN_MALLOC && PERL_CORE)
+
+ # Enable code for printing memory statistics.
+ DEBUGGING_MSTATS (!PLAIN_MALLOC && PERL_CORE)
+
+ # Move allocation info for small buckets into separate areas.
+ # Memory optimization (especially for small allocations, of the
+ # less than 64 bytes). Since perl usually makes a large number
+ # of small allocations, this is usually a win.
+ PACK_MALLOC (!PLAIN_MALLOC && !RCHECK)
+
+ # Add one page to big powers of two when calculating bucket size.
+ # This is targeted at big allocations, as are common in image
+ # processing.
+ TWO_POT_OPTIMIZE !PLAIN_MALLOC
+
+ # Use intermediate bucket sizes between powers-of-two. This is
+ # generally a memory optimization, and a (small) speed pessimization.
+ BUCKETS_ROOT2 !NO_FANCY_MALLOC
+
+ # Do not check small deallocations for bad free(). Memory
+ # and speed optimization, error reporting pessimization.
+ IGNORE_SMALL_BAD_FREE (!NO_FANCY_MALLOC && !RCHECK)
+
+ # Use table lookup to decide in which bucket a given allocation will go.
+ SMALL_BUCKET_VIA_TABLE !NO_FANCY_MALLOC
+
+ # Use a perl-defined sbrk() instead of the (presumably broken or
+ # missing) system-supplied sbrk().
+ USE_PERL_SBRK undef
+
+ # Use system malloc() (or calloc() etc.) to emulate sbrk(). Normally
+ # only used with broken sbrk()s.
+ PERL_SBRK_VIA_MALLOC undef
+
+ # Which allocator to use if PERL_SBRK_VIA_MALLOC
+ SYSTEM_ALLOC(a) malloc(a)
+
+ # Disable memory overwrite checking with DEBUGGING. Memory and speed
+ # optimization, error reporting pessimization.
+ NO_RCHECK undef
+
+ # Enable memory overwrite checking with DEBUGGING. Memory and speed
+ # pessimization, error reporting optimization
+ RCHECK (DEBUGGING && !NO_RCHECK)
+
+ # Failed allocations bigger than this size croak (if
+ # PERL_EMERGENCY_SBRK is enabled) without touching $^M. See
+ # perlvar.pod for a description of $^M.
+ BIG_SIZE (1<<16) # 64K
+
+ # Starting from this power of two, add an extra page to the
+ # size of the bucket. This enables optimized allocations of sizes
+ # close to powers of 2. Note that the value is indexed at 0.
+ FIRST_BIG_POW2 15 # 32K, 16K is used too often
+
+ # Estimate of minimal memory footprint. malloc uses this value to
+ # request the most reasonable largest blocks of memory from the system.
+ FIRST_SBRK (48*1024)
+
+ # Round up sbrk()s to multiples of this.
+ MIN_SBRK 2048
+
+ # Round up sbrk()s to multiples of this percent of footprint.
+ MIN_SBRK_FRAC 3
+
+ # Add this much memory to big powers of two to get the bucket size.
+ PERL_PAGESIZE 4096
+
+ # This many sbrk() discontinuities should be tolerated even
+ # from the start without deciding that sbrk() is usually
+ # discontinuous.
+ SBRK_ALLOW_FAILURES 3
+
+ # This many continuous sbrk()s compensate for one discontinuous one.
+ SBRK_FAILURE_PRICE 50
+
+ # Some configurations may ask for 12-byte-or-so allocations which
+ # require 8-byte alignment (?!). In such situation one needs to
+ # define this to disable 12-byte bucket (will increase memory footprint)
+ STRICT_ALIGNMENT undef
+
+ This implementation assumes that calling PerlIO_printf() does not
+ result in any memory allocation calls (used during a panic).
+
+ */
+
+#ifndef NO_FANCY_MALLOC
+# ifndef SMALL_BUCKET_VIA_TABLE
+# define SMALL_BUCKET_VIA_TABLE
+# endif
+# ifndef BUCKETS_ROOT2
+# define BUCKETS_ROOT2
+# endif
+# ifndef IGNORE_SMALL_BAD_FREE
+# define IGNORE_SMALL_BAD_FREE
+# endif
#endif
+#ifndef PLAIN_MALLOC /* Bulk enable features */
+# ifndef PACK_MALLOC
+# define PACK_MALLOC
+# endif
+# ifndef TWO_POT_OPTIMIZE
+# define TWO_POT_OPTIMIZE
+# endif
+# if defined(PERL_CORE) && !defined(PERL_EMERGENCY_SBRK)
+# define PERL_EMERGENCY_SBRK
+# endif
+# if defined(PERL_CORE) && !defined(DEBUGGING_MSTATS)
+# define DEBUGGING_MSTATS
+# endif
+#endif
+
+#define MIN_BUC_POW2 (sizeof(void*) > 4 ? 3 : 2) /* Allow for 4-byte arena. */
+#define MIN_BUCKET (MIN_BUC_POW2 * BUCKETS_PER_POW2)
+
+#if !(defined(I286) || defined(atarist) || defined(__MINT__))
+ /* take 2k unless the block is bigger than that */
+# define LOG_OF_MIN_ARENA 11
+#else
+ /* take 16k unless the block is bigger than that
+ (80286s like large segments!), probably good on the atari too */
+# define LOG_OF_MIN_ARENA 14
+#endif
+
#ifndef lint
# if defined(DEBUGGING) && !defined(NO_RCHECK)
# define RCHECK
# endif
+# if defined(RCHECK) && defined(IGNORE_SMALL_BAD_FREE)
+# undef IGNORE_SMALL_BAD_FREE
+# endif
/*
* malloc.c (Caltech) 2/21/82
* Chris Kingsley, kingsley@cit-20.
@@ -23,26 +170,87 @@
* but bombs when it runs out.
*/
-#include "EXTERN.h"
-#include "perl.h"
+#ifdef PERL_CORE
+# include "EXTERN.h"
+# include "perl.h"
+#else
+# ifdef PERL_FOR_X2P
+# include "../EXTERN.h"
+# include "../perl.h"
+# else
+# include <stdlib.h>
+# include <stdio.h>
+# include <memory.h>
+# define _(arg) arg
+# ifndef Malloc_t
+# define Malloc_t void *
+# endif
+# ifndef MEM_SIZE
+# define MEM_SIZE unsigned long
+# endif
+# ifndef LONG_MAX
+# define LONG_MAX 0x7FFFFFFF
+# endif
+# ifndef UV
+# define UV unsigned long
+# endif
+# ifndef caddr_t
+# define caddr_t char *
+# endif
+# ifndef Free_t
+# define Free_t void
+# endif
+# define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
+# define PerlEnv_getenv getenv
+# define PerlIO_printf fprintf
+# define PerlIO_stderr() stderr
+# endif
+# ifndef croak /* make depend */
+# define croak(mess, arg) warn((mess), (arg)); exit(1);
+# endif
+# ifndef warn
+# define warn(mess, arg) fprintf(stderr, (mess), (arg));
+# endif
+# ifdef DEBUG_m
+# undef DEBUG_m
+# endif
+# define DEBUG_m(a)
+# ifdef DEBUGGING
+# undef DEBUGGING
+# endif
+#endif
+
+#ifndef MUTEX_LOCK
+# define MUTEX_LOCK(l)
+#endif
+
+#ifndef MUTEX_UNLOCK
+# define MUTEX_UNLOCK(l)
+#endif
#ifdef DEBUGGING
-#undef DEBUG_m
-#define DEBUG_m(a) if (debug & 128) a
+# undef DEBUG_m
+# define DEBUG_m(a) if (PL_debug & 128) a
#endif
/* I don't much care whether these are defined in sys/types.h--LAW */
#define u_char unsigned char
#define u_int unsigned int
+
+#ifdef HAS_QUAD
+# define u_bigint UV /* Needs to eat *void. */
+#else /* needed? */
+# define u_bigint unsigned long /* Needs to eat *void. */
+#endif
+
#define u_short unsigned short
/* 286 and atarist like big chunks, which gives too much overhead. */
-#if (defined(RCHECK) || defined(I286) || defined(atarist)) && defined(PACK_MALLOC)
-#undef PACK_MALLOC
+#if (defined(RCHECK) || defined(I286) || defined(atarist) || defined(__MINT__)) && defined(PACK_MALLOC)
+# undef PACK_MALLOC
#endif
-
/*
* The description below is applicable if PACK_MALLOC is not defined.
*
@@ -74,79 +282,226 @@ union overhead {
};
#ifdef DEBUGGING
-static void botch _((char *s));
+static void botch _((char *diag, char *s));
#endif
static void morecore _((int bucket));
static int findbucket _((union overhead *freep, int srchlen));
+static void add_to_chain(void *p, MEM_SIZE size, MEM_SIZE chip);
#define MAGIC 0xff /* magic # on accounting info */
#define RMAGIC 0x55555555 /* magic # on range info */
+#define RMAGIC_C 0x55 /* magic # on range info */
+
#ifdef RCHECK
# define RSLOP sizeof (u_int)
# ifdef TWO_POT_OPTIMIZE
-# define MAX_SHORT_BUCKET 12
+# define MAX_SHORT_BUCKET (12 * BUCKETS_PER_POW2)
# else
-# define MAX_SHORT_BUCKET 13
+# define MAX_SHORT_BUCKET (13 * BUCKETS_PER_POW2)
# endif
#else
# define RSLOP 0
#endif
+#if !defined(PACK_MALLOC) && defined(BUCKETS_ROOT2)
+# undef BUCKETS_ROOT2
+#endif
+
+#ifdef BUCKETS_ROOT2
+# define BUCKET_TABLE_SHIFT 2
+# define BUCKET_POW2_SHIFT 1
+# define BUCKETS_PER_POW2 2
+#else
+# define BUCKET_TABLE_SHIFT MIN_BUC_POW2
+# define BUCKET_POW2_SHIFT 0
+# define BUCKETS_PER_POW2 1
+#endif
+
+#if !defined(MEM_ALIGNBYTES) || ((MEM_ALIGNBYTES > 4) && !defined(STRICT_ALIGNMENT))
+/* Figure out the alignment of void*. */
+struct aligner {
+ char c;
+ void *p;
+};
+# define ALIGN_SMALL ((int)((caddr_t)&(((struct aligner*)0)->p)))
+#else
+# define ALIGN_SMALL MEM_ALIGNBYTES
+#endif
+
+#define IF_ALIGN_8(yes,no) ((ALIGN_SMALL>4) ? (yes) : (no))
+
+#ifdef BUCKETS_ROOT2
+# define MAX_BUCKET_BY_TABLE 13
+static u_short buck_size[MAX_BUCKET_BY_TABLE + 1] =
+ {
+ 0, 0, 0, 0, 4, 4, 8, 12, 16, 24, 32, 48, 64, 80,
+ };
+# define BUCKET_SIZE(i) ((i) % 2 ? buck_size[i] : (1 << ((i) >> BUCKET_POW2_SHIFT)))
+# define BUCKET_SIZE_REAL(i) ((i) <= MAX_BUCKET_BY_TABLE \
+ ? buck_size[i] \
+ : ((1 << ((i) >> BUCKET_POW2_SHIFT)) \
+ - MEM_OVERHEAD(i) \
+ + POW2_OPTIMIZE_SURPLUS(i)))
+#else
+# define BUCKET_SIZE(i) (1 << ((i) >> BUCKET_POW2_SHIFT))
+# define BUCKET_SIZE_REAL(i) (BUCKET_SIZE(i) - MEM_OVERHEAD(i) + POW2_OPTIMIZE_SURPLUS(i))
+#endif
+
+
#ifdef PACK_MALLOC
-/*
- * In this case it is assumed that if we do sbrk() in 2K units, we
- * will get 2K aligned blocks. The bucket number of the given subblock is
- * on the boundary of 2K block which contains the subblock.
- * Several following bytes contain the magic numbers for the subblocks
- * in the block.
+/* In this case it is assumed that if we do sbrk() in 2K units, we
+ * will get 2K aligned arenas (at least after some initial
+ * alignment). The bucket number of the given subblock is on the start
+ * of 2K arena which contains the subblock. Several following bytes
+ * contain the magic numbers for the subblocks in the block.
*
* Sizes of chunks are powers of 2 for chunks in buckets <=
* MAX_PACKED, after this they are (2^n - sizeof(union overhead)) (to
* get alignment right).
*
- * We suppose that starts of all the chunks in a 2K block are in
- * different 2^n-byte-long chunks. If the top of the last chunk is
- * aligned on a boundary of 2K block, this means that
- * sizeof(union overhead)*"number of chunks" < 2^n, or
- * sizeof(union overhead)*2K < 4^n, or n > 6 + log2(sizeof()/2)/2, if a
- * chunk of size 2^n - overhead is used. Since this rules out n = 7
- * for 8 byte alignment, we specialcase allocation of the first of 16
- * 128-byte-long chunks.
+ * Consider an arena for 2^n with n>MAX_PACKED. We suppose that
+ * starts of all the chunks in a 2K arena are in different
+ * 2^n-byte-long chunks. If the top of the last chunk is aligned on a
+ * boundary of 2K block, this means that sizeof(union
+ * overhead)*"number of chunks" < 2^n, or sizeof(union overhead)*2K <
+ * 4^n, or n > 6 + log2(sizeof()/2)/2, since a chunk of size 2^n -
+ * overhead is used. Since this rules out n = 7 for 8 byte alignment,
+ * we specialcase allocation of the first of 16 128-byte-long chunks.
*
* Note that with the above assumption we automatically have enough
* place for MAGIC at the start of 2K block. Note also that we
- * overlay union overhead over the chunk, thus the start of the chunk
- * is immediately overwritten after freeing.
- */
-# define MAX_PACKED 6
-# define MAX_2_POT_ALGO ((1<<(MAX_PACKED + 1)) - M_OVERHEAD)
-# define TWOK_MASK ((1<<11) - 1)
-# define TWOK_MASKED(x) ((u_int)(x) & ~TWOK_MASK)
-# define TWOK_SHIFT(x) ((u_int)(x) & TWOK_MASK)
+ * overlay union overhead over the chunk, thus the start of small chunks
+ * is immediately overwritten after freeing. */
+# define MAX_PACKED_POW2 6
+# define MAX_PACKED (MAX_PACKED_POW2 * BUCKETS_PER_POW2 + BUCKET_POW2_SHIFT)
+# define MAX_POW2_ALGO ((1<<(MAX_PACKED_POW2 + 1)) - M_OVERHEAD)
+# define TWOK_MASK ((1<<LOG_OF_MIN_ARENA) - 1)
+# define TWOK_MASKED(x) ((u_bigint)(x) & ~TWOK_MASK)
+# define TWOK_SHIFT(x) ((u_bigint)(x) & TWOK_MASK)
# define OV_INDEXp(block) ((u_char*)(TWOK_MASKED(block)))
# define OV_INDEX(block) (*OV_INDEXp(block))
# define OV_MAGIC(block,bucket) (*(OV_INDEXp(block) + \
- (TWOK_SHIFT(block)>>(bucket + 3)) + \
- (bucket > MAX_NONSHIFT ? 1 : 0)))
+ (TWOK_SHIFT(block)>> \
+ (bucket>>BUCKET_POW2_SHIFT)) + \
+ (bucket >= MIN_NEEDS_SHIFT ? 1 : 0)))
+ /* A bucket can have a shift smaller than it size, we need to
+ shift its magic number so it will not overwrite index: */
+# ifdef BUCKETS_ROOT2
+# define MIN_NEEDS_SHIFT (7*BUCKETS_PER_POW2 - 1) /* Shift 80 greater than chunk 64. */
+# else
+# define MIN_NEEDS_SHIFT (7*BUCKETS_PER_POW2) /* Shift 128 greater than chunk 32. */
+# endif
# define CHUNK_SHIFT 0
-static u_char n_blks[11 - 3] = {224, 120, 62, 31, 16, 8, 4, 2};
-static u_short blk_shift[11 - 3] = {256, 128, 64, 32,
- 16*sizeof(union overhead),
- 8*sizeof(union overhead),
- 4*sizeof(union overhead),
- 2*sizeof(union overhead),
-# define MAX_NONSHIFT 2 /* Shift 64 greater than chunk 32. */
-};
+/* Number of active buckets of given ordinal. */
+#ifdef IGNORE_SMALL_BAD_FREE
+#define FIRST_BUCKET_WITH_CHECK (6 * BUCKETS_PER_POW2) /* 64 */
+# define N_BLKS(bucket) ( (bucket) < FIRST_BUCKET_WITH_CHECK \
+ ? ((1<<LOG_OF_MIN_ARENA) - 1)/BUCKET_SIZE(bucket) \
+ : n_blks[bucket] )
+#else
+# define N_BLKS(bucket) n_blks[bucket]
+#endif
+
+static u_short n_blks[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] =
+ {
+# if BUCKETS_PER_POW2==1
+ 0, 0,
+ (MIN_BUC_POW2==2 ? 384 : 0),
+ 224, 120, 62, 31, 16, 8, 4, 2
+# else
+ 0, 0, 0, 0,
+ (MIN_BUC_POW2==2 ? 384 : 0), (MIN_BUC_POW2==2 ? 384 : 0), /* 4, 4 */
+ 224, 149, 120, 80, 62, 41, 31, 25, 16, 16, 8, 8, 4, 4, 2, 2
+# endif
+ };
+
+/* Shift of the first bucket with the given ordinal inside 2K chunk. */
+#ifdef IGNORE_SMALL_BAD_FREE
+# define BLK_SHIFT(bucket) ( (bucket) < FIRST_BUCKET_WITH_CHECK \
+ ? ((1<<LOG_OF_MIN_ARENA) \
+ - BUCKET_SIZE(bucket) * N_BLKS(bucket)) \
+ : blk_shift[bucket])
+#else
+# define BLK_SHIFT(bucket) blk_shift[bucket]
+#endif
+
+static u_short blk_shift[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] =
+ {
+# if BUCKETS_PER_POW2==1
+ 0, 0,
+ (MIN_BUC_POW2==2 ? 512 : 0),
+ 256, 128, 64, 64, /* 8 to 64 */
+ 16*sizeof(union overhead),
+ 8*sizeof(union overhead),
+ 4*sizeof(union overhead),
+ 2*sizeof(union overhead),
+# else
+ 0, 0, 0, 0,
+ (MIN_BUC_POW2==2 ? 512 : 0), (MIN_BUC_POW2==2 ? 512 : 0),
+ 256, 260, 128, 128, 64, 80, 64, 48, /* 8 to 96 */
+ 16*sizeof(union overhead), 16*sizeof(union overhead),
+ 8*sizeof(union overhead), 8*sizeof(union overhead),
+ 4*sizeof(union overhead), 4*sizeof(union overhead),
+ 2*sizeof(union overhead), 2*sizeof(union overhead),
+# endif
+ };
#else /* !PACK_MALLOC */
# define OV_MAGIC(block,bucket) (block)->ov_magic
# define OV_INDEX(block) (block)->ov_index
# define CHUNK_SHIFT 1
+# define MAX_PACKED -1
#endif /* !PACK_MALLOC */
-# define M_OVERHEAD (sizeof(union overhead) + RSLOP)
+#define M_OVERHEAD (sizeof(union overhead) + RSLOP)
+
+#ifdef PACK_MALLOC
+# define MEM_OVERHEAD(bucket) \
+ (bucket <= MAX_PACKED ? 0 : M_OVERHEAD)
+# ifdef SMALL_BUCKET_VIA_TABLE
+# define START_SHIFTS_BUCKET ((MAX_PACKED_POW2 + 1) * BUCKETS_PER_POW2)
+# define START_SHIFT MAX_PACKED_POW2
+# ifdef BUCKETS_ROOT2 /* Chunks of size 3*2^n. */
+# define SIZE_TABLE_MAX 80
+# else
+# define SIZE_TABLE_MAX 64
+# endif
+static char bucket_of[] =
+ {
+# ifdef BUCKETS_ROOT2 /* Chunks of size 3*2^n. */
+ /* 0 to 15 in 4-byte increments. */
+ (sizeof(void*) > 4 ? 6 : 5), /* 4/8, 5-th bucket for better reports */
+ 6, /* 8 */
+ IF_ALIGN_8(8,7), 8, /* 16/12, 16 */
+ 9, 9, 10, 10, /* 24, 32 */
+ 11, 11, 11, 11, /* 48 */
+ 12, 12, 12, 12, /* 64 */
+ 13, 13, 13, 13, /* 80 */
+ 13, 13, 13, 13 /* 80 */
+# else /* !BUCKETS_ROOT2 */
+ /* 0 to 15 in 4-byte increments. */
+ (sizeof(void*) > 4 ? 3 : 2),
+ 3,
+ 4, 4,
+ 5, 5, 5, 5,
+ 6, 6, 6, 6,
+ 6, 6, 6, 6
+# endif /* !BUCKETS_ROOT2 */
+ };
+# else /* !SMALL_BUCKET_VIA_TABLE */
+# define START_SHIFTS_BUCKET MIN_BUCKET
+# define START_SHIFT (MIN_BUC_POW2 - 1)
+# endif /* !SMALL_BUCKET_VIA_TABLE */
+#else /* !PACK_MALLOC */
+# define MEM_OVERHEAD(bucket) M_OVERHEAD
+# ifdef SMALL_BUCKET_VIA_TABLE
+# undef SMALL_BUCKET_VIA_TABLE
+# endif
+# define START_SHIFTS_BUCKET MIN_BUCKET
+# define START_SHIFT (MIN_BUC_POW2 - 1)
+#endif /* !PACK_MALLOC */
/*
* Big allocations are often of the size 2^n bytes. To make them a
@@ -158,87 +513,156 @@ static u_short blk_shift[11 - 3] = {256, 128, 64, 32,
# ifndef PERL_PAGESIZE
# define PERL_PAGESIZE 4096
# endif
-# ifndef FIRST_BIG_TWO_POT
-# define FIRST_BIG_TWO_POT 14 /* 16K */
+# ifndef FIRST_BIG_POW2
+# define FIRST_BIG_POW2 15 /* 32K, 16K is used too often. */
# endif
-# define FIRST_BIG_BLOCK (1<<FIRST_BIG_TWO_POT) /* 16K */
+# define FIRST_BIG_BLOCK (1<<FIRST_BIG_POW2)
/* If this value or more, check against bigger blocks. */
# define FIRST_BIG_BOUND (FIRST_BIG_BLOCK - M_OVERHEAD)
/* If less than this value, goes into 2^n-overhead-block. */
# define LAST_SMALL_BOUND ((FIRST_BIG_BLOCK>>1) - M_OVERHEAD)
-#endif /* TWO_POT_OPTIMIZE */
+# define POW2_OPTIMIZE_ADJUST(nbytes) \
+ ((nbytes >= FIRST_BIG_BOUND) ? nbytes -= PERL_PAGESIZE : 0)
+# define POW2_OPTIMIZE_SURPLUS(bucket) \
+ ((bucket >= FIRST_BIG_POW2 * BUCKETS_PER_POW2) ? PERL_PAGESIZE : 0)
+
+#else /* !TWO_POT_OPTIMIZE */
+# define POW2_OPTIMIZE_ADJUST(nbytes)
+# define POW2_OPTIMIZE_SURPLUS(bucket) 0
+#endif /* !TWO_POT_OPTIMIZE */
+
+#if defined(HAS_64K_LIMIT) && defined(PERL_CORE)
+# define BARK_64K_LIMIT(what,nbytes,size) \
+ if (nbytes > 0xffff) { \
+ PerlIO_printf(PerlIO_stderr(), \
+ "%s too large: %lx\n", what, size); \
+ my_exit(1); \
+ }
+#else /* !HAS_64K_LIMIT || !PERL_CORE */
+# define BARK_64K_LIMIT(what,nbytes,size)
+#endif /* !HAS_64K_LIMIT || !PERL_CORE */
-#if defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)
+#ifndef MIN_SBRK
+# define MIN_SBRK 2048
+#endif
+
+#ifndef FIRST_SBRK
+# define FIRST_SBRK (48*1024)
+#endif
+
+/* Minimal sbrk in percents of what is already alloced. */
+#ifndef MIN_SBRK_FRAC
+# define MIN_SBRK_FRAC 3
+#endif
-#ifndef BIG_SIZE
-# define BIG_SIZE (1<<16) /* 64K */
+#ifndef SBRK_ALLOW_FAILURES
+# define SBRK_ALLOW_FAILURES 3
#endif
+#ifndef SBRK_FAILURE_PRICE
+# define SBRK_FAILURE_PRICE 50
+#endif
+
+#if defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)
+
+# ifndef BIG_SIZE
+# define BIG_SIZE (1<<16) /* 64K */
+# endif
+
+#ifdef MUTEX_INIT_CALLS_MALLOC
+# undef MUTEX_LOCK
+# define MUTEX_LOCK(m) STMT_START { if (*m) mutex_lock(*m); } STMT_END
+# undef MUTEX_UNLOCK
+# define MUTEX_UNLOCK(m) STMT_START { if (*m) mutex_unlock(*m); } STMT_END
+#endif
+
static char *emergency_buffer;
static MEM_SIZE emergency_buffer_size;
+static Malloc_t emergency_sbrk(MEM_SIZE size);
-static char *
-emergency_sbrk(size)
- MEM_SIZE size;
+static Malloc_t
+emergency_sbrk(MEM_SIZE size)
{
+ MEM_SIZE rsize = (((size - 1)>>LOG_OF_MIN_ARENA) + 1)<<LOG_OF_MIN_ARENA;
+
if (size >= BIG_SIZE) {
/* Give the possibility to recover: */
- die("Out of memory during request for %i bytes", size);
- /* croak may eat too much memory. */
+ MUTEX_UNLOCK(&PL_malloc_mutex);
+ croak("Out of memory during \"large\" request for %i bytes", size);
}
- if (!emergency_buffer) {
+ if (emergency_buffer_size >= rsize) {
+ char *old = emergency_buffer;
+
+ emergency_buffer_size -= rsize;
+ emergency_buffer += rsize;
+ return old;
+ } else {
+ dTHR;
/* First offense, give a possibility to recover by dieing. */
/* No malloc involved here: */
- GV **gvp = (GV**)hv_fetch(defstash, "^M", 2, 0);
+ GV **gvp = (GV**)hv_fetch(PL_defstash, "^M", 2, 0);
SV *sv;
char *pv;
-
- if (!gvp) gvp = (GV**)hv_fetch(defstash, "\015", 1, 0);
+ int have = 0;
+ STRLEN n_a;
+
+ if (emergency_buffer_size) {
+ add_to_chain(emergency_buffer, emergency_buffer_size, 0);
+ emergency_buffer_size = 0;
+ emergency_buffer = Nullch;
+ have = 1;
+ }
+ if (!gvp) gvp = (GV**)hv_fetch(PL_defstash, "\015", 1, 0);
if (!gvp || !(sv = GvSV(*gvp)) || !SvPOK(sv)
- || (SvLEN(sv) < (1<<11) - M_OVERHEAD))
+ || (SvLEN(sv) < (1<<LOG_OF_MIN_ARENA) - M_OVERHEAD)) {
+ if (have)
+ goto do_croak;
return (char *)-1; /* Now die die die... */
-
+ }
/* Got it, now detach SvPV: */
- pv = SvPV(sv, na);
+ pv = SvPV(sv, n_a);
/* Check alignment: */
- if (((u_int)(pv - M_OVERHEAD)) & ((1<<11) - 1)) {
+ if (((UV)(pv - sizeof(union overhead))) & ((1<<LOG_OF_MIN_ARENA) - 1)) {
PerlIO_puts(PerlIO_stderr(),"Bad alignment of $^M!\n");
return (char *)-1; /* die die die */
}
- emergency_buffer = pv - M_OVERHEAD;
- emergency_buffer_size = SvLEN(sv) + M_OVERHEAD;
+ emergency_buffer = pv - sizeof(union overhead);
+ emergency_buffer_size = malloced_size(pv) + M_OVERHEAD;
SvPOK_off(sv);
- SvREADONLY_on(sv);
- die("Out of memory!"); /* croak may eat too much memory. */
- }
- else if (emergency_buffer_size >= size) {
- emergency_buffer_size -= size;
- return emergency_buffer + emergency_buffer_size;
+ SvPVX(sv) = Nullch;
+ SvCUR(sv) = SvLEN(sv) = 0;
}
-
- return (char *)-1; /* poor guy... */
+ do_croak:
+ MUTEX_UNLOCK(&PL_malloc_mutex);
+ croak("Out of memory during request for %i bytes", size);
}
-#else /* !(defined(TWO_POT_OPTIMIZE) && defined(PERL_CORE)) */
+#else /* !(defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)) */
# define emergency_sbrk(size) -1
-#endif /* !(defined(TWO_POT_OPTIMIZE) && defined(PERL_CORE)) */
+#endif /* !(defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)) */
/*
- * nextf[i] is the pointer to the next free block of size 2^(i+3). The
+ * nextf[i] is the pointer to the next free block of size 2^i. The
* smallest allocatable block is 8 bytes. The overhead information
* precedes the data area returned to the user.
*/
-#define NBUCKETS 30
+#define NBUCKETS (32*BUCKETS_PER_POW2 + 1)
static union overhead *nextf[NBUCKETS];
#ifdef USE_PERL_SBRK
#define sbrk(a) Perl_sbrk(a)
-char * Perl_sbrk _((int size));
+Malloc_t Perl_sbrk _((int size));
+#else
+#ifdef DONT_DECLARE_STD
+#ifdef I_UNISTD
+#include <unistd.h>
+#endif
#else
-extern char *sbrk();
+extern Malloc_t sbrk(int);
+#endif
#endif
#ifdef DEBUGGING_MSTATS
@@ -247,50 +671,43 @@ extern char *sbrk();
* for a given block size.
*/
static u_int nmalloc[NBUCKETS];
-static u_int goodsbrk;
static u_int sbrk_slack;
static u_int start_slack;
#endif
+static u_int goodsbrk;
+
#ifdef DEBUGGING
-#define ASSERT(p) if (!(p)) botch(STRINGIFY(p)); else
+#undef ASSERT
+#define ASSERT(p,diag) if (!(p)) botch(diag,STRINGIFY(p)); else
static void
-botch(s)
- char *s;
+botch(char *diag, char *s)
{
- PerlIO_printf(PerlIO_stderr(), "assertion botched: %s\n", s);
- abort();
+ PerlIO_printf(PerlIO_stderr(), "assertion botched (%s?): %s\n", diag, s);
+ PerlProc_abort();
}
#else
-#define ASSERT(p)
+#define ASSERT(p, diag)
#endif
Malloc_t
-malloc(nbytes)
- register MEM_SIZE nbytes;
+malloc(register size_t nbytes)
{
register union overhead *p;
- register int bucket = 0;
+ register int bucket;
register MEM_SIZE shiftr;
#if defined(DEBUGGING) || defined(RCHECK)
MEM_SIZE size = nbytes;
#endif
-#ifdef PERL_CORE
-#ifdef HAS_64K_LIMIT
- if (nbytes > 0xffff) {
- PerlIO_printf(PerlIO_stderr(),
- "Allocation too large: %lx\n", (long)nbytes);
- my_exit(1);
- }
-#endif /* HAS_64K_LIMIT */
+ BARK_64K_LIMIT("Allocation",nbytes,nbytes);
#ifdef DEBUGGING
if ((long)nbytes < 0)
- croak("panic: malloc");
+ croak("%s", "panic: malloc");
#endif
-#endif /* PERL_CORE */
+ MUTEX_LOCK(&PL_malloc_mutex);
/*
* Convert amount of memory requested into
* closest block size stored in hash buckets
@@ -298,31 +715,40 @@ malloc(nbytes)
* space used per block for accounting.
*/
#ifdef PACK_MALLOC
+# ifdef SMALL_BUCKET_VIA_TABLE
+ if (nbytes == 0)
+ bucket = MIN_BUCKET;
+ else if (nbytes <= SIZE_TABLE_MAX) {
+ bucket = bucket_of[(nbytes - 1) >> BUCKET_TABLE_SHIFT];
+ } else
+# else
if (nbytes == 0)
nbytes = 1;
- else if (nbytes > MAX_2_POT_ALGO)
-#endif
- {
-#ifdef TWO_POT_OPTIMIZE
- if (nbytes >= FIRST_BIG_BOUND)
- nbytes -= PERL_PAGESIZE;
+ if (nbytes <= MAX_POW2_ALGO) goto do_shifts;
+ else
+# endif
#endif
- nbytes += M_OVERHEAD;
- nbytes = (nbytes + 3) &~ 3;
+ {
+ POW2_OPTIMIZE_ADJUST(nbytes);
+ nbytes += M_OVERHEAD;
+ nbytes = (nbytes + 3) &~ 3;
+ do_shifts:
+ shiftr = (nbytes - 1) >> START_SHIFT;
+ bucket = START_SHIFTS_BUCKET;
+ /* apart from this loop, this is O(1) */
+ while (shiftr >>= 1)
+ bucket += BUCKETS_PER_POW2;
}
- shiftr = (nbytes - 1) >> 2;
- /* apart from this loop, this is O(1) */
- while (shiftr >>= 1)
- bucket++;
/*
* If nothing in hash bucket right now,
* request more memory from the system.
*/
if (nextf[bucket] == NULL)
morecore(bucket);
- if ((p = (union overhead *)nextf[bucket]) == NULL) {
+ if ((p = nextf[bucket]) == NULL) {
+ MUTEX_UNLOCK(&PL_malloc_mutex);
#ifdef PERL_CORE
- if (!nomemok) {
+ if (!PL_nomemok) {
PerlIO_puts(PerlIO_stderr(),"Out of memory!\n");
my_exit(1);
}
@@ -331,19 +757,22 @@ malloc(nbytes)
#endif
}
-#ifdef PERL_CORE
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05lu) malloc %ld bytes\n",
- (unsigned long)(p+1),(unsigned long)(an++),(long)size));
-#endif /* PERL_CORE */
+ DEBUG_m(PerlIO_printf(Perl_debug_log,
+ "0x%lx: (%05lu) malloc %ld bytes\n",
+ (unsigned long)(p+1), (unsigned long)(PL_an++),
+ (long)size));
/* remove from linked list */
-#ifdef RCHECK
- if (*((int*)p) & (sizeof(union overhead) - 1))
+#if defined(RCHECK)
+ if (((UV)p) & (MEM_ALIGNBYTES - 1))
PerlIO_printf(PerlIO_stderr(), "Corrupt malloc ptr 0x%lx at 0x%lx\n",
(unsigned long)*((int*)p),(unsigned long)p);
#endif
nextf[bucket] = p->ov_next;
- OV_MAGIC(p, bucket) = MAGIC;
+#ifdef IGNORE_SMALL_BAD_FREE
+ if (bucket >= FIRST_BUCKET_WITH_CHECK)
+#endif
+ OV_MAGIC(p, bucket) = MAGIC;
#ifndef PACK_MALLOC
OV_INDEX(p) = bucket;
#endif
@@ -352,179 +781,475 @@ malloc(nbytes)
* Record allocated size of block and
* bound space with magic numbers.
*/
- nbytes = (size + M_OVERHEAD + 3) &~ 3;
- if (nbytes <= 0x10000)
- p->ov_size = nbytes - 1;
p->ov_rmagic = RMAGIC;
- *((u_int *)((caddr_t)p + nbytes - RSLOP)) = RMAGIC;
+ if (bucket <= MAX_SHORT_BUCKET) {
+ int i;
+
+ nbytes = size + M_OVERHEAD;
+ p->ov_size = nbytes - 1;
+ if ((i = nbytes & 3)) {
+ i = 4 - i;
+ while (i--)
+ *((char *)((caddr_t)p + nbytes - RSLOP + i)) = RMAGIC_C;
+ }
+ nbytes = (nbytes + 3) &~ 3;
+ *((u_int *)((caddr_t)p + nbytes - RSLOP)) = RMAGIC;
+ }
#endif
+ MUTEX_UNLOCK(&PL_malloc_mutex);
return ((Malloc_t)(p + CHUNK_SHIFT));
}
-/*
- * Allocate more memory to the indicated bucket.
- */
+static char *last_sbrk_top;
+static char *last_op; /* This arena can be easily extended. */
+static int sbrked_remains;
+static int sbrk_good = SBRK_ALLOW_FAILURES * SBRK_FAILURE_PRICE;
+
+#ifdef DEBUGGING_MSTATS
+static int sbrks;
+#endif
+
+struct chunk_chain_s {
+ struct chunk_chain_s *next;
+ MEM_SIZE size;
+};
+static struct chunk_chain_s *chunk_chain;
+static int n_chunks;
+static char max_bucket;
+
+/* Cutoff a piece of one of the chunks in the chain. Prefer smaller chunk. */
+static void *
+get_from_chain(MEM_SIZE size)
+{
+ struct chunk_chain_s *elt = chunk_chain, **oldp = &chunk_chain;
+ struct chunk_chain_s **oldgoodp = NULL;
+ long min_remain = LONG_MAX;
+
+ while (elt) {
+ if (elt->size >= size) {
+ long remains = elt->size - size;
+ if (remains >= 0 && remains < min_remain) {
+ oldgoodp = oldp;
+ min_remain = remains;
+ }
+ if (remains == 0) {
+ break;
+ }
+ }
+ oldp = &( elt->next );
+ elt = elt->next;
+ }
+ if (!oldgoodp) return NULL;
+ if (min_remain) {
+ void *ret = *oldgoodp;
+ struct chunk_chain_s *next = (*oldgoodp)->next;
+
+ *oldgoodp = (struct chunk_chain_s *)((char*)ret + size);
+ (*oldgoodp)->size = min_remain;
+ (*oldgoodp)->next = next;
+ return ret;
+ } else {
+ void *ret = *oldgoodp;
+ *oldgoodp = (*oldgoodp)->next;
+ n_chunks--;
+ return ret;
+ }
+}
+
static void
-morecore(bucket)
- register int bucket;
+add_to_chain(void *p, MEM_SIZE size, MEM_SIZE chip)
{
- register union overhead *op;
- register int rnu; /* 2^rnu bytes will be requested */
- register int nblks; /* become nblks blocks of the desired size */
- register MEM_SIZE siz, needed;
- int slack = 0;
+ struct chunk_chain_s *next = chunk_chain;
+ char *cp = (char*)p;
+
+ cp += chip;
+ chunk_chain = (struct chunk_chain_s *)cp;
+ chunk_chain->size = size - chip;
+ chunk_chain->next = next;
+ n_chunks++;
+}
- if (nextf[bucket])
- return;
- if (bucket == (sizeof(MEM_SIZE)*8 - 3)) {
- croak("Allocation too large");
+static void *
+get_from_bigger_buckets(int bucket, MEM_SIZE size)
+{
+ int price = 1;
+ static int bucketprice[NBUCKETS];
+ while (bucket <= max_bucket) {
+ /* We postpone stealing from bigger buckets until we want it
+ often enough. */
+ if (nextf[bucket] && bucketprice[bucket]++ >= price) {
+ /* Steal it! */
+ void *ret = (void*)(nextf[bucket] - 1 + CHUNK_SHIFT);
+ bucketprice[bucket] = 0;
+ if (((char*)nextf[bucket]) - M_OVERHEAD == last_op) {
+ last_op = NULL; /* Disable optimization */
+ }
+ nextf[bucket] = nextf[bucket]->ov_next;
+#ifdef DEBUGGING_MSTATS
+ nmalloc[bucket]--;
+ start_slack -= M_OVERHEAD;
+#endif
+ add_to_chain(ret, (BUCKET_SIZE(bucket) +
+ POW2_OPTIMIZE_SURPLUS(bucket)),
+ size);
+ return ret;
}
- /*
- * Insure memory is allocated
- * on a page boundary. Should
- * make getpageize call?
- */
-#ifndef atarist /* on the atari we dont have to worry about this */
- op = (union overhead *)sbrk(0);
-# ifndef I286
- if ((UV)op & (0x7FF >> CHUNK_SHIFT)) {
- slack = (0x800 >> CHUNK_SHIFT) - ((UV)op & (0x7FF >> CHUNK_SHIFT));
- (void)sbrk(slack);
-# if defined(DEBUGGING_MSTATS)
- sbrk_slack += slack;
-# endif
+ bucket++;
+ }
+ return NULL;
+}
+
+static union overhead *
+getpages(int needed, int *nblksp, int bucket)
+{
+ /* Need to do (possibly expensive) system call. Try to
+ optimize it for rare calling. */
+ MEM_SIZE require = needed - sbrked_remains;
+ char *cp;
+ union overhead *ovp;
+ int slack = 0;
+
+ if (sbrk_good > 0) {
+ if (!last_sbrk_top && require < FIRST_SBRK)
+ require = FIRST_SBRK;
+ else if (require < MIN_SBRK) require = MIN_SBRK;
+
+ if (require < goodsbrk * MIN_SBRK_FRAC / 100)
+ require = goodsbrk * MIN_SBRK_FRAC / 100;
+ require = ((require - 1 + MIN_SBRK) / MIN_SBRK) * MIN_SBRK;
+ } else {
+ require = needed;
+ last_sbrk_top = 0;
+ sbrked_remains = 0;
+ }
+
+ DEBUG_m(PerlIO_printf(Perl_debug_log,
+ "sbrk(%ld) for %ld-byte-long arena\n",
+ (long)require, (long) needed));
+ cp = (char *)sbrk(require);
+#ifdef DEBUGGING_MSTATS
+ sbrks++;
+#endif
+ if (cp == last_sbrk_top) {
+ /* Common case, anything is fine. */
+ sbrk_good++;
+ ovp = (union overhead *) (cp - sbrked_remains);
+ sbrked_remains = require - (needed - sbrked_remains);
+ } else if (cp == (char *)-1) { /* no more room! */
+ ovp = (union overhead *)emergency_sbrk(needed);
+ if (ovp == (union overhead *)-1)
+ return 0;
+ return ovp;
+ } else { /* Non-continuous or first sbrk(). */
+ long add = sbrked_remains;
+ char *newcp;
+
+ if (sbrked_remains) { /* Put rest into chain, we
+ cannot use it right now. */
+ add_to_chain((void*)(last_sbrk_top - sbrked_remains),
+ sbrked_remains, 0);
}
-# else
- /* The sbrk(0) call on the I286 always returns the next segment */
-# endif
-#endif /* atarist */
-#if !(defined(I286) || defined(atarist))
- /* take 2k unless the block is bigger than that */
- rnu = (bucket <= 8) ? 11 : bucket + 3;
-#else
- /* take 16k unless the block is bigger than that
- (80286s like large segments!), probably good on the atari too */
- rnu = (bucket <= 11) ? 14 : bucket + 3;
+ /* Second, check alignment. */
+ slack = 0;
+
+#if !defined(atarist) && !defined(__MINT__) /* on the atari we dont have to worry about this */
+# ifndef I286 /* The sbrk(0) call on the I286 always returns the next segment */
+
+ /* CHUNK_SHIFT is 1 for PACK_MALLOC, 0 otherwise. */
+ if ((UV)cp & (0x7FF >> CHUNK_SHIFT)) { /* Not aligned. */
+ slack = (0x800 >> CHUNK_SHIFT)
+ - ((UV)cp & (0x7FF >> CHUNK_SHIFT));
+ add += slack;
+ }
+# endif
+#endif /* !atarist && !MINT */
+
+ if (add) {
+ DEBUG_m(PerlIO_printf(Perl_debug_log,
+ "sbrk(%ld) to fix non-continuous/off-page sbrk:\n\t%ld for alignement,\t%ld were assumed to come from the tail of the previous sbrk\n",
+ (long)add, (long) slack,
+ (long) sbrked_remains));
+ newcp = (char *)sbrk(add);
+#if defined(DEBUGGING_MSTATS)
+ sbrks++;
+ sbrk_slack += add;
#endif
- nblks = 1 << (rnu - (bucket + 3)); /* how many blocks to get */
- needed = (MEM_SIZE)1 << rnu;
-#ifdef TWO_POT_OPTIMIZE
- needed += (bucket >= (FIRST_BIG_TWO_POT - 3) ? PERL_PAGESIZE : 0);
+ if (newcp != cp + require) {
+ /* Too bad: even rounding sbrk() is not continuous.*/
+ DEBUG_m(PerlIO_printf(Perl_debug_log,
+ "failed to fix bad sbrk()\n"));
+#ifdef PACK_MALLOC
+ if (slack) {
+ MUTEX_UNLOCK(&PL_malloc_mutex);
+ croak("%s", "panic: Off-page sbrk");
+ }
+#endif
+ if (sbrked_remains) {
+ /* Try again. */
+#if defined(DEBUGGING_MSTATS)
+ sbrk_slack += require;
+#endif
+ require = needed;
+ DEBUG_m(PerlIO_printf(Perl_debug_log,
+ "straight sbrk(%ld)\n",
+ (long)require));
+ cp = (char *)sbrk(require);
+#ifdef DEBUGGING_MSTATS
+ sbrks++;
#endif
- op = (union overhead *)sbrk(needed);
- /* no more room! */
- if (op == (union overhead *)-1) {
- op = (union overhead *)emergency_sbrk(needed);
- if (op == (union overhead *)-1)
- return;
+ if (cp == (char *)-1)
+ return 0;
+ }
+ sbrk_good = -1; /* Disable optimization!
+ Continue with not-aligned... */
+ } else {
+ cp += slack;
+ require += sbrked_remains;
+ }
}
-#ifdef DEBUGGING_MSTATS
- goodsbrk += needed;
-#endif
+
+ if (last_sbrk_top) {
+ sbrk_good -= SBRK_FAILURE_PRICE;
+ }
+
+ ovp = (union overhead *) cp;
/*
* Round up to minimum allocation size boundary
* and deduct from block count to reflect.
*/
-#ifndef I286
-# ifdef PACK_MALLOC
- if ((UV)op & 0x7FF)
- croak("panic: Off-page sbrk");
-# endif
- if ((UV)op & 7) {
- op = (union overhead *)(((UV)op + 8) & ~7);
- nblks--;
- }
-#else
- /* Again, this should always be ok on an 80286 */
+
+#ifndef I286 /* Again, this should always be ok on an 80286 */
+ if ((UV)ovp & 7) {
+ ovp = (union overhead *)(((UV)ovp + 8) & ~7);
+ DEBUG_m(PerlIO_printf(Perl_debug_log,
+ "fixing sbrk(): %d bytes off machine alignement\n",
+ (int)((UV)ovp & 7)));
+ (*nblksp)--;
+# if defined(DEBUGGING_MSTATS)
+ /* This is only approx. if TWO_POT_OPTIMIZE: */
+ sbrk_slack += (1 << bucket);
+# endif
+ }
#endif
+ sbrked_remains = require - needed;
+ }
+ last_sbrk_top = cp + require;
+ last_op = (char*) cp;
+#ifdef DEBUGGING_MSTATS
+ goodsbrk += require;
+#endif
+ return ovp;
+}
+
+static int
+getpages_adjacent(int require)
+{
+ if (require <= sbrked_remains) {
+ sbrked_remains -= require;
+ } else {
+ char *cp;
+
+ require -= sbrked_remains;
+ /* We do not try to optimize sbrks here, we go for place. */
+ cp = (char*) sbrk(require);
+#ifdef DEBUGGING_MSTATS
+ sbrks++;
+ goodsbrk += require;
+#endif
+ if (cp == last_sbrk_top) {
+ sbrked_remains = 0;
+ last_sbrk_top = cp + require;
+ } else {
+ if (cp == (char*)-1) { /* Out of memory */
+#ifdef DEBUGGING_MSTATS
+ goodsbrk -= require;
+#endif
+ return 0;
+ }
+ /* Report the failure: */
+ if (sbrked_remains)
+ add_to_chain((void*)(last_sbrk_top - sbrked_remains),
+ sbrked_remains, 0);
+ add_to_chain((void*)cp, require, 0);
+ sbrk_good -= SBRK_FAILURE_PRICE;
+ sbrked_remains = 0;
+ last_sbrk_top = 0;
+ last_op = 0;
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+/*
+ * Allocate more memory to the indicated bucket.
+ */
+static void
+morecore(register int bucket)
+{
+ register union overhead *ovp;
+ register int rnu; /* 2^rnu bytes will be requested */
+ int nblks; /* become nblks blocks of the desired size */
+ register MEM_SIZE siz, needed;
+
+ if (nextf[bucket])
+ return;
+ if (bucket == sizeof(MEM_SIZE)*8*BUCKETS_PER_POW2) {
+ MUTEX_UNLOCK(&PL_malloc_mutex);
+ croak("%s", "Out of memory during ridiculously large request");
+ }
+ if (bucket > max_bucket)
+ max_bucket = bucket;
+
+ rnu = ( (bucket <= (LOG_OF_MIN_ARENA << BUCKET_POW2_SHIFT))
+ ? LOG_OF_MIN_ARENA
+ : (bucket >> BUCKET_POW2_SHIFT) );
+ /* This may be overwritten later: */
+ nblks = 1 << (rnu - (bucket >> BUCKET_POW2_SHIFT)); /* how many blocks to get */
+ needed = ((MEM_SIZE)1 << rnu) + POW2_OPTIMIZE_SURPLUS(bucket);
+ if (nextf[rnu << BUCKET_POW2_SHIFT]) { /* 2048b bucket. */
+ ovp = nextf[rnu << BUCKET_POW2_SHIFT] - 1 + CHUNK_SHIFT;
+ nextf[rnu << BUCKET_POW2_SHIFT]
+ = nextf[rnu << BUCKET_POW2_SHIFT]->ov_next;
+#ifdef DEBUGGING_MSTATS
+ nmalloc[rnu << BUCKET_POW2_SHIFT]--;
+ start_slack -= M_OVERHEAD;
+#endif
+ DEBUG_m(PerlIO_printf(Perl_debug_log,
+ "stealing %ld bytes from %ld arena\n",
+ (long) needed, (long) rnu << BUCKET_POW2_SHIFT));
+ } else if (chunk_chain
+ && (ovp = (union overhead*) get_from_chain(needed))) {
+ DEBUG_m(PerlIO_printf(Perl_debug_log,
+ "stealing %ld bytes from chain\n",
+ (long) needed));
+ } else if ( (ovp = (union overhead*)
+ get_from_bigger_buckets((rnu << BUCKET_POW2_SHIFT) + 1,
+ needed)) ) {
+ DEBUG_m(PerlIO_printf(Perl_debug_log,
+ "stealing %ld bytes from bigger buckets\n",
+ (long) needed));
+ } else if (needed <= sbrked_remains) {
+ ovp = (union overhead *)(last_sbrk_top - sbrked_remains);
+ sbrked_remains -= needed;
+ last_op = (char*)ovp;
+ } else
+ ovp = getpages(needed, &nblks, bucket);
+
+ if (!ovp)
+ return;
+
/*
* Add new memory allocated to that on
* free list for this hash bucket.
*/
- siz = 1 << (bucket + 3);
+ siz = BUCKET_SIZE(bucket);
#ifdef PACK_MALLOC
- *(u_char*)op = bucket; /* Fill index. */
- if (bucket <= MAX_PACKED - 3) {
- op = (union overhead *) ((char*)op + blk_shift[bucket]);
- nblks = n_blks[bucket];
+ *(u_char*)ovp = bucket; /* Fill index. */
+ if (bucket <= MAX_PACKED) {
+ ovp = (union overhead *) ((char*)ovp + BLK_SHIFT(bucket));
+ nblks = N_BLKS(bucket);
# ifdef DEBUGGING_MSTATS
- start_slack += blk_shift[bucket];
+ start_slack += BLK_SHIFT(bucket);
# endif
- } else if (bucket <= 11 - 1 - 3) {
- op = (union overhead *) ((char*)op + blk_shift[bucket]);
- /* nblks = n_blks[bucket]; */
+ } else if (bucket < LOG_OF_MIN_ARENA * BUCKETS_PER_POW2) {
+ ovp = (union overhead *) ((char*)ovp + BLK_SHIFT(bucket));
siz -= sizeof(union overhead);
- } else op++; /* One chunk per block. */
-#endif /* !PACK_MALLOC */
- nextf[bucket] = op;
+ } else ovp++; /* One chunk per block. */
+#endif /* PACK_MALLOC */
+ nextf[bucket] = ovp;
#ifdef DEBUGGING_MSTATS
nmalloc[bucket] += nblks;
+ if (bucket > MAX_PACKED) {
+ start_slack += M_OVERHEAD * nblks;
+ }
#endif
while (--nblks > 0) {
- op->ov_next = (union overhead *)((caddr_t)op + siz);
- op = (union overhead *)((caddr_t)op + siz);
+ ovp->ov_next = (union overhead *)((caddr_t)ovp + siz);
+ ovp = (union overhead *)((caddr_t)ovp + siz);
}
/* Not all sbrks return zeroed memory.*/
- op->ov_next = (union overhead *)NULL;
+ ovp->ov_next = (union overhead *)NULL;
#ifdef PACK_MALLOC
- if (bucket == 7 - 3) { /* Special case, explanation is above. */
- union overhead *n_op = nextf[7 - 3]->ov_next;
- nextf[7 - 3] = (union overhead *)((caddr_t)nextf[7 - 3]
- - sizeof(union overhead));
- nextf[7 - 3]->ov_next = n_op;
+ if (bucket == 7*BUCKETS_PER_POW2) { /* Special case, explanation is above. */
+ union overhead *n_op = nextf[7*BUCKETS_PER_POW2]->ov_next;
+ nextf[7*BUCKETS_PER_POW2] =
+ (union overhead *)((caddr_t)nextf[7*BUCKETS_PER_POW2]
+ - sizeof(union overhead));
+ nextf[7*BUCKETS_PER_POW2]->ov_next = n_op;
}
#endif /* !PACK_MALLOC */
}
Free_t
-free(mp)
- Malloc_t mp;
+free(void *mp)
{
register MEM_SIZE size;
- register union overhead *op;
+ register union overhead *ovp;
char *cp = (char*)mp;
#ifdef PACK_MALLOC
u_char bucket;
#endif
-#ifdef PERL_CORE
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05lu) free\n",(unsigned long)cp,(unsigned long)(an++)));
-#endif /* PERL_CORE */
+ DEBUG_m(PerlIO_printf(Perl_debug_log,
+ "0x%lx: (%05lu) free\n",
+ (unsigned long)cp, (unsigned long)(PL_an++)));
if (cp == NULL)
return;
- op = (union overhead *)((caddr_t)cp
+ ovp = (union overhead *)((caddr_t)cp
- sizeof (union overhead) * CHUNK_SHIFT);
#ifdef PACK_MALLOC
- bucket = OV_INDEX(op);
+ bucket = OV_INDEX(ovp);
#endif
- if (OV_MAGIC(op, bucket) != MAGIC) {
+#ifdef IGNORE_SMALL_BAD_FREE
+ if ((bucket >= FIRST_BUCKET_WITH_CHECK)
+ && (OV_MAGIC(ovp, bucket) != MAGIC))
+#else
+ if (OV_MAGIC(ovp, bucket) != MAGIC)
+#endif
+ {
static int bad_free_warn = -1;
if (bad_free_warn == -1) {
- char *pbf = getenv("PERL_BADFREE");
+ char *pbf = PerlEnv_getenv("PERL_BADFREE");
bad_free_warn = (pbf) ? atoi(pbf) : 1;
}
if (!bad_free_warn)
return;
#ifdef RCHECK
warn("%s free() ignored",
- op->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad");
+ ovp->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad");
#else
- warn("Bad free() ignored");
+ warn("%s", "Bad free() ignored");
#endif
return; /* sanity */
- }
+ }
+ MUTEX_LOCK(&PL_malloc_mutex);
#ifdef RCHECK
- ASSERT(op->ov_rmagic == RMAGIC);
- if (OV_INDEX(op) <= MAX_SHORT_BUCKET)
- ASSERT(*(u_int *)((caddr_t)op + op->ov_size + 1 - RSLOP) == RMAGIC);
- op->ov_rmagic = RMAGIC - 1;
-#endif
- ASSERT(OV_INDEX(op) < NBUCKETS);
- size = OV_INDEX(op);
- op->ov_next = nextf[size];
- nextf[size] = op;
+ ASSERT(ovp->ov_rmagic == RMAGIC, "chunk's head overwrite");
+ if (OV_INDEX(ovp) <= MAX_SHORT_BUCKET) {
+ int i;
+ MEM_SIZE nbytes = ovp->ov_size + 1;
+
+ if ((i = nbytes & 3)) {
+ i = 4 - i;
+ while (i--) {
+ ASSERT(*((char *)((caddr_t)ovp + nbytes - RSLOP + i))
+ == RMAGIC_C, "chunk's tail overwrite");
+ }
+ }
+ nbytes = (nbytes + 3) &~ 3;
+ ASSERT(*(u_int *)((caddr_t)ovp + nbytes - RSLOP) == RMAGIC, "chunk's tail overwrite");
+ }
+ ovp->ov_rmagic = RMAGIC - 1;
+#endif
+ ASSERT(OV_INDEX(ovp) < NBUCKETS, "chunk's head overwrite");
+ size = OV_INDEX(ovp);
+ ovp->ov_next = nextf[size];
+ nextf[size] = ovp;
+ MUTEX_UNLOCK(&PL_malloc_mutex);
}
/*
@@ -538,44 +1263,41 @@ free(mp)
* is extern so the caller can modify it). If that fails we just copy
* however many bytes was given to realloc() and hope it's not huge.
*/
-int reall_srchlen = 4; /* 4 should be plenty, -1 =>'s whole list */
+int reall_srchlen = 4; /* 4 should be plenty, -1 =>'s whole list */
Malloc_t
-realloc(mp, nbytes)
- Malloc_t mp;
- MEM_SIZE nbytes;
+realloc(void *mp, size_t nbytes)
{
register MEM_SIZE onb;
- union overhead *op;
+ union overhead *ovp;
char *res;
- register int i;
- int was_alloced = 0;
+ int prev_bucket;
+ register int bucket;
+ int was_alloced = 0, incr;
char *cp = (char*)mp;
-#ifdef DEBUGGING
+#if defined(DEBUGGING) || !defined(PERL_CORE)
MEM_SIZE size = nbytes;
+
+ if ((long)nbytes < 0)
+ croak("%s", "panic: realloc");
#endif
-#ifdef PERL_CORE
-#ifdef HAS_64K_LIMIT
- if (nbytes > 0xffff) {
- PerlIO_printf(PerlIO_stderr(),
- "Reallocation too large: %lx\n", size);
- my_exit(1);
- }
-#endif /* HAS_64K_LIMIT */
+ BARK_64K_LIMIT("Reallocation",nbytes,size);
if (!cp)
return malloc(nbytes);
-#ifdef DEBUGGING
- if ((long)nbytes < 0)
- croak("panic: realloc");
-#endif
-#endif /* PERL_CORE */
- op = (union overhead *)((caddr_t)cp
+ MUTEX_LOCK(&PL_malloc_mutex);
+ ovp = (union overhead *)((caddr_t)cp
- sizeof (union overhead) * CHUNK_SHIFT);
- i = OV_INDEX(op);
- if (OV_MAGIC(op, i) == MAGIC) {
+ bucket = OV_INDEX(ovp);
+#ifdef IGNORE_SMALL_BAD_FREE
+ if ((bucket < FIRST_BUCKET_WITH_CHECK)
+ || (OV_MAGIC(ovp, bucket) == MAGIC))
+#else
+ if (OV_MAGIC(ovp, bucket) == MAGIC)
+#endif
+ {
was_alloced = 1;
} else {
/*
@@ -589,40 +1311,61 @@ realloc(mp, nbytes)
* the memory block being realloc'd is the
* smallest possible.
*/
- if ((i = findbucket(op, 1)) < 0 &&
- (i = findbucket(op, reall_srchlen)) < 0)
- i = 0;
+ if ((bucket = findbucket(ovp, 1)) < 0 &&
+ (bucket = findbucket(ovp, reall_srchlen)) < 0)
+ bucket = 0;
}
- onb = (1L << (i + 3)) -
-#ifdef PACK_MALLOC
- (i <= (MAX_PACKED - 3) ? 0 : M_OVERHEAD)
-#else
- M_OVERHEAD
-#endif
-#ifdef TWO_POT_OPTIMIZE
- + (i >= (FIRST_BIG_TWO_POT - 3) ? PERL_PAGESIZE : 0)
-#endif
- ;
+ onb = BUCKET_SIZE_REAL(bucket);
/*
* avoid the copy if same size block.
- * We are not agressive with boundary cases. Note that it is
- * possible for small number of cases give false negative if
+ * We are not agressive with boundary cases. Note that it might
+ * (for a small number of cases) give false negative if
* both new size and old one are in the bucket for
- * FIRST_BIG_TWO_POT, but the new one is near the lower end.
+ * FIRST_BIG_POW2, but the new one is near the lower end.
+ *
+ * We do not try to go to 1.5 times smaller bucket so far.
*/
- if (was_alloced &&
- nbytes <= onb && (nbytes > ( (onb >> 1) - M_OVERHEAD )
-#ifdef TWO_POT_OPTIMIZE
- || (i == (FIRST_BIG_TWO_POT - 3)
- && nbytes >= LAST_SMALL_BOUND )
-#endif
- )) {
+ if (nbytes > onb) incr = 1;
+ else {
+#ifdef DO_NOT_TRY_HARDER_WHEN_SHRINKING
+ if ( /* This is a little bit pessimal if PACK_MALLOC: */
+ nbytes > ( (onb >> 1) - M_OVERHEAD )
+# ifdef TWO_POT_OPTIMIZE
+ || (bucket == FIRST_BIG_POW2 && nbytes >= LAST_SMALL_BOUND )
+# endif
+ )
+#else /* !DO_NOT_TRY_HARDER_WHEN_SHRINKING */
+ prev_bucket = ( (bucket > MAX_PACKED + 1)
+ ? bucket - BUCKETS_PER_POW2
+ : bucket - 1);
+ if (nbytes > BUCKET_SIZE_REAL(prev_bucket))
+#endif /* !DO_NOT_TRY_HARDER_WHEN_SHRINKING */
+ incr = 0;
+ else incr = -1;
+ }
+ if (!was_alloced
+#ifdef STRESS_REALLOC
+ || 1 /* always do it the hard way */
+#endif
+ ) goto hard_way;
+ else if (incr == 0) {
+ inplace_label:
#ifdef RCHECK
/*
* Record new allocated size of block and
* bound space with magic numbers.
*/
- if (OV_INDEX(op) <= MAX_SHORT_BUCKET) {
+ if (OV_INDEX(ovp) <= MAX_SHORT_BUCKET) {
+ int i, nb = ovp->ov_size + 1;
+
+ if ((i = nb & 3)) {
+ i = 4 - i;
+ while (i--) {
+ ASSERT(*((char *)((caddr_t)ovp + nb - RSLOP + i)) == RMAGIC_C, "chunk's tail overwrite");
+ }
+ }
+ nb = (nb + 3) &~ 3;
+ ASSERT(*(u_int *)((caddr_t)ovp + nb - RSLOP) == RMAGIC, "chunk's tail overwrite");
/*
* Convert amount of memory requested into
* closest block size stored in hash buckets
@@ -630,31 +1373,62 @@ realloc(mp, nbytes)
* space used per block for accounting.
*/
nbytes += M_OVERHEAD;
+ ovp->ov_size = nbytes - 1;
+ if ((i = nbytes & 3)) {
+ i = 4 - i;
+ while (i--)
+ *((char *)((caddr_t)ovp + nbytes - RSLOP + i))
+ = RMAGIC_C;
+ }
nbytes = (nbytes + 3) &~ 3;
- op->ov_size = nbytes - 1;
- *((u_int *)((caddr_t)op + nbytes - RSLOP)) = RMAGIC;
+ *((u_int *)((caddr_t)ovp + nbytes - RSLOP)) = RMAGIC;
}
#endif
res = cp;
+ MUTEX_UNLOCK(&PL_malloc_mutex);
+ DEBUG_m(PerlIO_printf(Perl_debug_log,
+ "0x%lx: (%05lu) realloc %ld bytes inplace\n",
+ (unsigned long)res,(unsigned long)(PL_an++),
+ (long)size));
+ } else if (incr == 1 && (cp - M_OVERHEAD == last_op)
+ && (onb > (1 << LOG_OF_MIN_ARENA))) {
+ MEM_SIZE require, newarena = nbytes, pow;
+ int shiftr;
+
+ POW2_OPTIMIZE_ADJUST(newarena);
+ newarena = newarena + M_OVERHEAD;
+ /* newarena = (newarena + 3) &~ 3; */
+ shiftr = (newarena - 1) >> LOG_OF_MIN_ARENA;
+ pow = LOG_OF_MIN_ARENA + 1;
+ /* apart from this loop, this is O(1) */
+ while (shiftr >>= 1)
+ pow++;
+ newarena = (1 << pow) + POW2_OPTIMIZE_SURPLUS(pow * BUCKETS_PER_POW2);
+ require = newarena - onb - M_OVERHEAD;
+
+ if (getpages_adjacent(require)) {
+#ifdef DEBUGGING_MSTATS
+ nmalloc[bucket]--;
+ nmalloc[pow * BUCKETS_PER_POW2]++;
+#endif
+ *(cp - M_OVERHEAD) = pow * BUCKETS_PER_POW2; /* Fill index. */
+ goto inplace_label;
+ } else
+ goto hard_way;
+ } else {
+ hard_way:
+ MUTEX_UNLOCK(&PL_malloc_mutex);
+ DEBUG_m(PerlIO_printf(Perl_debug_log,
+ "0x%lx: (%05lu) realloc %ld bytes the hard way\n",
+ (unsigned long)cp,(unsigned long)(PL_an++),
+ (long)size));
+ if ((res = (char*)malloc(nbytes)) == NULL)
+ return (NULL);
+ if (cp != res) /* common optimization */
+ Copy(cp, res, (MEM_SIZE)(nbytes<onb?nbytes:onb), char);
+ if (was_alloced)
+ free(cp);
}
- else {
- if ((res = (char*)malloc(nbytes)) == NULL)
- return (NULL);
- if (cp != res) /* common optimization */
- Copy(cp, res, (MEM_SIZE)(nbytes<onb?nbytes:onb), char);
- if (was_alloced)
- free(cp);
- }
-
-#ifdef PERL_CORE
-#ifdef DEBUGGING
- if (debug & 128) {
- PerlIO_printf(Perl_debug_log, "0x%lx: (%05lu) rfree\n",(unsigned long)res,(unsigned long)(an++));
- PerlIO_printf(Perl_debug_log, "0x%lx: (%05lu) realloc %ld bytes\n",
- (unsigned long)res,(unsigned long)(an++),(long)size);
- }
-#endif
-#endif /* PERL_CORE */
return ((Malloc_t)res);
}
@@ -664,9 +1438,7 @@ realloc(mp, nbytes)
* Return bucket number, or -1 if not found.
*/
static int
-findbucket(freep, srchlen)
- union overhead *freep;
- int srchlen;
+findbucket(union overhead *freep, int srchlen)
{
register union overhead *p;
register int i, j;
@@ -683,9 +1455,7 @@ findbucket(freep, srchlen)
}
Malloc_t
-calloc(elements, size)
- register MEM_SIZE elements;
- register MEM_SIZE size;
+calloc(register size_t elements, register size_t size)
{
long sz = elements * size;
Malloc_t p = malloc(sz);
@@ -696,7 +1466,31 @@ calloc(elements, size)
return p;
}
+MEM_SIZE
+malloced_size(void *p)
+{
+ union overhead *ovp = (union overhead *)
+ ((caddr_t)p - sizeof (union overhead) * CHUNK_SHIFT);
+ int bucket = OV_INDEX(ovp);
+#ifdef RCHECK
+ /* The caller wants to have a complete control over the chunk,
+ disable the memory checking inside the chunk. */
+ if (bucket <= MAX_SHORT_BUCKET) {
+ MEM_SIZE size = BUCKET_SIZE_REAL(bucket);
+ ovp->ov_size = size + M_OVERHEAD - 1;
+ *((u_int *)((caddr_t)ovp + size + M_OVERHEAD - RSLOP)) = RMAGIC;
+ }
+#endif
+ return BUCKET_SIZE_REAL(bucket);
+}
+
#ifdef DEBUGGING_MSTATS
+
+# ifdef BUCKETS_ROOT2
+# define MIN_EVEN_REPORT 6
+# else
+# define MIN_EVEN_REPORT MIN_BUCKET
+# endif
/*
* mstats - print out statistics about malloc
*
@@ -705,41 +1499,80 @@ calloc(elements, size)
* frees for each size category.
*/
void
-dump_mstats(s)
- char *s;
+dump_mstats(char *s)
{
register int i, j;
register union overhead *p;
- int topbucket=0, totfree=0, total=0;
+ int topbucket=0, topbucket_ev=0, topbucket_odd=0, totfree=0, total=0;
u_int nfree[NBUCKETS];
+ int total_chain = 0;
+ struct chunk_chain_s* nextchain = chunk_chain;
- for (i=0; i < NBUCKETS; i++) {
+ for (i = MIN_BUCKET ; i < NBUCKETS; i++) {
for (j = 0, p = nextf[i]; p; p = p->ov_next, j++)
;
nfree[i] = j;
- totfree += nfree[i] * (1 << (i + 3));
- total += nmalloc[i] * (1 << (i + 3));
- if (nmalloc[i])
- topbucket = i;
+ totfree += nfree[i] * BUCKET_SIZE_REAL(i);
+ total += nmalloc[i] * BUCKET_SIZE_REAL(i);
+ if (nmalloc[i]) {
+ i % 2 ? (topbucket_odd = i) : (topbucket_ev = i);
+ topbucket = i;
+ }
}
if (s)
- PerlIO_printf(PerlIO_stderr(), "Memory allocation statistics %s (buckets 8..%d)\n",
- s, (1 << (topbucket + 3)) );
+ PerlIO_printf(PerlIO_stderr(),
+ "Memory allocation statistics %s (buckets %ld(%ld)..%ld(%ld)\n",
+ s,
+ (long)BUCKET_SIZE_REAL(MIN_BUCKET),
+ (long)BUCKET_SIZE(MIN_BUCKET),
+ (long)BUCKET_SIZE_REAL(topbucket), (long)BUCKET_SIZE(topbucket));
PerlIO_printf(PerlIO_stderr(), "%8d free:", totfree);
- for (i=0; i <= topbucket; i++) {
- PerlIO_printf(PerlIO_stderr(), (i<5 || i==7)?" %5d": (i<9)?" %3d":" %d", nfree[i]);
+ for (i = MIN_EVEN_REPORT; i <= topbucket; i += BUCKETS_PER_POW2) {
+ PerlIO_printf(PerlIO_stderr(),
+ ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2)
+ ? " %5d"
+ : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")),
+ nfree[i]);
+ }
+#ifdef BUCKETS_ROOT2
+ PerlIO_printf(PerlIO_stderr(), "\n\t ");
+ for (i = MIN_BUCKET + 1; i <= topbucket_odd; i += BUCKETS_PER_POW2) {
+ PerlIO_printf(PerlIO_stderr(),
+ ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2)
+ ? " %5d"
+ : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")),
+ nfree[i]);
}
+#endif
PerlIO_printf(PerlIO_stderr(), "\n%8d used:", total - totfree);
- for (i=0; i <= topbucket; i++) {
- PerlIO_printf(PerlIO_stderr(), (i<5 || i==7)?" %5d": (i<9)?" %3d":" %d", nmalloc[i] - nfree[i]);
+ for (i = MIN_EVEN_REPORT; i <= topbucket; i += BUCKETS_PER_POW2) {
+ PerlIO_printf(PerlIO_stderr(),
+ ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2)
+ ? " %5d"
+ : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")),
+ nmalloc[i] - nfree[i]);
+ }
+#ifdef BUCKETS_ROOT2
+ PerlIO_printf(PerlIO_stderr(), "\n\t ");
+ for (i = MIN_BUCKET + 1; i <= topbucket_odd; i += BUCKETS_PER_POW2) {
+ PerlIO_printf(PerlIO_stderr(),
+ ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2)
+ ? " %5d"
+ : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")),
+ nmalloc[i] - nfree[i]);
}
- PerlIO_printf(PerlIO_stderr(), "\nTotal sbrk(): %8d. Odd ends: sbrk(): %7d, malloc(): %7d bytes.\n",
- goodsbrk + sbrk_slack, sbrk_slack, start_slack);
+#endif
+ while (nextchain) {
+ total_chain += nextchain->size;
+ nextchain = nextchain->next;
+ }
+ PerlIO_printf(PerlIO_stderr(), "\nTotal sbrk(): %d/%d:%d. Odd ends: pad+heads+chain+tail: %d+%d+%d+%d.\n",
+ goodsbrk + sbrk_slack, sbrks, sbrk_good, sbrk_slack,
+ start_slack, total_chain, sbrked_remains);
}
#else
void
-dump_mstats(s)
- char *s;
+dump_mstats(char *s)
{
}
#endif
@@ -748,13 +1581,27 @@ dump_mstats(s)
#ifdef USE_PERL_SBRK
-# ifdef NeXT
+# if defined(__MACHTEN_PPC__) || defined(__NeXT__)
# define PERL_SBRK_VIA_MALLOC
+/*
+ * MachTen's malloc() returns a buffer aligned on a two-byte boundary.
+ * While this is adequate, it may slow down access to longer data
+ * types by forcing multiple memory accesses. It also causes
+ * complaints when RCHECK is in force. So we allocate six bytes
+ * more than we need to, and return an address rounded up to an
+ * eight-byte boundary.
+ *
+ * 980701 Dominic Dunlop <domo@computer.org>
+ */
+# define SYSTEM_ALLOC(a) ((void *)(((unsigned)malloc((a)+6)+6)&~7))
# endif
# ifdef PERL_SBRK_VIA_MALLOC
# if defined(HIDEMYMALLOC) || defined(EMBEDMYMALLOC)
-# undef malloc
+# undef malloc /* Expose names that */
+# undef calloc /* HIDEMYMALLOC hides */
+# undef realloc
+# undef free
# else
# include "Error: -DPERL_SBRK_VIA_MALLOC needs -D(HIDE|EMBED)MYMALLOC"
# endif
@@ -764,7 +1611,9 @@ dump_mstats(s)
/* frequent core dumps within nxzonefreenolock. This sbrk routine put an */
/* end to the cores */
-# define SYSTEM_ALLOC(a) malloc(a)
+# ifndef SYSTEM_ALLOC
+# define SYSTEM_ALLOC(a) malloc(a)
+# endif
# endif /* PERL_SBRK_VIA_MALLOC */
@@ -774,9 +1623,8 @@ static long Perl_sbrk_oldsize;
# define PERLSBRK_32_K (1<<15)
# define PERLSBRK_64_K (1<<16)
-char *
-Perl_sbrk(size)
-int size;
+Malloc_t
+Perl_sbrk(int size)
{
IV got;
int small, reqsize;
@@ -796,9 +1644,6 @@ int size;
if (size >= PERLSBRK_32_K) {
small = 0;
} else {
-#ifndef PERL_CORE
- reqsize = size;
-#endif
size = PERLSBRK_64_K;
small = 1;
}
@@ -813,10 +1658,8 @@ int size;
}
}
-#ifdef PERL_CORE
DEBUG_m(PerlIO_printf(Perl_debug_log, "sbrk malloc size %ld (reqsize %ld), left size %ld, give addr 0x%lx\n",
size, reqsize, Perl_sbrk_oldsize, got));
-#endif
return (void *)got;
}
diff --git a/gnu/usr.bin/perl/mg.c b/gnu/usr.bin/perl/mg.c
index ee87d47859b..d69fd53aa18 100644
--- a/gnu/usr.bin/perl/mg.c
+++ b/gnu/usr.bin/perl/mg.c
@@ -1,6 +1,6 @@
/* mg.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -30,6 +30,11 @@
* Use the "DESTRUCTOR" scope cleanup to reinstate magic.
*/
+#ifdef PERL_OBJECT
+
+#define VTBL this->*vtbl
+
+#else
struct magic_state {
SV* mgs_sv;
U32 mgs_flags;
@@ -37,11 +42,12 @@ struct magic_state {
typedef struct magic_state MGS;
static void restore_magic _((void *p));
+#define VTBL *vtbl
-static void
-save_magic(mgs, sv)
-MGS* mgs;
-SV* sv;
+#endif
+
+STATIC void
+save_magic(MGS *mgs, SV *sv)
{
assert(SvMAGICAL(sv));
@@ -54,9 +60,8 @@ SV* sv;
SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
}
-static void
-restore_magic(p)
-void* p;
+STATIC void
+restore_magic(void *p)
{
MGS* mgs = (MGS*)p;
SV* sv = mgs->mgs_sv;
@@ -72,28 +77,25 @@ void* p;
}
}
-
void
-mg_magical(sv)
-SV* sv;
+mg_magical(SV *sv)
{
MAGIC* mg;
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
MGVTBL* vtbl = mg->mg_virtual;
if (vtbl) {
- if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
+ if ((vtbl->svt_get != NULL) && !(mg->mg_flags & MGf_GSKIP))
SvGMAGICAL_on(sv);
if (vtbl->svt_set)
SvSMAGICAL_on(sv);
- if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear)
+ if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || (vtbl->svt_clear != NULL))
SvRMAGICAL_on(sv);
}
}
}
int
-mg_get(sv)
-SV* sv;
+mg_get(SV *sv)
{
MGS mgs;
MAGIC* mg;
@@ -106,8 +108,8 @@ SV* sv;
mgp = &SvMAGIC(sv);
while ((mg = *mgp) != 0) {
MGVTBL* vtbl = mg->mg_virtual;
- if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
- (*vtbl->svt_get)(sv, mg);
+ if (!(mg->mg_flags & MGf_GSKIP) && vtbl && (vtbl->svt_get != NULL)) {
+ (VTBL->svt_get)(sv, mg);
/* Ignore this magic if it's been deleted */
if ((mg == (mgp_valid ? *mgp : SvMAGIC(sv))) &&
(mg->mg_flags & MGf_GSKIP))
@@ -127,8 +129,7 @@ SV* sv;
}
int
-mg_set(sv)
-SV* sv;
+mg_set(SV *sv)
{
MGS mgs;
MAGIC* mg;
@@ -144,8 +145,8 @@ SV* sv;
mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */
mgs.mgs_flags = 0;
}
- if (vtbl && vtbl->svt_set)
- (*vtbl->svt_set)(sv, mg);
+ if (vtbl && (vtbl->svt_set != NULL))
+ (VTBL->svt_set)(sv, mg);
}
LEAVE;
@@ -153,8 +154,7 @@ SV* sv;
}
U32
-mg_len(sv)
-SV* sv;
+mg_length(SV *sv)
{
MAGIC* mg;
char *junk;
@@ -162,13 +162,13 @@ SV* sv;
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
MGVTBL* vtbl = mg->mg_virtual;
- if (vtbl && vtbl->svt_len) {
+ if (vtbl && (vtbl->svt_len != NULL)) {
MGS mgs;
ENTER;
save_magic(&mgs, sv);
/* omit MGf_GSKIP -- not changed here */
- len = (*vtbl->svt_len)(sv, mg);
+ len = (VTBL->svt_len)(sv, mg);
LEAVE;
return len;
}
@@ -178,9 +178,39 @@ SV* sv;
return len;
}
+I32
+mg_size(SV *sv)
+{
+ MAGIC* mg;
+ I32 len;
+
+ for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+ MGVTBL* vtbl = mg->mg_virtual;
+ if (vtbl && (vtbl->svt_len != NULL)) {
+ MGS mgs;
+ ENTER;
+ /* omit MGf_GSKIP -- not changed here */
+ len = (VTBL->svt_len)(sv, mg);
+ LEAVE;
+ return len;
+ }
+ }
+
+ switch(SvTYPE(sv)) {
+ case SVt_PVAV:
+ len = AvFILLp((AV *) sv); /* Fallback to non-tied array */
+ return len;
+ case SVt_PVHV:
+ /* FIXME */
+ default:
+ croak("Size magic not implemented");
+ break;
+ }
+ return 0;
+}
+
int
-mg_clear(sv)
-SV* sv;
+mg_clear(SV *sv)
{
MGS mgs;
MAGIC* mg;
@@ -192,8 +222,8 @@ SV* sv;
MGVTBL* vtbl = mg->mg_virtual;
/* omit GSKIP -- never set here */
- if (vtbl && vtbl->svt_clear)
- (*vtbl->svt_clear)(sv, mg);
+ if (vtbl && (vtbl->svt_clear != NULL))
+ (VTBL->svt_clear)(sv, mg);
}
LEAVE;
@@ -201,9 +231,7 @@ SV* sv;
}
MAGIC*
-mg_find(sv, type)
-SV* sv;
-int type;
+mg_find(SV *sv, int type)
{
MAGIC* mg;
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
@@ -214,17 +242,15 @@ int type;
}
int
-mg_copy(sv, nsv, key, klen)
-SV* sv;
-SV* nsv;
-char *key;
-I32 klen;
+mg_copy(SV *sv, SV *nsv, char *key, I32 klen)
{
int count = 0;
MAGIC* mg;
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
if (isUPPER(mg->mg_type)) {
- sv_magic(nsv, mg->mg_obj, toLOWER(mg->mg_type), key, klen);
+ sv_magic(nsv,
+ mg->mg_type == 'P' ? SvTIED_obj(sv, mg) : mg->mg_obj,
+ toLOWER(mg->mg_type), key, klen);
count++;
}
}
@@ -232,16 +258,15 @@ I32 klen;
}
int
-mg_free(sv)
-SV* sv;
+mg_free(SV *sv)
{
MAGIC* mg;
MAGIC* moremagic;
for (mg = SvMAGIC(sv); mg; mg = moremagic) {
MGVTBL* vtbl = mg->mg_virtual;
moremagic = mg->mg_moremagic;
- if (vtbl && vtbl->svt_free)
- (*vtbl->svt_free)(sv, mg);
+ if (vtbl && (vtbl->svt_free != NULL))
+ (VTBL->svt_free)(sv, mg);
if (mg->mg_ptr && mg->mg_type != 'g')
if (mg->mg_len >= 0)
Safefree(mg->mg_ptr);
@@ -260,10 +285,9 @@ SV* sv;
#endif
U32
-magic_len(sv, mg)
-SV *sv;
-MAGIC *mg;
+magic_len(SV *sv, MAGIC *mg)
{
+ dTHR;
register I32 paren;
register char *s;
register I32 i;
@@ -273,7 +297,7 @@ MAGIC *mg;
switch (*mg->mg_ptr) {
case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9': case '&':
- if (curpm && (rx = curpm->op_pmregexp)) {
+ if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
paren = atoi(mg->mg_ptr);
getparen:
if (paren <= rx->nparens &&
@@ -287,14 +311,14 @@ MAGIC *mg;
}
return 0;
case '+':
- if (curpm && (rx = curpm->op_pmregexp)) {
+ if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
paren = rx->lastparen;
if (paren)
goto getparen;
}
return 0;
case '`':
- if (curpm && (rx = curpm->op_pmregexp)) {
+ if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
if ((s = rx->subbeg) && rx->startp[0]) {
i = rx->startp[0] - s;
if (i >= 0)
@@ -303,7 +327,7 @@ MAGIC *mg;
}
return 0;
case '\'':
- if (curpm && (rx = curpm->op_pmregexp)) {
+ if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
if (rx->subend && (s = rx->endp[0])) {
i = rx->subend - s;
if (i >= 0)
@@ -312,23 +336,24 @@ MAGIC *mg;
}
return 0;
case ',':
- return (STRLEN)ofslen;
+ return (STRLEN)PL_ofslen;
case '\\':
- return (STRLEN)orslen;
+ return (STRLEN)PL_orslen;
}
magic_get(sv,mg);
- if (!SvPOK(sv) && SvNIOK(sv))
- sv_2pv(sv, &na);
+ if (!SvPOK(sv) && SvNIOK(sv)) {
+ STRLEN n_a;
+ sv_2pv(sv, &n_a);
+ }
if (SvPOK(sv))
return SvCUR(sv);
return 0;
}
int
-magic_get(sv, mg)
-SV *sv;
-MAGIC *mg;
+magic_get(SV *sv, MAGIC *mg)
{
+ dTHR;
register I32 paren;
register char *s;
register I32 i;
@@ -337,10 +362,13 @@ MAGIC *mg;
switch (*mg->mg_ptr) {
case '\001': /* ^A */
- sv_setsv(sv, bodytarget);
+ sv_setsv(sv, PL_bodytarget);
+ break;
+ case '\003': /* ^C */
+ sv_setiv(sv, (IV)PL_minus_c);
break;
case '\004': /* ^D */
- sv_setiv(sv, (IV)(debug & 32767));
+ sv_setiv(sv, (IV)(PL_debug & 32767));
break;
case '\005': /* ^E */
#ifdef VMS
@@ -361,58 +389,90 @@ MAGIC *mg;
sv_setnv(sv, (double)errno);
sv_setpv(sv, errno ? Strerror(errno) : "");
} else {
- if (errno != errno_isOS2)
- Perl_rc = _syserrno();
+ if (errno != errno_isOS2) {
+ int tmp = _syserrno();
+ if (tmp) /* 2nd call to _syserrno() makes it 0 */
+ Perl_rc = tmp;
+ }
sv_setnv(sv, (double)Perl_rc);
sv_setpv(sv, os2error(Perl_rc));
}
#else
+#ifdef WIN32
+ {
+ DWORD dwErr = GetLastError();
+ sv_setnv(sv, (double)dwErr);
+ if (dwErr)
+ {
+#ifdef PERL_OBJECT
+ char *sMsg;
+ DWORD dwLen;
+ PerlProc_GetSysMsg(sMsg, dwLen, dwErr);
+ sv_setpvn(sv, sMsg, dwLen);
+ PerlProc_FreeBuf(sMsg);
+#else
+ win32_str_os_error(sv, dwErr);
+#endif
+ }
+ else
+ sv_setpv(sv, "");
+ SetLastError(dwErr);
+ }
+#else
sv_setnv(sv, (double)errno);
sv_setpv(sv, errno ? Strerror(errno) : "");
#endif
#endif
+#endif
SvNOK_on(sv); /* what a wonderful hack! */
break;
case '\006': /* ^F */
- sv_setiv(sv, (IV)maxsysfd);
+ sv_setiv(sv, (IV)PL_maxsysfd);
break;
case '\010': /* ^H */
- sv_setiv(sv, (IV)hints);
+ sv_setiv(sv, (IV)PL_hints);
break;
- case '\t': /* ^I */
- if (inplace)
- sv_setpv(sv, inplace);
+ case '\011': /* ^I */ /* NOT \t in EBCDIC */
+ if (PL_inplace)
+ sv_setpv(sv, PL_inplace);
else
- sv_setsv(sv, &sv_undef);
+ sv_setsv(sv, &PL_sv_undef);
break;
case '\017': /* ^O */
- sv_setpv(sv, osname);
+ sv_setpv(sv, PL_osname);
break;
case '\020': /* ^P */
- sv_setiv(sv, (IV)perldb);
+ sv_setiv(sv, (IV)PL_perldb);
break;
case '\023': /* ^S */
- if (lex_state != LEX_NOTPARSING)
- SvOK_off(sv);
- else if (in_eval)
- sv_setiv(sv, 1);
- else
- sv_setiv(sv, 0);
+ {
+ dTHR;
+ if (PL_lex_state != LEX_NOTPARSING)
+ SvOK_off(sv);
+ else if (PL_in_eval)
+ sv_setiv(sv, 1);
+ else
+ sv_setiv(sv, 0);
+ }
break;
case '\024': /* ^T */
#ifdef BIG_TIME
- sv_setnv(sv, basetime);
+ sv_setnv(sv, PL_basetime);
#else
- sv_setiv(sv, (IV)basetime);
+ sv_setiv(sv, (IV)PL_basetime);
#endif
break;
case '\027': /* ^W */
- sv_setiv(sv, (IV)dowarn);
+ sv_setiv(sv, (IV)PL_dowarn);
break;
case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9': case '&':
- if (curpm && (rx = curpm->op_pmregexp)) {
- paren = atoi(GvENAME((GV*)mg->mg_obj));
+ if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
+ /*
+ * Pre-threads, this was paren = atoi(GvENAME((GV*)mg->mg_obj));
+ * XXX Does the new way break anything?
+ */
+ paren = atoi(mg->mg_ptr);
getparen:
if (paren <= rx->nparens &&
(s = rx->startp[paren]) &&
@@ -422,83 +482,85 @@ MAGIC *mg;
getrx:
if (i >= 0) {
bool was_tainted;
- if (tainting) {
- was_tainted = tainted;
- tainted = FALSE;
+ if (PL_tainting) {
+ was_tainted = PL_tainted;
+ PL_tainted = FALSE;
}
sv_setpvn(sv,s,i);
- if (tainting)
- tainted = was_tainted || rx->exec_tainted;
+ if (PL_tainting)
+ PL_tainted = (was_tainted || RX_MATCH_TAINTED(rx));
break;
}
}
}
- sv_setsv(sv,&sv_undef);
+ sv_setsv(sv,&PL_sv_undef);
break;
case '+':
- if (curpm && (rx = curpm->op_pmregexp)) {
+ if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
paren = rx->lastparen;
if (paren)
goto getparen;
}
- sv_setsv(sv,&sv_undef);
+ sv_setsv(sv,&PL_sv_undef);
break;
case '`':
- if (curpm && (rx = curpm->op_pmregexp)) {
+ if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
if ((s = rx->subbeg) && rx->startp[0]) {
i = rx->startp[0] - s;
goto getrx;
}
}
- sv_setsv(sv,&sv_undef);
+ sv_setsv(sv,&PL_sv_undef);
break;
case '\'':
- if (curpm && (rx = curpm->op_pmregexp)) {
+ if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
if (rx->subend && (s = rx->endp[0])) {
i = rx->subend - s;
goto getrx;
}
}
- sv_setsv(sv,&sv_undef);
+ sv_setsv(sv,&PL_sv_undef);
break;
case '.':
#ifndef lint
- if (GvIO(last_in_gv)) {
- sv_setiv(sv, (IV)IoLINES(GvIO(last_in_gv)));
+ if (GvIO(PL_last_in_gv)) {
+ sv_setiv(sv, (IV)IoLINES(GvIO(PL_last_in_gv)));
}
#endif
break;
case '?':
- sv_setiv(sv, (IV)STATUS_CURRENT);
+ {
+ sv_setiv(sv, (IV)STATUS_CURRENT);
#ifdef COMPLEX_STATUS
- LvTARGOFF(sv) = statusvalue;
- LvTARGLEN(sv) = statusvalue_vms;
+ LvTARGOFF(sv) = PL_statusvalue;
+ LvTARGLEN(sv) = PL_statusvalue_vms;
#endif
+ }
break;
case '^':
- s = IoTOP_NAME(GvIOp(defoutgv));
+ s = IoTOP_NAME(GvIOp(PL_defoutgv));
if (s)
sv_setpv(sv,s);
else {
- sv_setpv(sv,GvENAME(defoutgv));
+ sv_setpv(sv,GvENAME(PL_defoutgv));
sv_catpv(sv,"_TOP");
}
break;
case '~':
- s = IoFMT_NAME(GvIOp(defoutgv));
+ s = IoFMT_NAME(GvIOp(PL_defoutgv));
if (!s)
- s = GvENAME(defoutgv);
+ s = GvENAME(PL_defoutgv);
sv_setpv(sv,s);
break;
#ifndef lint
case '=':
- sv_setiv(sv, (IV)IoPAGE_LEN(GvIOp(defoutgv)));
+ sv_setiv(sv, (IV)IoPAGE_LEN(GvIOp(PL_defoutgv)));
break;
case '-':
- sv_setiv(sv, (IV)IoLINES_LEFT(GvIOp(defoutgv)));
+ sv_setiv(sv, (IV)IoLINES_LEFT(GvIOp(PL_defoutgv)));
break;
case '%':
- sv_setiv(sv, (IV)IoPAGE(GvIOp(defoutgv)));
+ sv_setiv(sv, (IV)IoPAGE(GvIOp(PL_defoutgv)));
break;
#endif
case ':':
@@ -506,19 +568,19 @@ MAGIC *mg;
case '/':
break;
case '[':
- sv_setiv(sv, (IV)curcop->cop_arybase);
+ WITH_THR(sv_setiv(sv, (IV)PL_curcop->cop_arybase));
break;
case '|':
- sv_setiv(sv, (IV)(IoFLAGS(GvIOp(defoutgv)) & IOf_FLUSH) != 0 );
+ sv_setiv(sv, (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0 );
break;
case ',':
- sv_setpvn(sv,ofs,ofslen);
+ sv_setpvn(sv,PL_ofs,PL_ofslen);
break;
case '\\':
- sv_setpvn(sv,ors,orslen);
+ sv_setpvn(sv,PL_ors,PL_orslen);
break;
case '#':
- sv_setpv(sv,ofmt);
+ sv_setpv(sv,PL_ofmt);
break;
case '!':
#ifdef VMS
@@ -539,18 +601,18 @@ MAGIC *mg;
SvNOK_on(sv); /* what a wonderful hack! */
break;
case '<':
- sv_setiv(sv, (IV)uid);
+ sv_setiv(sv, (IV)PL_uid);
break;
case '>':
- sv_setiv(sv, (IV)euid);
+ sv_setiv(sv, (IV)PL_euid);
break;
case '(':
- sv_setiv(sv, (IV)gid);
- sv_setpvf(sv, "%Vd", (IV)gid);
+ sv_setiv(sv, (IV)PL_gid);
+ sv_setpvf(sv, "%Vd", (IV)PL_gid);
goto add_groups;
case ')':
- sv_setiv(sv, (IV)egid);
- sv_setpvf(sv, "%Vd", (IV)egid);
+ sv_setiv(sv, (IV)PL_egid);
+ sv_setpvf(sv, "%Vd", (IV)PL_egid);
add_groups:
#ifdef HAS_GETGROUPS
{
@@ -566,14 +628,17 @@ MAGIC *mg;
break;
case '0':
break;
+#ifdef USE_THREADS
+ case '@':
+ sv_setsv(sv, thr->errsv);
+ break;
+#endif /* USE_THREADS */
}
return 0;
}
int
-magic_getuvar(sv, mg)
-SV *sv;
-MAGIC *mg;
+magic_getuvar(SV *sv, MAGIC *mg)
{
struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
@@ -583,9 +648,7 @@ MAGIC *mg;
}
int
-magic_setenv(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setenv(SV *sv, MAGIC *mg)
{
register char *s;
char *ptr;
@@ -601,15 +664,15 @@ MAGIC* mg;
/* waiting in the wings? */
if (!len) {
SV **valp;
- if ((valp = hv_fetch(GvHVn(envgv), ptr, klen, FALSE)))
+ if ((valp = hv_fetch(GvHVn(PL_envgv), ptr, klen, FALSE)))
s = SvPV(*valp, len);
}
#endif
-#if !defined(OS2) && !defined(AMIGAOS) && !defined(WIN32)
+#if !defined(OS2) && !defined(AMIGAOS) && !defined(WIN32) && !defined(MSDOS)
/* And you'll never guess what the dog had */
/* in its mouth... */
- if (tainting) {
+ if (PL_tainting) {
MgTAINTEDDIR_off(mg);
#ifdef VMS
if (s && klen == 8 && strEQ(ptr, "DCL$PATH")) {
@@ -641,49 +704,49 @@ MAGIC* mg;
char *strend = s + len;
while (s < strend) {
+ char tmpbuf[256];
struct stat st;
- s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf,
+ s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf,
s, strend, ':', &i);
s++;
- if (i >= sizeof tokenbuf /* too long -- assume the worst */
- || *tokenbuf != '/'
- || (Stat(tokenbuf, &st) == 0 && (st.st_mode & 2)) ) {
+ if (i >= sizeof tmpbuf /* too long -- assume the worst */
+ || *tmpbuf != '/'
+ || (PerlLIO_stat(tmpbuf, &st) == 0 && (st.st_mode & 2)) ) {
MgTAINTEDDIR_on(mg);
return 0;
}
}
}
}
-#endif /* neither OS2 nor AMIGAOS nor WIN32 */
+#endif /* neither OS2 nor AMIGAOS nor WIN32 nor MSDOS */
return 0;
}
int
-magic_clearenv(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_clearenv(SV *sv, MAGIC *mg)
{
- my_setenv(MgPV(mg,na),Nullch);
+ STRLEN n_a;
+ my_setenv(MgPV(mg,n_a),Nullch);
return 0;
}
int
-magic_set_all_env(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_set_all_env(SV *sv, MAGIC *mg)
{
#if defined(VMS)
die("Can't make list assignment to %%ENV on this system");
#else
- if (localizing) {
+ dTHR;
+ if (PL_localizing) {
HE* entry;
+ STRLEN n_a;
magic_clear_all_env(sv,mg);
hv_iterinit((HV*)sv);
while (entry = hv_iternext((HV*)sv)) {
I32 keylen;
my_setenv(hv_iterkey(entry, &keylen),
- SvPV(hv_iterval((HV*)sv, entry), na));
+ SvPV(hv_iterval((HV*)sv, entry), n_a));
}
}
#endif
@@ -691,9 +754,7 @@ MAGIC* mg;
}
int
-magic_clear_all_env(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_clear_all_env(SV *sv, MAGIC *mg)
{
#if defined(VMS)
die("Can't make list assignment to %%ENV on this system");
@@ -708,7 +769,7 @@ MAGIC* mg;
*end = '\0';
my_setenv(cur,Nullch);
*end = '=';
- cur += strlen(end+1)+1;
+ cur = end + strlen(end+1)+2;
}
else if ((len = strlen(cur)))
cur += len+1;
@@ -717,7 +778,7 @@ MAGIC* mg;
#else
I32 i;
- if (environ == origenviron)
+ if (environ == PL_origenviron)
New(901, environ, 1, char*);
else
for (i = 0; environ[i]; i++)
@@ -730,13 +791,12 @@ MAGIC* mg;
}
int
-magic_getsig(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_getsig(SV *sv, MAGIC *mg)
{
I32 i;
+ STRLEN n_a;
/* Are we fetching a signal entry? */
- i = whichsig(MgPV(mg,na));
+ i = whichsig(MgPV(mg,n_a));
if (i) {
if(psig_ptr[i])
sv_setsv(sv,psig_ptr[i]);
@@ -747,7 +807,7 @@ MAGIC* mg;
if(sigstate == SIG_IGN)
sv_setpv(sv,"IGNORE");
else
- sv_setsv(sv,&sv_undef);
+ sv_setsv(sv,&PL_sv_undef);
psig_ptr[i] = SvREFCNT_inc(sv);
SvTEMP_off(sv);
}
@@ -755,13 +815,12 @@ MAGIC* mg;
return 0;
}
int
-magic_clearsig(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_clearsig(SV *sv, MAGIC *mg)
{
I32 i;
+ STRLEN n_a;
/* Are we clearing a signal entry? */
- i = whichsig(MgPV(mg,na));
+ i = whichsig(MgPV(mg,n_a));
if (i) {
if(psig_ptr[i]) {
SvREFCNT_dec(psig_ptr[i]);
@@ -776,22 +835,22 @@ MAGIC* mg;
}
int
-magic_setsig(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setsig(SV *sv, MAGIC *mg)
{
+ dTHR;
register char *s;
I32 i;
SV** svp;
+ STRLEN n_a;
- s = MgPV(mg,na);
+ s = MgPV(mg,n_a);
if (*s == '_') {
if (strEQ(s,"__DIE__"))
- svp = &diehook;
+ svp = &PL_diehook;
else if (strEQ(s,"__WARN__"))
- svp = &warnhook;
+ svp = &PL_warnhook;
else if (strEQ(s,"__PARSE__"))
- svp = &parsehook;
+ svp = &PL_parsehook;
else
croak("No such hook: %s", s);
i = 0;
@@ -803,7 +862,7 @@ MAGIC* mg;
else {
i = whichsig(s); /* ...no, a brick */
if (!i) {
- if (dowarn || strEQ(s,"ALARM"))
+ if (PL_dowarn || strEQ(s,"ALARM"))
warn("No such signal: SIG%s", s);
return 0;
}
@@ -816,12 +875,12 @@ MAGIC* mg;
}
if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
if (i)
- (void)rsignal(i, sighandler);
+ (void)rsignal(i, PL_sighandlerp);
else
*svp = SvREFCNT_inc(sv);
return 0;
}
- s = SvPV_force(sv,na);
+ s = SvPV_force(sv,n_a);
if (strEQ(s,"IGNORE")) {
if (i)
(void)rsignal(i, SIG_IGN);
@@ -843,7 +902,7 @@ MAGIC* mg;
if (!strchr(s,':') && !strchr(s,'\''))
sv_setpv(sv, form("main::%s", s));
if (i)
- (void)rsignal(i, sighandler);
+ (void)rsignal(i, PL_sighandlerp);
else
*svp = SvREFCNT_inc(sv);
}
@@ -851,75 +910,105 @@ MAGIC* mg;
}
int
-magic_setisa(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setisa(SV *sv, MAGIC *mg)
{
- sub_generation++;
+ PL_sub_generation++;
return 0;
}
#ifdef OVERLOAD
int
-magic_setamagic(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setamagic(SV *sv, MAGIC *mg)
{
/* HV_badAMAGIC_on(Sv_STASH(sv)); */
- amagic_generation++;
+ PL_amagic_generation++;
return 0;
}
#endif /* OVERLOAD */
int
-magic_setnkeys(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_getnkeys(SV *sv, MAGIC *mg)
+{
+ HV *hv = (HV*)LvTARG(sv);
+ HE *entry;
+ I32 i = 0;
+
+ if (hv) {
+ (void) hv_iterinit(hv);
+ if (! SvTIED_mg((SV*)hv, 'P'))
+ i = HvKEYS(hv);
+ else {
+ /*SUPPRESS 560*/
+ while (entry = hv_iternext(hv)) {
+ i++;
+ }
+ }
+ }
+
+ sv_setiv(sv, (IV)i);
+ return 0;
+}
+
+int
+magic_setnkeys(SV *sv, MAGIC *mg)
{
if (LvTARG(sv)) {
hv_ksplit((HV*)LvTARG(sv), SvIV(sv));
- LvTARG(sv) = Nullsv; /* Don't allow a ref to reassign this. */
}
return 0;
+}
+
+/* caller is responsible for stack switching/cleanup */
+STATIC int
+magic_methcall(SV *sv, MAGIC *mg, char *meth, I32 flags, int n, SV *val)
+{
+ dSP;
+
+ PUSHMARK(SP);
+ EXTEND(SP, n);
+ PUSHs(SvTIED_obj(sv, mg));
+ if (n > 1) {
+ if (mg->mg_ptr) {
+ if (mg->mg_len >= 0)
+ PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
+ else if (mg->mg_len == HEf_SVKEY)
+ PUSHs((SV*)mg->mg_ptr);
+ }
+ else if (mg->mg_type == 'p') {
+ PUSHs(sv_2mortal(newSViv(mg->mg_len)));
+ }
+ }
+ if (n > 2) {
+ PUSHs(val);
+ }
+ PUTBACK;
+
+ return perl_call_method(meth, flags);
}
-static int
-magic_methpack(sv,mg,meth)
-SV* sv;
-MAGIC* mg;
-char *meth;
+STATIC int
+magic_methpack(SV *sv, MAGIC *mg, char *meth)
{
dSP;
ENTER;
SAVETMPS;
- PUSHMARK(sp);
- EXTEND(sp, 2);
- PUSHs(mg->mg_obj);
- if (mg->mg_ptr) {
- if (mg->mg_len >= 0)
- PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
- else if (mg->mg_len == HEf_SVKEY)
- PUSHs((SV*)mg->mg_ptr);
- }
- else if (mg->mg_type == 'p')
- PUSHs(sv_2mortal(newSViv(mg->mg_len)));
- PUTBACK;
+ PUSHSTACKi(PERLSI_MAGIC);
- if (perl_call_method(meth, G_SCALAR))
- sv_setsv(sv, *stack_sp--);
+ if (magic_methcall(sv, mg, meth, G_SCALAR, 2, NULL)) {
+ sv_setsv(sv, *PL_stack_sp--);
+ }
+ POPSTACK;
FREETMPS;
LEAVE;
return 0;
}
int
-magic_getpack(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_getpack(SV *sv, MAGIC *mg)
{
magic_methpack(sv,mg,"FETCH");
if (mg->mg_ptr)
@@ -928,102 +1017,103 @@ MAGIC* mg;
}
int
-magic_setpack(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setpack(SV *sv, MAGIC *mg)
{
dSP;
-
- PUSHMARK(sp);
- EXTEND(sp, 3);
- PUSHs(mg->mg_obj);
- if (mg->mg_ptr) {
- if (mg->mg_len >= 0)
- PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
- else if (mg->mg_len == HEf_SVKEY)
- PUSHs((SV*)mg->mg_ptr);
- }
- else if (mg->mg_type == 'p')
- PUSHs(sv_2mortal(newSViv(mg->mg_len)));
- PUSHs(sv);
- PUTBACK;
-
- perl_call_method("STORE", G_SCALAR|G_DISCARD);
-
+ ENTER;
+ PUSHSTACKi(PERLSI_MAGIC);
+ magic_methcall(sv, mg, "STORE", G_SCALAR|G_DISCARD, 3, sv);
+ POPSTACK;
+ LEAVE;
return 0;
}
int
-magic_clearpack(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_clearpack(SV *sv, MAGIC *mg)
{
return magic_methpack(sv,mg,"DELETE");
}
-int magic_wipepack(sv,mg)
-SV* sv;
-MAGIC* mg;
+
+U32
+magic_sizepack(SV *sv, MAGIC *mg)
+{
+ dSP;
+ U32 retval = 0;
+
+ ENTER;
+ SAVETMPS;
+ PUSHSTACKi(PERLSI_MAGIC);
+ if (magic_methcall(sv, mg, "FETCHSIZE", G_SCALAR, 2, NULL)) {
+ sv = *PL_stack_sp--;
+ retval = (U32) SvIV(sv)-1;
+ }
+ POPSTACK;
+ FREETMPS;
+ LEAVE;
+ return retval;
+}
+
+int magic_wipepack(SV *sv, MAGIC *mg)
{
dSP;
- PUSHMARK(sp);
- XPUSHs(mg->mg_obj);
+ ENTER;
+ PUSHSTACKi(PERLSI_MAGIC);
+ PUSHMARK(SP);
+ XPUSHs(SvTIED_obj(sv, mg));
PUTBACK;
-
perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
-
+ POPSTACK;
+ LEAVE;
return 0;
}
int
-magic_nextpack(sv,mg,key)
-SV* sv;
-MAGIC* mg;
-SV* key;
+magic_nextpack(SV *sv, MAGIC *mg, SV *key)
{
dSP;
char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
ENTER;
SAVETMPS;
- PUSHMARK(sp);
- EXTEND(sp, 2);
- PUSHs(mg->mg_obj);
+ PUSHSTACKi(PERLSI_MAGIC);
+ PUSHMARK(SP);
+ EXTEND(SP, 2);
+ PUSHs(SvTIED_obj(sv, mg));
if (SvOK(key))
PUSHs(key);
PUTBACK;
if (perl_call_method(meth, G_SCALAR))
- sv_setsv(key, *stack_sp--);
+ sv_setsv(key, *PL_stack_sp--);
+ POPSTACK;
FREETMPS;
LEAVE;
return 0;
}
int
-magic_existspack(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_existspack(SV *sv, MAGIC *mg)
{
return magic_methpack(sv,mg,"EXISTS");
}
int
-magic_setdbline(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setdbline(SV *sv, MAGIC *mg)
{
+ dTHR;
OP *o;
I32 i;
GV* gv;
SV** svp;
+ STRLEN n_a;
- gv = DBline;
+ gv = PL_DBline;
i = SvTRUE(sv);
svp = av_fetch(GvAV(gv),
- atoi(MgPV(mg,na)), FALSE);
+ atoi(MgPV(mg,n_a)), FALSE);
if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
o->op_private = i;
else
@@ -1032,34 +1122,31 @@ MAGIC* mg;
}
int
-magic_getarylen(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_getarylen(SV *sv, MAGIC *mg)
{
- sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + curcop->cop_arybase);
+ dTHR;
+ sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + PL_curcop->cop_arybase);
return 0;
}
int
-magic_setarylen(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setarylen(SV *sv, MAGIC *mg)
{
- av_fill((AV*)mg->mg_obj, SvIV(sv) - curcop->cop_arybase);
+ dTHR;
+ av_fill((AV*)mg->mg_obj, SvIV(sv) - PL_curcop->cop_arybase);
return 0;
}
int
-magic_getpos(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_getpos(SV *sv, MAGIC *mg)
{
SV* lsv = LvTARG(sv);
if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
mg = mg_find(lsv, 'g');
if (mg && mg->mg_len >= 0) {
- sv_setiv(sv, mg->mg_len + curcop->cop_arybase);
+ dTHR;
+ sv_setiv(sv, mg->mg_len + PL_curcop->cop_arybase);
return 0;
}
}
@@ -1068,9 +1155,7 @@ MAGIC* mg;
}
int
-magic_setpos(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setpos(SV *sv, MAGIC *mg)
{
SV* lsv = LvTARG(sv);
SSize_t pos;
@@ -1092,7 +1177,7 @@ MAGIC* mg;
}
len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
- pos = SvIV(sv) - curcop->cop_arybase;
+ WITH_THR(pos = SvIV(sv) - PL_curcop->cop_arybase);
if (pos < 0) {
pos += len;
if (pos < 0)
@@ -1107,9 +1192,7 @@ MAGIC* mg;
}
int
-magic_getglob(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_getglob(SV *sv, MAGIC *mg)
{
if (SvFAKE(sv)) { /* FAKE globs can get coerced */
SvFAKE_off(sv);
@@ -1122,16 +1205,15 @@ MAGIC* mg;
}
int
-magic_setglob(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setglob(SV *sv, MAGIC *mg)
{
register char *s;
GV* gv;
+ STRLEN n_a;
if (!SvOK(sv))
return 0;
- s = SvPV(sv, na);
+ s = SvPV(sv, n_a);
if (*s == '*' && s[1])
s++;
gv = gv_fetchpv(s,TRUE, SVt_PVGV);
@@ -1144,9 +1226,24 @@ MAGIC* mg;
}
int
-magic_setsubstr(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_getsubstr(SV *sv, MAGIC *mg)
+{
+ STRLEN len;
+ SV *lsv = LvTARG(sv);
+ char *tmps = SvPV(lsv,len);
+ I32 offs = LvTARGOFF(sv);
+ I32 rem = LvTARGLEN(sv);
+
+ if (offs > len)
+ offs = len;
+ if (rem + offs > len)
+ rem = len - offs;
+ sv_setpvn(sv, tmps + offs, (STRLEN)rem);
+ return 0;
+}
+
+int
+magic_setsubstr(SV *sv, MAGIC *mg)
{
STRLEN len;
char *tmps = SvPV(sv,len);
@@ -1155,27 +1252,25 @@ MAGIC* mg;
}
int
-magic_gettaint(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_gettaint(SV *sv, MAGIC *mg)
{
+ dTHR;
TAINT_IF((mg->mg_len & 1) ||
(mg->mg_len & 2) && mg->mg_obj == sv); /* kludge */
return 0;
}
int
-magic_settaint(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_settaint(SV *sv, MAGIC *mg)
{
- if (localizing) {
- if (localizing == 1)
+ dTHR;
+ if (PL_localizing) {
+ if (PL_localizing == 1)
mg->mg_len <<= 1;
else
mg->mg_len >>= 1;
}
- else if (tainted)
+ else if (PL_tainted)
mg->mg_len |= 1;
else
mg->mg_len &= ~1;
@@ -1183,33 +1278,103 @@ MAGIC* mg;
}
int
-magic_setvec(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_getvec(SV *sv, MAGIC *mg)
+{
+ SV *lsv = LvTARG(sv);
+ unsigned char *s;
+ unsigned long retnum;
+ STRLEN lsvlen;
+ I32 len;
+ I32 offset;
+ I32 size;
+
+ if (!lsv) {
+ SvOK_off(sv);
+ return 0;
+ }
+ s = (unsigned char *) SvPV(lsv, lsvlen);
+ offset = LvTARGOFF(sv);
+ size = LvTARGLEN(sv);
+ len = (offset + size + 7) / 8;
+
+ /* Copied from pp_vec() */
+
+ if (len > lsvlen) {
+ if (size <= 8)
+ retnum = 0;
+ else {
+ offset >>= 3;
+ if (size == 16) {
+ if (offset >= lsvlen)
+ retnum = 0;
+ else
+ retnum = (unsigned long) s[offset] << 8;
+ }
+ else if (size == 32) {
+ if (offset >= lsvlen)
+ retnum = 0;
+ else if (offset + 1 >= lsvlen)
+ retnum = (unsigned long) s[offset] << 24;
+ else if (offset + 2 >= lsvlen)
+ retnum = ((unsigned long) s[offset] << 24) +
+ ((unsigned long) s[offset + 1] << 16);
+ else
+ retnum = ((unsigned long) s[offset] << 24) +
+ ((unsigned long) s[offset + 1] << 16) +
+ (s[offset + 2] << 8);
+ }
+ }
+ }
+ else if (size < 8)
+ retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
+ else {
+ offset >>= 3;
+ if (size == 8)
+ retnum = s[offset];
+ else if (size == 16)
+ retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
+ else if (size == 32)
+ retnum = ((unsigned long) s[offset] << 24) +
+ ((unsigned long) s[offset + 1] << 16) +
+ (s[offset + 2] << 8) + s[offset+3];
+ }
+
+ sv_setuv(sv, (UV)retnum);
+ return 0;
+}
+
+int
+magic_setvec(SV *sv, MAGIC *mg)
{
do_vecset(sv); /* XXX slurp this routine */
return 0;
}
int
-magic_getdefelem(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_getdefelem(SV *sv, MAGIC *mg)
{
SV *targ = Nullsv;
if (LvTARGLEN(sv)) {
if (mg->mg_obj) {
- HV* hv = (HV*)LvTARG(sv);
- HE* he = hv_fetch_ent(hv, mg->mg_obj, FALSE, 0);
- if (he)
- targ = HeVAL(he);
+ SV *ahv = LvTARG(sv);
+ if (SvTYPE(ahv) == SVt_PVHV) {
+ HE *he = hv_fetch_ent((HV*)ahv, mg->mg_obj, FALSE, 0);
+ if (he)
+ targ = HeVAL(he);
+ }
+ else {
+ SV **svp = avhv_fetch_ent((AV*)ahv, mg->mg_obj, FALSE, 0);
+ if (svp)
+ targ = *svp;
+ }
}
else {
AV* av = (AV*)LvTARG(sv);
if ((I32)LvTARGOFF(sv) <= AvFILL(av))
targ = AvARRAY(av)[LvTARGOFF(sv)];
}
- if (targ && targ != &sv_undef) {
+ if (targ && targ != &PL_sv_undef) {
+ dTHR; /* just for SvREFCNT_dec */
/* somebody else defined it for us */
SvREFCNT_dec(LvTARG(sv));
LvTARG(sv) = SvREFCNT_inc(targ);
@@ -1221,14 +1386,12 @@ MAGIC* mg;
}
else
targ = LvTARG(sv);
- sv_setsv(sv, targ ? targ : &sv_undef);
+ sv_setsv(sv, targ ? targ : &PL_sv_undef);
return 0;
}
int
-magic_setdefelem(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setdefelem(SV *sv, MAGIC *mg)
{
if (LvTARGLEN(sv))
vivify_defelem(sv);
@@ -1239,29 +1402,31 @@ MAGIC* mg;
return 0;
}
-int
-magic_freedefelem(sv,mg)
-SV* sv;
-MAGIC* mg;
-{
- SvREFCNT_dec(LvTARG(sv));
- return 0;
-}
-
void
-vivify_defelem(sv)
-SV* sv;
+vivify_defelem(SV *sv)
{
- MAGIC* mg;
- SV* value;
+ dTHR; /* just for SvREFCNT_inc and SvREFCNT_dec*/
+ MAGIC *mg;
+ SV *value = Nullsv;
if (!LvTARGLEN(sv) || !(mg = mg_find(sv, 'y')))
return;
if (mg->mg_obj) {
- HV* hv = (HV*)LvTARG(sv);
- HE* he = hv_fetch_ent(hv, mg->mg_obj, TRUE, 0);
- if (!he || (value = HeVAL(he)) == &sv_undef)
- croak(no_helem, SvPV(mg->mg_obj, na));
+ SV *ahv = LvTARG(sv);
+ if (SvTYPE(ahv) == SVt_PVHV) {
+ HE *he = hv_fetch_ent((HV*)ahv, mg->mg_obj, TRUE, 0);
+ if (he)
+ value = HeVAL(he);
+ }
+ else {
+ SV **svp = avhv_fetch_ent((AV*)ahv, mg->mg_obj, TRUE, 0);
+ if (svp)
+ value = *svp;
+ }
+ if (!value || value == &PL_sv_undef) {
+ STRLEN n_a;
+ croak(no_helem, SvPV(mg->mg_obj, n_a));
+ }
}
else {
AV* av = (AV*)LvTARG(sv);
@@ -1269,7 +1434,7 @@ SV* sv;
LvTARG(sv) = Nullsv; /* array can't be extended */
else {
SV** svp = av_fetch(av, LvTARGOFF(sv), TRUE);
- if (!svp || (value = *svp) == &sv_undef)
+ if (!svp || (value = *svp) == &PL_sv_undef)
croak(no_aelem, (I32)LvTARGOFF(sv));
}
}
@@ -1283,9 +1448,7 @@ SV* sv;
}
int
-magic_setmglob(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setmglob(SV *sv, MAGIC *mg)
{
mg->mg_len = -1;
SvSCREAM_off(sv);
@@ -1293,9 +1456,7 @@ MAGIC* mg;
}
int
-magic_setbm(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setbm(SV *sv, MAGIC *mg)
{
sv_unmagic(sv, 'B');
SvVALID_off(sv);
@@ -1303,9 +1464,7 @@ MAGIC* mg;
}
int
-magic_setfm(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setfm(SV *sv, MAGIC *mg)
{
sv_unmagic(sv, 'f');
SvCOMPILED_off(sv);
@@ -1313,9 +1472,7 @@ MAGIC* mg;
}
int
-magic_setuvar(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setuvar(SV *sv, MAGIC *mg)
{
struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
@@ -1324,11 +1481,17 @@ MAGIC* mg;
return 0;
}
+int
+magic_freeregexp(SV *sv, MAGIC *mg)
+{
+ regexp *re = (regexp *)mg->mg_obj;
+ ReREFCNT_dec(re);
+ return 0;
+}
+
#ifdef USE_LOCALE_COLLATE
int
-magic_setcollxfrm(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setcollxfrm(SV *sv, MAGIC *mg)
{
/*
* René Descartes said "I think not."
@@ -1344,96 +1507,102 @@ MAGIC* mg;
#endif /* USE_LOCALE_COLLATE */
int
-magic_set(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_set(SV *sv, MAGIC *mg)
{
+ dTHR;
register char *s;
I32 i;
STRLEN len;
switch (*mg->mg_ptr) {
case '\001': /* ^A */
- sv_setsv(bodytarget, sv);
+ sv_setsv(PL_bodytarget, sv);
+ break;
+ case '\003': /* ^C */
+ PL_minus_c = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
break;
case '\004': /* ^D */
- debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000;
+ PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000;
DEBUG_x(dump_all());
break;
case '\005': /* ^E */
#ifdef VMS
set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
#else
+#ifdef WIN32
+ SetLastError( SvIV(sv) );
+#else
/* will anyone ever use this? */
SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
#endif
+#endif
break;
case '\006': /* ^F */
- maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ PL_maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
break;
case '\010': /* ^H */
- hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ PL_hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
break;
- case '\t': /* ^I */
- if (inplace)
- Safefree(inplace);
+ case '\011': /* ^I */ /* NOT \t in EBCDIC */
+ if (PL_inplace)
+ Safefree(PL_inplace);
if (SvOK(sv))
- inplace = savepv(SvPV(sv,na));
+ PL_inplace = savepv(SvPV(sv,len));
else
- inplace = Nullch;
+ PL_inplace = Nullch;
break;
case '\017': /* ^O */
- if (osname)
- Safefree(osname);
+ if (PL_osname)
+ Safefree(PL_osname);
if (SvOK(sv))
- osname = savepv(SvPV(sv,na));
+ PL_osname = savepv(SvPV(sv,len));
else
- osname = Nullch;
+ PL_osname = Nullch;
break;
case '\020': /* ^P */
- perldb = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ PL_perldb = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
break;
case '\024': /* ^T */
#ifdef BIG_TIME
- basetime = (Time_t)(SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv));
+ PL_basetime = (Time_t)(SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv));
#else
- basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ PL_basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
#endif
break;
case '\027': /* ^W */
- dowarn = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ PL_dowarn = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
break;
case '.':
- if (localizing) {
- if (localizing == 1)
- save_sptr((SV**)&last_in_gv);
+ if (PL_localizing) {
+ if (PL_localizing == 1)
+ save_sptr((SV**)&PL_last_in_gv);
}
- else if (SvOK(sv) && GvIO(last_in_gv))
- IoLINES(GvIOp(last_in_gv)) = (long)SvIV(sv);
+ else if (SvOK(sv) && GvIO(PL_last_in_gv))
+ IoLINES(GvIOp(PL_last_in_gv)) = (long)SvIV(sv);
break;
case '^':
- Safefree(IoTOP_NAME(GvIOp(defoutgv)));
- IoTOP_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
- IoTOP_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
+ Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
+ IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
+ IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
break;
case '~':
- Safefree(IoFMT_NAME(GvIOp(defoutgv)));
- IoFMT_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
- IoFMT_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
+ Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
+ IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
+ IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
break;
case '=':
- IoPAGE_LEN(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ IoPAGE_LEN(GvIOp(PL_defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
break;
case '-':
- IoLINES_LEFT(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
- if (IoLINES_LEFT(GvIOp(defoutgv)) < 0L)
- IoLINES_LEFT(GvIOp(defoutgv)) = 0L;
+ IoLINES_LEFT(GvIOp(PL_defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ if (IoLINES_LEFT(GvIOp(PL_defoutgv)) < 0L)
+ IoLINES_LEFT(GvIOp(PL_defoutgv)) = 0L;
break;
case '%':
- IoPAGE(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ IoPAGE(GvIOp(PL_defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
break;
case '|':
{
- IO *io = GvIOp(defoutgv);
+ IO *io = GvIOp(PL_defoutgv);
if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) == 0)
IoFLAGS(io) &= ~IOf_FLUSH;
else {
@@ -1448,42 +1617,42 @@ MAGIC* mg;
break;
case '*':
i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
- multiline = (i != 0);
+ PL_multiline = (i != 0);
break;
case '/':
- SvREFCNT_dec(nrs);
- nrs = newSVsv(sv);
- SvREFCNT_dec(rs);
- rs = SvREFCNT_inc(nrs);
+ SvREFCNT_dec(PL_nrs);
+ PL_nrs = newSVsv(sv);
+ SvREFCNT_dec(PL_rs);
+ PL_rs = SvREFCNT_inc(PL_nrs);
break;
case '\\':
- if (ors)
- Safefree(ors);
+ if (PL_ors)
+ Safefree(PL_ors);
if (SvOK(sv) || SvGMAGICAL(sv))
- ors = savepv(SvPV(sv,orslen));
+ PL_ors = savepv(SvPV(sv,PL_orslen));
else {
- ors = Nullch;
- orslen = 0;
+ PL_ors = Nullch;
+ PL_orslen = 0;
}
break;
case ',':
- if (ofs)
- Safefree(ofs);
- ofs = savepv(SvPV(sv, ofslen));
+ if (PL_ofs)
+ Safefree(PL_ofs);
+ PL_ofs = savepv(SvPV(sv, PL_ofslen));
break;
case '#':
- if (ofmt)
- Safefree(ofmt);
- ofmt = savepv(SvPV(sv,na));
+ if (PL_ofmt)
+ Safefree(PL_ofmt);
+ PL_ofmt = savepv(SvPV(sv,len));
break;
case '[':
- compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
break;
case '?':
#ifdef COMPLEX_STATUS
- if (localizing == 2) {
- statusvalue = LvTARGOFF(sv);
- statusvalue_vms = LvTARGLEN(sv);
+ if (PL_localizing == 2) {
+ PL_statusvalue = LvTARGOFF(sv);
+ PL_statusvalue_vms = LvTARGLEN(sv);
}
else
#endif
@@ -1495,100 +1664,100 @@ MAGIC* mg;
STATUS_POSIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
break;
case '!':
- SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),
+ SETERRNO(SvIOK(sv) ? SvIVX(sv) : SvOK(sv) ? sv_2iv(sv) : 0,
(SvIV(sv) == EVMSERR) ? 4 : vaxc$errno);
break;
case '<':
- uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
- if (delaymagic) {
- delaymagic |= DM_RUID;
+ PL_uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ if (PL_delaymagic) {
+ PL_delaymagic |= DM_RUID;
break; /* don't do magic till later */
}
#ifdef HAS_SETRUID
- (void)setruid((Uid_t)uid);
+ (void)setruid((Uid_t)PL_uid);
#else
#ifdef HAS_SETREUID
- (void)setreuid((Uid_t)uid, (Uid_t)-1);
+ (void)setreuid((Uid_t)PL_uid, (Uid_t)-1);
#else
#ifdef HAS_SETRESUID
- (void)setresuid((Uid_t)uid, (Uid_t)-1, (Uid_t)-1);
+ (void)setresuid((Uid_t)PL_uid, (Uid_t)-1, (Uid_t)-1);
#else
- if (uid == euid) /* special case $< = $> */
- (void)setuid(uid);
+ if (PL_uid == PL_euid) /* special case $< = $> */
+ (void)PerlProc_setuid(PL_uid);
else {
- uid = (I32)getuid();
+ PL_uid = (I32)PerlProc_getuid();
croak("setruid() not implemented");
}
#endif
#endif
#endif
- uid = (I32)getuid();
- tainting |= (uid && (euid != uid || egid != gid));
+ PL_uid = (I32)PerlProc_getuid();
+ PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
break;
case '>':
- euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
- if (delaymagic) {
- delaymagic |= DM_EUID;
+ PL_euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ if (PL_delaymagic) {
+ PL_delaymagic |= DM_EUID;
break; /* don't do magic till later */
}
#ifdef HAS_SETEUID
- (void)seteuid((Uid_t)euid);
+ (void)seteuid((Uid_t)PL_euid);
#else
#ifdef HAS_SETREUID
- (void)setreuid((Uid_t)-1, (Uid_t)euid);
+ (void)setreuid((Uid_t)-1, (Uid_t)PL_euid);
#else
#ifdef HAS_SETRESUID
- (void)setresuid((Uid_t)-1, (Uid_t)euid, (Uid_t)-1);
+ (void)setresuid((Uid_t)-1, (Uid_t)PL_euid, (Uid_t)-1);
#else
- if (euid == uid) /* special case $> = $< */
- setuid(euid);
+ if (PL_euid == PL_uid) /* special case $> = $< */
+ PerlProc_setuid(PL_euid);
else {
- euid = (I32)geteuid();
+ PL_euid = (I32)PerlProc_geteuid();
croak("seteuid() not implemented");
}
#endif
#endif
#endif
- euid = (I32)geteuid();
- tainting |= (uid && (euid != uid || egid != gid));
+ PL_euid = (I32)PerlProc_geteuid();
+ PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
break;
case '(':
- gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
- if (delaymagic) {
- delaymagic |= DM_RGID;
+ PL_gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ if (PL_delaymagic) {
+ PL_delaymagic |= DM_RGID;
break; /* don't do magic till later */
}
#ifdef HAS_SETRGID
- (void)setrgid((Gid_t)gid);
+ (void)setrgid((Gid_t)PL_gid);
#else
#ifdef HAS_SETREGID
- (void)setregid((Gid_t)gid, (Gid_t)-1);
+ (void)setregid((Gid_t)PL_gid, (Gid_t)-1);
#else
#ifdef HAS_SETRESGID
- (void)setresgid((Gid_t)gid, (Gid_t)-1, (Gid_t) 1);
+ (void)setresgid((Gid_t)PL_gid, (Gid_t)-1, (Gid_t) 1);
#else
- if (gid == egid) /* special case $( = $) */
- (void)setgid(gid);
+ if (PL_gid == PL_egid) /* special case $( = $) */
+ (void)PerlProc_setgid(PL_gid);
else {
- gid = (I32)getgid();
+ PL_gid = (I32)PerlProc_getgid();
croak("setrgid() not implemented");
}
#endif
#endif
#endif
- gid = (I32)getgid();
- tainting |= (uid && (euid != uid || egid != gid));
+ PL_gid = (I32)PerlProc_getgid();
+ PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
break;
case ')':
#ifdef HAS_SETGROUPS
{
- char *p = SvPV(sv, na);
+ char *p = SvPV(sv, len);
Groups_t gary[NGROUPS];
SET_NUMERIC_STANDARD();
while (isSPACE(*p))
++p;
- egid = I_V(atof(p));
+ PL_egid = I_V(atof(p));
for (i = 0; i < NGROUPS; ++i) {
while (*p && !isSPACE(*p))
++p;
@@ -1602,95 +1771,119 @@ MAGIC* mg;
(void)setgroups(i, gary);
}
#else /* HAS_SETGROUPS */
- egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ PL_egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
#endif /* HAS_SETGROUPS */
- if (delaymagic) {
- delaymagic |= DM_EGID;
+ if (PL_delaymagic) {
+ PL_delaymagic |= DM_EGID;
break; /* don't do magic till later */
}
#ifdef HAS_SETEGID
- (void)setegid((Gid_t)egid);
+ (void)setegid((Gid_t)PL_egid);
#else
#ifdef HAS_SETREGID
- (void)setregid((Gid_t)-1, (Gid_t)egid);
+ (void)setregid((Gid_t)-1, (Gid_t)PL_egid);
#else
#ifdef HAS_SETRESGID
- (void)setresgid((Gid_t)-1, (Gid_t)egid, (Gid_t)-1);
+ (void)setresgid((Gid_t)-1, (Gid_t)PL_egid, (Gid_t)-1);
#else
- if (egid == gid) /* special case $) = $( */
- (void)setgid(egid);
+ if (PL_egid == PL_gid) /* special case $) = $( */
+ (void)PerlProc_setgid(PL_egid);
else {
- egid = (I32)getegid();
+ PL_egid = (I32)PerlProc_getegid();
croak("setegid() not implemented");
}
#endif
#endif
#endif
- egid = (I32)getegid();
- tainting |= (uid && (euid != uid || egid != gid));
+ PL_egid = (I32)PerlProc_getegid();
+ PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
break;
case ':':
- chopset = SvPV_force(sv,na);
+ PL_chopset = SvPV_force(sv,len);
break;
case '0':
- if (!origalen) {
- s = origargv[0];
+ if (!PL_origalen) {
+ s = PL_origargv[0];
s += strlen(s);
/* See if all the arguments are contiguous in memory */
- for (i = 1; i < origargc; i++) {
- if (origargv[i] == s + 1
+ for (i = 1; i < PL_origargc; i++) {
+ if (PL_origargv[i] == s + 1
#ifdef OS2
- || origargv[i] == s + 2
+ || PL_origargv[i] == s + 2
#endif
)
- s += strlen(++s); /* this one is ok too */
+ {
+ ++s;
+ s += strlen(s); /* this one is ok too */
+ }
else
break;
}
/* can grab env area too? */
- if (origenviron && (origenviron[0] == s + 1
+ if (PL_origenviron && (PL_origenviron[0] == s + 1
#ifdef OS2
- || (origenviron[0] == s + 9 && (s += 8))
+ || (PL_origenviron[0] == s + 9 && (s += 8))
#endif
)) {
my_setenv("NoNe SuCh", Nullch);
/* force copy of environment */
- for (i = 0; origenviron[i]; i++)
- if (origenviron[i] == s + 1)
- s += strlen(++s);
+ for (i = 0; PL_origenviron[i]; i++)
+ if (PL_origenviron[i] == s + 1) {
+ ++s;
+ s += strlen(s);
+ }
else
break;
}
- origalen = s - origargv[0];
+ PL_origalen = s - PL_origargv[0];
}
s = SvPV_force(sv,len);
i = len;
- if (i >= origalen) {
- i = origalen;
+ if (i >= PL_origalen) {
+ i = PL_origalen;
/* don't allow system to limit $0 seen by script */
/* SvCUR_set(sv, i); *SvEND(sv) = '\0'; */
- Copy(s, origargv[0], i, char);
- s = origargv[0]+i;
+ Copy(s, PL_origargv[0], i, char);
+ s = PL_origargv[0]+i;
*s = '\0';
}
else {
- Copy(s, origargv[0], i, char);
- s = origargv[0]+i;
+ Copy(s, PL_origargv[0], i, char);
+ s = PL_origargv[0]+i;
*s++ = '\0';
- while (++i < origalen)
+ while (++i < PL_origalen)
*s++ = ' ';
- s = origargv[0]+i;
- for (i = 1; i < origargc; i++)
- origargv[i] = Nullch;
+ s = PL_origargv[0]+i;
+ for (i = 1; i < PL_origargc; i++)
+ PL_origargv[i] = Nullch;
}
break;
+#ifdef USE_THREADS
+ case '@':
+ sv_setsv(thr->errsv, sv);
+ break;
+#endif /* USE_THREADS */
}
return 0;
}
+#ifdef USE_THREADS
+int
+magic_mutexfree(SV *sv, MAGIC *mg)
+{
+ dTHR;
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: magic_mutexfree 0x%lx\n",
+ (unsigned long)thr, (unsigned long)sv);)
+ if (MgOWNER(mg))
+ croak("panic: magic_mutexfree");
+ MUTEX_DESTROY(MgMUTEXP(mg));
+ COND_DESTROY(MgCONDP(mg));
+ return 0;
+}
+#endif /* USE_THREADS */
+
I32
-whichsig(sig)
-char *sig;
+whichsig(char *sig)
{
register char **sigv;
@@ -1710,52 +1903,41 @@ char *sig;
static SV* sig_sv;
-static void
-unwind_handler_stack(p)
- void *p;
+STATIC void
+unwind_handler_stack(void *p)
{
+ dTHR;
U32 flags = *(U32*)p;
if (flags & 1)
- savestack_ix -= 5; /* Unprotect save in progress. */
+ PL_savestack_ix -= 5; /* Unprotect save in progress. */
/* cxstack_ix-- Not needed, die already unwound it. */
if (flags & 64)
SvREFCNT_dec(sig_sv);
}
Signal_t
-sighandler(sig)
-int sig;
+sighandler(int sig)
{
dSP;
- GV *gv;
+ GV *gv = Nullgv;
HV *st;
- SV *sv, *tSv = Sv;
- CV *cv;
- AV *oldstack;
- OP *myop = op;
+ SV *sv, *tSv = PL_Sv;
+ CV *cv = Nullcv;
+ OP *myop = PL_op;
U32 flags = 0;
- I32 o_save_i = savestack_ix, type;
- CONTEXT *cx;
- XPV *tXpv = Xpv;
+ I32 o_save_i = PL_savestack_ix, type;
+ XPV *tXpv = PL_Xpv;
- if (savestack_ix + 15 <= savestack_max)
+ if (PL_savestack_ix + 15 <= PL_savestack_max)
flags |= 1;
- if (cxstack_ix < cxstack_max - 2)
- flags |= 2;
- if (markstack_ptr < markstack_max - 2)
+ if (PL_markstack_ptr < PL_markstack_max - 2)
flags |= 4;
- if (retstack_ix < retstack_max - 2)
+ if (PL_retstack_ix < PL_retstack_max - 2)
flags |= 8;
- if (scopestack_ix < scopestack_max - 3)
+ if (PL_scopestack_ix < PL_scopestack_max - 3)
flags |= 16;
- if (flags & 2) { /* POPBLOCK may decrease cxstack too early. */
- cxstack_ix++; /* Protect from overwrite. */
- cx = &cxstack[cxstack_ix];
- type = cx->cx_type; /* Can be during partial write. */
- cx->cx_type = CXt_NULL; /* Make it safe for unwind. */
- }
if (!psig_ptr[sig])
die("Signal SIG%s received, but no signal handler set.\n",
sig_name[sig]);
@@ -1763,35 +1945,33 @@ int sig;
/* Max number of items pushed there is 3*n or 4. We cannot fix
infinity, so we fix 4 (in fact 5): */
if (flags & 1) {
- savestack_ix += 5; /* Protect save in progress. */
- o_save_i = savestack_ix;
+ PL_savestack_ix += 5; /* Protect save in progress. */
+ o_save_i = PL_savestack_ix;
SAVEDESTRUCTOR(unwind_handler_stack, (void*)&flags);
}
if (flags & 4)
- markstack_ptr++; /* Protect mark. */
+ PL_markstack_ptr++; /* Protect mark. */
if (flags & 8) {
- retstack_ix++;
- retstack[retstack_ix] = NULL;
+ PL_retstack_ix++;
+ PL_retstack[PL_retstack_ix] = NULL;
}
if (flags & 16)
- scopestack_ix += 1;
+ PL_scopestack_ix += 1;
/* sv_2cv is too complicated, try a simpler variant first: */
if (!SvROK(psig_ptr[sig]) || !(cv = (CV*)SvRV(psig_ptr[sig]))
|| SvTYPE(cv) != SVt_PVCV)
cv = sv_2cv(psig_ptr[sig],&st,&gv,TRUE);
if (!cv || !CvROOT(cv)) {
- if (dowarn)
+ if (PL_dowarn)
warn("SIG%s handler \"%s\" not defined.\n",
- sig_name[sig], GvENAME(gv) );
- return;
+ sig_name[sig], (gv ? GvENAME(gv)
+ : ((cv && CvGV(cv))
+ ? GvENAME(CvGV(cv))
+ : "__ANON__")));
+ goto cleanup;
}
- oldstack = curstack;
- if (curstack != signalstack)
- AvFILL(signalstack) = 0;
- SWITCHSTACK(curstack, signalstack);
-
if(psig_name[sig]) {
sv = SvREFCNT_inc(psig_name[sig]);
flags |= 64;
@@ -1800,30 +1980,31 @@ int sig;
sv = sv_newmortal();
sv_setpv(sv,sig_name[sig]);
}
- PUSHMARK(sp);
+
+ PUSHSTACKi(PERLSI_SIGNAL);
+ PUSHMARK(SP);
PUSHs(sv);
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
- SWITCHSTACK(signalstack, oldstack);
+ POPSTACK;
+cleanup:
if (flags & 1)
- savestack_ix -= 8; /* Unprotect save in progress. */
- if (flags & 2) {
- cxstack[cxstack_ix].cx_type = type;
- cxstack_ix -= 1;
- }
+ PL_savestack_ix -= 8; /* Unprotect save in progress. */
if (flags & 4)
- markstack_ptr--;
+ PL_markstack_ptr--;
if (flags & 8)
- retstack_ix--;
+ PL_retstack_ix--;
if (flags & 16)
- scopestack_ix -= 1;
+ PL_scopestack_ix -= 1;
if (flags & 64)
SvREFCNT_dec(sv);
- op = myop; /* Apparently not needed... */
+ PL_op = myop; /* Apparently not needed... */
- Sv = tSv; /* Restore global temporaries. */
- Xpv = tXpv;
+ PL_Sv = tSv; /* Restore global temporaries. */
+ PL_Xpv = tXpv;
return;
}
+
+
diff --git a/gnu/usr.bin/perl/mg.h b/gnu/usr.bin/perl/mg.h
index c4647465572..ccd3acc10b7 100644
--- a/gnu/usr.bin/perl/mg.h
+++ b/gnu/usr.bin/perl/mg.h
@@ -1,19 +1,23 @@
/* mg.h
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
*
*/
+#ifdef STRUCT_MGVTBL_DEFINITION
+STRUCT_MGVTBL_DEFINITION;
+#else
struct mgvtbl {
- int (*svt_get) _((SV *sv, MAGIC* mg));
- int (*svt_set) _((SV *sv, MAGIC* mg));
- U32 (*svt_len) _((SV *sv, MAGIC* mg));
- int (*svt_clear) _((SV *sv, MAGIC* mg));
- int (*svt_free) _((SV *sv, MAGIC* mg));
+ int (CPERLscope(*svt_get)) _((SV *sv, MAGIC* mg));
+ int (CPERLscope(*svt_set)) _((SV *sv, MAGIC* mg));
+ U32 (CPERLscope(*svt_len)) _((SV *sv, MAGIC* mg));
+ int (CPERLscope(*svt_clear)) _((SV *sv, MAGIC* mg));
+ int (CPERLscope(*svt_free)) _((SV *sv, MAGIC* mg));
};
+#endif
struct magic {
MAGIC* mg_moremagic;
@@ -39,3 +43,8 @@ struct magic {
#define MgPV(mg,lp) (((lp = (mg)->mg_len) == HEf_SVKEY) ? \
SvPV((SV*)((mg)->mg_ptr),lp) : \
(mg)->mg_ptr)
+
+#define SvTIED_mg(sv,how) \
+ (SvRMAGICAL(sv) ? mg_find((sv),(how)) : Null(MAGIC*))
+#define SvTIED_obj(sv,mg) \
+ ((mg)->mg_obj ? (mg)->mg_obj : sv_2mortal(newRV(sv)))
diff --git a/gnu/usr.bin/perl/miniperlmain.c b/gnu/usr.bin/perl/miniperlmain.c
index 402f2ef065e..cfbe95b7364 100644
--- a/gnu/usr.bin/perl/miniperlmain.c
+++ b/gnu/usr.bin/perl/miniperlmain.c
@@ -6,45 +6,44 @@
#pragma runopts(HEAP(1M,32K,ANYWHERE,KEEP,8K,4K))
#endif
-#ifdef __cplusplus
-extern "C" {
-#endif
#include "EXTERN.h"
#include "perl.h"
-#ifdef __cplusplus
-}
-# define EXTERN_C extern "C"
-#else
-# define EXTERN_C extern
-#endif
-
static void xs_init _((void));
static PerlInterpreter *my_perl;
+#if defined (__MINT__) || defined (atarist)
+/* The Atari operating system doesn't have a dynamic stack. The
+ stack size is determined from this value. */
+long _stksize = 64 * 1024;
+#endif
+
int
-#ifdef CAN_PROTOTYPE
main(int argc, char **argv, char **env)
-#else
-main(argc, argv, env)
-int argc;
-char **argv;
-char **env;
-#endif
{
int exitstatus;
+#ifdef PERL_GLOBAL_STRUCT
+#define PERLVAR(var,type) /**/
+#define PERLVARI(var,type,init) PL_Vars.var = init;
+#define PERLVARIC(var,type,init) PL_Vars.var = init;
+#include "perlvars.h"
+#undef PERLVAR
+#undef PERLVARI
+#undef PERLVARIC
+#endif
+
PERL_SYS_INIT(&argc,&argv);
perl_init_i18nl10n(1);
- if (!do_undump) {
+ if (!PL_do_undump) {
my_perl = perl_alloc();
if (!my_perl)
exit(1);
perl_construct( my_perl );
- perl_destruct_level = 0;
+ PL_perl_destruct_level = 0;
}
exitstatus = perl_parse( my_perl, xs_init, argc, argv, (char **) NULL );
@@ -58,6 +57,7 @@ char **env;
PERL_SYS_TERM();
exit( exitstatus );
+ return exitstatus;
}
/* Register any extra external extensions */
@@ -65,7 +65,7 @@ char **env;
/* Do not delete this line--writemain depends on it */
static void
-xs_init()
+xs_init(void)
{
dXSUB_SYS;
}
diff --git a/gnu/usr.bin/perl/myconfig b/gnu/usr.bin/perl/myconfig
index 86da2edce87..c143aea6e8d 100644
--- a/gnu/usr.bin/perl/myconfig
+++ b/gnu/usr.bin/perl/myconfig
@@ -15,29 +15,27 @@ fi
. $TOP/config.sh
# Note that the text lines /^Summary of/ .. /^\s*$/ are copied into Config.pm.
-# XXX Add d_sigaction (?) once it's defined.
$spitshell <<!GROK!THIS!
-
Summary of my $package ($baserev patchlevel $PATCHLEVEL subversion $SUBVERSION) configuration:
Platform:
osname=$osname, osvers=$osvers, archname=$archname
uname='$myuname'
hint=$hint, useposix=$useposix, d_sigaction=$d_sigaction
- bincompat3=$bincompat3 useperlio=$useperlio d_sfio=$d_sfio
+ usethreads=$usethreads useperlio=$useperlio d_sfio=$d_sfio
Compiler:
cc='$cc', optimize='$optimize', gccversion=$gccversion
cppflags='$cppflags'
ccflags ='$ccflags'
stdchar='$stdchar', d_stdstdio=$d_stdstdio, usevfork=$usevfork
- voidflags=$voidflags, castflags=$castflags, d_casti32=$d_casti32, d_castneg=$d_castneg
- intsize=$intsize, alignbytes=$alignbytes, usemymalloc=$usemymalloc, prototype=$prototype
+ intsize=$intsize, longsize=$longsize, ptrsize=$ptrsize, doublesize=$doublesize
+ d_longlong=$d_longlong, longlongsize=$longlongsize, d_longdbl=$d_longdbl, longdblsize=$longdblsize
+ alignbytes=$alignbytes, usemymalloc=$usemymalloc, prototype=$prototype
Linker and Libraries:
ld='$ld', ldflags ='$ldflags'
libpth=$libpth
libs=$libs
- libc=$libc, so=$so
- useshrplib=$useshrplib, libperl=$libperl
+ libc=$libc, so=$so, useshrplib=$useshrplib, libperl=$libperl
Dynamic Linking:
dlsrc=$dlsrc, dlext=$dlext, d_dlsymun=$d_dlsymun, ccdlflags='$ccdlflags'
cccdlflags='$cccdlflags', lddlflags='$lddlflags'
diff --git a/gnu/usr.bin/perl/op.c b/gnu/usr.bin/perl/op.c
index 8e8811da934..bf944a652dd 100644
--- a/gnu/usr.bin/perl/op.c
+++ b/gnu/usr.bin/perl/op.c
@@ -1,6 +1,6 @@
/* op.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -18,102 +18,106 @@
#include "EXTERN.h"
#include "perl.h"
-#define USE_OP_MASK /* Turned on by default in 5.002beta1h */
+#ifdef PERL_OBJECT
+#define CHECKCALL this->*check
+#else
+#define CHECKCALL *check
+#endif
-#ifdef USE_OP_MASK
/*
- * In the following definition, the ", (OP *) op" is just to make the compiler
+ * In the following definition, the ", Nullop" is just to make the compiler
* think the expression is of the right type: croak actually does a Siglongjmp.
*/
-#define CHECKOP(type,op) \
- ((op_mask && op_mask[type]) \
- ? ( op_free((OP*)op), \
+#define CHECKOP(type,o) \
+ ((PL_op_mask && PL_op_mask[type]) \
+ ? ( op_free((OP*)o), \
croak("%s trapped by operation mask", op_desc[type]), \
Nullop ) \
- : (*check[type])((OP*)op))
-#else
-#define CHECKOP(type,op) (*check[type])(op)
-#endif /* USE_OP_MASK */
-
-static I32 list_assignment _((OP *op));
-static OP *bad_type _((I32 n, char *t, char *name, OP *kid));
-static OP *modkids _((OP *op, I32 type));
-static OP *no_fh_allowed _((OP *op));
-static bool scalar_mod_type _((OP *op, I32 type));
-static OP *scalarboolean _((OP *op));
-static OP *too_few_arguments _((OP *op, char* name));
-static OP *too_many_arguments _((OP *op, char* name));
-static void null _((OP* op));
+ : (CHECKCALL[type])((OP*)o))
+
+#define PAD_MAX 999999999
+
+static bool scalar_mod_type _((OP *o, I32 type));
+#ifndef PERL_OBJECT
+static I32 list_assignment _((OP *o));
+static void bad_type _((I32 n, char *t, char *name, OP *kid));
+static OP *modkids _((OP *o, I32 type));
+static OP *no_fh_allowed _((OP *o));
+static OP *scalarboolean _((OP *o));
+static OP *too_few_arguments _((OP *o, char* name));
+static OP *too_many_arguments _((OP *o, char* name));
+static void null _((OP* o));
static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq,
- CV* startcv, I32 cx_ix));
+ CV* startcv, I32 cx_ix, I32 saweval, U32 flags));
+static OP *newDEFSVOP _((void));
+static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
+#endif
-static char*
-gv_ename(gv)
-GV* gv;
+STATIC char*
+gv_ename(GV *gv)
{
SV* tmpsv = sv_newmortal();
+ STRLEN n_a;
gv_efullname3(tmpsv, gv, Nullch);
- return SvPV(tmpsv,na);
+ return SvPV(tmpsv,n_a);
}
-static OP *
-no_fh_allowed(op)
-OP *op;
+STATIC OP *
+no_fh_allowed(OP *o)
{
yyerror(form("Missing comma after first argument to %s function",
- op_desc[op->op_type]));
- return op;
+ op_desc[o->op_type]));
+ return o;
}
-static OP *
-too_few_arguments(op, name)
-OP* op;
-char* name;
+STATIC OP *
+too_few_arguments(OP *o, char *name)
{
yyerror(form("Not enough arguments for %s", name));
- return op;
+ return o;
}
-static OP *
-too_many_arguments(op, name)
-OP *op;
-char* name;
+STATIC OP *
+too_many_arguments(OP *o, char *name)
{
yyerror(form("Too many arguments for %s", name));
- return op;
+ return o;
}
-static OP *
-bad_type(n, t, name, kid)
-I32 n;
-char *t;
-char *name;
-OP *kid;
+STATIC void
+bad_type(I32 n, char *t, char *name, OP *kid)
{
yyerror(form("Type of arg %d to %s must be %s (not %s)",
(int)n, name, t, op_desc[kid->op_type]));
- return op;
}
void
-assertref(op)
-OP *op;
+assertref(OP *o)
{
- int type = op->op_type;
- if (type != OP_AELEM && type != OP_HELEM) {
+ int type = o->op_type;
+ if (type != OP_AELEM && type != OP_HELEM && type != OP_GELEM) {
yyerror(form("Can't use subscript on %s", op_desc[type]));
- if (type == OP_ENTERSUB || type == OP_RV2HV || type == OP_PADHV)
- warn("(Did you mean $ or @ instead of %c?)\n",
- type == OP_ENTERSUB ? '&' : '%');
+ if (type == OP_ENTERSUB || type == OP_RV2HV || type == OP_PADHV) {
+ dTHR;
+ SV *msg = sv_2mortal(
+ newSVpvf("(Did you mean $ or @ instead of %c?)\n",
+ type == OP_ENTERSUB ? '&' : '%'));
+ if (PL_in_eval & 2)
+ warn("%_", msg);
+ else if (PL_in_eval)
+ sv_catsv(GvSV(PL_errgv), msg);
+ else
+ PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
+ }
}
}
/* "register" allocation */
PADOFFSET
-pad_allocmy(name)
-char *name;
+pad_allocmy(char *name)
{
+ dTHR;
PADOFFSET off;
SV *sv;
@@ -125,15 +129,16 @@ char *name;
}
croak("Can't use global %s in \"my\"",name);
}
- if (dowarn && AvFILL(comppad_name) >= 0) {
- SV **svp = AvARRAY(comppad_name);
- for (off = AvFILL(comppad_name); off > comppad_name_floor; off--) {
+ if (PL_dowarn && AvFILLp(PL_comppad_name) >= 0) {
+ SV **svp = AvARRAY(PL_comppad_name);
+ for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_floor; off--) {
if ((sv = svp[off])
- && sv != &sv_undef
- && SvIVX(sv) == 999999999 /* var is in open scope */
+ && sv != &PL_sv_undef
+ && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
&& strEQ(name, SvPVX(sv)))
{
- warn("\"my\" variable %s masks earlier declaration in same scope", name);
+ warn("\"my\" variable %s masks earlier declaration in same %s",
+ name, (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
break;
}
}
@@ -142,51 +147,53 @@ char *name;
sv = NEWSV(1102,0);
sv_upgrade(sv, SVt_PVNV);
sv_setpv(sv, name);
- av_store(comppad_name, off, sv);
- SvNVX(sv) = (double)999999999;
+ if (PL_in_my_stash) {
+ if (*name != '$')
+ croak("Can't declare class for non-scalar %s in \"my\"",name);
+ SvOBJECT_on(sv);
+ (void)SvUPGRADE(sv, SVt_PVMG);
+ SvSTASH(sv) = (HV*)SvREFCNT_inc(PL_in_my_stash);
+ PL_sv_objcount++;
+ }
+ av_store(PL_comppad_name, off, sv);
+ SvNVX(sv) = (double)PAD_MAX;
SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */
- if (!min_intro_pending)
- min_intro_pending = off;
- max_intro_pending = off;
+ if (!PL_min_intro_pending)
+ PL_min_intro_pending = off;
+ PL_max_intro_pending = off;
if (*name == '@')
- av_store(comppad, off, (SV*)newAV());
+ av_store(PL_comppad, off, (SV*)newAV());
else if (*name == '%')
- av_store(comppad, off, (SV*)newHV());
- SvPADMY_on(curpad[off]);
+ av_store(PL_comppad, off, (SV*)newHV());
+ SvPADMY_on(PL_curpad[off]);
return off;
}
-static PADOFFSET
-#ifndef CAN_PROTOTYPE
-pad_findlex(name, newoff, seq, startcv, cx_ix)
-char *name;
-PADOFFSET newoff;
-U32 seq;
-CV* startcv;
-I32 cx_ix;
-#else
-pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
-#endif
+#define FINDLEX_NOSEARCH 1 /* don't search outer contexts */
+
+STATIC PADOFFSET
+pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval,
+ U32 flags)
{
+ dTHR;
CV *cv;
I32 off;
SV *sv;
register I32 i;
- register CONTEXT *cx;
- int saweval;
+ register PERL_CONTEXT *cx;
for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
AV *curlist = CvPADLIST(cv);
SV **svp = av_fetch(curlist, 0, FALSE);
AV *curname;
- if (!svp || *svp == &sv_undef)
+ if (!svp || *svp == &PL_sv_undef)
continue;
curname = (AV*)*svp;
svp = AvARRAY(curname);
- for (off = AvFILL(curname); off > 0; off--) {
+ for (off = AvFILLp(curname); off > 0; off--) {
if ((sv = svp[off]) &&
- sv != &sv_undef &&
+ sv != &PL_sv_undef &&
seq <= SvIVX(sv) &&
seq > I_32(SvNVX(sv)) &&
strEQ(SvPVX(sv), name))
@@ -211,64 +218,77 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
newoff = pad_alloc(OP_PADSV, SVs_PADMY);
sv_upgrade(namesv, SVt_PVNV);
sv_setpv(namesv, name);
- av_store(comppad_name, newoff, namesv);
- SvNVX(namesv) = (double)curcop->cop_seq;
- SvIVX(namesv) = 999999999; /* A ref, intro immediately */
+ av_store(PL_comppad_name, newoff, namesv);
+ SvNVX(namesv) = (double)PL_curcop->cop_seq;
+ SvIVX(namesv) = PAD_MAX; /* A ref, intro immediately */
SvFAKE_on(namesv); /* A ref, not a real var */
- if (CvANON(compcv) || SvTYPE(compcv) == SVt_PVFM) {
+ if (SvOBJECT(svp[off])) { /* A typed var */
+ SvOBJECT_on(namesv);
+ (void)SvUPGRADE(namesv, SVt_PVMG);
+ SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(svp[off]));
+ PL_sv_objcount++;
+ }
+ if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
/* "It's closures all the way down." */
- CvCLONE_on(compcv);
+ CvCLONE_on(PL_compcv);
if (cv == startcv) {
- if (CvANON(compcv))
+ if (CvANON(PL_compcv))
oldsv = Nullsv; /* no need to keep ref */
}
else {
CV *bcv;
for (bcv = startcv;
bcv && bcv != cv && !CvCLONE(bcv);
- bcv = CvOUTSIDE(bcv)) {
+ bcv = CvOUTSIDE(bcv))
+ {
if (CvANON(bcv))
CvCLONE_on(bcv);
else {
- if (dowarn && !CvUNIQUE(cv))
+ if (PL_dowarn
+ && !CvUNIQUE(bcv) && !CvUNIQUE(cv))
+ {
warn(
"Variable \"%s\" may be unavailable",
name);
+ }
break;
}
}
}
}
- else if (!CvUNIQUE(compcv)) {
- if (dowarn && !SvFAKE(sv) && !CvUNIQUE(cv))
+ else if (!CvUNIQUE(PL_compcv)) {
+ if (PL_dowarn && !SvFAKE(sv) && !CvUNIQUE(cv))
warn("Variable \"%s\" will not stay shared", name);
}
}
- av_store(comppad, newoff, SvREFCNT_inc(oldsv));
+ av_store(PL_comppad, newoff, SvREFCNT_inc(oldsv));
return newoff;
}
}
}
+ if (flags & FINDLEX_NOSEARCH)
+ return 0;
+
/* Nothing in current lexical context--try eval's context, if any.
* This is necessary to let the perldb get at lexically scoped variables.
* XXX This will also probably interact badly with eval tree caching.
*/
- saweval = 0;
for (i = cx_ix; i >= 0; i--) {
cx = &cxstack[i];
- switch (cx->cx_type) {
+ switch (CxTYPE(cx)) {
default:
if (i == 0 && saweval) {
seq = cxstack[saweval].blk_oldcop->cop_seq;
- return pad_findlex(name, newoff, seq, main_cv, 0);
+ return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval, 0);
}
break;
case CXt_EVAL:
switch (cx->blk_eval.old_op_type) {
case OP_ENTEREVAL:
- saweval = i;
+ if (CxREALEVAL(cx))
+ saweval = i;
break;
case OP_REQUIRE:
/* require must have its own scope */
@@ -279,12 +299,12 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
if (!saweval)
return 0;
cv = cx->blk_sub.cv;
- if (debstash && CvSTASH(cv) == debstash) { /* ignore DB'* scope */
+ if (PL_debstash && CvSTASH(cv) == PL_debstash) { /* ignore DB'* scope */
saweval = i; /* so we know where we were called from */
continue;
}
seq = cxstack[saweval].blk_oldcop->cop_seq;
- return pad_findlex(name, newoff, seq, cv, i-1);
+ return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH);
}
}
@@ -292,19 +312,34 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
}
PADOFFSET
-pad_findmy(name)
-char *name;
+pad_findmy(char *name)
{
+ dTHR;
I32 off;
I32 pendoff = 0;
SV *sv;
- SV **svp = AvARRAY(comppad_name);
- U32 seq = cop_seqmax;
+ SV **svp = AvARRAY(PL_comppad_name);
+ U32 seq = PL_cop_seqmax;
+ PERL_CONTEXT *cx;
+ CV *outside;
+
+#ifdef USE_THREADS
+ /*
+ * Special case to get lexical (and hence per-thread) @_.
+ * XXX I need to find out how to tell at parse-time whether use
+ * of @_ should refer to a lexical (from a sub) or defgv (global
+ * scope and maybe weird sub-ish things like formats). See
+ * startsub in perly.y. It's possible that @_ could be lexical
+ * (at least from subs) even in non-threaded perl.
+ */
+ if (strEQ(name, "@_"))
+ return 0; /* success. (NOT_IN_PAD indicates failure) */
+#endif /* USE_THREADS */
/* The one we're looking for is probably just before comppad_name_fill. */
- for (off = AvFILL(comppad_name); off > 0; off--) {
+ for (off = AvFILLp(PL_comppad_name); off > 0; off--) {
if ((sv = svp[off]) &&
- sv != &sv_undef &&
+ sv != &PL_sv_undef &&
(!SvIVX(sv) ||
(seq <= SvIVX(sv) &&
seq > I_32(SvNVX(sv)))) &&
@@ -316,230 +351,344 @@ char *name;
}
}
+ outside = CvOUTSIDE(PL_compcv);
+
+ /* Check if if we're compiling an eval'', and adjust seq to be the
+ * eval's seq number. This depends on eval'' having a non-null
+ * CvOUTSIDE() while it is being compiled. The eval'' itself is
+ * identified by CvEVAL being true and CvGV being null. */
+ if (outside && CvEVAL(PL_compcv) && !CvGV(PL_compcv) && cxstack_ix >= 0) {
+ cx = &cxstack[cxstack_ix];
+ if (CxREALEVAL(cx))
+ seq = cx->blk_oldcop->cop_seq;
+ }
+
/* See if it's in a nested scope */
- off = pad_findlex(name, 0, seq, CvOUTSIDE(compcv), cxstack_ix);
+ off = pad_findlex(name, 0, seq, outside, cxstack_ix, 0, 0);
if (off) {
/* If there is a pending local definition, this new alias must die */
if (pendoff)
- SvIVX(AvARRAY(comppad_name)[off]) = seq;
- return off;
+ SvIVX(AvARRAY(PL_comppad_name)[off]) = seq;
+ return off; /* pad_findlex returns 0 for failure...*/
}
-
- return 0;
+ return NOT_IN_PAD; /* ...but we return NOT_IN_PAD for failure */
}
void
-pad_leavemy(fill)
-I32 fill;
+pad_leavemy(I32 fill)
{
I32 off;
- SV **svp = AvARRAY(comppad_name);
+ SV **svp = AvARRAY(PL_comppad_name);
SV *sv;
- if (min_intro_pending && fill < min_intro_pending) {
- for (off = max_intro_pending; off >= min_intro_pending; off--) {
- if ((sv = svp[off]) && sv != &sv_undef)
+ if (PL_min_intro_pending && fill < PL_min_intro_pending) {
+ for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
+ if ((sv = svp[off]) && sv != &PL_sv_undef)
warn("%s never introduced", SvPVX(sv));
}
}
/* "Deintroduce" my variables that are leaving with this scope. */
- for (off = AvFILL(comppad_name); off > fill; off--) {
- if ((sv = svp[off]) && sv != &sv_undef && SvIVX(sv) == 999999999)
- SvIVX(sv) = cop_seqmax;
+ for (off = AvFILLp(PL_comppad_name); off > fill; off--) {
+ if ((sv = svp[off]) && sv != &PL_sv_undef && SvIVX(sv) == PAD_MAX)
+ SvIVX(sv) = PL_cop_seqmax;
}
}
PADOFFSET
-pad_alloc(optype,tmptype)
-I32 optype;
-U32 tmptype;
+pad_alloc(I32 optype, U32 tmptype)
{
+ dTHR;
SV *sv;
I32 retval;
- if (AvARRAY(comppad) != curpad)
+ if (AvARRAY(PL_comppad) != PL_curpad)
croak("panic: pad_alloc");
- if (pad_reset_pending)
+ if (PL_pad_reset_pending)
pad_reset();
if (tmptype & SVs_PADMY) {
do {
- sv = *av_fetch(comppad, AvFILL(comppad) + 1, TRUE);
+ sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
} while (SvPADBUSY(sv)); /* need a fresh one */
- retval = AvFILL(comppad);
+ retval = AvFILLp(PL_comppad);
}
else {
- SV **names = AvARRAY(comppad_name);
- SSize_t names_fill = AvFILL(comppad_name);
+ SV **names = AvARRAY(PL_comppad_name);
+ SSize_t names_fill = AvFILLp(PL_comppad_name);
for (;;) {
/*
* "foreach" index vars temporarily become aliases to non-"my"
* values. Thus we must skip, not just pad values that are
* marked as current pad values, but also those with names.
*/
- if (++padix <= names_fill &&
- (sv = names[padix]) && sv != &sv_undef)
+ if (++PL_padix <= names_fill &&
+ (sv = names[PL_padix]) && sv != &PL_sv_undef)
continue;
- sv = *av_fetch(comppad, padix, TRUE);
+ sv = *av_fetch(PL_comppad, PL_padix, TRUE);
if (!(SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY)))
break;
}
- retval = padix;
+ retval = PL_padix;
}
SvFLAGS(sv) |= tmptype;
- curpad = AvARRAY(comppad);
- DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad alloc %ld for %s\n", (long) retval, op_name[optype]));
+ PL_curpad = AvARRAY(PL_comppad);
+#ifdef USE_THREADS
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx alloc %ld for %s\n",
+ (unsigned long) thr, (unsigned long) PL_curpad,
+ (long) retval, op_name[optype]));
+#else
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx alloc %ld for %s\n",
+ (unsigned long) PL_curpad,
+ (long) retval, op_name[optype]));
+#endif /* USE_THREADS */
return (PADOFFSET)retval;
}
SV *
-#ifndef CAN_PROTOTYPE
-pad_sv(po)
-PADOFFSET po;
-#else
pad_sv(PADOFFSET po)
-#endif /* CAN_PROTOTYPE */
{
+ dTHR;
+#ifdef USE_THREADS
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx sv %d\n",
+ (unsigned long) thr, (unsigned long) PL_curpad, po));
+#else
if (!po)
croak("panic: pad_sv po");
- DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad sv %lu\n", (unsigned long)po));
- return curpad[po]; /* eventually we'll turn this into a macro */
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx sv %d\n",
+ (unsigned long) PL_curpad, po));
+#endif /* USE_THREADS */
+ return PL_curpad[po]; /* eventually we'll turn this into a macro */
}
void
-#ifndef CAN_PROTOTYPE
-pad_free(po)
-PADOFFSET po;
-#else
pad_free(PADOFFSET po)
-#endif /* CAN_PROTOTYPE */
{
- if (!curpad)
+ dTHR;
+ if (!PL_curpad)
return;
- if (AvARRAY(comppad) != curpad)
+ if (AvARRAY(PL_comppad) != PL_curpad)
croak("panic: pad_free curpad");
if (!po)
croak("panic: pad_free po");
- DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad free %lu\n", (unsigned long)po));
- if (curpad[po] && !SvIMMORTAL(curpad[po]))
- SvPADTMP_off(curpad[po]);
- if ((I32)po < padix)
- padix = po - 1;
+#ifdef USE_THREADS
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx free %d\n",
+ (unsigned long) thr, (unsigned long) PL_curpad, po));
+#else
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx free %d\n",
+ (unsigned long) PL_curpad, po));
+#endif /* USE_THREADS */
+ if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef)
+ SvPADTMP_off(PL_curpad[po]);
+ if ((I32)po < PL_padix)
+ PL_padix = po - 1;
}
void
-#ifndef CAN_PROTOTYPE
-pad_swipe(po)
-PADOFFSET po;
-#else
pad_swipe(PADOFFSET po)
-#endif /* CAN_PROTOTYPE */
{
- if (AvARRAY(comppad) != curpad)
+ dTHR;
+ if (AvARRAY(PL_comppad) != PL_curpad)
croak("panic: pad_swipe curpad");
if (!po)
croak("panic: pad_swipe po");
- DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad swipe %lu\n", (unsigned long)po));
- SvPADTMP_off(curpad[po]);
- curpad[po] = NEWSV(1107,0);
- SvPADTMP_on(curpad[po]);
- if ((I32)po < padix)
- padix = po - 1;
-}
-
+#ifdef USE_THREADS
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx swipe %d\n",
+ (unsigned long) thr, (unsigned long) PL_curpad, po));
+#else
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx swipe %d\n",
+ (unsigned long) PL_curpad, po));
+#endif /* USE_THREADS */
+ SvPADTMP_off(PL_curpad[po]);
+ PL_curpad[po] = NEWSV(1107,0);
+ SvPADTMP_on(PL_curpad[po]);
+ if ((I32)po < PL_padix)
+ PL_padix = po - 1;
+}
+
+/* XXX pad_reset() is currently disabled because it results in serious bugs.
+ * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
+ * on the stack by OPs that use them, there are several ways to get an alias
+ * to a shared TARG. Such an alias will change randomly and unpredictably.
+ * We avoid doing this until we can think of a Better Way.
+ * GSAR 97-10-29 */
void
-pad_reset()
+pad_reset(void)
{
+#ifdef USE_BROKEN_PAD_RESET
+ dTHR;
register I32 po;
- if (AvARRAY(comppad) != curpad)
+ if (AvARRAY(PL_comppad) != PL_curpad)
croak("panic: pad_reset curpad");
- DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad reset\n"));
- if (!tainting) { /* Can't mix tainted and non-tainted temporaries. */
- for (po = AvMAX(comppad); po > padix_floor; po--) {
- if (curpad[po] && !SvIMMORTAL(curpad[po]))
- SvPADTMP_off(curpad[po]);
+#ifdef USE_THREADS
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx reset\n",
+ (unsigned long) thr, (unsigned long) PL_curpad));
+#else
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx reset\n",
+ (unsigned long) PL_curpad));
+#endif /* USE_THREADS */
+ if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
+ for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
+ if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
+ SvPADTMP_off(PL_curpad[po]);
}
- padix = padix_floor;
+ PL_padix = PL_padix_floor;
}
- pad_reset_pending = FALSE;
+#endif
+ PL_pad_reset_pending = FALSE;
}
+#ifdef USE_THREADS
+/* find_threadsv is not reentrant */
+PADOFFSET
+find_threadsv(char *name)
+{
+ dTHR;
+ char *p;
+ PADOFFSET key;
+ SV **svp;
+ /* We currently only handle names of a single character */
+ p = strchr(PL_threadsv_names, *name);
+ if (!p)
+ return NOT_IN_PAD;
+ key = p - PL_threadsv_names;
+ MUTEX_LOCK(&thr->mutex);
+ svp = av_fetch(thr->threadsv, key, FALSE);
+ if (svp)
+ MUTEX_UNLOCK(&thr->mutex);
+ else {
+ SV *sv = NEWSV(0, 0);
+ av_store(thr->threadsv, key, sv);
+ thr->threadsvp = AvARRAY(thr->threadsv);
+ MUTEX_UNLOCK(&thr->mutex);
+ /*
+ * Some magic variables used to be automagically initialised
+ * in gv_fetchpv. Those which are now per-thread magicals get
+ * initialised here instead.
+ */
+ switch (*name) {
+ case '_':
+ break;
+ case ';':
+ sv_setpv(sv, "\034");
+ sv_magic(sv, 0, 0, name, 1);
+ break;
+ case '&':
+ case '`':
+ case '\'':
+ PL_sawampersand = TRUE;
+ /* FALL THROUGH */
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ SvREADONLY_on(sv);
+ /* FALL THROUGH */
+
+ /* XXX %! tied to Errno.pm needs to be added here.
+ * See gv_fetchpv(). */
+ /* case '!': */
+
+ default:
+ sv_magic(sv, 0, 0, name, 1);
+ }
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ "find_threadsv: new SV %p for $%s%c\n",
+ sv, (*name < 32) ? "^" : "",
+ (*name < 32) ? toCTRL(*name) : *name));
+ }
+ return key;
+}
+#endif /* USE_THREADS */
+
/* Destructor */
void
-op_free(op)
-OP *op;
+op_free(OP *o)
{
register OP *kid, *nextkid;
- if (!op || op->op_seq == (U16)-1)
+ if (!o || o->op_seq == (U16)-1)
return;
- if (op->op_flags & OPf_KIDS) {
- for (kid = cUNOP->op_first; kid; kid = nextkid) {
+ if (o->op_flags & OPf_KIDS) {
+ for (kid = cUNOPo->op_first; kid; kid = nextkid) {
nextkid = kid->op_sibling; /* Get before next freeing kid */
op_free(kid);
}
}
- switch (op->op_type) {
+ switch (o->op_type) {
case OP_NULL:
- op->op_targ = 0; /* Was holding old type, if any. */
+ o->op_targ = 0; /* Was holding old type, if any. */
break;
case OP_ENTEREVAL:
- op->op_targ = 0; /* Was holding hints. */
+ o->op_targ = 0; /* Was holding hints. */
+ break;
+#ifdef USE_THREADS
+ case OP_ENTERITER:
+ if (!(o->op_flags & OPf_SPECIAL))
+ break;
+ /* FALL THROUGH */
+ case OP_THREADSV:
+ o->op_targ = 0; /* Was holding index into thr->threadsv AV. */
break;
+#endif /* USE_THREADS */
default:
- if (!(op->op_flags & OPf_REF) || (check[op->op_type] != ck_ftst))
+ if (!(o->op_flags & OPf_REF)
+ || (check[o->op_type] != FUNC_NAME_TO_PTR(ck_ftst)))
break;
/* FALL THROUGH */
case OP_GVSV:
case OP_GV:
case OP_AELEMFAST:
- SvREFCNT_dec(cGVOP->op_gv);
+ SvREFCNT_dec(cGVOPo->op_gv);
break;
case OP_NEXTSTATE:
case OP_DBSTATE:
- Safefree(cCOP->cop_label);
- SvREFCNT_dec(cCOP->cop_filegv);
+ Safefree(cCOPo->cop_label);
+ SvREFCNT_dec(cCOPo->cop_filegv);
break;
case OP_CONST:
- SvREFCNT_dec(cSVOP->op_sv);
+ SvREFCNT_dec(cSVOPo->op_sv);
break;
case OP_GOTO:
case OP_NEXT:
case OP_LAST:
case OP_REDO:
- if (op->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS))
+ if (o->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS))
break;
/* FALL THROUGH */
case OP_TRANS:
- Safefree(cPVOP->op_pv);
+ Safefree(cPVOPo->op_pv);
break;
case OP_SUBST:
- op_free(cPMOP->op_pmreplroot);
+ op_free(cPMOPo->op_pmreplroot);
/* FALL THROUGH */
case OP_PUSHRE:
case OP_MATCH:
- pregfree(cPMOP->op_pmregexp);
- SvREFCNT_dec(cPMOP->op_pmshort);
+ case OP_QR:
+ ReREFCNT_dec(cPMOPo->op_pmregexp);
break;
}
- if (op->op_targ > 0)
- pad_free(op->op_targ);
+ if (o->op_targ > 0)
+ pad_free(o->op_targ);
- Safefree(op);
+ Safefree(o);
}
-static void
-null(op)
-OP* op;
+STATIC void
+null(OP *o)
{
- if (op->op_type != OP_NULL && op->op_targ > 0)
- pad_free(op->op_targ);
- op->op_targ = op->op_type;
- op->op_type = OP_NULL;
- op->op_ppaddr = ppaddr[OP_NULL];
+ if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0)
+ pad_free(o->op_targ);
+ o->op_targ = o->op_type;
+ o->op_type = OP_NULL;
+ o->op_ppaddr = ppaddr[OP_NULL];
}
/* Contextualizers */
@@ -547,101 +696,99 @@ OP* op;
#define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
OP *
-linklist(op)
-OP *op;
+linklist(OP *o)
{
register OP *kid;
- if (op->op_next)
- return op->op_next;
+ if (o->op_next)
+ return o->op_next;
/* establish postfix order */
- if (cUNOP->op_first) {
- op->op_next = LINKLIST(cUNOP->op_first);
- for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
+ if (cUNOPo->op_first) {
+ o->op_next = LINKLIST(cUNOPo->op_first);
+ for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
if (kid->op_sibling)
kid->op_next = LINKLIST(kid->op_sibling);
else
- kid->op_next = op;
+ kid->op_next = o;
}
}
else
- op->op_next = op;
+ o->op_next = o;
- return op->op_next;
+ return o->op_next;
}
OP *
-scalarkids(op)
-OP *op;
+scalarkids(OP *o)
{
OP *kid;
- if (op && op->op_flags & OPf_KIDS) {
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ if (o && o->op_flags & OPf_KIDS) {
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
scalar(kid);
}
- return op;
+ return o;
}
-static OP *
-scalarboolean(op)
-OP *op;
+STATIC OP *
+scalarboolean(OP *o)
{
- if (dowarn &&
- op->op_type == OP_SASSIGN && cBINOP->op_first->op_type == OP_CONST) {
- line_t oldline = curcop->cop_line;
+ if (PL_dowarn &&
+ o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
+ dTHR;
+ line_t oldline = PL_curcop->cop_line;
- if (copline != NOLINE)
- curcop->cop_line = copline;
+ if (PL_copline != NOLINE)
+ PL_curcop->cop_line = PL_copline;
warn("Found = in conditional, should be ==");
- curcop->cop_line = oldline;
+ PL_curcop->cop_line = oldline;
}
- return scalar(op);
+ return scalar(o);
}
OP *
-scalar(op)
-OP *op;
+scalar(OP *o)
{
OP *kid;
/* assumes no premature commitment */
- if (!op || (op->op_flags & OPf_WANT) || error_count
- || op->op_type == OP_RETURN)
- return op;
+ if (!o || (o->op_flags & OPf_WANT) || PL_error_count
+ || o->op_type == OP_RETURN)
+ return o;
- op->op_flags = (op->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR;
+ o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR;
- switch (op->op_type) {
+ switch (o->op_type) {
case OP_REPEAT:
- if (op->op_private & OPpREPEAT_DOLIST)
- null(((LISTOP*)cBINOP->op_first)->op_first);
- scalar(cBINOP->op_first);
+ if (o->op_private & OPpREPEAT_DOLIST)
+ null(((LISTOP*)cBINOPo->op_first)->op_first);
+ scalar(cBINOPo->op_first);
break;
case OP_OR:
case OP_AND:
case OP_COND_EXPR:
- for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
+ for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
scalar(kid);
break;
case OP_SPLIT:
- if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) {
+ if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
if (!kPMOP->op_pmreplroot)
deprecate("implicit split to @_");
}
/* FALL THROUGH */
case OP_MATCH:
+ case OP_QR:
case OP_SUBST:
case OP_NULL:
default:
- if (op->op_flags & OPf_KIDS) {
- for (kid = cUNOP->op_first; kid; kid = kid->op_sibling)
+ if (o->op_flags & OPf_KIDS) {
+ for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
scalar(kid);
}
break;
case OP_LEAVE:
case OP_LEAVETRY:
- kid = cLISTOP->op_first;
+ kid = cLISTOPo->op_first;
scalar(kid);
while (kid = kid->op_sibling) {
if (kid->op_sibling)
@@ -649,45 +796,49 @@ OP *op;
else
scalar(kid);
}
- curcop = &compiling;
+ WITH_THR(PL_curcop = &PL_compiling);
break;
case OP_SCOPE:
case OP_LINESEQ:
case OP_LIST:
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
if (kid->op_sibling)
scalarvoid(kid);
else
scalar(kid);
}
- curcop = &compiling;
+ WITH_THR(PL_curcop = &PL_compiling);
break;
}
- return op;
+ return o;
}
OP *
-scalarvoid(op)
-OP *op;
+scalarvoid(OP *o)
{
OP *kid;
char* useless = 0;
SV* sv;
/* assumes no premature commitment */
- if (!op || (op->op_flags & OPf_WANT) == OPf_WANT_LIST || error_count
- || op->op_type == OP_RETURN)
- return op;
+ U8 want = o->op_flags & OPf_WANT;
+ if (!o || (want && want != OPf_WANT_SCALAR) || PL_error_count
+ || o->op_type == OP_RETURN)
+ return o;
- op->op_flags = (op->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
+ o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
- switch (op->op_type) {
+ switch (o->op_type) {
default:
- if (!(opargs[op->op_type] & OA_FOLDCONST))
+ if (!(opargs[o->op_type] & OA_FOLDCONST))
break;
/* FALL THROUGH */
case OP_REPEAT:
- if (op->op_flags & OPf_STACKED)
+ if (o->op_flags & OPf_STACKED)
+ break;
+ goto func_ops;
+ case OP_SUBSTR:
+ if (o->op_private == 4)
break;
/* FALL THROUGH */
case OP_GVSV:
@@ -705,7 +856,6 @@ OP *op;
case OP_HEX:
case OP_OCT:
case OP_LENGTH:
- case OP_SUBSTR:
case OP_VEC:
case OP_INDEX:
case OP_RINDEX:
@@ -758,27 +908,28 @@ OP *op;
case OP_GGRNAM:
case OP_GGRGID:
case OP_GETLOGIN:
- if (!(op->op_private & OPpLVAL_INTRO))
- useless = op_desc[op->op_type];
+ func_ops:
+ if (!(o->op_private & OPpLVAL_INTRO))
+ useless = op_desc[o->op_type];
break;
case OP_RV2GV:
case OP_RV2SV:
case OP_RV2AV:
case OP_RV2HV:
- if (!(op->op_private & OPpLVAL_INTRO) &&
- (!op->op_sibling || op->op_sibling->op_type != OP_READLINE))
+ if (!(o->op_private & OPpLVAL_INTRO) &&
+ (!o->op_sibling || o->op_sibling->op_type != OP_READLINE))
useless = "a variable";
break;
case OP_NEXTSTATE:
case OP_DBSTATE:
- curcop = ((COP*)op); /* for warning below */
+ WITH_THR(PL_curcop = ((COP*)o)); /* for warning below */
break;
case OP_CONST:
- sv = cSVOP->op_sv;
- if (dowarn) {
+ sv = cSVOPo->op_sv;
+ if (PL_dowarn) {
useless = "a constant";
if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
useless = 0;
@@ -789,37 +940,37 @@ OP *op;
useless = 0;
}
}
- null(op); /* don't execute a constant */
+ null(o); /* don't execute a constant */
SvREFCNT_dec(sv); /* don't even remember it */
break;
case OP_POSTINC:
- op->op_type = OP_PREINC; /* pre-increment is faster */
- op->op_ppaddr = ppaddr[OP_PREINC];
+ o->op_type = OP_PREINC; /* pre-increment is faster */
+ o->op_ppaddr = ppaddr[OP_PREINC];
break;
case OP_POSTDEC:
- op->op_type = OP_PREDEC; /* pre-decrement is faster */
- op->op_ppaddr = ppaddr[OP_PREDEC];
+ o->op_type = OP_PREDEC; /* pre-decrement is faster */
+ o->op_ppaddr = ppaddr[OP_PREDEC];
break;
case OP_OR:
case OP_AND:
case OP_COND_EXPR:
- for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
+ for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
scalarvoid(kid);
break;
case OP_NULL:
- if (op->op_targ == OP_NEXTSTATE || op->op_targ == OP_DBSTATE)
- curcop = ((COP*)op); /* for warning below */
- if (op->op_flags & OPf_STACKED)
+ if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
+ WITH_THR(PL_curcop = ((COP*)o)); /* for warning below */
+ if (o->op_flags & OPf_STACKED)
break;
/* FALL THROUGH */
case OP_ENTERTRY:
case OP_ENTER:
case OP_SCALAR:
- if (!(op->op_flags & OPf_KIDS))
+ if (!(o->op_flags & OPf_KIDS))
break;
/* FALL THROUGH */
case OP_SCOPE:
@@ -828,80 +979,79 @@ OP *op;
case OP_LEAVELOOP:
case OP_LINESEQ:
case OP_LIST:
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
scalarvoid(kid);
break;
case OP_ENTEREVAL:
- scalarkids(op);
+ scalarkids(o);
break;
case OP_REQUIRE:
/* all requires must return a boolean value */
- op->op_flags &= ~OPf_WANT;
- return scalar(op);
+ o->op_flags &= ~OPf_WANT;
+ return scalar(o);
case OP_SPLIT:
- if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) {
+ if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
if (!kPMOP->op_pmreplroot)
deprecate("implicit split to @_");
}
break;
}
- if (useless && dowarn)
+ if (useless && PL_dowarn)
warn("Useless use of %s in void context", useless);
- return op;
+ return o;
}
OP *
-listkids(op)
-OP *op;
+listkids(OP *o)
{
OP *kid;
- if (op && op->op_flags & OPf_KIDS) {
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ if (o && o->op_flags & OPf_KIDS) {
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
list(kid);
}
- return op;
+ return o;
}
OP *
-list(op)
-OP *op;
+list(OP *o)
{
OP *kid;
/* assumes no premature commitment */
- if (!op || (op->op_flags & OPf_WANT) || error_count
- || op->op_type == OP_RETURN)
- return op;
+ if (!o || (o->op_flags & OPf_WANT) || PL_error_count
+ || o->op_type == OP_RETURN)
+ return o;
- op->op_flags = (op->op_flags & ~OPf_WANT) | OPf_WANT_LIST;
+ o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_LIST;
- switch (op->op_type) {
+ switch (o->op_type) {
case OP_FLOP:
case OP_REPEAT:
- list(cBINOP->op_first);
+ list(cBINOPo->op_first);
break;
case OP_OR:
case OP_AND:
case OP_COND_EXPR:
- for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
+ for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
list(kid);
break;
default:
case OP_MATCH:
+ case OP_QR:
case OP_SUBST:
case OP_NULL:
- if (!(op->op_flags & OPf_KIDS))
+ if (!(o->op_flags & OPf_KIDS))
break;
- if (!op->op_next && cUNOP->op_first->op_type == OP_FLOP) {
- list(cBINOP->op_first);
- return gen_constant_list(op);
+ if (!o->op_next && cUNOPo->op_first->op_type == OP_FLOP) {
+ list(cBINOPo->op_first);
+ return gen_constant_list(o);
}
case OP_LIST:
- listkids(op);
+ listkids(o);
break;
case OP_LEAVE:
case OP_LEAVETRY:
- kid = cLISTOP->op_first;
+ kid = cLISTOPo->op_first;
list(kid);
while (kid = kid->op_sibling) {
if (kid->op_sibling)
@@ -909,94 +1059,90 @@ OP *op;
else
list(kid);
}
- curcop = &compiling;
+ WITH_THR(PL_curcop = &PL_compiling);
break;
case OP_SCOPE:
case OP_LINESEQ:
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
if (kid->op_sibling)
scalarvoid(kid);
else
list(kid);
}
- curcop = &compiling;
+ WITH_THR(PL_curcop = &PL_compiling);
break;
case OP_REQUIRE:
/* all requires must return a boolean value */
- op->op_flags &= ~OPf_WANT;
- return scalar(op);
+ o->op_flags &= ~OPf_WANT;
+ return scalar(o);
}
- return op;
+ return o;
}
OP *
-scalarseq(op)
-OP *op;
+scalarseq(OP *o)
{
OP *kid;
- if (op) {
- if (op->op_type == OP_LINESEQ ||
- op->op_type == OP_SCOPE ||
- op->op_type == OP_LEAVE ||
- op->op_type == OP_LEAVETRY)
+ if (o) {
+ if (o->op_type == OP_LINESEQ ||
+ o->op_type == OP_SCOPE ||
+ o->op_type == OP_LEAVE ||
+ o->op_type == OP_LEAVETRY)
{
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
+ dTHR;
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
if (kid->op_sibling) {
scalarvoid(kid);
}
}
- curcop = &compiling;
+ PL_curcop = &PL_compiling;
}
- op->op_flags &= ~OPf_PARENS;
- if (hints & HINT_BLOCK_SCOPE)
- op->op_flags |= OPf_PARENS;
+ o->op_flags &= ~OPf_PARENS;
+ if (PL_hints & HINT_BLOCK_SCOPE)
+ o->op_flags |= OPf_PARENS;
}
else
- op = newOP(OP_STUB, 0);
- return op;
+ o = newOP(OP_STUB, 0);
+ return o;
}
-static OP *
-modkids(op, type)
-OP *op;
-I32 type;
+STATIC OP *
+modkids(OP *o, I32 type)
{
OP *kid;
- if (op && op->op_flags & OPf_KIDS) {
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ if (o && o->op_flags & OPf_KIDS) {
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
mod(kid, type);
}
- return op;
+ return o;
}
-static I32 modcount;
-
OP *
-mod(op, type)
-OP *op;
-I32 type;
+mod(OP *o, I32 type)
{
+ dTHR;
OP *kid;
SV *sv;
+ STRLEN n_a;
- if (!op || error_count)
- return op;
+ if (!o || PL_error_count)
+ return o;
- switch (op->op_type) {
+ switch (o->op_type) {
case OP_UNDEF:
- modcount++;
- return op;
+ PL_modcount++;
+ return o;
case OP_CONST:
- if (!(op->op_private & (OPpCONST_ARYBASE)))
+ if (!(o->op_private & (OPpCONST_ARYBASE)))
goto nomod;
- if (eval_start && eval_start->op_type == OP_CONST) {
- compiling.cop_arybase = (I32)SvIV(((SVOP*)eval_start)->op_sv);
- eval_start = 0;
+ if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
+ PL_compiling.cop_arybase = (I32)SvIV(((SVOP*)PL_eval_start)->op_sv);
+ PL_eval_start = 0;
}
else if (!type) {
- SAVEI32(compiling.cop_arybase);
- compiling.cop_arybase = 0;
+ SAVEI32(PL_compiling.cop_arybase);
+ PL_compiling.cop_arybase = 0;
}
else if (type == OP_REFGEN)
goto nomod;
@@ -1004,16 +1150,16 @@ I32 type;
croak("That use of $[ is unsupported");
break;
case OP_STUB:
- if (op->op_flags & OPf_PARENS)
+ if (o->op_flags & OPf_PARENS)
break;
goto nomod;
case OP_ENTERSUB:
if ((type == OP_UNDEF || type == OP_REFGEN) &&
- !(op->op_flags & OPf_STACKED)) {
- op->op_type = OP_RV2CV; /* entersub => rv2cv */
- op->op_ppaddr = ppaddr[OP_RV2CV];
- assert(cUNOP->op_first->op_type == OP_NULL);
- null(((LISTOP*)cUNOP->op_first)->op_first); /* disable pushmark */
+ !(o->op_flags & OPf_STACKED)) {
+ o->op_type = OP_RV2CV; /* entersub => rv2cv */
+ o->op_ppaddr = ppaddr[OP_RV2CV];
+ assert(cUNOPo->op_first->op_type == OP_NULL);
+ null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
break;
}
/* FALL THROUGH */
@@ -1023,9 +1169,9 @@ I32 type;
if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)
break;
yyerror(form("Can't modify %s in %s",
- op_desc[op->op_type],
+ op_desc[o->op_type],
type ? op_desc[type] : "local"));
- return op;
+ return o;
case OP_PREINC:
case OP_PREDEC:
@@ -1047,29 +1193,29 @@ I32 type;
case OP_I_MODULO:
case OP_I_ADD:
case OP_I_SUBTRACT:
- if (!(op->op_flags & OPf_STACKED))
+ if (!(o->op_flags & OPf_STACKED))
goto nomod;
- modcount++;
+ PL_modcount++;
break;
case OP_COND_EXPR:
- for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
+ for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
mod(kid, type);
break;
case OP_RV2AV:
case OP_RV2HV:
- if (!type && cUNOP->op_first->op_type != OP_GV)
+ if (!type && cUNOPo->op_first->op_type != OP_GV)
croak("Can't localize through a reference");
- if (type == OP_REFGEN && op->op_flags & OPf_PARENS) {
- modcount = 10000;
- return op; /* Treat \(@foo) like ordinary list. */
+ if (type == OP_REFGEN && o->op_flags & OPf_PARENS) {
+ PL_modcount = 10000;
+ return o; /* Treat \(@foo) like ordinary list. */
}
/* FALL THROUGH */
case OP_RV2GV:
- if (scalar_mod_type(op, type))
+ if (scalar_mod_type(o, type))
goto nomod;
- ref(cUNOP->op_first, op->op_type);
+ ref(cUNOPo->op_first, o->op_type);
/* FALL THROUGH */
case OP_AASSIGN:
case OP_ASLICE:
@@ -1078,34 +1224,41 @@ I32 type;
case OP_DBSTATE:
case OP_REFGEN:
case OP_CHOMP:
- modcount = 10000;
+ PL_modcount = 10000;
break;
case OP_RV2SV:
- if (!type && cUNOP->op_first->op_type != OP_GV)
+ if (!type && cUNOPo->op_first->op_type != OP_GV)
croak("Can't localize through a reference");
- ref(cUNOP->op_first, op->op_type);
+ ref(cUNOPo->op_first, o->op_type);
/* FALL THROUGH */
case OP_GV:
case OP_AV2ARYLEN:
+ PL_hints |= HINT_BLOCK_SCOPE;
case OP_SASSIGN:
case OP_AELEMFAST:
- modcount++;
+ PL_modcount++;
break;
case OP_PADAV:
case OP_PADHV:
- modcount = 10000;
- if (type == OP_REFGEN && op->op_flags & OPf_PARENS)
- return op; /* Treat \(@foo) like ordinary list. */
- if (scalar_mod_type(op, type))
+ PL_modcount = 10000;
+ if (type == OP_REFGEN && o->op_flags & OPf_PARENS)
+ return o; /* Treat \(@foo) like ordinary list. */
+ if (scalar_mod_type(o, type))
goto nomod;
/* FALL THROUGH */
case OP_PADSV:
- modcount++;
+ PL_modcount++;
if (!type)
croak("Can't localize lexical variable %s",
- SvPV(*av_fetch(comppad_name, op->op_targ, 4), na));
+ SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), n_a));
+ break;
+
+#ifdef USE_THREADS
+ case OP_THREADSV:
+ PL_modcount++; /* XXX ??? */
break;
+#endif /* USE_THREADS */
case OP_PUSHMARK:
break;
@@ -1113,67 +1266,70 @@ I32 type;
case OP_KEYS:
if (type != OP_SASSIGN)
goto nomod;
+ goto lvalue_func;
+ case OP_SUBSTR:
+ if (o->op_private == 4) /* don't allow 4 arg substr as lvalue */
+ goto nomod;
/* FALL THROUGH */
case OP_POS:
case OP_VEC:
- case OP_SUBSTR:
- pad_free(op->op_targ);
- op->op_targ = pad_alloc(op->op_type, SVs_PADMY);
- assert(SvTYPE(PAD_SV(op->op_targ)) == SVt_NULL);
- if (op->op_flags & OPf_KIDS)
- mod(cBINOP->op_first->op_sibling, type);
+ lvalue_func:
+ pad_free(o->op_targ);
+ o->op_targ = pad_alloc(o->op_type, SVs_PADMY);
+ assert(SvTYPE(PAD_SV(o->op_targ)) == SVt_NULL);
+ if (o->op_flags & OPf_KIDS)
+ mod(cBINOPo->op_first->op_sibling, type);
break;
case OP_AELEM:
case OP_HELEM:
- ref(cBINOP->op_first, op->op_type);
+ ref(cBINOPo->op_first, o->op_type);
if (type == OP_ENTERSUB &&
- !(op->op_private & (OPpLVAL_INTRO | OPpDEREF)))
- op->op_private |= OPpLVAL_DEFER;
- modcount++;
+ !(o->op_private & (OPpLVAL_INTRO | OPpDEREF)))
+ o->op_private |= OPpLVAL_DEFER;
+ PL_modcount++;
break;
case OP_SCOPE:
case OP_LEAVE:
case OP_ENTER:
- if (op->op_flags & OPf_KIDS)
- mod(cLISTOP->op_last, type);
+ if (o->op_flags & OPf_KIDS)
+ mod(cLISTOPo->op_last, type);
break;
case OP_NULL:
- if (!(op->op_flags & OPf_KIDS))
+ if (!(o->op_flags & OPf_KIDS))
break;
- if (op->op_targ != OP_LIST) {
- mod(cBINOP->op_first, type);
+ if (o->op_targ != OP_LIST) {
+ mod(cBINOPo->op_first, type);
break;
}
/* FALL THROUGH */
case OP_LIST:
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
mod(kid, type);
break;
}
- op->op_flags |= OPf_MOD;
+ o->op_flags |= OPf_MOD;
if (type == OP_AASSIGN || type == OP_SASSIGN)
- op->op_flags |= OPf_SPECIAL|OPf_REF;
+ o->op_flags |= OPf_SPECIAL|OPf_REF;
else if (!type) {
- op->op_private |= OPpLVAL_INTRO;
- op->op_flags &= ~OPf_SPECIAL;
+ o->op_private |= OPpLVAL_INTRO;
+ o->op_flags &= ~OPf_SPECIAL;
+ PL_hints |= HINT_BLOCK_SCOPE;
}
else if (type != OP_GREPSTART && type != OP_ENTERSUB)
- op->op_flags |= OPf_REF;
- return op;
+ o->op_flags |= OPf_REF;
+ return o;
}
static bool
-scalar_mod_type(op, type)
-OP *op;
-I32 type;
+scalar_mod_type(OP *o, I32 type)
{
switch (type) {
case OP_SASSIGN:
- if (op->op_type == OP_RV2GV)
+ if (o->op_type == OP_RV2GV)
return FALSE;
/* FALL THROUGH */
case OP_PREINC:
@@ -1204,6 +1360,9 @@ I32 type;
case OP_CONCAT:
case OP_SUBST:
case OP_TRANS:
+ case OP_READ:
+ case OP_SYSREAD:
+ case OP_RECV:
case OP_ANDASSIGN: /* may work later */
case OP_ORASSIGN: /* may work later */
return TRUE;
@@ -1213,83 +1372,83 @@ I32 type;
}
OP *
-refkids(op, type)
-OP *op;
-I32 type;
+refkids(OP *o, I32 type)
{
OP *kid;
- if (op && op->op_flags & OPf_KIDS) {
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ if (o && o->op_flags & OPf_KIDS) {
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
ref(kid, type);
}
- return op;
+ return o;
}
OP *
-ref(op, type)
-OP *op;
-I32 type;
+ref(OP *o, I32 type)
{
OP *kid;
- if (!op || error_count)
- return op;
+ if (!o || PL_error_count)
+ return o;
- switch (op->op_type) {
+ switch (o->op_type) {
case OP_ENTERSUB:
- if ((type == OP_DEFINED) &&
- !(op->op_flags & OPf_STACKED)) {
- op->op_type = OP_RV2CV; /* entersub => rv2cv */
- op->op_ppaddr = ppaddr[OP_RV2CV];
- assert(cUNOP->op_first->op_type == OP_NULL);
- null(((LISTOP*)cUNOP->op_first)->op_first); /* disable pushmark */
- op->op_flags |= OPf_SPECIAL;
+ if ((type == OP_DEFINED || type == OP_LOCK) &&
+ !(o->op_flags & OPf_STACKED)) {
+ o->op_type = OP_RV2CV; /* entersub => rv2cv */
+ o->op_ppaddr = ppaddr[OP_RV2CV];
+ assert(cUNOPo->op_first->op_type == OP_NULL);
+ null(((LISTOP*)cUNOPo->op_first)->op_first); /* disable pushmark */
+ o->op_flags |= OPf_SPECIAL;
}
break;
-
+
case OP_COND_EXPR:
- for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
+ for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
ref(kid, type);
break;
case OP_RV2SV:
- ref(cUNOP->op_first, op->op_type);
+ ref(cUNOPo->op_first, o->op_type);
/* FALL THROUGH */
case OP_PADSV:
if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
- op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
- : type == OP_RV2HV ? OPpDEREF_HV
- : OPpDEREF_SV);
- op->op_flags |= OPf_MOD;
+ o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
+ : type == OP_RV2HV ? OPpDEREF_HV
+ : OPpDEREF_SV);
+ o->op_flags |= OPf_MOD;
}
break;
+ case OP_THREADSV:
+ o->op_flags |= OPf_MOD; /* XXX ??? */
+ break;
+
case OP_RV2AV:
case OP_RV2HV:
- op->op_flags |= OPf_REF;
+ o->op_flags |= OPf_REF;
/* FALL THROUGH */
case OP_RV2GV:
- ref(cUNOP->op_first, op->op_type);
+ ref(cUNOPo->op_first, o->op_type);
break;
case OP_PADAV:
case OP_PADHV:
- op->op_flags |= OPf_REF;
+ o->op_flags |= OPf_REF;
break;
-
+
case OP_SCALAR:
case OP_NULL:
- if (!(op->op_flags & OPf_KIDS))
+ if (!(o->op_flags & OPf_KIDS))
break;
- ref(cBINOP->op_first, type);
+ ref(cBINOPo->op_first, type);
break;
case OP_AELEM:
case OP_HELEM:
- ref(cBINOP->op_first, op->op_type);
+ ref(cBINOPo->op_first, o->op_type);
if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
- op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
- : type == OP_RV2HV ? OPpDEREF_HV
- : OPpDEREF_SV);
- op->op_flags |= OPf_MOD;
+ o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
+ : type == OP_RV2HV ? OPpDEREF_HV
+ : OPpDEREF_SV);
+ o->op_flags |= OPf_MOD;
}
break;
@@ -1297,48 +1456,47 @@ I32 type;
case OP_LEAVE:
case OP_ENTER:
case OP_LIST:
- if (!(op->op_flags & OPf_KIDS))
+ if (!(o->op_flags & OPf_KIDS))
break;
- ref(cLISTOP->op_last, type);
+ ref(cLISTOPo->op_last, type);
break;
default:
break;
}
- return scalar(op);
+ return scalar(o);
}
OP *
-my(op)
-OP *op;
+my(OP *o)
{
OP *kid;
I32 type;
- if (!op || error_count)
- return op;
+ if (!o || PL_error_count)
+ return o;
- type = op->op_type;
+ type = o->op_type;
if (type == OP_LIST) {
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
my(kid);
- }
- else if (type != OP_PADSV &&
+ } else if (type == OP_UNDEF) {
+ return o;
+ } else if (type != OP_PADSV &&
type != OP_PADAV &&
type != OP_PADHV &&
type != OP_PUSHMARK)
{
- yyerror(form("Can't declare %s in my", op_desc[op->op_type]));
- return op;
+ yyerror(form("Can't declare %s in my", op_desc[o->op_type]));
+ return o;
}
- op->op_flags |= OPf_MOD;
- op->op_private |= OPpLVAL_INTRO;
- return op;
+ o->op_flags |= OPf_MOD;
+ o->op_private |= OPpLVAL_INTRO;
+ return o;
}
OP *
-sawparens(o)
-OP *o;
+sawparens(OP *o)
{
if (o)
o->op_flags |= OPf_PARENS;
@@ -1346,14 +1504,11 @@ OP *o;
}
OP *
-bind_match(type, left, right)
-I32 type;
-OP *left;
-OP *right;
+bind_match(I32 type, OP *left, OP *right)
{
- OP *op;
+ OP *o;
- if (dowarn &&
+ if (PL_dowarn &&
(left->op_type == OP_RV2AV ||
left->op_type == OP_RV2HV ||
left->op_type == OP_PADAV ||
@@ -1374,12 +1529,12 @@ OP *right;
if (right->op_type != OP_MATCH)
left = mod(left, right->op_type);
if (right->op_type == OP_TRANS)
- op = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
+ o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
else
- op = prepend_elem(right->op_type, scalar(left), right);
+ o = prepend_elem(right->op_type, scalar(left), right);
if (type == OP_NOT)
- return newUNOP(OP_NOT, 0, scalar(op));
- return op;
+ return newUNOP(OP_NOT, 0, scalar(o));
+ return o;
}
else
return bind_match(type, left,
@@ -1387,21 +1542,19 @@ OP *right;
}
OP *
-invert(op)
-OP *op;
+invert(OP *o)
{
- if (!op)
- return op;
+ if (!o)
+ return o;
/* XXX need to optimize away NOT NOT here? Or do we let optimizer do it? */
- return newUNOP(OP_NOT, OPf_SPECIAL, scalar(op));
+ return newUNOP(OP_NOT, OPf_SPECIAL, scalar(o));
}
OP *
-scope(o)
-OP *o;
+scope(OP *o)
{
if (o) {
- if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || tainting) {
+ if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || PL_tainting) {
o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
o->op_type = OP_LEAVE;
o->op_ppaddr = ppaddr[OP_LEAVE];
@@ -1424,73 +1577,94 @@ OP *o;
return o;
}
+void
+save_hints(void)
+{
+ SAVEI32(PL_hints);
+ SAVESPTR(GvHV(PL_hintgv));
+ GvHV(PL_hintgv) = newHVhv(GvHV(PL_hintgv));
+ SAVEFREESV(GvHV(PL_hintgv));
+}
+
int
-block_start(full)
-int full;
+block_start(int full)
{
- int retval = savestack_ix;
- SAVEI32(comppad_name_floor);
+ dTHR;
+ int retval = PL_savestack_ix;
+
+ SAVEI32(PL_comppad_name_floor);
if (full) {
- if ((comppad_name_fill = AvFILL(comppad_name)) > 0)
- comppad_name_floor = comppad_name_fill;
+ if ((PL_comppad_name_fill = AvFILLp(PL_comppad_name)) > 0)
+ PL_comppad_name_floor = PL_comppad_name_fill;
else
- comppad_name_floor = 0;
- }
- SAVEI32(min_intro_pending);
- SAVEI32(max_intro_pending);
- min_intro_pending = 0;
- SAVEI32(comppad_name_fill);
- SAVEI32(padix_floor);
- padix_floor = padix;
- pad_reset_pending = FALSE;
- SAVEI32(hints);
- hints &= ~HINT_BLOCK_SCOPE;
+ PL_comppad_name_floor = 0;
+ }
+ SAVEI32(PL_min_intro_pending);
+ SAVEI32(PL_max_intro_pending);
+ PL_min_intro_pending = 0;
+ SAVEI32(PL_comppad_name_fill);
+ SAVEI32(PL_padix_floor);
+ PL_padix_floor = PL_padix;
+ PL_pad_reset_pending = FALSE;
+ SAVEHINTS();
+ PL_hints &= ~HINT_BLOCK_SCOPE;
return retval;
}
OP*
-block_end(floor, seq)
-I32 floor;
-OP* seq;
+block_end(I32 floor, OP *seq)
{
- int needblockscope = hints & HINT_BLOCK_SCOPE;
+ dTHR;
+ int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
OP* retval = scalarseq(seq);
LEAVE_SCOPE(floor);
- pad_reset_pending = FALSE;
+ PL_pad_reset_pending = FALSE;
if (needblockscope)
- hints |= HINT_BLOCK_SCOPE; /* propagate out */
- pad_leavemy(comppad_name_fill);
- cop_seqmax++;
+ PL_hints |= HINT_BLOCK_SCOPE; /* propagate out */
+ pad_leavemy(PL_comppad_name_fill);
+ PL_cop_seqmax++;
return retval;
}
+STATIC OP *
+newDEFSVOP(void)
+{
+#ifdef USE_THREADS
+ OP *o = newOP(OP_THREADSV, 0);
+ o->op_targ = find_threadsv("_");
+ return o;
+#else
+ return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
+#endif /* USE_THREADS */
+}
+
void
-newPROG(op)
-OP *op;
+newPROG(OP *o)
{
- if (in_eval) {
- eval_root = newUNOP(OP_LEAVEEVAL, ((in_eval & 4) ? OPf_SPECIAL : 0), op);
- eval_start = linklist(eval_root);
- eval_root->op_next = 0;
- peep(eval_start);
+ dTHR;
+ if (PL_in_eval) {
+ PL_eval_root = newUNOP(OP_LEAVEEVAL, ((PL_in_eval & 4) ? OPf_SPECIAL : 0), o);
+ PL_eval_start = linklist(PL_eval_root);
+ PL_eval_root->op_next = 0;
+ peep(PL_eval_start);
}
else {
- if (!op)
+ if (!o)
return;
- main_root = scope(sawparens(scalarvoid(op)));
- curcop = &compiling;
- main_start = LINKLIST(main_root);
- main_root->op_next = 0;
- peep(main_start);
- compcv = 0;
+ PL_main_root = scope(sawparens(scalarvoid(o)));
+ PL_curcop = &PL_compiling;
+ PL_main_start = LINKLIST(PL_main_root);
+ PL_main_root->op_next = 0;
+ peep(PL_main_start);
+ PL_compcv = 0;
/* Register with debugger */
if (PERLDB_INTER) {
CV *cv = perl_get_cv("DB::postponed", FALSE);
if (cv) {
dSP;
- PUSHMARK(sp);
- XPUSHs((SV*)compiling.cop_filegv);
+ PUSHMARK(SP);
+ XPUSHs((SV*)PL_compiling.cop_filegv);
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
}
@@ -1499,22 +1673,20 @@ OP *op;
}
OP *
-localize(o, lex)
-OP *o;
-I32 lex;
+localize(OP *o, I32 lex)
{
if (o->op_flags & OPf_PARENS)
list(o);
else {
- scalar(o);
- if (dowarn && bufptr > oldbufptr && bufptr[-1] == ',') {
+ if (PL_dowarn && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',') {
char *s;
- for (s = bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ;
+ for (s = PL_bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ;
if (*s == ';' || *s == '=')
warn("Parens missing around \"%s\" list", lex ? "my" : "local");
}
}
- in_my = FALSE;
+ PL_in_my = FALSE;
+ PL_in_my_stash = Nullhv;
if (lex)
return my(o);
else
@@ -1522,22 +1694,25 @@ I32 lex;
}
OP *
-jmaybe(o)
-OP *o;
+jmaybe(OP *o)
{
if (o->op_type == OP_LIST) {
- o = convert(OP_JOIN, 0,
- prepend_elem(OP_LIST,
- newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
- o));
+ OP *o2;
+#ifdef USE_THREADS
+ o2 = newOP(OP_THREADSV, 0);
+ o2->op_targ = find_threadsv(";");
+#else
+ o2 = newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
+#endif /* USE_THREADS */
+ o = convert(OP_JOIN, 0, prepend_elem(OP_LIST, o2, o));
}
return o;
}
OP *
-fold_constants(o)
-register OP *o;
+fold_constants(register OP *o)
{
+ dTHR;
register OP *curop;
I32 type = o->op_type;
SV *sv;
@@ -1547,7 +1722,7 @@ register OP *o;
if (opargs[type] & OA_TARGET)
o->op_targ = pad_alloc(type, SVs_PADTMP);
- if ((opargs[type] & OA_OTHERINT) && (hints & HINT_INTEGER))
+ if ((opargs[type] & OA_OTHERINT) && (PL_hints & HINT_INTEGER))
o->op_ppaddr = ppaddr[type = ++(o->op_type)];
if (!(opargs[type] & OA_FOLDCONST))
@@ -1559,11 +1734,17 @@ register OP *o;
case OP_LCFIRST:
case OP_UC:
case OP_LC:
+ case OP_SLT:
+ case OP_SGT:
+ case OP_SLE:
+ case OP_SGE:
+ case OP_SCMP:
+
if (o->op_private & OPpLOCALE)
goto nope;
}
- if (error_count)
+ if (PL_error_count)
goto nope; /* Don't try to run w/ errors */
for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
@@ -1578,9 +1759,9 @@ register OP *o;
curop = LINKLIST(o);
o->op_next = 0;
- op = curop;
- runops();
- sv = *(stack_sp--);
+ PL_op = curop;
+ CALLRUNOPS();
+ sv = *(PL_stack_sp--);
if (o->op_targ && sv == PAD_SV(o->op_targ)) /* grab pad temp? */
pad_swipe(o->op_targ);
else if (SvTEMP(sv)) { /* grab mortal temp? */
@@ -1591,9 +1772,12 @@ register OP *o;
if (type == OP_RV2GV)
return newGVOP(OP_GV, 0, (GV*)sv);
else {
- if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK) {
+ /* try to smush double to int, but don't smush -2.0 to -2 */
+ if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK &&
+ type != OP_NEGATE)
+ {
IV iv = SvIV(sv);
- if ((double)iv == SvNV(sv)) { /* can we smush double to int */
+ if ((double)iv == SvNV(sv)) {
SvREFCNT_dec(sv);
sv = newSViv(iv);
}
@@ -1602,12 +1786,12 @@ register OP *o;
}
return newSVOP(OP_CONST, 0, sv);
}
-
+
nope:
if (!(opargs[type] & OA_OTHERINT))
return o;
- if (!(hints & HINT_INTEGER)) {
+ if (!(PL_hints & HINT_INTEGER)) {
if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS))
return o;
@@ -1628,75 +1812,69 @@ register OP *o;
}
OP *
-gen_constant_list(o)
-register OP *o;
+gen_constant_list(register OP *o)
{
+ dTHR;
register OP *curop;
- I32 oldtmps_floor = tmps_floor;
+ I32 oldtmps_floor = PL_tmps_floor;
list(o);
- if (error_count)
+ if (PL_error_count)
return o; /* Don't attempt to run with errors */
- op = curop = LINKLIST(o);
+ PL_op = curop = LINKLIST(o);
o->op_next = 0;
- pp_pushmark();
- runops();
- op = curop;
- pp_anonlist();
- tmps_floor = oldtmps_floor;
+ pp_pushmark(ARGS);
+ CALLRUNOPS();
+ PL_op = curop;
+ pp_anonlist(ARGS);
+ PL_tmps_floor = oldtmps_floor;
o->op_type = OP_RV2AV;
o->op_ppaddr = ppaddr[OP_RV2AV];
curop = ((UNOP*)o)->op_first;
- ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*stack_sp--));
+ ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*PL_stack_sp--));
op_free(curop);
linklist(o);
return list(o);
}
OP *
-convert(type, flags, op)
-I32 type;
-I32 flags;
-OP* op;
+convert(I32 type, I32 flags, OP *o)
{
OP *kid;
OP *last = 0;
- if (!op || op->op_type != OP_LIST)
- op = newLISTOP(OP_LIST, 0, op, Nullop);
+ if (!o || o->op_type != OP_LIST)
+ o = newLISTOP(OP_LIST, 0, o, Nullop);
else
- op->op_flags &= ~OPf_WANT;
+ o->op_flags &= ~OPf_WANT;
if (!(opargs[type] & OA_MARK))
- null(cLISTOP->op_first);
+ null(cLISTOPo->op_first);
- op->op_type = type;
- op->op_ppaddr = ppaddr[type];
- op->op_flags |= flags;
+ o->op_type = type;
+ o->op_ppaddr = ppaddr[type];
+ o->op_flags |= flags;
- op = CHECKOP(type, op);
- if (op->op_type != type)
- return op;
+ o = CHECKOP(type, o);
+ if (o->op_type != type)
+ return o;
- if (cLISTOP->op_children < 7) {
+ if (cLISTOPo->op_children < 7) {
/* XXX do we really need to do this if we're done appending?? */
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
last = kid;
- cLISTOP->op_last = last; /* in case check substituted last arg */
+ cLISTOPo->op_last = last; /* in case check substituted last arg */
}
- return fold_constants(op);
+ return fold_constants(o);
}
/* List constructors */
OP *
-append_elem(type, first, last)
-I32 type;
-OP* first;
-OP* last;
+append_elem(I32 type, OP *first, OP *last)
{
if (!first)
return last;
@@ -1719,10 +1897,7 @@ OP* last;
}
OP *
-append_list(type, first, last)
-I32 type;
-LISTOP* first;
-LISTOP* last;
+append_list(I32 type, LISTOP *first, LISTOP *last)
{
if (!first)
return (OP*)last;
@@ -1740,17 +1915,14 @@ LISTOP* last;
first->op_last = last->op_last;
first->op_children += last->op_children;
if (first->op_children)
- last->op_flags |= OPf_KIDS;
+ first->op_flags |= OPf_KIDS;
Safefree(last);
return (OP*)first;
}
OP *
-prepend_elem(type, first, last)
-I32 type;
-OP* first;
-OP* last;
+prepend_elem(I32 type, OP *first, OP *last)
{
if (!first)
return last;
@@ -1781,27 +1953,22 @@ OP* last;
/* Constructors */
OP *
-newNULLLIST()
+newNULLLIST(void)
{
return newOP(OP_STUB, 0);
}
OP *
-force_list(op)
-OP* op;
+force_list(OP *o)
{
- if (!op || op->op_type != OP_LIST)
- op = newLISTOP(OP_LIST, 0, op, Nullop);
- null(op);
- return op;
+ if (!o || o->op_type != OP_LIST)
+ o = newLISTOP(OP_LIST, 0, o, Nullop);
+ null(o);
+ return o;
}
OP *
-newLISTOP(type, flags, first, last)
-I32 type;
-I32 flags;
-OP* first;
-OP* last;
+newLISTOP(I32 type, I32 flags, OP *first, OP *last)
{
LISTOP *listop;
@@ -1836,35 +2003,30 @@ OP* last;
}
OP *
-newOP(type, flags)
-I32 type;
-I32 flags;
-{
- OP *op;
- Newz(1101, op, 1, OP);
- op->op_type = type;
- op->op_ppaddr = ppaddr[type];
- op->op_flags = flags;
-
- op->op_next = op;
- op->op_private = 0 + (flags >> 8);
+newOP(I32 type, I32 flags)
+{
+ OP *o;
+ Newz(1101, o, 1, OP);
+ o->op_type = type;
+ o->op_ppaddr = ppaddr[type];
+ o->op_flags = flags;
+
+ o->op_next = o;
+ o->op_private = 0 + (flags >> 8);
if (opargs[type] & OA_RETSCALAR)
- scalar(op);
+ scalar(o);
if (opargs[type] & OA_TARGET)
- op->op_targ = pad_alloc(type, SVs_PADTMP);
- return CHECKOP(type, op);
+ o->op_targ = pad_alloc(type, SVs_PADTMP);
+ return CHECKOP(type, o);
}
OP *
-newUNOP(type, flags, first)
-I32 type;
-I32 flags;
-OP* first;
+newUNOP(I32 type, I32 flags, OP *first)
{
UNOP *unop;
if (!first)
- first = newOP(OP_STUB, 0);
+ first = newOP(OP_STUB, 0);
if (opargs[type] & OA_MARK)
first = force_list(first);
@@ -1874,7 +2036,6 @@ OP* first;
unop->op_first = first;
unop->op_flags = flags | OPf_KIDS;
unop->op_private = 1 | (flags >> 8);
-
unop = (UNOP*) CHECKOP(type, unop);
if (unop->op_next)
return (OP*)unop;
@@ -1883,11 +2044,7 @@ OP* first;
}
OP *
-newBINOP(type, flags, first, last)
-I32 type;
-I32 flags;
-OP* first;
-OP* last;
+newBINOP(I32 type, I32 flags, OP *first, OP *last)
{
BINOP *binop;
Newz(1101, binop, 1, BINOP);
@@ -1918,10 +2075,7 @@ OP* last;
}
OP *
-pmtrans(op, expr, repl)
-OP *op;
-OP *expr;
-OP *repl;
+pmtrans(OP *o, OP *expr, OP *repl)
{
SV *tstr = ((SVOP*)expr)->op_sv;
SV *rstr = ((SVOP*)repl)->op_sv;
@@ -1931,14 +2085,15 @@ OP *repl;
register U8 *r = (U8*)SvPV(rstr, rlen);
register I32 i;
register I32 j;
- I32 delete;
+ I32 Delete;
I32 complement;
+ I32 squash;
register short *tbl;
- tbl = (short*)cPVOP->op_pv;
- complement = op->op_private & OPpTRANS_COMPLEMENT;
- delete = op->op_private & OPpTRANS_DELETE;
- /* squash = op->op_private & OPpTRANS_SQUASH; */
+ tbl = (short*)cPVOPo->op_pv;
+ complement = o->op_private & OPpTRANS_COMPLEMENT;
+ Delete = o->op_private & OPpTRANS_DELETE;
+ squash = o->op_private & OPpTRANS_SQUASH;
if (complement) {
Zero(tbl, 256, short);
@@ -1947,7 +2102,7 @@ OP *repl;
for (i = 0, j = 0; i < 256; i++) {
if (!tbl[i]) {
if (j >= rlen) {
- if (delete)
+ if (Delete)
tbl[i] = -2;
else if (rlen)
tbl[i] = r[j-1];
@@ -1960,14 +2115,16 @@ OP *repl;
}
}
else {
- if (!rlen && !delete) {
+ if (!rlen && !Delete) {
r = t; rlen = tlen;
+ if (!squash)
+ o->op_private |= OPpTRANS_COUNTONLY;
}
for (i = 0; i < 256; i++)
tbl[i] = -1;
for (i = 0, j = 0; i < tlen; i++,j++) {
if (j >= rlen) {
- if (delete) {
+ if (Delete) {
if (tbl[t[i]] == -1)
tbl[t[i]] = -2;
continue;
@@ -1981,14 +2138,13 @@ OP *repl;
op_free(expr);
op_free(repl);
- return op;
+ return o;
}
OP *
-newPMOP(type, flags)
-I32 type;
-I32 flags;
+newPMOP(I32 type, I32 flags)
{
+ dTHR;
PMOP *pmop;
Newz(1101, pmop, 1, PMOP);
@@ -1997,62 +2153,67 @@ I32 flags;
pmop->op_flags = flags;
pmop->op_private = 0 | (flags >> 8);
- if (hints & HINT_LOCALE)
- pmop->op_pmpermflags = (pmop->op_pmflags |= PMf_LOCALE);
+ if (PL_hints & HINT_RE_TAINT)
+ pmop->op_pmpermflags |= PMf_RETAINT;
+ if (PL_hints & HINT_LOCALE)
+ pmop->op_pmpermflags |= PMf_LOCALE;
+ pmop->op_pmflags = pmop->op_pmpermflags;
/* link into pm list */
- if (type != OP_TRANS && curstash) {
- pmop->op_pmnext = HvPMROOT(curstash);
- HvPMROOT(curstash) = pmop;
+ if (type != OP_TRANS && PL_curstash) {
+ pmop->op_pmnext = HvPMROOT(PL_curstash);
+ HvPMROOT(PL_curstash) = pmop;
}
return (OP*)pmop;
}
OP *
-pmruntime(op, expr, repl)
-OP *op;
-OP *expr;
-OP *repl;
+pmruntime(OP *o, OP *expr, OP *repl)
{
+ dTHR;
PMOP *pm;
LOGOP *rcop;
+ I32 repl_has_vars = 0;
- if (op->op_type == OP_TRANS)
- return pmtrans(op, expr, repl);
+ if (o->op_type == OP_TRANS)
+ return pmtrans(o, expr, repl);
- hints |= HINT_BLOCK_SCOPE;
- pm = (PMOP*)op;
+ PL_hints |= HINT_BLOCK_SCOPE;
+ pm = (PMOP*)o;
if (expr->op_type == OP_CONST) {
STRLEN plen;
SV *pat = ((SVOP*)expr)->op_sv;
char *p = SvPV(pat, plen);
- if ((op->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
+ if ((o->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
sv_setpvn(pat, "\\s+", 3);
p = SvPV(pat, plen);
pm->op_pmflags |= PMf_SKIPWHITE;
}
- pm->op_pmregexp = pregcomp(p, p + plen, pm);
- if (strEQ("\\s+", pm->op_pmregexp->precomp))
+ pm->op_pmregexp = CALLREGCOMP(p, p + plen, pm);
+ if (strEQ("\\s+", pm->op_pmregexp->precomp))
pm->op_pmflags |= PMf_WHITE;
- hoistmust(pm);
op_free(expr);
}
else {
- if (pm->op_pmflags & PMf_KEEP)
- expr = newUNOP(OP_REGCMAYBE,0,expr);
+ if (pm->op_pmflags & PMf_KEEP || !(PL_hints & HINT_RE_EVAL))
+ expr = newUNOP((!(PL_hints & HINT_RE_EVAL)
+ ? OP_REGCRESET
+ : OP_REGCMAYBE),0,expr);
Newz(1101, rcop, 1, LOGOP);
rcop->op_type = OP_REGCOMP;
rcop->op_ppaddr = ppaddr[OP_REGCOMP];
rcop->op_first = scalar(expr);
- rcop->op_flags |= OPf_KIDS;
+ rcop->op_flags |= ((PL_hints & HINT_RE_EVAL)
+ ? (OPf_SPECIAL | OPf_KIDS)
+ : OPf_KIDS);
rcop->op_private = 1;
- rcop->op_other = op;
+ rcop->op_other = o;
/* establish postfix order */
- if (pm->op_pmflags & PMf_KEEP) {
+ if (pm->op_pmflags & PMf_KEEP || !(PL_hints & HINT_RE_EVAL)) {
LINKLIST(expr);
rcop->op_next = expr;
((UNOP*)expr)->op_first->op_next = (OP*)rcop;
@@ -2062,24 +2223,44 @@ OP *repl;
expr->op_next = (OP*)rcop;
}
- prepend_elem(op->op_type, scalar((OP*)rcop), op);
+ prepend_elem(o->op_type, scalar((OP*)rcop), o);
}
if (repl) {
OP *curop;
- if (pm->op_pmflags & PMf_EVAL)
+ if (pm->op_pmflags & PMf_EVAL) {
curop = 0;
+ if (PL_curcop->cop_line < PL_multi_end)
+ PL_curcop->cop_line = PL_multi_end;
+ }
+#ifdef USE_THREADS
+ else if (repl->op_type == OP_THREADSV
+ && strchr("&`'123456789+",
+ PL_threadsv_names[repl->op_targ]))
+ {
+ curop = 0;
+ }
+#endif /* USE_THREADS */
else if (repl->op_type == OP_CONST)
curop = repl;
else {
OP *lastop = 0;
for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
if (opargs[curop->op_type] & OA_DANGEROUS) {
+#ifdef USE_THREADS
+ if (curop->op_type == OP_THREADSV) {
+ repl_has_vars = 1;
+ if (strchr("&`'123456789+", curop->op_private))
+ break;
+ }
+#else
if (curop->op_type == OP_GV) {
GV *gv = ((GVOP*)curop)->op_gv;
+ repl_has_vars = 1;
if (strchr("&`'123456789+", *GvENAME(gv)))
break;
}
+#endif /* USE_THREADS */
else if (curop->op_type == OP_RV2CV)
break;
else if (curop->op_type == OP_RV2SV ||
@@ -2093,27 +2274,36 @@ OP *repl;
curop->op_type == OP_PADAV ||
curop->op_type == OP_PADHV ||
curop->op_type == OP_PADANY) {
- /* is okay */
+ repl_has_vars = 1;
}
+ else if (curop->op_type == OP_PUSHRE)
+ ; /* Okay here, dangerous in newASSIGNOP */
else
break;
}
lastop = curop;
}
}
- if (curop == repl) {
+ if (curop == repl
+ && !(repl_has_vars
+ && (!pm->op_pmregexp
+ || pm->op_pmregexp->reganch & ROPT_EVAL_SEEN))) {
pm->op_pmflags |= PMf_CONST; /* const for long enough */
pm->op_pmpermflags |= PMf_CONST; /* const for long enough */
- prepend_elem(op->op_type, scalar(repl), op);
+ prepend_elem(o->op_type, scalar(repl), o);
}
else {
+ if (curop == repl && !pm->op_pmregexp) { /* Has variables. */
+ pm->op_pmflags |= PMf_MAYBE_CONST;
+ pm->op_pmpermflags |= PMf_MAYBE_CONST;
+ }
Newz(1101, rcop, 1, LOGOP);
rcop->op_type = OP_SUBSTCONT;
rcop->op_ppaddr = ppaddr[OP_SUBSTCONT];
rcop->op_first = scalar(repl);
rcop->op_flags |= OPf_KIDS;
rcop->op_private = 1;
- rcop->op_other = op;
+ rcop->op_other = o;
/* establish postfix order */
rcop->op_next = LINKLIST(repl);
@@ -2129,10 +2319,7 @@ OP *repl;
}
OP *
-newSVOP(type, flags, sv)
-I32 type;
-I32 flags;
-SV *sv;
+newSVOP(I32 type, I32 flags, SV *sv)
{
SVOP *svop;
Newz(1101, svop, 1, SVOP);
@@ -2149,11 +2336,9 @@ SV *sv;
}
OP *
-newGVOP(type, flags, gv)
-I32 type;
-I32 flags;
-GV *gv;
+newGVOP(I32 type, I32 flags, GV *gv)
{
+ dTHR;
GVOP *gvop;
Newz(1101, gvop, 1, GVOP);
gvop->op_type = type;
@@ -2169,10 +2354,7 @@ GV *gv;
}
OP *
-newPVOP(type, flags, pv)
-I32 type;
-I32 flags;
-char *pv;
+newPVOP(I32 type, I32 flags, char *pv)
{
PVOP *pvop;
Newz(1101, pvop, 1, PVOP);
@@ -2189,43 +2371,40 @@ char *pv;
}
void
-package(op)
-OP *op;
+package(OP *o)
{
+ dTHR;
SV *sv;
- save_hptr(&curstash);
- save_item(curstname);
- if (op) {
+ save_hptr(&PL_curstash);
+ save_item(PL_curstname);
+ if (o) {
STRLEN len;
char *name;
- sv = cSVOP->op_sv;
+ sv = cSVOPo->op_sv;
name = SvPV(sv, len);
- curstash = gv_stashpvn(name,len,TRUE);
- sv_setpvn(curstname, name, len);
- op_free(op);
+ PL_curstash = gv_stashpvn(name,len,TRUE);
+ sv_setpvn(PL_curstname, name, len);
+ op_free(o);
}
else {
- sv_setpv(curstname,"<none>");
- curstash = Nullhv;
+ sv_setpv(PL_curstname,"<none>");
+ PL_curstash = Nullhv;
}
- copline = NOLINE;
- expect = XSTATE;
+ PL_hints |= HINT_BLOCK_SCOPE;
+ PL_copline = NOLINE;
+ PL_expect = XSTATE;
}
void
-utilize(aver, floor, version, id, arg)
-int aver;
-I32 floor;
-OP *version;
-OP *id;
-OP *arg;
+utilize(int aver, I32 floor, OP *version, OP *id, OP *arg)
{
OP *pack;
OP *meth;
OP *rqop;
OP *imop;
OP *veop;
+ GV *gv;
if (id->op_type != OP_CONST)
croak("Module name must be constant");
@@ -2256,7 +2435,7 @@ OP *arg;
newUNOP(OP_METHOD, 0, meth)));
}
}
-
+
/* Fake up an import/unimport */
if (arg && arg->op_type == OP_STUB)
imop = arg; /* no import on explicit () */
@@ -2277,8 +2456,21 @@ OP *arg;
newUNOP(OP_METHOD, 0, meth)));
}
- /* Fake up a require */
- rqop = newUNOP(OP_REQUIRE, 0, id);
+ /* Fake up a require, handle override, if any */
+ gv = gv_fetchpv("require", FALSE, SVt_PVCV);
+ if (!(gv && GvIMPORTED_CV(gv)))
+ gv = gv_fetchpv("CORE::GLOBAL::require", FALSE, SVt_PVCV);
+
+ if (gv && GvIMPORTED_CV(gv)) {
+ rqop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
+ append_elem(OP_LIST, id,
+ scalar(newUNOP(OP_RV2CV, 0,
+ newGVOP(OP_GV, 0,
+ gv))))));
+ }
+ else {
+ rqop = newUNOP(OP_REQUIRE, 0, id);
+ }
/* Fake up the BEGIN {}, which does its thing immediately. */
newSUB(floor,
@@ -2290,34 +2482,53 @@ OP *arg;
newSTATEOP(0, Nullch, veop)),
newSTATEOP(0, Nullch, imop) ));
- copline = NOLINE;
- expect = XSTATE;
+ PL_copline = NOLINE;
+ PL_expect = XSTATE;
+}
+
+OP *
+dofile(OP *term)
+{
+ OP *doop;
+ GV *gv;
+
+ gv = gv_fetchpv("do", FALSE, SVt_PVCV);
+ if (!(gv && GvIMPORTED_CV(gv)))
+ gv = gv_fetchpv("CORE::GLOBAL::do", FALSE, SVt_PVCV);
+
+ if (gv && GvIMPORTED_CV(gv)) {
+ doop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
+ append_elem(OP_LIST, term,
+ scalar(newUNOP(OP_RV2CV, 0,
+ newGVOP(OP_GV, 0,
+ gv))))));
+ }
+ else {
+ doop = newUNOP(OP_DOFILE, 0, scalar(term));
+ }
+ return doop;
}
OP *
-newSLICEOP(flags, subscript, listval)
-I32 flags;
-OP *subscript;
-OP *listval;
+newSLICEOP(I32 flags, OP *subscript, OP *listval)
{
return newBINOP(OP_LSLICE, flags,
list(force_list(subscript)),
list(force_list(listval)) );
}
-static I32
-list_assignment(op)
-register OP *op;
+STATIC I32
+list_assignment(register OP *o)
{
- if (!op)
+ if (!o)
return TRUE;
- if (op->op_type == OP_NULL && op->op_flags & OPf_KIDS)
- op = cUNOP->op_first;
+ if (o->op_type == OP_NULL && o->op_flags & OPf_KIDS)
+ o = cUNOPo->op_first;
- if (op->op_type == OP_COND_EXPR) {
- I32 t = list_assignment(cCONDOP->op_first->op_sibling);
- I32 f = list_assignment(cCONDOP->op_first->op_sibling->op_sibling);
+ if (o->op_type == OP_COND_EXPR) {
+ I32 t = list_assignment(cCONDOPo->op_first->op_sibling);
+ I32 f = list_assignment(cCONDOPo->op_first->op_sibling->op_sibling);
if (t && f)
return TRUE;
@@ -2326,28 +2537,24 @@ register OP *op;
return FALSE;
}
- if (op->op_type == OP_LIST || op->op_flags & OPf_PARENS ||
- op->op_type == OP_RV2AV || op->op_type == OP_RV2HV ||
- op->op_type == OP_ASLICE || op->op_type == OP_HSLICE)
+ if (o->op_type == OP_LIST || o->op_flags & OPf_PARENS ||
+ o->op_type == OP_RV2AV || o->op_type == OP_RV2HV ||
+ o->op_type == OP_ASLICE || o->op_type == OP_HSLICE)
return TRUE;
- if (op->op_type == OP_PADAV || op->op_type == OP_PADHV)
+ if (o->op_type == OP_PADAV || o->op_type == OP_PADHV)
return TRUE;
- if (op->op_type == OP_RV2SV)
+ if (o->op_type == OP_RV2SV)
return FALSE;
return FALSE;
}
OP *
-newASSIGNOP(flags, left, optype, right)
-I32 flags;
-OP *left;
-I32 optype;
-OP *right;
+newASSIGNOP(I32 flags, OP *left, I32 optype, OP *right)
{
- OP *op;
+ OP *o;
if (optype) {
if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) {
@@ -2362,42 +2569,42 @@ OP *right;
}
if (list_assignment(left)) {
- modcount = 0;
- eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
+ dTHR;
+ PL_modcount = 0;
+ PL_eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
left = mod(left, OP_AASSIGN);
- if (eval_start)
- eval_start = 0;
+ if (PL_eval_start)
+ PL_eval_start = 0;
else {
op_free(left);
op_free(right);
return Nullop;
}
- op = newBINOP(OP_AASSIGN, flags,
+ o = newBINOP(OP_AASSIGN, flags,
list(force_list(right)),
list(force_list(left)) );
- op->op_private = 0 | (flags >> 8);
+ o->op_private = 0 | (flags >> 8);
if (!(left->op_private & OPpLVAL_INTRO)) {
- static int generation = 100;
OP *curop;
- OP *lastop = op;
- generation++;
- for (curop = LINKLIST(op); curop != op; curop = LINKLIST(curop)) {
+ OP *lastop = o;
+ PL_generation++;
+ for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
if (opargs[curop->op_type] & OA_DANGEROUS) {
if (curop->op_type == OP_GV) {
GV *gv = ((GVOP*)curop)->op_gv;
- if (gv == defgv || SvCUR(gv) == generation)
+ if (gv == PL_defgv || SvCUR(gv) == PL_generation)
break;
- SvCUR(gv) = generation;
+ SvCUR(gv) = PL_generation;
}
else if (curop->op_type == OP_PADSV ||
curop->op_type == OP_PADAV ||
curop->op_type == OP_PADHV ||
curop->op_type == OP_PADANY) {
- SV **svp = AvARRAY(comppad_name);
+ SV **svp = AvARRAY(PL_comppad_name);
SV *sv = svp[curop->op_targ];
- if (SvCUR(sv) == generation)
+ if (SvCUR(sv) == PL_generation)
break;
- SvCUR(sv) = generation; /* (SvCUR not used any more) */
+ SvCUR(sv) = PL_generation; /* (SvCUR not used any more) */
}
else if (curop->op_type == OP_RV2CV)
break;
@@ -2408,13 +2615,21 @@ OP *right;
if (lastop->op_type != OP_GV) /* funny deref? */
break;
}
+ else if (curop->op_type == OP_PUSHRE) {
+ if (((PMOP*)curop)->op_pmreplroot) {
+ GV *gv = (GV*)((PMOP*)curop)->op_pmreplroot;
+ if (gv == PL_defgv || SvCUR(gv) == PL_generation)
+ break;
+ SvCUR(gv) = PL_generation;
+ }
+ }
else
break;
}
lastop = curop;
}
- if (curop != op)
- op->op_private = OPpASSIGN_COMMON;
+ if (curop != o)
+ o->op_private = OPpASSIGN_COMMON;
}
if (right && right->op_type == OP_SPLIT) {
OP* tmpop;
@@ -2424,34 +2639,34 @@ OP *right;
PMOP *pm = (PMOP*)tmpop;
if (left->op_type == OP_RV2AV &&
!(left->op_private & OPpLVAL_INTRO) &&
- !(op->op_private & OPpASSIGN_COMMON) )
+ !(o->op_private & OPpASSIGN_COMMON) )
{
tmpop = ((UNOP*)left)->op_first;
if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) {
pm->op_pmreplroot = (OP*)((GVOP*)tmpop)->op_gv;
pm->op_pmflags |= PMf_ONCE;
- tmpop = ((UNOP*)op)->op_first; /* to list (nulled) */
+ tmpop = cUNOPo->op_first; /* to list (nulled) */
tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
tmpop->op_sibling = Nullop; /* don't free split */
right->op_next = tmpop->op_next; /* fix starting loc */
- op_free(op); /* blow off assign */
+ op_free(o); /* blow off assign */
right->op_flags &= ~OPf_WANT;
/* "I don't know and I don't care." */
return right;
}
}
else {
- if (modcount < 10000 &&
+ if (PL_modcount < 10000 &&
((LISTOP*)right)->op_last->op_type == OP_CONST)
{
SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
if (SvIVX(sv) == 0)
- sv_setiv(sv, modcount+1);
+ sv_setiv(sv, PL_modcount+1);
}
}
}
}
- return op;
+ return o;
}
if (!right)
right = newOP(OP_UNDEF, 0);
@@ -2460,30 +2675,28 @@ OP *right;
return newBINOP(OP_NULL, flags, mod(scalar(left), OP_SASSIGN), scalar(right));
}
else {
- eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
- op = newBINOP(OP_SASSIGN, flags,
+ PL_eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
+ o = newBINOP(OP_SASSIGN, flags,
scalar(right), mod(scalar(left), OP_SASSIGN) );
- if (eval_start)
- eval_start = 0;
+ if (PL_eval_start)
+ PL_eval_start = 0;
else {
- op_free(op);
+ op_free(o);
return Nullop;
}
}
- return op;
+ return o;
}
OP *
-newSTATEOP(flags, label, op)
-I32 flags;
-char *label;
-OP *op;
+newSTATEOP(I32 flags, char *label, OP *o)
{
+ dTHR;
U32 seq = intro_my();
register COP *cop;
Newz(1101, cop, 1, COP);
- if (PERLDB_LINE && curcop->cop_line && curstash != debstash) {
+ if (PERLDB_LINE && PL_curcop->cop_line && PL_curstash != PL_debstash) {
cop->op_type = OP_DBSTATE;
cop->op_ppaddr = ppaddr[ OP_DBSTATE ];
}
@@ -2500,64 +2713,69 @@ OP *op;
if (label) {
cop->cop_label = label;
- hints |= HINT_BLOCK_SCOPE;
+ PL_hints |= HINT_BLOCK_SCOPE;
}
cop->cop_seq = seq;
- cop->cop_arybase = curcop->cop_arybase;
+ cop->cop_arybase = PL_curcop->cop_arybase;
- if (copline == NOLINE)
- cop->cop_line = curcop->cop_line;
+ if (PL_copline == NOLINE)
+ cop->cop_line = PL_curcop->cop_line;
else {
- cop->cop_line = copline;
- copline = NOLINE;
+ cop->cop_line = PL_copline;
+ PL_copline = NOLINE;
}
- cop->cop_filegv = (GV*)SvREFCNT_inc(curcop->cop_filegv);
- cop->cop_stash = curstash;
+ cop->cop_filegv = (GV*)SvREFCNT_inc(PL_curcop->cop_filegv);
+ cop->cop_stash = PL_curstash;
- if (PERLDB_LINE && curstash != debstash) {
- SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE);
- if (svp && *svp != &sv_undef && !SvIOK(*svp)) {
+ if (PERLDB_LINE && PL_curstash != PL_debstash) {
+ SV **svp = av_fetch(GvAV(PL_curcop->cop_filegv),(I32)cop->cop_line, FALSE);
+ if (svp && *svp != &PL_sv_undef && !SvIOK(*svp)) {
(void)SvIOK_on(*svp);
SvIVX(*svp) = 1;
SvSTASH(*svp) = (HV*)cop;
}
}
- return prepend_elem(OP_LINESEQ, (OP*)cop, op);
+ return prepend_elem(OP_LINESEQ, (OP*)cop, o);
}
/* "Introduce" my variables to visible status. */
U32
-intro_my()
+intro_my(void)
{
SV **svp;
SV *sv;
I32 i;
- if (! min_intro_pending)
- return cop_seqmax;
+ if (! PL_min_intro_pending)
+ return PL_cop_seqmax;
- svp = AvARRAY(comppad_name);
- for (i = min_intro_pending; i <= max_intro_pending; i++) {
- if ((sv = svp[i]) && sv != &sv_undef && !SvIVX(sv)) {
- SvIVX(sv) = 999999999; /* Don't know scope end yet. */
- SvNVX(sv) = (double)cop_seqmax;
+ svp = AvARRAY(PL_comppad_name);
+ for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
+ if ((sv = svp[i]) && sv != &PL_sv_undef && !SvIVX(sv)) {
+ SvIVX(sv) = PAD_MAX; /* Don't know scope end yet. */
+ SvNVX(sv) = (double)PL_cop_seqmax;
}
}
- min_intro_pending = 0;
- comppad_name_fill = max_intro_pending; /* Needn't search higher */
- return cop_seqmax++;
+ PL_min_intro_pending = 0;
+ PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
+ return PL_cop_seqmax++;
}
OP *
-newLOGOP(type, flags, first, other)
-I32 type;
-I32 flags;
-OP* first;
-OP* other;
+newLOGOP(I32 type, I32 flags, OP *first, OP *other)
{
+ return new_logop(type, flags, &first, &other);
+}
+
+STATIC OP *
+new_logop(I32 type, I32 flags, OP** firstp, OP** otherp)
+{
+ dTHR;
LOGOP *logop;
- OP *op;
+ OP *o;
+ OP *first = *firstp;
+ OP *other = *otherp;
if (type == OP_XOR) /* Not short circuit, but here by precedence. */
return newBINOP(type, flags, scalar(first), scalar(other));
@@ -2570,23 +2788,25 @@ OP* other;
type = OP_OR;
else
type = OP_AND;
- op = first;
- first = cUNOP->op_first;
- if (op->op_next)
- first->op_next = op->op_next;
- cUNOP->op_first = Nullop;
- op_free(op);
+ o = first;
+ first = *firstp = cUNOPo->op_first;
+ if (o->op_next)
+ first->op_next = o->op_next;
+ cUNOPo->op_first = Nullop;
+ op_free(o);
}
}
if (first->op_type == OP_CONST) {
- if (dowarn && (first->op_private & OPpCONST_BARE))
+ if (PL_dowarn && (first->op_private & OPpCONST_BARE))
warn("Probable precedence problem on %s", op_desc[type]);
if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
op_free(first);
+ *firstp = Nullop;
return other;
}
else {
op_free(other);
+ *otherp = Nullop;
return first;
}
}
@@ -2596,7 +2816,7 @@ OP* other;
else
scalar(other);
}
- else if (dowarn && (first->op_flags & OPf_KIDS)) {
+ else if (PL_dowarn && (first->op_flags & OPf_KIDS)) {
OP *k1 = ((UNOP*)first)->op_first;
OP *k2 = k1->op_sibling;
OPCODE warnop = 0;
@@ -2605,7 +2825,7 @@ OP* other;
case OP_NULL:
if (k2 && k2->op_type == OP_READLINE
&& (k2->op_flags & OPf_STACKED)
- && (k1->op_type == OP_RV2SV || k1->op_type == OP_PADSV))
+ && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
warnop = k2->op_type;
break;
@@ -2617,13 +2837,13 @@ OP* other;
break;
}
if (warnop) {
- line_t oldline = curcop->cop_line;
- curcop->cop_line = copline;
+ line_t oldline = PL_curcop->cop_line;
+ PL_curcop->cop_line = PL_copline;
warn("Value of %s%s can be \"0\"; test with defined()",
op_desc[warnop],
((warnop == OP_READLINE || warnop == OP_GLOB)
? " construct" : "() operator"));
- curcop->cop_line = oldline;
+ PL_curcop->cop_line = oldline;
}
}
@@ -2647,21 +2867,18 @@ OP* other;
first->op_next = (OP*)logop;
first->op_sibling = other;
- op = newUNOP(OP_NULL, 0, (OP*)logop);
- other->op_next = op;
+ o = newUNOP(OP_NULL, 0, (OP*)logop);
+ other->op_next = o;
- return op;
+ return o;
}
OP *
-newCONDOP(flags, first, trueop, falseop)
-I32 flags;
-OP* first;
-OP* trueop;
-OP* falseop;
+newCONDOP(I32 flags, OP *first, OP *trueop, OP *falseop)
{
+ dTHR;
CONDOP *condop;
- OP *op;
+ OP *o;
if (!falseop)
return newLOGOP(OP_AND, 0, first, trueop);
@@ -2701,24 +2918,22 @@ OP* falseop;
first->op_sibling = trueop;
trueop->op_sibling = falseop;
- op = newUNOP(OP_NULL, 0, (OP*)condop);
+ o = newUNOP(OP_NULL, 0, (OP*)condop);
- trueop->op_next = op;
- falseop->op_next = op;
+ trueop->op_next = o;
+ falseop->op_next = o;
- return op;
+ return o;
}
OP *
-newRANGE(flags, left, right)
-I32 flags;
-OP *left;
-OP *right;
+newRANGE(I32 flags, OP *left, OP *right)
{
+ dTHR;
CONDOP *condop;
OP *flip;
OP *flop;
- OP *op;
+ OP *o;
Newz(1101, condop, 1, CONDOP);
@@ -2735,7 +2950,7 @@ OP *right;
condop->op_next = (OP*)condop;
flip = newUNOP(OP_FLIP, flags, (OP*)condop);
flop = newUNOP(OP_FLOP, 0, flip);
- op = newUNOP(OP_NULL, 0, flop);
+ o = newUNOP(OP_NULL, 0, flop);
linklist(flop);
left->op_next = flip;
@@ -2749,22 +2964,19 @@ OP *right;
flip->op_private = left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
- flip->op_next = op;
+ flip->op_next = o;
if (!flip->op_private || !flop->op_private)
- linklist(op); /* blow off optimizer unless constant */
+ linklist(o); /* blow off optimizer unless constant */
- return op;
+ return o;
}
OP *
-newLOOPOP(flags, debuggable, expr, block)
-I32 flags;
-I32 debuggable;
-OP *expr;
-OP *block;
+newLOOPOP(I32 flags, I32 debuggable, OP *expr, OP *block)
{
+ dTHR;
OP* listop;
- OP* op;
+ OP* o;
int once = block && block->op_flags & OPf_SPECIAL &&
(block->op_type == OP_ENTERSUB || block->op_type == OP_NULL);
@@ -2774,47 +2986,78 @@ OP *block;
if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
|| (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
expr = newUNOP(OP_DEFINED, 0,
- newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
+ newASSIGNOP(0, newDEFSVOP(), 0, expr) );
+ } else if (expr->op_flags & OPf_KIDS) {
+ OP *k1 = ((UNOP*)expr)->op_first;
+ OP *k2 = (k1) ? k1->op_sibling : NULL;
+ switch (expr->op_type) {
+ case OP_NULL:
+ if (k2 && k2->op_type == OP_READLINE
+ && (k2->op_flags & OPf_STACKED)
+ && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
+ expr = newUNOP(OP_DEFINED, 0, expr);
+ break;
+
+ case OP_SASSIGN:
+ if (k1->op_type == OP_READDIR
+ || k1->op_type == OP_GLOB
+ || k1->op_type == OP_EACH)
+ expr = newUNOP(OP_DEFINED, 0, expr);
+ break;
+ }
}
}
listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
- op = newLOGOP(OP_AND, 0, expr, listop);
+ o = new_logop(OP_AND, 0, &expr, &listop);
- ((LISTOP*)listop)->op_last->op_next = LINKLIST(op);
+ if (listop)
+ ((LISTOP*)listop)->op_last->op_next = LINKLIST(o);
- if (once && op != listop)
- op->op_next = ((LOGOP*)cUNOP->op_first)->op_other;
+ if (once && o != listop)
+ o->op_next = ((LOGOP*)cUNOPo->op_first)->op_other;
- if (op == listop)
- op = newUNOP(OP_NULL, 0, op); /* or do {} while 1 loses outer block */
+ if (o == listop)
+ o = newUNOP(OP_NULL, 0, o); /* or do {} while 1 loses outer block */
- op->op_flags |= flags;
- op = scope(op);
- op->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration*/
- return op;
+ o->op_flags |= flags;
+ o = scope(o);
+ o->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration*/
+ return o;
}
OP *
-newWHILEOP(flags, debuggable, loop, whileline, expr, block, cont)
-I32 flags;
-I32 debuggable;
-LOOP *loop;
-I32 whileline;
-OP *expr;
-OP *block;
-OP *cont;
+newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *block, OP *cont)
{
+ dTHR;
OP *redo;
OP *next = 0;
OP *listop;
- OP *op;
+ OP *o;
OP *condop;
if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
|| (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) {
expr = newUNOP(OP_DEFINED, 0,
- newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
+ newASSIGNOP(0, newDEFSVOP(), 0, expr) );
+ } else if (expr && (expr->op_flags & OPf_KIDS)) {
+ OP *k1 = ((UNOP*)expr)->op_first;
+ OP *k2 = (k1) ? k1->op_sibling : NULL;
+ switch (expr->op_type) {
+ case OP_NULL:
+ if (k2 && k2->op_type == OP_READLINE
+ && (k2->op_flags & OPf_STACKED)
+ && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
+ expr = newUNOP(OP_DEFINED, 0, expr);
+ break;
+
+ case OP_SASSIGN:
+ if (k1->op_type == OP_READDIR
+ || k1->op_type == OP_GLOB
+ || k1->op_type == OP_EACH)
+ expr = newUNOP(OP_DEFINED, 0, expr);
+ break;
+ }
}
if (!block)
@@ -2825,7 +3068,7 @@ OP *cont;
if (expr) {
cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
if ((line_t)whileline != NOLINE) {
- copline = whileline;
+ PL_copline = whileline;
cont = append_elem(OP_LINESEQ, cont,
newSTATEOP(0, Nullch, Nullop));
}
@@ -2835,19 +3078,22 @@ OP *cont;
redo = LINKLIST(listop);
if (expr) {
- op = newLOGOP(OP_AND, 0, expr, scalar(listop));
- if (op == expr && op->op_type == OP_CONST && !SvTRUE(cSVOP->op_sv)) {
+ PL_copline = whileline;
+ scalar(listop);
+ o = new_logop(OP_AND, 0, &expr, &listop);
+ if (o == expr && o->op_type == OP_CONST && !SvTRUE(cSVOPo->op_sv)) {
op_free(expr); /* oops, it's a while (0) */
op_free((OP*)loop);
- return Nullop; /* (listop already freed by newLOGOP) */
+ return Nullop; /* listop already freed by new_logop */
}
- ((LISTOP*)listop)->op_last->op_next = condop =
- (op == listop ? redo : LINKLIST(op));
+ if (listop)
+ ((LISTOP*)listop)->op_last->op_next = condop =
+ (o == listop ? redo : LINKLIST(o));
if (!next)
next = condop;
}
else
- op = listop;
+ o = listop;
if (!loop) {
Newz(1101,loop,1,LOOP);
@@ -2857,34 +3103,23 @@ OP *cont;
loop->op_next = (OP*)loop;
}
- op = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, op);
+ o = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, o);
loop->op_redoop = redo;
- loop->op_lastop = op;
+ loop->op_lastop = o;
if (next)
loop->op_nextop = next;
else
- loop->op_nextop = op;
+ loop->op_nextop = o;
- op->op_flags |= flags;
- op->op_private |= (flags >> 8);
- return op;
+ o->op_flags |= flags;
+ o->op_private |= (flags >> 8);
+ return o;
}
OP *
-#ifndef CAN_PROTOTYPE
-newFOROP(flags,label,forline,sv,expr,block,cont)
-I32 flags;
-char *label;
-line_t forline;
-OP* sv;
-OP* expr;
-OP*block;
-OP*cont;
-#else
newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
-#endif /* CAN_PROTOTYPE */
{
LOOP *loop;
OP *wop;
@@ -2901,60 +3136,120 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont
op_free(sv);
sv = Nullop;
}
+ else if (sv->op_type == OP_THREADSV) { /* per-thread variable */
+ padoff = sv->op_targ;
+ iterflags |= OPf_SPECIAL;
+ op_free(sv);
+ sv = Nullop;
+ }
else
croak("Can't use %s for loop variable", op_desc[sv->op_type]);
}
else {
- sv = newGVOP(OP_GV, 0, defgv);
+#ifdef USE_THREADS
+ padoff = find_threadsv("_");
+ iterflags |= OPf_SPECIAL;
+#else
+ sv = newGVOP(OP_GV, 0, PL_defgv);
+#endif
}
if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) {
- expr = scalar(ref(expr, OP_ITER));
+ expr = mod(force_list(scalar(ref(expr, OP_ITER))), OP_GREPSTART);
+ iterflags |= OPf_STACKED;
+ }
+ else if (expr->op_type == OP_NULL &&
+ (expr->op_flags & OPf_KIDS) &&
+ ((BINOP*)expr)->op_first->op_type == OP_FLOP)
+ {
+ /* Basically turn for($x..$y) into the same as for($x,$y), but we
+ * set the STACKED flag to indicate that these values are to be
+ * treated as min/max values by 'pp_iterinit'.
+ */
+ UNOP* flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first;
+ CONDOP* range = (CONDOP*) flip->op_first;
+ OP* left = range->op_first;
+ OP* right = left->op_sibling;
+ LISTOP* listop;
+
+ range->op_flags &= ~OPf_KIDS;
+ range->op_first = Nullop;
+
+ listop = (LISTOP*)newLISTOP(OP_LIST, 0, left, right);
+ listop->op_first->op_next = range->op_true;
+ left->op_next = range->op_false;
+ right->op_next = (OP*)listop;
+ listop->op_next = listop->op_first;
+
+ op_free(expr);
+ expr = (OP*)(listop);
+ null(expr);
iterflags |= OPf_STACKED;
}
+ else {
+ expr = mod(force_list(expr), OP_GREPSTART);
+ }
+
+
loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
- append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART),
- scalar(sv))));
+ append_elem(OP_LIST, expr, scalar(sv))));
assert(!loop->op_next);
Renew(loop, 1, LOOP);
loop->op_targ = padoff;
wop = newWHILEOP(flags, 1, loop, forline, newOP(OP_ITER, 0), block, cont);
- copline = forline;
+ PL_copline = forline;
return newSTATEOP(0, label, wop);
}
OP*
-newLOOPEX(type, label)
-I32 type;
-OP* label;
+newLOOPEX(I32 type, OP *label)
{
- OP *op;
+ dTHR;
+ OP *o;
+ STRLEN n_a;
if (type != OP_GOTO || label->op_type == OP_CONST) {
- op = newPVOP(type, 0, savepv(
- label->op_type == OP_CONST
- ? SvPVx(((SVOP*)label)->op_sv, na)
- : "" ));
+ /* "last()" means "last" */
+ if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
+ o = newOP(type, OPf_SPECIAL);
+ else {
+ o = newPVOP(type, 0, savepv(label->op_type == OP_CONST
+ ? SvPVx(((SVOP*)label)->op_sv, n_a)
+ : ""));
+ }
op_free(label);
}
else {
if (label->op_type == OP_ENTERSUB)
label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
- op = newUNOP(type, OPf_STACKED, label);
+ o = newUNOP(type, OPf_STACKED, label);
}
- hints |= HINT_BLOCK_SCOPE;
- return op;
+ PL_hints |= HINT_BLOCK_SCOPE;
+ return o;
}
void
-cv_undef(cv)
-CV *cv;
+cv_undef(CV *cv)
{
+ dTHR;
+#ifdef USE_THREADS
+ if (CvMUTEXP(cv)) {
+ MUTEX_DESTROY(CvMUTEXP(cv));
+ Safefree(CvMUTEXP(cv));
+ CvMUTEXP(cv) = 0;
+ }
+#endif /* USE_THREADS */
+
if (!CvXSUB(cv) && CvROOT(cv)) {
+#ifdef USE_THREADS
+ if (CvDEPTH(cv) || (CvOWNER(cv) && CvOWNER(cv) != thr))
+ croak("Can't undef active subroutine");
+#else
if (CvDEPTH(cv))
croak("Can't undef active subroutine");
+#endif /* USE_THREADS */
ENTER;
- SAVESPTR(curpad);
- curpad = 0;
+ SAVESPTR(PL_curpad);
+ PL_curpad = 0;
if (!CvCLONED(cv))
op_free(CvROOT(cv));
@@ -2970,17 +3265,17 @@ CV *cv;
if (CvPADLIST(cv)) {
/* may be during global destruction */
if (SvREFCNT(CvPADLIST(cv))) {
- I32 i = AvFILL(CvPADLIST(cv));
+ I32 i = AvFILLp(CvPADLIST(cv));
while (i >= 0) {
SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
SV* sv = svp ? *svp : Nullsv;
if (!sv)
continue;
- if (sv == (SV*)comppad_name)
- comppad_name = Nullav;
- else if (sv == (SV*)comppad) {
- comppad = Nullav;
- curpad = Null(SV**);
+ if (sv == (SV*)PL_comppad_name)
+ PL_comppad_name = Nullav;
+ else if (sv == (SV*)PL_comppad) {
+ PL_comppad = Nullav;
+ PL_curpad = Null(SV**);
}
SvREFCNT_dec(sv);
}
@@ -2991,7 +3286,7 @@ CV *cv;
}
#ifdef DEBUG_CLOSURES
-static void
+STATIC void
cv_dump(cv)
CV* cv;
{
@@ -3006,13 +3301,13 @@ CV* cv;
PerlIO_printf(Perl_debug_log, "\tCV=0x%lx (%s), OUTSIDE=0x%lx (%s)\n",
cv,
(CvANON(cv) ? "ANON"
- : (cv == main_cv) ? "MAIN"
- : CvUNIQUE(outside) ? "UNIQUE"
+ : (cv == PL_main_cv) ? "MAIN"
+ : CvUNIQUE(cv) ? "UNIQUE"
: CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
outside,
(!outside ? "null"
: CvANON(outside) ? "ANON"
- : (outside == main_cv) ? "MAIN"
+ : (outside == PL_main_cv) ? "MAIN"
: CvUNIQUE(outside) ? "UNIQUE"
: CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
@@ -3024,7 +3319,7 @@ CV* cv;
pname = AvARRAY(pad_name);
ppad = AvARRAY(pad);
- for (ix = 1; ix <= AvFILL(pad_name); ix++) {
+ for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
if (SvPOK(pname[ix]))
PerlIO_printf(Perl_debug_log, "\t%4d. 0x%lx (%s\"%s\" %ld-%ld)\n",
ix, ppad[ix],
@@ -3036,11 +3331,10 @@ CV* cv;
}
#endif /* DEBUG_CLOSURES */
-static CV *
-cv_clone2(proto, outside)
-CV* proto;
-CV* outside;
+STATIC CV *
+cv_clone2(CV *proto, CV *outside)
{
+ dTHR;
AV* av;
I32 ix;
AV* protopadlist = CvPADLIST(proto);
@@ -3048,25 +3342,30 @@ CV* outside;
AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
SV** pname = AvARRAY(protopad_name);
SV** ppad = AvARRAY(protopad);
- I32 fname = AvFILL(protopad_name);
- I32 fpad = AvFILL(protopad);
+ I32 fname = AvFILLp(protopad_name);
+ I32 fpad = AvFILLp(protopad);
AV* comppadlist;
CV* cv;
assert(!CvUNIQUE(proto));
ENTER;
- SAVESPTR(curpad);
- SAVESPTR(comppad);
- SAVESPTR(comppad_name);
- SAVESPTR(compcv);
+ SAVESPTR(PL_curpad);
+ SAVESPTR(PL_comppad);
+ SAVESPTR(PL_comppad_name);
+ SAVESPTR(PL_compcv);
- cv = compcv = (CV*)NEWSV(1104,0);
+ cv = PL_compcv = (CV*)NEWSV(1104,0);
sv_upgrade((SV *)cv, SvTYPE(proto));
CvCLONED_on(cv);
if (CvANON(proto))
CvANON_on(cv);
+#ifdef USE_THREADS
+ New(666, CvMUTEXP(cv), 1, perl_mutex);
+ MUTEX_INIT(CvMUTEXP(cv));
+ CvOWNER(cv) = 0;
+#endif /* USE_THREADS */
CvFILEGV(cv) = CvFILEGV(proto);
CvGV(cv) = (GV*)SvREFCNT_inc(CvGV(proto));
CvSTASH(cv) = CvSTASH(proto);
@@ -3078,34 +3377,34 @@ CV* outside;
if (SvPOK(proto))
sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto));
- comppad_name = newAV();
+ PL_comppad_name = newAV();
for (ix = fname; ix >= 0; ix--)
- av_store(comppad_name, ix, SvREFCNT_inc(pname[ix]));
+ av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
- comppad = newAV();
+ PL_comppad = newAV();
comppadlist = newAV();
AvREAL_off(comppadlist);
- av_store(comppadlist, 0, (SV*)comppad_name);
- av_store(comppadlist, 1, (SV*)comppad);
+ av_store(comppadlist, 0, (SV*)PL_comppad_name);
+ av_store(comppadlist, 1, (SV*)PL_comppad);
CvPADLIST(cv) = comppadlist;
- av_fill(comppad, AvFILL(protopad));
- curpad = AvARRAY(comppad);
+ av_fill(PL_comppad, AvFILLp(protopad));
+ PL_curpad = AvARRAY(PL_comppad);
av = newAV(); /* will be @_ */
av_extend(av, 0);
- av_store(comppad, 0, (SV*)av);
+ av_store(PL_comppad, 0, (SV*)av);
AvFLAGS(av) = AVf_REIFY;
for (ix = fpad; ix > 0; ix--) {
SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
- if (namesv && namesv != &sv_undef) {
+ if (namesv && namesv != &PL_sv_undef) {
char *name = SvPVX(namesv); /* XXX */
if (SvFLAGS(namesv) & SVf_FAKE) { /* lexical from outside? */
I32 off = pad_findlex(name, ix, SvIVX(namesv),
- CvOUTSIDE(cv), cxstack_ix);
+ CvOUTSIDE(cv), cxstack_ix, 0, 0);
if (!off)
- curpad[ix] = SvREFCNT_inc(ppad[ix]);
+ PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
else if (off != ix)
croak("panic: cv_clone: %s", name);
}
@@ -3123,13 +3422,13 @@ CV* outside;
sv = NEWSV(0,0);
if (!SvPADBUSY(sv))
SvPADMY_on(sv);
- curpad[ix] = sv;
+ PL_curpad[ix] = sv;
}
}
else {
SV* sv = NEWSV(0,0);
SvPADTMP_on(sv);
- curpad[ix] = sv;
+ PL_curpad[ix] = sv;
}
}
@@ -3138,7 +3437,7 @@ CV* outside;
for (ix = fpad; ix > 0; ix--) {
SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
if (namesv
- && namesv != &sv_undef
+ && namesv != &PL_sv_undef
&& !(SvFLAGS(namesv) & SVf_FAKE)
&& *SvPVX(namesv) == '&'
&& CvCLONE(ppad[ix]))
@@ -3147,7 +3446,7 @@ CV* outside;
SvREFCNT_dec(ppad[ix]);
CvCLONE_on(kid);
SvPADMY_on(kid);
- curpad[ix] = (SV*)kid;
+ PL_curpad[ix] = (SV*)kid;
}
}
@@ -3165,17 +3464,17 @@ CV* outside;
}
CV *
-cv_clone(proto)
-CV* proto;
+cv_clone(CV *proto)
{
- return cv_clone2(proto, CvOUTSIDE(proto));
+ CV *cv;
+ MUTEX_LOCK(&PL_cred_mutex); /* XXX create separate mutex */
+ cv = cv_clone2(proto, CvOUTSIDE(proto));
+ MUTEX_UNLOCK(&PL_cred_mutex); /* XXX create separate mutex */
+ return cv;
}
void
-cv_ckproto(cv, gv, p)
-CV* cv;
-GV* gv;
-char* p;
+cv_ckproto(CV *cv, GV *gv, char *p)
{
if ((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) {
SV* msg = sv_newmortal();
@@ -3198,19 +3497,29 @@ char* p;
}
SV *
-cv_const_sv(cv)
-CV* cv;
+cv_const_sv(CV *cv)
{
- OP *o;
- SV *sv;
-
if (!cv || !SvPOK(cv) || SvCUR(cv))
return Nullsv;
+ return op_const_sv(CvSTART(cv), cv);
+}
- sv = Nullsv;
- for (o = CvSTART(cv); o; o = o->op_next) {
+SV *
+op_const_sv(OP *o, CV *cv)
+{
+ SV *sv = Nullsv;
+
+ if(!o)
+ return Nullsv;
+
+ if(o->op_type == OP_LINESEQ && cLISTOPo->op_first)
+ o = cLISTOPo->op_first->op_sibling;
+
+ for (; o; o = o->op_next) {
OPCODE type = o->op_type;
-
+
+ if(sv && o->op_next == o)
+ return sv;
if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK)
continue;
if (type == OP_LEAVESUB || type == OP_RETURN)
@@ -3218,10 +3527,10 @@ CV* cv;
if (sv)
return Nullsv;
if (type == OP_CONST)
- sv = ((SVOP*)o)->op_sv;
- else if (type == OP_PADSV) {
- AV* pad = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
- sv = pad ? AvARRAY(pad)[o->op_targ] : Nullsv;
+ sv = cSVOPo->op_sv;
+ else if (type == OP_PADSV && cv) {
+ AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
+ sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv;
if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1))
return Nullsv;
}
@@ -3234,23 +3543,39 @@ CV* cv;
}
CV *
-newSUB(floor,op,proto,block)
-I32 floor;
-OP *op;
-OP *proto;
-OP *block;
-{
- char *name = op ? SvPVx(cSVOP->op_sv, na) : Nullch;
- GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
- char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, na) : Nullch;
- register CV *cv;
+newSUB(I32 floor, OP *o, OP *proto, OP *block)
+{
+ dTHR;
+ STRLEN n_a;
+ char *name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch;
+ GV *gv = gv_fetchpv(name ? name : "__ANON__",
+ GV_ADDMULTI | (block ? 0 : GV_NOINIT), SVt_PVCV);
+ char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, n_a) : Nullch;
+ register CV *cv=0;
I32 ix;
- if (op)
- SAVEFREEOP(op);
+ if (o)
+ SAVEFREEOP(o);
if (proto)
SAVEFREEOP(proto);
+ if (SvTYPE(gv) != SVt_PVGV) { /* Prototype now, and had
+ maximum a prototype before. */
+ if (SvTYPE(gv) > SVt_NULL) {
+ if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1))
+ warn("Runaway prototype");
+ cv_ckproto((CV*)gv, NULL, ps);
+ }
+ if (ps)
+ sv_setpv((SV*)gv, ps);
+ else
+ sv_setiv((SV*)gv, -1);
+ SvREFCNT_dec(PL_compcv);
+ cv = PL_compcv = NULL;
+ PL_sub_generation++;
+ goto noblock;
+ }
+
if (!name || GvCVGEN(gv))
cv = Nullcv;
else if (cv = GvCV(gv)) {
@@ -3258,21 +3583,26 @@ OP *block;
/* already defined (or promised)? */
if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
SV* const_sv;
+ bool const_changed = TRUE;
if (!block) {
/* just a "sub foo;" when &foo is already defined */
- SAVEFREESV(compcv);
+ SAVEFREESV(PL_compcv);
goto done;
}
/* ahem, death to those who redefine active sort subs */
- if (curstack == sortstack && sortcop == CvSTART(cv))
+ if (PL_curstackinfo->si_type == PERLSI_SORT && PL_sortcop == CvSTART(cv))
croak("Can't redefine active sort subroutine %s", name);
- const_sv = cv_const_sv(cv);
- if (const_sv || dowarn) {
- line_t oldline = curcop->cop_line;
- curcop->cop_line = copline;
+ if(const_sv = cv_const_sv(cv))
+ const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv));
+ if ((const_sv && const_changed) || PL_dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
+ && HvNAME(GvSTASH(CvGV(cv)))
+ && strEQ(HvNAME(GvSTASH(CvGV(cv))),
+ "autouse"))) {
+ line_t oldline = PL_curcop->cop_line;
+ PL_curcop->cop_line = PL_copline;
warn(const_sv ? "Constant subroutine %s redefined"
: "Subroutine %s redefined", name);
- curcop->cop_line = oldline;
+ PL_curcop->cop_line = oldline;
}
SvREFCNT_dec(cv);
cv = Nullcv;
@@ -3280,31 +3610,38 @@ OP *block;
}
if (cv) { /* must reuse cv if autoloaded */
cv_undef(cv);
- CvFLAGS(cv) = CvFLAGS(compcv);
- CvOUTSIDE(cv) = CvOUTSIDE(compcv);
- CvOUTSIDE(compcv) = 0;
- CvPADLIST(cv) = CvPADLIST(compcv);
- CvPADLIST(compcv) = 0;
- if (SvREFCNT(compcv) > 1) /* XXX Make closures transit through stub. */
- CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)cv);
- SvREFCNT_dec(compcv);
+ CvFLAGS(cv) = CvFLAGS(PL_compcv);
+ CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv);
+ CvOUTSIDE(PL_compcv) = 0;
+ CvPADLIST(cv) = CvPADLIST(PL_compcv);
+ CvPADLIST(PL_compcv) = 0;
+ if (SvREFCNT(PL_compcv) > 1) /* XXX Make closures transit through stub. */
+ CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc((SV*)cv);
+ SvREFCNT_dec(PL_compcv);
}
else {
- cv = compcv;
+ cv = PL_compcv;
if (name) {
GvCV(gv) = cv;
GvCVGEN(gv) = 0;
- sub_generation++;
+ PL_sub_generation++;
}
}
CvGV(cv) = (GV*)SvREFCNT_inc(gv);
- CvFILEGV(cv) = curcop->cop_filegv;
- CvSTASH(cv) = curstash;
+ CvFILEGV(cv) = PL_curcop->cop_filegv;
+ CvSTASH(cv) = PL_curstash;
+#ifdef USE_THREADS
+ CvOWNER(cv) = 0;
+ if (!CvMUTEXP(cv)) {
+ New(666, CvMUTEXP(cv), 1, perl_mutex);
+ MUTEX_INIT(CvMUTEXP(cv));
+ }
+#endif /* USE_THREADS */
if (ps)
sv_setpv((SV*)cv, ps);
- if (error_count) {
+ if (PL_error_count) {
op_free(block);
block = Nullop;
if (name) {
@@ -3313,31 +3650,32 @@ OP *block;
if (strEQ(s, "BEGIN")) {
char *not_safe =
"BEGIN not safe after errors--compilation aborted";
- if (in_eval & 4)
+ if (PL_in_eval & 4)
croak(not_safe);
else {
/* force display of errors found but not reported */
- sv_catpv(GvSV(errgv), not_safe);
- croak("%s", SvPVx(GvSV(errgv), na));
+ sv_catpv(ERRSV, not_safe);
+ croak("%s", SvPVx(ERRSV, n_a));
}
}
}
}
if (!block) {
- copline = NOLINE;
+ noblock:
+ PL_copline = NOLINE;
LEAVE_SCOPE(floor);
return cv;
}
- if (AvFILL(comppad_name) < AvFILL(comppad))
- av_store(comppad_name, AvFILL(comppad), Nullsv);
+ if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
+ av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
if (CvCLONE(cv)) {
- SV **namep = AvARRAY(comppad_name);
- for (ix = AvFILL(comppad); ix > 0; ix--) {
+ SV **namep = AvARRAY(PL_comppad_name);
+ for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
SV *namesv;
- if (SvIMMORTAL(curpad[ix]))
+ if (SvIMMORTAL(PL_curpad[ix]))
continue;
/*
* The only things that a clonable function needs in its
@@ -3345,26 +3683,26 @@ OP *block;
* The rest are created anew during cloning.
*/
if (!((namesv = namep[ix]) != Nullsv &&
- namesv != &sv_undef &&
+ namesv != &PL_sv_undef &&
(SvFAKE(namesv) ||
*SvPVX(namesv) == '&')))
{
- SvREFCNT_dec(curpad[ix]);
- curpad[ix] = Nullsv;
+ SvREFCNT_dec(PL_curpad[ix]);
+ PL_curpad[ix] = Nullsv;
}
}
}
else {
AV *av = newAV(); /* Will be @_ */
av_extend(av, 0);
- av_store(comppad, 0, (SV*)av);
+ av_store(PL_comppad, 0, (SV*)av);
AvFLAGS(av) = AVf_REIFY;
- for (ix = AvFILL(comppad); ix > 0; ix--) {
- if (SvIMMORTAL(curpad[ix]))
+ for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
+ if (SvIMMORTAL(PL_curpad[ix]))
continue;
- if (!SvPADMY(curpad[ix]))
- SvPADTMP_on(curpad[ix]);
+ if (!SvPADMY(PL_curpad[ix]))
+ SvPADTMP_on(PL_curpad[ix]);
}
}
@@ -3376,26 +3714,23 @@ OP *block;
if (name) {
char *s;
- if (PERLDB_SUBLINE && curstash != debstash) {
+ if (PERLDB_SUBLINE && PL_curstash != PL_debstash) {
SV *sv = NEWSV(0,0);
SV *tmpstr = sv_newmortal();
- static GV *db_postponed;
+ GV *db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
CV *cv;
HV *hv;
sv_setpvf(sv, "%_:%ld-%ld",
- GvSV(curcop->cop_filegv),
- (long)subline, (long)curcop->cop_line);
+ GvSV(PL_curcop->cop_filegv),
+ (long)PL_subline, (long)PL_curcop->cop_line);
gv_efullname3(tmpstr, gv, Nullch);
- hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
- if (!db_postponed) {
- db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
- }
+ hv_store(GvHV(PL_DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
hv = GvHVn(db_postponed);
if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
&& (cv = GvCV(db_postponed))) {
dSP;
- PUSHMARK(sp);
+ PUSHMARK(SP);
XPUSHs(tmpstr);
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
@@ -3407,60 +3742,76 @@ OP *block;
else
s = name;
if (strEQ(s, "BEGIN")) {
- I32 oldscope = scopestack_ix;
+ I32 oldscope = PL_scopestack_ix;
ENTER;
- SAVESPTR(compiling.cop_filegv);
- SAVEI16(compiling.cop_line);
- SAVEI32(perldb);
- save_svref(&rs);
- sv_setsv(rs, nrs);
-
- if (!beginav)
- beginav = newAV();
+ SAVESPTR(PL_compiling.cop_filegv);
+ SAVEI16(PL_compiling.cop_line);
+ save_svref(&PL_rs);
+ sv_setsv(PL_rs, PL_nrs);
+
+ if (!PL_beginav)
+ PL_beginav = newAV();
DEBUG_x( dump_sub(gv) );
- av_push(beginav, (SV *)cv);
+ av_push(PL_beginav, (SV *)cv);
GvCV(gv) = 0;
- call_list(oldscope, beginav);
+ call_list(oldscope, PL_beginav);
- curcop = &compiling;
+ PL_curcop = &PL_compiling;
LEAVE;
}
- else if (strEQ(s, "END") && !error_count) {
- if (!endav)
- endav = newAV();
- av_unshift(endav, 1);
- av_store(endav, 0, (SV *)cv);
+ else if (strEQ(s, "END") && !PL_error_count) {
+ if (!PL_endav)
+ PL_endav = newAV();
+ av_unshift(PL_endav, 1);
+ av_store(PL_endav, 0, (SV *)cv);
+ GvCV(gv) = 0;
+ }
+ else if (strEQ(s, "INIT") && !PL_error_count) {
+ if (!PL_initav)
+ PL_initav = newAV();
+ av_push(PL_initav, SvREFCNT_inc(cv));
GvCV(gv) = 0;
}
}
done:
- copline = NOLINE;
+ PL_copline = NOLINE;
LEAVE_SCOPE(floor);
return cv;
}
-#ifdef DEPRECATED
-CV *
-newXSUB(name, ix, subaddr, filename)
-char *name;
-I32 ix;
-I32 (*subaddr)();
-char *filename;
-{
- CV* cv = newXS(name, (void(*)())subaddr, filename);
- CvOLDSTYLE_on(cv);
- CvXSUBANY(cv).any_i32 = ix;
- return cv;
+/* XXX unsafe for threads if eval_owner isn't held */
+void
+newCONSTSUB(HV *stash, char *name, SV *sv)
+{
+ dTHR;
+ U32 oldhints = PL_hints;
+ HV *old_cop_stash = PL_curcop->cop_stash;
+ HV *old_curstash = PL_curstash;
+ line_t oldline = PL_curcop->cop_line;
+ PL_curcop->cop_line = PL_copline;
+
+ PL_hints &= ~HINT_BLOCK_SCOPE;
+ if(stash)
+ PL_curstash = PL_curcop->cop_stash = stash;
+
+ newSUB(
+ start_subparse(FALSE, 0),
+ newSVOP(OP_CONST, 0, newSVpv(name,0)),
+ newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
+ newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
+ );
+
+ PL_hints = oldhints;
+ PL_curcop->cop_stash = old_cop_stash;
+ PL_curstash = old_curstash;
+ PL_curcop->cop_line = oldline;
}
-#endif
CV *
-newXS(name, subaddr, filename)
-char *name;
-void (*subaddr) _((CV*));
-char *filename;
+newXS(char *name, void (*subaddr) (CV * _CPERLproto), char *filename)
{
+ dTHR;
GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
register CV *cv;
@@ -3472,11 +3823,14 @@ char *filename;
}
else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
/* already defined (or promised) */
- if (dowarn) {
- line_t oldline = curcop->cop_line;
- curcop->cop_line = copline;
+ if (PL_dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
+ && HvNAME(GvSTASH(CvGV(cv)))
+ && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
+ line_t oldline = PL_curcop->cop_line;
+ if (PL_copline != NOLINE)
+ PL_curcop->cop_line = PL_copline;
warn("Subroutine %s redefined",name);
- curcop->cop_line = oldline;
+ PL_curcop->cop_line = oldline;
}
SvREFCNT_dec(cv);
cv = 0;
@@ -3491,10 +3845,15 @@ char *filename;
if (name) {
GvCV(gv) = cv;
GvCVGEN(gv) = 0;
- sub_generation++;
+ PL_sub_generation++;
}
}
CvGV(cv) = (GV*)SvREFCNT_inc(gv);
+#ifdef USE_THREADS
+ New(666, CvMUTEXP(cv), 1, perl_mutex);
+ MUTEX_INIT(CvMUTEXP(cv));
+ CvOWNER(cv) = 0;
+#endif /* USE_THREADS */
CvFILEGV(cv) = gv_fetchfile(filename);
CvXSUB(cv) = subaddr;
@@ -3505,16 +3864,22 @@ char *filename;
else
s = name;
if (strEQ(s, "BEGIN")) {
- if (!beginav)
- beginav = newAV();
- av_push(beginav, (SV *)cv);
+ if (!PL_beginav)
+ PL_beginav = newAV();
+ av_push(PL_beginav, (SV *)cv);
GvCV(gv) = 0;
}
else if (strEQ(s, "END")) {
- if (!endav)
- endav = newAV();
- av_unshift(endav, 1);
- av_store(endav, 0, (SV *)cv);
+ if (!PL_endav)
+ PL_endav = newAV();
+ av_unshift(PL_endav, 1);
+ av_store(PL_endav, 0, (SV *)cv);
+ GvCV(gv) = 0;
+ }
+ else if (strEQ(s, "INIT")) {
+ if (!PL_initav)
+ PL_initav = newAV();
+ av_push(PL_initav, (SV *)cv);
GvCV(gv) = 0;
}
}
@@ -3525,86 +3890,79 @@ char *filename;
}
void
-newFORM(floor,op,block)
-I32 floor;
-OP *op;
-OP *block;
+newFORM(I32 floor, OP *o, OP *block)
{
+ dTHR;
register CV *cv;
char *name;
GV *gv;
I32 ix;
+ STRLEN n_a;
- if (op)
- name = SvPVx(cSVOP->op_sv, na);
+ if (o)
+ name = SvPVx(cSVOPo->op_sv, n_a);
else
name = "STDOUT";
gv = gv_fetchpv(name,TRUE, SVt_PVFM);
GvMULTI_on(gv);
if (cv = GvFORM(gv)) {
- if (dowarn) {
- line_t oldline = curcop->cop_line;
+ if (PL_dowarn) {
+ line_t oldline = PL_curcop->cop_line;
- curcop->cop_line = copline;
+ PL_curcop->cop_line = PL_copline;
warn("Format %s redefined",name);
- curcop->cop_line = oldline;
+ PL_curcop->cop_line = oldline;
}
SvREFCNT_dec(cv);
}
- cv = compcv;
+ cv = PL_compcv;
GvFORM(gv) = cv;
CvGV(cv) = (GV*)SvREFCNT_inc(gv);
- CvFILEGV(cv) = curcop->cop_filegv;
+ CvFILEGV(cv) = PL_curcop->cop_filegv;
- for (ix = AvFILL(comppad); ix > 0; ix--) {
- if (!SvPADMY(curpad[ix]) && !SvIMMORTAL(curpad[ix]))
- SvPADTMP_on(curpad[ix]);
+ for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
+ if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
+ SvPADTMP_on(PL_curpad[ix]);
}
CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
CvSTART(cv) = LINKLIST(CvROOT(cv));
CvROOT(cv)->op_next = 0;
peep(CvSTART(cv));
- op_free(op);
- copline = NOLINE;
+ op_free(o);
+ PL_copline = NOLINE;
LEAVE_SCOPE(floor);
}
OP *
-newANONLIST(op)
-OP* op;
+newANONLIST(OP *o)
{
return newUNOP(OP_REFGEN, 0,
- mod(list(convert(OP_ANONLIST, 0, op)), OP_REFGEN));
+ mod(list(convert(OP_ANONLIST, 0, o)), OP_REFGEN));
}
OP *
-newANONHASH(op)
-OP* op;
+newANONHASH(OP *o)
{
return newUNOP(OP_REFGEN, 0,
- mod(list(convert(OP_ANONHASH, 0, op)), OP_REFGEN));
+ mod(list(convert(OP_ANONHASH, 0, o)), OP_REFGEN));
}
OP *
-newANONSUB(floor, proto, block)
-I32 floor;
-OP *proto;
-OP *block;
+newANONSUB(I32 floor, OP *proto, OP *block)
{
return newUNOP(OP_REFGEN, 0,
newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, proto, block)));
}
OP *
-oopsAV(o)
-OP *o;
+oopsAV(OP *o)
{
switch (o->op_type) {
case OP_PADSV:
o->op_type = OP_PADAV;
o->op_ppaddr = ppaddr[OP_PADAV];
- return ref(newUNOP(OP_RV2AV, 0, scalar(o)), OP_RV2AV);
+ return ref(o, OP_RV2AV);
case OP_RV2SV:
o->op_type = OP_RV2AV;
@@ -3620,15 +3978,14 @@ OP *o;
}
OP *
-oopsHV(o)
-OP *o;
+oopsHV(OP *o)
{
switch (o->op_type) {
case OP_PADSV:
case OP_PADAV:
o->op_type = OP_PADHV;
o->op_ppaddr = ppaddr[OP_PADHV];
- return ref(newUNOP(OP_RV2HV, 0, scalar(o)), OP_RV2HV);
+ return ref(o, OP_RV2HV);
case OP_RV2SV:
case OP_RV2AV:
@@ -3645,8 +4002,7 @@ OP *o;
}
OP *
-newAVREF(o)
-OP *o;
+newAVREF(OP *o)
{
if (o->op_type == OP_PADANY) {
o->op_type = OP_PADAV;
@@ -3657,18 +4013,15 @@ OP *o;
}
OP *
-newGVREF(type,o)
-I32 type;
-OP *o;
+newGVREF(I32 type, OP *o)
{
- if (type == OP_MAPSTART)
+ if (type == OP_MAPSTART || type == OP_GREPSTART)
return newUNOP(OP_NULL, 0, o);
return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
}
OP *
-newHVREF(o)
-OP *o;
+newHVREF(OP *o)
{
if (o->op_type == OP_PADANY) {
o->op_type = OP_PADHV;
@@ -3679,8 +4032,7 @@ OP *o;
}
OP *
-oopsCV(o)
-OP *o;
+oopsCV(OP *o)
{
croak("NOT IMPL LINE %d",__LINE__);
/* STUB */
@@ -3688,30 +4040,30 @@ OP *o;
}
OP *
-newCVREF(flags, o)
-I32 flags;
-OP *o;
+newCVREF(I32 flags, OP *o)
{
return newUNOP(OP_RV2CV, flags, scalar(o));
}
OP *
-newSVREF(o)
-OP *o;
+newSVREF(OP *o)
{
if (o->op_type == OP_PADANY) {
o->op_type = OP_PADSV;
o->op_ppaddr = ppaddr[OP_PADSV];
return o;
}
+ else if (o->op_type == OP_THREADSV && !(o->op_flags & OPpDONE_SVREF)) {
+ o->op_flags |= OPpDONE_SVREF;
+ return o;
+ }
return newUNOP(OP_RV2SV, 0, scalar(o));
}
/* Check routines. */
OP *
-ck_anoncode(op)
-OP *op;
+ck_anoncode(OP *o)
{
PADOFFSET ix;
SV* name;
@@ -3721,111 +4073,105 @@ OP *op;
sv_setpvn(name, "&", 1);
SvIVX(name) = -1;
SvNVX(name) = 1;
- ix = pad_alloc(op->op_type, SVs_PADMY);
- av_store(comppad_name, ix, name);
- av_store(comppad, ix, cSVOP->op_sv);
- SvPADMY_on(cSVOP->op_sv);
- cSVOP->op_sv = Nullsv;
- cSVOP->op_targ = ix;
- return op;
+ ix = pad_alloc(o->op_type, SVs_PADMY);
+ av_store(PL_comppad_name, ix, name);
+ av_store(PL_comppad, ix, cSVOPo->op_sv);
+ SvPADMY_on(cSVOPo->op_sv);
+ cSVOPo->op_sv = Nullsv;
+ cSVOPo->op_targ = ix;
+ return o;
}
OP *
-ck_bitop(op)
-OP *op;
+ck_bitop(OP *o)
{
- op->op_private = hints;
- return op;
+ o->op_private = PL_hints;
+ return o;
}
OP *
-ck_concat(op)
-OP *op;
+ck_concat(OP *o)
{
- if (cUNOP->op_first->op_type == OP_CONCAT)
- op->op_flags |= OPf_STACKED;
- return op;
+ if (cUNOPo->op_first->op_type == OP_CONCAT)
+ o->op_flags |= OPf_STACKED;
+ return o;
}
OP *
-ck_spair(op)
-OP *op;
+ck_spair(OP *o)
{
- if (op->op_flags & OPf_KIDS) {
+ if (o->op_flags & OPf_KIDS) {
OP* newop;
OP* kid;
- OPCODE type = op->op_type;
- op = modkids(ck_fun(op), type);
- kid = cUNOP->op_first;
+ OPCODE type = o->op_type;
+ o = modkids(ck_fun(o), type);
+ kid = cUNOPo->op_first;
newop = kUNOP->op_first->op_sibling;
if (newop &&
(newop->op_sibling ||
!(opargs[newop->op_type] & OA_RETSCALAR) ||
newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
-
- return op;
+
+ return o;
}
op_free(kUNOP->op_first);
kUNOP->op_first = newop;
}
- op->op_ppaddr = ppaddr[++op->op_type];
- return ck_fun(op);
+ o->op_ppaddr = ppaddr[++o->op_type];
+ return ck_fun(o);
}
OP *
-ck_delete(op)
-OP *op;
+ck_delete(OP *o)
{
- op = ck_fun(op);
- op->op_private = 0;
- if (op->op_flags & OPf_KIDS) {
- OP *kid = cUNOP->op_first;
+ o = ck_fun(o);
+ o->op_private = 0;
+ if (o->op_flags & OPf_KIDS) {
+ OP *kid = cUNOPo->op_first;
if (kid->op_type == OP_HSLICE)
- op->op_private |= OPpSLICE;
+ o->op_private |= OPpSLICE;
else if (kid->op_type != OP_HELEM)
croak("%s argument is not a HASH element or slice",
- op_desc[op->op_type]);
+ op_desc[o->op_type]);
null(kid);
}
- return op;
+ return o;
}
OP *
-ck_eof(op)
-OP *op;
+ck_eof(OP *o)
{
- I32 type = op->op_type;
+ I32 type = o->op_type;
- if (op->op_flags & OPf_KIDS) {
- if (cLISTOP->op_first->op_type == OP_STUB) {
- op_free(op);
- op = newUNOP(type, OPf_SPECIAL,
- newGVOP(OP_GV, 0, gv_fetchpv("main::ARGV", TRUE, SVt_PVAV)));
+ if (o->op_flags & OPf_KIDS) {
+ if (cLISTOPo->op_first->op_type == OP_STUB) {
+ op_free(o);
+ o = newUNOP(type, OPf_SPECIAL,
+ newGVOP(OP_GV, 0, gv_fetchpv("main::ARGV", TRUE, SVt_PVAV)));
}
- return ck_fun(op);
+ return ck_fun(o);
}
- return op;
+ return o;
}
OP *
-ck_eval(op)
-OP *op;
+ck_eval(OP *o)
{
- hints |= HINT_BLOCK_SCOPE;
- if (op->op_flags & OPf_KIDS) {
- SVOP *kid = (SVOP*)cUNOP->op_first;
+ PL_hints |= HINT_BLOCK_SCOPE;
+ if (o->op_flags & OPf_KIDS) {
+ SVOP *kid = (SVOP*)cUNOPo->op_first;
if (!kid) {
- op->op_flags &= ~OPf_KIDS;
- null(op);
+ o->op_flags &= ~OPf_KIDS;
+ null(o);
}
else if (kid->op_type == OP_LINESEQ) {
LOGOP *enter;
- kid->op_next = op->op_next;
- cUNOP->op_first = 0;
- op_free(op);
+ kid->op_next = o->op_next;
+ cUNOPo->op_first = 0;
+ op_free(o);
Newz(1101, enter, 1, LOGOP);
enter->op_type = OP_ENTERTRY;
@@ -3835,54 +4181,53 @@ OP *op;
/* establish postfix order */
enter->op_next = (OP*)enter;
- op = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
- op->op_type = OP_LEAVETRY;
- op->op_ppaddr = ppaddr[OP_LEAVETRY];
- enter->op_other = op;
- return op;
+ o = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
+ o->op_type = OP_LEAVETRY;
+ o->op_ppaddr = ppaddr[OP_LEAVETRY];
+ enter->op_other = o;
+ return o;
}
+ else
+ scalar((OP*)kid);
}
else {
- op_free(op);
- op = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
+ op_free(o);
+ o = newUNOP(OP_ENTEREVAL, 0, newDEFSVOP());
}
- op->op_targ = (PADOFFSET)hints;
- return op;
+ o->op_targ = (PADOFFSET)PL_hints;
+ return o;
}
OP *
-ck_exec(op)
-OP *op;
+ck_exec(OP *o)
{
OP *kid;
- if (op->op_flags & OPf_STACKED) {
- op = ck_fun(op);
- kid = cUNOP->op_first->op_sibling;
+ if (o->op_flags & OPf_STACKED) {
+ o = ck_fun(o);
+ kid = cUNOPo->op_first->op_sibling;
if (kid->op_type == OP_RV2GV)
null(kid);
}
else
- op = listkids(op);
- return op;
+ o = listkids(o);
+ return o;
}
OP *
-ck_exists(op)
-OP *op;
+ck_exists(OP *o)
{
- op = ck_fun(op);
- if (op->op_flags & OPf_KIDS) {
- OP *kid = cUNOP->op_first;
+ o = ck_fun(o);
+ if (o->op_flags & OPf_KIDS) {
+ OP *kid = cUNOPo->op_first;
if (kid->op_type != OP_HELEM)
- croak("%s argument is not a HASH element", op_desc[op->op_type]);
+ croak("%s argument is not a HASH element", op_desc[o->op_type]);
null(kid);
}
- return op;
+ return o;
}
OP *
-ck_gvconst(o)
-register OP *o;
+ck_gvconst(register OP *o)
{
o = fold_constants(o);
if (o->op_type == OP_CONST)
@@ -3891,21 +4236,61 @@ register OP *o;
}
OP *
-ck_rvconst(op)
-register OP *op;
+ck_rvconst(register OP *o)
{
- SVOP *kid = (SVOP*)cUNOP->op_first;
+ dTHR;
+ SVOP *kid = (SVOP*)cUNOPo->op_first;
- op->op_private |= (hints & HINT_STRICT_REFS);
+ o->op_private |= (PL_hints & HINT_STRICT_REFS);
if (kid->op_type == OP_CONST) {
char *name;
int iscv;
GV *gv;
+ SV *kidsv = kid->op_sv;
+ STRLEN n_a;
+
+ /* Is it a constant from cv_const_sv()? */
+ if (SvROK(kidsv) && SvREADONLY(kidsv)) {
+ SV *rsv = SvRV(kidsv);
+ int svtype = SvTYPE(rsv);
+ char *badtype = Nullch;
+
+ switch (o->op_type) {
+ case OP_RV2SV:
+ if (svtype > SVt_PVMG)
+ badtype = "a SCALAR";
+ break;
+ case OP_RV2AV:
+ if (svtype != SVt_PVAV)
+ badtype = "an ARRAY";
+ break;
+ case OP_RV2HV:
+ if (svtype != SVt_PVHV) {
+ if (svtype == SVt_PVAV) { /* pseudohash? */
+ SV **ksv = av_fetch((AV*)rsv, 0, FALSE);
+ if (ksv && SvROK(*ksv)
+ && SvTYPE(SvRV(*ksv)) == SVt_PVHV)
+ {
+ break;
+ }
+ }
+ badtype = "a HASH";
+ }
+ break;
+ case OP_RV2CV:
+ if (svtype != SVt_PVCV)
+ badtype = "a CODE";
+ break;
+ }
+ if (badtype)
+ croak("Constant is not %s reference", badtype);
+ return o;
+ }
+ name = SvPV(kidsv, n_a);
- name = SvPV(kid->op_sv, na);
- if ((hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
+ if ((PL_hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
char *badthing = Nullch;
- switch (op->op_type) {
+ switch (o->op_type) {
case OP_RV2SV:
badthing = "a SCALAR";
break;
@@ -3921,86 +4306,90 @@ register OP *op;
"Can't use bareword (\"%s\") as %s ref while \"strict refs\" in use",
name, badthing);
}
- kid->op_type = OP_GV;
- iscv = (op->op_type == OP_RV2CV) * 2;
- for (gv = 0; !gv; iscv++) {
- /*
- * This is a little tricky. We only want to add the symbol if we
- * didn't add it in the lexer. Otherwise we get duplicate strict
- * warnings. But if we didn't add it in the lexer, we must at
- * least pretend like we wanted to add it even if it existed before,
- * or we get possible typo warnings. OPpCONST_ENTERED says
- * whether the lexer already added THIS instance of this symbol.
- */
+ /*
+ * This is a little tricky. We only want to add the symbol if we
+ * didn't add it in the lexer. Otherwise we get duplicate strict
+ * warnings. But if we didn't add it in the lexer, we must at
+ * least pretend like we wanted to add it even if it existed before,
+ * or we get possible typo warnings. OPpCONST_ENTERED says
+ * whether the lexer already added THIS instance of this symbol.
+ */
+ iscv = (o->op_type == OP_RV2CV) * 2;
+ do {
gv = gv_fetchpv(name,
iscv | !(kid->op_private & OPpCONST_ENTERED),
iscv
? SVt_PVCV
- : op->op_type == OP_RV2SV
+ : o->op_type == OP_RV2SV
? SVt_PV
- : op->op_type == OP_RV2AV
+ : o->op_type == OP_RV2AV
? SVt_PVAV
- : op->op_type == OP_RV2HV
+ : o->op_type == OP_RV2HV
? SVt_PVHV
: SVt_PVGV);
+ } while (!gv && !(kid->op_private & OPpCONST_ENTERED) && !iscv++);
+ if (gv) {
+ kid->op_type = OP_GV;
+ SvREFCNT_dec(kid->op_sv);
+ kid->op_sv = SvREFCNT_inc(gv);
}
- SvREFCNT_dec(kid->op_sv);
- kid->op_sv = SvREFCNT_inc(gv);
}
- return op;
+ return o;
}
OP *
-ck_ftst(op)
-OP *op;
+ck_ftst(OP *o)
{
- I32 type = op->op_type;
+ dTHR;
+ I32 type = o->op_type;
- if (op->op_flags & OPf_REF)
- return op;
+ if (o->op_flags & OPf_REF)
+ return o;
- if (op->op_flags & OPf_KIDS) {
- SVOP *kid = (SVOP*)cUNOP->op_first;
+ if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
+ SVOP *kid = (SVOP*)cUNOPo->op_first;
if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
+ STRLEN n_a;
OP *newop = newGVOP(type, OPf_REF,
- gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO));
- op_free(op);
+ gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVIO));
+ op_free(o);
return newop;
}
}
else {
- op_free(op);
+ op_free(o);
if (type == OP_FTTTY)
return newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
SVt_PVIO));
else
- return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
+ return newUNOP(type, 0, newDEFSVOP());
}
- return op;
+ return o;
}
OP *
-ck_fun(op)
-OP *op;
+ck_fun(OP *o)
{
+ dTHR;
register OP *kid;
OP **tokid;
OP *sibl;
I32 numargs = 0;
- int type = op->op_type;
+ int type = o->op_type;
register I32 oa = opargs[type] >> OASHIFT;
-
- if (op->op_flags & OPf_STACKED) {
+
+ if (o->op_flags & OPf_STACKED) {
if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
oa &= ~OA_OPTIONAL;
else
- return no_fh_allowed(op);
+ return no_fh_allowed(o);
}
- if (op->op_flags & OPf_KIDS) {
- tokid = &cLISTOP->op_first;
- kid = cLISTOP->op_first;
+ if (o->op_flags & OPf_KIDS) {
+ STRLEN n_a;
+ tokid = &cLISTOPo->op_first;
+ kid = cLISTOPo->op_first;
if (kid->op_type == OP_PUSHMARK ||
kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
{
@@ -4008,7 +4397,7 @@ OP *op;
kid = kid->op_sibling;
}
if (!kid && opargs[type] & OA_DEFGV)
- *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv));
+ *tokid = kid = newDEFSVOP();
while (oa && kid) {
numargs++;
@@ -4028,10 +4417,10 @@ OP *op;
case OA_AVREF:
if (kid->op_type == OP_CONST &&
(kid->op_private & OPpCONST_BARE)) {
- char *name = SvPVx(((SVOP*)kid)->op_sv, na);
+ char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
OP *newop = newAVREF(newGVOP(OP_GV, 0,
gv_fetchpv(name, TRUE, SVt_PVAV) ));
- if (dowarn)
+ if (PL_dowarn)
warn("Array @%s missing the @ in argument %ld of %s()",
name, (long)numargs, op_desc[type]);
op_free(kid);
@@ -4040,16 +4429,16 @@ OP *op;
*tokid = kid;
}
else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
- bad_type(numargs, "array", op_desc[op->op_type], kid);
+ bad_type(numargs, "array", op_desc[o->op_type], kid);
mod(kid, type);
break;
case OA_HVREF:
if (kid->op_type == OP_CONST &&
(kid->op_private & OPpCONST_BARE)) {
- char *name = SvPVx(((SVOP*)kid)->op_sv, na);
+ char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
OP *newop = newHVREF(newGVOP(OP_GV, 0,
gv_fetchpv(name, TRUE, SVt_PVHV) ));
- if (dowarn)
+ if (PL_dowarn)
warn("Hash %%%s missing the %% in argument %ld of %s()",
name, (long)numargs, op_desc[type]);
op_free(kid);
@@ -4058,7 +4447,7 @@ OP *op;
*tokid = kid;
}
else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
- bad_type(numargs, "hash", op_desc[op->op_type], kid);
+ bad_type(numargs, "hash", op_desc[o->op_type], kid);
mod(kid, type);
break;
case OA_CVREF:
@@ -4073,15 +4462,19 @@ OP *op;
}
break;
case OA_FILEREF:
- if (kid->op_type != OP_GV) {
+ if (kid->op_type != OP_GV && kid->op_type != OP_RV2GV) {
if (kid->op_type == OP_CONST &&
(kid->op_private & OPpCONST_BARE)) {
OP *newop = newGVOP(OP_GV, 0,
- gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, na), TRUE,
+ gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, n_a), TRUE,
SVt_PVIO) );
op_free(kid);
kid = newop;
}
+ else if (kid->op_type == OP_READLINE) {
+ /* neophyte patrol: open(<FH>), close(<FH>) etc. */
+ bad_type(numargs, "HANDLE", op_desc[o->op_type], kid);
+ }
else {
kid->op_sibling = 0;
kid = newUNOP(OP_RV2GV, 0, scalar(kid));
@@ -4099,107 +4492,107 @@ OP *op;
tokid = &kid->op_sibling;
kid = kid->op_sibling;
}
- op->op_private |= numargs;
+ o->op_private |= numargs;
if (kid)
- return too_many_arguments(op,op_desc[op->op_type]);
- listkids(op);
+ return too_many_arguments(o,op_desc[o->op_type]);
+ listkids(o);
}
else if (opargs[type] & OA_DEFGV) {
- op_free(op);
- return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
+ op_free(o);
+ return newUNOP(type, 0, newDEFSVOP());
}
if (oa) {
while (oa & OA_OPTIONAL)
oa >>= 4;
if (oa && oa != OA_LIST)
- return too_few_arguments(op,op_desc[op->op_type]);
+ return too_few_arguments(o,op_desc[o->op_type]);
}
- return op;
+ return o;
}
OP *
-ck_glob(op)
-OP *op;
+ck_glob(OP *o)
{
GV *gv;
- if ((op->op_flags & OPf_KIDS) && !cLISTOP->op_first->op_sibling)
- append_elem(OP_GLOB, op, newSVREF(newGVOP(OP_GV, 0, defgv)));
+ if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
+ append_elem(OP_GLOB, o, newDEFSVOP());
if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv)))
gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
if (gv && GvIMPORTED_CV(gv)) {
+#ifndef PERL_OBJECT
static int glob_index;
+#endif
- append_elem(OP_GLOB, op,
+ append_elem(OP_GLOB, o,
newSVOP(OP_CONST, 0, newSViv(glob_index++)));
- op->op_type = OP_LIST;
- op->op_ppaddr = ppaddr[OP_LIST];
- ((LISTOP*)op)->op_first->op_type = OP_PUSHMARK;
- ((LISTOP*)op)->op_first->op_ppaddr = ppaddr[OP_PUSHMARK];
- op = newUNOP(OP_ENTERSUB, OPf_STACKED,
- append_elem(OP_LIST, op,
- scalar(newUNOP(OP_RV2CV, 0,
- newGVOP(OP_GV, 0, gv)))));
- op = newUNOP(OP_NULL, 0, ck_subr(op));
- op->op_targ = OP_GLOB; /* hint at what it used to be */
- return op;
+ o->op_type = OP_LIST;
+ o->op_ppaddr = ppaddr[OP_LIST];
+ cLISTOPo->op_first->op_type = OP_PUSHMARK;
+ cLISTOPo->op_first->op_ppaddr = ppaddr[OP_PUSHMARK];
+ o = newUNOP(OP_ENTERSUB, OPf_STACKED,
+ append_elem(OP_LIST, o,
+ scalar(newUNOP(OP_RV2CV, 0,
+ newGVOP(OP_GV, 0, gv)))));
+ o = newUNOP(OP_NULL, 0, ck_subr(o));
+ o->op_targ = OP_GLOB; /* hint at what it used to be */
+ return o;
}
gv = newGVgen("main");
gv_IOadd(gv);
- append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv));
- scalarkids(op);
- return ck_fun(op);
+ append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
+ scalarkids(o);
+ return ck_fun(o);
}
OP *
-ck_grep(op)
-OP *op;
+ck_grep(OP *o)
{
LOGOP *gwop;
OP *kid;
- OPCODE type = op->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
+ OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
- op->op_ppaddr = ppaddr[OP_GREPSTART];
+ o->op_ppaddr = ppaddr[OP_GREPSTART];
Newz(1101, gwop, 1, LOGOP);
-
- if (op->op_flags & OPf_STACKED) {
+
+ if (o->op_flags & OPf_STACKED) {
OP* k;
- op = ck_sort(op);
- kid = cLISTOP->op_first->op_sibling;
- for (k = cLISTOP->op_first->op_sibling->op_next; k; k = k->op_next) {
+ o = ck_sort(o);
+ kid = cLISTOPo->op_first->op_sibling;
+ for (k = cLISTOPo->op_first->op_sibling->op_next; k; k = k->op_next) {
kid = k;
}
kid->op_next = (OP*)gwop;
- op->op_flags &= ~OPf_STACKED;
+ o->op_flags &= ~OPf_STACKED;
}
- kid = cLISTOP->op_first->op_sibling;
+ kid = cLISTOPo->op_first->op_sibling;
if (type == OP_MAPWHILE)
list(kid);
else
scalar(kid);
- op = ck_fun(op);
- if (error_count)
- return op;
- kid = cLISTOP->op_first->op_sibling;
+ o = ck_fun(o);
+ if (PL_error_count)
+ return o;
+ kid = cLISTOPo->op_first->op_sibling;
if (kid->op_type != OP_NULL)
croak("panic: ck_grep");
kid = kUNOP->op_first;
gwop->op_type = type;
gwop->op_ppaddr = ppaddr[type];
- gwop->op_first = listkids(op);
+ gwop->op_first = listkids(o);
gwop->op_flags |= OPf_KIDS;
gwop->op_private = 1;
gwop->op_other = LINKLIST(kid);
gwop->op_targ = pad_alloc(type, SVs_PADTMP);
kid->op_next = (OP*)gwop;
- kid = cLISTOP->op_first->op_sibling;
+ kid = cLISTOPo->op_first->op_sibling;
if (!kid || !kid->op_sibling)
- return too_few_arguments(op,op_desc[op->op_type]);
+ return too_few_arguments(o,op_desc[o->op_type]);
for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
mod(kid, OP_GREPSTART);
@@ -4207,142 +4600,133 @@ OP *op;
}
OP *
-ck_index(op)
-OP *op;
+ck_index(OP *o)
{
- if (op->op_flags & OPf_KIDS) {
- OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
+ if (o->op_flags & OPf_KIDS) {
+ OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
+ if (kid)
+ kid = kid->op_sibling; /* get past "big" */
if (kid && kid->op_type == OP_CONST)
- fbm_compile(((SVOP*)kid)->op_sv);
+ fbm_compile(((SVOP*)kid)->op_sv, 0);
}
- return ck_fun(op);
+ return ck_fun(o);
}
OP *
-ck_lengthconst(op)
-OP *op;
+ck_lengthconst(OP *o)
{
/* XXX length optimization goes here */
- return ck_fun(op);
+ return ck_fun(o);
}
OP *
-ck_lfun(op)
-OP *op;
+ck_lfun(OP *o)
{
- OPCODE type = op->op_type;
- return modkids(ck_fun(op), type);
+ OPCODE type = o->op_type;
+ return modkids(ck_fun(o), type);
}
OP *
-ck_rfun(op)
-OP *op;
+ck_rfun(OP *o)
{
- OPCODE type = op->op_type;
- return refkids(ck_fun(op), type);
+ OPCODE type = o->op_type;
+ return refkids(ck_fun(o), type);
}
OP *
-ck_listiob(op)
-OP *op;
+ck_listiob(OP *o)
{
register OP *kid;
-
- kid = cLISTOP->op_first;
+
+ kid = cLISTOPo->op_first;
if (!kid) {
- op = force_list(op);
- kid = cLISTOP->op_first;
+ o = force_list(o);
+ kid = cLISTOPo->op_first;
}
if (kid->op_type == OP_PUSHMARK)
kid = kid->op_sibling;
- if (kid && op->op_flags & OPf_STACKED)
+ if (kid && o->op_flags & OPf_STACKED)
kid = kid->op_sibling;
else if (kid && !kid->op_sibling) { /* print HANDLE; */
if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
- op->op_flags |= OPf_STACKED; /* make it a filehandle */
+ o->op_flags |= OPf_STACKED; /* make it a filehandle */
kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
- cLISTOP->op_first->op_sibling = kid;
- cLISTOP->op_last = kid;
+ cLISTOPo->op_first->op_sibling = kid;
+ cLISTOPo->op_last = kid;
kid = kid->op_sibling;
}
}
if (!kid)
- append_elem(op->op_type, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
+ append_elem(o->op_type, o, newDEFSVOP());
- op = listkids(op);
+ o = listkids(o);
- op->op_private = 0;
+ o->op_private = 0;
#ifdef USE_LOCALE
- if (hints & HINT_LOCALE)
- op->op_private |= OPpLOCALE;
+ if (PL_hints & HINT_LOCALE)
+ o->op_private |= OPpLOCALE;
#endif
- return op;
+ return o;
}
OP *
-ck_fun_locale(op)
-OP *op;
+ck_fun_locale(OP *o)
{
- op = ck_fun(op);
+ o = ck_fun(o);
- op->op_private = 0;
+ o->op_private = 0;
#ifdef USE_LOCALE
- if (hints & HINT_LOCALE)
- op->op_private |= OPpLOCALE;
+ if (PL_hints & HINT_LOCALE)
+ o->op_private |= OPpLOCALE;
#endif
- return op;
+ return o;
}
OP *
-ck_scmp(op)
-OP *op;
+ck_scmp(OP *o)
{
- op->op_private = 0;
+ o->op_private = 0;
#ifdef USE_LOCALE
- if (hints & HINT_LOCALE)
- op->op_private |= OPpLOCALE;
+ if (PL_hints & HINT_LOCALE)
+ o->op_private |= OPpLOCALE;
#endif
- return op;
+ return o;
}
OP *
-ck_match(op)
-OP *op;
+ck_match(OP *o)
{
- op->op_private |= OPpRUNTIME;
- return op;
+ o->op_private |= OPpRUNTIME;
+ return o;
}
OP *
-ck_null(op)
-OP *op;
+ck_null(OP *o)
{
- return op;
+ return o;
}
OP *
-ck_repeat(op)
-OP *op;
+ck_repeat(OP *o)
{
- if (cBINOP->op_first->op_flags & OPf_PARENS) {
- op->op_private |= OPpREPEAT_DOLIST;
- cBINOP->op_first = force_list(cBINOP->op_first);
+ if (cBINOPo->op_first->op_flags & OPf_PARENS) {
+ o->op_private |= OPpREPEAT_DOLIST;
+ cBINOPo->op_first = force_list(cBINOPo->op_first);
}
else
- scalar(op);
- return op;
+ scalar(o);
+ return o;
}
OP *
-ck_require(op)
-OP *op;
+ck_require(OP *o)
{
- if (op->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */
- SVOP *kid = (SVOP*)cUNOP->op_first;
+ if (o->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */
+ SVOP *kid = (SVOP*)cUNOPo->op_first;
if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
char *s;
@@ -4356,69 +4740,83 @@ OP *op;
sv_catpvn(kid->op_sv, ".pm", 3);
}
}
- return ck_fun(op);
+ return ck_fun(o);
}
OP *
-ck_retarget(op)
-OP *op;
+ck_retarget(OP *o)
{
croak("NOT IMPL LINE %d",__LINE__);
/* STUB */
- return op;
+ return o;
}
OP *
-ck_select(op)
-OP *op;
+ck_select(OP *o)
{
OP* kid;
- if (op->op_flags & OPf_KIDS) {
- kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
+ if (o->op_flags & OPf_KIDS) {
+ kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
if (kid && kid->op_sibling) {
- op->op_type = OP_SSELECT;
- op->op_ppaddr = ppaddr[OP_SSELECT];
- op = ck_fun(op);
- return fold_constants(op);
+ o->op_type = OP_SSELECT;
+ o->op_ppaddr = ppaddr[OP_SSELECT];
+ o = ck_fun(o);
+ return fold_constants(o);
}
}
- op = ck_fun(op);
- kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
+ o = ck_fun(o);
+ kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
if (kid && kid->op_type == OP_RV2GV)
kid->op_private &= ~HINT_STRICT_REFS;
- return op;
+ return o;
}
OP *
-ck_shift(op)
-OP *op;
+ck_shift(OP *o)
{
- I32 type = op->op_type;
+ I32 type = o->op_type;
- if (!(op->op_flags & OPf_KIDS)) {
- op_free(op);
- return newUNOP(type, 0,
- scalar(newUNOP(OP_RV2AV, 0,
- scalar(newGVOP(OP_GV, 0, subline
- ? defgv
- : gv_fetchpv("ARGV", TRUE, SVt_PVAV) )))));
+ if (!(o->op_flags & OPf_KIDS)) {
+ OP *argop;
+
+ op_free(o);
+#ifdef USE_THREADS
+ if (!CvUNIQUE(PL_compcv)) {
+ argop = newOP(OP_PADAV, OPf_REF);
+ argop->op_targ = 0; /* PL_curpad[0] is @_ */
+ }
+ else {
+ argop = newUNOP(OP_RV2AV, 0,
+ scalar(newGVOP(OP_GV, 0,
+ gv_fetchpv("ARGV", TRUE, SVt_PVAV))));
+ }
+#else
+ argop = newUNOP(OP_RV2AV, 0,
+ scalar(newGVOP(OP_GV, 0, !CvUNIQUE(PL_compcv) ?
+ PL_defgv : gv_fetchpv("ARGV", TRUE, SVt_PVAV))));
+#endif /* USE_THREADS */
+ return newUNOP(type, 0, scalar(argop));
}
- return scalar(modkids(ck_fun(op), type));
+ return scalar(modkids(ck_fun(o), type));
}
OP *
-ck_sort(op)
-OP *op;
+ck_sort(OP *o)
{
- op->op_private = 0;
+ o->op_private = 0;
#ifdef USE_LOCALE
- if (hints & HINT_LOCALE)
- op->op_private |= OPpLOCALE;
+ if (PL_hints & HINT_LOCALE)
+ o->op_private |= OPpLOCALE;
#endif
- if (op->op_flags & OPf_STACKED) {
- OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
+ if (o->op_flags & OPf_STACKED) {
+ OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
OP *k;
+
+ if (o->op_type == OP_SORT) {
+ GvMULTI_on(gv_fetchpv("a", TRUE, SVt_PV));
+ GvMULTI_on(gv_fetchpv("b", TRUE, SVt_PV));
+ }
kid = kUNOP->op_first; /* get past rv2gv */
if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
@@ -4428,7 +4826,7 @@ OP *op;
kid->op_next = 0;
}
else if (kid->op_type == OP_LEAVE) {
- if (op->op_type == OP_SORT) {
+ if (o->op_type == OP_SORT) {
null(kid); /* wipe out leave */
kid->op_next = kid;
@@ -4443,113 +4841,109 @@ OP *op;
}
peep(k);
- kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
+ kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
null(kid); /* wipe out rv2gv */
- if (op->op_type == OP_SORT)
+ if (o->op_type == OP_SORT)
kid->op_next = kid;
else
kid->op_next = k;
- op->op_flags |= OPf_SPECIAL;
+ o->op_flags |= OPf_SPECIAL;
}
- }
+ else if (kid->op_type == OP_RV2SV || kid->op_type == OP_PADSV)
+ null(cLISTOPo->op_first->op_sibling);
+ }
- return op;
+ return o;
}
OP *
-ck_split(op)
-OP *op;
+ck_split(OP *o)
{
register OP *kid;
- PMOP* pm;
-
- if (op->op_flags & OPf_STACKED)
- return no_fh_allowed(op);
- kid = cLISTOP->op_first;
+ if (o->op_flags & OPf_STACKED)
+ return no_fh_allowed(o);
+
+ kid = cLISTOPo->op_first;
if (kid->op_type != OP_NULL)
croak("panic: ck_split");
kid = kid->op_sibling;
- op_free(cLISTOP->op_first);
- cLISTOP->op_first = kid;
+ op_free(cLISTOPo->op_first);
+ cLISTOPo->op_first = kid;
if (!kid) {
- cLISTOP->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
- cLISTOP->op_last = kid; /* There was only one element previously */
+ cLISTOPo->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
+ cLISTOPo->op_last = kid; /* There was only one element previously */
}
if (kid->op_type != OP_MATCH) {
OP *sibl = kid->op_sibling;
kid->op_sibling = 0;
kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
- if (cLISTOP->op_first == cLISTOP->op_last)
- cLISTOP->op_last = kid;
- cLISTOP->op_first = kid;
+ if (cLISTOPo->op_first == cLISTOPo->op_last)
+ cLISTOPo->op_last = kid;
+ cLISTOPo->op_first = kid;
kid->op_sibling = sibl;
}
- pm = (PMOP*)kid;
- if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) {
- SvREFCNT_dec(pm->op_pmshort); /* can't use substring to optimize */
- pm->op_pmshort = 0;
- }
kid->op_type = OP_PUSHRE;
kid->op_ppaddr = ppaddr[OP_PUSHRE];
scalar(kid);
if (!kid->op_sibling)
- append_elem(OP_SPLIT, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
+ append_elem(OP_SPLIT, o, newDEFSVOP());
kid = kid->op_sibling;
scalar(kid);
if (!kid->op_sibling)
- append_elem(OP_SPLIT, op, newSVOP(OP_CONST, 0, newSViv(0)));
+ append_elem(OP_SPLIT, o, newSVOP(OP_CONST, 0, newSViv(0)));
kid = kid->op_sibling;
scalar(kid);
if (kid->op_sibling)
- return too_many_arguments(op,op_desc[op->op_type]);
+ return too_many_arguments(o,op_desc[o->op_type]);
- return op;
+ return o;
}
OP *
-ck_subr(op)
-OP *op;
+ck_subr(OP *o)
{
- OP *prev = ((cUNOP->op_first->op_sibling)
- ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first;
- OP *o = prev->op_sibling;
+ dTHR;
+ OP *prev = ((cUNOPo->op_first->op_sibling)
+ ? cUNOPo : ((UNOP*)cUNOPo->op_first))->op_first;
+ OP *o2 = prev->op_sibling;
OP *cvop;
char *proto = 0;
CV *cv = 0;
GV *namegv = 0;
int optional = 0;
I32 arg = 0;
+ STRLEN n_a;
- for (cvop = o; cvop->op_sibling; cvop = cvop->op_sibling) ;
+ for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ;
if (cvop->op_type == OP_RV2CV) {
SVOP* tmpop;
- op->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
+ o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
null(cvop); /* disable rv2cv */
tmpop = (SVOP*)((UNOP*)cvop)->op_first;
if (tmpop->op_type == OP_GV) {
cv = GvCVu(tmpop->op_sv);
- if (cv && SvPOK(cv) && !(op->op_private & OPpENTERSUB_AMPER)) {
+ if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER)) {
namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv);
- proto = SvPV((SV*)cv, na);
+ proto = SvPV((SV*)cv, n_a);
}
}
}
- op->op_private |= (hints & HINT_STRICT_REFS);
- if (PERLDB_SUB && curstash != debstash)
- op->op_private |= OPpENTERSUB_DB;
- while (o != cvop) {
+ o->op_private |= (PL_hints & HINT_STRICT_REFS);
+ if (PERLDB_SUB && PL_curstash != PL_debstash)
+ o->op_private |= OPpENTERSUB_DB;
+ while (o2 != cvop) {
if (proto) {
switch (*proto) {
case '\0':
- return too_many_arguments(op, gv_ename(namegv));
+ return too_many_arguments(o, gv_ename(namegv));
case ';':
optional = 1;
proto++;
@@ -4557,62 +4951,62 @@ OP *op;
case '$':
proto++;
arg++;
- scalar(o);
+ scalar(o2);
break;
case '%':
case '@':
- list(o);
+ list(o2);
arg++;
break;
case '&':
proto++;
arg++;
- if (o->op_type != OP_REFGEN && o->op_type != OP_UNDEF)
- bad_type(arg, "block", gv_ename(namegv), o);
+ if (o2->op_type != OP_REFGEN && o2->op_type != OP_UNDEF)
+ bad_type(arg, "block", gv_ename(namegv), o2);
break;
case '*':
+ /* '*' allows any scalar type, including bareword */
proto++;
arg++;
- if (o->op_type == OP_RV2GV)
- goto wrapref;
- {
- OP* kid = o;
- o = newUNOP(OP_RV2GV, 0, kid);
- o->op_sibling = kid->op_sibling;
- kid->op_sibling = 0;
- prev->op_sibling = o;
- }
- goto wrapref;
+ if (o2->op_type == OP_RV2GV)
+ goto wrapref; /* autoconvert GLOB -> GLOBref */
+ scalar(o2);
+ break;
case '\\':
proto++;
arg++;
switch (*proto++) {
case '*':
- if (o->op_type != OP_RV2GV)
- bad_type(arg, "symbol", gv_ename(namegv), o);
+ if (o2->op_type != OP_RV2GV)
+ bad_type(arg, "symbol", gv_ename(namegv), o2);
goto wrapref;
case '&':
- if (o->op_type != OP_RV2CV)
- bad_type(arg, "sub", gv_ename(namegv), o);
+ if (o2->op_type != OP_RV2CV)
+ bad_type(arg, "sub", gv_ename(namegv), o2);
goto wrapref;
case '$':
- if (o->op_type != OP_RV2SV && o->op_type != OP_PADSV)
- bad_type(arg, "scalar", gv_ename(namegv), o);
+ if (o2->op_type != OP_RV2SV
+ && o2->op_type != OP_PADSV
+ && o2->op_type != OP_THREADSV)
+ {
+ bad_type(arg, "scalar", gv_ename(namegv), o2);
+ }
goto wrapref;
case '@':
- if (o->op_type != OP_RV2AV && o->op_type != OP_PADAV)
- bad_type(arg, "array", gv_ename(namegv), o);
+ if (o2->op_type != OP_RV2AV && o2->op_type != OP_PADAV)
+ bad_type(arg, "array", gv_ename(namegv), o2);
goto wrapref;
case '%':
- if (o->op_type != OP_RV2HV && o->op_type != OP_PADHV)
- bad_type(arg, "hash", gv_ename(namegv), o);
+ if (o2->op_type != OP_RV2HV && o2->op_type != OP_PADHV)
+ bad_type(arg, "hash", gv_ename(namegv), o2);
wrapref:
{
- OP* kid = o;
- o = newUNOP(OP_REFGEN, 0, kid);
- o->op_sibling = kid->op_sibling;
+ OP* kid = o2;
+ OP* sib = kid->op_sibling;
kid->op_sibling = 0;
- prev->op_sibling = o;
+ o2 = newUNOP(OP_REFGEN, 0, kid);
+ o2->op_sibling = sib;
+ prev->op_sibling = o2;
}
break;
default: goto oops;
@@ -4624,68 +5018,67 @@ OP *op;
default:
oops:
croak("Malformed prototype for %s: %s",
- gv_ename(namegv), SvPV((SV*)cv, na));
+ gv_ename(namegv), SvPV((SV*)cv, n_a));
}
}
else
- list(o);
- mod(o, OP_ENTERSUB);
- prev = o;
- o = o->op_sibling;
+ list(o2);
+ mod(o2, OP_ENTERSUB);
+ prev = o2;
+ o2 = o2->op_sibling;
}
if (proto && !optional &&
(*proto && *proto != '@' && *proto != '%' && *proto != ';'))
- return too_few_arguments(op, gv_ename(namegv));
- return op;
+ return too_few_arguments(o, gv_ename(namegv));
+ return o;
}
OP *
-ck_svconst(op)
-OP *op;
+ck_svconst(OP *o)
{
- SvREADONLY_on(cSVOP->op_sv);
- return op;
+ SvREADONLY_on(cSVOPo->op_sv);
+ return o;
}
OP *
-ck_trunc(op)
-OP *op;
+ck_trunc(OP *o)
{
- if (op->op_flags & OPf_KIDS) {
- SVOP *kid = (SVOP*)cUNOP->op_first;
+ if (o->op_flags & OPf_KIDS) {
+ SVOP *kid = (SVOP*)cUNOPo->op_first;
if (kid->op_type == OP_NULL)
kid = (SVOP*)kid->op_sibling;
if (kid &&
kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
- op->op_flags |= OPf_SPECIAL;
+ o->op_flags |= OPf_SPECIAL;
}
- return ck_fun(op);
+ return ck_fun(o);
}
/* A peephole optimizer. We visit the ops in the order they're to execute. */
void
-peep(o)
-register OP* o;
+peep(register OP *o)
{
+ dTHR;
register OP* oldop = 0;
+ STRLEN n_a;
if (!o || o->op_seq)
return;
ENTER;
- SAVESPTR(op);
- SAVESPTR(curcop);
+ SAVEOP();
+ SAVESPTR(PL_curcop);
for (; o; o = o->op_next) {
if (o->op_seq)
break;
- if (!op_seqmax)
- op_seqmax++;
- op = o;
+ if (!PL_op_seqmax)
+ PL_op_seqmax++;
+ PL_op = o;
switch (o->op_type) {
case OP_NEXTSTATE:
case OP_DBSTATE:
- curcop = ((COP*)o); /* for warnings */
- o->op_seq = op_seqmax++;
+ PL_curcop = ((COP*)o); /* for warnings */
+ o->op_seq = PL_op_seqmax++;
break;
case OP_CONCAT:
@@ -4696,19 +5089,19 @@ register OP* o;
case OP_LC:
case OP_LCFIRST:
case OP_QUOTEMETA:
- if (o->op_next->op_type == OP_STRINGIFY)
+ if (o->op_next && o->op_next->op_type == OP_STRINGIFY)
null(o->op_next);
- o->op_seq = op_seqmax++;
+ o->op_seq = PL_op_seqmax++;
break;
case OP_STUB:
if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) {
- o->op_seq = op_seqmax++;
+ o->op_seq = PL_op_seqmax++;
break; /* Scalar stub must produce undef. List stub is noop */
}
goto nothin;
case OP_NULL:
if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
- curcop = ((COP*)op);
+ PL_curcop = ((COP*)o);
goto nothin;
case OP_SCALAR:
case OP_LINESEQ:
@@ -4718,7 +5111,7 @@ register OP* o;
oldop->op_next = o->op_next;
continue;
}
- o->op_seq = op_seqmax++;
+ o->op_seq = PL_op_seqmax++;
break;
case OP_GV:
@@ -4735,11 +5128,11 @@ register OP* o;
OP* pop = o->op_next->op_next;
IV i;
if (pop->op_type == OP_CONST &&
- (op = pop->op_next) &&
+ (PL_op = pop->op_next) &&
pop->op_next->op_type == OP_AELEM &&
!(pop->op_next->op_private &
(OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF)) &&
- (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase)
+ (i = SvIV(((SVOP*)pop)->op_sv) - PL_compiling.cop_arybase)
<= 255 &&
i >= 0)
{
@@ -4755,52 +5148,98 @@ register OP* o;
GvAVn(((GVOP*)o)->op_gv);
}
}
- o->op_seq = op_seqmax++;
+ o->op_seq = PL_op_seqmax++;
break;
case OP_MAPWHILE:
case OP_GREPWHILE:
case OP_AND:
case OP_OR:
- o->op_seq = op_seqmax++;
+ o->op_seq = PL_op_seqmax++;
+ while (cLOGOP->op_other->op_type == OP_NULL)
+ cLOGOP->op_other = cLOGOP->op_other->op_next;
peep(cLOGOP->op_other);
break;
case OP_COND_EXPR:
- o->op_seq = op_seqmax++;
+ o->op_seq = PL_op_seqmax++;
peep(cCONDOP->op_true);
peep(cCONDOP->op_false);
break;
case OP_ENTERLOOP:
- o->op_seq = op_seqmax++;
+ o->op_seq = PL_op_seqmax++;
peep(cLOOP->op_redoop);
peep(cLOOP->op_nextop);
peep(cLOOP->op_lastop);
break;
+ case OP_QR:
case OP_MATCH:
case OP_SUBST:
- o->op_seq = op_seqmax++;
+ o->op_seq = PL_op_seqmax++;
peep(cPMOP->op_pmreplstart);
break;
case OP_EXEC:
- o->op_seq = op_seqmax++;
- if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
+ o->op_seq = PL_op_seqmax++;
+ if (PL_dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
if (o->op_next->op_sibling &&
+ o->op_next->op_sibling->op_type != OP_EXIT &&
+ o->op_next->op_sibling->op_type != OP_WARN &&
o->op_next->op_sibling->op_type != OP_DIE) {
- line_t oldline = curcop->cop_line;
+ line_t oldline = PL_curcop->cop_line;
- curcop->cop_line = ((COP*)o->op_next)->cop_line;
+ PL_curcop->cop_line = ((COP*)o->op_next)->cop_line;
warn("Statement unlikely to be reached");
warn("(Maybe you meant system() when you said exec()?)\n");
- curcop->cop_line = oldline;
+ PL_curcop->cop_line = oldline;
}
}
break;
+
+ case OP_HELEM: {
+ UNOP *rop;
+ SV *lexname;
+ GV **fields;
+ SV **svp, **indsvp;
+ I32 ind;
+ char *key;
+ STRLEN keylen;
+
+ if (o->op_private & (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)
+ || ((BINOP*)o)->op_last->op_type != OP_CONST)
+ break;
+ rop = (UNOP*)((BINOP*)o)->op_first;
+ if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV)
+ break;
+ lexname = *av_fetch(PL_comppad_name, rop->op_first->op_targ, TRUE);
+ if (!SvOBJECT(lexname))
+ break;
+ fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
+ if (!fields || !GvHV(*fields))
+ break;
+ svp = &((SVOP*)((BINOP*)o)->op_last)->op_sv;
+ key = SvPV(*svp, keylen);
+ indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
+ if (!indsvp) {
+ croak("No such field \"%s\" in variable %s of type %s",
+ key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname)));
+ }
+ ind = SvIV(*indsvp);
+ if (ind < 1)
+ croak("Bad index while coercing array into hash");
+ rop->op_type = OP_RV2AV;
+ rop->op_ppaddr = ppaddr[OP_RV2AV];
+ o->op_type = OP_AELEM;
+ o->op_ppaddr = ppaddr[OP_AELEM];
+ SvREFCNT_dec(*svp);
+ *svp = newSViv(ind);
+ break;
+ }
+
default:
- o->op_seq = op_seqmax++;
+ o->op_seq = PL_op_seqmax++;
break;
}
oldop = o;
diff --git a/gnu/usr.bin/perl/op.h b/gnu/usr.bin/perl/op.h
index d58f825beea..d0b56f3543b 100644
--- a/gnu/usr.bin/perl/op.h
+++ b/gnu/usr.bin/perl/op.h
@@ -1,6 +1,6 @@
/* op.h
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -24,6 +24,7 @@
*/
typedef U32 PADOFFSET;
+#define NOT_IN_PAD ((PADOFFSET) -1)
#ifdef DEBUGGING_OPS
#define OPCODE opcode
@@ -31,15 +32,19 @@ typedef U32 PADOFFSET;
#define OPCODE U16
#endif
+#ifdef BASEOP_DEFINITION
+#define BASEOP BASEOP_DEFINITION
+#else
#define BASEOP \
OP* op_next; \
OP* op_sibling; \
- OP* (*op_ppaddr)(); \
+ OP* (CPERLscope(*op_ppaddr))_((ARGSproto)); \
PADOFFSET op_targ; \
OPCODE op_type; \
U16 op_seq; \
U8 op_flags; \
U8 op_private;
+#endif
#define OP_GIMME(op,dfl) \
(((op)->op_flags & OPf_WANT) == OPf_WANT_VOID ? G_VOID : \
@@ -47,7 +52,7 @@ typedef U32 PADOFFSET;
((op)->op_flags & OPf_WANT) == OPf_WANT_LIST ? G_ARRAY : \
dfl)
-#define GIMME_V OP_GIMME(op, block_gimme())
+#define GIMME_V OP_GIMME(PL_op, block_gimme())
/* Public flags */
@@ -73,12 +78,17 @@ typedef U32 PADOFFSET;
/* On UNOPs, saw bare parens, e.g. eof(). */
/* On OP_ENTERSUB || OP_NULL, saw a "do". */
/* On OP_(ENTER|LEAVE)EVAL, don't clear $@ */
+ /* On OP_ENTERITER, loop var is per-thread */
/* old names; don't use in new code, but don't break them, either */
-#define OPf_LIST 1
-#define OPf_KNOW 2
+#define OPf_LIST OPf_WANT_LIST
+#define OPf_KNOW OPf_WANT
#define GIMME \
- (op->op_flags & OPf_KNOW ? op->op_flags & OPf_LIST : dowantarray())
+ (PL_op->op_flags & OPf_WANT \
+ ? ((PL_op->op_flags & OPf_WANT) == OPf_WANT_LIST \
+ ? G_ARRAY \
+ : G_SCALAR) \
+ : dowantarray())
/* Private for lvalues */
#define OPpLVAL_INTRO 128 /* Lvalue must be localized */
@@ -93,6 +103,7 @@ typedef U32 PADOFFSET;
#define OPpRUNTIME 64 /* Pattern coming in on the stack */
/* Private for OP_TRANS */
+#define OPpTRANS_COUNTONLY 8
#define OPpTRANS_SQUASH 16
#define OPpTRANS_DELETE 32
#define OPpTRANS_COMPLEMENT 64
@@ -129,6 +140,9 @@ typedef U32 PADOFFSET;
/* Private for OP_SORT, OP_PRTF, OP_SPRINTF, string cmp'n, and case changers */
#define OPpLOCALE 64 /* Use locale */
+/* Private for OP_THREADSV */
+#define OPpDONE_SVREF 64 /* Been through newSVREF once */
+
struct op {
BASEOP
};
@@ -173,29 +187,34 @@ struct pmop {
OP * op_pmreplstart;
PMOP * op_pmnext; /* list of all scanpats */
REGEXP * op_pmregexp; /* compiled expression */
- SV * op_pmshort; /* for a fast bypass of execute() */
U16 op_pmflags;
U16 op_pmpermflags;
- char op_pmslen;
+ U8 op_pmdynflags;
};
-#define PMf_USED 0x0001 /* pm has been used once already */
+#define PMdf_USED 0x01 /* pm has been used once already */
+#define PMdf_TAINTED 0x02 /* pm compiled from tainted pattern */
+
+#define PMf_RETAINT 0x0001 /* taint $1 etc. if target tainted */
#define PMf_ONCE 0x0002 /* use pattern only once per reset */
-#define PMf_SCANFIRST 0x0004 /* initial constant not anchored */
-#define PMf_ALL 0x0008 /* initial constant is whole pat */
+#define PMf_REVERSED 0x0004 /* Should be matched right->left */
+#define PMf_MAYBE_CONST 0x0008 /* replacement contains variables */
#define PMf_SKIPWHITE 0x0010 /* skip leading whitespace for split */
-#define PMf_FOLD 0x0020 /* case insensitivity */
+#define PMf_WHITE 0x0020 /* pattern is \s+ */
#define PMf_CONST 0x0040 /* subst replacement is constant */
#define PMf_KEEP 0x0080 /* keep 1st runtime pattern forever */
#define PMf_GLOBAL 0x0100 /* pattern had a g modifier */
#define PMf_CONTINUE 0x0200 /* don't reset pos() if //g fails */
#define PMf_EVAL 0x0400 /* evaluating replacement as expr */
-#define PMf_WHITE 0x0800 /* pattern is \s+ */
+#define PMf_LOCALE 0x0800 /* use locale for character types */
#define PMf_MULTILINE 0x1000 /* assume multiple lines */
#define PMf_SINGLELINE 0x2000 /* assume single line */
-#define PMf_LOCALE 0x4000 /* use locale for character types */
+#define PMf_FOLD 0x4000 /* case insensitivity */
#define PMf_EXTENDED 0x8000 /* chuck embedded whitespace */
+/* mask of bits stored in regexp->reganch */
+#define PMf_COMPILETIME (PMf_MULTILINE|PMf_SINGLELINE|PMf_LOCALE|PMf_FOLD|PMf_EXTENDED)
+
struct svop {
BASEOP
SV * op_sv;
@@ -221,17 +240,30 @@ struct loop {
OP * op_lastop;
};
-#define cUNOP ((UNOP*)op)
-#define cBINOP ((BINOP*)op)
-#define cLISTOP ((LISTOP*)op)
-#define cLOGOP ((LOGOP*)op)
-#define cCONDOP ((CONDOP*)op)
-#define cPMOP ((PMOP*)op)
-#define cSVOP ((SVOP*)op)
-#define cGVOP ((GVOP*)op)
-#define cPVOP ((PVOP*)op)
-#define cCOP ((COP*)op)
-#define cLOOP ((LOOP*)op)
+#define cUNOP ((UNOP*)PL_op)
+#define cBINOP ((BINOP*)PL_op)
+#define cLISTOP ((LISTOP*)PL_op)
+#define cLOGOP ((LOGOP*)PL_op)
+#define cCONDOP ((CONDOP*)PL_op)
+#define cPMOP ((PMOP*)PL_op)
+#define cSVOP ((SVOP*)PL_op)
+#define cGVOP ((GVOP*)PL_op)
+#define cPVOP ((PVOP*)PL_op)
+#define cCOP ((COP*)PL_op)
+#define cLOOP ((LOOP*)PL_op)
+
+#define cUNOPo ((UNOP*)o)
+#define cBINOPo ((BINOP*)o)
+#define cLISTOPo ((LISTOP*)o)
+#define cLOGOPo ((LOGOP*)o)
+#define cCONDOPo ((CONDOP*)o)
+#define cPMOPo ((PMOP*)o)
+#define cSVOPo ((SVOP*)o)
+#define cGVOPo ((GVOP*)o)
+#define cPVOPo ((PVOP*)o)
+#define cCVOPo ((CVOP*)o)
+#define cCOPo ((COP*)o)
+#define cLOOPo ((LOOP*)o)
#define kUNOP ((UNOP*)kid)
#define kBINOP ((BINOP*)kid)
@@ -257,7 +289,26 @@ struct loop {
#define OA_DANGEROUS 64
#define OA_DEFGV 128
-#define OASHIFT 8
+/* The next 4 bits encode op class information */
+#define OA_CLASS_MASK (15 << 8)
+
+#define OA_BASEOP (0 << 8)
+#define OA_UNOP (1 << 8)
+#define OA_BINOP (2 << 8)
+#define OA_LOGOP (3 << 8)
+#define OA_CONDOP (4 << 8)
+#define OA_LISTOP (5 << 8)
+#define OA_PMOP (6 << 8)
+#define OA_SVOP (7 << 8)
+#define OA_GVOP (8 << 8)
+#define OA_PVOP (9 << 8)
+#define OA_LOOP (10 << 8)
+#define OA_COP (11 << 8)
+#define OA_BASEOP_OR_UNOP (12 << 8)
+#define OA_FILESTATOP (13 << 8)
+#define OA_LOOPEXOP (14 << 8)
+
+#define OASHIFT 12
/* Remaining nybbles of opargs */
#define OA_SCALAR 1
diff --git a/gnu/usr.bin/perl/opcode.h b/gnu/usr.bin/perl/opcode.h
index d962c1dae7f..81e169087e7 100644
--- a/gnu/usr.bin/perl/opcode.h
+++ b/gnu/usr.bin/perl/opcode.h
@@ -33,325 +33,329 @@ typedef enum {
OP_READLINE, /* 26 */
OP_RCATLINE, /* 27 */
OP_REGCMAYBE, /* 28 */
- OP_REGCOMP, /* 29 */
- OP_MATCH, /* 30 */
- OP_SUBST, /* 31 */
- OP_SUBSTCONT, /* 32 */
- OP_TRANS, /* 33 */
- OP_SASSIGN, /* 34 */
- OP_AASSIGN, /* 35 */
- OP_CHOP, /* 36 */
- OP_SCHOP, /* 37 */
- OP_CHOMP, /* 38 */
- OP_SCHOMP, /* 39 */
- OP_DEFINED, /* 40 */
- OP_UNDEF, /* 41 */
- OP_STUDY, /* 42 */
- OP_POS, /* 43 */
- OP_PREINC, /* 44 */
- OP_I_PREINC, /* 45 */
- OP_PREDEC, /* 46 */
- OP_I_PREDEC, /* 47 */
- OP_POSTINC, /* 48 */
- OP_I_POSTINC, /* 49 */
- OP_POSTDEC, /* 50 */
- OP_I_POSTDEC, /* 51 */
- OP_POW, /* 52 */
- OP_MULTIPLY, /* 53 */
- OP_I_MULTIPLY, /* 54 */
- OP_DIVIDE, /* 55 */
- OP_I_DIVIDE, /* 56 */
- OP_MODULO, /* 57 */
- OP_I_MODULO, /* 58 */
- OP_REPEAT, /* 59 */
- OP_ADD, /* 60 */
- OP_I_ADD, /* 61 */
- OP_SUBTRACT, /* 62 */
- OP_I_SUBTRACT, /* 63 */
- OP_CONCAT, /* 64 */
- OP_STRINGIFY, /* 65 */
- OP_LEFT_SHIFT, /* 66 */
- OP_RIGHT_SHIFT, /* 67 */
- OP_LT, /* 68 */
- OP_I_LT, /* 69 */
- OP_GT, /* 70 */
- OP_I_GT, /* 71 */
- OP_LE, /* 72 */
- OP_I_LE, /* 73 */
- OP_GE, /* 74 */
- OP_I_GE, /* 75 */
- OP_EQ, /* 76 */
- OP_I_EQ, /* 77 */
- OP_NE, /* 78 */
- OP_I_NE, /* 79 */
- OP_NCMP, /* 80 */
- OP_I_NCMP, /* 81 */
- OP_SLT, /* 82 */
- OP_SGT, /* 83 */
- OP_SLE, /* 84 */
- OP_SGE, /* 85 */
- OP_SEQ, /* 86 */
- OP_SNE, /* 87 */
- OP_SCMP, /* 88 */
- OP_BIT_AND, /* 89 */
- OP_BIT_XOR, /* 90 */
- OP_BIT_OR, /* 91 */
- OP_NEGATE, /* 92 */
- OP_I_NEGATE, /* 93 */
- OP_NOT, /* 94 */
- OP_COMPLEMENT, /* 95 */
- OP_ATAN2, /* 96 */
- OP_SIN, /* 97 */
- OP_COS, /* 98 */
- OP_RAND, /* 99 */
- OP_SRAND, /* 100 */
- OP_EXP, /* 101 */
- OP_LOG, /* 102 */
- OP_SQRT, /* 103 */
- OP_INT, /* 104 */
- OP_HEX, /* 105 */
- OP_OCT, /* 106 */
- OP_ABS, /* 107 */
- OP_LENGTH, /* 108 */
- OP_SUBSTR, /* 109 */
- OP_VEC, /* 110 */
- OP_INDEX, /* 111 */
- OP_RINDEX, /* 112 */
- OP_SPRINTF, /* 113 */
- OP_FORMLINE, /* 114 */
- OP_ORD, /* 115 */
- OP_CHR, /* 116 */
- OP_CRYPT, /* 117 */
- OP_UCFIRST, /* 118 */
- OP_LCFIRST, /* 119 */
- OP_UC, /* 120 */
- OP_LC, /* 121 */
- OP_QUOTEMETA, /* 122 */
- OP_RV2AV, /* 123 */
- OP_AELEMFAST, /* 124 */
- OP_AELEM, /* 125 */
- OP_ASLICE, /* 126 */
- OP_EACH, /* 127 */
- OP_VALUES, /* 128 */
- OP_KEYS, /* 129 */
- OP_DELETE, /* 130 */
- OP_EXISTS, /* 131 */
- OP_RV2HV, /* 132 */
- OP_HELEM, /* 133 */
- OP_HSLICE, /* 134 */
- OP_UNPACK, /* 135 */
- OP_PACK, /* 136 */
- OP_SPLIT, /* 137 */
- OP_JOIN, /* 138 */
- OP_LIST, /* 139 */
- OP_LSLICE, /* 140 */
- OP_ANONLIST, /* 141 */
- OP_ANONHASH, /* 142 */
- OP_SPLICE, /* 143 */
- OP_PUSH, /* 144 */
- OP_POP, /* 145 */
- OP_SHIFT, /* 146 */
- OP_UNSHIFT, /* 147 */
- OP_SORT, /* 148 */
- OP_REVERSE, /* 149 */
- OP_GREPSTART, /* 150 */
- OP_GREPWHILE, /* 151 */
- OP_MAPSTART, /* 152 */
- OP_MAPWHILE, /* 153 */
- OP_RANGE, /* 154 */
- OP_FLIP, /* 155 */
- OP_FLOP, /* 156 */
- OP_AND, /* 157 */
- OP_OR, /* 158 */
- OP_XOR, /* 159 */
- OP_COND_EXPR, /* 160 */
- OP_ANDASSIGN, /* 161 */
- OP_ORASSIGN, /* 162 */
- OP_METHOD, /* 163 */
- OP_ENTERSUB, /* 164 */
- OP_LEAVESUB, /* 165 */
- OP_CALLER, /* 166 */
- OP_WARN, /* 167 */
- OP_DIE, /* 168 */
- OP_RESET, /* 169 */
- OP_LINESEQ, /* 170 */
- OP_NEXTSTATE, /* 171 */
- OP_DBSTATE, /* 172 */
- OP_UNSTACK, /* 173 */
- OP_ENTER, /* 174 */
- OP_LEAVE, /* 175 */
- OP_SCOPE, /* 176 */
- OP_ENTERITER, /* 177 */
- OP_ITER, /* 178 */
- OP_ENTERLOOP, /* 179 */
- OP_LEAVELOOP, /* 180 */
- OP_RETURN, /* 181 */
- OP_LAST, /* 182 */
- OP_NEXT, /* 183 */
- OP_REDO, /* 184 */
- OP_DUMP, /* 185 */
- OP_GOTO, /* 186 */
- OP_EXIT, /* 187 */
- OP_OPEN, /* 188 */
- OP_CLOSE, /* 189 */
- OP_PIPE_OP, /* 190 */
- OP_FILENO, /* 191 */
- OP_UMASK, /* 192 */
- OP_BINMODE, /* 193 */
- OP_TIE, /* 194 */
- OP_UNTIE, /* 195 */
- OP_TIED, /* 196 */
- OP_DBMOPEN, /* 197 */
- OP_DBMCLOSE, /* 198 */
- OP_SSELECT, /* 199 */
- OP_SELECT, /* 200 */
- OP_GETC, /* 201 */
- OP_READ, /* 202 */
- OP_ENTERWRITE, /* 203 */
- OP_LEAVEWRITE, /* 204 */
- OP_PRTF, /* 205 */
- OP_PRINT, /* 206 */
- OP_SYSOPEN, /* 207 */
- OP_SYSSEEK, /* 208 */
- OP_SYSREAD, /* 209 */
- OP_SYSWRITE, /* 210 */
- OP_SEND, /* 211 */
- OP_RECV, /* 212 */
- OP_EOF, /* 213 */
- OP_TELL, /* 214 */
- OP_SEEK, /* 215 */
- OP_TRUNCATE, /* 216 */
- OP_FCNTL, /* 217 */
- OP_IOCTL, /* 218 */
- OP_FLOCK, /* 219 */
- OP_SOCKET, /* 220 */
- OP_SOCKPAIR, /* 221 */
- OP_BIND, /* 222 */
- OP_CONNECT, /* 223 */
- OP_LISTEN, /* 224 */
- OP_ACCEPT, /* 225 */
- OP_SHUTDOWN, /* 226 */
- OP_GSOCKOPT, /* 227 */
- OP_SSOCKOPT, /* 228 */
- OP_GETSOCKNAME, /* 229 */
- OP_GETPEERNAME, /* 230 */
- OP_LSTAT, /* 231 */
- OP_STAT, /* 232 */
- OP_FTRREAD, /* 233 */
- OP_FTRWRITE, /* 234 */
- OP_FTREXEC, /* 235 */
- OP_FTEREAD, /* 236 */
- OP_FTEWRITE, /* 237 */
- OP_FTEEXEC, /* 238 */
- OP_FTIS, /* 239 */
- OP_FTEOWNED, /* 240 */
- OP_FTROWNED, /* 241 */
- OP_FTZERO, /* 242 */
- OP_FTSIZE, /* 243 */
- OP_FTMTIME, /* 244 */
- OP_FTATIME, /* 245 */
- OP_FTCTIME, /* 246 */
- OP_FTSOCK, /* 247 */
- OP_FTCHR, /* 248 */
- OP_FTBLK, /* 249 */
- OP_FTFILE, /* 250 */
- OP_FTDIR, /* 251 */
- OP_FTPIPE, /* 252 */
- OP_FTLINK, /* 253 */
- OP_FTSUID, /* 254 */
- OP_FTSGID, /* 255 */
- OP_FTSVTX, /* 256 */
- OP_FTTTY, /* 257 */
- OP_FTTEXT, /* 258 */
- OP_FTBINARY, /* 259 */
- OP_CHDIR, /* 260 */
- OP_CHOWN, /* 261 */
- OP_CHROOT, /* 262 */
- OP_UNLINK, /* 263 */
- OP_CHMOD, /* 264 */
- OP_UTIME, /* 265 */
- OP_RENAME, /* 266 */
- OP_LINK, /* 267 */
- OP_SYMLINK, /* 268 */
- OP_READLINK, /* 269 */
- OP_MKDIR, /* 270 */
- OP_RMDIR, /* 271 */
- OP_OPEN_DIR, /* 272 */
- OP_READDIR, /* 273 */
- OP_TELLDIR, /* 274 */
- OP_SEEKDIR, /* 275 */
- OP_REWINDDIR, /* 276 */
- OP_CLOSEDIR, /* 277 */
- OP_FORK, /* 278 */
- OP_WAIT, /* 279 */
- OP_WAITPID, /* 280 */
- OP_SYSTEM, /* 281 */
- OP_EXEC, /* 282 */
- OP_KILL, /* 283 */
- OP_GETPPID, /* 284 */
- OP_GETPGRP, /* 285 */
- OP_SETPGRP, /* 286 */
- OP_GETPRIORITY, /* 287 */
- OP_SETPRIORITY, /* 288 */
- OP_TIME, /* 289 */
- OP_TMS, /* 290 */
- OP_LOCALTIME, /* 291 */
- OP_GMTIME, /* 292 */
- OP_ALARM, /* 293 */
- OP_SLEEP, /* 294 */
- OP_SHMGET, /* 295 */
- OP_SHMCTL, /* 296 */
- OP_SHMREAD, /* 297 */
- OP_SHMWRITE, /* 298 */
- OP_MSGGET, /* 299 */
- OP_MSGCTL, /* 300 */
- OP_MSGSND, /* 301 */
- OP_MSGRCV, /* 302 */
- OP_SEMGET, /* 303 */
- OP_SEMCTL, /* 304 */
- OP_SEMOP, /* 305 */
- OP_REQUIRE, /* 306 */
- OP_DOFILE, /* 307 */
- OP_ENTEREVAL, /* 308 */
- OP_LEAVEEVAL, /* 309 */
- OP_ENTERTRY, /* 310 */
- OP_LEAVETRY, /* 311 */
- OP_GHBYNAME, /* 312 */
- OP_GHBYADDR, /* 313 */
- OP_GHOSTENT, /* 314 */
- OP_GNBYNAME, /* 315 */
- OP_GNBYADDR, /* 316 */
- OP_GNETENT, /* 317 */
- OP_GPBYNAME, /* 318 */
- OP_GPBYNUMBER, /* 319 */
- OP_GPROTOENT, /* 320 */
- OP_GSBYNAME, /* 321 */
- OP_GSBYPORT, /* 322 */
- OP_GSERVENT, /* 323 */
- OP_SHOSTENT, /* 324 */
- OP_SNETENT, /* 325 */
- OP_SPROTOENT, /* 326 */
- OP_SSERVENT, /* 327 */
- OP_EHOSTENT, /* 328 */
- OP_ENETENT, /* 329 */
- OP_EPROTOENT, /* 330 */
- OP_ESERVENT, /* 331 */
- OP_GPWNAM, /* 332 */
- OP_GPWUID, /* 333 */
- OP_GPWENT, /* 334 */
- OP_SPWENT, /* 335 */
- OP_EPWENT, /* 336 */
- OP_GGRNAM, /* 337 */
- OP_GGRGID, /* 338 */
- OP_GGRENT, /* 339 */
- OP_SGRENT, /* 340 */
- OP_EGRENT, /* 341 */
- OP_GETLOGIN, /* 342 */
- OP_SYSCALL, /* 343 */
+ OP_REGCRESET, /* 29 */
+ OP_REGCOMP, /* 30 */
+ OP_MATCH, /* 31 */
+ OP_QR, /* 32 */
+ OP_SUBST, /* 33 */
+ OP_SUBSTCONT, /* 34 */
+ OP_TRANS, /* 35 */
+ OP_SASSIGN, /* 36 */
+ OP_AASSIGN, /* 37 */
+ OP_CHOP, /* 38 */
+ OP_SCHOP, /* 39 */
+ OP_CHOMP, /* 40 */
+ OP_SCHOMP, /* 41 */
+ OP_DEFINED, /* 42 */
+ OP_UNDEF, /* 43 */
+ OP_STUDY, /* 44 */
+ OP_POS, /* 45 */
+ OP_PREINC, /* 46 */
+ OP_I_PREINC, /* 47 */
+ OP_PREDEC, /* 48 */
+ OP_I_PREDEC, /* 49 */
+ OP_POSTINC, /* 50 */
+ OP_I_POSTINC, /* 51 */
+ OP_POSTDEC, /* 52 */
+ OP_I_POSTDEC, /* 53 */
+ OP_POW, /* 54 */
+ OP_MULTIPLY, /* 55 */
+ OP_I_MULTIPLY, /* 56 */
+ OP_DIVIDE, /* 57 */
+ OP_I_DIVIDE, /* 58 */
+ OP_MODULO, /* 59 */
+ OP_I_MODULO, /* 60 */
+ OP_REPEAT, /* 61 */
+ OP_ADD, /* 62 */
+ OP_I_ADD, /* 63 */
+ OP_SUBTRACT, /* 64 */
+ OP_I_SUBTRACT, /* 65 */
+ OP_CONCAT, /* 66 */
+ OP_STRINGIFY, /* 67 */
+ OP_LEFT_SHIFT, /* 68 */
+ OP_RIGHT_SHIFT, /* 69 */
+ OP_LT, /* 70 */
+ OP_I_LT, /* 71 */
+ OP_GT, /* 72 */
+ OP_I_GT, /* 73 */
+ OP_LE, /* 74 */
+ OP_I_LE, /* 75 */
+ OP_GE, /* 76 */
+ OP_I_GE, /* 77 */
+ OP_EQ, /* 78 */
+ OP_I_EQ, /* 79 */
+ OP_NE, /* 80 */
+ OP_I_NE, /* 81 */
+ OP_NCMP, /* 82 */
+ OP_I_NCMP, /* 83 */
+ OP_SLT, /* 84 */
+ OP_SGT, /* 85 */
+ OP_SLE, /* 86 */
+ OP_SGE, /* 87 */
+ OP_SEQ, /* 88 */
+ OP_SNE, /* 89 */
+ OP_SCMP, /* 90 */
+ OP_BIT_AND, /* 91 */
+ OP_BIT_XOR, /* 92 */
+ OP_BIT_OR, /* 93 */
+ OP_NEGATE, /* 94 */
+ OP_I_NEGATE, /* 95 */
+ OP_NOT, /* 96 */
+ OP_COMPLEMENT, /* 97 */
+ OP_ATAN2, /* 98 */
+ OP_SIN, /* 99 */
+ OP_COS, /* 100 */
+ OP_RAND, /* 101 */
+ OP_SRAND, /* 102 */
+ OP_EXP, /* 103 */
+ OP_LOG, /* 104 */
+ OP_SQRT, /* 105 */
+ OP_INT, /* 106 */
+ OP_HEX, /* 107 */
+ OP_OCT, /* 108 */
+ OP_ABS, /* 109 */
+ OP_LENGTH, /* 110 */
+ OP_SUBSTR, /* 111 */
+ OP_VEC, /* 112 */
+ OP_INDEX, /* 113 */
+ OP_RINDEX, /* 114 */
+ OP_SPRINTF, /* 115 */
+ OP_FORMLINE, /* 116 */
+ OP_ORD, /* 117 */
+ OP_CHR, /* 118 */
+ OP_CRYPT, /* 119 */
+ OP_UCFIRST, /* 120 */
+ OP_LCFIRST, /* 121 */
+ OP_UC, /* 122 */
+ OP_LC, /* 123 */
+ OP_QUOTEMETA, /* 124 */
+ OP_RV2AV, /* 125 */
+ OP_AELEMFAST, /* 126 */
+ OP_AELEM, /* 127 */
+ OP_ASLICE, /* 128 */
+ OP_EACH, /* 129 */
+ OP_VALUES, /* 130 */
+ OP_KEYS, /* 131 */
+ OP_DELETE, /* 132 */
+ OP_EXISTS, /* 133 */
+ OP_RV2HV, /* 134 */
+ OP_HELEM, /* 135 */
+ OP_HSLICE, /* 136 */
+ OP_UNPACK, /* 137 */
+ OP_PACK, /* 138 */
+ OP_SPLIT, /* 139 */
+ OP_JOIN, /* 140 */
+ OP_LIST, /* 141 */
+ OP_LSLICE, /* 142 */
+ OP_ANONLIST, /* 143 */
+ OP_ANONHASH, /* 144 */
+ OP_SPLICE, /* 145 */
+ OP_PUSH, /* 146 */
+ OP_POP, /* 147 */
+ OP_SHIFT, /* 148 */
+ OP_UNSHIFT, /* 149 */
+ OP_SORT, /* 150 */
+ OP_REVERSE, /* 151 */
+ OP_GREPSTART, /* 152 */
+ OP_GREPWHILE, /* 153 */
+ OP_MAPSTART, /* 154 */
+ OP_MAPWHILE, /* 155 */
+ OP_RANGE, /* 156 */
+ OP_FLIP, /* 157 */
+ OP_FLOP, /* 158 */
+ OP_AND, /* 159 */
+ OP_OR, /* 160 */
+ OP_XOR, /* 161 */
+ OP_COND_EXPR, /* 162 */
+ OP_ANDASSIGN, /* 163 */
+ OP_ORASSIGN, /* 164 */
+ OP_METHOD, /* 165 */
+ OP_ENTERSUB, /* 166 */
+ OP_LEAVESUB, /* 167 */
+ OP_CALLER, /* 168 */
+ OP_WARN, /* 169 */
+ OP_DIE, /* 170 */
+ OP_RESET, /* 171 */
+ OP_LINESEQ, /* 172 */
+ OP_NEXTSTATE, /* 173 */
+ OP_DBSTATE, /* 174 */
+ OP_UNSTACK, /* 175 */
+ OP_ENTER, /* 176 */
+ OP_LEAVE, /* 177 */
+ OP_SCOPE, /* 178 */
+ OP_ENTERITER, /* 179 */
+ OP_ITER, /* 180 */
+ OP_ENTERLOOP, /* 181 */
+ OP_LEAVELOOP, /* 182 */
+ OP_RETURN, /* 183 */
+ OP_LAST, /* 184 */
+ OP_NEXT, /* 185 */
+ OP_REDO, /* 186 */
+ OP_DUMP, /* 187 */
+ OP_GOTO, /* 188 */
+ OP_EXIT, /* 189 */
+ OP_OPEN, /* 190 */
+ OP_CLOSE, /* 191 */
+ OP_PIPE_OP, /* 192 */
+ OP_FILENO, /* 193 */
+ OP_UMASK, /* 194 */
+ OP_BINMODE, /* 195 */
+ OP_TIE, /* 196 */
+ OP_UNTIE, /* 197 */
+ OP_TIED, /* 198 */
+ OP_DBMOPEN, /* 199 */
+ OP_DBMCLOSE, /* 200 */
+ OP_SSELECT, /* 201 */
+ OP_SELECT, /* 202 */
+ OP_GETC, /* 203 */
+ OP_READ, /* 204 */
+ OP_ENTERWRITE, /* 205 */
+ OP_LEAVEWRITE, /* 206 */
+ OP_PRTF, /* 207 */
+ OP_PRINT, /* 208 */
+ OP_SYSOPEN, /* 209 */
+ OP_SYSSEEK, /* 210 */
+ OP_SYSREAD, /* 211 */
+ OP_SYSWRITE, /* 212 */
+ OP_SEND, /* 213 */
+ OP_RECV, /* 214 */
+ OP_EOF, /* 215 */
+ OP_TELL, /* 216 */
+ OP_SEEK, /* 217 */
+ OP_TRUNCATE, /* 218 */
+ OP_FCNTL, /* 219 */
+ OP_IOCTL, /* 220 */
+ OP_FLOCK, /* 221 */
+ OP_SOCKET, /* 222 */
+ OP_SOCKPAIR, /* 223 */
+ OP_BIND, /* 224 */
+ OP_CONNECT, /* 225 */
+ OP_LISTEN, /* 226 */
+ OP_ACCEPT, /* 227 */
+ OP_SHUTDOWN, /* 228 */
+ OP_GSOCKOPT, /* 229 */
+ OP_SSOCKOPT, /* 230 */
+ OP_GETSOCKNAME, /* 231 */
+ OP_GETPEERNAME, /* 232 */
+ OP_LSTAT, /* 233 */
+ OP_STAT, /* 234 */
+ OP_FTRREAD, /* 235 */
+ OP_FTRWRITE, /* 236 */
+ OP_FTREXEC, /* 237 */
+ OP_FTEREAD, /* 238 */
+ OP_FTEWRITE, /* 239 */
+ OP_FTEEXEC, /* 240 */
+ OP_FTIS, /* 241 */
+ OP_FTEOWNED, /* 242 */
+ OP_FTROWNED, /* 243 */
+ OP_FTZERO, /* 244 */
+ OP_FTSIZE, /* 245 */
+ OP_FTMTIME, /* 246 */
+ OP_FTATIME, /* 247 */
+ OP_FTCTIME, /* 248 */
+ OP_FTSOCK, /* 249 */
+ OP_FTCHR, /* 250 */
+ OP_FTBLK, /* 251 */
+ OP_FTFILE, /* 252 */
+ OP_FTDIR, /* 253 */
+ OP_FTPIPE, /* 254 */
+ OP_FTLINK, /* 255 */
+ OP_FTSUID, /* 256 */
+ OP_FTSGID, /* 257 */
+ OP_FTSVTX, /* 258 */
+ OP_FTTTY, /* 259 */
+ OP_FTTEXT, /* 260 */
+ OP_FTBINARY, /* 261 */
+ OP_CHDIR, /* 262 */
+ OP_CHOWN, /* 263 */
+ OP_CHROOT, /* 264 */
+ OP_UNLINK, /* 265 */
+ OP_CHMOD, /* 266 */
+ OP_UTIME, /* 267 */
+ OP_RENAME, /* 268 */
+ OP_LINK, /* 269 */
+ OP_SYMLINK, /* 270 */
+ OP_READLINK, /* 271 */
+ OP_MKDIR, /* 272 */
+ OP_RMDIR, /* 273 */
+ OP_OPEN_DIR, /* 274 */
+ OP_READDIR, /* 275 */
+ OP_TELLDIR, /* 276 */
+ OP_SEEKDIR, /* 277 */
+ OP_REWINDDIR, /* 278 */
+ OP_CLOSEDIR, /* 279 */
+ OP_FORK, /* 280 */
+ OP_WAIT, /* 281 */
+ OP_WAITPID, /* 282 */
+ OP_SYSTEM, /* 283 */
+ OP_EXEC, /* 284 */
+ OP_KILL, /* 285 */
+ OP_GETPPID, /* 286 */
+ OP_GETPGRP, /* 287 */
+ OP_SETPGRP, /* 288 */
+ OP_GETPRIORITY, /* 289 */
+ OP_SETPRIORITY, /* 290 */
+ OP_TIME, /* 291 */
+ OP_TMS, /* 292 */
+ OP_LOCALTIME, /* 293 */
+ OP_GMTIME, /* 294 */
+ OP_ALARM, /* 295 */
+ OP_SLEEP, /* 296 */
+ OP_SHMGET, /* 297 */
+ OP_SHMCTL, /* 298 */
+ OP_SHMREAD, /* 299 */
+ OP_SHMWRITE, /* 300 */
+ OP_MSGGET, /* 301 */
+ OP_MSGCTL, /* 302 */
+ OP_MSGSND, /* 303 */
+ OP_MSGRCV, /* 304 */
+ OP_SEMGET, /* 305 */
+ OP_SEMCTL, /* 306 */
+ OP_SEMOP, /* 307 */
+ OP_REQUIRE, /* 308 */
+ OP_DOFILE, /* 309 */
+ OP_ENTEREVAL, /* 310 */
+ OP_LEAVEEVAL, /* 311 */
+ OP_ENTERTRY, /* 312 */
+ OP_LEAVETRY, /* 313 */
+ OP_GHBYNAME, /* 314 */
+ OP_GHBYADDR, /* 315 */
+ OP_GHOSTENT, /* 316 */
+ OP_GNBYNAME, /* 317 */
+ OP_GNBYADDR, /* 318 */
+ OP_GNETENT, /* 319 */
+ OP_GPBYNAME, /* 320 */
+ OP_GPBYNUMBER, /* 321 */
+ OP_GPROTOENT, /* 322 */
+ OP_GSBYNAME, /* 323 */
+ OP_GSBYPORT, /* 324 */
+ OP_GSERVENT, /* 325 */
+ OP_SHOSTENT, /* 326 */
+ OP_SNETENT, /* 327 */
+ OP_SPROTOENT, /* 328 */
+ OP_SSERVENT, /* 329 */
+ OP_EHOSTENT, /* 330 */
+ OP_ENETENT, /* 331 */
+ OP_EPROTOENT, /* 332 */
+ OP_ESERVENT, /* 333 */
+ OP_GPWNAM, /* 334 */
+ OP_GPWUID, /* 335 */
+ OP_GPWENT, /* 336 */
+ OP_SPWENT, /* 337 */
+ OP_EPWENT, /* 338 */
+ OP_GGRNAM, /* 339 */
+ OP_GGRGID, /* 340 */
+ OP_GGRENT, /* 341 */
+ OP_SGRENT, /* 342 */
+ OP_EGRENT, /* 343 */
+ OP_GETLOGIN, /* 344 */
+ OP_SYSCALL, /* 345 */
+ OP_LOCK, /* 346 */
+ OP_THREADSV, /* 347 */
OP_max
} opcode;
-#define MAXO 344
+#define MAXO 348
#ifndef DOINIT
EXT char *op_name[];
@@ -386,8 +390,10 @@ EXT char *op_name[] = {
"readline",
"rcatline",
"regcmaybe",
+ "regcreset",
"regcomp",
"match",
+ "qr",
"subst",
"substcont",
"trans",
@@ -701,6 +707,8 @@ EXT char *op_name[] = {
"egrent",
"getlogin",
"syscall",
+ "lock",
+ "threadsv",
};
#endif
@@ -737,8 +745,10 @@ EXT char *op_desc[] = {
"<HANDLE>",
"append I/O operator",
"regexp comp once",
+ "regexp reset interpolation flag",
"regexp compilation",
"pattern match",
+ "pattern quote",
"substitution",
"substitution cont",
"character translation",
@@ -881,7 +891,7 @@ EXT char *op_desc[] = {
"line sequence",
"next statement",
"debug next statement",
- "unstack",
+ "iteration finalizer",
"block entry",
"block exit",
"block",
@@ -1052,391 +1062,404 @@ EXT char *op_desc[] = {
"endgrent",
"getlogin",
"syscall",
+ "lock",
+ "per-thread variable",
};
#endif
-OP * ck_anoncode _((OP* op));
-OP * ck_bitop _((OP* op));
-OP * ck_concat _((OP* op));
-OP * ck_delete _((OP* op));
-OP * ck_eof _((OP* op));
-OP * ck_eval _((OP* op));
-OP * ck_exec _((OP* op));
-OP * ck_exists _((OP* op));
-OP * ck_ftst _((OP* op));
-OP * ck_fun _((OP* op));
-OP * ck_fun_locale _((OP* op));
-OP * ck_glob _((OP* op));
-OP * ck_grep _((OP* op));
-OP * ck_index _((OP* op));
-OP * ck_lengthconst _((OP* op));
-OP * ck_lfun _((OP* op));
-OP * ck_listiob _((OP* op));
-OP * ck_match _((OP* op));
-OP * ck_null _((OP* op));
-OP * ck_repeat _((OP* op));
-OP * ck_require _((OP* op));
-OP * ck_rfun _((OP* op));
-OP * ck_rvconst _((OP* op));
-OP * ck_scmp _((OP* op));
-OP * ck_select _((OP* op));
-OP * ck_shift _((OP* op));
-OP * ck_sort _((OP* op));
-OP * ck_spair _((OP* op));
-OP * ck_split _((OP* op));
-OP * ck_subr _((OP* op));
-OP * ck_svconst _((OP* op));
-OP * ck_trunc _((OP* op));
+#ifndef PERL_OBJECT
+START_EXTERN_C
+
+OP * ck_anoncode _((OP* o));
+OP * ck_bitop _((OP* o));
+OP * ck_concat _((OP* o));
+OP * ck_delete _((OP* o));
+OP * ck_eof _((OP* o));
+OP * ck_eval _((OP* o));
+OP * ck_exec _((OP* o));
+OP * ck_exists _((OP* o));
+OP * ck_ftst _((OP* o));
+OP * ck_fun _((OP* o));
+OP * ck_fun_locale _((OP* o));
+OP * ck_glob _((OP* o));
+OP * ck_grep _((OP* o));
+OP * ck_index _((OP* o));
+OP * ck_lengthconst _((OP* o));
+OP * ck_lfun _((OP* o));
+OP * ck_listiob _((OP* o));
+OP * ck_match _((OP* o));
+OP * ck_null _((OP* o));
+OP * ck_repeat _((OP* o));
+OP * ck_require _((OP* o));
+OP * ck_rfun _((OP* o));
+OP * ck_rvconst _((OP* o));
+OP * ck_scmp _((OP* o));
+OP * ck_select _((OP* o));
+OP * ck_shift _((OP* o));
+OP * ck_sort _((OP* o));
+OP * ck_spair _((OP* o));
+OP * ck_split _((OP* o));
+OP * ck_subr _((OP* o));
+OP * ck_svconst _((OP* o));
+OP * ck_trunc _((OP* o));
+
+OP * pp_null _((ARGSproto));
+OP * pp_stub _((ARGSproto));
+OP * pp_scalar _((ARGSproto));
+OP * pp_pushmark _((ARGSproto));
+OP * pp_wantarray _((ARGSproto));
+OP * pp_const _((ARGSproto));
+OP * pp_gvsv _((ARGSproto));
+OP * pp_gv _((ARGSproto));
+OP * pp_gelem _((ARGSproto));
+OP * pp_padsv _((ARGSproto));
+OP * pp_padav _((ARGSproto));
+OP * pp_padhv _((ARGSproto));
+OP * pp_padany _((ARGSproto));
+OP * pp_pushre _((ARGSproto));
+OP * pp_rv2gv _((ARGSproto));
+OP * pp_rv2sv _((ARGSproto));
+OP * pp_av2arylen _((ARGSproto));
+OP * pp_rv2cv _((ARGSproto));
+OP * pp_anoncode _((ARGSproto));
+OP * pp_prototype _((ARGSproto));
+OP * pp_refgen _((ARGSproto));
+OP * pp_srefgen _((ARGSproto));
+OP * pp_ref _((ARGSproto));
+OP * pp_bless _((ARGSproto));
+OP * pp_backtick _((ARGSproto));
+OP * pp_glob _((ARGSproto));
+OP * pp_readline _((ARGSproto));
+OP * pp_rcatline _((ARGSproto));
+OP * pp_regcmaybe _((ARGSproto));
+OP * pp_regcreset _((ARGSproto));
+OP * pp_regcomp _((ARGSproto));
+OP * pp_match _((ARGSproto));
+OP * pp_qr _((ARGSproto));
+OP * pp_subst _((ARGSproto));
+OP * pp_substcont _((ARGSproto));
+OP * pp_trans _((ARGSproto));
+OP * pp_sassign _((ARGSproto));
+OP * pp_aassign _((ARGSproto));
+OP * pp_chop _((ARGSproto));
+OP * pp_schop _((ARGSproto));
+OP * pp_chomp _((ARGSproto));
+OP * pp_schomp _((ARGSproto));
+OP * pp_defined _((ARGSproto));
+OP * pp_undef _((ARGSproto));
+OP * pp_study _((ARGSproto));
+OP * pp_pos _((ARGSproto));
+OP * pp_preinc _((ARGSproto));
+OP * pp_i_preinc _((ARGSproto));
+OP * pp_predec _((ARGSproto));
+OP * pp_i_predec _((ARGSproto));
+OP * pp_postinc _((ARGSproto));
+OP * pp_i_postinc _((ARGSproto));
+OP * pp_postdec _((ARGSproto));
+OP * pp_i_postdec _((ARGSproto));
+OP * pp_pow _((ARGSproto));
+OP * pp_multiply _((ARGSproto));
+OP * pp_i_multiply _((ARGSproto));
+OP * pp_divide _((ARGSproto));
+OP * pp_i_divide _((ARGSproto));
+OP * pp_modulo _((ARGSproto));
+OP * pp_i_modulo _((ARGSproto));
+OP * pp_repeat _((ARGSproto));
+OP * pp_add _((ARGSproto));
+OP * pp_i_add _((ARGSproto));
+OP * pp_subtract _((ARGSproto));
+OP * pp_i_subtract _((ARGSproto));
+OP * pp_concat _((ARGSproto));
+OP * pp_stringify _((ARGSproto));
+OP * pp_left_shift _((ARGSproto));
+OP * pp_right_shift _((ARGSproto));
+OP * pp_lt _((ARGSproto));
+OP * pp_i_lt _((ARGSproto));
+OP * pp_gt _((ARGSproto));
+OP * pp_i_gt _((ARGSproto));
+OP * pp_le _((ARGSproto));
+OP * pp_i_le _((ARGSproto));
+OP * pp_ge _((ARGSproto));
+OP * pp_i_ge _((ARGSproto));
+OP * pp_eq _((ARGSproto));
+OP * pp_i_eq _((ARGSproto));
+OP * pp_ne _((ARGSproto));
+OP * pp_i_ne _((ARGSproto));
+OP * pp_ncmp _((ARGSproto));
+OP * pp_i_ncmp _((ARGSproto));
+OP * pp_slt _((ARGSproto));
+OP * pp_sgt _((ARGSproto));
+OP * pp_sle _((ARGSproto));
+OP * pp_sge _((ARGSproto));
+OP * pp_seq _((ARGSproto));
+OP * pp_sne _((ARGSproto));
+OP * pp_scmp _((ARGSproto));
+OP * pp_bit_and _((ARGSproto));
+OP * pp_bit_xor _((ARGSproto));
+OP * pp_bit_or _((ARGSproto));
+OP * pp_negate _((ARGSproto));
+OP * pp_i_negate _((ARGSproto));
+OP * pp_not _((ARGSproto));
+OP * pp_complement _((ARGSproto));
+OP * pp_atan2 _((ARGSproto));
+OP * pp_sin _((ARGSproto));
+OP * pp_cos _((ARGSproto));
+OP * pp_rand _((ARGSproto));
+OP * pp_srand _((ARGSproto));
+OP * pp_exp _((ARGSproto));
+OP * pp_log _((ARGSproto));
+OP * pp_sqrt _((ARGSproto));
+OP * pp_int _((ARGSproto));
+OP * pp_hex _((ARGSproto));
+OP * pp_oct _((ARGSproto));
+OP * pp_abs _((ARGSproto));
+OP * pp_length _((ARGSproto));
+OP * pp_substr _((ARGSproto));
+OP * pp_vec _((ARGSproto));
+OP * pp_index _((ARGSproto));
+OP * pp_rindex _((ARGSproto));
+OP * pp_sprintf _((ARGSproto));
+OP * pp_formline _((ARGSproto));
+OP * pp_ord _((ARGSproto));
+OP * pp_chr _((ARGSproto));
+OP * pp_crypt _((ARGSproto));
+OP * pp_ucfirst _((ARGSproto));
+OP * pp_lcfirst _((ARGSproto));
+OP * pp_uc _((ARGSproto));
+OP * pp_lc _((ARGSproto));
+OP * pp_quotemeta _((ARGSproto));
+OP * pp_rv2av _((ARGSproto));
+OP * pp_aelemfast _((ARGSproto));
+OP * pp_aelem _((ARGSproto));
+OP * pp_aslice _((ARGSproto));
+OP * pp_each _((ARGSproto));
+OP * pp_values _((ARGSproto));
+OP * pp_keys _((ARGSproto));
+OP * pp_delete _((ARGSproto));
+OP * pp_exists _((ARGSproto));
+OP * pp_rv2hv _((ARGSproto));
+OP * pp_helem _((ARGSproto));
+OP * pp_hslice _((ARGSproto));
+OP * pp_unpack _((ARGSproto));
+OP * pp_pack _((ARGSproto));
+OP * pp_split _((ARGSproto));
+OP * pp_join _((ARGSproto));
+OP * pp_list _((ARGSproto));
+OP * pp_lslice _((ARGSproto));
+OP * pp_anonlist _((ARGSproto));
+OP * pp_anonhash _((ARGSproto));
+OP * pp_splice _((ARGSproto));
+OP * pp_push _((ARGSproto));
+OP * pp_pop _((ARGSproto));
+OP * pp_shift _((ARGSproto));
+OP * pp_unshift _((ARGSproto));
+OP * pp_sort _((ARGSproto));
+OP * pp_reverse _((ARGSproto));
+OP * pp_grepstart _((ARGSproto));
+OP * pp_grepwhile _((ARGSproto));
+OP * pp_mapstart _((ARGSproto));
+OP * pp_mapwhile _((ARGSproto));
+OP * pp_range _((ARGSproto));
+OP * pp_flip _((ARGSproto));
+OP * pp_flop _((ARGSproto));
+OP * pp_and _((ARGSproto));
+OP * pp_or _((ARGSproto));
+OP * pp_xor _((ARGSproto));
+OP * pp_cond_expr _((ARGSproto));
+OP * pp_andassign _((ARGSproto));
+OP * pp_orassign _((ARGSproto));
+OP * pp_method _((ARGSproto));
+OP * pp_entersub _((ARGSproto));
+OP * pp_leavesub _((ARGSproto));
+OP * pp_caller _((ARGSproto));
+OP * pp_warn _((ARGSproto));
+OP * pp_die _((ARGSproto));
+OP * pp_reset _((ARGSproto));
+OP * pp_lineseq _((ARGSproto));
+OP * pp_nextstate _((ARGSproto));
+OP * pp_dbstate _((ARGSproto));
+OP * pp_unstack _((ARGSproto));
+OP * pp_enter _((ARGSproto));
+OP * pp_leave _((ARGSproto));
+OP * pp_scope _((ARGSproto));
+OP * pp_enteriter _((ARGSproto));
+OP * pp_iter _((ARGSproto));
+OP * pp_enterloop _((ARGSproto));
+OP * pp_leaveloop _((ARGSproto));
+OP * pp_return _((ARGSproto));
+OP * pp_last _((ARGSproto));
+OP * pp_next _((ARGSproto));
+OP * pp_redo _((ARGSproto));
+OP * pp_dump _((ARGSproto));
+OP * pp_goto _((ARGSproto));
+OP * pp_exit _((ARGSproto));
+OP * pp_open _((ARGSproto));
+OP * pp_close _((ARGSproto));
+OP * pp_pipe_op _((ARGSproto));
+OP * pp_fileno _((ARGSproto));
+OP * pp_umask _((ARGSproto));
+OP * pp_binmode _((ARGSproto));
+OP * pp_tie _((ARGSproto));
+OP * pp_untie _((ARGSproto));
+OP * pp_tied _((ARGSproto));
+OP * pp_dbmopen _((ARGSproto));
+OP * pp_dbmclose _((ARGSproto));
+OP * pp_sselect _((ARGSproto));
+OP * pp_select _((ARGSproto));
+OP * pp_getc _((ARGSproto));
+OP * pp_read _((ARGSproto));
+OP * pp_enterwrite _((ARGSproto));
+OP * pp_leavewrite _((ARGSproto));
+OP * pp_prtf _((ARGSproto));
+OP * pp_print _((ARGSproto));
+OP * pp_sysopen _((ARGSproto));
+OP * pp_sysseek _((ARGSproto));
+OP * pp_sysread _((ARGSproto));
+OP * pp_syswrite _((ARGSproto));
+OP * pp_send _((ARGSproto));
+OP * pp_recv _((ARGSproto));
+OP * pp_eof _((ARGSproto));
+OP * pp_tell _((ARGSproto));
+OP * pp_seek _((ARGSproto));
+OP * pp_truncate _((ARGSproto));
+OP * pp_fcntl _((ARGSproto));
+OP * pp_ioctl _((ARGSproto));
+OP * pp_flock _((ARGSproto));
+OP * pp_socket _((ARGSproto));
+OP * pp_sockpair _((ARGSproto));
+OP * pp_bind _((ARGSproto));
+OP * pp_connect _((ARGSproto));
+OP * pp_listen _((ARGSproto));
+OP * pp_accept _((ARGSproto));
+OP * pp_shutdown _((ARGSproto));
+OP * pp_gsockopt _((ARGSproto));
+OP * pp_ssockopt _((ARGSproto));
+OP * pp_getsockname _((ARGSproto));
+OP * pp_getpeername _((ARGSproto));
+OP * pp_lstat _((ARGSproto));
+OP * pp_stat _((ARGSproto));
+OP * pp_ftrread _((ARGSproto));
+OP * pp_ftrwrite _((ARGSproto));
+OP * pp_ftrexec _((ARGSproto));
+OP * pp_fteread _((ARGSproto));
+OP * pp_ftewrite _((ARGSproto));
+OP * pp_fteexec _((ARGSproto));
+OP * pp_ftis _((ARGSproto));
+OP * pp_fteowned _((ARGSproto));
+OP * pp_ftrowned _((ARGSproto));
+OP * pp_ftzero _((ARGSproto));
+OP * pp_ftsize _((ARGSproto));
+OP * pp_ftmtime _((ARGSproto));
+OP * pp_ftatime _((ARGSproto));
+OP * pp_ftctime _((ARGSproto));
+OP * pp_ftsock _((ARGSproto));
+OP * pp_ftchr _((ARGSproto));
+OP * pp_ftblk _((ARGSproto));
+OP * pp_ftfile _((ARGSproto));
+OP * pp_ftdir _((ARGSproto));
+OP * pp_ftpipe _((ARGSproto));
+OP * pp_ftlink _((ARGSproto));
+OP * pp_ftsuid _((ARGSproto));
+OP * pp_ftsgid _((ARGSproto));
+OP * pp_ftsvtx _((ARGSproto));
+OP * pp_fttty _((ARGSproto));
+OP * pp_fttext _((ARGSproto));
+OP * pp_ftbinary _((ARGSproto));
+OP * pp_chdir _((ARGSproto));
+OP * pp_chown _((ARGSproto));
+OP * pp_chroot _((ARGSproto));
+OP * pp_unlink _((ARGSproto));
+OP * pp_chmod _((ARGSproto));
+OP * pp_utime _((ARGSproto));
+OP * pp_rename _((ARGSproto));
+OP * pp_link _((ARGSproto));
+OP * pp_symlink _((ARGSproto));
+OP * pp_readlink _((ARGSproto));
+OP * pp_mkdir _((ARGSproto));
+OP * pp_rmdir _((ARGSproto));
+OP * pp_open_dir _((ARGSproto));
+OP * pp_readdir _((ARGSproto));
+OP * pp_telldir _((ARGSproto));
+OP * pp_seekdir _((ARGSproto));
+OP * pp_rewinddir _((ARGSproto));
+OP * pp_closedir _((ARGSproto));
+OP * pp_fork _((ARGSproto));
+OP * pp_wait _((ARGSproto));
+OP * pp_waitpid _((ARGSproto));
+OP * pp_system _((ARGSproto));
+OP * pp_exec _((ARGSproto));
+OP * pp_kill _((ARGSproto));
+OP * pp_getppid _((ARGSproto));
+OP * pp_getpgrp _((ARGSproto));
+OP * pp_setpgrp _((ARGSproto));
+OP * pp_getpriority _((ARGSproto));
+OP * pp_setpriority _((ARGSproto));
+OP * pp_time _((ARGSproto));
+OP * pp_tms _((ARGSproto));
+OP * pp_localtime _((ARGSproto));
+OP * pp_gmtime _((ARGSproto));
+OP * pp_alarm _((ARGSproto));
+OP * pp_sleep _((ARGSproto));
+OP * pp_shmget _((ARGSproto));
+OP * pp_shmctl _((ARGSproto));
+OP * pp_shmread _((ARGSproto));
+OP * pp_shmwrite _((ARGSproto));
+OP * pp_msgget _((ARGSproto));
+OP * pp_msgctl _((ARGSproto));
+OP * pp_msgsnd _((ARGSproto));
+OP * pp_msgrcv _((ARGSproto));
+OP * pp_semget _((ARGSproto));
+OP * pp_semctl _((ARGSproto));
+OP * pp_semop _((ARGSproto));
+OP * pp_require _((ARGSproto));
+OP * pp_dofile _((ARGSproto));
+OP * pp_entereval _((ARGSproto));
+OP * pp_leaveeval _((ARGSproto));
+OP * pp_entertry _((ARGSproto));
+OP * pp_leavetry _((ARGSproto));
+OP * pp_ghbyname _((ARGSproto));
+OP * pp_ghbyaddr _((ARGSproto));
+OP * pp_ghostent _((ARGSproto));
+OP * pp_gnbyname _((ARGSproto));
+OP * pp_gnbyaddr _((ARGSproto));
+OP * pp_gnetent _((ARGSproto));
+OP * pp_gpbyname _((ARGSproto));
+OP * pp_gpbynumber _((ARGSproto));
+OP * pp_gprotoent _((ARGSproto));
+OP * pp_gsbyname _((ARGSproto));
+OP * pp_gsbyport _((ARGSproto));
+OP * pp_gservent _((ARGSproto));
+OP * pp_shostent _((ARGSproto));
+OP * pp_snetent _((ARGSproto));
+OP * pp_sprotoent _((ARGSproto));
+OP * pp_sservent _((ARGSproto));
+OP * pp_ehostent _((ARGSproto));
+OP * pp_enetent _((ARGSproto));
+OP * pp_eprotoent _((ARGSproto));
+OP * pp_eservent _((ARGSproto));
+OP * pp_gpwnam _((ARGSproto));
+OP * pp_gpwuid _((ARGSproto));
+OP * pp_gpwent _((ARGSproto));
+OP * pp_spwent _((ARGSproto));
+OP * pp_epwent _((ARGSproto));
+OP * pp_ggrnam _((ARGSproto));
+OP * pp_ggrgid _((ARGSproto));
+OP * pp_ggrent _((ARGSproto));
+OP * pp_sgrent _((ARGSproto));
+OP * pp_egrent _((ARGSproto));
+OP * pp_getlogin _((ARGSproto));
+OP * pp_syscall _((ARGSproto));
+OP * pp_lock _((ARGSproto));
+OP * pp_threadsv _((ARGSproto));
-OP * pp_null _((void));
-OP * pp_stub _((void));
-OP * pp_scalar _((void));
-OP * pp_pushmark _((void));
-OP * pp_wantarray _((void));
-OP * pp_const _((void));
-OP * pp_gvsv _((void));
-OP * pp_gv _((void));
-OP * pp_gelem _((void));
-OP * pp_padsv _((void));
-OP * pp_padav _((void));
-OP * pp_padhv _((void));
-OP * pp_padany _((void));
-OP * pp_pushre _((void));
-OP * pp_rv2gv _((void));
-OP * pp_rv2sv _((void));
-OP * pp_av2arylen _((void));
-OP * pp_rv2cv _((void));
-OP * pp_anoncode _((void));
-OP * pp_prototype _((void));
-OP * pp_refgen _((void));
-OP * pp_srefgen _((void));
-OP * pp_ref _((void));
-OP * pp_bless _((void));
-OP * pp_backtick _((void));
-OP * pp_glob _((void));
-OP * pp_readline _((void));
-OP * pp_rcatline _((void));
-OP * pp_regcmaybe _((void));
-OP * pp_regcomp _((void));
-OP * pp_match _((void));
-OP * pp_subst _((void));
-OP * pp_substcont _((void));
-OP * pp_trans _((void));
-OP * pp_sassign _((void));
-OP * pp_aassign _((void));
-OP * pp_chop _((void));
-OP * pp_schop _((void));
-OP * pp_chomp _((void));
-OP * pp_schomp _((void));
-OP * pp_defined _((void));
-OP * pp_undef _((void));
-OP * pp_study _((void));
-OP * pp_pos _((void));
-OP * pp_preinc _((void));
-OP * pp_i_preinc _((void));
-OP * pp_predec _((void));
-OP * pp_i_predec _((void));
-OP * pp_postinc _((void));
-OP * pp_i_postinc _((void));
-OP * pp_postdec _((void));
-OP * pp_i_postdec _((void));
-OP * pp_pow _((void));
-OP * pp_multiply _((void));
-OP * pp_i_multiply _((void));
-OP * pp_divide _((void));
-OP * pp_i_divide _((void));
-OP * pp_modulo _((void));
-OP * pp_i_modulo _((void));
-OP * pp_repeat _((void));
-OP * pp_add _((void));
-OP * pp_i_add _((void));
-OP * pp_subtract _((void));
-OP * pp_i_subtract _((void));
-OP * pp_concat _((void));
-OP * pp_stringify _((void));
-OP * pp_left_shift _((void));
-OP * pp_right_shift _((void));
-OP * pp_lt _((void));
-OP * pp_i_lt _((void));
-OP * pp_gt _((void));
-OP * pp_i_gt _((void));
-OP * pp_le _((void));
-OP * pp_i_le _((void));
-OP * pp_ge _((void));
-OP * pp_i_ge _((void));
-OP * pp_eq _((void));
-OP * pp_i_eq _((void));
-OP * pp_ne _((void));
-OP * pp_i_ne _((void));
-OP * pp_ncmp _((void));
-OP * pp_i_ncmp _((void));
-OP * pp_slt _((void));
-OP * pp_sgt _((void));
-OP * pp_sle _((void));
-OP * pp_sge _((void));
-OP * pp_seq _((void));
-OP * pp_sne _((void));
-OP * pp_scmp _((void));
-OP * pp_bit_and _((void));
-OP * pp_bit_xor _((void));
-OP * pp_bit_or _((void));
-OP * pp_negate _((void));
-OP * pp_i_negate _((void));
-OP * pp_not _((void));
-OP * pp_complement _((void));
-OP * pp_atan2 _((void));
-OP * pp_sin _((void));
-OP * pp_cos _((void));
-OP * pp_rand _((void));
-OP * pp_srand _((void));
-OP * pp_exp _((void));
-OP * pp_log _((void));
-OP * pp_sqrt _((void));
-OP * pp_int _((void));
-OP * pp_hex _((void));
-OP * pp_oct _((void));
-OP * pp_abs _((void));
-OP * pp_length _((void));
-OP * pp_substr _((void));
-OP * pp_vec _((void));
-OP * pp_index _((void));
-OP * pp_rindex _((void));
-OP * pp_sprintf _((void));
-OP * pp_formline _((void));
-OP * pp_ord _((void));
-OP * pp_chr _((void));
-OP * pp_crypt _((void));
-OP * pp_ucfirst _((void));
-OP * pp_lcfirst _((void));
-OP * pp_uc _((void));
-OP * pp_lc _((void));
-OP * pp_quotemeta _((void));
-OP * pp_rv2av _((void));
-OP * pp_aelemfast _((void));
-OP * pp_aelem _((void));
-OP * pp_aslice _((void));
-OP * pp_each _((void));
-OP * pp_values _((void));
-OP * pp_keys _((void));
-OP * pp_delete _((void));
-OP * pp_exists _((void));
-OP * pp_rv2hv _((void));
-OP * pp_helem _((void));
-OP * pp_hslice _((void));
-OP * pp_unpack _((void));
-OP * pp_pack _((void));
-OP * pp_split _((void));
-OP * pp_join _((void));
-OP * pp_list _((void));
-OP * pp_lslice _((void));
-OP * pp_anonlist _((void));
-OP * pp_anonhash _((void));
-OP * pp_splice _((void));
-OP * pp_push _((void));
-OP * pp_pop _((void));
-OP * pp_shift _((void));
-OP * pp_unshift _((void));
-OP * pp_sort _((void));
-OP * pp_reverse _((void));
-OP * pp_grepstart _((void));
-OP * pp_grepwhile _((void));
-OP * pp_mapstart _((void));
-OP * pp_mapwhile _((void));
-OP * pp_range _((void));
-OP * pp_flip _((void));
-OP * pp_flop _((void));
-OP * pp_and _((void));
-OP * pp_or _((void));
-OP * pp_xor _((void));
-OP * pp_cond_expr _((void));
-OP * pp_andassign _((void));
-OP * pp_orassign _((void));
-OP * pp_method _((void));
-OP * pp_entersub _((void));
-OP * pp_leavesub _((void));
-OP * pp_caller _((void));
-OP * pp_warn _((void));
-OP * pp_die _((void));
-OP * pp_reset _((void));
-OP * pp_lineseq _((void));
-OP * pp_nextstate _((void));
-OP * pp_dbstate _((void));
-OP * pp_unstack _((void));
-OP * pp_enter _((void));
-OP * pp_leave _((void));
-OP * pp_scope _((void));
-OP * pp_enteriter _((void));
-OP * pp_iter _((void));
-OP * pp_enterloop _((void));
-OP * pp_leaveloop _((void));
-OP * pp_return _((void));
-OP * pp_last _((void));
-OP * pp_next _((void));
-OP * pp_redo _((void));
-OP * pp_dump _((void));
-OP * pp_goto _((void));
-OP * pp_exit _((void));
-OP * pp_open _((void));
-OP * pp_close _((void));
-OP * pp_pipe_op _((void));
-OP * pp_fileno _((void));
-OP * pp_umask _((void));
-OP * pp_binmode _((void));
-OP * pp_tie _((void));
-OP * pp_untie _((void));
-OP * pp_tied _((void));
-OP * pp_dbmopen _((void));
-OP * pp_dbmclose _((void));
-OP * pp_sselect _((void));
-OP * pp_select _((void));
-OP * pp_getc _((void));
-OP * pp_read _((void));
-OP * pp_enterwrite _((void));
-OP * pp_leavewrite _((void));
-OP * pp_prtf _((void));
-OP * pp_print _((void));
-OP * pp_sysopen _((void));
-OP * pp_sysseek _((void));
-OP * pp_sysread _((void));
-OP * pp_syswrite _((void));
-OP * pp_send _((void));
-OP * pp_recv _((void));
-OP * pp_eof _((void));
-OP * pp_tell _((void));
-OP * pp_seek _((void));
-OP * pp_truncate _((void));
-OP * pp_fcntl _((void));
-OP * pp_ioctl _((void));
-OP * pp_flock _((void));
-OP * pp_socket _((void));
-OP * pp_sockpair _((void));
-OP * pp_bind _((void));
-OP * pp_connect _((void));
-OP * pp_listen _((void));
-OP * pp_accept _((void));
-OP * pp_shutdown _((void));
-OP * pp_gsockopt _((void));
-OP * pp_ssockopt _((void));
-OP * pp_getsockname _((void));
-OP * pp_getpeername _((void));
-OP * pp_lstat _((void));
-OP * pp_stat _((void));
-OP * pp_ftrread _((void));
-OP * pp_ftrwrite _((void));
-OP * pp_ftrexec _((void));
-OP * pp_fteread _((void));
-OP * pp_ftewrite _((void));
-OP * pp_fteexec _((void));
-OP * pp_ftis _((void));
-OP * pp_fteowned _((void));
-OP * pp_ftrowned _((void));
-OP * pp_ftzero _((void));
-OP * pp_ftsize _((void));
-OP * pp_ftmtime _((void));
-OP * pp_ftatime _((void));
-OP * pp_ftctime _((void));
-OP * pp_ftsock _((void));
-OP * pp_ftchr _((void));
-OP * pp_ftblk _((void));
-OP * pp_ftfile _((void));
-OP * pp_ftdir _((void));
-OP * pp_ftpipe _((void));
-OP * pp_ftlink _((void));
-OP * pp_ftsuid _((void));
-OP * pp_ftsgid _((void));
-OP * pp_ftsvtx _((void));
-OP * pp_fttty _((void));
-OP * pp_fttext _((void));
-OP * pp_ftbinary _((void));
-OP * pp_chdir _((void));
-OP * pp_chown _((void));
-OP * pp_chroot _((void));
-OP * pp_unlink _((void));
-OP * pp_chmod _((void));
-OP * pp_utime _((void));
-OP * pp_rename _((void));
-OP * pp_link _((void));
-OP * pp_symlink _((void));
-OP * pp_readlink _((void));
-OP * pp_mkdir _((void));
-OP * pp_rmdir _((void));
-OP * pp_open_dir _((void));
-OP * pp_readdir _((void));
-OP * pp_telldir _((void));
-OP * pp_seekdir _((void));
-OP * pp_rewinddir _((void));
-OP * pp_closedir _((void));
-OP * pp_fork _((void));
-OP * pp_wait _((void));
-OP * pp_waitpid _((void));
-OP * pp_system _((void));
-OP * pp_exec _((void));
-OP * pp_kill _((void));
-OP * pp_getppid _((void));
-OP * pp_getpgrp _((void));
-OP * pp_setpgrp _((void));
-OP * pp_getpriority _((void));
-OP * pp_setpriority _((void));
-OP * pp_time _((void));
-OP * pp_tms _((void));
-OP * pp_localtime _((void));
-OP * pp_gmtime _((void));
-OP * pp_alarm _((void));
-OP * pp_sleep _((void));
-OP * pp_shmget _((void));
-OP * pp_shmctl _((void));
-OP * pp_shmread _((void));
-OP * pp_shmwrite _((void));
-OP * pp_msgget _((void));
-OP * pp_msgctl _((void));
-OP * pp_msgsnd _((void));
-OP * pp_msgrcv _((void));
-OP * pp_semget _((void));
-OP * pp_semctl _((void));
-OP * pp_semop _((void));
-OP * pp_require _((void));
-OP * pp_dofile _((void));
-OP * pp_entereval _((void));
-OP * pp_leaveeval _((void));
-OP * pp_entertry _((void));
-OP * pp_leavetry _((void));
-OP * pp_ghbyname _((void));
-OP * pp_ghbyaddr _((void));
-OP * pp_ghostent _((void));
-OP * pp_gnbyname _((void));
-OP * pp_gnbyaddr _((void));
-OP * pp_gnetent _((void));
-OP * pp_gpbyname _((void));
-OP * pp_gpbynumber _((void));
-OP * pp_gprotoent _((void));
-OP * pp_gsbyname _((void));
-OP * pp_gsbyport _((void));
-OP * pp_gservent _((void));
-OP * pp_shostent _((void));
-OP * pp_snetent _((void));
-OP * pp_sprotoent _((void));
-OP * pp_sservent _((void));
-OP * pp_ehostent _((void));
-OP * pp_enetent _((void));
-OP * pp_eprotoent _((void));
-OP * pp_eservent _((void));
-OP * pp_gpwnam _((void));
-OP * pp_gpwuid _((void));
-OP * pp_gpwent _((void));
-OP * pp_spwent _((void));
-OP * pp_epwent _((void));
-OP * pp_ggrnam _((void));
-OP * pp_ggrgid _((void));
-OP * pp_ggrent _((void));
-OP * pp_sgrent _((void));
-OP * pp_egrent _((void));
-OP * pp_getlogin _((void));
-OP * pp_syscall _((void));
+END_EXTERN_C
+#endif /* PERL_OBJECT */
#ifndef DOINIT
-EXT OP * (*ppaddr[])();
+EXT OP * (CPERLscope(*ppaddr)[])(ARGSproto);
#else
-EXT OP * (*ppaddr[])() = {
+#ifndef PERL_OBJECT
+EXT OP * (CPERLscope(*ppaddr)[])(ARGSproto) = {
pp_null,
pp_stub,
pp_scalar,
@@ -1466,8 +1489,10 @@ EXT OP * (*ppaddr[])() = {
pp_readline,
pp_rcatline,
pp_regcmaybe,
+ pp_regcreset,
pp_regcomp,
pp_match,
+ pp_qr,
pp_subst,
pp_substcont,
pp_trans,
@@ -1781,13 +1806,17 @@ EXT OP * (*ppaddr[])() = {
pp_egrent,
pp_getlogin,
pp_syscall,
+ pp_lock,
+ pp_threadsv,
};
+#endif /* PERL_OBJECT */
#endif
#ifndef DOINIT
-EXT OP * (*check[]) _((OP *op));
+EXT OP * (CPERLscope(*check)[]) _((OP *op));
#else
-EXT OP * (*check[]) _((OP *op)) = {
+#ifndef PERL_OBJECT
+EXT OP * (CPERLscope(*check)[]) _((OP *op)) = {
ck_null, /* null */
ck_null, /* stub */
ck_fun, /* scalar */
@@ -1817,8 +1846,10 @@ EXT OP * (*check[]) _((OP *op)) = {
ck_null, /* readline */
ck_null, /* rcatline */
ck_fun, /* regcmaybe */
+ ck_fun, /* regcreset */
ck_null, /* regcomp */
ck_match, /* match */
+ ck_match, /* qr */
ck_null, /* subst */
ck_null, /* substcont */
ck_null, /* trans */
@@ -2132,7 +2163,10 @@ EXT OP * (*check[]) _((OP *op)) = {
ck_null, /* egrent */
ck_null, /* getlogin */
ck_fun, /* syscall */
+ ck_rfun, /* lock */
+ ck_null, /* threadsv */
};
+#endif /* PERL_OBJECT */
#endif
#ifndef DOINIT
@@ -2141,347 +2175,351 @@ EXT U32 opargs[];
EXT U32 opargs[] = {
0x00000000, /* null */
0x00000000, /* stub */
- 0x00000104, /* scalar */
+ 0x00001c04, /* scalar */
0x00000004, /* pushmark */
0x00000014, /* wantarray */
- 0x00000004, /* const */
- 0x00000044, /* gvsv */
- 0x00000044, /* gv */
- 0x00001140, /* gelem */
+ 0x00000704, /* const */
+ 0x00000844, /* gvsv */
+ 0x00000844, /* gv */
+ 0x00011240, /* gelem */
0x00000044, /* padsv */
0x00000040, /* padav */
0x00000040, /* padhv */
0x00000040, /* padany */
- 0x00000000, /* pushre */
- 0x00000044, /* rv2gv */
- 0x00000044, /* rv2sv */
- 0x00000014, /* av2arylen */
- 0x00000040, /* rv2cv */
- 0x00000000, /* anoncode */
- 0x00000104, /* prototype */
- 0x00000201, /* refgen */
- 0x00000106, /* srefgen */
- 0x0000098c, /* ref */
- 0x00009104, /* bless */
- 0x00000008, /* backtick */
- 0x00009908, /* glob */
- 0x00000008, /* readline */
- 0x00000008, /* rcatline */
- 0x00000104, /* regcmaybe */
- 0x00000104, /* regcomp */
- 0x00000040, /* match */
- 0x00000154, /* subst */
- 0x00000054, /* substcont */
- 0x00000114, /* trans */
+ 0x00000640, /* pushre */
+ 0x00000144, /* rv2gv */
+ 0x00000144, /* rv2sv */
+ 0x00000114, /* av2arylen */
+ 0x00000140, /* rv2cv */
+ 0x00000700, /* anoncode */
+ 0x00001c04, /* prototype */
+ 0x00002101, /* refgen */
+ 0x00001106, /* srefgen */
+ 0x00009c8c, /* ref */
+ 0x00091504, /* bless */
+ 0x00000c08, /* backtick */
+ 0x00099508, /* glob */
+ 0x00000c08, /* readline */
+ 0x00000c08, /* rcatline */
+ 0x00001104, /* regcmaybe */
+ 0x00001104, /* regcreset */
+ 0x00001304, /* regcomp */
+ 0x00000640, /* match */
+ 0x00000604, /* qr */
+ 0x00001654, /* subst */
+ 0x00000354, /* substcont */
+ 0x00001914, /* trans */
0x00000004, /* sassign */
- 0x00002208, /* aassign */
- 0x0000020d, /* chop */
- 0x0000098c, /* schop */
- 0x0000020d, /* chomp */
- 0x0000098c, /* schomp */
- 0x00000994, /* defined */
- 0x00000904, /* undef */
- 0x00000984, /* study */
- 0x0000098c, /* pos */
- 0x00000164, /* preinc */
- 0x00000154, /* i_preinc */
- 0x00000164, /* predec */
- 0x00000154, /* i_predec */
- 0x0000016c, /* postinc */
- 0x0000015c, /* i_postinc */
- 0x0000016c, /* postdec */
- 0x0000015c, /* i_postdec */
- 0x0000110e, /* pow */
- 0x0000112e, /* multiply */
- 0x0000111e, /* i_multiply */
- 0x0000112e, /* divide */
- 0x0000111e, /* i_divide */
- 0x0000113e, /* modulo */
- 0x0000111e, /* i_modulo */
- 0x00001209, /* repeat */
- 0x0000112e, /* add */
- 0x0000111e, /* i_add */
- 0x0000112e, /* subtract */
- 0x0000111e, /* i_subtract */
- 0x0000110e, /* concat */
- 0x0000010e, /* stringify */
- 0x0000110e, /* left_shift */
- 0x0000110e, /* right_shift */
- 0x00001136, /* lt */
- 0x00001116, /* i_lt */
- 0x00001136, /* gt */
- 0x00001116, /* i_gt */
- 0x00001136, /* le */
- 0x00001116, /* i_le */
- 0x00001136, /* ge */
- 0x00001116, /* i_ge */
- 0x00001136, /* eq */
- 0x00001116, /* i_eq */
- 0x00001136, /* ne */
- 0x00001116, /* i_ne */
- 0x0000113e, /* ncmp */
- 0x0000111e, /* i_ncmp */
- 0x00001116, /* slt */
- 0x00001116, /* sgt */
- 0x00001116, /* sle */
- 0x00001116, /* sge */
- 0x00001116, /* seq */
- 0x00001116, /* sne */
- 0x0000111e, /* scmp */
- 0x0000110e, /* bit_and */
- 0x0000110e, /* bit_xor */
- 0x0000110e, /* bit_or */
- 0x0000012e, /* negate */
- 0x0000011e, /* i_negate */
- 0x00000116, /* not */
- 0x0000010e, /* complement */
- 0x0000110e, /* atan2 */
- 0x0000098e, /* sin */
- 0x0000098e, /* cos */
- 0x0000090c, /* rand */
- 0x00000904, /* srand */
- 0x0000098e, /* exp */
- 0x0000098e, /* log */
- 0x0000098e, /* sqrt */
- 0x0000098e, /* int */
- 0x0000098e, /* hex */
- 0x0000098e, /* oct */
- 0x0000098e, /* abs */
- 0x0000099c, /* length */
- 0x0009110c, /* substr */
- 0x0001111c, /* vec */
- 0x0009111c, /* index */
- 0x0009111c, /* rindex */
- 0x0000210f, /* sprintf */
- 0x00002105, /* formline */
- 0x0000099e, /* ord */
- 0x0000098e, /* chr */
- 0x0000110e, /* crypt */
- 0x0000098e, /* ucfirst */
- 0x0000098e, /* lcfirst */
- 0x0000098e, /* uc */
- 0x0000098e, /* lc */
- 0x0000098e, /* quotemeta */
- 0x00000048, /* rv2av */
- 0x00001304, /* aelemfast */
- 0x00001304, /* aelem */
- 0x00002301, /* aslice */
- 0x00000408, /* each */
- 0x00000408, /* values */
- 0x00000408, /* keys */
- 0x00000100, /* delete */
- 0x00000114, /* exists */
- 0x00000048, /* rv2hv */
- 0x00001404, /* helem */
- 0x00002401, /* hslice */
- 0x00001100, /* unpack */
- 0x0000210d, /* pack */
- 0x00011108, /* split */
- 0x0000210d, /* join */
- 0x00000201, /* list */
- 0x00022400, /* lslice */
- 0x00000205, /* anonlist */
- 0x00000205, /* anonhash */
- 0x00299301, /* splice */
- 0x0000231d, /* push */
- 0x00000304, /* pop */
- 0x00000304, /* shift */
- 0x0000231d, /* unshift */
- 0x00002d01, /* sort */
- 0x00000209, /* reverse */
- 0x00002541, /* grepstart */
- 0x00000048, /* grepwhile */
- 0x00002541, /* mapstart */
- 0x00000048, /* mapwhile */
- 0x00001100, /* range */
- 0x00001100, /* flip */
- 0x00000000, /* flop */
- 0x00000000, /* and */
- 0x00000000, /* or */
- 0x00001106, /* xor */
- 0x00000040, /* cond_expr */
- 0x00000004, /* andassign */
- 0x00000004, /* orassign */
- 0x00000040, /* method */
- 0x00000249, /* entersub */
- 0x00000000, /* leavesub */
- 0x00000908, /* caller */
- 0x0000021d, /* warn */
- 0x0000025d, /* die */
- 0x00000914, /* reset */
- 0x00000000, /* lineseq */
- 0x00000004, /* nextstate */
- 0x00000004, /* dbstate */
+ 0x00022208, /* aassign */
+ 0x00002c0d, /* chop */
+ 0x00009c8c, /* schop */
+ 0x00002c0d, /* chomp */
+ 0x00009c8c, /* schomp */
+ 0x00009c94, /* defined */
+ 0x00009c04, /* undef */
+ 0x00009c84, /* study */
+ 0x00009c8c, /* pos */
+ 0x00001164, /* preinc */
+ 0x00001154, /* i_preinc */
+ 0x00001164, /* predec */
+ 0x00001154, /* i_predec */
+ 0x0000116c, /* postinc */
+ 0x0000115c, /* i_postinc */
+ 0x0000116c, /* postdec */
+ 0x0000115c, /* i_postdec */
+ 0x0001120e, /* pow */
+ 0x0001122e, /* multiply */
+ 0x0001121e, /* i_multiply */
+ 0x0001122e, /* divide */
+ 0x0001121e, /* i_divide */
+ 0x0001123e, /* modulo */
+ 0x0001121e, /* i_modulo */
+ 0x00012209, /* repeat */
+ 0x0001122e, /* add */
+ 0x0001121e, /* i_add */
+ 0x0001122e, /* subtract */
+ 0x0001121e, /* i_subtract */
+ 0x0001120e, /* concat */
+ 0x0000150e, /* stringify */
+ 0x0001120e, /* left_shift */
+ 0x0001120e, /* right_shift */
+ 0x00011236, /* lt */
+ 0x00011216, /* i_lt */
+ 0x00011236, /* gt */
+ 0x00011216, /* i_gt */
+ 0x00011236, /* le */
+ 0x00011216, /* i_le */
+ 0x00011236, /* ge */
+ 0x00011216, /* i_ge */
+ 0x00011236, /* eq */
+ 0x00011216, /* i_eq */
+ 0x00011236, /* ne */
+ 0x00011216, /* i_ne */
+ 0x0001123e, /* ncmp */
+ 0x0001121e, /* i_ncmp */
+ 0x00011216, /* slt */
+ 0x00011216, /* sgt */
+ 0x00011216, /* sle */
+ 0x00011216, /* sge */
+ 0x00011216, /* seq */
+ 0x00011216, /* sne */
+ 0x0001121e, /* scmp */
+ 0x0001120e, /* bit_and */
+ 0x0001120e, /* bit_xor */
+ 0x0001120e, /* bit_or */
+ 0x0000112e, /* negate */
+ 0x0000111e, /* i_negate */
+ 0x00001116, /* not */
+ 0x0000110e, /* complement */
+ 0x0001150e, /* atan2 */
+ 0x00009c8e, /* sin */
+ 0x00009c8e, /* cos */
+ 0x00009c0c, /* rand */
+ 0x00009c04, /* srand */
+ 0x00009c8e, /* exp */
+ 0x00009c8e, /* log */
+ 0x00009c8e, /* sqrt */
+ 0x00009c8e, /* int */
+ 0x00009c8e, /* hex */
+ 0x00009c8e, /* oct */
+ 0x00009c8e, /* abs */
+ 0x00009c9c, /* length */
+ 0x0991150c, /* substr */
+ 0x0011151c, /* vec */
+ 0x0091151c, /* index */
+ 0x0091151c, /* rindex */
+ 0x0002150f, /* sprintf */
+ 0x00021505, /* formline */
+ 0x00009c9e, /* ord */
+ 0x00009c8e, /* chr */
+ 0x0001150e, /* crypt */
+ 0x00009c8e, /* ucfirst */
+ 0x00009c8e, /* lcfirst */
+ 0x00009c8e, /* uc */
+ 0x00009c8e, /* lc */
+ 0x00009c8e, /* quotemeta */
+ 0x00000148, /* rv2av */
+ 0x00013804, /* aelemfast */
+ 0x00013204, /* aelem */
+ 0x00023501, /* aslice */
+ 0x00004c08, /* each */
+ 0x00004c08, /* values */
+ 0x00004c08, /* keys */
+ 0x00001c00, /* delete */
+ 0x00001c14, /* exists */
+ 0x00000148, /* rv2hv */
+ 0x00014204, /* helem */
+ 0x00024501, /* hslice */
+ 0x00011500, /* unpack */
+ 0x0002150d, /* pack */
+ 0x00111508, /* split */
+ 0x0002150d, /* join */
+ 0x00002501, /* list */
+ 0x00224200, /* lslice */
+ 0x00002505, /* anonlist */
+ 0x00002505, /* anonhash */
+ 0x02993501, /* splice */
+ 0x0002351d, /* push */
+ 0x00003c04, /* pop */
+ 0x00003c04, /* shift */
+ 0x0002351d, /* unshift */
+ 0x0002d501, /* sort */
+ 0x00002509, /* reverse */
+ 0x00025541, /* grepstart */
+ 0x00000348, /* grepwhile */
+ 0x00025541, /* mapstart */
+ 0x00000348, /* mapwhile */
+ 0x00011400, /* range */
+ 0x00011100, /* flip */
+ 0x00000100, /* flop */
+ 0x00000300, /* and */
+ 0x00000300, /* or */
+ 0x00011306, /* xor */
+ 0x00000440, /* cond_expr */
+ 0x00000304, /* andassign */
+ 0x00000304, /* orassign */
+ 0x00000140, /* method */
+ 0x00002149, /* entersub */
+ 0x00000100, /* leavesub */
+ 0x00009c08, /* caller */
+ 0x0000251d, /* warn */
+ 0x0000255d, /* die */
+ 0x00009c14, /* reset */
+ 0x00000500, /* lineseq */
+ 0x00000b04, /* nextstate */
+ 0x00000b04, /* dbstate */
0x00000004, /* unstack */
0x00000000, /* enter */
- 0x00000000, /* leave */
- 0x00000000, /* scope */
- 0x00000040, /* enteriter */
+ 0x00000500, /* leave */
+ 0x00000500, /* scope */
+ 0x00000a40, /* enteriter */
0x00000000, /* iter */
- 0x00000040, /* enterloop */
- 0x00000000, /* leaveloop */
- 0x00000241, /* return */
- 0x00000044, /* last */
- 0x00000044, /* next */
- 0x00000044, /* redo */
- 0x00000044, /* dump */
- 0x00000044, /* goto */
- 0x00000944, /* exit */
- 0x0000961c, /* open */
- 0x00000e14, /* close */
- 0x00006614, /* pipe_op */
- 0x0000061c, /* fileno */
- 0x0000091c, /* umask */
- 0x00000604, /* binmode */
- 0x00021755, /* tie */
- 0x00000714, /* untie */
- 0x00000704, /* tied */
- 0x00011414, /* dbmopen */
- 0x00000414, /* dbmclose */
- 0x00111108, /* sselect */
- 0x00000e0c, /* select */
- 0x00000e0c, /* getc */
- 0x0091761d, /* read */
- 0x00000e54, /* enterwrite */
- 0x00000000, /* leavewrite */
- 0x00002e15, /* prtf */
- 0x00002e15, /* print */
- 0x00911604, /* sysopen */
- 0x00011604, /* sysseek */
- 0x0091761d, /* sysread */
- 0x0091161d, /* syswrite */
- 0x0091161d, /* send */
- 0x0011761d, /* recv */
- 0x00000e14, /* eof */
- 0x00000e0c, /* tell */
- 0x00011604, /* seek */
- 0x00001114, /* truncate */
- 0x0001160c, /* fcntl */
- 0x0001160c, /* ioctl */
- 0x0000161c, /* flock */
- 0x00111614, /* socket */
- 0x01116614, /* sockpair */
- 0x00001614, /* bind */
- 0x00001614, /* connect */
- 0x00001614, /* listen */
- 0x0000661c, /* accept */
- 0x0000161c, /* shutdown */
- 0x00011614, /* gsockopt */
- 0x00111614, /* ssockopt */
- 0x00000614, /* getsockname */
- 0x00000614, /* getpeername */
- 0x00000680, /* lstat */
- 0x00000680, /* stat */
- 0x00000694, /* ftrread */
- 0x00000694, /* ftrwrite */
- 0x00000694, /* ftrexec */
- 0x00000694, /* fteread */
- 0x00000694, /* ftewrite */
- 0x00000694, /* fteexec */
- 0x00000694, /* ftis */
- 0x00000694, /* fteowned */
- 0x00000694, /* ftrowned */
- 0x00000694, /* ftzero */
- 0x0000069c, /* ftsize */
- 0x0000068c, /* ftmtime */
- 0x0000068c, /* ftatime */
- 0x0000068c, /* ftctime */
- 0x00000694, /* ftsock */
- 0x00000694, /* ftchr */
- 0x00000694, /* ftblk */
- 0x00000694, /* ftfile */
- 0x00000694, /* ftdir */
- 0x00000694, /* ftpipe */
- 0x00000694, /* ftlink */
- 0x00000694, /* ftsuid */
- 0x00000694, /* ftsgid */
- 0x00000694, /* ftsvtx */
- 0x00000614, /* fttty */
- 0x00000694, /* fttext */
- 0x00000694, /* ftbinary */
- 0x0000091c, /* chdir */
- 0x0000021d, /* chown */
- 0x0000099c, /* chroot */
- 0x0000029d, /* unlink */
- 0x0000021d, /* chmod */
- 0x0000021d, /* utime */
- 0x0000111c, /* rename */
- 0x0000111c, /* link */
- 0x0000111c, /* symlink */
- 0x0000098c, /* readlink */
- 0x0000111c, /* mkdir */
- 0x0000099c, /* rmdir */
- 0x00001614, /* open_dir */
- 0x00000600, /* readdir */
- 0x0000060c, /* telldir */
- 0x00001604, /* seekdir */
- 0x00000604, /* rewinddir */
- 0x00000614, /* closedir */
+ 0x00000a40, /* enterloop */
+ 0x00000200, /* leaveloop */
+ 0x00002541, /* return */
+ 0x00000e44, /* last */
+ 0x00000e44, /* next */
+ 0x00000e44, /* redo */
+ 0x00000e44, /* dump */
+ 0x00000e44, /* goto */
+ 0x00009c44, /* exit */
+ 0x0009651c, /* open */
+ 0x0000ec14, /* close */
+ 0x00066514, /* pipe_op */
+ 0x00006c1c, /* fileno */
+ 0x00009c1c, /* umask */
+ 0x00006c04, /* binmode */
+ 0x00217555, /* tie */
+ 0x00007c14, /* untie */
+ 0x00007c04, /* tied */
+ 0x00114514, /* dbmopen */
+ 0x00004c14, /* dbmclose */
+ 0x01111508, /* sselect */
+ 0x0000e50c, /* select */
+ 0x0000ec0c, /* getc */
+ 0x0917651d, /* read */
+ 0x0000ec54, /* enterwrite */
+ 0x00000100, /* leavewrite */
+ 0x0002e515, /* prtf */
+ 0x0002e515, /* print */
+ 0x09116504, /* sysopen */
+ 0x00116504, /* sysseek */
+ 0x0917651d, /* sysread */
+ 0x0991651d, /* syswrite */
+ 0x0911651d, /* send */
+ 0x0117651d, /* recv */
+ 0x0000ec14, /* eof */
+ 0x0000ec0c, /* tell */
+ 0x00116504, /* seek */
+ 0x00011514, /* truncate */
+ 0x0011650c, /* fcntl */
+ 0x0011650c, /* ioctl */
+ 0x0001651c, /* flock */
+ 0x01116514, /* socket */
+ 0x11166514, /* sockpair */
+ 0x00016514, /* bind */
+ 0x00016514, /* connect */
+ 0x00016514, /* listen */
+ 0x0006651c, /* accept */
+ 0x0001651c, /* shutdown */
+ 0x00116514, /* gsockopt */
+ 0x01116514, /* ssockopt */
+ 0x00006c14, /* getsockname */
+ 0x00006c14, /* getpeername */
+ 0x00006d80, /* lstat */
+ 0x00006d80, /* stat */
+ 0x00006d94, /* ftrread */
+ 0x00006d94, /* ftrwrite */
+ 0x00006d94, /* ftrexec */
+ 0x00006d94, /* fteread */
+ 0x00006d94, /* ftewrite */
+ 0x00006d94, /* fteexec */
+ 0x00006d94, /* ftis */
+ 0x00006d94, /* fteowned */
+ 0x00006d94, /* ftrowned */
+ 0x00006d94, /* ftzero */
+ 0x00006d9c, /* ftsize */
+ 0x00006d8c, /* ftmtime */
+ 0x00006d8c, /* ftatime */
+ 0x00006d8c, /* ftctime */
+ 0x00006d94, /* ftsock */
+ 0x00006d94, /* ftchr */
+ 0x00006d94, /* ftblk */
+ 0x00006d94, /* ftfile */
+ 0x00006d94, /* ftdir */
+ 0x00006d94, /* ftpipe */
+ 0x00006d94, /* ftlink */
+ 0x00006d94, /* ftsuid */
+ 0x00006d94, /* ftsgid */
+ 0x00006d94, /* ftsvtx */
+ 0x00006d14, /* fttty */
+ 0x00006d94, /* fttext */
+ 0x00006d94, /* ftbinary */
+ 0x00009c1c, /* chdir */
+ 0x0000251d, /* chown */
+ 0x00009c9c, /* chroot */
+ 0x0000259d, /* unlink */
+ 0x0000251d, /* chmod */
+ 0x0000251d, /* utime */
+ 0x0001151c, /* rename */
+ 0x0001151c, /* link */
+ 0x0001151c, /* symlink */
+ 0x00009c8c, /* readlink */
+ 0x0001151c, /* mkdir */
+ 0x00009c9c, /* rmdir */
+ 0x00016514, /* open_dir */
+ 0x00006c00, /* readdir */
+ 0x00006c0c, /* telldir */
+ 0x00016504, /* seekdir */
+ 0x00006c04, /* rewinddir */
+ 0x00006c14, /* closedir */
0x0000001c, /* fork */
0x0000001c, /* wait */
- 0x0000111c, /* waitpid */
- 0x0000291d, /* system */
- 0x0000295d, /* exec */
- 0x0000025d, /* kill */
+ 0x0001151c, /* waitpid */
+ 0x0002951d, /* system */
+ 0x0002955d, /* exec */
+ 0x0000255d, /* kill */
0x0000001c, /* getppid */
- 0x0000091c, /* getpgrp */
- 0x0000991c, /* setpgrp */
- 0x0000111c, /* getpriority */
- 0x0001111c, /* setpriority */
+ 0x00009c1c, /* getpgrp */
+ 0x0009951c, /* setpgrp */
+ 0x0001151c, /* getpriority */
+ 0x0011151c, /* setpriority */
0x0000001c, /* time */
0x00000000, /* tms */
- 0x00000908, /* localtime */
- 0x00000908, /* gmtime */
- 0x0000099c, /* alarm */
- 0x0000091c, /* sleep */
- 0x0001111d, /* shmget */
- 0x0001111d, /* shmctl */
- 0x0011111d, /* shmread */
- 0x0011111d, /* shmwrite */
- 0x0000111d, /* msgget */
- 0x0001111d, /* msgctl */
- 0x0001111d, /* msgsnd */
- 0x0111111d, /* msgrcv */
- 0x0001111d, /* semget */
- 0x0011111d, /* semctl */
- 0x0000111d, /* semop */
- 0x000009c0, /* require */
- 0x00000140, /* dofile */
- 0x00000140, /* entereval */
- 0x00000100, /* leaveeval */
- 0x00000000, /* entertry */
- 0x00000000, /* leavetry */
- 0x00000100, /* ghbyname */
- 0x00001100, /* ghbyaddr */
+ 0x00009c08, /* localtime */
+ 0x00009c08, /* gmtime */
+ 0x00009c9c, /* alarm */
+ 0x00009c1c, /* sleep */
+ 0x0011151d, /* shmget */
+ 0x0011151d, /* shmctl */
+ 0x0111151d, /* shmread */
+ 0x0111151d, /* shmwrite */
+ 0x0001151d, /* msgget */
+ 0x0011151d, /* msgctl */
+ 0x0011151d, /* msgsnd */
+ 0x1111151d, /* msgrcv */
+ 0x0011151d, /* semget */
+ 0x0111151d, /* semctl */
+ 0x0001151d, /* semop */
+ 0x00009cc0, /* require */
+ 0x00001140, /* dofile */
+ 0x00001c40, /* entereval */
+ 0x00001100, /* leaveeval */
+ 0x00000300, /* entertry */
+ 0x00000500, /* leavetry */
+ 0x00001c00, /* ghbyname */
+ 0x00011500, /* ghbyaddr */
0x00000000, /* ghostent */
- 0x00000100, /* gnbyname */
- 0x00001100, /* gnbyaddr */
+ 0x00001c00, /* gnbyname */
+ 0x00011500, /* gnbyaddr */
0x00000000, /* gnetent */
- 0x00000100, /* gpbyname */
- 0x00000100, /* gpbynumber */
+ 0x00001c00, /* gpbyname */
+ 0x00001500, /* gpbynumber */
0x00000000, /* gprotoent */
- 0x00001100, /* gsbyname */
- 0x00001100, /* gsbyport */
+ 0x00011500, /* gsbyname */
+ 0x00011500, /* gsbyport */
0x00000000, /* gservent */
- 0x00000114, /* shostent */
- 0x00000114, /* snetent */
- 0x00000114, /* sprotoent */
- 0x00000114, /* sservent */
+ 0x00001c14, /* shostent */
+ 0x00001c14, /* snetent */
+ 0x00001c14, /* sprotoent */
+ 0x00001c14, /* sservent */
0x00000014, /* ehostent */
0x00000014, /* enetent */
0x00000014, /* eprotoent */
0x00000014, /* eservent */
- 0x00000100, /* gpwnam */
- 0x00000100, /* gpwuid */
+ 0x00001c00, /* gpwnam */
+ 0x00001c00, /* gpwuid */
0x00000000, /* gpwent */
0x00000014, /* spwent */
0x00000014, /* epwent */
- 0x00000100, /* ggrnam */
- 0x00000100, /* ggrgid */
+ 0x00001c00, /* ggrnam */
+ 0x00001c00, /* ggrgid */
0x00000000, /* ggrent */
0x00000014, /* sgrent */
0x00000014, /* egrent */
0x0000000c, /* getlogin */
- 0x0000211d, /* syscall */
+ 0x0002151d, /* syscall */
+ 0x00001c04, /* lock */
+ 0x00000044, /* threadsv */
};
#endif
diff --git a/gnu/usr.bin/perl/opcode.pl b/gnu/usr.bin/perl/opcode.pl
index a5659333726..cec51c00dfe 100644
--- a/gnu/usr.bin/perl/opcode.pl
+++ b/gnu/usr.bin/perl/opcode.pl
@@ -77,36 +77,44 @@ print <<END;
};
#endif
+#ifndef PERL_OBJECT
+START_EXTERN_C
+
END
# Emit function declarations.
for (sort keys %ckname) {
- print "OP *\t", &tab(3,$_),"_((OP* op));\n";
+ print "OP *\t", &tab(3,$_),"_((OP* o));\n";
}
print "\n";
for (@ops) {
- print "OP *\t", &tab(3, "pp_\L$_"), "_((void));\n";
+ print "OP *\t", &tab(3, "pp_$_"), "_((ARGSproto));\n";
}
# Emit ppcode switch array.
print <<END;
+END_EXTERN_C
+#endif /* PERL_OBJECT */
+
#ifndef DOINIT
-EXT OP * (*ppaddr[])();
+EXT OP * (CPERLscope(*ppaddr)[])(ARGSproto);
#else
-EXT OP * (*ppaddr[])() = {
+#ifndef PERL_OBJECT
+EXT OP * (CPERLscope(*ppaddr)[])(ARGSproto) = {
END
for (@ops) {
- print "\tpp_\L$_,\n";
+ print "\tpp_$_,\n";
}
print <<END;
};
+#endif /* PERL_OBJECT */
#endif
END
@@ -115,17 +123,19 @@ END
print <<END;
#ifndef DOINIT
-EXT OP * (*check[]) _((OP *op));
+EXT OP * (CPERLscope(*check)[]) _((OP *op));
#else
-EXT OP * (*check[]) _((OP *op)) = {
+#ifndef PERL_OBJECT
+EXT OP * (CPERLscope(*check)[]) _((OP *op)) = {
END
for (@ops) {
- print "\t", &tab(3, "$check{$_},"), "/* \L$_ */\n";
+ print "\t", &tab(3, "$check{$_},"), "/* $_ */\n";
}
print <<END;
};
+#endif /* PERL_OBJECT */
#endif
END
@@ -149,6 +159,24 @@ END
R, 7, # scalar reference
);
+%opclass = (
+ '0', 0, # baseop
+ '1', 1, # unop
+ '2', 2, # binop
+ '|', 3, # logop
+ '?', 4, # condop
+ '@', 5, # listop
+ '/', 6, # pmop
+ '$', 7, # svop
+ '*', 8, # gvop
+ '"', 9, # pvop
+ '{', 10, # loop
+ ';', 11, # cop
+ '%', 12, # baseop_or_unop
+ '-', 13, # filestatop
+ '}', 14, # loopexop
+);
+
for (@ops) {
$argsum = 0;
$flags = $flags{$_};
@@ -160,7 +188,10 @@ for (@ops) {
$argsum |= 32 if $flags =~ /I/; # has corresponding int op
$argsum |= 64 if $flags =~ /d/; # danger, unknown side effects
$argsum |= 128 if $flags =~ /u/; # defaults to $_
- $mul = 256;
+
+ $flags =~ /([\W\d_])/ or die qq[Opcode "$_" has no class indicator];
+ $argsum |= $opclass{$1} << 8;
+ $mul = 4096; # 2 ^ OASHIFT
for $arg (split(' ',$args{$_})) {
$argnum = ($arg =~ s/\?//) ? 8 : 0;
$argnum += $argnum{$arg};
@@ -168,7 +199,7 @@ for (@ops) {
$mul <<= 4;
}
$argsum = sprintf("0x%08x", $argsum);
- print "\t", &tab(3, "$argsum,"), "/* \L$_ */\n";
+ print "\t", &tab(3, "$argsum,"), "/* $_ */\n";
}
print <<END;
@@ -176,6 +207,17 @@ print <<END;
#endif
END
+close OC or die "Error closing opcode.h: $!";
+
+unlink "pp_proto.h";
+open PP, '>pp_proto.h' or die "Error creating pp_proto.h: $!";
+for (@ops) {
+ next if /^i_(pre|post)(inc|dec)$/;
+ print PP "PPDEF(pp_$_)\n";
+}
+
+close PP or die "Error closing pp_proto.h: $!";
+
###########################################################################
sub tab {
local($l, $t) = @_;
@@ -189,466 +231,473 @@ __END__
null null operation ck_null 0
stub stub ck_null 0
-scalar scalar ck_fun s S
+scalar scalar ck_fun s% S
# Pushy stuff.
-pushmark pushmark ck_null s
-wantarray wantarray ck_null is
+pushmark pushmark ck_null s0
+wantarray wantarray ck_null is0
-const constant item ck_svconst s
+const constant item ck_svconst s$
-gvsv scalar variable ck_null ds
-gv glob value ck_null ds
-gelem glob elem ck_null d S S
-padsv private variable ck_null ds
-padav private array ck_null d
-padhv private hash ck_null d
-padany private something ck_null d
+gvsv scalar variable ck_null ds*
+gv glob value ck_null ds*
+gelem glob elem ck_null d2 S S
+padsv private variable ck_null ds0
+padav private array ck_null d0
+padhv private hash ck_null d0
+padany private something ck_null d0
-pushre push regexp ck_null 0
+pushre push regexp ck_null d/
# References and stuff.
-rv2gv ref-to-glob cast ck_rvconst ds
-rv2sv scalar deref ck_rvconst ds
-av2arylen array length ck_null is
-rv2cv subroutine deref ck_rvconst d
-anoncode anonymous subroutine ck_anoncode 0
-prototype subroutine prototype ck_null s S
-refgen reference constructor ck_spair m L
-srefgen scalar ref constructor ck_null fs S
-ref reference-type operator ck_fun stu S?
-bless bless ck_fun s S S?
+rv2gv ref-to-glob cast ck_rvconst ds1
+rv2sv scalar deref ck_rvconst ds1
+av2arylen array length ck_null is1
+rv2cv subroutine deref ck_rvconst d1
+anoncode anonymous subroutine ck_anoncode $
+prototype subroutine prototype ck_null s% S
+refgen reference constructor ck_spair m1 L
+srefgen scalar ref constructor ck_null fs1 S
+ref reference-type operator ck_fun stu% S?
+bless bless ck_fun s@ S S?
# Pushy I/O.
-backtick backticks ck_null t
+backtick backticks ck_null t%
# glob defaults its first arg to $_
-glob glob ck_glob t S? S?
-readline <HANDLE> ck_null t
-rcatline append I/O operator ck_null t
+glob glob ck_glob t@ S? S?
+readline <HANDLE> ck_null t%
+rcatline append I/O operator ck_null t%
# Bindable operators.
-regcmaybe regexp comp once ck_fun s S
-regcomp regexp compilation ck_null s S
-match pattern match ck_match d
-subst substitution ck_null dis S
-substcont substitution cont ck_null dis
-trans character translation ck_null is S
+regcmaybe regexp comp once ck_fun s1 S
+regcreset regexp reset interpolation flag ck_fun s1 S
+regcomp regexp compilation ck_null s| S
+match pattern match ck_match d/
+qr pattern quote ck_match s/
+subst substitution ck_null dis/ S
+substcont substitution cont ck_null dis|
+trans character translation ck_null is" S
# Lvalue operators.
-
-sassign scalar assignment ck_null s
-aassign list assignment ck_null t L L
-
-chop chop ck_spair mts L
-schop scalar chop ck_null stu S?
-chomp safe chop ck_spair mts L
-schomp scalar safe chop ck_null stu S?
-defined defined operator ck_rfun isu S?
-undef undef operator ck_lfun s S?
-study study ck_fun su S?
-pos match position ck_lfun stu S?
-
-preinc preincrement ck_lfun dIs S
-i_preinc integer preincrement ck_lfun dis S
-predec predecrement ck_lfun dIs S
-i_predec integer predecrement ck_lfun dis S
-postinc postincrement ck_lfun dIst S
-i_postinc integer postincrement ck_lfun dist S
-postdec postdecrement ck_lfun dIst S
-i_postdec integer postdecrement ck_lfun dist S
+# sassign is special-cased for op class
+
+sassign scalar assignment ck_null s0
+aassign list assignment ck_null t2 L L
+
+chop chop ck_spair mts% L
+schop scalar chop ck_null stu% S?
+chomp safe chop ck_spair mts% L
+schomp scalar safe chop ck_null stu% S?
+defined defined operator ck_rfun isu% S?
+undef undef operator ck_lfun s% S?
+study study ck_fun su% S?
+pos match position ck_lfun stu% S?
+
+preinc preincrement ck_lfun dIs1 S
+i_preinc integer preincrement ck_lfun dis1 S
+predec predecrement ck_lfun dIs1 S
+i_predec integer predecrement ck_lfun dis1 S
+postinc postincrement ck_lfun dIst1 S
+i_postinc integer postincrement ck_lfun dist1 S
+postdec postdecrement ck_lfun dIst1 S
+i_postdec integer postdecrement ck_lfun dist1 S
# Ordinary operators.
-pow exponentiation ck_null fst S S
-
-multiply multiplication ck_null Ifst S S
-i_multiply integer multiplication ck_null ifst S S
-divide division ck_null Ifst S S
-i_divide integer division ck_null ifst S S
-modulo modulus ck_null Iifst S S
-i_modulo integer modulus ck_null ifst S S
-repeat repeat ck_repeat mt L S
-
-add addition ck_null Ifst S S
-i_add integer addition ck_null ifst S S
-subtract subtraction ck_null Ifst S S
-i_subtract integer subtraction ck_null ifst S S
-concat concatenation ck_concat fst S S
-stringify string ck_fun fst S
-
-left_shift left bitshift ck_bitop fst S S
-right_shift right bitshift ck_bitop fst S S
-
-lt numeric lt ck_null Iifs S S
-i_lt integer lt ck_null ifs S S
-gt numeric gt ck_null Iifs S S
-i_gt integer gt ck_null ifs S S
-le numeric le ck_null Iifs S S
-i_le integer le ck_null ifs S S
-ge numeric ge ck_null Iifs S S
-i_ge integer ge ck_null ifs S S
-eq numeric eq ck_null Iifs S S
-i_eq integer eq ck_null ifs S S
-ne numeric ne ck_null Iifs S S
-i_ne integer ne ck_null ifs S S
-ncmp spaceship operator ck_null Iifst S S
-i_ncmp integer spaceship ck_null ifst S S
-
-slt string lt ck_scmp ifs S S
-sgt string gt ck_scmp ifs S S
-sle string le ck_scmp ifs S S
-sge string ge ck_scmp ifs S S
-seq string eq ck_null ifs S S
-sne string ne ck_null ifs S S
-scmp string comparison ck_scmp ifst S S
-
-bit_and bitwise and ck_bitop fst S S
-bit_xor bitwise xor ck_bitop fst S S
-bit_or bitwise or ck_bitop fst S S
-
-negate negate ck_null Ifst S
-i_negate integer negate ck_null ifst S
-not not ck_null ifs S
-complement 1's complement ck_bitop fst S
+pow exponentiation ck_null fst2 S S
+
+multiply multiplication ck_null Ifst2 S S
+i_multiply integer multiplication ck_null ifst2 S S
+divide division ck_null Ifst2 S S
+i_divide integer division ck_null ifst2 S S
+modulo modulus ck_null Iifst2 S S
+i_modulo integer modulus ck_null ifst2 S S
+repeat repeat ck_repeat mt2 L S
+
+add addition ck_null Ifst2 S S
+i_add integer addition ck_null ifst2 S S
+subtract subtraction ck_null Ifst2 S S
+i_subtract integer subtraction ck_null ifst2 S S
+concat concatenation ck_concat fst2 S S
+stringify string ck_fun fst@ S
+
+left_shift left bitshift ck_bitop fst2 S S
+right_shift right bitshift ck_bitop fst2 S S
+
+lt numeric lt ck_null Iifs2 S S
+i_lt integer lt ck_null ifs2 S S
+gt numeric gt ck_null Iifs2 S S
+i_gt integer gt ck_null ifs2 S S
+le numeric le ck_null Iifs2 S S
+i_le integer le ck_null ifs2 S S
+ge numeric ge ck_null Iifs2 S S
+i_ge integer ge ck_null ifs2 S S
+eq numeric eq ck_null Iifs2 S S
+i_eq integer eq ck_null ifs2 S S
+ne numeric ne ck_null Iifs2 S S
+i_ne integer ne ck_null ifs2 S S
+ncmp spaceship operator ck_null Iifst2 S S
+i_ncmp integer spaceship ck_null ifst2 S S
+
+slt string lt ck_scmp ifs2 S S
+sgt string gt ck_scmp ifs2 S S
+sle string le ck_scmp ifs2 S S
+sge string ge ck_scmp ifs2 S S
+seq string eq ck_null ifs2 S S
+sne string ne ck_null ifs2 S S
+scmp string comparison ck_scmp ifst2 S S
+
+bit_and bitwise and ck_bitop fst2 S S
+bit_xor bitwise xor ck_bitop fst2 S S
+bit_or bitwise or ck_bitop fst2 S S
+
+negate negate ck_null Ifst1 S
+i_negate integer negate ck_null ifst1 S
+not not ck_null ifs1 S
+complement 1's complement ck_bitop fst1 S
# High falutin' math.
-atan2 atan2 ck_fun fst S S
-sin sin ck_fun fstu S?
-cos cos ck_fun fstu S?
-rand rand ck_fun st S?
-srand srand ck_fun s S?
-exp exp ck_fun fstu S?
-log log ck_fun fstu S?
-sqrt sqrt ck_fun fstu S?
+atan2 atan2 ck_fun fst@ S S
+sin sin ck_fun fstu% S?
+cos cos ck_fun fstu% S?
+rand rand ck_fun st% S?
+srand srand ck_fun s% S?
+exp exp ck_fun fstu% S?
+log log ck_fun fstu% S?
+sqrt sqrt ck_fun fstu% S?
# Lowbrow math.
-int int ck_fun fstu S?
-hex hex ck_fun fstu S?
-oct oct ck_fun fstu S?
-abs abs ck_fun fstu S?
+int int ck_fun fstu% S?
+hex hex ck_fun fstu% S?
+oct oct ck_fun fstu% S?
+abs abs ck_fun fstu% S?
# String stuff.
-length length ck_lengthconst istu S?
-substr substr ck_fun st S S S?
-vec vec ck_fun ist S S S
+length length ck_lengthconst istu% S?
+substr substr ck_fun st@ S S S? S?
+vec vec ck_fun ist@ S S S
-index index ck_index ist S S S?
-rindex rindex ck_index ist S S S?
+index index ck_index ist@ S S S?
+rindex rindex ck_index ist@ S S S?
-sprintf sprintf ck_fun_locale mfst S L
-formline formline ck_fun ms S L
-ord ord ck_fun ifstu S?
-chr chr ck_fun fstu S?
-crypt crypt ck_fun fst S S
-ucfirst upper case first ck_fun_locale fstu S?
-lcfirst lower case first ck_fun_locale fstu S?
-uc upper case ck_fun_locale fstu S?
-lc lower case ck_fun_locale fstu S?
-quotemeta quote metachars ck_fun fstu S?
+sprintf sprintf ck_fun_locale mfst@ S L
+formline formline ck_fun ms@ S L
+ord ord ck_fun ifstu% S?
+chr chr ck_fun fstu% S?
+crypt crypt ck_fun fst@ S S
+ucfirst upper case first ck_fun_locale fstu% S?
+lcfirst lower case first ck_fun_locale fstu% S?
+uc upper case ck_fun_locale fstu% S?
+lc lower case ck_fun_locale fstu% S?
+quotemeta quote metachars ck_fun fstu% S?
# Arrays.
-rv2av array deref ck_rvconst dt
-aelemfast known array element ck_null s A S
-aelem array element ck_null s A S
-aslice array slice ck_null m A L
+rv2av array deref ck_rvconst dt1
+aelemfast known array element ck_null s* A S
+aelem array element ck_null s2 A S
+aslice array slice ck_null m@ A L
# Hashes.
-each each ck_fun t H
-values values ck_fun t H
-keys keys ck_fun t H
-delete delete ck_delete 0 S
-exists exists operator ck_exists is S
-rv2hv hash deref ck_rvconst dt
-helem hash elem ck_null s H S
-hslice hash slice ck_null m H L
+each each ck_fun t% H
+values values ck_fun t% H
+keys keys ck_fun t% H
+delete delete ck_delete % S
+exists exists operator ck_exists is% S
+rv2hv hash deref ck_rvconst dt1
+helem hash elem ck_null s2@ H S
+hslice hash slice ck_null m@ H L
# Explosives and implosives.
-unpack unpack ck_fun 0 S S
-pack pack ck_fun mst S L
-split split ck_split t S S S
-join join ck_fun mst S L
+unpack unpack ck_fun @ S S
+pack pack ck_fun mst@ S L
+split split ck_split t@ S S S
+join join ck_fun mst@ S L
# List operators.
-list list ck_null m L
-lslice list slice ck_null 0 H L L
-anonlist anonymous list ck_fun ms L
-anonhash anonymous hash ck_fun ms L
+list list ck_null m@ L
+lslice list slice ck_null 2 H L L
+anonlist anonymous list ck_fun ms@ L
+anonhash anonymous hash ck_fun ms@ L
-splice splice ck_fun m A S? S? L
-push push ck_fun imst A L
-pop pop ck_shift s A
-shift shift ck_shift s A
-unshift unshift ck_fun imst A L
-sort sort ck_sort m C? L
-reverse reverse ck_fun mt L
+splice splice ck_fun m@ A S? S? L
+push push ck_fun imst@ A L
+pop pop ck_shift s% A
+shift shift ck_shift s% A
+unshift unshift ck_fun imst@ A L
+sort sort ck_sort m@ C? L
+reverse reverse ck_fun mt@ L
-grepstart grep ck_grep dm C L
-grepwhile grep iterator ck_null dt
+grepstart grep ck_grep dm@ C L
+grepwhile grep iterator ck_null dt|
-mapstart map ck_grep dm C L
-mapwhile map iterator ck_null dt
+mapstart map ck_grep dm@ C L
+mapwhile map iterator ck_null dt|
# Range stuff.
-range flipflop ck_null 0 S S
-flip range (or flip) ck_null 0 S S
-flop range (or flop) ck_null 0
+range flipflop ck_null ? S S
+flip range (or flip) ck_null 1 S S
+flop range (or flop) ck_null 1
# Control.
-and logical and ck_null 0
-or logical or ck_null 0
-xor logical xor ck_null fs S S
-cond_expr conditional expression ck_null d
-andassign logical and assignment ck_null s
-orassign logical or assignment ck_null s
-
-method method lookup ck_null d
-entersub subroutine entry ck_subr dmt L
-leavesub subroutine exit ck_null 0
-caller caller ck_fun t S?
-warn warn ck_fun imst L
-die die ck_fun dimst L
-reset reset ck_fun is S?
-
-lineseq line sequence ck_null 0
-nextstate next statement ck_null s
-dbstate debug next statement ck_null s
-unstack unstack ck_null s
+and logical and ck_null |
+or logical or ck_null |
+xor logical xor ck_null fs| S S
+cond_expr conditional expression ck_null d?
+andassign logical and assignment ck_null s|
+orassign logical or assignment ck_null s|
+
+method method lookup ck_null d1
+entersub subroutine entry ck_subr dmt1 L
+leavesub subroutine exit ck_null 1
+caller caller ck_fun t% S?
+warn warn ck_fun imst@ L
+die die ck_fun dimst@ L
+reset reset ck_fun is% S?
+
+lineseq line sequence ck_null @
+nextstate next statement ck_null s;
+dbstate debug next statement ck_null s;
+unstack iteration finalizer ck_null s0
enter block entry ck_null 0
-leave block exit ck_null 0
-scope block ck_null 0
-enteriter foreach loop entry ck_null d
+leave block exit ck_null @
+scope block ck_null @
+enteriter foreach loop entry ck_null d{
iter foreach loop iterator ck_null 0
-enterloop loop entry ck_null d
-leaveloop loop exit ck_null 0
-return return ck_null dm L
-last last ck_null ds
-next next ck_null ds
-redo redo ck_null ds
-dump dump ck_null ds
-goto goto ck_null ds
-exit exit ck_fun ds S?
+enterloop loop entry ck_null d{
+leaveloop loop exit ck_null 2
+return return ck_null dm@ L
+last last ck_null ds}
+next next ck_null ds}
+redo redo ck_null ds}
+dump dump ck_null ds}
+goto goto ck_null ds}
+exit exit ck_fun ds% S?
#nswitch numeric switch ck_null d
#cswitch character switch ck_null d
# I/O.
-open open ck_fun ist F S?
-close close ck_fun is F?
-pipe_op pipe ck_fun is F F
+open open ck_fun ist@ F S?
+close close ck_fun is% F?
+pipe_op pipe ck_fun is@ F F
-fileno fileno ck_fun ist F
-umask umask ck_fun ist S?
-binmode binmode ck_fun s F
+fileno fileno ck_fun ist% F
+umask umask ck_fun ist% S?
+binmode binmode ck_fun s% F
-tie tie ck_fun idms R S L
-untie untie ck_fun is R
-tied tied ck_fun s R
-dbmopen dbmopen ck_fun is H S S
-dbmclose dbmclose ck_fun is H
+tie tie ck_fun idms@ R S L
+untie untie ck_fun is% R
+tied tied ck_fun s% R
+dbmopen dbmopen ck_fun is@ H S S
+dbmclose dbmclose ck_fun is% H
-sselect select system call ck_select t S S S S
-select select ck_select st F?
+sselect select system call ck_select t@ S S S S
+select select ck_select st@ F?
-getc getc ck_eof st F?
-read read ck_fun imst F R S S?
-enterwrite write ck_fun dis F?
-leavewrite write exit ck_null 0
+getc getc ck_eof st% F?
+read read ck_fun imst@ F R S S?
+enterwrite write ck_fun dis% F?
+leavewrite write exit ck_null 1
-prtf printf ck_listiob ims F? L
-print print ck_listiob ims F? L
+prtf printf ck_listiob ims@ F? L
+print print ck_listiob ims@ F? L
-sysopen sysopen ck_fun s F S S S?
-sysseek sysseek ck_fun s F S S
-sysread sysread ck_fun imst F R S S?
-syswrite syswrite ck_fun imst F S S S?
+sysopen sysopen ck_fun s@ F S S S?
+sysseek sysseek ck_fun s@ F S S
+sysread sysread ck_fun imst@ F R S S?
+syswrite syswrite ck_fun imst@ F S S? S?
-send send ck_fun imst F S S S?
-recv recv ck_fun imst F R S S
+send send ck_fun imst@ F S S S?
+recv recv ck_fun imst@ F R S S
-eof eof ck_eof is F?
-tell tell ck_fun st F?
-seek seek ck_fun s F S S
+eof eof ck_eof is% F?
+tell tell ck_fun st% F?
+seek seek ck_fun s@ F S S
# truncate really behaves as if it had both "S S" and "F S"
-truncate truncate ck_trunc is S S
+truncate truncate ck_trunc is@ S S
-fcntl fcntl ck_fun st F S S
-ioctl ioctl ck_fun st F S S
-flock flock ck_fun ist F S
+fcntl fcntl ck_fun st@ F S S
+ioctl ioctl ck_fun st@ F S S
+flock flock ck_fun ist@ F S
# Sockets.
-socket socket ck_fun is F S S S
-sockpair socketpair ck_fun is F F S S S
+socket socket ck_fun is@ F S S S
+sockpair socketpair ck_fun is@ F F S S S
-bind bind ck_fun is F S
-connect connect ck_fun is F S
-listen listen ck_fun is F S
-accept accept ck_fun ist F F
-shutdown shutdown ck_fun ist F S
+bind bind ck_fun is@ F S
+connect connect ck_fun is@ F S
+listen listen ck_fun is@ F S
+accept accept ck_fun ist@ F F
+shutdown shutdown ck_fun ist@ F S
-gsockopt getsockopt ck_fun is F S S
-ssockopt setsockopt ck_fun is F S S S
+gsockopt getsockopt ck_fun is@ F S S
+ssockopt setsockopt ck_fun is@ F S S S
-getsockname getsockname ck_fun is F
-getpeername getpeername ck_fun is F
+getsockname getsockname ck_fun is% F
+getpeername getpeername ck_fun is% F
# Stat calls.
-lstat lstat ck_ftst u F
-stat stat ck_ftst u F
-ftrread -R ck_ftst isu F
-ftrwrite -W ck_ftst isu F
-ftrexec -X ck_ftst isu F
-fteread -r ck_ftst isu F
-ftewrite -w ck_ftst isu F
-fteexec -x ck_ftst isu F
-ftis -e ck_ftst isu F
-fteowned -O ck_ftst isu F
-ftrowned -o ck_ftst isu F
-ftzero -z ck_ftst isu F
-ftsize -s ck_ftst istu F
-ftmtime -M ck_ftst stu F
-ftatime -A ck_ftst stu F
-ftctime -C ck_ftst stu F
-ftsock -S ck_ftst isu F
-ftchr -c ck_ftst isu F
-ftblk -b ck_ftst isu F
-ftfile -f ck_ftst isu F
-ftdir -d ck_ftst isu F
-ftpipe -p ck_ftst isu F
-ftlink -l ck_ftst isu F
-ftsuid -u ck_ftst isu F
-ftsgid -g ck_ftst isu F
-ftsvtx -k ck_ftst isu F
-fttty -t ck_ftst is F
-fttext -T ck_ftst isu F
-ftbinary -B ck_ftst isu F
+lstat lstat ck_ftst u- F
+stat stat ck_ftst u- F
+ftrread -R ck_ftst isu- F
+ftrwrite -W ck_ftst isu- F
+ftrexec -X ck_ftst isu- F
+fteread -r ck_ftst isu- F
+ftewrite -w ck_ftst isu- F
+fteexec -x ck_ftst isu- F
+ftis -e ck_ftst isu- F
+fteowned -O ck_ftst isu- F
+ftrowned -o ck_ftst isu- F
+ftzero -z ck_ftst isu- F
+ftsize -s ck_ftst istu- F
+ftmtime -M ck_ftst stu- F
+ftatime -A ck_ftst stu- F
+ftctime -C ck_ftst stu- F
+ftsock -S ck_ftst isu- F
+ftchr -c ck_ftst isu- F
+ftblk -b ck_ftst isu- F
+ftfile -f ck_ftst isu- F
+ftdir -d ck_ftst isu- F
+ftpipe -p ck_ftst isu- F
+ftlink -l ck_ftst isu- F
+ftsuid -u ck_ftst isu- F
+ftsgid -g ck_ftst isu- F
+ftsvtx -k ck_ftst isu- F
+fttty -t ck_ftst is- F
+fttext -T ck_ftst isu- F
+ftbinary -B ck_ftst isu- F
# File calls.
-chdir chdir ck_fun ist S?
-chown chown ck_fun imst L
-chroot chroot ck_fun istu S?
-unlink unlink ck_fun imstu L
-chmod chmod ck_fun imst L
-utime utime ck_fun imst L
-rename rename ck_fun ist S S
-link link ck_fun ist S S
-symlink symlink ck_fun ist S S
-readlink readlink ck_fun stu S?
-mkdir mkdir ck_fun ist S S
-rmdir rmdir ck_fun istu S?
+chdir chdir ck_fun ist% S?
+chown chown ck_fun imst@ L
+chroot chroot ck_fun istu% S?
+unlink unlink ck_fun imstu@ L
+chmod chmod ck_fun imst@ L
+utime utime ck_fun imst@ L
+rename rename ck_fun ist@ S S
+link link ck_fun ist@ S S
+symlink symlink ck_fun ist@ S S
+readlink readlink ck_fun stu% S?
+mkdir mkdir ck_fun ist@ S S
+rmdir rmdir ck_fun istu% S?
# Directory calls.
-open_dir opendir ck_fun is F S
-readdir readdir ck_fun 0 F
-telldir telldir ck_fun st F
-seekdir seekdir ck_fun s F S
-rewinddir rewinddir ck_fun s F
-closedir closedir ck_fun is F
+open_dir opendir ck_fun is@ F S
+readdir readdir ck_fun % F
+telldir telldir ck_fun st% F
+seekdir seekdir ck_fun s@ F S
+rewinddir rewinddir ck_fun s% F
+closedir closedir ck_fun is% F
# Process control.
-fork fork ck_null ist
-wait wait ck_null ist
-waitpid waitpid ck_fun ist S S
-system system ck_exec imst S? L
-exec exec ck_exec dimst S? L
-kill kill ck_fun dimst L
-getppid getppid ck_null ist
-getpgrp getpgrp ck_fun ist S?
-setpgrp setpgrp ck_fun ist S? S?
-getpriority getpriority ck_fun ist S S
-setpriority setpriority ck_fun ist S S S
+fork fork ck_null ist0
+wait wait ck_null ist0
+waitpid waitpid ck_fun ist@ S S
+system system ck_exec imst@ S? L
+exec exec ck_exec dimst@ S? L
+kill kill ck_fun dimst@ L
+getppid getppid ck_null ist0
+getpgrp getpgrp ck_fun ist% S?
+setpgrp setpgrp ck_fun ist@ S? S?
+getpriority getpriority ck_fun ist@ S S
+setpriority setpriority ck_fun ist@ S S S
# Time calls.
-time time ck_null ist
+time time ck_null ist0
tms times ck_null 0
-localtime localtime ck_fun t S?
-gmtime gmtime ck_fun t S?
-alarm alarm ck_fun istu S?
-sleep sleep ck_fun ist S?
+localtime localtime ck_fun t% S?
+gmtime gmtime ck_fun t% S?
+alarm alarm ck_fun istu% S?
+sleep sleep ck_fun ist% S?
# Shared memory.
-shmget shmget ck_fun imst S S S
-shmctl shmctl ck_fun imst S S S
-shmread shmread ck_fun imst S S S S
-shmwrite shmwrite ck_fun imst S S S S
+shmget shmget ck_fun imst@ S S S
+shmctl shmctl ck_fun imst@ S S S
+shmread shmread ck_fun imst@ S S S S
+shmwrite shmwrite ck_fun imst@ S S S S
# Message passing.
-msgget msgget ck_fun imst S S
-msgctl msgctl ck_fun imst S S S
-msgsnd msgsnd ck_fun imst S S S
-msgrcv msgrcv ck_fun imst S S S S S
+msgget msgget ck_fun imst@ S S
+msgctl msgctl ck_fun imst@ S S S
+msgsnd msgsnd ck_fun imst@ S S S
+msgrcv msgrcv ck_fun imst@ S S S S S
# Semaphores.
-semget semget ck_fun imst S S S
-semctl semctl ck_fun imst S S S S
-semop semop ck_fun imst S S
+semget semget ck_fun imst@ S S S
+semctl semctl ck_fun imst@ S S S S
+semop semop ck_fun imst@ S S
# Eval.
-require require ck_require du S?
-dofile do 'file' ck_fun d S
-entereval eval string ck_eval d S
-leaveeval eval exit ck_null 0 S
-#evalonce eval constant string ck_null d S
-entertry eval block ck_null 0
-leavetry eval block exit ck_null 0
+require require ck_require du% S?
+dofile do 'file' ck_fun d1 S
+entereval eval string ck_eval d% S
+leaveeval eval exit ck_null 1 S
+#evalonce eval constant string ck_null d1 S
+entertry eval block ck_null |
+leavetry eval block exit ck_null @
# Get system info.
-ghbyname gethostbyname ck_fun 0 S
-ghbyaddr gethostbyaddr ck_fun 0 S S
+ghbyname gethostbyname ck_fun % S
+ghbyaddr gethostbyaddr ck_fun @ S S
ghostent gethostent ck_null 0
-gnbyname getnetbyname ck_fun 0 S
-gnbyaddr getnetbyaddr ck_fun 0 S S
+gnbyname getnetbyname ck_fun % S
+gnbyaddr getnetbyaddr ck_fun @ S S
gnetent getnetent ck_null 0
-gpbyname getprotobyname ck_fun 0 S
-gpbynumber getprotobynumber ck_fun 0 S
+gpbyname getprotobyname ck_fun % S
+gpbynumber getprotobynumber ck_fun @ S
gprotoent getprotoent ck_null 0
-gsbyname getservbyname ck_fun 0 S S
-gsbyport getservbyport ck_fun 0 S S
+gsbyname getservbyname ck_fun @ S S
+gsbyport getservbyport ck_fun @ S S
gservent getservent ck_null 0
-shostent sethostent ck_fun is S
-snetent setnetent ck_fun is S
-sprotoent setprotoent ck_fun is S
-sservent setservent ck_fun is S
-ehostent endhostent ck_null is
-enetent endnetent ck_null is
-eprotoent endprotoent ck_null is
-eservent endservent ck_null is
-gpwnam getpwnam ck_fun 0 S
-gpwuid getpwuid ck_fun 0 S
+shostent sethostent ck_fun is% S
+snetent setnetent ck_fun is% S
+sprotoent setprotoent ck_fun is% S
+sservent setservent ck_fun is% S
+ehostent endhostent ck_null is0
+enetent endnetent ck_null is0
+eprotoent endprotoent ck_null is0
+eservent endservent ck_null is0
+gpwnam getpwnam ck_fun % S
+gpwuid getpwuid ck_fun % S
gpwent getpwent ck_null 0
-spwent setpwent ck_null is
-epwent endpwent ck_null is
-ggrnam getgrnam ck_fun 0 S
-ggrgid getgrgid ck_fun 0 S
+spwent setpwent ck_null is0
+epwent endpwent ck_null is0
+ggrnam getgrnam ck_fun % S
+ggrgid getgrgid ck_fun % S
ggrent getgrent ck_null 0
-sgrent setgrent ck_null is
-egrent endgrent ck_null is
-getlogin getlogin ck_null st
+sgrent setgrent ck_null is0
+egrent endgrent ck_null is0
+getlogin getlogin ck_null st0
# Miscellaneous.
-syscall syscall ck_fun imst S L
+syscall syscall ck_fun imst@ S L
+
+# For multi-threading
+lock lock ck_rfun s% S
+threadsv per-thread variable ck_null ds0
diff --git a/gnu/usr.bin/perl/os2/Changes b/gnu/usr.bin/perl/os2/Changes
index 4e0c4d49b53..d15e74e6268 100644
--- a/gnu/usr.bin/perl/os2/Changes
+++ b/gnu/usr.bin/perl/os2/Changes
@@ -163,3 +163,61 @@ after 5.004_03:
changes to errno?)
$0 may be edited to longer lengths (at least under OS/2).
OS2::REXX->loads looks in the OS/2-ish fashion too.
+
+after 5.004_04:
+ Default perl.exe was built with a shorter stack than expected.
+ Strip extensions DLLs too (unless debugging build).
+ ./os2.c being RO could stop cp.
+ When starting scripts, Perl will find them on path (using the same
+ extensions as for -S command-line switch). If it finds magic
+ `extproc ' or `#!' cookies, it will start the scripts directly.
+ May use `cmd /c more <' as a pager.
+ If a program could not be started, this might have been hidden.
+ End of pipe was closed twice when `open'ing a pipeline.
+
+after 5.004_53:
+ Minimal thread support added. One needs to manually move pthread.h
+
+after 5.004_64:
+ Make DLL names different if thread-enabled.
+ Emit more informative internal DLL descriptions.
+
+5.004_72:
+ Updated OS2::Process (v0.2) included.
+
+after 5.004_73:
+ Fixed a bug with argv not NULL-terminated when starting scripts.
+ Support all the forms of starting scripts.
+ Support killing a child when receiving a signal during system()
+ (in two stage, on first send the same signal, on the next
+ send SIGKILL).
+ Add the same logic for scripts as in pdksh, including
+ stripping the path from #! line if needed,
+ calling EXECSHELL or COMSPEC for magic-less scripts;
+ Now pdksh is called only if one-arg system()/friends contains
+ metachars, or if magic-line asks for sh, or there is no magic
+ line and EXECSHELL is set to sh.
+ Shell is supplied the original command line if possible.
+
+after 5.005_02:
+ Can start PM programs from non-PM sessions by plain system()
+ and friends. Can start DOS/Win programs. Can start
+ fullscreen programs from non-fullscreen sessions too.
+ In fact system(P_PM,...) was broken.
+ We mangle the name of perl*.DLL, to allow coexistence of different
+ versions of Perl executables on the system. Mangling of
+ names of extension DLL is also changed, thus running two
+ different versions of the executable with loaded
+ extensions should not lead to conflicts (since
+ extension-full-name and Perl-version mangling work in the
+ same set ot 576 possible keys, this may lead to clashes).
+ $^E was reset on the second read, and contained ".\r\n" at the end.
+after 5.005_53:
+ Would segfault system()ing non-existing program;
+ AOUT build was hosed;
+ warning-test for getpriority() might lock the system hard on
+ pre-fixpak22 configuration (calling getpriority() on
+ non-existing process triggers a system-wide bug).
+
+
+ PrfDB was using a bug in processing XSUBs returning U32.
diff --git a/gnu/usr.bin/perl/os2/Makefile.SHs b/gnu/usr.bin/perl/os2/Makefile.SHs
index 493aeab8c59..c9bf39a1e23 100644
--- a/gnu/usr.bin/perl/os2/Makefile.SHs
+++ b/gnu/usr.bin/perl/os2/Makefile.SHs
@@ -6,9 +6,21 @@
# Additional rules supported: perl_, aout_test, aout_install, use them
# for a.out style perl (which may fork).
+perl_version="5.00${PATCHLEVEL}_$SUBVERSION"
+case "$archname" in
+ *-thread*) perl_version="${perl_version}-threaded";;
+esac
+
+dll_post="`echo $perl_version | sum | awk '{print $1}'`"
+dll_post="`printf '%x' $dll_post | tr '[a-z]' '[A-Z]'`"
+
$spitshell >>Makefile <<!GROK!THIS!
-AOUT_CCCMD = \$(CC) $aout_ccflags $optimize
+PERL_VERSION = $perl_version
+
+OPTIMIZE = $optimize
+AOUT_OPTIMIZE = \$(OPTIMIZE)
+AOUT_CCCMD = \$(CC) $aout_ccflags \$(AOUT_OPTIMIZE)
AOUT_AR = $aout_ar
AOUT_OBJ_EXT = $aout_obj_ext
AOUT_LIB_EXT = $aout_lib_ext
@@ -17,17 +29,21 @@ AOUT_CLDFLAGS = $aout_ldflags
AOUT_LIBPERL_DLL = libperl_dll$aout_lib_ext
AOUT_CCCMD_DLL = \$(CC) -DDOSISH -DOS2=2 -DEMBED -I. -DPACK_MALLOC -DDEBUGGING_MSTATS -DTWO_POT_OPTIMIZE -DPERL_EMERGENCY_SBRK
-AOUT_CLDFLAGS_DLL = -Zexe -Zmt -Zcrtdll
+AOUT_CLDFLAGS_DLL = -Zexe -Zmt -Zcrtdll -Zstack 32000
LD_OPT = $optimize
+PERL_DLL_BASE = perl$dll_post
+PERL_DLL = \$(PERL_DLL_BASE)\$(DLSUFFIX)
+CONFIG_ARGS = $config_args
+
!GROK!THIS!
$spitshell >>Makefile <<'!NO!SUBS!'
-$(LIBPERL): perl.imp perl.dll perl5.def
+$(LIBPERL): perl.imp $(PERL_DLL) perl5.def
emximp -o $(LIBPERL) perl.imp
-$(AOUT_LIBPERL_DLL): perl.imp perl.dll perl5.def
+$(AOUT_LIBPERL_DLL): perl.imp $(PERL_DLL) perl5.def
emximp -o $(AOUT_LIBPERL_DLL) perl.imp
perl.imp: perl5.def
@@ -37,26 +53,18 @@ perl.imp: perl5.def
echo 'emx_malloc emxlibcm 402 ?' >> $@
echo 'emx_realloc emxlibcm 403 ?' >> $@
-perl.dll: $(obj) perl5.def perl$(OBJ_EXT)
+perl_dll: $(PERL_DLL)
+
+$(PERL_DLL): $(obj) perl5.def perl$(OBJ_EXT)
$(LD) $(LD_OPT) $(LDDLFLAGS) -o $@ perl$(OBJ_EXT) $(obj) $(libs) perl5.def
perl5.def: perl.linkexp
- echo "LIBRARY 'Perl' INITINSTANCE TERMINSTANCE" > $@
- echo DESCRIPTION "'Perl interpreter, export autogenerated'" >>$@
+ echo "LIBRARY '$(PERL_DLL_BASE)' INITINSTANCE TERMINSTANCE" > $@
+ echo DESCRIPTION "'Perl interpreter v$(PERL_VERSION), export autogenerated, built with $(CONFIG_ARGS)'" >>$@
echo STACKSIZE 32768 >>$@
echo CODE LOADONCALL >>$@
echo DATA LOADONCALL NONSHARED MULTIPLE >>$@
echo EXPORTS >>$@
- echo ' "ctermid"' >>$@
- echo ' "get_sysinfo"' >>$@
- echo ' "Perl_OS2_init"' >>$@
- echo ' "OS2_Perl_data"' >>$@
- echo ' "dlopen"' >>$@
- echo ' "dlsym"' >>$@
- echo ' "dlerror"' >>$@
- echo ' "my_tmpfile"' >>$@
- echo ' "my_tmpnam"' >>$@
- echo ' "my_flock"' >>$@
!NO!SUBS!
if [ ! -z "$myttyname" ] ; then
@@ -77,8 +85,8 @@ perl.exports: perl.exp EXTERN.h perl.h
$(CC) -DEMBED -E - | \
awk '{if ($$2 == "") print $$1}' | sort | uniq > $@
-perl.linkexp: perl.exports perl.map
- cat perl.exports perl.map | sort | uniq -d | sed -e 's/\w\+/ "\0"/' > perl.linkexp
+perl.linkexp: perl.exports perl.map os2/os2.sym
+ cat perl.exports os2/os2.sym perl.map | sort | uniq -d | sed -e 's/\w\+/ "\0"/' > perl.linkexp
# We link miniperl statically, since .DLL depends on $(DYNALOADER)
@@ -88,28 +96,39 @@ perl.map miniperl: $(obj) perl$(OBJ_EXT) miniperlmain$(OBJ_EXT)
rm miniperl.map
@./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest
-depend: os2ish.h dlfcn.h
+depend: os2ish.h dlfcn.h os2thread.h os2.c
# Stupid make? Needed...
os2$(OBJ_EXT) : os2.c
os2.c: os2/os2.c os2ish.h
- cp $< $@
+ cp -f $< $@
dl_os2.c: os2/dl_os2.c os2ish.h
- cp $< $@
+ cp -f $< $@
os2ish.h: os2/os2ish.h
- cp $< $@
+ cp -f $< $@
+
+os2thread.h: os2/os2thread.h
+ cp -f $< $@
dlfcn.h: os2/dlfcn.h
- cp $< $@
+ cp -f $< $@
# This one is compiled OMF, so cannot fork():
perl___: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
$(SHRPENV) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl___ perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LIBPERL) `cat ext.libs` $(libs)
+# This one is compiled -Zsys, so cannot do many things:
+
+# Remove -Zcrtdll, add -Zsys
+SYS_CLDFLAGS = -Zexe -Zomf -Zmt -Zsys -Zstack 32000
+
+perl_sys: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
+ $(SHRPENV) $(CC) $(LARGE) $(SYS_CLDFLAGS) $(CCDLFLAGS) -o perl_sys perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LIBPERL) `cat ext.libs` $(libs)
+
installcmd :
perl -e 'die qq{Give the option INSTALLCMDDIR=... to make!} if $$ARGV[0] eq ""' $(INSTALLCMDDIR)
perl os2/perl2cmd.pl $(INSTALLCMDDIR)
@@ -146,8 +165,8 @@ aout_perlmain.c: miniperlmain.c config.sh makefile $(static_ext_autoinit)
sh writemain $(DYNALOADER) $(aout_static_lib) > tmp
sh mv-if-diff tmp aout_perlmain.c
-miniperl_: $& miniperlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) ext.libs
- $(CC) $(LARGE) $(AOUT_CLDFLAGS) $(CCDLFLAGS) -o miniperl_ miniperlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) `cat ext.libs` $(libs)
+miniperl_: $& miniperlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL)
+ $(CC) $(LARGE) $(AOUT_CLDFLAGS) $(CCDLFLAGS) -o miniperl_ miniperlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) $(libs)
perl_: $& aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) $(AOUT_DYNALOADER) $(aout_static_ext) ext.libs
$(CC) $(LARGE) $(AOUT_CLDFLAGS) $(CCDLFLAGS) -o perl_ aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_DYNALOADER) $(aout_static_ext) $(AOUT_LIBPERL) `cat ext.libs` $(libs)
@@ -175,18 +194,55 @@ aout_install.perl: perl_ installperl
aout_test: perl_
- cd t && (rm -f perl_$(EXE_EXT); $(LNS) ../perl_$(EXE_EXT) perl$(EXE_EXT)) && ./perl TEST </dev/tty
-lib/auto/OS2/*/%.a : ext/OS2/%/Makefile.aout
- cd ext/OS2/$(basename $(notdir $@)) ; make -f Makefile.aout config || echo "$make config failed, continuing anyway..."
- cd ext/OS2/$(basename $(notdir $@)) ; make -f Makefile.aout LINKTYPE=static CCCDLFLAGS=
+# To test with harness, set HARNESS_BAD_EXITCODE=2
-lib/auto/*/%.a : ext/%/Makefile.aout
- cd ext/$(basename $(notdir $@)) ; make -f Makefile.aout config || echo "$make config failed, continuing anyway..."
- cd ext/$(basename $(notdir $@)) ; make -f Makefile.aout LINKTYPE=static CCCDLFLAGS=
+sys_test: perl_sys
+ - cd t && (rm -f perl_$(EXE_EXT); $(LNS) ../perl_sys$(EXE_EXT) perl$(EXE_EXT)) && ./perl TEST </dev/tty
+
+sys_harness: perl_sys
+ - cd t && (rm -f perl_$(EXE_EXT); $(LNS) ../perl_sys$(EXE_EXT) perl$(EXE_EXT)) && env HARNESS_BAD_EXITCODE=2 ./perl harness </dev/tty
+
+!NO!SUBS!
+
+# Now we need to find directories in ./ext/ which are two level deep
+
+dirs=''
+preci='ext/%/Makefile.aout '
+for d in ext/*
+do
+ # echo "Checking '$d'..."
+ f="`echo $d/*/Makefile.PL`"
+ # SDBFile/sdbm, skip kid makefile
+ if test ! -e "$d/Makefile.PL" -a ! "$f" = ""; then
+ dirs="$dirs $d"
+ preci="$preci $d/%/Makefile.aout"
+ fi
+done
+
+$spitshell >>Makefile <<!GROK!THIS!
+.PRECIOUS : $preci
+
+!GROK!THIS!
+
+for d in $dirs
+do
+ p=`basename $d`
+ $spitshell >>Makefile <<!GROK!THIS!
+lib/auto/$p/*/%.a : ext/$p/%/Makefile.aout
+ @cd ext/$p/\$(basename \$(notdir \$@)) ; make -f Makefile.aout config || echo "\$(MAKE) config failed, continuing anyway..."
+ cd ext/$p/\$(basename \$(notdir \$@)) ; make -f Makefile.aout LINKTYPE=static CCCDLFLAGS=
-.PRECIOUS : ext/%/Makefile.aout ext/OS2/%/Makefile.aout
+$d/%/Makefile.aout : miniperl_
+ cd \$(dir \$@) ; ../../../miniperl_ -I ../../../lib Makefile.PL MAKEFILE=Makefile.aout INSTALLDIRS=perl
-ext/OS2/%/Makefile.aout : miniperl_
- cd $(dir $@) ; ../../../miniperl_ -I ../../../lib Makefile.PL MAKEFILE=Makefile.aout INSTALLDIRS=perl
+!GROK!THIS!
+
+done
+
+$spitshell >>Makefile <<'!NO!SUBS!'
+lib/auto/*/%.a : ext/%/Makefile.aout
+ @cd ext/$(basename $(notdir $@)) ; make -f Makefile.aout config || echo "\$(MAKE) config failed, continuing anyway..."
+ cd ext/$(basename $(notdir $@)) ; make -f Makefile.aout LINKTYPE=static CCCDLFLAGS=
ext/%/Makefile.aout : miniperl_
cd $(dir $@) ; ../../miniperl_ -I ../../lib Makefile.PL MAKEFILE=Makefile.aout INSTALLDIRS=perl
diff --git a/gnu/usr.bin/perl/os2/OS2/PrfDB/PrfDB.xs b/gnu/usr.bin/perl/os2/OS2/PrfDB/PrfDB.xs
index a5b2c89ca6f..2ba836c1833 100644
--- a/gnu/usr.bin/perl/os2/OS2/PrfDB/PrfDB.xs
+++ b/gnu/usr.bin/perl/os2/OS2/PrfDB/PrfDB.xs
@@ -20,20 +20,20 @@ Prf_Get(HINI hini, PSZ app, PSZ key) {
BOOL rc;
SV *sv;
- if (CheckWinError(PrfQueryProfileSize(hini, app, key, &len))) return &sv_undef;
+ if (CheckWinError(PrfQueryProfileSize(hini, app, key, &len))) return &PL_sv_undef;
sv = newSVpv("", 0);
- SvGROW(sv, len);
+ SvGROW(sv, len + 1);
if (CheckWinError(PrfQueryProfileData(hini, app, key, SvPVX(sv), &len))
|| (len == 0 && (app == NULL || key == NULL))) { /* Somewhy needed. */
SvREFCNT_dec(sv);
- return &sv_undef;
+ return &PL_sv_undef;
}
SvCUR_set(sv, len);
*SvEND(sv) = 0;
return sv;
}
-U32
+I32
Prf_GetLength(HINI hini, PSZ app, PSZ key) {
U32 len;
@@ -59,7 +59,7 @@ Prf_Profiles()
char system[257];
PRFPROFILE info = { 257, user, 257, system};
- if (CheckWinError(PrfQueryProfile(Perl_hab, &info))) return &sv_undef;
+ if (CheckWinError(PrfQueryProfile(Perl_hab, &info))) return &PL_sv_undef;
if (info.cchUserName > 257 || info.cchSysName > 257)
die("Panic: Profile names too long");
av_push(av, newSVpv(user, info.cchUserName - 1));
@@ -110,7 +110,7 @@ Prf_Set(hini, app, key, s, l = (SvPOK(ST(3)) ? SvCUR(ST(3)): -1))
PSZ s;
ULONG l;
-U32
+I32
Prf_GetLength(hini, app, key)
HINI hini;
PSZ app;
diff --git a/gnu/usr.bin/perl/os2/OS2/PrfDB/typemap b/gnu/usr.bin/perl/os2/OS2/PrfDB/typemap
index 0b91f3750a6..eb2722bda52 100644
--- a/gnu/usr.bin/perl/os2/OS2/PrfDB/typemap
+++ b/gnu/usr.bin/perl/os2/OS2/PrfDB/typemap
@@ -7,7 +7,7 @@ PSZ T_PVNULL
#############################################################################
INPUT
T_PVNULL
- $var = ( SvOK($arg) ? ($type)SvPV($arg,na) : NULL )
+ $var = ( SvOK($arg) ? ($type)SvPV($arg,PL_na) : NULL )
#############################################################################
OUTPUT
T_PVNULL
diff --git a/gnu/usr.bin/perl/os2/OS2/Process/Makefile.PL b/gnu/usr.bin/perl/os2/OS2/Process/Makefile.PL
index b7a295f8575..d3240631646 100644
--- a/gnu/usr.bin/perl/os2/OS2/Process/Makefile.PL
+++ b/gnu/usr.bin/perl/os2/OS2/Process/Makefile.PL
@@ -3,9 +3,12 @@ use ExtUtils::MakeMaker;
# the contents of the Makefile that is written.
WriteMakefile(
'NAME' => 'OS2::Process',
- 'VERSION' => '0.1',
+ VERSION_FROM=> 'Process.pm',
MAN3PODS => ' ', # Pods will be built by installman.
'LIBS' => [''], # e.g., '-lm'
'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
'INC' => '', # e.g., '-I/usr/include/other'
+ IMPORTS => { _16_DosSmSetTitle => 'sesmgr.DOSSMSETTITLE',
+ # _16_Win16SetTitle => 'pmshapi.93',
+ },
);
diff --git a/gnu/usr.bin/perl/os2/OS2/Process/Process.pm b/gnu/usr.bin/perl/os2/OS2/Process/Process.pm
index 9216bb1e055..88de2bfad5f 100644
--- a/gnu/usr.bin/perl/os2/OS2/Process/Process.pm
+++ b/gnu/usr.bin/perl/os2/OS2/Process/Process.pm
@@ -1,8 +1,10 @@
package OS2::Process;
+$VERSION = 0.2;
+
require Exporter;
require DynaLoader;
-require AutoLoader;
+#require AutoLoader;
@ISA = qw(Exporter DynaLoader);
# Items to export into callers namespace by default. Note: do not export
@@ -28,6 +30,22 @@ require AutoLoader;
P_UNRELATED
P_WAIT
P_WINDOWED
+ my_type
+ file_type
+ T_NOTSPEC
+ T_NOTWINDOWCOMPAT
+ T_WINDOWCOMPAT
+ T_WINDOWAPI
+ T_BOUND
+ T_DLL
+ T_DOS
+ T_PHYSDRV
+ T_VIRTDRV
+ T_PROTDLL
+ T_32BIT
+ process_entry
+ set_title
+ get_title
);
sub AUTOLOAD {
# This AUTOLOAD is used to 'autoload' constants from the constant()
@@ -56,6 +74,8 @@ bootstrap OS2::Process;
# Preloaded methods go here.
+sub get_title () { (process_entry())[0] }
+
# Autoload methods go after __END__, and are processed by the autosplit program.
1;
@@ -101,9 +121,170 @@ and optionally add PM and session option bits:
P_TILDE = MKS argument passing convention
P_UNRELATED = do not kill child when father terminates
+=head2 Access to process properties
+
+Additionaly, subroutines my_type(), process_entry() and
+C<file_type(file)>, get_title() and C<set_title(newtitle)> are implemented.
+my_type() returns the type of the current process (one of
+"FS", "DOS", "VIO", "PM", "DETACH" and "UNKNOWN"), or C<undef> on error.
+
+=over
+
+=item C<file_type(file)>
+
+returns the type of the executable file C<file>, or
+dies on error. The bits 0-2 of the result contain one of the values
+
+=over
+
+=item C<T_NOTSPEC> (0)
+
+Application type is not specified in the executable header.
+
+=item C<T_NOTWINDOWCOMPAT> (1)
+
+Application type is not-window-compatible.
+
+=item C<T_WINDOWCOMPAT> (2)
+
+Application type is window-compatible.
+
+=item C<T_WINDOWAPI> (3)
+
+Application type is window-API.
+
+=back
+
+The remaining bits should be masked with the following values to
+determine the type of the executable:
+
+=over
+
+=item C<T_BOUND> (8)
+
+Set to 1 if the executable file has been "bound" (by the BIND command)
+as a Family API application. Bits 0, 1, and 2 still apply.
+
+=item C<T_DLL> (0x10)
+
+Set to 1 if the executable file is a dynamic link library (DLL)
+module. Bits 0, 1, 2, 3, and 5 will be set to 0.
+
+=item C<T_DOS> (0x20)
+
+Set to 1 if the executable file is in PC/DOS format. Bits 0, 1, 2, 3,
+and 4 will be set to 0.
+
+=item C<T_PHYSDRV> (0x40)
+
+Set to 1 if the executable file is a physical device driver.
+
+=item C<T_VIRTDRV> (0x80)
+
+Set to 1 if the executable file is a virtual device driver.
+
+=item C<T_PROTDLL> (0x100)
+
+Set to 1 if the executable file is a protected-memory dynamic link
+library module.
+
+=item C<T_32BIT> (0x4000)
+
+Set to 1 for 32-bit executable files.
+
+=back
+
+file_type() may croak with one of the strings C<"Invalid EXE
+signature"> or C<"EXE marked invalid"> to indicate typical error
+conditions. If given non-absolute path, will look on C<PATH>, will
+add extention F<.exe> if no extension is present (add extension F<.>
+to suppress).
+
+=item process_entry()
+
+returns a list of the following data:
+
+=over
+
+=item
+
+Title of the process (in the C<Ctrl-Esc> list);
+
+=item
+
+window handle of switch entry of the process (in the C<Ctrl-Esc> list);
+
+=item
+
+window handle of the icon of the process;
+
+=item
+
+process handle of the owner of the entry in C<Ctrl-Esc> list;
+
+=item
+
+process id of the owner of the entry in C<Ctrl-Esc> list;
+
+=item
+
+session id of the owner of the entry in C<Ctrl-Esc> list;
+
+=item
+
+whether visible in C<Ctrl-Esc> list;
+
+=item
+
+whether item cannot be switched to (note that it is not actually
+grayed in the C<Ctrl-Esc> list));
+
+=item
+
+whether participates in jump sequence;
+
+=item
+
+program type. Possible values are:
+
+ PROG_DEFAULT 0
+ PROG_FULLSCREEN 1
+ PROG_WINDOWABLEVIO 2
+ PROG_PM 3
+ PROG_VDM 4
+ PROG_WINDOWEDVDM 7
+
+Although there are several other program types for WIN-OS/2 programs,
+these do not show up in this field. Instead, the PROG_VDM or
+PROG_WINDOWEDVDM program types are used. For instance, for
+PROG_31_STDSEAMLESSVDM, PROG_WINDOWEDVDM is used. This is because all
+the WIN-OS/2 programs run in DOS sessions. For example, if a program
+is a windowed WIN-OS/2 program, it runs in a PROG_WINDOWEDVDM
+session. Likewise, if it's a full-screen WIN-OS/2 program, it runs in
+a PROG_VDM session.
+
+
+=back
+
+=item C<set_title(newtitle)>
+
+- does not work with some windows (if the title is set from the start).
+This is a limitation of OS/2, in such a case $^E is set to 372 (type
+
+ help 372
+
+for a funny - and wrong - explanation ;-).
+
+=item get_title()
+
+is a shortcut implemented via process_entry().
+
+=back
+
=head1 AUTHOR
-Andreas Kaiser <ak@ananke.s.bawue.de>.
+Andreas Kaiser <ak@ananke.s.bawue.de>,
+Ilya Zakharevich <ilya@math.ohio-state.edu>.
=head1 SEE ALSO
diff --git a/gnu/usr.bin/perl/os2/OS2/Process/Process.xs b/gnu/usr.bin/perl/os2/OS2/Process/Process.xs
index bdb2ece7a08..c16d15d0d0f 100644
--- a/gnu/usr.bin/perl/os2/OS2/Process/Process.xs
+++ b/gnu/usr.bin/perl/os2/OS2/Process/Process.xs
@@ -3,6 +3,9 @@
#include "XSUB.h"
#include <process.h>
+#define INCL_DOS
+#define INCL_DOSERRORS
+#include <os2.h>
static int
not_here(s)
@@ -133,6 +136,73 @@ int arg;
#else
goto not_there;
#endif
+ } else if (name[0] == 'T' && name[1] == '_') {
+ if (strEQ(name, "FAPPTYP_NOTSPEC"))
+#ifdef FAPPTYP_NOTSPEC
+ return FAPPTYP_NOTSPEC;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_NOTWINDOWCOMPAT"))
+#ifdef FAPPTYP_NOTWINDOWCOMPAT
+ return FAPPTYP_NOTWINDOWCOMPAT;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_WINDOWCOMPAT"))
+#ifdef FAPPTYP_WINDOWCOMPAT
+ return FAPPTYP_WINDOWCOMPAT;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_WINDOWAPI"))
+#ifdef FAPPTYP_WINDOWAPI
+ return FAPPTYP_WINDOWAPI;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_BOUND"))
+#ifdef FAPPTYP_BOUND
+ return FAPPTYP_BOUND;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_DLL"))
+#ifdef FAPPTYP_DLL
+ return FAPPTYP_DLL;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_DOS"))
+#ifdef FAPPTYP_DOS
+ return FAPPTYP_DOS;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_PHYSDRV"))
+#ifdef FAPPTYP_PHYSDRV
+ return FAPPTYP_PHYSDRV;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_VIRTDRV"))
+#ifdef FAPPTYP_VIRTDRV
+ return FAPPTYP_VIRTDRV;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_PROTDLL"))
+#ifdef FAPPTYP_PROTDLL
+ return FAPPTYP_PROTDLL;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_32BIT"))
+#ifdef FAPPTYP_32BIT
+ return FAPPTYP_32BIT;
+#else
+ goto not_there;
+#endif
}
errno = EINVAL;
@@ -143,6 +213,138 @@ not_there:
return 0;
}
+const char* const ptypes[] = { "FS", "DOS", "VIO", "PM", "DETACH" };
+
+static char *
+my_type()
+{
+ int rc;
+ TIB *tib;
+ PIB *pib;
+
+ if (!(_emx_env & 0x200)) return (char*)ptypes[1]; /* not OS/2. */
+ if (CheckOSError(DosGetInfoBlocks(&tib, &pib)))
+ return NULL;
+
+ return (pib->pib_ultype <= 4 ? (char*)ptypes[pib->pib_ultype] : "UNKNOWN");
+}
+
+static ULONG
+file_type(char *path)
+{
+ int rc;
+ ULONG apptype;
+
+ if (!(_emx_env & 0x200))
+ croak("file_type not implemented on DOS"); /* not OS/2. */
+ if (CheckOSError(DosQueryAppType(path, &apptype))) {
+ if (rc == ERROR_INVALID_EXE_SIGNATURE)
+ croak("Invalid EXE signature");
+ else if (rc == ERROR_EXE_MARKED_INVALID) {
+ croak("EXE marked invalid");
+ }
+ croak("DosQueryAppType err %ld", rc);
+ }
+
+ return apptype;
+}
+
+static void
+fill_swcntrl(SWCNTRL *swcntrlp)
+{
+ int rc;
+ PTIB ptib;
+ PPIB ppib;
+ HSWITCH hSwitch;
+ HWND hwndMe;
+
+ if (!(_emx_env & 0x200))
+ croak("switch_entry not implemented on DOS"); /* not OS/2. */
+ if (CheckOSError(DosGetInfoBlocks(&ptib, &ppib)))
+ croak("DosGetInfoBlocks err %ld", rc);
+ if (CheckWinError(hSwitch =
+ WinQuerySwitchHandle(NULLHANDLE,
+ (PID)ppib->pib_ulpid)))
+ croak("WinQuerySwitchHandle err %ld", Perl_rc);
+ if (CheckOSError(WinQuerySwitchEntry(hSwitch, swcntrlp)))
+ croak("WinQuerySwitchEntry err %ld", rc);
+}
+
+/* static ULONG (* APIENTRY16 pDosSmSetTitle)(ULONG, PSZ); */
+ULONG _THUNK_FUNCTION(DosSmSetTitle)(ULONG, PSZ);
+
+#if 0 /* Does not work. */
+static ULONG (*pDosSmSetTitle)(ULONG, PSZ);
+
+static void
+set_title(char *s)
+{
+ SWCNTRL swcntrl;
+ static HMODULE hdosc = 0;
+ BYTE buf[20];
+ long rc;
+
+ fill_swcntrl(&swcntrl);
+ if (!pDosSmSetTitle || !hdosc) {
+ if (CheckOSError(DosLoadModule(buf, sizeof buf, "sesmgr", &hdosc)))
+ croak("Cannot load SESMGR: no `%s'", buf);
+ if (CheckOSError(DosQueryProcAddr(hdosc, 0, "DOSSMSETTITLE",
+ (PFN*)&pDosSmSetTitle)))
+ croak("Cannot load SESMGR.DOSSMSETTITLE, err=%ld", rc);
+ }
+/* (pDosSmSetTitle)(swcntrl.idSession,s); */
+ rc = ((USHORT)
+ (_THUNK_PROLOG (2+4);
+ _THUNK_SHORT (swcntrl.idSession);
+ _THUNK_FLAT (s);
+ _THUNK_CALLI (*pDosSmSetTitle)));
+ if (CheckOSError(rc))
+ warn("*DOSSMSETTITLE: err=%ld, ses=%ld, addr=%x, *paddr=%x",
+ rc, swcntrl.idSession, &_THUNK_FUNCTION(DosSmSetTitle),
+ pDosSmSetTitle);
+}
+
+#else /* !0 */
+
+static bool
+set_title(char *s)
+{
+ SWCNTRL swcntrl;
+ static HMODULE hdosc = 0;
+ BYTE buf[20];
+ long rc;
+
+ fill_swcntrl(&swcntrl);
+ rc = ((USHORT)
+ (_THUNK_PROLOG (2+4);
+ _THUNK_SHORT (swcntrl.idSession);
+ _THUNK_FLAT (s);
+ _THUNK_CALL (DosSmSetTitle)));
+#if 0
+ if (CheckOSError(rc))
+ warn("DOSSMSETTITLE: err=%ld, ses=%ld, addr=%x",
+ rc, swcntrl.idSession, _THUNK_FUNCTION(DosSmSetTitle));
+#endif
+ return !CheckOSError(rc);
+}
+#endif /* !0 */
+
+#if 0 /* Does not work. */
+USHORT _THUNK_FUNCTION(Win16SetTitle) ();
+
+static void
+set_title2(char *s)
+{
+ long rc;
+
+ rc = ((USHORT)
+ (_THUNK_PROLOG (4);
+ _THUNK_FLAT (s);
+ _THUNK_CALL (Win16SetTitle)));
+ if (CheckWinError(rc))
+ warn("Win16SetTitle: err=%ld", rc);
+}
+#endif
MODULE = OS2::Process PACKAGE = OS2::Process
@@ -152,3 +354,33 @@ constant(name,arg)
char * name
int arg
+char *
+my_type()
+
+U32
+file_type(path)
+ char *path
+
+U32
+process_entry()
+ PPCODE:
+ {
+ SWCNTRL swcntrl;
+
+ fill_swcntrl(&swcntrl);
+ EXTEND(sp,9);
+ PUSHs(sv_2mortal(newSVpv(swcntrl.szSwtitle, 0)));
+ PUSHs(sv_2mortal(newSVnv(swcntrl.hwnd)));
+ PUSHs(sv_2mortal(newSVnv(swcntrl.hwndIcon)));
+ PUSHs(sv_2mortal(newSViv(swcntrl.hprog)));
+ PUSHs(sv_2mortal(newSViv(swcntrl.idProcess)));
+ PUSHs(sv_2mortal(newSViv(swcntrl.idSession)));
+ PUSHs(sv_2mortal(newSViv(swcntrl.uchVisibility != SWL_INVISIBLE)));
+ PUSHs(sv_2mortal(newSViv(swcntrl.uchVisibility == SWL_GRAYED)));
+ PUSHs(sv_2mortal(newSViv(swcntrl.fbJump == SWL_JUMPABLE)));
+ PUSHs(sv_2mortal(newSViv(swcntrl.bProgType)));
+ }
+
+bool
+set_title(s)
+ char *s
diff --git a/gnu/usr.bin/perl/os2/OS2/REXX/REXX.xs b/gnu/usr.bin/perl/os2/OS2/REXX/REXX.xs
index df7646c42e7..60266f4f16f 100644
--- a/gnu/usr.bin/perl/os2/OS2/REXX/REXX.xs
+++ b/gnu/usr.bin/perl/os2/OS2/REXX/REXX.xs
@@ -46,6 +46,7 @@ static long incompartment;
static SV*
exec_in_REXX(char *cmd, char * handlerName, RexxFunctionHandler *handler)
{
+ dTHR;
HMODULE hRexx, hRexxAPI;
BYTE buf[200];
LONG APIENTRY (*pRexxStart) (LONG, PRXSTRING, PSZ, PRXSTRING,
@@ -93,9 +94,10 @@ exec_in_REXX(char *cmd, char * handlerName, RexxFunctionHandler *handler)
} else {
res = NEWSV(729,0);
}
- if (rc || SvTRUE(GvSV(errgv))) {
- if (SvTRUE(GvSV(errgv))) {
- die ("Error inside perl function called from REXX compartment.\n%s", SvPV(GvSV(errgv), na)) ;
+ if (rc || SvTRUE(GvSV(PL_errgv))) {
+ if (SvTRUE(GvSV(PL_errgv))) {
+ STRLEN n_a;
+ die ("Error inside perl function called from REXX compartment.\n%s", SvPV(GvSV(PL_errgv), n_a)) ;
}
die ("REXX compartment returned non-zero status %li", rc);
}
@@ -132,7 +134,7 @@ PERLCALL(PSZ name, ULONG argc, PRXSTRING argv, PSZ queue, PRXSTRING ret)
ENTER;
SAVETMPS;
- PUSHMARK(sp);
+ PUSHMARK(SP);
#if 0
if (!my_perl) {
@@ -338,7 +340,7 @@ _fetch(name, ...)
{
int i;
ULONG rc;
- EXTEND(sp, items);
+ EXTEND(SP, items);
needvars(items);
if (trace)
fprintf(stderr, "REXXCALL::_fetch");
@@ -373,7 +375,7 @@ _fetch(name, ...)
var->shvname.strlength, var->shvname.strptr,
namelen, var->shvvalue.strptr);
if (var->shvret & RXSHV_NEWV || !var->shvvalue.strptr)
- PUSHs(&sv_undef);
+ PUSHs(&PL_sv_undef);
else
PUSHs(sv_2mortal(newSVpv(var->shvvalue.strptr,
namelen)));
@@ -409,7 +411,7 @@ _next(stem)
rc = RexxVariablePool(&sv);
} while (!rc && memcmp(stem, sv.shvname.strptr, len) != 0);
if (!rc) {
- EXTEND(sp, 2);
+ EXTEND(SP, 2);
/* returned lengths appear to be swapped */
/* but beware of "future bug fixes" */
namelen = sv.shvname.strlength; /* should be */
@@ -427,7 +429,7 @@ _next(stem)
PUSHs(sv_2mortal(newSVpv(sv.shvvalue.strptr, valuelen)));
DosFreeMem(sv.shvvalue.strptr);
} else
- PUSHs(&sv_undef);
+ PUSHs(&PL_sv_undef);
} else if (rc != RXSHV_LVAR) {
die("Error %i when in _next", rc);
} else {
diff --git a/gnu/usr.bin/perl/os2/diff.configure b/gnu/usr.bin/perl/os2/diff.configure
index 9f42dc139fe..62cf1d20315 100644
--- a/gnu/usr.bin/perl/os2/diff.configure
+++ b/gnu/usr.bin/perl/os2/diff.configure
@@ -1,6 +1,6 @@
---- Configure.orig Fri Aug 1 23:12:26 1997
-+++ Configure Fri Aug 1 23:20:24 1997
-@@ -1489,7 +1489,7 @@
+--- Configure Wed Feb 25 16:52:55 1998
++++ Configure.os2 Wed Feb 25 16:52:58 1998
+@@ -1602,7 +1602,7 @@
*)
echo "I don't know where '$file' is, and my life depends on it." >&4
echo "Go find a public domain implementation or fix your PATH setting!" >&4
@@ -9,18 +9,7 @@
;;
esac
done
-@@ -1498,7 +1498,9 @@
- say=offhand
- for file in $trylist; do
- xxx=`./loc $file $file $pth`
-- eval $file=$xxx
-+ if test "X$file" != "X$xxx" ; then
-+ eval $file=$xxx
-+ fi
- eval _$file=$xxx
- case "$xxx" in
- /*)
-@@ -3198,7 +3200,7 @@
+@@ -3637,7 +3637,7 @@
exit(0);
}
EOM
@@ -29,20 +18,7 @@
gccversion=`./gccvers`
case "$gccversion" in
'') echo "You are not using GNU cc." ;;
-@@ -3401,6 +3403,12 @@
- *"-l$thislib "*);;
- *) dflt="$dflt -l$thislib";;
- esac
-+ elif xxx=`./loc $thislib.lib X $libpth`; $test -f "$xxx"; then
-+ echo "Found -l$thislib."
-+ case " $dflt " in
-+ *"-l$thislib "*);;
-+ *) dflt="$dflt -l$thislib";;
-+ esac
- else
- echo "No -l$thislib."
- fi
-@@ -3950,7 +3958,7 @@
+@@ -4434,7 +4434,7 @@
esac
;;
esac
@@ -51,224 +27,3 @@
case "$libs" in
'') ;;
*) for thislib in $libs; do
-@@ -3972,6 +3980,8 @@
- :
- elif try=`./loc $thislib X $libpth`; $test -f "$try"; then
- :
-+ elif try=`./loc $thislib$lib_ext X $libpth`; $test -f "$try"; then
-+ :
- elif try=`./loc Slib$thislib$lib_ext X $xlibpth`; $test -f "$try"; then
- :
- else
-@@ -4156,6 +4166,10 @@
- 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
- else
- nm -p $* 2>/dev/null >libc.tmp
- $grep fprintf libc.tmp > libc.ptf
-@@ -4166,23 +4180,33 @@
- eval $xrun
- else
- echo " "
-- echo "nm didn't seem to work right. Trying ar instead..." >&4
-+ echo "nm didn't seem to work right. Trying $ar instead..." >&4
- com=''
-- if ar t $libc > libc.tmp; then
-- for thisname in $libnames; do
-- ar t $thisname >>libc.tmp
-+ if test "X$osname" = "Xos2"; then ar_opt=tv ; else ar_opt=t ;fi
-+ if $ar $ar_opt $libc > libc.tmp; then
-+ echo \; > libc.tmp
-+ for thisname in $libnames $libc; do
-+ $ar $ar_opt $thisname >>libc.tmp
-+ if test "X$osname" = "Xos2"; then
-+ # Revision 50 of EMX has bug in $ar:
-+ emximp -o tmp.imp $thisname \
-+ 2>/dev/null && \
-+ $sed -e 's/^\([_a-zA-Z0-9]*\) .*$/\1/p' \
-+ < tmp.imp >>libc.tmp
-+ $rm tmp.imp
-+ fi
- done
-- $sed -e 's/\.o$//' < libc.tmp > libc.list
-+ $sed -e 's/\.o$//' -e 's/^ \+//' < libc.tmp | grep -v "^IMPORT#" > libc.list
- echo "Ok." >&4
- else
-- echo "ar didn't seem to work right." >&4
-+ 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
-+ $ar t $thisname >>libc.tmp
- done
- echo "Ok." >&4
- else
-@@ -5611,15 +5635,15 @@
- EOCP
- : check sys/file.h first, no particular reason here
- if $test `./findhdr sys/file.h` && \
-- $cc $cppflags -DI_SYS_FILE access.c -o access >/dev/null 2>&1 ; then
-+ $cc $ldflags $cppflags -DI_SYS_FILE access.c -o access >/dev/null 2>&1 ; then
- h_sysfile=true;
- echo "<sys/file.h> defines the *_OK access constants." >&4
- elif $test `./findhdr fcntl.h` && \
-- $cc $cppflags -DI_FCNTL access.c -o access >/dev/null 2>&1 ; then
-+ $cc $ldflags $cppflags -DI_FCNTL access.c -o access >/dev/null 2>&1 ; then
- h_fcntl=true;
- echo "<fcntl.h> defines the *_OK access constants." >&4
- elif $test `./findhdr unistd.h` && \
-- $cc $cppflags -DI_UNISTD access.c -o access >/dev/null 2>&1 ; then
-+ $cc $ldflags $cppflags -DI_UNISTD access.c -o access >/dev/null 2>&1 ; then
- echo "<unistd.h> defines the *_OK access constants." >&4
- else
- echo "I can't find the four *_OK access constants--I'll use mine." >&4
-@@ -5913,7 +5937,7 @@
- exit(result);
- }
- EOCP
--if $cc -o try $ccflags try.c >/dev/null 2>&1; then
-+if $cc -o try $ccflags try.c $ldflags >/dev/null 2>&1; then
- ./try
- yyy=$?
- else
-@@ -5994,7 +6018,7 @@
-
- }
- EOCP
--if $cc -o try $ccflags try.c >/dev/null 2>&1; then
-+if $cc -o try $ccflags try.c $ldflags >/dev/null 2>&1; then
- ./try
- castflags=$?
- else
-@@ -6033,7 +6057,7 @@
- exit((unsigned long)vsprintf(buf,"%s",args) > 10L);
- }
- EOF
-- if $cc $ccflags vprintf.c -o vprintf >/dev/null 2>&1 && ./vprintf; then
-+ if $cc $ccflags vprintf.c $ldflags -o vprintf >/dev/null 2>&1 && ./vprintf; then
- echo "Your vsprintf() returns (int)." >&4
- val2="$undef"
- else
-@@ -6381,7 +6405,7 @@
- EOCP
- : check sys/file.h first to get FREAD on Sun
- if $test `./findhdr sys/file.h` && \
-- $cc $ccflags "-DI_SYS_FILE" -o open3 $ldflags open3.c $libs >/dev/null 2>&1 ; then
-+ $cc $ldflags $ccflags "-DI_SYS_FILE" -o open3 $ldflags open3.c $libs >/dev/null 2>&1 ; then
- h_sysfile=true;
- echo "<sys/file.h> defines the O_* constants..." >&4
- if ./open3; then
-@@ -6392,7 +6416,7 @@
- val="$undef"
- fi
- elif $test `./findhdr fcntl.h` && \
-- $cc $ccflags "-DI_FCNTL" -o open3 $ldflags open3.c $libs >/dev/null 2>&1 ; then
-+ $cc $ldflags $ccflags "-DI_FCNTL" -o open3 $ldflags open3.c $libs >/dev/null 2>&1 ; then
- h_fcntl=true;
- echo "<fcntl.h> defines the O_* constants..." >&4
- if ./open3; then
-@@ -6898,7 +6922,7 @@
- y*|true)
- usemymalloc='y'
- mallocsrc='malloc.c'
-- mallocobj='malloc.o'
-+ mallocobj="malloc$obj_ext"
- d_mymalloc="$define"
- case "$libs" in
- *-lmalloc*)
-@@ -8156,7 +8180,7 @@
- printf("%d\n", (char *)&try.bar - (char *)&try.foo);
- }
- EOCP
-- if $cc $ccflags try.c -o try >/dev/null 2>&1; then
-+ if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1; then
- dflt=`./try`
- else
- dflt='8'
-@@ -8204,7 +8228,7 @@
- }
- EOCP
- xxx_prompt=y
-- if $cc $ccflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
-+ if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
- dflt=`./try`
- case "$dflt" in
- [1-4][1-4][1-4][1-4]|12345678|87654321)
-@@ -8711,18 +8735,18 @@
- $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$lib_ext bar2.o bar1.o >/dev/null 2>&1
-+$ar rc bar$lib_ext bar2.o bar1.o >/dev/null 2>&1
- if $cc $ccflags $ldflags -o foobar foo.o bar$lib_ext $libs > /dev/null 2>&1 &&
- ./foobar >/dev/null 2>&1; then
-- echo "ar appears to generate random libraries itself."
-+ echo "$ar appears to generate random libraries itself."
- orderlib=false
- ranlib=":"
--elif ar ts bar$lib_ext >/dev/null 2>&1 &&
-+elif $ar ts bar$lib_ext >/dev/null 2>&1 &&
- $cc $ccflags $ldflags -o foobar foo.o bar$lib_ext $libs > /dev/null 2>&1 &&
- ./foobar >/dev/null 2>&1; then
-- echo "a table of contents needs to be added with 'ar ts'."
-+ echo "a table of contents needs to be added with '$ar ts'."
- orderlib=false
-- ranlib="ar ts"
-+ ranlib="$ar ts"
- else
- case "$ranlib" in
- :) ranlib='';;
-@@ -8794,7 +8818,7 @@
- '') $echo $n ".$c"
- if $cc $ccflags \
- $i_time $i_systime $i_systimek $sysselect $s_timeval $s_timezone \
-- try.c -o try >/dev/null 2>&1 ; then
-+ try.c -o try $ldflags >/dev/null 2>&1 ; then
- set X $i_time $i_systime $i_systimek $sysselect $s_timeval
- shift
- flags="$*"
-@@ -8863,7 +8887,7 @@
- #endif
- }
- EOCP
--if $cc $ccflags -DTRYBITS fd_set.c -o fd_set >fd_set.out 2>&1 ; then
-+if $cc $ccflags $ldflags -DTRYBITS fd_set.c -o fd_set >fd_set.out 2>&1 ; then
- d_fds_bits="$define"
- d_fd_set="$define"
- echo "Well, your system knows about the normal fd_set typedef..." >&4
-@@ -8880,7 +8904,7 @@
- $cat <<'EOM'
- Hmm, your compiler has some difficulty with fd_set. Checking further...
- EOM
-- if $cc $ccflags fd_set.c -o fd_set >fd_set.out 2>&1 ; then
-+ if $cc $ccflags $ldflags fd_set.c -o fd_set >fd_set.out 2>&1 ; then
- d_fds_bits="$undef"
- d_fd_set="$define"
- echo "Well, your system has some sort of fd_set available..." >&4
-@@ -9627,7 +9651,7 @@
- else
- echo "false"
- fi
--$rm -f varargs.o
-+$rm -f varargs$obj_ext
- EOP
- chmod +x varargs
-
-@@ -9954,7 +9978,7 @@
- echo " "
- echo "Stripping down executable paths..." >&4
- for file in $loclist $trylist; do
-- eval $file="\$file"
-+ if test X$file != Xln -o X$osname != Xos2; then eval $file="\$file"; fi
- done
- ;;
- esac
diff --git a/gnu/usr.bin/perl/os2/os2.c b/gnu/usr.bin/perl/os2/os2.c
index 8a292e30f25..28751ffa888 100644
--- a/gnu/usr.bin/perl/os2/os2.c
+++ b/gnu/usr.bin/perl/os2/os2.c
@@ -5,6 +5,8 @@
#define INCL_DOSERRORS
#include <os2.h>
+#include <sys/uflags.h>
+
/*
* Various Unix compatibility functions for OS/2
*/
@@ -18,6 +20,161 @@
#include "EXTERN.h"
#include "perl.h"
+#ifdef USE_THREADS
+
+typedef void (*emx_startroutine)(void *);
+typedef void* (*pthreads_startroutine)(void *);
+
+enum pthreads_state {
+ pthreads_st_none = 0,
+ pthreads_st_run,
+ pthreads_st_exited,
+ pthreads_st_detached,
+ pthreads_st_waited,
+};
+const char *pthreads_states[] = {
+ "uninit",
+ "running",
+ "exited",
+ "detached",
+ "waited for",
+};
+
+typedef struct {
+ void *status;
+ perl_cond cond;
+ enum pthreads_state state;
+} thread_join_t;
+
+thread_join_t *thread_join_data;
+int thread_join_count;
+perl_mutex start_thread_mutex;
+
+int
+pthread_join(perl_os_thread tid, void **status)
+{
+ MUTEX_LOCK(&start_thread_mutex);
+ switch (thread_join_data[tid].state) {
+ case pthreads_st_exited:
+ thread_join_data[tid].state = pthreads_st_none; /* Ready to reuse */
+ MUTEX_UNLOCK(&start_thread_mutex);
+ *status = thread_join_data[tid].status;
+ break;
+ case pthreads_st_waited:
+ MUTEX_UNLOCK(&start_thread_mutex);
+ croak("join with a thread with a waiter");
+ break;
+ case pthreads_st_run:
+ thread_join_data[tid].state = pthreads_st_waited;
+ COND_INIT(&thread_join_data[tid].cond);
+ MUTEX_UNLOCK(&start_thread_mutex);
+ COND_WAIT(&thread_join_data[tid].cond, NULL);
+ COND_DESTROY(&thread_join_data[tid].cond);
+ thread_join_data[tid].state = pthreads_st_none; /* Ready to reuse */
+ *status = thread_join_data[tid].status;
+ break;
+ default:
+ MUTEX_UNLOCK(&start_thread_mutex);
+ croak("join: unknown thread state: '%s'",
+ pthreads_states[thread_join_data[tid].state]);
+ break;
+ }
+ return 0;
+}
+
+void
+pthread_startit(void *arg)
+{
+ /* Thread is already started, we need to transfer control only */
+ pthreads_startroutine start_routine = *((pthreads_startroutine*)arg);
+ int tid = pthread_self();
+ void *retval;
+
+ arg = ((void**)arg)[1];
+ if (tid >= thread_join_count) {
+ int oc = thread_join_count;
+
+ thread_join_count = tid + 5 + tid/5;
+ if (thread_join_data) {
+ Renew(thread_join_data, thread_join_count, thread_join_t);
+ Zero(thread_join_data + oc, thread_join_count - oc, thread_join_t);
+ } else {
+ Newz(1323, thread_join_data, thread_join_count, thread_join_t);
+ }
+ }
+ if (thread_join_data[tid].state != pthreads_st_none)
+ croak("attempt to reuse thread id %i", tid);
+ thread_join_data[tid].state = pthreads_st_run;
+ /* Now that we copied/updated the guys, we may release the caller... */
+ MUTEX_UNLOCK(&start_thread_mutex);
+ thread_join_data[tid].status = (*start_routine)(arg);
+ switch (thread_join_data[tid].state) {
+ case pthreads_st_waited:
+ COND_SIGNAL(&thread_join_data[tid].cond);
+ break;
+ default:
+ thread_join_data[tid].state = pthreads_st_exited;
+ break;
+ }
+}
+
+int
+pthread_create(perl_os_thread *tid, const pthread_attr_t *attr,
+ void *(*start_routine)(void*), void *arg)
+{
+ void *args[2];
+
+ args[0] = (void*)start_routine;
+ args[1] = arg;
+
+ MUTEX_LOCK(&start_thread_mutex);
+ *tid = _beginthread(pthread_startit, /*stack*/ NULL,
+ /*stacksize*/ 10*1024*1024, (void*)args);
+ MUTEX_LOCK(&start_thread_mutex);
+ MUTEX_UNLOCK(&start_thread_mutex);
+ return *tid ? 0 : EINVAL;
+}
+
+int
+pthread_detach(perl_os_thread tid)
+{
+ MUTEX_LOCK(&start_thread_mutex);
+ switch (thread_join_data[tid].state) {
+ case pthreads_st_waited:
+ MUTEX_UNLOCK(&start_thread_mutex);
+ croak("detach on a thread with a waiter");
+ break;
+ case pthreads_st_run:
+ thread_join_data[tid].state = pthreads_st_detached;
+ MUTEX_UNLOCK(&start_thread_mutex);
+ break;
+ default:
+ MUTEX_UNLOCK(&start_thread_mutex);
+ croak("detach: unknown thread state: '%s'",
+ pthreads_states[thread_join_data[tid].state]);
+ break;
+ }
+ return 0;
+}
+
+/* This is a very bastardized version: */
+int
+os2_cond_wait(perl_cond *c, perl_mutex *m)
+{
+ int rc;
+ STRLEN n_a;
+ if ((rc = DosResetEventSem(*c,&n_a)) && (rc != ERROR_ALREADY_RESET))
+ croak("panic: COND_WAIT-reset: rc=%i", rc);
+ if (m) MUTEX_UNLOCK(m);
+ if (CheckOSError(DosWaitEventSem(*c,SEM_INDEFINITE_WAIT))
+ && (rc != ERROR_INTERRUPT))
+ croak("panic: COND_WAIT: rc=%i", rc);
+ if (rc == ERROR_INTERRUPT)
+ errno = EINTR;
+ if (m) MUTEX_LOCK(m);
+}
+#endif
+
/*****************************************************************************/
/* 2.1 would not resolve symbols on demand, and has no ExtLIBPATH. */
static PFN ExtFCN[2]; /* Labeled by ord below. */
@@ -156,7 +313,28 @@ getpriority(int which /* ignored */, int pid)
/*****************************************************************************/
/* spawn */
-typedef void (*Sigfunc) _((int));
+
+/* There is no big sense to make it thread-specific, since signals
+ are delivered to thread 1 only. XXXX Maybe make it into an array? */
+static int spawn_pid;
+static int spawn_killed;
+
+static Signal_t
+spawn_sighandler(int sig)
+{
+ /* Some programs do not arrange for the keyboard signals to be
+ delivered to them. We need to deliver the signal manually. */
+ /* We may get a signal only if
+ a) kid does not receive keyboard signal: deliver it;
+ b) kid already died, and we get a signal. We may only hope
+ that the pid number was not reused.
+ */
+
+ if (spawn_killed)
+ sig = SIGKILL; /* Try harder. */
+ kill(spawn_pid, sig);
+ spawn_killed = 1;
+}
static int
result(int flag, int pid)
@@ -173,15 +351,17 @@ result(int flag, int pid)
return pid;
#ifdef __EMX__
- ihand = rsignal(SIGINT, SIG_IGN);
- qhand = rsignal(SIGQUIT, SIG_IGN);
+ spawn_pid = pid;
+ spawn_killed = 0;
+ ihand = rsignal(SIGINT, &spawn_sighandler);
+ qhand = rsignal(SIGQUIT, &spawn_sighandler);
do {
r = wait4pid(pid, &status, 0);
} while (r == -1 && errno == EINTR);
rsignal(SIGINT, ihand);
rsignal(SIGQUIT, qhand);
- statusvalue = (U16)status;
+ PL_statusvalue = (U16)status;
if (r < 0)
return -1;
return status & 0xFFFF;
@@ -189,27 +369,406 @@ result(int flag, int pid)
ihand = rsignal(SIGINT, SIG_IGN);
r = DosWaitChild(DCWA_PROCESS, DCWW_WAIT, &res, &rpid, pid);
rsignal(SIGINT, ihand);
- statusvalue = res.codeResult << 8 | res.codeTerminate;
+ PL_statusvalue = res.codeResult << 8 | res.codeTerminate;
if (r)
return -1;
- return statusvalue;
+ return PL_statusvalue;
#endif
}
+#define EXECF_SPAWN 0
+#define EXECF_EXEC 1
+#define EXECF_TRUEEXEC 2
+#define EXECF_SPAWN_NOWAIT 3
+
+/* const char* const ptypes[] = { "FS", "DOS", "VIO", "PM", "DETACH" }; */
+
+static int
+my_type()
+{
+ int rc;
+ TIB *tib;
+ PIB *pib;
+
+ if (!(_emx_env & 0x200)) return 1; /* not OS/2. */
+ if (CheckOSError(DosGetInfoBlocks(&tib, &pib)))
+ return -1;
+
+ return (pib->pib_ultype);
+}
+
+static ULONG
+file_type(char *path)
+{
+ int rc;
+ ULONG apptype;
+
+ if (!(_emx_env & 0x200))
+ croak("file_type not implemented on DOS"); /* not OS/2. */
+ if (CheckOSError(DosQueryAppType(path, &apptype))) {
+ switch (rc) {
+ case ERROR_FILE_NOT_FOUND:
+ case ERROR_PATH_NOT_FOUND:
+ return -1;
+ case ERROR_ACCESS_DENIED: /* Directory with this name found? */
+ return -3;
+ default: /* Found, but not an
+ executable, or some other
+ read error. */
+ return -2;
+ }
+ }
+ return apptype;
+}
+
+static ULONG os2_mytype;
+
+/* Spawn/exec a program, revert to shell if needed. */
+/* global PL_Argv[] contains arguments. */
+
+int
+do_spawn_ve(really, flag, execf, inicmd)
+SV *really;
+U32 flag;
+U32 execf;
+char *inicmd;
+{
+ dTHR;
+ int trueflag = flag;
+ int rc, pass = 1;
+ char *tmps;
+ char buf[256], *s = 0, scrbuf[280];
+ char *args[4];
+ static char * fargs[4]
+ = { "/bin/sh", "-c", "\"$@\"", "spawn-via-shell", };
+ char **argsp = fargs;
+ char nargs = 4;
+ int force_shell;
+ STRLEN n_a;
+
+ if (flag == P_WAIT)
+ flag = P_NOWAIT;
+
+ retry:
+ if (strEQ(PL_Argv[0],"/bin/sh"))
+ PL_Argv[0] = PL_sh_path;
+
+ if (PL_Argv[0][0] != '/' && PL_Argv[0][0] != '\\'
+ && !(PL_Argv[0][0] && PL_Argv[0][1] == ':'
+ && (PL_Argv[0][2] == '/' || PL_Argv[0][2] != '\\'))
+ ) /* will spawnvp use PATH? */
+ TAINT_ENV(); /* testing IFS here is overkill, probably */
+ /* We should check PERL_SH* and PERLLIB_* as well? */
+ if (!really || !*(tmps = SvPV(really, n_a)))
+ tmps = PL_Argv[0];
+
+ reread:
+ force_shell = 0;
+ if (_emx_env & 0x200) { /* OS/2. */
+ int type = file_type(tmps);
+ type_again:
+ if (type == -1) { /* Not found */
+ errno = ENOENT;
+ rc = -1;
+ goto do_script;
+ }
+ else if (type == -2) { /* Not an EXE */
+ errno = ENOEXEC;
+ rc = -1;
+ goto do_script;
+ }
+ else if (type == -3) { /* Is a directory? */
+ /* Special-case this */
+ char tbuf[512];
+ int l = strlen(tmps);
+
+ if (l + 5 <= sizeof tbuf) {
+ strcpy(tbuf, tmps);
+ strcpy(tbuf + l, ".exe");
+ type = file_type(tbuf);
+ if (type >= -3)
+ goto type_again;
+ }
+
+ errno = ENOEXEC;
+ rc = -1;
+ goto do_script;
+ }
+ switch (type & 7) {
+ /* Ignore WINDOWCOMPAT and FAPI, start them the same type we are. */
+ case FAPPTYP_WINDOWAPI:
+ {
+ if (os2_mytype != 3) { /* not PM */
+ if (flag == P_NOWAIT)
+ flag = P_PM;
+ else if ((flag & 7) != P_PM && (flag & 7) != P_SESSION)
+ warn("Starting PM process with flag=%d, mytype=%d",
+ flag, os2_mytype);
+ }
+ }
+ break;
+ case FAPPTYP_NOTWINDOWCOMPAT:
+ {
+ if (os2_mytype != 0) { /* not full screen */
+ if (flag == P_NOWAIT)
+ flag = P_SESSION;
+ else if ((flag & 7) != P_SESSION)
+ warn("Starting Full Screen process with flag=%d, mytype=%d",
+ flag, os2_mytype);
+ }
+ }
+ break;
+ case FAPPTYP_NOTSPEC:
+ /* Let the shell handle this... */
+ force_shell = 1;
+ goto doshell_args;
+ break;
+ }
+ }
+
+#if 0
+ rc = result(trueflag, spawnvp(flag,tmps,PL_Argv));
+#else
+ if (execf == EXECF_TRUEEXEC)
+ rc = execvp(tmps,PL_Argv);
+ else if (execf == EXECF_EXEC)
+ rc = spawnvp(trueflag | P_OVERLAY,tmps,PL_Argv);
+ else if (execf == EXECF_SPAWN_NOWAIT)
+ rc = spawnvp(flag,tmps,PL_Argv);
+ else /* EXECF_SPAWN */
+ rc = result(trueflag,
+ spawnvp(flag,tmps,PL_Argv));
+#endif
+ if (rc < 0 && pass == 1
+ && (tmps == PL_Argv[0])) { /* Cannot transfer `really' via shell. */
+ do_script:
+ {
+ int err = errno;
+
+ if (err == ENOENT || err == ENOEXEC) {
+ /* No such file, or is a script. */
+ /* Try adding script extensions to the file name, and
+ search on PATH. */
+ char *scr = find_script(PL_Argv[0], TRUE, NULL, 0);
+
+ if (scr) {
+ FILE *file;
+ char *s = 0, *s1;
+ int l;
+
+ l = strlen(scr);
+
+ if (l >= sizeof scrbuf) {
+ Safefree(scr);
+ longbuf:
+ croak("Size of scriptname too big: %d", l);
+ }
+ strcpy(scrbuf, scr);
+ Safefree(scr);
+ scr = scrbuf;
+
+ file = fopen(scr, "r");
+ PL_Argv[0] = scr;
+ if (!file)
+ goto panic_file;
+ if (!fgets(buf, sizeof buf, file)) { /* Empty... */
+
+ buf[0] = 0;
+ fclose(file);
+ /* Special case: maybe from -Zexe build, so
+ there is an executable around (contrary to
+ documentation, DosQueryAppType sometimes (?)
+ does not append ".exe", so we could have
+ reached this place). */
+ if (l + 5 < sizeof scrbuf) {
+ strcpy(scrbuf + l, ".exe");
+ if (PerlLIO_stat(scrbuf,&PL_statbuf) >= 0
+ && !S_ISDIR(PL_statbuf.st_mode)) {
+ /* Found */
+ tmps = scr;
+ pass++;
+ goto reread;
+ } else
+ scrbuf[l] = 0;
+ } else
+ goto longbuf;
+ }
+ if (fclose(file) != 0) { /* Failure */
+ panic_file:
+ warn("Error reading \"%s\": %s",
+ scr, Strerror(errno));
+ buf[0] = 0; /* Not #! */
+ goto doshell_args;
+ }
+ if (buf[0] == '#') {
+ if (buf[1] == '!')
+ s = buf + 2;
+ } else if (buf[0] == 'e') {
+ if (strnEQ(buf, "extproc", 7)
+ && isSPACE(buf[7]))
+ s = buf + 8;
+ } else if (buf[0] == 'E') {
+ if (strnEQ(buf, "EXTPROC", 7)
+ && isSPACE(buf[7]))
+ s = buf + 8;
+ }
+ if (!s) {
+ buf[0] = 0; /* Not #! */
+ goto doshell_args;
+ }
+
+ s1 = s;
+ nargs = 0;
+ argsp = args;
+ while (1) {
+ /* Do better than pdksh: allow a few args,
+ strip trailing whitespace. */
+ while (isSPACE(*s))
+ s++;
+ if (*s == 0)
+ break;
+ if (nargs == 4) {
+ nargs = -1;
+ break;
+ }
+ args[nargs++] = s;
+ while (*s && !isSPACE(*s))
+ s++;
+ if (*s == 0)
+ break;
+ *s++ = 0;
+ }
+ if (nargs == -1) {
+ warn("Too many args on %.*s line of \"%s\"",
+ s1 - buf, buf, scr);
+ nargs = 4;
+ argsp = fargs;
+ }
+ doshell_args:
+ {
+ char **a = PL_Argv;
+ char *exec_args[2];
+
+ if (force_shell
+ || (!buf[0] && file)) { /* File without magic */
+ /* In fact we tried all what pdksh would
+ try. There is no point in calling
+ pdksh, we may just emulate its logic. */
+ char *shell = getenv("EXECSHELL");
+ char *shell_opt = NULL;
+
+ if (!shell) {
+ char *s;
+
+ shell_opt = "/c";
+ shell = getenv("OS2_SHELL");
+ if (inicmd) { /* No spaces at start! */
+ s = inicmd;
+ while (*s && !isSPACE(*s)) {
+ if (*s++ = '/') {
+ inicmd = NULL; /* Cannot use */
+ break;
+ }
+ }
+ }
+ if (!inicmd) {
+ s = PL_Argv[0];
+ while (*s) {
+ /* Dosish shells will choke on slashes
+ in paths, fortunately, this is
+ important for zeroth arg only. */
+ if (*s == '/')
+ *s = '\\';
+ s++;
+ }
+ }
+ }
+ /* If EXECSHELL is set, we do not set */
+
+ if (!shell)
+ shell = ((_emx_env & 0x200)
+ ? "c:/os2/cmd.exe"
+ : "c:/command.com");
+ nargs = shell_opt ? 2 : 1; /* shell file args */
+ exec_args[0] = shell;
+ exec_args[1] = shell_opt;
+ argsp = exec_args;
+ if (nargs == 2 && inicmd) {
+ /* Use the original cmd line */
+ /* XXXX This is good only until we refuse
+ quoted arguments... */
+ PL_Argv[0] = inicmd;
+ PL_Argv[1] = Nullch;
+ }
+ } else if (!buf[0] && inicmd) { /* No file */
+ /* Start with the original cmdline. */
+ /* XXXX This is good only until we refuse
+ quoted arguments... */
+
+ PL_Argv[0] = inicmd;
+ PL_Argv[1] = Nullch;
+ nargs = 2; /* shell -c */
+ }
+
+ while (a[1]) /* Get to the end */
+ a++;
+ a++; /* Copy finil NULL too */
+ while (a >= PL_Argv) {
+ *(a + nargs) = *a; /* PL_Argv was preallocated to be
+ long enough. */
+ a--;
+ }
+ while (nargs-- >= 0)
+ PL_Argv[nargs] = argsp[nargs];
+ /* Enable pathless exec if #! (as pdksh). */
+ pass = (buf[0] == '#' ? 2 : 3);
+ goto retry;
+ }
+ }
+ /* Not found: restore errno */
+ errno = err;
+ }
+ }
+ } else if (rc < 0 && pass == 2 && errno == ENOENT) { /* File not found */
+ char *no_dir = strrchr(PL_Argv[0], '/');
+
+ /* Do as pdksh port does: if not found with /, try without
+ path. */
+ if (no_dir) {
+ PL_Argv[0] = no_dir + 1;
+ pass++;
+ goto retry;
+ }
+ }
+ if (rc < 0 && PL_dowarn)
+ warn("Can't %s \"%s\": %s\n",
+ ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC)
+ ? "spawn" : "exec"),
+ PL_Argv[0], Strerror(errno));
+ if (rc < 0 && (execf != EXECF_SPAWN_NOWAIT)
+ && ((trueflag & 0xFF) == P_WAIT))
+ rc = 255 << 8; /* Emulate the fork(). */
+
+ return rc;
+}
+
+/* Array spawn. */
int
do_aspawn(really,mark,sp)
SV *really;
register SV **mark;
register SV **sp;
{
+ dTHR;
register char **a;
char *tmps = NULL;
int rc;
int flag = P_WAIT, trueflag, err, secondtry = 0;
+ STRLEN n_a;
if (sp > mark) {
- New(1301,Argv, sp - mark + 3, char*);
- a = Argv;
+ New(1301,PL_Argv, sp - mark + 3, char*);
+ a = PL_Argv;
if (mark < sp && SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
++mark;
@@ -218,73 +777,20 @@ register SV **sp;
while (++mark <= sp) {
if (*mark)
- *a++ = SvPVx(*mark, na);
+ *a++ = SvPVx(*mark, n_a);
else
*a++ = "";
}
*a = Nullch;
- trueflag = flag;
- if (flag == P_WAIT)
- flag = P_NOWAIT;
-
- if (strEQ(Argv[0],"/bin/sh")) Argv[0] = sh_path;
-
- if (Argv[0][0] != '/' && Argv[0][0] != '\\'
- && !(Argv[0][0] && Argv[0][1] == ':'
- && (Argv[0][2] == '/' || Argv[0][2] != '\\'))
- ) /* will swawnvp use PATH? */
- TAINT_ENV(); /* testing IFS here is overkill, probably */
- /* We should check PERL_SH* and PERLLIB_* as well? */
- retry:
- if (really && *(tmps = SvPV(really, na)))
- rc = result(trueflag, spawnvp(flag,tmps,Argv));
- else
- rc = result(trueflag, spawnvp(flag,Argv[0],Argv));
-
- if (rc < 0 && secondtry == 0
- && (!tmps || !*tmps)) { /* Cannot transfer `really' via shell. */
- err = errno;
- if (err == ENOENT) { /* No such file. */
- /* One reason may be that EMX added .exe. We suppose
- that .exe-less files are automatically shellable. */
- char *no_dir;
- (no_dir = strrchr(Argv[0], '/'))
- || (no_dir = strrchr(Argv[0], '\\'))
- || (no_dir = Argv[0]);
- if (!strchr(no_dir, '.')) {
- struct stat buffer;
- if (stat(Argv[0], &buffer) != -1) { /* File exists. */
- /* Maybe we need to specify the full name here? */
- goto doshell;
- }
- }
- } else if (err == ENOEXEC) { /* Need to send to shell. */
- doshell:
- while (a >= Argv) {
- *(a + 2) = *a;
- a--;
- }
- *Argv = sh_path;
- *(Argv + 1) = "-c";
- secondtry = 1;
- goto retry;
- }
- }
- if (rc < 0 && dowarn)
- warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno));
- if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
+ rc = do_spawn_ve(really, flag, EXECF_SPAWN, NULL);
} else
rc = -1;
do_execfree();
return rc;
}
-#define EXECF_SPAWN 0
-#define EXECF_EXEC 1
-#define EXECF_TRUEEXEC 2
-#define EXECF_SPAWN_NOWAIT 3
-
+/* Try converting 1-arg form to (usually shell-less) multi-arg form. */
int
do_spawn2(cmd, execf)
char *cmd;
@@ -294,7 +800,7 @@ int execf;
register char *s;
char flags[10];
char *shell, *copt, *news = NULL;
- int rc, added_shell = 0, err, seenspace = 0;
+ int rc, err, seenspace = 0;
char fullcmd[MAXNAMLEN + 1];
#ifdef TRYSHELL
@@ -311,7 +817,7 @@ int execf;
have a shell which will not change between computers with the
same architecture, to avoid "action on a distance".
And to have simple build, this shell should be sh. */
- shell = sh_path;
+ shell = PL_sh_path;
copt = "-c";
#endif
@@ -319,13 +825,12 @@ int execf;
cmd++;
if (strnEQ(cmd,"/bin/sh",7) && isSPACE(cmd[7])) {
- STRLEN l = strlen(sh_path);
+ STRLEN l = strlen(PL_sh_path);
New(1302, news, strlen(cmd) - 7 + l + 1, char);
- strcpy(news, sh_path);
+ strcpy(news, PL_sh_path);
strcpy(news + l, cmd + 7);
cmd = news;
- added_shell = 1;
}
/* save an extra exec if possible */
@@ -349,32 +854,38 @@ int execf;
} else if (*s == '\\' && !seenspace) {
continue; /* Allow backslashes in names */
}
+ /* We do not convert this to do_spawn_ve since shell
+ should be smart enough to start itself gloriously. */
doshell:
if (execf == EXECF_TRUEEXEC)
- return execl(shell,shell,copt,cmd,(char*)0);
+ rc = execl(shell,shell,copt,cmd,(char*)0);
else if (execf == EXECF_EXEC)
- return spawnl(P_OVERLAY,shell,shell,copt,cmd,(char*)0);
+ rc = spawnl(P_OVERLAY,shell,shell,copt,cmd,(char*)0);
else if (execf == EXECF_SPAWN_NOWAIT)
- return spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0);
- /* In the ak code internal P_NOWAIT is P_WAIT ??? */
- rc = result(P_WAIT,
- spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0));
- if (rc < 0 && dowarn)
- warn("Can't %s \"%s\": %s",
- (execf == EXECF_SPAWN ? "spawn" : "exec"),
- shell, Strerror(errno));
- if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
- if (news) Safefree(news);
+ rc = spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0);
+ else {
+ /* In the ak code internal P_NOWAIT is P_WAIT ??? */
+ rc = result(P_WAIT,
+ spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0));
+ if (rc < 0 && PL_dowarn)
+ warn("Can't %s \"%s\": %s",
+ (execf == EXECF_SPAWN ? "spawn" : "exec"),
+ shell, Strerror(errno));
+ if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
+ }
+ if (news)
+ Safefree(news);
return rc;
} else if (*s == ' ' || *s == '\t') {
seenspace = 1;
}
}
- New(1303,Argv, (s - cmd) / 2 + 2, char*);
- Cmd = savepvn(cmd, s-cmd);
- a = Argv;
- for (s = Cmd; *s;) {
+ /* cmd="a" may lead to "sh", "-c", "\"$@\"", "a", "a.cmd", NULL */
+ New(1303,PL_Argv, (s - cmd + 11) / 2, char*);
+ PL_Cmd = savepvn(cmd, s-cmd);
+ a = PL_Argv;
+ for (s = PL_Cmd; *s;) {
while (*s && isSPACE(*s)) s++;
if (*s)
*(a++) = s;
@@ -383,46 +894,12 @@ int execf;
*s++ = '\0';
}
*a = Nullch;
- if (Argv[0]) {
- int err;
-
- if (execf == EXECF_TRUEEXEC)
- rc = execvp(Argv[0],Argv);
- else if (execf == EXECF_EXEC)
- rc = spawnvp(P_OVERLAY,Argv[0],Argv);
- else if (execf == EXECF_SPAWN_NOWAIT)
- rc = spawnvp(P_NOWAIT,Argv[0],Argv);
- else
- rc = result(P_WAIT, spawnvp(P_NOWAIT,Argv[0],Argv));
- if (rc < 0) {
- err = errno;
- if (err == ENOENT) { /* No such file. */
- /* One reason may be that EMX added .exe. We suppose
- that .exe-less files are automatically shellable. */
- char *no_dir;
- (no_dir = strrchr(Argv[0], '/'))
- || (no_dir = strrchr(Argv[0], '\\'))
- || (no_dir = Argv[0]);
- if (!strchr(no_dir, '.')) {
- struct stat buffer;
- if (stat(Argv[0], &buffer) != -1) { /* File exists. */
- /* Maybe we need to specify the full name here? */
- goto doshell;
- }
- }
- } else if (err == ENOEXEC) { /* Need to send to shell. */
- goto doshell;
- }
- }
- if (rc < 0 && dowarn)
- warn("Can't %s \"%s\": %s",
- ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC)
- ? "spawn" : "exec"),
- Argv[0], Strerror(err));
- if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
- } else
+ if (PL_Argv[0])
+ rc = do_spawn_ve(NULL, 0, execf, cmd);
+ else
rc = -1;
- if (news) Safefree(news);
+ if (news)
+ Safefree(news);
do_execfree();
return rc;
}
@@ -445,7 +922,8 @@ bool
do_exec(cmd)
char *cmd;
{
- return do_spawn2(cmd, EXECF_EXEC);
+ do_spawn2(cmd, EXECF_EXEC);
+ return FALSE;
}
bool
@@ -468,15 +946,15 @@ char *mode;
PerlIO *res;
SV *sv;
- if (pipe(p) < 0)
- return Nullfp;
/* `this' is what we use in the parent, `that' in the child. */
this = (*mode == 'w');
that = !this;
- if (tainting) {
+ if (PL_tainting) {
taint_env();
taint_proper("Insecure %s%s", "EXEC");
}
+ if (pipe(p) < 0)
+ return Nullfp;
/* Now we need to spawn the child. */
newfd = dup(*mode == 'r'); /* Preserve std* */
if (p[that] != (*mode == 'r')) {
@@ -491,7 +969,8 @@ char *mode;
dup2(newfd, *mode == 'r'); /* Return std* back. */
close(newfd);
}
- close(p[that]);
+ if (p[that] == (*mode == 'r'))
+ close(p[that]);
if (pid == -1) {
close(p[this]);
return NULL;
@@ -501,10 +980,10 @@ char *mode;
close(p[this]);
p[this] = p[that];
}
- sv = *av_fetch(fdpid,p[this],TRUE);
+ sv = *av_fetch(PL_fdpid,p[this],TRUE);
(void)SvUPGRADE(sv,SVt_IV);
SvIVX(sv) = pid;
- forkprocess = pid;
+ PL_forkprocess = pid;
return PerlIO_fdopen(p[this], mode);
#else /* USE_POPEN */
@@ -517,11 +996,11 @@ char *mode;
# else
char *shell = getenv("EMXSHELL");
- my_setenv("EMXSHELL", sh_path);
+ my_setenv("EMXSHELL", PL_sh_path);
res = popen(cmd, mode);
my_setenv("EMXSHELL", shell);
# endif
- sv = *av_fetch(fdpid, PerlIO_fileno(res), TRUE);
+ sv = *av_fetch(PL_fdpid, PerlIO_fileno(res), TRUE);
(void)SvUPGRADE(sv,SVt_IV);
SvIVX(sv) = -1; /* A cooky. */
return res;
@@ -536,7 +1015,7 @@ char *mode;
int
fork(void)
{
- die(no_func, "Unsupported function fork");
+ die(PL_no_func, "Unsupported function fork");
errno = EINVAL;
return -1;
}
@@ -675,8 +1154,9 @@ XS(XS_File__Copy_syscopy)
if (items < 2 || items > 3)
croak("Usage: File::Copy::syscopy(src,dst,flag=0)");
{
- char * src = (char *)SvPV(ST(0),na);
- char * dst = (char *)SvPV(ST(1),na);
+ STRLEN n_a;
+ char * src = (char *)SvPV(ST(0),n_a);
+ char * dst = (char *)SvPV(ST(1),n_a);
U32 flag;
int RETVAL, rc;
@@ -693,6 +1173,8 @@ XS(XS_File__Copy_syscopy)
XSRETURN(1);
}
+#include "patchlevel.h"
+
char *
mod2fname(sv)
SV *sv;
@@ -703,6 +1185,7 @@ mod2fname(sv)
AV *av;
SV *svp;
char *s;
+ STRLEN n_a;
if (!SvROK(sv)) croak("Not a reference given to mod2fname");
sv = SvRV(sv);
@@ -713,7 +1196,7 @@ mod2fname(sv)
if (avlen < 0)
croak("Empty array reference given to mod2fname");
- s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), na);
+ s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a);
strncpy(fname, s, 8);
len = strlen(s);
if (len < 6) pos = len;
@@ -723,12 +1206,16 @@ mod2fname(sv)
}
avlen --;
while (avlen >= 0) {
- s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), na);
+ s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a);
while (*s) {
sum = 33 * sum + *(s++); /* 7 is primitive mod 13. */
}
avlen --;
}
+#ifdef USE_THREADS
+ sum++; /* Avoid conflict of DLLs in memory. */
+#endif
+ sum += PATCHLEVEL * 200 + SUBVERSION * 2; /* */
fname[pos] = 'A' + (sum % 26);
fname[pos + 1] = 'A' + (sum / 26 % 26);
fname[pos + 2] = '\0';
@@ -764,6 +1251,12 @@ os2error(int rc)
sprintf(buf, "OS/2 system error code %d=0x%x", rc, rc);
else
buf[len] = '\0';
+ if (len > 0 && buf[len - 1] == '\n')
+ buf[len - 1] = '\0';
+ if (len > 1 && buf[len - 2] == '\r')
+ buf[len - 2] = '\0';
+ if (len > 2 && buf[len - 3] == '.')
+ buf[len - 3] = '\0';
return buf;
}
@@ -850,7 +1343,8 @@ XS(XS_Cwd_sys_chdir)
if (items != 1)
croak("Usage: Cwd::sys_chdir(path)");
{
- char * path = (char *)SvPV(ST(0),na);
+ STRLEN n_a;
+ char * path = (char *)SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = sys_chdir(path);
@@ -866,7 +1360,8 @@ XS(XS_Cwd_change_drive)
if (items != 1)
croak("Usage: Cwd::change_drive(d)");
{
- char d = (char)*SvPV(ST(0),na);
+ STRLEN n_a;
+ char d = (char)*SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = change_drive(d);
@@ -882,7 +1377,8 @@ XS(XS_Cwd_sys_is_absolute)
if (items != 1)
croak("Usage: Cwd::sys_is_absolute(path)");
{
- char * path = (char *)SvPV(ST(0),na);
+ STRLEN n_a;
+ char * path = (char *)SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = sys_is_absolute(path);
@@ -898,7 +1394,8 @@ XS(XS_Cwd_sys_is_rooted)
if (items != 1)
croak("Usage: Cwd::sys_is_rooted(path)");
{
- char * path = (char *)SvPV(ST(0),na);
+ STRLEN n_a;
+ char * path = (char *)SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = sys_is_rooted(path);
@@ -914,7 +1411,8 @@ XS(XS_Cwd_sys_is_relative)
if (items != 1)
croak("Usage: Cwd::sys_is_relative(path)");
{
- char * path = (char *)SvPV(ST(0),na);
+ STRLEN n_a;
+ char * path = (char *)SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = sys_is_relative(path);
@@ -945,7 +1443,8 @@ XS(XS_Cwd_sys_abspath)
if (items < 1 || items > 2)
croak("Usage: Cwd::sys_abspath(path, dir = NULL)");
{
- char * path = (char *)SvPV(ST(0),na);
+ STRLEN n_a;
+ char * path = (char *)SvPV(ST(0),n_a);
char * dir;
char p[MAXPATHLEN];
char * RETVAL;
@@ -953,7 +1452,7 @@ XS(XS_Cwd_sys_abspath)
if (items < 2)
dir = NULL;
else {
- dir = (char *)SvPV(ST(1),na);
+ dir = (char *)SvPV(ST(1),n_a);
}
if (path[0] == '.' && (path[1] == '/' || path[1] == '\\')) {
path += 2;
@@ -1093,7 +1592,8 @@ XS(XS_Cwd_extLibpath_set)
if (items < 1 || items > 2)
croak("Usage: Cwd::extLibpath_set(s, type = 0)");
{
- char * s = (char *)SvPV(ST(0),na);
+ STRLEN n_a;
+ char * s = (char *)SvPV(ST(0),n_a);
bool type;
U32 rc;
bool RETVAL;
@@ -1147,27 +1647,31 @@ Perl_OS2_init(char **env)
{
char *shell;
+ MALLOC_INIT;
settmppath();
OS2_Perl_data.xs_init = &Xs_OS2_init;
+ _uflags (_UF_SBRK_MODEL, _UF_SBRK_ARBITRARY);
if (environ == NULL) {
environ = env;
}
if ( (shell = getenv("PERL_SH_DRIVE")) ) {
- New(1304, sh_path, strlen(SH_PATH) + 1, char);
- strcpy(sh_path, SH_PATH);
- sh_path[0] = shell[0];
+ New(1304, PL_sh_path, strlen(SH_PATH) + 1, char);
+ strcpy(PL_sh_path, SH_PATH);
+ PL_sh_path[0] = shell[0];
} else if ( (shell = getenv("PERL_SH_DIR")) ) {
int l = strlen(shell), i;
if (shell[l-1] == '/' || shell[l-1] == '\\') {
l--;
}
- New(1304, sh_path, l + 8, char);
- strncpy(sh_path, shell, l);
- strcpy(sh_path + l, "/sh.exe");
+ New(1304, PL_sh_path, l + 8, char);
+ strncpy(PL_sh_path, shell, l);
+ strcpy(PL_sh_path + l, "/sh.exe");
for (i = 0; i < l; i++) {
- if (sh_path[i] == '\\') sh_path[i] = '/';
+ if (PL_sh_path[i] == '\\') PL_sh_path[i] = '/';
}
}
+ MUTEX_INIT(&start_thread_mutex);
+ os2_mytype = my_type(); /* Do it before morphing. Needed? */
}
#undef tmpnam
@@ -1205,7 +1709,7 @@ my_tmpfile ()
/* This code was contributed by Rocco Caputo. */
int
-my_flock(int handle, int op)
+my_flock(int handle, int o)
{
FILELOCK rNull, rFull;
ULONG timeout, handle_type, flag_word;
@@ -1221,7 +1725,7 @@ my_flock(int handle, int op)
use_my = 1;
}
if (!(_emx_env & 0x200) || !use_my)
- return flock(handle, op); /* Delegate to EMX. */
+ return flock(handle, o); /* Delegate to EMX. */
// is this a file?
if ((DosQueryHType(handle, &handle_type, &flag_word) != 0) ||
@@ -1234,11 +1738,11 @@ my_flock(int handle, int op)
rNull.lOffset = rNull.lRange = rFull.lOffset = 0;
rFull.lRange = 0x7FFFFFFF;
// set timeout for blocking
- timeout = ((blocking = !(op & LOCK_NB))) ? 100 : 1;
+ timeout = ((blocking = !(o & LOCK_NB))) ? 100 : 1;
// shared or exclusive?
- shared = (op & LOCK_SH) ? 1 : 0;
+ shared = (o & LOCK_SH) ? 1 : 0;
// do not block the unlock
- if (op & (LOCK_UN | LOCK_SH | LOCK_EX)) {
+ if (o & (LOCK_UN | LOCK_SH | LOCK_EX)) {
rc = DosSetFileLocks(handle, &rFull, &rNull, timeout, shared);
switch (rc) {
case 0:
@@ -1266,7 +1770,7 @@ my_flock(int handle, int op)
}
}
// lock may block
- if (op & (LOCK_SH | LOCK_EX)) {
+ if (o & (LOCK_SH | LOCK_EX)) {
// for blocking operations
for (;;) {
rc =
diff --git a/gnu/usr.bin/perl/os2/os2ish.h b/gnu/usr.bin/perl/os2/os2ish.h
index b62e3d04d4b..1f6b4aba6c6 100644
--- a/gnu/usr.bin/perl/os2/os2ish.h
+++ b/gnu/usr.bin/perl/os2/os2ish.h
@@ -25,6 +25,14 @@
*/
#undef USEMYBINMODE
+/* Stat_t:
+ * This symbol holds the type used to declare buffers for information
+ * returned by stat(). It's usually just struct stat. It may be necessary
+ * to include <sys/stat.h> and <sys/types.h> to get any typedef'ed
+ * information.
+ */
+#define Stat_t struct stat
+
/* USE_STAT_RDEV:
* This symbol is defined if this system has a stat structure declaring
* st_rdev
@@ -64,17 +72,114 @@
/* It is not working without TCPIPV4 defined. */
# undef I_SYS_UN
#endif
+
+#ifdef USE_THREADS
+
+#define OS2_ERROR_ALREADY_POSTED 299 /* Avoid os2.h */
+
+extern int rc;
+
+#define MUTEX_INIT(m) \
+ STMT_START { \
+ int rc; \
+ if ((rc = _rmutex_create(m,0))) \
+ croak("panic: MUTEX_INIT: rc=%i", rc); \
+ } STMT_END
+#define MUTEX_LOCK(m) \
+ STMT_START { \
+ int rc; \
+ if ((rc = _rmutex_request(m,_FMR_IGNINT))) \
+ croak("panic: MUTEX_LOCK: rc=%i", rc); \
+ } STMT_END
+#define MUTEX_UNLOCK(m) \
+ STMT_START { \
+ int rc; \
+ if ((rc = _rmutex_release(m))) \
+ croak("panic: MUTEX_UNLOCK: rc=%i", rc); \
+ } STMT_END
+#define MUTEX_DESTROY(m) \
+ STMT_START { \
+ int rc; \
+ if ((rc = _rmutex_close(m))) \
+ croak("panic: MUTEX_DESTROY: rc=%i", rc); \
+ } STMT_END
+
+#define COND_INIT(c) \
+ STMT_START { \
+ int rc; \
+ if ((rc = DosCreateEventSem(NULL,c,0,0))) \
+ croak("panic: COND_INIT: rc=%i", rc); \
+ } STMT_END
+#define COND_SIGNAL(c) \
+ STMT_START { \
+ int rc; \
+ if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED) \
+ croak("panic: COND_SIGNAL, rc=%ld", rc); \
+ } STMT_END
+#define COND_BROADCAST(c) \
+ STMT_START { \
+ int rc; \
+ if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED)\
+ croak("panic: COND_BROADCAST, rc=%i", rc); \
+ } STMT_END
+/* #define COND_WAIT(c, m) \
+ STMT_START { \
+ if (WaitForSingleObject(*(c),INFINITE) == WAIT_FAILED) \
+ croak("panic: COND_WAIT"); \
+ } STMT_END
+*/
+#define COND_WAIT(c, m) os2_cond_wait(c,m)
+
+#define COND_WAIT_win32(c, m) \
+ STMT_START { \
+ int rc; \
+ if ((rc = SignalObjectAndWait(*(m),*(c),INFINITE,FALSE)))\
+ croak("panic: COND_WAIT"); \
+ else \
+ MUTEX_LOCK(m); \
+ } STMT_END
+#define COND_DESTROY(c) \
+ STMT_START { \
+ int rc; \
+ if ((rc = DosCloseEventSem(*(c)))) \
+ croak("panic: COND_DESTROY, rc=%i", rc); \
+ } STMT_END
+/*#define THR ((struct thread *) TlsGetValue(PL_thr_key))
+#define dTHR struct thread *thr = THR
+*/
+
+#define pthread_getspecific(k) (*_threadstore())
+#define pthread_setspecific(k,v) (*_threadstore()=v,0)
+#define pthread_self() _gettid()
+#define pthread_key_create(keyp,flag) (*keyp=_gettid(),0)
+#define YIELD DosSleep(0)
+
+#ifdef PTHREADS_INCLUDED /* For ./x2p stuff. */
+int pthread_join(pthread_t tid, void **status);
+int pthread_detach(pthread_t tid);
+int pthread_create(pthread_t *tid, const pthread_attr_t *attr,
+ void *(*start_routine)(void*), void *arg);
+#endif
+
+#define THREADS_ELSEWHERE
+
+#endif
void Perl_OS2_init(char **);
/* XXX This code hideously puts env inside: */
-#define PERL_SYS_INIT(argcp, argvp) STMT_START { \
+#ifdef __EMX__
+# define PERL_SYS_INIT(argcp, argvp) STMT_START { \
_response(argcp, argvp); \
_wildcard(argcp, argvp); \
Perl_OS2_init(env); } STMT_END
-
-#define PERL_SYS_TERM()
+#else /* Compiling embedded Perl with non-EMX compiler */
+# define PERL_SYS_INIT(argcp, argvp) STMT_START { \
+ Perl_OS2_init(env); } STMT_END
+# define PERL_CALLCONV _System
+#endif
+#define PERL_SYS_TERM() MALLOC_TERM
/* #define PERL_SYS_TERM() STMT_START { \
if (Perl_HAB_set) WinTerminate(Perl_hab); } STMT_END */
diff --git a/gnu/usr.bin/perl/os2/perl2cmd.pl b/gnu/usr.bin/perl/os2/perl2cmd.pl
index e774f773d03..f9cc03bdac2 100644
--- a/gnu/usr.bin/perl/os2/perl2cmd.pl
+++ b/gnu/usr.bin/perl/os2/perl2cmd.pl
@@ -23,7 +23,7 @@ foreach $file (<$idir/*>) {
$base =~ s|.*/||;
$file =~ s|/|\\|g ;
print "Processing $file => $dir\\$base.cmd\n";
- system 'cmd.exe', '/c', "echo extproc perl -S >$dir\\$base.cmd";
+ system 'cmd.exe', '/c', "echo extproc perl -S>$dir\\$base.cmd";
system 'cmd.exe', '/c', "type $file >> $dir\\$base.cmd";
}
diff --git a/gnu/usr.bin/perl/patchlevel.h b/gnu/usr.bin/perl/patchlevel.h
index 2adaed5f721..cbf0b1d6c9b 100644
--- a/gnu/usr.bin/perl/patchlevel.h
+++ b/gnu/usr.bin/perl/patchlevel.h
@@ -1,9 +1,11 @@
-#define PATCHLEVEL 4
-#define SUBVERSION 4
+#ifndef __PATCHLEVEL_H_INCLUDED__
+#define PATCHLEVEL 5
+#undef SUBVERSION /* OS/390 has a SUBVERSION in a system header */
+#define SUBVERSION 3
/*
local_patches -- list of locally applied less-than-subversion patches.
- If you're distributing such a patch, please give it a tag name and a
+ If you're distributing such a patch, please give it a name and a
one-line description, placed just before the last NULL in the array
below. If your patch fixes a bug in the perlbug database, please
mention the bugid. If your patch *IS* dependent on a prior patch,
@@ -17,7 +19,7 @@
--- patchlevel.h <date here>
*** 38,43 ***
--- 38,44 ---
- ,"MAINT_TRIAL_1 - 5.00x_0x maintenance release trial 1"
+ ,"FOO1235 - some patch"
,"BAR3141 - another patch"
,"BAZ2718 - and another patch"
+ ,"MINE001 - my new patch"
@@ -36,7 +38,6 @@
This will prevent patch from choking if someone has previously
applied different patches than you.
*/
-/* The following line and terminating '};' are read by perlbug.PL. Don't alter. */
static char *local_patches[] = {
NULL
,NULL
@@ -45,3 +46,6 @@ static char *local_patches[] = {
/* Initial space prevents this variable from being inserted in config.sh */
# define LOCAL_PATCH_COUNT \
(sizeof(local_patches)/sizeof(local_patches[0])-2)
+
+# define __PATCHLEVEL_H_INCLUDED__
+#endif
diff --git a/gnu/usr.bin/perl/perl.c b/gnu/usr.bin/perl/perl.c
index f9cc65302a8..cc1f7edd132 100644
--- a/gnu/usr.bin/perl/perl.c
+++ b/gnu/usr.bin/perl/perl.c
@@ -1,6 +1,6 @@
/* perl.c
*
- * Copyright (c) 1987-1997 Larry Wall
+ * Copyright (c) 1987-1999 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.
@@ -24,7 +24,12 @@
char *getenv _((char *)); /* Usually in <stdlib.h> */
#endif
-dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n";
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
#ifdef IAMSUID
#ifndef DOSUID
@@ -38,91 +43,136 @@ dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n";
#endif
#endif
-#define I_REINIT \
- STMT_START { \
- chopset = " \n-"; \
- copline = NOLINE; \
- curcop = &compiling; \
- curcopdb = NULL; \
- cxstack_ix = -1; \
- cxstack_max = 128; \
- dbargs = 0; \
- dlmax = 128; \
- laststatval = -1; \
- laststype = OP_STAT; \
- maxscream = -1; \
- maxsysfd = MAXSYSFD; \
- statname = Nullsv; \
- tmps_floor = -1; \
- tmps_ix = -1; \
- op_mask = NULL; \
- dlmax = 128; \
- laststatval = -1; \
- laststype = OP_STAT; \
- mess_sv = Nullsv; \
- } STMT_END
-
+#ifdef PERL_OBJECT
+static I32 read_e_script _((CPerlObj* pPerl, int idx, SV *buf_sv, int maxlen));
+#else
static void find_beginning _((void));
static void forbid_setid _((char *));
static void incpush _((char *, int));
+static void init_interp _((void));
static void init_ids _((void));
static void init_debugger _((void));
static void init_lexer _((void));
static void init_main_stash _((void));
+#ifdef USE_THREADS
+static struct perl_thread * init_main_thread _((void));
+#endif /* USE_THREADS */
static void init_perllib _((void));
static void init_postdump_symbols _((int, char **, char **));
static void init_predump_symbols _((void));
-static void init_stacks _((void));
static void my_exit_jump _((void)) __attribute__((noreturn));
static void nuke_stacks _((void));
-static void open_script _((char *, bool, SV *));
+static void open_script _((char *, bool, SV *, int *fd));
static void usage _((char *));
-static void validate_suid _((char *, char*));
+#ifdef IAMSUID
+static int fd_on_nosuid_fs _((int));
+#endif
+static void validate_suid _((char *, char*, int));
+static I32 read_e_script _((int idx, SV *buf_sv, int maxlen));
+#endif
-static int fdscript = -1;
+#ifdef PERL_OBJECT
+CPerlObj* perl_alloc(IPerlMem* ipM, IPerlEnv* ipE, IPerlStdIO* ipStd,
+ IPerlLIO* ipLIO, IPerlDir* ipD, IPerlSock* ipS, IPerlProc* ipP)
+{
+ CPerlObj* pPerl = new(ipM) CPerlObj(ipM, ipE, ipStd, ipLIO, ipD, ipS, ipP);
+ if(pPerl != NULL)
+ pPerl->Init();
+ return pPerl;
+}
+#else
PerlInterpreter *
-perl_alloc()
+perl_alloc(void)
{
PerlInterpreter *sv_interp;
- curinterp = 0;
+ PL_curinterp = 0;
New(53, sv_interp, 1, PerlInterpreter);
return sv_interp;
}
+#endif /* PERL_OBJECT */
void
-perl_construct( sv_interp )
-register PerlInterpreter *sv_interp;
+#ifdef PERL_OBJECT
+CPerlObj::perl_construct(void)
+#else
+perl_construct(register PerlInterpreter *sv_interp)
+#endif
{
- if (!(curinterp = sv_interp))
+#ifdef USE_THREADS
+ int i;
+#ifndef FAKE_THREADS
+ struct perl_thread *thr;
+#endif /* FAKE_THREADS */
+#endif /* USE_THREADS */
+
+#ifndef PERL_OBJECT
+ if (!(PL_curinterp = sv_interp))
return;
+#endif
#ifdef MULTIPLICITY
+ ++PL_ninterps;
Zero(sv_interp, 1, PerlInterpreter);
#endif
- /* Init the real globals? */
- if (!linestr) {
- linestr = NEWSV(65,80);
- sv_upgrade(linestr,SVt_PVIV);
+ /* Init the real globals (and main thread)? */
+ if (!PL_linestr) {
+#ifdef USE_THREADS
+
+ INIT_THREADS;
+#ifdef ALLOC_THREAD_KEY
+ ALLOC_THREAD_KEY;
+#else
+ if (pthread_key_create(&PL_thr_key, 0))
+ croak("panic: pthread_key_create");
+#endif
+ MUTEX_INIT(&PL_sv_mutex);
+ MUTEX_INIT(&PL_cred_mutex);
+ /*
+ * Safe to use basic SV functions from now on (though
+ * not things like mortals or tainting yet).
+ */
+ MUTEX_INIT(&PL_eval_mutex);
+ COND_INIT(&PL_eval_cond);
+ MUTEX_INIT(&PL_threads_mutex);
+ COND_INIT(&PL_nthreads_cond);
+#ifdef EMULATE_ATOMIC_REFCOUNTS
+ MUTEX_INIT(&PL_svref_mutex);
+#endif /* EMULATE_ATOMIC_REFCOUNTS */
+
+ thr = init_main_thread();
+#endif /* USE_THREADS */
+
+ PL_linestr = NEWSV(65,79);
+ sv_upgrade(PL_linestr,SVt_PVIV);
- if (!SvREADONLY(&sv_undef)) {
- SvREADONLY_on(&sv_undef);
+ if (!SvREADONLY(&PL_sv_undef)) {
+ /* set read-only and try to insure than we wont see REFCNT==0
+ very often */
- sv_setpv(&sv_no,No);
- SvNV(&sv_no);
- SvREADONLY_on(&sv_no);
+ SvREADONLY_on(&PL_sv_undef);
+ SvREFCNT(&PL_sv_undef) = (~(U32)0)/2;
- sv_setpv(&sv_yes,Yes);
- SvNV(&sv_yes);
- SvREADONLY_on(&sv_yes);
- }
+ sv_setpv(&PL_sv_no,PL_No);
+ SvNV(&PL_sv_no);
+ SvREADONLY_on(&PL_sv_no);
+ SvREFCNT(&PL_sv_no) = (~(U32)0)/2;
- nrs = newSVpv("\n", 1);
- rs = SvREFCNT_inc(nrs);
+ sv_setpv(&PL_sv_yes,PL_Yes);
+ SvNV(&PL_sv_yes);
+ SvREADONLY_on(&PL_sv_yes);
+ SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
+ }
- pidstatus = newHV();
+#ifdef PERL_OBJECT
+ /* TODO: */
+ /* PL_sighandlerp = sighandler; */
+#else
+ PL_sighandlerp = sighandler;
+#endif
+ PL_pidstatus = newHV();
#ifdef MSDOS
/*
@@ -135,61 +185,149 @@ register PerlInterpreter *sv_interp;
#endif
}
+ PL_nrs = newSVpv("\n", 1);
+ PL_rs = SvREFCNT_inc(PL_nrs);
+
+ init_stacks(ARGS);
#ifdef MULTIPLICITY
- I_REINIT;
- perl_destruct_level = 1;
+ init_interp();
+ PL_perl_destruct_level = 1;
#else
- if(perl_destruct_level > 0)
- I_REINIT;
+ if (PL_perl_destruct_level > 0)
+ init_interp();
#endif
init_ids();
- lex_state = LEX_NOTPARSING;
+ PL_lex_state = LEX_NOTPARSING;
- start_env.je_prev = NULL;
- start_env.je_ret = -1;
- start_env.je_mustcatch = TRUE;
- top_env = &start_env;
+ PL_start_env.je_prev = NULL;
+ PL_start_env.je_ret = -1;
+ PL_start_env.je_mustcatch = TRUE;
+ PL_top_env = &PL_start_env;
STATUS_ALL_SUCCESS;
SET_NUMERIC_STANDARD();
#if defined(SUBVERSION) && SUBVERSION > 0
- sprintf(patchlevel, "%7.5f", (double) 5
+ sprintf(PL_patchlevel, "%7.5f", (double) 5
+ ((double) PATCHLEVEL / (double) 1000)
+ ((double) SUBVERSION / (double) 100000));
#else
- sprintf(patchlevel, "%5.3f", (double) 5 +
+ sprintf(PL_patchlevel, "%5.3f", (double) 5 +
((double) PATCHLEVEL / (double) 1000));
#endif
#if defined(LOCAL_PATCH_COUNT)
- localpatches = local_patches; /* For possible -v */
+ PL_localpatches = local_patches; /* For possible -v */
#endif
- PerlIO_init(); /* Hook to IO system */
+ PerlIO_init(); /* Hook to IO system */
+
+ PL_fdpid = newAV(); /* for remembering popen pids by fd */
+ PL_modglobal = newHV(); /* pointers to per-interpreter module globals */
- fdpid = newAV(); /* for remembering popen pids by fd */
+ DEBUG( {
+ New(51,PL_debname,128,char);
+ New(52,PL_debdelim,128,char);
+ } )
- init_stacks();
ENTER;
}
void
-perl_destruct(sv_interp)
-register PerlInterpreter *sv_interp;
+#ifdef PERL_OBJECT
+CPerlObj::perl_destruct(void)
+#else
+perl_destruct(register PerlInterpreter *sv_interp)
+#endif
{
+ dTHR;
int destruct_level; /* 0=none, 1=full, 2=full with checks */
I32 last_sv_count;
HV *hv;
+#ifdef USE_THREADS
+ Thread t;
+#endif /* USE_THREADS */
- if (!(curinterp = sv_interp))
+#ifndef PERL_OBJECT
+ if (!(PL_curinterp = sv_interp))
return;
+#endif
- destruct_level = perl_destruct_level;
+#ifdef USE_THREADS
+#ifndef FAKE_THREADS
+ /* Pass 1 on any remaining threads: detach joinables, join zombies */
+ retry_cleanup:
+ MUTEX_LOCK(&PL_threads_mutex);
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ "perl_destruct: waiting for %d threads...\n",
+ PL_nthreads - 1));
+ for (t = thr->next; t != thr; t = t->next) {
+ MUTEX_LOCK(&t->mutex);
+ switch (ThrSTATE(t)) {
+ AV *av;
+ case THRf_ZOMBIE:
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ "perl_destruct: joining zombie %p\n", t));
+ ThrSETSTATE(t, THRf_DEAD);
+ MUTEX_UNLOCK(&t->mutex);
+ PL_nthreads--;
+ /*
+ * The SvREFCNT_dec below may take a long time (e.g. av
+ * may contain an object scalar whose destructor gets
+ * called) so we have to unlock threads_mutex and start
+ * all over again.
+ */
+ MUTEX_UNLOCK(&PL_threads_mutex);
+ JOIN(t, &av);
+ SvREFCNT_dec((SV*)av);
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ "perl_destruct: joined zombie %p OK\n", t));
+ goto retry_cleanup;
+ case THRf_R_JOINABLE:
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ "perl_destruct: detaching thread %p\n", t));
+ ThrSETSTATE(t, THRf_R_DETACHED);
+ /*
+ * We unlock threads_mutex and t->mutex in the opposite order
+ * from which we locked them just so that DETACH won't
+ * deadlock if it panics. It's only a breach of good style
+ * not a bug since they are unlocks not locks.
+ */
+ MUTEX_UNLOCK(&PL_threads_mutex);
+ DETACH(t);
+ MUTEX_UNLOCK(&t->mutex);
+ goto retry_cleanup;
+ default:
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ "perl_destruct: ignoring %p (state %u)\n",
+ t, ThrSTATE(t)));
+ MUTEX_UNLOCK(&t->mutex);
+ /* fall through and out */
+ }
+ }
+ /* We leave the above "Pass 1" loop with threads_mutex still locked */
+
+ /* Pass 2 on remaining threads: wait for the thread count to drop to one */
+ while (PL_nthreads > 1)
+ {
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ "perl_destruct: final wait for %d threads\n",
+ PL_nthreads - 1));
+ COND_WAIT(&PL_nthreads_cond, &PL_threads_mutex);
+ }
+ /* At this point, we're the last thread */
+ MUTEX_UNLOCK(&PL_threads_mutex);
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(), "perl_destruct: armageddon has arrived\n"));
+ MUTEX_DESTROY(&PL_threads_mutex);
+ COND_DESTROY(&PL_nthreads_cond);
+#endif /* !defined(FAKE_THREADS) */
+#endif /* USE_THREADS */
+
+ destruct_level = PL_perl_destruct_level;
#ifdef DEBUGGING
{
char *s;
- if (s = getenv("PERL_DESTRUCT_LEVEL")) {
+ if (s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL")) {
int i = atoi(s);
if (destruct_level < i)
destruct_level = i;
@@ -200,36 +338,47 @@ register PerlInterpreter *sv_interp;
LEAVE;
FREETMPS;
+#ifdef MULTIPLICITY
+ --PL_ninterps;
+#endif
+
/* We must account for everything. */
/* Destroy the main CV and syntax tree */
- if (main_root) {
- curpad = AvARRAY(comppad);
- op_free(main_root);
- main_root = Nullop;
+ if (PL_main_root) {
+ PL_curpad = AvARRAY(PL_comppad);
+ op_free(PL_main_root);
+ PL_main_root = Nullop;
}
- main_start = Nullop;
- SvREFCNT_dec(main_cv);
- main_cv = Nullcv;
+ PL_curcop = &PL_compiling;
+ PL_main_start = Nullop;
+ SvREFCNT_dec(PL_main_cv);
+ PL_main_cv = Nullcv;
- if (sv_objcount) {
+ if (PL_sv_objcount) {
/*
* Try to destruct global references. We do this first so that the
* destructors and destructees still exist. Some sv's might remain.
* Non-referenced objects are on their own.
*/
- dirty = TRUE;
+ PL_dirty = TRUE;
sv_clean_objs();
}
/* unhook hooks which will soon be, or use, destroyed data */
- SvREFCNT_dec(warnhook);
- warnhook = Nullsv;
- SvREFCNT_dec(diehook);
- diehook = Nullsv;
- SvREFCNT_dec(parsehook);
- parsehook = Nullsv;
+ SvREFCNT_dec(PL_warnhook);
+ PL_warnhook = Nullsv;
+ SvREFCNT_dec(PL_diehook);
+ PL_diehook = Nullsv;
+ SvREFCNT_dec(PL_parsehook);
+ PL_parsehook = Nullsv;
+
+ /* call exit list functions */
+ while (PL_exitlistlen-- > 0)
+ PL_exitlist[PL_exitlistlen].fn(PERL_OBJECT_THIS_ PL_exitlist[PL_exitlistlen].ptr);
+
+ Safefree(PL_exitlist);
if (destruct_level == 0){
@@ -241,138 +390,108 @@ register PerlInterpreter *sv_interp;
/* loosen bonds of global variables */
- if(rsfp) {
- (void)PerlIO_close(rsfp);
- rsfp = Nullfp;
+ if(PL_rsfp) {
+ (void)PerlIO_close(PL_rsfp);
+ PL_rsfp = Nullfp;
}
/* Filters for program text */
- SvREFCNT_dec(rsfp_filters);
- rsfp_filters = Nullav;
+ SvREFCNT_dec(PL_rsfp_filters);
+ PL_rsfp_filters = Nullav;
/* switches */
- preprocess = FALSE;
- minus_n = FALSE;
- minus_p = FALSE;
- minus_l = FALSE;
- minus_a = FALSE;
- minus_F = FALSE;
- doswitches = FALSE;
- dowarn = FALSE;
- doextract = FALSE;
- sawampersand = FALSE; /* must save all match strings */
- sawstudy = FALSE; /* do fbm_instr on all strings */
- sawvec = FALSE;
- unsafe = FALSE;
-
- Safefree(inplace);
- inplace = Nullch;
-
- Safefree(e_tmpname);
- e_tmpname = Nullch;
-
- if (e_fp) {
- PerlIO_close(e_fp);
- e_fp = Nullfp;
+ PL_preprocess = FALSE;
+ PL_minus_n = FALSE;
+ PL_minus_p = FALSE;
+ PL_minus_l = FALSE;
+ PL_minus_a = FALSE;
+ PL_minus_F = FALSE;
+ PL_doswitches = FALSE;
+ PL_dowarn = FALSE;
+ PL_doextract = FALSE;
+ PL_sawampersand = FALSE; /* must save all match strings */
+ PL_sawstudy = FALSE; /* do fbm_instr on all strings */
+ PL_sawvec = FALSE;
+ PL_unsafe = FALSE;
+
+ Safefree(PL_inplace);
+ PL_inplace = Nullch;
+
+ if (PL_e_script) {
+ SvREFCNT_dec(PL_e_script);
+ PL_e_script = Nullsv;
}
/* magical thingies */
- Safefree(ofs); /* $, */
- ofs = Nullch;
+ Safefree(PL_ofs); /* $, */
+ PL_ofs = Nullch;
- Safefree(ors); /* $\ */
- ors = Nullch;
+ Safefree(PL_ors); /* $\ */
+ PL_ors = Nullch;
- SvREFCNT_dec(nrs); /* $\ helper */
- nrs = Nullsv;
+ SvREFCNT_dec(PL_rs); /* $/ */
+ PL_rs = Nullsv;
- multiline = 0; /* $* */
-
- SvREFCNT_dec(statname);
- statname = Nullsv;
- statgv = Nullgv;
-
- /* defgv, aka *_ should be taken care of elsewhere */
+ SvREFCNT_dec(PL_nrs); /* $/ helper */
+ PL_nrs = Nullsv;
-#if 0 /* just about all regexp stuff, seems to be ok */
+ PL_multiline = 0; /* $* */
- /* shortcuts to regexp stuff */
- leftgv = Nullgv;
- ampergv = Nullgv;
+ SvREFCNT_dec(PL_statname);
+ PL_statname = Nullsv;
+ PL_statgv = Nullgv;
- SAVEFREEOP(curpm);
- SAVEFREEOP(oldlastpm); /* for saving regexp context during debugger */
-
- regprecomp = NULL; /* uncompiled string. */
- regparse = NULL; /* Input-scan pointer. */
- regxend = NULL; /* End of input for compile */
- regnpar = 0; /* () count. */
- regcode = NULL; /* Code-emit pointer; &regdummy = don't. */
- regsize = 0; /* Code size. */
- regnaughty = 0; /* How bad is this pattern? */
- regsawback = 0; /* Did we see \1, ...? */
-
- reginput = NULL; /* String-input pointer. */
- regbol = NULL; /* Beginning of input, for ^ check. */
- regeol = NULL; /* End of input, for $ check. */
- regstartp = (char **)NULL; /* Pointer to startp array. */
- regendp = (char **)NULL; /* Ditto for endp. */
- reglastparen = 0; /* Similarly for lastparen. */
- regtill = NULL; /* How far we are required to go. */
- regflags = 0; /* are we folding, multilining? */
- regprev = (char)NULL; /* char before regbol, \n if none */
-
-#endif /* if 0 */
+ /* defgv, aka *_ should be taken care of elsewhere */
/* clean up after study() */
- SvREFCNT_dec(lastscream);
- lastscream = Nullsv;
- Safefree(screamfirst);
- screamfirst = 0;
- Safefree(screamnext);
- screamnext = 0;
+ SvREFCNT_dec(PL_lastscream);
+ PL_lastscream = Nullsv;
+ Safefree(PL_screamfirst);
+ PL_screamfirst = 0;
+ Safefree(PL_screamnext);
+ PL_screamnext = 0;
/* startup and shutdown function lists */
- SvREFCNT_dec(beginav);
- SvREFCNT_dec(endav);
- beginav = Nullav;
- endav = Nullav;
-
- /* temp stack during pp_sort() */
- SvREFCNT_dec(sortstack);
- sortstack = Nullav;
+ SvREFCNT_dec(PL_beginav);
+ SvREFCNT_dec(PL_endav);
+ SvREFCNT_dec(PL_initav);
+ PL_beginav = Nullav;
+ PL_endav = Nullav;
+ PL_initav = Nullav;
/* shortcuts just get cleared */
- envgv = Nullgv;
- siggv = Nullgv;
- incgv = Nullgv;
- errgv = Nullgv;
- argvgv = Nullgv;
- argvoutgv = Nullgv;
- stdingv = Nullgv;
- last_in_gv = Nullgv;
+ PL_envgv = Nullgv;
+ PL_siggv = Nullgv;
+ PL_incgv = Nullgv;
+ PL_hintgv = Nullgv;
+ PL_errgv = Nullgv;
+ PL_argvgv = Nullgv;
+ PL_argvoutgv = Nullgv;
+ PL_stdingv = Nullgv;
+ PL_last_in_gv = Nullgv;
+ PL_replgv = Nullgv;
/* reset so print() ends up where we expect */
setdefout(Nullgv);
/* Prepare to destruct main symbol table. */
- hv = defstash;
- defstash = 0;
+ hv = PL_defstash;
+ PL_defstash = 0;
SvREFCNT_dec(hv);
FREETMPS;
if (destruct_level >= 2) {
- if (scopestack_ix != 0)
+ if (PL_scopestack_ix != 0)
warn("Unbalanced scopes: %ld more ENTERs than LEAVEs\n",
- (long)scopestack_ix);
- if (savestack_ix != 0)
+ (long)PL_scopestack_ix);
+ if (PL_savestack_ix != 0)
warn("Unbalanced saves: %ld more saves than restores\n",
- (long)savestack_ix);
- if (tmps_floor != -1)
+ (long)PL_savestack_ix);
+ if (PL_tmps_floor != -1)
warn("Unbalanced tmps: %ld more allocs than frees\n",
- (long)tmps_floor + 1);
+ (long)PL_tmps_floor + 1);
if (cxstack_ix != -1)
warn("Unbalanced context: %ld more PUSHes than POPs\n",
(long)cxstack_ix + 1);
@@ -380,13 +499,13 @@ register PerlInterpreter *sv_interp;
/* Now absolutely destruct everything, somehow or other, loops or no. */
last_sv_count = 0;
- SvFLAGS(strtab) |= SVTYPEMASK; /* don't clean out strtab now */
- while (sv_count != 0 && sv_count != last_sv_count) {
- last_sv_count = sv_count;
+ SvFLAGS(PL_strtab) |= SVTYPEMASK; /* don't clean out strtab now */
+ while (PL_sv_count != 0 && PL_sv_count != last_sv_count) {
+ last_sv_count = PL_sv_count;
sv_clean_all();
}
- SvFLAGS(strtab) &= ~SVTYPEMASK;
- SvFLAGS(strtab) |= SVt_PVHV;
+ SvFLAGS(PL_strtab) &= ~SVTYPEMASK;
+ SvFLAGS(PL_strtab) |= SVt_PVHV;
/* Destruct the global string table. */
{
@@ -399,8 +518,8 @@ register PerlInterpreter *sv_interp;
HE **array;
riter = 0;
- max = HvMAX(strtab);
- array = HvARRAY(strtab);
+ max = HvMAX(PL_strtab);
+ array = HvARRAY(PL_strtab);
hent = array[0];
for (;;) {
if (hent) {
@@ -416,52 +535,102 @@ register PerlInterpreter *sv_interp;
}
}
}
- SvREFCNT_dec(strtab);
+ SvREFCNT_dec(PL_strtab);
- if (sv_count != 0)
- warn("Scalars leaked: %ld\n", (long)sv_count);
+ if (PL_sv_count != 0)
+ warn("Scalars leaked: %ld\n", (long)PL_sv_count);
sv_free_arenas();
/* No SVs have survived, need to clean out */
- linestr = NULL;
- pidstatus = Nullhv;
- if (origfilename)
- Safefree(origfilename);
+ PL_linestr = NULL;
+ PL_pidstatus = Nullhv;
+ Safefree(PL_origfilename);
+ Safefree(PL_archpat_auto);
+ Safefree(PL_reg_start_tmp);
+ Safefree(HeKEY_hek(&PL_hv_fetch_ent_mh));
+ Safefree(PL_op_mask);
nuke_stacks();
- hints = 0; /* Reset hints. Should hints be per-interpreter ? */
+ PL_hints = 0; /* Reset hints. Should hints be per-interpreter ? */
DEBUG_P(debprofdump());
-
+#ifdef USE_THREADS
+ MUTEX_DESTROY(&PL_strtab_mutex);
+ MUTEX_DESTROY(&PL_sv_mutex);
+ MUTEX_DESTROY(&PL_cred_mutex);
+ MUTEX_DESTROY(&PL_eval_mutex);
+ COND_DESTROY(&PL_eval_cond);
+#ifdef EMULATE_ATOMIC_REFCOUNTS
+ MUTEX_DESTROY(&PL_svref_mutex);
+#endif /* EMULATE_ATOMIC_REFCOUNTS */
+
+ /* As the penultimate thing, free the non-arena SV for thrsv */
+ Safefree(SvPVX(PL_thrsv));
+ Safefree(SvANY(PL_thrsv));
+ Safefree(PL_thrsv);
+ PL_thrsv = Nullsv;
+#endif /* USE_THREADS */
+
/* As the absolutely last thing, free the non-arena SV for mess() */
- if (mess_sv) {
+ if (PL_mess_sv) {
+ /* it could have accumulated taint magic */
+ if (SvTYPE(PL_mess_sv) >= SVt_PVMG) {
+ MAGIC* mg;
+ MAGIC* moremagic;
+ for (mg = SvMAGIC(PL_mess_sv); mg; mg = moremagic) {
+ moremagic = mg->mg_moremagic;
+ if (mg->mg_ptr && mg->mg_type != 'g' && mg->mg_len >= 0)
+ Safefree(mg->mg_ptr);
+ Safefree(mg);
+ }
+ }
/* we know that type >= SVt_PV */
- SvOOK_off(mess_sv);
- Safefree(SvPVX(mess_sv));
- Safefree(SvANY(mess_sv));
- Safefree(mess_sv);
- mess_sv = Nullsv;
+ SvOOK_off(PL_mess_sv);
+ Safefree(SvPVX(PL_mess_sv));
+ Safefree(SvANY(PL_mess_sv));
+ Safefree(PL_mess_sv);
+ PL_mess_sv = Nullsv;
}
}
void
-perl_free(sv_interp)
-PerlInterpreter *sv_interp;
+#ifdef PERL_OBJECT
+CPerlObj::perl_free(void)
+#else
+perl_free(PerlInterpreter *sv_interp)
+#endif
{
- if (!(curinterp = sv_interp))
+#ifdef PERL_OBJECT
+ Safefree(this);
+#else
+ if (!(PL_curinterp = sv_interp))
return;
Safefree(sv_interp);
+#endif
+}
+
+void
+#ifdef PERL_OBJECT
+CPerlObj::perl_atexit(void (*fn) (CPerlObj*,void *), void *ptr)
+#else
+perl_atexit(void (*fn) (void *), void *ptr)
+#endif
+{
+ Renew(PL_exitlist, PL_exitlistlen+1, PerlExitListEntry);
+ PL_exitlist[PL_exitlistlen].fn = fn;
+ PL_exitlist[PL_exitlistlen].ptr = ptr;
+ ++PL_exitlistlen;
}
int
-perl_parse(sv_interp, xsinit, argc, argv, env)
-PerlInterpreter *sv_interp;
-void (*xsinit)_((void));
-int argc;
-char **argv;
-char **env;
+#ifdef PERL_OBJECT
+CPerlObj::perl_parse(void (*xsinit) (CPerlObj*), int argc, char **argv, char **env)
+#else
+perl_parse(PerlInterpreter *sv_interp, void (*xsinit) (void), int argc, char **argv, char **env)
+#endif
{
+ dTHR;
register SV *sv;
register char *s;
char *scriptname = NULL;
@@ -471,6 +640,7 @@ char **env;
AV* comppadlist;
dJMPENV;
int ret;
+ int fdscript = -1;
#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
#ifdef IAMSUID
@@ -480,44 +650,45 @@ setuid perl scripts securely.\n");
#endif
#endif
- if (!(curinterp = sv_interp))
+#ifndef PERL_OBJECT
+ if (!(PL_curinterp = sv_interp))
return 255;
+#endif
#if defined(NeXT) && defined(__DYNAMIC__)
_dyld_lookup_and_bind
("__environ", (unsigned long *) &environ_pointer, NULL);
#endif /* environ */
- origargv = argv;
- origargc = argc;
+ PL_origargv = argv;
+ PL_origargc = argc;
#ifndef VMS /* VMS doesn't have environ array */
- origenviron = environ;
+ PL_origenviron = environ;
#endif
- e_tmpname = Nullch;
- if (do_undump) {
+ if (PL_do_undump) {
/* Come here if running an undumped a.out. */
- origfilename = savepv(argv[0]);
- do_undump = FALSE;
+ PL_origfilename = savepv(argv[0]);
+ PL_do_undump = FALSE;
cxstack_ix = -1; /* start label stack again */
init_ids();
init_postdump_symbols(argc,argv,env);
return 0;
}
- if (main_root) {
- curpad = AvARRAY(comppad);
- op_free(main_root);
- main_root = Nullop;
+ if (PL_main_root) {
+ PL_curpad = AvARRAY(PL_comppad);
+ op_free(PL_main_root);
+ PL_main_root = Nullop;
}
- main_start = Nullop;
- SvREFCNT_dec(main_cv);
- main_cv = Nullcv;
+ PL_main_start = Nullop;
+ SvREFCNT_dec(PL_main_cv);
+ PL_main_cv = Nullcv;
- time(&basetime);
- oldscope = scopestack_ix;
+ time(&PL_basetime);
+ oldscope = PL_scopestack_ix;
JMPENV_PUSH(ret);
switch (ret) {
@@ -526,12 +697,12 @@ setuid perl scripts securely.\n");
/* FALL THROUGH */
case 2:
/* my_exit() was called */
- while (scopestack_ix > oldscope)
+ while (PL_scopestack_ix > oldscope)
LEAVE;
FREETMPS;
- curstash = defstash;
- if (endav)
- call_list(oldscope, endav);
+ PL_curstash = PL_defstash;
+ if (PL_endav)
+ call_list(oldscope, PL_endav);
JMPENV_POP;
return STATUS_NATIVE_EXPORT;
case 3:
@@ -540,7 +711,7 @@ setuid perl scripts securely.\n");
return 1;
}
- sv_setpvn(linestr,"",0);
+ sv_setpvn(PL_linestr,"",0);
sv = newSVpv("",0); /* first used for -I flags */
SAVEFREESV(sv);
init_main_stash();
@@ -557,6 +728,10 @@ setuid perl scripts securely.\n");
s = argv[0]+1;
reswitch:
switch (*s) {
+#ifndef PERL_STRICT_CR
+ case '\r':
+#endif
+ case ' ':
case '0':
case 'F':
case 'a':
@@ -580,36 +755,28 @@ setuid perl scripts securely.\n");
break;
case 'T':
- tainting = TRUE;
+ PL_tainting = TRUE;
s++;
goto reswitch;
case 'e':
- if (euid != uid || egid != gid)
+ if (PL_euid != PL_uid || PL_egid != PL_gid)
croak("No -e allowed in setuid scripts");
- if (!e_fp) {
- int fd;
-
- e_tmpname = savepv(TMPPATH);
- fd = mkstemp(e_tmpname);
- if (fd == -1)
- croak("Can't mkstemp()");
- e_fp = PerlIO_fdopen(fd,"w");
- if (!e_fp) {
- (void)close(fd);
- croak("Cannot open temporary file");
- }
+ if (!PL_e_script) {
+ PL_e_script = newSVpv("",0);
+ filter_add(read_e_script, NULL);
}
if (*++s)
- PerlIO_puts(e_fp,s);
+ sv_catpv(PL_e_script, s);
else if (argv[1]) {
- PerlIO_puts(e_fp,argv[1]);
+ sv_catpv(PL_e_script, argv[1]);
argc--,argv++;
}
else
croak("No code specified for -e");
- (void)PerlIO_putc(e_fp,'\n');
+ sv_catpv(PL_e_script, "\n");
break;
+
case 'I': /* -I handled both here and in moreswitches() */
forbid_setid("-I");
if (!*++s && (s=argv[1]) != Nullch) {
@@ -630,7 +797,7 @@ setuid perl scripts securely.\n");
break;
case 'P':
forbid_setid("-P");
- preprocess = TRUE;
+ PL_preprocess = TRUE;
s++;
goto reswitch;
case 'S':
@@ -639,67 +806,67 @@ setuid perl scripts securely.\n");
s++;
goto reswitch;
case 'V':
- if (!preambleav)
- preambleav = newAV();
- av_push(preambleav, newSVpv("use Config qw(myconfig config_vars)",0));
+ if (!PL_preambleav)
+ PL_preambleav = newAV();
+ av_push(PL_preambleav, newSVpv("use Config qw(myconfig config_vars)",0));
if (*++s != ':') {
- Sv = newSVpv("print myconfig();",0);
+ PL_Sv = newSVpv("print myconfig();",0);
#ifdef VMS
- sv_catpv(Sv,"print \"\\nCharacteristics of this PERLSHR image: \\n\",");
+ sv_catpv(PL_Sv,"print \"\\nCharacteristics of this PERLSHR image: \\n\",");
#else
- sv_catpv(Sv,"print \"\\nCharacteristics of this binary (from libperl): \\n\",");
+ sv_catpv(PL_Sv,"print \"\\nCharacteristics of this binary (from libperl): \\n\",");
#endif
#if defined(DEBUGGING) || defined(NO_EMBED) || defined(MULTIPLICITY)
- sv_catpv(Sv,"\" Compile-time options:");
+ sv_catpv(PL_Sv,"\" Compile-time options:");
# ifdef DEBUGGING
- sv_catpv(Sv," DEBUGGING");
+ sv_catpv(PL_Sv," DEBUGGING");
# endif
# ifdef NO_EMBED
- sv_catpv(Sv," NO_EMBED");
+ sv_catpv(PL_Sv," NO_EMBED");
# endif
# ifdef MULTIPLICITY
- sv_catpv(Sv," MULTIPLICITY");
+ sv_catpv(PL_Sv," MULTIPLICITY");
# endif
- sv_catpv(Sv,"\\n\",");
+ sv_catpv(PL_Sv,"\\n\",");
#endif
#if defined(LOCAL_PATCH_COUNT)
if (LOCAL_PATCH_COUNT > 0) {
int i;
- sv_catpv(Sv,"\" Locally applied patches:\\n\",");
+ sv_catpv(PL_Sv,"\" Locally applied patches:\\n\",");
for (i = 1; i <= LOCAL_PATCH_COUNT; i++) {
- if (localpatches[i])
- sv_catpvf(Sv,"\" \\t%s\\n\",",localpatches[i]);
+ if (PL_localpatches[i])
+ sv_catpvf(PL_Sv,"\" \\t%s\\n\",",PL_localpatches[i]);
}
}
#endif
- sv_catpvf(Sv,"\" Built under %s\\n\"",OSNAME);
+ sv_catpvf(PL_Sv,"\" Built under %s\\n\"",OSNAME);
#ifdef __DATE__
# ifdef __TIME__
- sv_catpvf(Sv,",\" Compiled at %s %s\\n\"",__DATE__,__TIME__);
+ sv_catpvf(PL_Sv,",\" Compiled at %s %s\\n\"",__DATE__,__TIME__);
# else
- sv_catpvf(Sv,",\" Compiled on %s\\n\"",__DATE__);
+ sv_catpvf(PL_Sv,",\" Compiled on %s\\n\"",__DATE__);
# endif
#endif
- sv_catpv(Sv, "; \
+ sv_catpv(PL_Sv, "; \
$\"=\"\\n \"; \
@env = map { \"$_=\\\"$ENV{$_}\\\"\" } sort grep {/^PERL/} keys %ENV; \
print \" \\%ENV:\\n @env\\n\" if @env; \
print \" \\@INC:\\n @INC\\n\";");
}
else {
- Sv = newSVpv("config_vars(qw(",0);
- sv_catpv(Sv, ++s);
- sv_catpv(Sv, "))");
+ PL_Sv = newSVpv("config_vars(qw(",0);
+ sv_catpv(PL_Sv, ++s);
+ sv_catpv(PL_Sv, "))");
s += strlen(s);
}
- av_push(preambleav, Sv);
+ av_push(PL_preambleav, PL_Sv);
scriptname = BIT_BUCKET; /* don't look for script or read stdin */
goto reswitch;
case 'x':
- doextract = TRUE;
+ PL_doextract = TRUE;
s++;
if (*s)
- cddir = savepv(s);
+ PL_cddir = savepv(s);
break;
case 0:
break;
@@ -725,7 +892,7 @@ print \" \\@INC:\\n @INC\\n\";");
}
switch_end:
- if (!tainting && (s = getenv("PERL5OPT"))) {
+ if (!PL_tainting && (s = PerlEnv_getenv("PERL5OPT"))) {
while (s && *s) {
while (isSPACE(*s))
s++;
@@ -744,20 +911,13 @@ print \" \\@INC:\\n @INC\\n\";");
if (!scriptname)
scriptname = argv[0];
- if (e_fp) {
- if (PerlIO_flush(e_fp) || PerlIO_error(e_fp) || PerlIO_close(e_fp)) {
-#ifndef MULTIPLICITY
- warn("Did you forget to compile with -DMULTIPLICITY?");
-#endif
- croak("Can't write to temp file for -e: %s", Strerror(errno));
- }
- e_fp = Nullfp;
+ if (PL_e_script) {
argc++,argv--;
- scriptname = e_tmpname;
+ scriptname = BIT_BUCKET; /* don't look for script or read stdin */
}
else if (scriptname == Nullch) {
#ifdef MSDOS
- if ( isatty(PerlIO_fileno(PerlIO_stdin())) )
+ if ( PerlLIO_isatty(PerlIO_fileno(PerlIO_stdin())) )
moreswitches("h");
#endif
scriptname = "-";
@@ -765,101 +925,118 @@ print \" \\@INC:\\n @INC\\n\";");
init_perllib();
- open_script(scriptname,dosearch,sv);
+ open_script(scriptname,dosearch,sv,&fdscript);
- validate_suid(validarg, scriptname);
+ validate_suid(validarg, scriptname,fdscript);
- if (doextract)
+ if (PL_doextract)
find_beginning();
- main_cv = compcv = (CV*)NEWSV(1104,0);
- sv_upgrade((SV *)compcv, SVt_PVCV);
- CvUNIQUE_on(compcv);
-
- comppad = newAV();
- av_push(comppad, Nullsv);
- curpad = AvARRAY(comppad);
- comppad_name = newAV();
- comppad_name_fill = 0;
- min_intro_pending = 0;
- padix = 0;
+ PL_main_cv = PL_compcv = (CV*)NEWSV(1104,0);
+ sv_upgrade((SV *)PL_compcv, SVt_PVCV);
+ CvUNIQUE_on(PL_compcv);
+
+ PL_comppad = newAV();
+ av_push(PL_comppad, Nullsv);
+ PL_curpad = AvARRAY(PL_comppad);
+ PL_comppad_name = newAV();
+ PL_comppad_name_fill = 0;
+ PL_min_intro_pending = 0;
+ PL_padix = 0;
+#ifdef USE_THREADS
+ av_store(PL_comppad_name, 0, newSVpv("@_", 2));
+ PL_curpad[0] = (SV*)newAV();
+ SvPADMY_on(PL_curpad[0]); /* XXX Needed? */
+ CvOWNER(PL_compcv) = 0;
+ New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);
+ MUTEX_INIT(CvMUTEXP(PL_compcv));
+#endif /* USE_THREADS */
comppadlist = newAV();
AvREAL_off(comppadlist);
- av_store(comppadlist, 0, (SV*)comppad_name);
- av_store(comppadlist, 1, (SV*)comppad);
- CvPADLIST(compcv) = comppadlist;
+ av_store(comppadlist, 0, (SV*)PL_comppad_name);
+ av_store(comppadlist, 1, (SV*)PL_comppad);
+ CvPADLIST(PL_compcv) = comppadlist;
boot_core_UNIVERSAL();
+
if (xsinit)
- (*xsinit)(); /* in case linked C routines want magical variables */
-#if defined(VMS) || defined(WIN32)
+ (*xsinit)(PERL_OBJECT_THIS); /* in case linked C routines want magical variables */
+#if defined(VMS) || defined(WIN32) || defined(DJGPP)
init_os_extras();
#endif
init_predump_symbols();
- if (!do_undump)
+ /* init_postdump_symbols not currently designed to be called */
+ /* more than once (ENV isn't cleared first, for example) */
+ /* But running with -u leaves %ENV & @ARGV undefined! XXX */
+ if (!PL_do_undump)
init_postdump_symbols(argc,argv,env);
init_lexer();
/* now parse the script */
- error_count = 0;
- if (yyparse() || error_count) {
- if (minus_c)
- croak("%s had compilation errors.\n", origfilename);
+ SETERRNO(0,SS$_NORMAL);
+ PL_error_count = 0;
+ if (yyparse() || PL_error_count) {
+ if (PL_minus_c)
+ croak("%s had compilation errors.\n", PL_origfilename);
else {
croak("Execution of %s aborted due to compilation errors.\n",
- origfilename);
+ PL_origfilename);
}
}
- curcop->cop_line = 0;
- curstash = defstash;
- preprocess = FALSE;
- if (e_tmpname) {
- (void)UNLINK(e_tmpname);
- Safefree(e_tmpname);
- e_tmpname = Nullch;
+ PL_curcop->cop_line = 0;
+ PL_curstash = PL_defstash;
+ PL_preprocess = FALSE;
+ if (PL_e_script) {
+ SvREFCNT_dec(PL_e_script);
+ PL_e_script = Nullsv;
}
/* now that script is parsed, we can modify record separator */
- SvREFCNT_dec(rs);
- rs = SvREFCNT_inc(nrs);
- sv_setsv(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), rs);
-
- if (do_undump)
+ SvREFCNT_dec(PL_rs);
+ PL_rs = SvREFCNT_inc(PL_nrs);
+ sv_setsv(perl_get_sv("/", TRUE), PL_rs);
+ if (PL_do_undump)
my_unexec();
- if (dowarn)
- gv_check(defstash);
+ if (PL_dowarn)
+ gv_check(PL_defstash);
LEAVE;
FREETMPS;
#ifdef MYMALLOC
- if ((s=getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2)
+ if ((s=PerlEnv_getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2)
dump_mstats("after compilation:");
#endif
ENTER;
- restartop = 0;
+ PL_restartop = 0;
JMPENV_POP;
return 0;
}
int
-perl_run(sv_interp)
-PerlInterpreter *sv_interp;
+#ifdef PERL_OBJECT
+CPerlObj::perl_run(void)
+#else
+perl_run(PerlInterpreter *sv_interp)
+#endif
{
+ dSP;
I32 oldscope;
dJMPENV;
int ret;
- if (!(curinterp = sv_interp))
+#ifndef PERL_OBJECT
+ if (!(PL_curinterp = sv_interp))
return 255;
+#endif
- oldscope = scopestack_ix;
+ oldscope = PL_scopestack_ix;
JMPENV_PUSH(ret);
switch (ret) {
@@ -868,58 +1045,59 @@ PerlInterpreter *sv_interp;
break;
case 2:
/* my_exit() was called */
- while (scopestack_ix > oldscope)
+ while (PL_scopestack_ix > oldscope)
LEAVE;
FREETMPS;
- curstash = defstash;
- if (endav)
- call_list(oldscope, endav);
+ PL_curstash = PL_defstash;
+ if (PL_endav)
+ call_list(oldscope, PL_endav);
#ifdef MYMALLOC
- if (getenv("PERL_DEBUG_MSTATS"))
+ if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
dump_mstats("after execution: ");
#endif
JMPENV_POP;
return STATUS_NATIVE_EXPORT;
case 3:
- if (!restartop) {
+ if (!PL_restartop) {
PerlIO_printf(PerlIO_stderr(), "panic: restartop\n");
FREETMPS;
JMPENV_POP;
return 1;
}
- if (curstack != mainstack) {
- dSP;
- SWITCHSTACK(curstack, mainstack);
- }
+ POPSTACK_TO(PL_mainstack);
break;
}
DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support.\n",
- sawampersand ? "Enabling" : "Omitting"));
+ PL_sawampersand ? "Enabling" : "Omitting"));
- if (!restartop) {
+ if (!PL_restartop) {
DEBUG_x(dump_all());
DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n"));
+ DEBUG_S(PerlIO_printf(Perl_debug_log, "main thread is 0x%lx\n",
+ (unsigned long) thr));
- if (minus_c) {
- PerlIO_printf(PerlIO_stderr(), "%s syntax OK\n", origfilename);
+ if (PL_minus_c) {
+ PerlIO_printf(PerlIO_stderr(), "%s syntax OK\n", PL_origfilename);
my_exit(0);
}
- if (PERLDB_SINGLE && DBsingle)
- sv_setiv(DBsingle, 1);
+ if (PERLDB_SINGLE && PL_DBsingle)
+ sv_setiv(PL_DBsingle, 1);
+ if (PL_initav)
+ call_list(oldscope, PL_initav);
}
/* do it */
- if (restartop) {
- op = restartop;
- restartop = 0;
- runops();
+ if (PL_restartop) {
+ PL_op = PL_restartop;
+ PL_restartop = 0;
+ CALLRUNOPS();
}
- else if (main_start) {
- CvDEPTH(main_cv) = 1;
- op = main_start;
- runops();
+ else if (PL_main_start) {
+ CvDEPTH(PL_main_cv) = 1;
+ PL_op = PL_main_start;
+ CALLRUNOPS();
}
my_exit(0);
@@ -928,20 +1106,26 @@ PerlInterpreter *sv_interp;
}
SV*
-perl_get_sv(name, create)
-char* name;
-I32 create;
+perl_get_sv(char *name, I32 create)
{
- GV* gv = gv_fetchpv(name, create, SVt_PV);
+ GV *gv;
+#ifdef USE_THREADS
+ if (name[1] == '\0' && !isALPHA(name[0])) {
+ PADOFFSET tmp = find_threadsv(name);
+ if (tmp != NOT_IN_PAD) {
+ dTHR;
+ return THREADSV(tmp);
+ }
+ }
+#endif /* USE_THREADS */
+ gv = gv_fetchpv(name, create, SVt_PV);
if (gv)
return GvSV(gv);
return Nullsv;
}
AV*
-perl_get_av(name, create)
-char* name;
-I32 create;
+perl_get_av(char *name, I32 create)
{
GV* gv = gv_fetchpv(name, create, SVt_PVAV);
if (create)
@@ -952,9 +1136,7 @@ I32 create;
}
HV*
-perl_get_hv(name, create)
-char* name;
-I32 create;
+perl_get_hv(char *name, I32 create)
{
GV* gv = gv_fetchpv(name, create, SVt_PVHV);
if (create)
@@ -965,11 +1147,10 @@ I32 create;
}
CV*
-perl_get_cv(name, create)
-char* name;
-I32 create;
+perl_get_cv(char *name, I32 create)
{
GV* gv = gv_fetchpv(name, create, SVt_PVCV);
+ /* XXX unsafe for threads if eval_owner isn't held */
if (create && !GvCVu(gv))
return newSUB(start_subparse(FALSE, 0),
newSVOP(OP_CONST, 0, newSVpv(name,0)),
@@ -983,14 +1164,14 @@ I32 create;
/* Be sure to refetch the stack pointer after calling these routines. */
I32
-perl_call_argv(subname, flags, argv)
-char *subname;
-I32 flags; /* See G_* flags in cop.h */
-register char **argv; /* null terminated arg list */
+perl_call_argv(char *sub_name, I32 flags, register char **argv)
+
+ /* See G_* flags in cop.h */
+ /* null terminated arg list */
{
dSP;
- PUSHMARK(sp);
+ PUSHMARK(SP);
if (argv) {
while (*argv) {
XPUSHs(sv_2mortal(newSVpv(*argv,0)));
@@ -998,48 +1179,49 @@ register char **argv; /* null terminated arg list */
}
PUTBACK;
}
- return perl_call_pv(subname, flags);
+ return perl_call_pv(sub_name, flags);
}
I32
-perl_call_pv(subname, flags)
-char *subname; /* name of the subroutine */
-I32 flags; /* See G_* flags in cop.h */
+perl_call_pv(char *sub_name, I32 flags)
+ /* name of the subroutine */
+ /* See G_* flags in cop.h */
{
- return perl_call_sv((SV*)perl_get_cv(subname, TRUE), flags);
+ return perl_call_sv((SV*)perl_get_cv(sub_name, TRUE), flags);
}
I32
-perl_call_method(methname, flags)
-char *methname; /* name of the subroutine */
-I32 flags; /* See G_* flags in cop.h */
+perl_call_method(char *methname, I32 flags)
+ /* name of the subroutine */
+ /* See G_* flags in cop.h */
{
dSP;
OP myop;
- if (!op)
- op = &myop;
+ if (!PL_op)
+ PL_op = &myop;
XPUSHs(sv_2mortal(newSVpv(methname,0)));
PUTBACK;
- pp_method();
- return perl_call_sv(*stack_sp--, flags);
+ pp_method(ARGS);
+ if(PL_op == &myop)
+ PL_op = Nullop;
+ return perl_call_sv(*PL_stack_sp--, flags);
}
/* May be called with any of a CV, a GV, or an SV containing the name. */
I32
-perl_call_sv(sv, flags)
-SV* sv;
-I32 flags; /* See G_* flags in cop.h */
+perl_call_sv(SV *sv, I32 flags)
+
+ /* See G_* flags in cop.h */
{
+ dSP;
LOGOP myop; /* fake syntax tree node */
- SV** sp = stack_sp;
I32 oldmark;
I32 retval;
I32 oldscope;
- static CV *DBcv;
bool oldcatch = CATCH_GET;
dJMPENV;
int ret;
- OP* oldop = op;
+ OP* oldop = PL_op;
if (flags & G_DISCARD) {
ENTER;
@@ -1053,45 +1235,46 @@ I32 flags; /* See G_* flags in cop.h */
myop.op_flags |= ((flags & G_VOID) ? OPf_WANT_VOID :
(flags & G_ARRAY) ? OPf_WANT_LIST :
OPf_WANT_SCALAR);
- SAVESPTR(op);
- op = (OP*)&myop;
+ SAVEOP();
+ PL_op = (OP*)&myop;
- EXTEND(stack_sp, 1);
- *++stack_sp = sv;
+ EXTEND(PL_stack_sp, 1);
+ *++PL_stack_sp = sv;
oldmark = TOPMARK;
- oldscope = scopestack_ix;
+ oldscope = PL_scopestack_ix;
- if (PERLDB_SUB && curstash != debstash
+ if (PERLDB_SUB && PL_curstash != PL_debstash
/* Handle first BEGIN of -d. */
- && (DBcv || (DBcv = GvCV(DBsub)))
+ && (PL_DBcv || (PL_DBcv = GvCV(PL_DBsub)))
/* Try harder, since this may have been a sighandler, thus
* curstash may be meaningless. */
- && (SvTYPE(sv) != SVt_PVCV || CvSTASH((CV*)sv) != debstash))
- op->op_private |= OPpENTERSUB_DB;
+ && (SvTYPE(sv) != SVt_PVCV || CvSTASH((CV*)sv) != PL_debstash)
+ && !(flags & G_NODEBUG))
+ PL_op->op_private |= OPpENTERSUB_DB;
if (flags & G_EVAL) {
- cLOGOP->op_other = op;
- markstack_ptr--;
+ cLOGOP->op_other = PL_op;
+ PL_markstack_ptr--;
/* we're trying to emulate pp_entertry() here */
{
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
ENTER;
SAVETMPS;
- push_return(op->op_next);
- PUSHBLOCK(cx, CXt_EVAL, stack_sp);
+ push_return(PL_op->op_next);
+ PUSHBLOCK(cx, CXt_EVAL, PL_stack_sp);
PUSHEVAL(cx, 0, 0);
- eval_root = op; /* Only needed so that goto works right. */
+ PL_eval_root = PL_op; /* Only needed so that goto works right. */
- in_eval = 1;
+ PL_in_eval = 1;
if (flags & G_KEEPERR)
- in_eval |= 4;
+ PL_in_eval |= 4;
else
- sv_setpv(GvSV(errgv),"");
+ sv_setpv(ERRSV,"");
}
- markstack_ptr++;
+ PL_markstack_ptr++;
JMPENV_PUSH(ret);
switch (ret) {
@@ -1102,25 +1285,25 @@ I32 flags; /* See G_* flags in cop.h */
/* FALL THROUGH */
case 2:
/* my_exit() was called */
- curstash = defstash;
+ PL_curstash = PL_defstash;
FREETMPS;
JMPENV_POP;
- if (statusvalue)
+ if (PL_statusvalue)
croak("Callback called exit");
my_exit_jump();
/* NOTREACHED */
case 3:
- if (restartop) {
- op = restartop;
- restartop = 0;
+ if (PL_restartop) {
+ PL_op = PL_restartop;
+ PL_restartop = 0;
break;
}
- stack_sp = stack_base + oldmark;
+ PL_stack_sp = PL_stack_base + oldmark;
if (flags & G_ARRAY)
retval = 0;
else {
retval = 1;
- *++stack_sp = &sv_undef;
+ *++PL_stack_sp = &PL_sv_undef;
}
goto cleanup;
}
@@ -1128,27 +1311,27 @@ I32 flags; /* See G_* flags in cop.h */
else
CATCH_SET(TRUE);
- if (op == (OP*)&myop)
- op = pp_entersub();
- if (op)
- runops();
- retval = stack_sp - (stack_base + oldmark);
+ if (PL_op == (OP*)&myop)
+ PL_op = pp_entersub(ARGS);
+ if (PL_op)
+ CALLRUNOPS();
+ retval = PL_stack_sp - (PL_stack_base + oldmark);
if ((flags & G_EVAL) && !(flags & G_KEEPERR))
- sv_setpv(GvSV(errgv),"");
+ sv_setpv(ERRSV,"");
cleanup:
if (flags & G_EVAL) {
- if (scopestack_ix > oldscope) {
+ if (PL_scopestack_ix > oldscope) {
SV **newsp;
PMOP *newpm;
I32 gimme;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 optype;
POPBLOCK(cx,newpm);
POPEVAL(cx);
pop_return();
- curpm = newpm;
+ PL_curpm = newpm;
LEAVE;
}
JMPENV_POP;
@@ -1157,42 +1340,42 @@ I32 flags; /* See G_* flags in cop.h */
CATCH_SET(oldcatch);
if (flags & G_DISCARD) {
- stack_sp = stack_base + oldmark;
+ PL_stack_sp = PL_stack_base + oldmark;
retval = 0;
FREETMPS;
LEAVE;
}
- op = oldop;
+ PL_op = oldop;
return retval;
}
/* Eval a string. The G_EVAL flag is always assumed. */
I32
-perl_eval_sv(sv, flags)
-SV* sv;
-I32 flags; /* See G_* flags in cop.h */
+perl_eval_sv(SV *sv, I32 flags)
+
+ /* See G_* flags in cop.h */
{
+ dSP;
UNOP myop; /* fake syntax tree node */
- SV** sp = stack_sp;
- I32 oldmark = sp - stack_base;
+ I32 oldmark = SP - PL_stack_base;
I32 retval;
I32 oldscope;
dJMPENV;
int ret;
- OP* oldop = op;
+ OP* oldop = PL_op;
if (flags & G_DISCARD) {
ENTER;
SAVETMPS;
}
- SAVESPTR(op);
- op = (OP*)&myop;
- Zero(op, 1, UNOP);
- EXTEND(stack_sp, 1);
- *++stack_sp = sv;
- oldscope = scopestack_ix;
+ SAVEOP();
+ PL_op = (OP*)&myop;
+ Zero(PL_op, 1, UNOP);
+ EXTEND(PL_stack_sp, 1);
+ *++PL_stack_sp = sv;
+ oldscope = PL_scopestack_ix;
if (!(flags & G_NOARGS))
myop.op_flags = OPf_STACKED;
@@ -1213,58 +1396,56 @@ I32 flags; /* See G_* flags in cop.h */
/* FALL THROUGH */
case 2:
/* my_exit() was called */
- curstash = defstash;
+ PL_curstash = PL_defstash;
FREETMPS;
JMPENV_POP;
- if (statusvalue)
+ if (PL_statusvalue)
croak("Callback called exit");
my_exit_jump();
/* NOTREACHED */
case 3:
- if (restartop) {
- op = restartop;
- restartop = 0;
+ if (PL_restartop) {
+ PL_op = PL_restartop;
+ PL_restartop = 0;
break;
}
- stack_sp = stack_base + oldmark;
+ PL_stack_sp = PL_stack_base + oldmark;
if (flags & G_ARRAY)
retval = 0;
else {
retval = 1;
- *++stack_sp = &sv_undef;
+ *++PL_stack_sp = &PL_sv_undef;
}
goto cleanup;
}
- if (op == (OP*)&myop)
- op = pp_entereval();
- if (op)
- runops();
- retval = stack_sp - (stack_base + oldmark);
+ if (PL_op == (OP*)&myop)
+ PL_op = pp_entereval(ARGS);
+ if (PL_op)
+ CALLRUNOPS();
+ retval = PL_stack_sp - (PL_stack_base + oldmark);
if (!(flags & G_KEEPERR))
- sv_setpv(GvSV(errgv),"");
+ sv_setpv(ERRSV,"");
cleanup:
JMPENV_POP;
if (flags & G_DISCARD) {
- stack_sp = stack_base + oldmark;
+ PL_stack_sp = PL_stack_base + oldmark;
retval = 0;
FREETMPS;
LEAVE;
}
- op = oldop;
+ PL_op = oldop;
return retval;
}
SV*
-perl_eval_pv(p, croak_on_error)
-char* p;
-I32 croak_on_error;
+perl_eval_pv(char *p, I32 croak_on_error)
{
dSP;
SV* sv = newSVpv(p, 0);
- PUSHMARK(sp);
+ PUSHMARK(SP);
perl_eval_sv(sv, G_SCALAR);
SvREFCNT_dec(sv);
@@ -1272,8 +1453,10 @@ I32 croak_on_error;
sv = POPs;
PUTBACK;
- if (croak_on_error && SvTRUE(GvSV(errgv)))
- croak(SvPVx(GvSV(errgv), na));
+ if (croak_on_error && SvTRUE(ERRSV)) {
+ STRLEN n_a;
+ croak(SvPVx(ERRSV, n_a));
+ }
return sv;
}
@@ -1281,21 +1464,23 @@ I32 croak_on_error;
/* Require a module. */
void
-perl_require_pv(pv)
-char* pv;
+perl_require_pv(char *pv)
{
- SV* sv = sv_newmortal();
+ SV* sv;
+ dSP;
+ PUSHSTACKi(PERLSI_REQUIRE);
+ PUTBACK;
+ sv = sv_newmortal();
sv_setpv(sv, "require '");
sv_catpv(sv, pv);
sv_catpv(sv, "'");
perl_eval_sv(sv, G_DISCARD);
+ SPAGAIN;
+ POPSTACK;
}
void
-magicname(sym,name,namlen)
-char *sym;
-char *name;
-I32 namlen;
+magicname(char *sym, char *name, I32 namlen)
{
register GV *gv;
@@ -1303,14 +1488,14 @@ I32 namlen;
sv_magic(GvSV(gv), (SV*)gv, 0, name, namlen);
}
-static void
-usage(name) /* XXX move this out into a module ? */
-char *name;
+STATIC void
+usage(char *name) /* XXX move this out into a module ? */
+
{
/* This message really ought to be max 23 lines.
* Removed -h because the user already knows that opton. Others? */
- static char *usage[] = {
+ static char *usage_msg[] = {
"-0[octal] specify record separator (\\0, if no argument)",
"-a autosplit mode with -n or -p (splits $_ into @F)",
"-c check syntax only (runs BEGIN and END blocks)",
@@ -1330,14 +1515,14 @@ char *name;
"-T turn on tainting checks",
"-u dump core after parsing script",
"-U allow unsafe operations",
-"-v print version number and patchlevel of perl",
+"-v print version number, patchlevel plus VERY IMPORTANT perl info",
"-V[:variable] print perl configuration information",
"-w TURN WARNINGS ON FOR COMPILATION OF YOUR SCRIPT. Recommended.",
"-x[directory] strip off text before #!perl line and perhaps cd to directory",
"\n",
NULL
};
- char **p = usage;
+ char **p = usage_msg;
printf("\nUsage: %s [switches] [--] [programfile] [arguments]", name);
while (*p)
@@ -1347,36 +1532,38 @@ NULL
/* This routine handles any switches that can be given during run */
char *
-moreswitches(s)
-char *s;
+moreswitches(char *s)
{
I32 numlen;
U32 rschar;
switch (*s) {
case '0':
+ {
+ dTHR;
rschar = scan_oct(s, 4, &numlen);
- SvREFCNT_dec(nrs);
+ SvREFCNT_dec(PL_nrs);
if (rschar & ~((U8)~0))
- nrs = &sv_undef;
+ PL_nrs = &PL_sv_undef;
else if (!rschar && numlen >= 2)
- nrs = newSVpv("", 0);
+ PL_nrs = newSVpv("", 0);
else {
char ch = rschar;
- nrs = newSVpv(&ch, 1);
+ PL_nrs = newSVpv(&ch, 1);
}
return s + numlen;
+ }
case 'F':
- minus_F = TRUE;
- splitstr = savepv(s + 1);
+ PL_minus_F = TRUE;
+ PL_splitstr = savepv(s + 1);
s += strlen(s);
return s;
case 'a':
- minus_a = TRUE;
+ PL_minus_a = TRUE;
s++;
return s;
case 'c':
- minus_c = TRUE;
+ PL_minus_c = TRUE;
s++;
return s;
case 'd':
@@ -1386,8 +1573,8 @@ char *s;
my_setenv("PERL5DB", form("use Devel::%s;", ++s));
s += strlen(s);
}
- if (!perldb) {
- perldb = PERLDB_ALL;
+ if (!PL_perldb) {
+ PL_perldb = PERLDB_ALL;
init_debugger();
}
return s;
@@ -1395,17 +1582,17 @@ char *s;
#ifdef DEBUGGING
forbid_setid("-D");
if (isALPHA(s[1])) {
- static char debopts[] = "psltocPmfrxuLHXD";
+ static char debopts[] = "psltocPmfrxuLHXDS";
char *d;
for (s++; *s && (d = strchr(debopts,*s)); s++)
- debug |= 1 << (d - debopts);
+ PL_debug |= 1 << (d - debopts);
}
else {
- debug = atoi(s+1);
+ PL_debug = atoi(s+1);
for (s++; isDIGIT(*s); s++) ;
}
- debug |= 0x80000000;
+ PL_debug |= 0x80000000;
#else
warn("Recompile perl with -DDEBUGGING to use -D switch\n");
for (s++; isALNUM(*s); s++) ;
@@ -1413,16 +1600,19 @@ char *s;
/*SUPPRESS 530*/
return s;
case 'h':
- usage(origargv[0]);
- exit(0);
+ usage(PL_origargv[0]);
+ PerlProc_exit(0);
case 'i':
- if (inplace)
- Safefree(inplace);
- inplace = savepv(s+1);
+ if (PL_inplace)
+ Safefree(PL_inplace);
+ PL_inplace = savepv(s+1);
/*SUPPRESS 530*/
- for (s = inplace; *s && !isSPACE(*s); s++) ;
- if (*s)
+ for (s = PL_inplace; *s && !isSPACE(*s); s++) ;
+ if (*s) {
*s++ = '\0';
+ if (*s == '-') /* Additional switches on #! line. */
+ s++;
+ }
return s;
case 'I': /* -I handled both here and in parse_perl() */
forbid_setid("-I");
@@ -1441,24 +1631,25 @@ char *s;
croak("No space allowed after -I");
return s;
case 'l':
- minus_l = TRUE;
+ PL_minus_l = TRUE;
s++;
- if (ors)
- Safefree(ors);
+ if (PL_ors)
+ Safefree(PL_ors);
if (isDIGIT(*s)) {
- ors = savepv("\n");
- orslen = 1;
- *ors = scan_oct(s, 3 + (*s == '0'), &numlen);
+ PL_ors = savepv("\n");
+ PL_orslen = 1;
+ *PL_ors = scan_oct(s, 3 + (*s == '0'), &numlen);
s += numlen;
}
else {
- if (RsPARA(nrs)) {
- ors = "\n\n";
- orslen = 2;
+ dTHR;
+ if (RsPARA(PL_nrs)) {
+ PL_ors = "\n\n";
+ PL_orslen = 2;
}
else
- ors = SvPV(nrs, orslen);
- ors = savepvn(ors, orslen);
+ PL_ors = SvPV(PL_nrs, PL_orslen);
+ PL_ors = savepvn(PL_ors, PL_orslen);
}
return s;
case 'M':
@@ -1468,58 +1659,59 @@ char *s;
forbid_setid("-m"); /* XXX ? */
if (*++s) {
char *start;
+ SV *sv;
char *use = "use ";
/* -M-foo == 'no foo' */
if (*s == '-') { use = "no "; ++s; }
- Sv = newSVpv(use,0);
+ sv = newSVpv(use,0);
start = s;
/* We allow -M'Module qw(Foo Bar)' */
while(isALNUM(*s) || *s==':') ++s;
if (*s != '=') {
- sv_catpv(Sv, start);
+ sv_catpv(sv, start);
if (*(start-1) == 'm') {
if (*s != '\0')
croak("Can't use '%c' after -mname", *s);
- sv_catpv( Sv, " ()");
+ sv_catpv( sv, " ()");
}
} else {
- sv_catpvn(Sv, start, s-start);
- sv_catpv(Sv, " split(/,/,q{");
- sv_catpv(Sv, ++s);
- sv_catpv(Sv, "})");
+ sv_catpvn(sv, start, s-start);
+ sv_catpv(sv, " split(/,/,q{");
+ sv_catpv(sv, ++s);
+ sv_catpv(sv, "})");
}
s += strlen(s);
- if (preambleav == NULL)
- preambleav = newAV();
- av_push(preambleav, Sv);
+ if (PL_preambleav == NULL)
+ PL_preambleav = newAV();
+ av_push(PL_preambleav, sv);
}
else
croak("No space allowed after -%c", *(s-1));
return s;
case 'n':
- minus_n = TRUE;
+ PL_minus_n = TRUE;
s++;
return s;
case 'p':
- minus_p = TRUE;
+ PL_minus_p = TRUE;
s++;
return s;
case 's':
forbid_setid("-s");
- doswitches = TRUE;
+ PL_doswitches = TRUE;
s++;
return s;
case 'T':
- if (!tainting)
+ if (!PL_tainting)
croak("Too late for \"-T\" option");
s++;
return s;
case 'u':
- do_undump = TRUE;
+ PL_do_undump = TRUE;
s++;
return s;
case 'U':
- unsafe = TRUE;
+ PL_unsafe = TRUE;
s++;
return s;
case 'v':
@@ -1528,7 +1720,7 @@ char *s;
PATCHLEVEL, SUBVERSION, ARCHNAME);
#else
printf("\nThis is perl, version %s built for %s",
- patchlevel, ARCHNAME);
+ PL_patchlevel, ARCHNAME);
#endif
#if defined(LOCAL_PATCH_COUNT)
if (LOCAL_PATCH_COUNT > 0)
@@ -1536,26 +1728,48 @@ char *s;
LOCAL_PATCH_COUNT, (LOCAL_PATCH_COUNT!=1) ? "es" : "");
#endif
- printf("\n\nCopyright 1987-1997, Larry Wall\n");
+ printf("\n\nCopyright 1987-1999, Larry Wall\n");
#ifdef MSDOS
printf("\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
#endif
#ifdef DJGPP
printf("djgpp v2 port (jpl5003c) by Hirofumi Watanabe, 1996\n");
+ printf("djgpp v2 port (perl5004+) by Laszlo Molnar, 1997-1998\n");
#endif
#ifdef OS2
printf("\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
- "Version 5 port Copyright (c) 1994-1997, Andreas Kaiser, Ilya Zakharevich\n");
+ "Version 5 port Copyright (c) 1994-1998, Andreas Kaiser, Ilya Zakharevich\n");
#endif
#ifdef atarist
printf("atariST series port, ++jrb bammi@cadence.com\n");
#endif
+#ifdef __BEOS__
+ printf("BeOS port Copyright Tom Spindler, 1997-1998\n");
+#endif
+#ifdef MPE
+ printf("MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-1998\n");
+#endif
+#ifdef OEMVS
+ printf("MVS (OS390) port by Mortice Kern Systems, 1997-1998\n");
+#endif
+#ifdef __VOS__
+ printf("Stratus VOS port by Paul_Green@stratus.com, 1997-1999\n");
+#endif
+#ifdef __MINT__
+ printf("MiNT port by Guido Flohr, 1997\n");
+#endif
+#ifdef BINARY_BUILD_NOTICE
+ BINARY_BUILD_NOTICE;
+#endif
printf("\n\
Perl may be copied only under the terms of either the Artistic License or the\n\
-GNU General Public License, which may be found in the Perl 5.0 source kit.\n\n");
- exit(0);
+GNU General Public License, which may be found in the Perl 5.0 source kit.\n\n\
+Complete documentation for Perl, including FAQ lists, should be found on\n\
+this system using `man perl' or `perldoc perl'. If you have access to the\n\
+Internet, point your browser at http://www.perl.com/, the Perl Home Page.\n\n");
+ PerlProc_exit(0);
case 'w':
- dowarn = TRUE;
+ PL_dowarn = TRUE;
s++;
return s;
case '*':
@@ -1565,6 +1779,9 @@ GNU General Public License, which may be found in the Perl 5.0 source kit.\n\n")
break;
case '-':
case 0:
+#if defined(WIN32) || !defined(PERL_STRICT_CR)
+ case '\r':
+#endif
case '\n':
case '\t':
break;
@@ -1573,7 +1790,7 @@ GNU General Public License, which may be found in the Perl 5.0 source kit.\n\n")
break;
#endif
case 'P':
- if (preprocess)
+ if (PL_preprocess)
return s+1;
/* FALL THROUGH */
default:
@@ -1585,26 +1802,25 @@ GNU General Public License, which may be found in the Perl 5.0 source kit.\n\n")
/* compliments of Tom Christiansen */
/* unexec() can be found in the Gnu emacs distribution */
+/* Known to work with -DUNEXEC and using unexelf.c from GNU emacs-20.2 */
void
-my_unexec()
+my_unexec(void)
{
#ifdef UNEXEC
SV* prog;
SV* file;
- int status;
+ int status = 1;
extern int etext;
- prog = newSVpv(BIN_EXP);
+ prog = newSVpv(BIN_EXP, 0);
sv_catpv(prog, "/perl");
- file = newSVpv(origfilename);
+ file = newSVpv(PL_origfilename, 0);
sv_catpv(file, ".perldump");
- status = unexec(SvPVX(file), SvPVX(prog), &etext, sbrk(0), 0);
- if (status)
- PerlIO_printf(PerlIO_stderr(), "unexec of %s into %s failed!\n",
- SvPVX(prog), SvPVX(file));
- exit(status);
+ unexec(SvPVX(file), SvPVX(prog), &etext, sbrk(0), 0);
+ /* unexec prints msg to stderr in case of failure */
+ PerlProc_exit(status);
#else
# ifdef VMS
# include <lib$routines.h>
@@ -1615,263 +1831,156 @@ my_unexec()
#endif
}
-static void
-init_main_stash()
+/* initialize curinterp */
+STATIC void
+init_interp(void)
+{
+
+#ifdef PERL_OBJECT /* XXX kludge */
+#define I_REINIT \
+ STMT_START { \
+ PL_chopset = " \n-"; \
+ PL_copline = NOLINE; \
+ PL_curcop = &PL_compiling;\
+ PL_curcopdb = NULL; \
+ PL_dbargs = 0; \
+ PL_dlmax = 128; \
+ PL_laststatval = -1; \
+ PL_laststype = OP_STAT; \
+ PL_maxscream = -1; \
+ PL_maxsysfd = MAXSYSFD; \
+ PL_statname = Nullsv; \
+ PL_tmps_floor = -1; \
+ PL_tmps_ix = -1; \
+ PL_op_mask = NULL; \
+ PL_dlmax = 128; \
+ PL_laststatval = -1; \
+ PL_laststype = OP_STAT; \
+ PL_mess_sv = Nullsv; \
+ PL_splitstr = " "; \
+ PL_generation = 100; \
+ PL_exitlist = NULL; \
+ PL_exitlistlen = 0; \
+ PL_regindent = 0; \
+ PL_in_clean_objs = FALSE; \
+ PL_in_clean_all = FALSE; \
+ PL_profiledata = NULL; \
+ PL_rsfp = Nullfp; \
+ PL_rsfp_filters = Nullav; \
+ } STMT_END
+ I_REINIT;
+#else
+# ifdef MULTIPLICITY
+# define PERLVAR(var,type)
+# define PERLVARI(var,type,init) PL_curinterp->var = init;
+# define PERLVARIC(var,type,init) PL_curinterp->var = init;
+# include "intrpvar.h"
+# ifndef USE_THREADS
+# include "thrdvar.h"
+# endif
+# undef PERLVAR
+# undef PERLVARI
+# undef PERLVARIC
+# else
+# define PERLVAR(var,type)
+# define PERLVARI(var,type,init) PL_##var = init;
+# define PERLVARIC(var,type,init) PL_##var = init;
+# include "intrpvar.h"
+# ifndef USE_THREADS
+# include "thrdvar.h"
+# endif
+# undef PERLVAR
+# undef PERLVARI
+# undef PERLVARIC
+# endif
+#endif
+
+}
+
+STATIC void
+init_main_stash(void)
{
+ dTHR;
GV *gv;
/* Note that strtab is a rather special HV. Assumptions are made
about not iterating on it, and not adding tie magic to it.
It is properly deallocated in perl_destruct() */
- strtab = newHV();
- HvSHAREKEYS_off(strtab); /* mandatory */
- Newz(506,((XPVHV*)SvANY(strtab))->xhv_array,
- sizeof(HE*) * (((XPVHV*)SvANY(strtab))->xhv_max + 1), char);
+ PL_strtab = newHV();
+#ifdef USE_THREADS
+ MUTEX_INIT(&PL_strtab_mutex);
+#endif
+ HvSHAREKEYS_off(PL_strtab); /* mandatory */
+ hv_ksplit(PL_strtab, 512);
- curstash = defstash = newHV();
- curstname = newSVpv("main",4);
+ PL_curstash = PL_defstash = newHV();
+ PL_curstname = newSVpv("main",4);
gv = gv_fetchpv("main::",TRUE, SVt_PVHV);
SvREFCNT_dec(GvHV(gv));
- GvHV(gv) = (HV*)SvREFCNT_inc(defstash);
+ GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash);
SvREADONLY_on(gv);
- HvNAME(defstash) = savepv("main");
- incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
- GvMULTI_on(incgv);
- defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
- errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
- GvMULTI_on(errgv);
+ HvNAME(PL_defstash) = savepv("main");
+ PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
+ GvMULTI_on(PL_incgv);
+ PL_hintgv = gv_fetchpv("\010",TRUE, SVt_PV); /* ^H */
+ GvMULTI_on(PL_hintgv);
+ PL_defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
+ PL_errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
+ GvMULTI_on(PL_errgv);
+ PL_replgv = gv_fetchpv("\022", TRUE, SVt_PV); /* ^R */
+ GvMULTI_on(PL_replgv);
(void)form("%240s",""); /* Preallocate temp - for immediate signals. */
- sv_grow(GvSV(errgv), 240); /* Preallocate - for immediate signals. */
- sv_setpvn(GvSV(errgv), "", 0);
- curstash = defstash;
- compiling.cop_stash = defstash;
- debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
+ sv_grow(ERRSV, 240); /* Preallocate - for immediate signals. */
+ sv_setpvn(ERRSV, "", 0);
+ PL_curstash = PL_defstash;
+ PL_compiling.cop_stash = PL_defstash;
+ PL_debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
+ PL_globalstash = GvHV(gv_fetchpv("CORE::GLOBAL::", GV_ADDMULTI, SVt_PVHV));
/* We must init $/ before switches are processed. */
- sv_setpvn(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), "\n", 1);
+ sv_setpvn(perl_get_sv("/", TRUE), "\n", 1);
}
-#ifdef CAN_PROTOTYPE
-static void
-open_script(char *scriptname, bool dosearch, SV *sv)
-#else
-static void
-open_script(scriptname,dosearch,sv)
-char *scriptname;
-bool dosearch;
-SV *sv;
-#endif
+STATIC void
+open_script(char *scriptname, bool dosearch, SV *sv, int *fdscript)
{
- char *xfound = Nullch;
- char *xfailed = Nullch;
+ dTHR;
register char *s;
- I32 len;
- int retval;
-#if defined(DOSISH) && !defined(OS2) && !defined(atarist)
-# define SEARCH_EXTS ".bat", ".cmd", NULL
-# define MAX_EXT_LEN 4
-#endif
-#ifdef OS2
-# define SEARCH_EXTS ".cmd", ".btm", ".bat", ".pl", NULL
-# define MAX_EXT_LEN 4
-#endif
-#ifdef VMS
-# define SEARCH_EXTS ".pl", ".com", NULL
-# define MAX_EXT_LEN 4
-#endif
- /* additional extensions to try in each dir if scriptname not found */
-#ifdef SEARCH_EXTS
- char *ext[] = { SEARCH_EXTS };
- int extidx = 0, i = 0;
- char *curext = Nullch;
-#else
-# define MAX_EXT_LEN 0
-#endif
- /*
- * If dosearch is true and if scriptname does not contain path
- * delimiters, search the PATH for scriptname.
- *
- * If SEARCH_EXTS is also defined, will look for each
- * scriptname{SEARCH_EXTS} whenever scriptname is not found
- * while searching the PATH.
- *
- * Assuming SEARCH_EXTS is C<".foo",".bar",NULL>, PATH search
- * proceeds as follows:
- * If DOSISH:
- * + look for ./scriptname{,.foo,.bar}
- * + search the PATH for scriptname{,.foo,.bar}
- *
- * If !DOSISH:
- * + look *only* in the PATH for scriptname{,.foo,.bar} (note
- * this will not look in '.' if it's not in the PATH)
- */
+ *fdscript = -1;
-#ifdef VMS
- if (dosearch) {
- int hasdir, idx = 0, deftypes = 1;
- bool seen_dot = 1;
-
- hasdir = (strpbrk(scriptname,":[</") != Nullch) ;
- /* The first time through, just add SEARCH_EXTS to whatever we
- * already have, so we can check for default file types. */
- while (deftypes ||
- (!hasdir && my_trnlnm("DCL$PATH",tokenbuf,idx++)) )
- {
- if (deftypes) {
- deftypes = 0;
- *tokenbuf = '\0';
- }
- if ((strlen(tokenbuf) + strlen(scriptname)
- + MAX_EXT_LEN) >= sizeof tokenbuf)
- continue; /* don't search dir with too-long name */
- strcat(tokenbuf, scriptname);
-#else /* !VMS */
-
-#ifdef DOSISH
- if (strEQ(scriptname, "-"))
- dosearch = 0;
- if (dosearch) { /* Look in '.' first. */
- char *cur = scriptname;
-#ifdef SEARCH_EXTS
- if ((curext = strrchr(scriptname,'.'))) /* possible current ext */
- while (ext[i])
- if (strEQ(ext[i++],curext)) {
- extidx = -1; /* already has an ext */
- break;
- }
- do {
-#endif
- DEBUG_p(PerlIO_printf(Perl_debug_log,
- "Looking for %s\n",cur));
- if (Stat(cur,&statbuf) >= 0) {
- dosearch = 0;
- scriptname = cur;
-#ifdef SEARCH_EXTS
- break;
-#endif
- }
-#ifdef SEARCH_EXTS
- if (cur == scriptname) {
- len = strlen(scriptname);
- if (len+MAX_EXT_LEN+1 >= sizeof(tokenbuf))
- break;
- cur = strcpy(tokenbuf, scriptname);
- }
- } while (extidx >= 0 && ext[extidx] /* try an extension? */
- && strcpy(tokenbuf+len, ext[extidx++]));
-#endif
+ if (PL_e_script) {
+ PL_origfilename = savepv("-e");
}
-#endif
+ else {
+ /* if find_script() returns, it returns a malloc()-ed value */
+ PL_origfilename = scriptname = find_script(scriptname, dosearch, NULL, 1);
- if (dosearch && !strchr(scriptname, '/')
-#ifdef DOSISH
- && !strchr(scriptname, '\\')
-#endif
- && (s = getenv("PATH"))) {
- bool seen_dot = 0;
-
- bufend = s + strlen(s);
- while (s < bufend) {
-#if defined(atarist) || defined(DOSISH)
- for (len = 0; *s
-# ifdef atarist
- && *s != ','
-# endif
- && *s != ';'; len++, s++) {
- if (len < sizeof tokenbuf)
- tokenbuf[len] = *s;
- }
- if (len < sizeof tokenbuf)
- tokenbuf[len] = '\0';
-#else /* ! (atarist || DOSISH) */
- s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend,
- ':',
- &len);
-#endif /* ! (atarist || DOSISH) */
- if (s < bufend)
+ if (strnEQ(scriptname, "/dev/fd/", 8) && isDIGIT(scriptname[8]) ) {
+ char *s = scriptname + 8;
+ *fdscript = atoi(s);
+ while (isDIGIT(*s))
s++;
- if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tokenbuf)
- continue; /* don't search dir with too-long name */
- if (len
-#if defined(atarist) || defined(DOSISH)
- && tokenbuf[len - 1] != '/'
- && tokenbuf[len - 1] != '\\'
-#endif
- )
- tokenbuf[len++] = '/';
- if (len == 2 && tokenbuf[0] == '.')
- seen_dot = 1;
- (void)strcpy(tokenbuf + len, scriptname);
-#endif /* !VMS */
-
-#ifdef SEARCH_EXTS
- len = strlen(tokenbuf);
- if (extidx > 0) /* reset after previous loop */
- extidx = 0;
- do {
-#endif
- DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tokenbuf));
- retval = Stat(tokenbuf,&statbuf);
-#ifdef SEARCH_EXTS
- } while ( retval < 0 /* not there */
- && extidx>=0 && ext[extidx] /* try an extension? */
- && strcpy(tokenbuf+len, ext[extidx++])
- );
-#endif
- if (retval < 0)
- continue;
- if (S_ISREG(statbuf.st_mode)
- && cando(S_IRUSR,TRUE,&statbuf)
-#ifndef DOSISH
- && cando(S_IXUSR,TRUE,&statbuf)
-#endif
- )
- {
- xfound = tokenbuf; /* bingo! */
- break;
+ if (*s) {
+ scriptname = savepv(s + 1);
+ Safefree(PL_origfilename);
+ PL_origfilename = scriptname;
}
- if (!xfailed)
- xfailed = savepv(tokenbuf);
}
-#ifndef DOSISH
- if (!xfound && !seen_dot && !xfailed && (Stat(scriptname,&statbuf) < 0))
-#endif
- seen_dot = 1; /* Disable message. */
- if (!xfound)
- croak("Can't %s %s%s%s",
- (xfailed ? "execute" : "find"),
- (xfailed ? xfailed : scriptname),
- (xfailed ? "" : " on PATH"),
- (xfailed || seen_dot) ? "" : ", '.' not in PATH");
- if (xfailed)
- Safefree(xfailed);
- scriptname = xfound;
- }
-
- if (strnEQ(scriptname, "/dev/fd/", 8) && isDIGIT(scriptname[8]) ) {
- char *s = scriptname + 8;
- fdscript = atoi(s);
- while (isDIGIT(*s))
- s++;
- if (*s)
- scriptname = s + 1;
}
- else
- fdscript = -1;
- origfilename = savepv(e_tmpname ? "-e" : scriptname);
- curcop->cop_filegv = gv_fetchfile(origfilename);
- if (strEQ(origfilename,"-"))
+
+ PL_curcop->cop_filegv = gv_fetchfile(PL_origfilename);
+ if (strEQ(PL_origfilename,"-"))
scriptname = "";
- if (fdscript >= 0) {
- rsfp = PerlIO_fdopen(fdscript,"r");
+ if (*fdscript >= 0) {
+ PL_rsfp = PerlIO_fdopen(*fdscript,PERL_SCRIPT_MODE);
#if defined(HAS_FCNTL) && defined(F_SETFD)
- if (rsfp)
- fcntl(PerlIO_fileno(rsfp),F_SETFD,1); /* ensure close-on-exec */
+ if (PL_rsfp)
+ fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,1); /* ensure close-on-exec */
#endif
}
- else if (preprocess) {
+ else if (PL_preprocess) {
char *cpp_cfg = CPPSTDIN;
- SV *cpp = NEWSV(0,0);
+ SV *cpp = newSVpv("",0);
SV *cmd = NEWSV(0,0);
if (strEQ(cpp_cfg, "cppstdin"))
@@ -1895,7 +2004,7 @@ sed %s -e \"/^[^#]/b\" \
-e \"/^#[ ]*endif/b\" \
-e \"s/^#.*//\" \
%s | %_ -C %_ %s",
- (doextract ? "-e \"1,/^#/d\n\"" : ""),
+ (PL_doextract ? "-e \"1,/^#/d\n\"" : ""),
#else
sv_setpvf(cmd, "\
%s %s -e '/^[^#]/b' \
@@ -1915,67 +2024,129 @@ sed %s -e \"/^[^#]/b\" \
#else
"sed",
#endif
- (doextract ? "-e '1,/^#/d\n'" : ""),
+ (PL_doextract ? "-e '1,/^#/d\n'" : ""),
#endif
scriptname, cpp, sv, CPPMINUS);
- doextract = FALSE;
+ PL_doextract = FALSE;
#ifdef IAMSUID /* actually, this is caught earlier */
- if (euid != uid && !euid) { /* if running suidperl */
+ if (PL_euid != PL_uid && !PL_euid) { /* if running suidperl */
#ifdef HAS_SETEUID
- (void)seteuid(uid); /* musn't stay setuid root */
+ (void)seteuid(PL_uid); /* musn't stay setuid root */
#else
#ifdef HAS_SETREUID
- (void)setreuid((Uid_t)-1, uid);
+ (void)setreuid((Uid_t)-1, PL_uid);
#else
#ifdef HAS_SETRESUID
- (void)setresuid((Uid_t)-1, uid, (Uid_t)-1);
+ (void)setresuid((Uid_t)-1, PL_uid, (Uid_t)-1);
#else
- setuid(uid);
+ PerlProc_setuid(PL_uid);
#endif
#endif
#endif
- if (geteuid() != uid)
+ if (PerlProc_geteuid() != PL_uid)
croak("Can't do seteuid!\n");
}
#endif /* IAMSUID */
- rsfp = my_popen(SvPVX(cmd), "r");
+ PL_rsfp = PerlProc_popen(SvPVX(cmd), "r");
SvREFCNT_dec(cmd);
SvREFCNT_dec(cpp);
}
else if (!*scriptname) {
forbid_setid("program input from stdin");
- rsfp = PerlIO_stdin();
+ PL_rsfp = PerlIO_stdin();
}
else {
- rsfp = PerlIO_open(scriptname,"r");
+ PL_rsfp = PerlIO_open(scriptname,PERL_SCRIPT_MODE);
#if defined(HAS_FCNTL) && defined(F_SETFD)
- if (rsfp)
- fcntl(PerlIO_fileno(rsfp),F_SETFD,1); /* ensure close-on-exec */
+ if (PL_rsfp)
+ fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,1); /* ensure close-on-exec */
#endif
}
- if (e_tmpname) {
- e_fp = rsfp;
- }
- if (!rsfp) {
+ if (!PL_rsfp) {
#ifdef DOSUID
#ifndef IAMSUID /* in case script is not readable before setuid */
- if (euid && Stat(SvPVX(GvSV(curcop->cop_filegv)),&statbuf) >= 0 &&
- statbuf.st_mode & (S_ISUID|S_ISGID)) {
+ if (PL_euid &&
+ PerlLIO_stat(SvPVX(GvSV(PL_curcop->cop_filegv)),&PL_statbuf) >= 0 &&
+ PL_statbuf.st_mode & (S_ISUID|S_ISGID))
+ {
/* try again */
- execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
+ PerlProc_execv(form("%s/sperl%s", BIN_EXP, PL_patchlevel), PL_origargv);
croak("Can't do setuid\n");
}
#endif
#endif
croak("Can't open perl script \"%s\": %s\n",
- SvPVX(GvSV(curcop->cop_filegv)), Strerror(errno));
+ SvPVX(GvSV(PL_curcop->cop_filegv)), Strerror(errno));
+ }
+}
+
+#ifdef IAMSUID
+static int
+fd_on_nosuid_fs(int fd)
+{
+ int on_nosuid = 0;
+ int check_okay = 0;
+/*
+ * Preferred order: fstatvfs(), fstatfs(), getmntent().
+ * fstatvfs() is UNIX98.
+ * fstatfs() is BSD.
+ * getmntent() is O(number-of-mounted-filesystems) and can hang.
+ */
+
+# ifdef HAS_FSTATVFS
+ struct statvfs stfs;
+ check_okay = fstatvfs(fd, &stfs) == 0;
+ on_nosuid = check_okay && (stfs.f_flag & ST_NOSUID);
+# else
+# if defined(HAS_FSTATFS) && defined(HAS_STRUCT_STATFS_FLAGS)
+ struct statfs stfs;
+ check_okay = fstatfs(fd, &stfs) == 0;
+# undef PERL_MOUNT_NOSUID
+# if !defined(PERL_MOUNT_NOSUID) && defined(MNT_NOSUID)
+# define PERL_MOUNT_NOSUID MNT_NOSUID
+# endif
+# if !defined(PERL_MOUNT_NOSUID) && defined(MS_NOSUID)
+# define PERL_MOUNT_NOSUID MS_NOSUID
+# endif
+# if !defined(PERL_MOUNT_NOSUID) && defined(M_NOSUID)
+# define PERL_MOUNT_NOSUID M_NOSUID
+# endif
+# ifdef PERL_MOUNT_NOSUID
+ on_nosuid = check_okay && (stfs.f_flags & PERL_MOUNT_NOSUID);
+# endif
+# else
+# if defined(HAS_GETMNTENT) && defined(HAS_HASMNTOPT) && defined(MNTOPT_NOSUID)
+ FILE *mtab = fopen("/etc/mtab", "r");
+ struct mntent *entry;
+ struct stat stb, fsb;
+
+ if (mtab && (fstat(fd, &stb) == 0)) {
+ while (entry = getmntent(mtab)) {
+ if (stat(entry->mnt_dir, &fsb) == 0
+ && fsb.st_dev == stb.st_dev)
+ {
+ /* found the filesystem */
+ check_okay = 1;
+ if (hasmntopt(entry, MNTOPT_NOSUID))
+ on_nosuid = 1;
+ break;
+ } /* A single fs may well fail its stat(). */
+ }
}
+ if (mtab)
+ fclose(mtab);
+# endif /* mntent */
+# endif /* statfs */
+# endif /* statvfs */
+ if (!check_okay)
+ croak("Can't check filesystem of script \"%s\" for nosuid",
+ PL_origfilename);
+ return on_nosuid;
}
+#endif /* IAMSUID */
-static void
-validate_suid(validarg, scriptname)
-char *validarg;
-char *scriptname;
+STATIC void
+validate_suid(char *validarg, char *scriptname, int fdscript)
{
int which;
@@ -2000,12 +2171,14 @@ char *scriptname;
*/
#ifdef DOSUID
+ dTHR;
char *s, *s2;
- if (Fstat(PerlIO_fileno(rsfp),&statbuf) < 0) /* normal stat is insecure */
- croak("Can't stat script \"%s\"",origfilename);
- if (fdscript < 0 && statbuf.st_mode & (S_ISUID|S_ISGID)) {
+ if (PerlLIO_fstat(PerlIO_fileno(PL_rsfp),&PL_statbuf) < 0) /* normal stat is insecure */
+ croak("Can't stat script \"%s\"",PL_origfilename);
+ if (fdscript < 0 && PL_statbuf.st_mode & (S_ISUID|S_ISGID)) {
I32 len;
+ STRLEN n_a;
#ifdef IAMSUID
#ifndef HAS_SETREUID
@@ -2017,7 +2190,7 @@ char *scriptname;
* But I don't think it's too important. The manual lies when
* it says access() is useful in setuid programs.
*/
- if (access(SvPVX(GvSV(curcop->cop_filegv)),1)) /*double check*/
+ if (PerlLIO_access(SvPVX(GvSV(PL_curcop->cop_filegv)),1)) /*double check*/
croak("Permission denied");
#else
/* If we can swap euid and uid, then we can determine access rights
@@ -2030,60 +2203,64 @@ char *scriptname;
if (
#ifdef HAS_SETREUID
- setreuid(euid,uid) < 0
+ setreuid(PL_euid,PL_uid) < 0
#else
# if HAS_SETRESUID
- setresuid(euid,uid,(Uid_t)-1) < 0
+ setresuid(PL_euid,PL_uid,(Uid_t)-1) < 0
# endif
#endif
- || getuid() != euid || geteuid() != uid)
+ || PerlProc_getuid() != PL_euid || PerlProc_geteuid() != PL_uid)
croak("Can't swap uid and euid"); /* really paranoid */
- if (Stat(SvPVX(GvSV(curcop->cop_filegv)),&tmpstatbuf) < 0)
+ if (PerlLIO_stat(SvPVX(GvSV(PL_curcop->cop_filegv)),&tmpstatbuf) < 0)
croak("Permission denied"); /* testing full pathname here */
- if (tmpstatbuf.st_dev != statbuf.st_dev ||
- tmpstatbuf.st_ino != statbuf.st_ino) {
- (void)PerlIO_close(rsfp);
- if (rsfp = my_popen("/bin/mail root","w")) { /* heh, heh */
- PerlIO_printf(rsfp,
+#if defined(IAMSUID) && !defined(NO_NOSUID_CHECK)
+ if (fd_on_nosuid_fs(PerlIO_fileno(PL_rsfp)))
+ croak("Permission denied");
+#endif
+ if (tmpstatbuf.st_dev != PL_statbuf.st_dev ||
+ tmpstatbuf.st_ino != PL_statbuf.st_ino) {
+ (void)PerlIO_close(PL_rsfp);
+ if (PL_rsfp = PerlProc_popen("/bin/mail root","w")) { /* heh, heh */
+ PerlIO_printf(PL_rsfp,
"User %ld tried to run dev %ld ino %ld in place of dev %ld ino %ld!\n\
(Filename of set-id script was %s, uid %ld gid %ld.)\n\nSincerely,\nperl\n",
- (long)uid,(long)tmpstatbuf.st_dev, (long)tmpstatbuf.st_ino,
- (long)statbuf.st_dev, (long)statbuf.st_ino,
- SvPVX(GvSV(curcop->cop_filegv)),
- (long)statbuf.st_uid, (long)statbuf.st_gid);
- (void)my_pclose(rsfp);
+ (long)PL_uid,(long)tmpstatbuf.st_dev, (long)tmpstatbuf.st_ino,
+ (long)PL_statbuf.st_dev, (long)PL_statbuf.st_ino,
+ SvPVX(GvSV(PL_curcop->cop_filegv)),
+ (long)PL_statbuf.st_uid, (long)PL_statbuf.st_gid);
+ (void)PerlProc_pclose(PL_rsfp);
}
croak("Permission denied\n");
}
if (
#ifdef HAS_SETREUID
- setreuid(uid,euid) < 0
+ setreuid(PL_uid,PL_euid) < 0
#else
# if defined(HAS_SETRESUID)
- setresuid(uid,euid,(Uid_t)-1) < 0
+ setresuid(PL_uid,PL_euid,(Uid_t)-1) < 0
# endif
#endif
- || getuid() != uid || geteuid() != euid)
+ || PerlProc_getuid() != PL_uid || PerlProc_geteuid() != PL_euid)
croak("Can't reswap uid and euid");
- if (!cando(S_IXUSR,FALSE,&statbuf)) /* can real uid exec? */
+ if (!cando(S_IXUSR,FALSE,&PL_statbuf)) /* can real uid exec? */
croak("Permission denied\n");
}
#endif /* HAS_SETREUID */
#endif /* IAMSUID */
- if (!S_ISREG(statbuf.st_mode))
+ if (!S_ISREG(PL_statbuf.st_mode))
croak("Permission denied");
- if (statbuf.st_mode & S_IWOTH)
+ if (PL_statbuf.st_mode & S_IWOTH)
croak("Setuid/gid script is writable by world");
- doswitches = FALSE; /* -s is insecure in suid */
- curcop->cop_line++;
- if (sv_gets(linestr, rsfp, 0) == Nullch ||
- strnNE(SvPV(linestr,na),"#!",2) ) /* required even on Sys V */
+ PL_doswitches = FALSE; /* -s is insecure in suid */
+ PL_curcop->cop_line++;
+ if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch ||
+ strnNE(SvPV(PL_linestr,n_a),"#!",2) ) /* required even on Sys V */
croak("No #! line");
- s = SvPV(linestr,na)+2;
+ s = SvPV(PL_linestr,n_a)+2;
if (*s == ' ') s++;
while (!isSPACE(*s)) s++;
- for (s2 = s; (s2 > SvPV(linestr,na)+2 &&
+ for (s2 = s; (s2 > SvPV(PL_linestr,n_a)+2 &&
(isDIGIT(s2[-1]) || strchr("._-", s2[-1]))); s2--) ;
if (strnNE(s2-4,"perl",4) && strnNE(s-9,"perl",4)) /* sanity check */
croak("Not a perl script");
@@ -2099,80 +2276,80 @@ char *scriptname;
croak("Args must match #! line");
#ifndef IAMSUID
- if (euid != uid && (statbuf.st_mode & S_ISUID) &&
- euid == statbuf.st_uid)
- if (!do_undump)
+ if (PL_euid != PL_uid && (PL_statbuf.st_mode & S_ISUID) &&
+ PL_euid == PL_statbuf.st_uid)
+ if (!PL_do_undump)
croak("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
#endif /* IAMSUID */
- if (euid) { /* oops, we're not the setuid root perl */
- (void)PerlIO_close(rsfp);
+ if (PL_euid) { /* oops, we're not the setuid root perl */
+ (void)PerlIO_close(PL_rsfp);
#ifndef IAMSUID
/* try again */
- execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
+ PerlProc_execv(form("%s/sperl%s", BIN_EXP, PL_patchlevel), PL_origargv);
#endif
croak("Can't do setuid\n");
}
- if (statbuf.st_mode & S_ISGID && statbuf.st_gid != egid) {
+ if (PL_statbuf.st_mode & S_ISGID && PL_statbuf.st_gid != PL_egid) {
#ifdef HAS_SETEGID
- (void)setegid(statbuf.st_gid);
+ (void)setegid(PL_statbuf.st_gid);
#else
#ifdef HAS_SETREGID
- (void)setregid((Gid_t)-1,statbuf.st_gid);
+ (void)setregid((Gid_t)-1,PL_statbuf.st_gid);
#else
#ifdef HAS_SETRESGID
- (void)setresgid((Gid_t)-1,statbuf.st_gid,(Gid_t)-1);
+ (void)setresgid((Gid_t)-1,PL_statbuf.st_gid,(Gid_t)-1);
#else
- setgid(statbuf.st_gid);
+ PerlProc_setgid(PL_statbuf.st_gid);
#endif
#endif
#endif
- if (getegid() != statbuf.st_gid)
+ if (PerlProc_getegid() != PL_statbuf.st_gid)
croak("Can't do setegid!\n");
}
- if (statbuf.st_mode & S_ISUID) {
- if (statbuf.st_uid != euid)
+ if (PL_statbuf.st_mode & S_ISUID) {
+ if (PL_statbuf.st_uid != PL_euid)
#ifdef HAS_SETEUID
- (void)seteuid(statbuf.st_uid); /* all that for this */
+ (void)seteuid(PL_statbuf.st_uid); /* all that for this */
#else
#ifdef HAS_SETREUID
- (void)setreuid((Uid_t)-1,statbuf.st_uid);
+ (void)setreuid((Uid_t)-1,PL_statbuf.st_uid);
#else
#ifdef HAS_SETRESUID
- (void)setresuid((Uid_t)-1,statbuf.st_uid,(Uid_t)-1);
+ (void)setresuid((Uid_t)-1,PL_statbuf.st_uid,(Uid_t)-1);
#else
- setuid(statbuf.st_uid);
+ PerlProc_setuid(PL_statbuf.st_uid);
#endif
#endif
#endif
- if (geteuid() != statbuf.st_uid)
+ if (PerlProc_geteuid() != PL_statbuf.st_uid)
croak("Can't do seteuid!\n");
}
- else if (uid) { /* oops, mustn't run as root */
+ else if (PL_uid) { /* oops, mustn't run as root */
#ifdef HAS_SETEUID
- (void)seteuid((Uid_t)uid);
+ (void)seteuid((Uid_t)PL_uid);
#else
#ifdef HAS_SETREUID
- (void)setreuid((Uid_t)-1,(Uid_t)uid);
+ (void)setreuid((Uid_t)-1,(Uid_t)PL_uid);
#else
#ifdef HAS_SETRESUID
- (void)setresuid((Uid_t)-1,(Uid_t)uid,(Uid_t)-1);
+ (void)setresuid((Uid_t)-1,(Uid_t)PL_uid,(Uid_t)-1);
#else
- setuid((Uid_t)uid);
+ PerlProc_setuid((Uid_t)PL_uid);
#endif
#endif
#endif
- if (geteuid() != uid)
+ if (PerlProc_geteuid() != PL_uid)
croak("Can't do seteuid!\n");
}
init_ids();
- if (!cando(S_IXUSR,TRUE,&statbuf))
+ if (!cando(S_IXUSR,TRUE,&PL_statbuf))
croak("Permission denied\n"); /* they can't do this */
}
#ifdef IAMSUID
- else if (preprocess)
+ else if (PL_preprocess)
croak("-P not allowed for setuid/setgid script\n");
else if (fdscript >= 0)
croak("fd script not allowed in suidperl\n");
@@ -2182,28 +2359,29 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
/* We absolutely must clear out any saved ids here, so we */
/* exec the real perl, substituting fd script for scriptname. */
/* (We pass script name as "subdir" of fd, which perl will grok.) */
- PerlIO_rewind(rsfp);
- lseek(PerlIO_fileno(rsfp),(Off_t)0,0); /* just in case rewind didn't */
- for (which = 1; origargv[which] && origargv[which] != scriptname; which++) ;
- if (!origargv[which])
+ PerlIO_rewind(PL_rsfp);
+ PerlLIO_lseek(PerlIO_fileno(PL_rsfp),(Off_t)0,0); /* just in case rewind didn't */
+ for (which = 1; PL_origargv[which] && PL_origargv[which] != scriptname; which++) ;
+ if (!PL_origargv[which])
croak("Permission denied");
- origargv[which] = savepv(form("/dev/fd/%d/%s",
- PerlIO_fileno(rsfp), origargv[which]));
+ PL_origargv[which] = savepv(form("/dev/fd/%d/%s",
+ PerlIO_fileno(PL_rsfp), PL_origargv[which]));
#if defined(HAS_FCNTL) && defined(F_SETFD)
- fcntl(PerlIO_fileno(rsfp),F_SETFD,0); /* ensure no close-on-exec */
+ fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0); /* ensure no close-on-exec */
#endif
- execv(form("%s/perl%s", BIN_EXP, patchlevel), origargv); /* try again */
+ PerlProc_execv(form("%s/perl%s", BIN_EXP, PL_patchlevel), PL_origargv);/* try again */
croak("Can't do setuid\n");
#endif /* IAMSUID */
#else /* !DOSUID */
- if (euid != uid || egid != gid) { /* (suidperl doesn't exist, in fact) */
+ if (PL_euid != PL_uid || PL_egid != PL_gid) { /* (suidperl doesn't exist, in fact) */
#ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
- Fstat(PerlIO_fileno(rsfp),&statbuf); /* may be either wrapped or real suid */
- if ((euid != uid && euid == statbuf.st_uid && statbuf.st_mode & S_ISUID)
+ dTHR;
+ PerlLIO_fstat(PerlIO_fileno(PL_rsfp),&PL_statbuf); /* may be either wrapped or real suid */
+ if ((PL_euid != PL_uid && PL_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID)
||
- (egid != gid && egid == statbuf.st_gid && statbuf.st_mode & S_ISGID)
+ (PL_egid != PL_gid && PL_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID)
)
- if (!do_undump)
+ if (!PL_do_undump)
croak("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
#endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
@@ -2212,20 +2390,20 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
#endif /* DOSUID */
}
-static void
-find_beginning()
+STATIC void
+find_beginning(void)
{
register char *s, *s2;
/* skip forward in input to the real script? */
forbid_setid("-x");
- while (doextract) {
- if ((s = sv_gets(linestr, rsfp, 0)) == Nullch)
+ while (PL_doextract) {
+ if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch)
croak("No Perl script found in input\n");
if (*s == '#' && s[1] == '!' && (s = instr(s,"perl"))) {
- PerlIO_ungetc(rsfp, '\n'); /* to keep line count right */
- doextract = FALSE;
+ PerlIO_ungetc(PL_rsfp, '\n'); /* to keep line count right */
+ PL_doextract = FALSE;
while (*s && !(isSPACE (*s) || *s == '#')) s++;
s2 = s;
while (*s == ' ' || *s == '\t') s++;
@@ -2235,154 +2413,156 @@ find_beginning()
/*SUPPRESS 530*/
while (s = moreswitches(s)) ;
}
- if (cddir && chdir(cddir) < 0)
- croak("Can't chdir to %s",cddir);
+ if (PL_cddir && PerlDir_chdir(PL_cddir) < 0)
+ croak("Can't chdir to %s",PL_cddir);
}
}
}
-static void
-init_ids()
+
+STATIC void
+init_ids(void)
{
- uid = (int)getuid();
- euid = (int)geteuid();
- gid = (int)getgid();
- egid = (int)getegid();
+ PL_uid = (int)PerlProc_getuid();
+ PL_euid = (int)PerlProc_geteuid();
+ PL_gid = (int)PerlProc_getgid();
+ PL_egid = (int)PerlProc_getegid();
#ifdef VMS
- uid |= gid << 16;
- euid |= egid << 16;
+ PL_uid |= PL_gid << 16;
+ PL_euid |= PL_egid << 16;
#endif
- tainting |= (uid && (euid != uid || egid != gid));
+ PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
}
-static void
-forbid_setid(s)
-char *s;
+STATIC void
+forbid_setid(char *s)
{
- if (euid != uid)
+ if (PL_euid != PL_uid)
croak("No %s allowed while running setuid", s);
- if (egid != gid)
+ if (PL_egid != PL_gid)
croak("No %s allowed while running setgid", s);
}
-static void
-init_debugger()
+STATIC void
+init_debugger(void)
{
- curstash = debstash;
- dbargs = GvAV(gv_AVadd((gv_fetchpv("args", GV_ADDMULTI, SVt_PVAV))));
- AvREAL_off(dbargs);
- DBgv = gv_fetchpv("DB", GV_ADDMULTI, SVt_PVGV);
- DBline = gv_fetchpv("dbline", GV_ADDMULTI, SVt_PVAV);
- DBsub = gv_HVadd(gv_fetchpv("sub", GV_ADDMULTI, SVt_PVHV));
- DBsingle = GvSV((gv_fetchpv("single", GV_ADDMULTI, SVt_PV)));
- sv_setiv(DBsingle, 0);
- DBtrace = GvSV((gv_fetchpv("trace", GV_ADDMULTI, SVt_PV)));
- sv_setiv(DBtrace, 0);
- DBsignal = GvSV((gv_fetchpv("signal", GV_ADDMULTI, SVt_PV)));
- sv_setiv(DBsignal, 0);
- curstash = defstash;
+ dTHR;
+ PL_curstash = PL_debstash;
+ PL_dbargs = GvAV(gv_AVadd((gv_fetchpv("args", GV_ADDMULTI, SVt_PVAV))));
+ AvREAL_off(PL_dbargs);
+ PL_DBgv = gv_fetchpv("DB", GV_ADDMULTI, SVt_PVGV);
+ PL_DBline = gv_fetchpv("dbline", GV_ADDMULTI, SVt_PVAV);
+ PL_DBsub = gv_HVadd(gv_fetchpv("sub", GV_ADDMULTI, SVt_PVHV));
+ PL_DBsingle = GvSV((gv_fetchpv("single", GV_ADDMULTI, SVt_PV)));
+ sv_setiv(PL_DBsingle, 0);
+ PL_DBtrace = GvSV((gv_fetchpv("trace", GV_ADDMULTI, SVt_PV)));
+ sv_setiv(PL_DBtrace, 0);
+ PL_DBsignal = GvSV((gv_fetchpv("signal", GV_ADDMULTI, SVt_PV)));
+ sv_setiv(PL_DBsignal, 0);
+ PL_curstash = PL_defstash;
}
-static void
-init_stacks()
-{
- curstack = newAV();
- mainstack = curstack; /* remember in case we switch stacks */
- AvREAL_off(curstack); /* not a real array */
- av_extend(curstack,127);
-
- stack_base = AvARRAY(curstack);
- stack_sp = stack_base;
- stack_max = stack_base + 127;
-
- cxstack_max = 8192 / sizeof(CONTEXT) - 2; /* Use most of 8K. */
- New(50,cxstack,cxstack_max + 1,CONTEXT);
- cxstack_ix = -1;
-
- New(50,tmps_stack,128,SV*);
- tmps_ix = -1;
- tmps_max = 128;
-
- DEBUG( {
- New(51,debname,128,char);
- New(52,debdelim,128,char);
- } )
-
- /*
- * The following stacks almost certainly should be per-interpreter,
- * but for now they're not. XXX
- */
-
- if (markstack) {
- markstack_ptr = markstack;
- } else {
- New(54,markstack,64,I32);
- markstack_ptr = markstack;
- markstack_max = markstack + 64;
- }
-
- if (scopestack) {
- scopestack_ix = 0;
- } else {
- New(54,scopestack,32,I32);
- scopestack_ix = 0;
- scopestack_max = 32;
- }
-
- if (savestack) {
- savestack_ix = 0;
- } else {
- New(54,savestack,128,ANY);
- savestack_ix = 0;
- savestack_max = 128;
- }
+#ifndef STRESS_REALLOC
+#define REASONABLE(size) (size)
+#else
+#define REASONABLE(size) (1) /* unreasonable */
+#endif
- if (retstack) {
- retstack_ix = 0;
- } else {
- New(54,retstack,16,OP*);
- retstack_ix = 0;
- retstack_max = 16;
- }
+void
+init_stacks(ARGSproto)
+{
+ /* start with 128-item stack and 8K cxstack */
+ PL_curstackinfo = new_stackinfo(REASONABLE(128),
+ REASONABLE(8192/sizeof(PERL_CONTEXT) - 1));
+ PL_curstackinfo->si_type = PERLSI_MAIN;
+ PL_curstack = PL_curstackinfo->si_stack;
+ PL_mainstack = PL_curstack; /* remember in case we switch stacks */
+
+ PL_stack_base = AvARRAY(PL_curstack);
+ PL_stack_sp = PL_stack_base;
+ PL_stack_max = PL_stack_base + AvMAX(PL_curstack);
+
+ New(50,PL_tmps_stack,REASONABLE(128),SV*);
+ PL_tmps_floor = -1;
+ PL_tmps_ix = -1;
+ PL_tmps_max = REASONABLE(128);
+
+ New(54,PL_markstack,REASONABLE(32),I32);
+ PL_markstack_ptr = PL_markstack;
+ PL_markstack_max = PL_markstack + REASONABLE(32);
+
+ SET_MARKBASE;
+
+ New(54,PL_scopestack,REASONABLE(32),I32);
+ PL_scopestack_ix = 0;
+ PL_scopestack_max = REASONABLE(32);
+
+ New(54,PL_savestack,REASONABLE(128),ANY);
+ PL_savestack_ix = 0;
+ PL_savestack_max = REASONABLE(128);
+
+ New(54,PL_retstack,REASONABLE(16),OP*);
+ PL_retstack_ix = 0;
+ PL_retstack_max = REASONABLE(16);
}
-static void
-nuke_stacks()
+#undef REASONABLE
+
+STATIC void
+nuke_stacks(void)
{
- Safefree(cxstack);
- Safefree(tmps_stack);
+ dTHR;
+ while (PL_curstackinfo->si_next)
+ PL_curstackinfo = PL_curstackinfo->si_next;
+ while (PL_curstackinfo) {
+ PERL_SI *p = PL_curstackinfo->si_prev;
+ /* curstackinfo->si_stack got nuked by sv_free_arenas() */
+ Safefree(PL_curstackinfo->si_cxstack);
+ Safefree(PL_curstackinfo);
+ PL_curstackinfo = p;
+ }
+ Safefree(PL_tmps_stack);
+ Safefree(PL_markstack);
+ Safefree(PL_scopestack);
+ Safefree(PL_savestack);
+ Safefree(PL_retstack);
DEBUG( {
- Safefree(debname);
- Safefree(debdelim);
+ Safefree(PL_debname);
+ Safefree(PL_debdelim);
} )
}
+#ifndef PERL_OBJECT
static PerlIO *tmpfp; /* moved outside init_lexer() because of UNICOS bug */
+#endif
-static void
-init_lexer()
+STATIC void
+init_lexer(void)
{
- tmpfp = rsfp;
- rsfp = Nullfp;
- lex_start(linestr);
- rsfp = tmpfp;
- subname = newSVpv("main",4);
+#ifdef PERL_OBJECT
+ PerlIO *tmpfp;
+#endif
+ tmpfp = PL_rsfp;
+ PL_rsfp = Nullfp;
+ lex_start(PL_linestr);
+ PL_rsfp = tmpfp;
+ PL_subname = newSVpv("main",4);
}
-static void
-init_predump_symbols()
+STATIC void
+init_predump_symbols(void)
{
+ dTHR;
GV *tmpgv;
GV *othergv;
- sv_setpvn(GvSV(gv_fetchpv("\"", TRUE, SVt_PV)), " ", 1);
-
- stdingv = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
- GvMULTI_on(stdingv);
- IoIFP(GvIOp(stdingv)) = PerlIO_stdin();
+ sv_setpvn(perl_get_sv("\"", TRUE), " ", 1);
+ PL_stdingv = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
+ GvMULTI_on(PL_stdingv);
+ IoIFP(GvIOp(PL_stdingv)) = PerlIO_stdin();
tmpgv = gv_fetchpv("stdin",TRUE, SVt_PV);
GvMULTI_on(tmpgv);
- GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(stdingv));
+ GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(PL_stdingv));
tmpgv = gv_fetchpv("STDOUT",TRUE, SVt_PVIO);
GvMULTI_on(tmpgv);
@@ -2390,7 +2570,7 @@ init_predump_symbols()
setdefout(tmpgv);
tmpgv = gv_fetchpv("stdout",TRUE, SVt_PV);
GvMULTI_on(tmpgv);
- GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(defoutgv));
+ GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(PL_defoutgv));
othergv = gv_fetchpv("STDERR",TRUE, SVt_PVIO);
GvMULTI_on(othergv);
@@ -2399,24 +2579,22 @@ init_predump_symbols()
GvMULTI_on(tmpgv);
GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(othergv));
- statname = NEWSV(66,0); /* last filename we did stat on */
+ PL_statname = NEWSV(66,0); /* last filename we did stat on */
- if (!osname)
- osname = savepv(OSNAME);
+ if (!PL_osname)
+ PL_osname = savepv(OSNAME);
}
-static void
-init_postdump_symbols(argc,argv,env)
-register int argc;
-register char **argv;
-register char **env;
+STATIC void
+init_postdump_symbols(register int argc, register char **argv, register char **env)
{
+ dTHR;
char *s;
SV *sv;
GV* tmpgv;
argc--,argv++; /* skip name of script */
- if (doswitches) {
+ if (PL_doswitches) {
for (; argc > 0 && **argv == '-'; argc--,argv++) {
if (!argv[0][1])
break;
@@ -2432,34 +2610,34 @@ register char **env;
sv_setiv(GvSV(gv_fetchpv(argv[0]+1,TRUE, SVt_PV)),1);
}
}
- toptarget = NEWSV(0,0);
- sv_upgrade(toptarget, SVt_PVFM);
- sv_setpvn(toptarget, "", 0);
- bodytarget = NEWSV(0,0);
- sv_upgrade(bodytarget, SVt_PVFM);
- sv_setpvn(bodytarget, "", 0);
- formtarget = bodytarget;
+ PL_toptarget = NEWSV(0,0);
+ sv_upgrade(PL_toptarget, SVt_PVFM);
+ sv_setpvn(PL_toptarget, "", 0);
+ PL_bodytarget = NEWSV(0,0);
+ sv_upgrade(PL_bodytarget, SVt_PVFM);
+ sv_setpvn(PL_bodytarget, "", 0);
+ PL_formtarget = PL_bodytarget;
TAINT;
if (tmpgv = gv_fetchpv("0",TRUE, SVt_PV)) {
- sv_setpv(GvSV(tmpgv),origfilename);
+ sv_setpv(GvSV(tmpgv),PL_origfilename);
magicname("0", "0", 1);
}
if (tmpgv = gv_fetchpv("\030",TRUE, SVt_PV))
- sv_setpv(GvSV(tmpgv),origargv[0]);
- if (argvgv = gv_fetchpv("ARGV",TRUE, SVt_PVAV)) {
- GvMULTI_on(argvgv);
- (void)gv_AVadd(argvgv);
- av_clear(GvAVn(argvgv));
+ sv_setpv(GvSV(tmpgv),PL_origargv[0]);
+ if (PL_argvgv = gv_fetchpv("ARGV",TRUE, SVt_PVAV)) {
+ GvMULTI_on(PL_argvgv);
+ (void)gv_AVadd(PL_argvgv);
+ av_clear(GvAVn(PL_argvgv));
for (; argc > 0; argc--,argv++) {
- av_push(GvAVn(argvgv),newSVpv(argv[0],0));
+ av_push(GvAVn(PL_argvgv),newSVpv(argv[0],0));
}
}
- if (envgv = gv_fetchpv("ENV",TRUE, SVt_PVHV)) {
+ if (PL_envgv = gv_fetchpv("ENV",TRUE, SVt_PVHV)) {
HV *hv;
- GvMULTI_on(envgv);
- hv = GvHVn(envgv);
- hv_magic(hv, envgv, 'E');
+ GvMULTI_on(PL_envgv);
+ hv = GvHVn(PL_envgv);
+ hv_magic(hv, PL_envgv, 'E');
#ifndef VMS /* VMS doesn't have environ array */
/* Note that if the supplied env parameter is actually a copy
of the global environ then it may now point to free'd memory
@@ -2474,7 +2652,7 @@ register char **env;
if (!(s = strchr(*env,'=')))
continue;
*s++ = '\0';
-#ifdef WIN32
+#if defined(MSDOS)
(void)strupr(*env);
#endif
sv = newSVpv(s--,0);
@@ -2482,7 +2660,7 @@ register char **env;
*s = '=';
#if defined(__BORLANDC__) && defined(USE_WIN32_RTL_ENV)
/* Sins of the RTL. See note in my_setenv(). */
- (void)putenv(savepv(*env));
+ (void)PerlEnv_putenv(savepv(*env));
#endif
}
#endif
@@ -2495,17 +2673,17 @@ register char **env;
sv_setiv(GvSV(tmpgv), (IV)getpid());
}
-static void
-init_perllib()
+STATIC void
+init_perllib(void)
{
char *s;
- if (!tainting) {
+ if (!PL_tainting) {
#ifndef VMS
- s = getenv("PERL5LIB");
+ s = PerlEnv_getenv("PERL5LIB");
if (s)
incpush(s, TRUE);
else
- incpush(getenv("PERLLIB"), FALSE);
+ incpush(PerlEnv_getenv("PERLLIB"), FALSE);
#else /* VMS */
/* Treat PERL5?LIB as a possible search list logical name -- the
* "natural" VMS idiom for a Unix path string. We allow each
@@ -2521,10 +2699,10 @@ init_perllib()
}
/* Use the ~-expanded versions of APPLLIB (undocumented),
- ARCHLIB PRIVLIB SITEARCH SITELIB and OLDARCHLIB
+ ARCHLIB PRIVLIB SITEARCH and SITELIB
*/
#ifdef APPLLIB_EXP
- incpush(APPLLIB_EXP, FALSE);
+ incpush(APPLLIB_EXP, TRUE);
#endif
#ifdef ARCHLIB_EXP
@@ -2533,19 +2711,23 @@ init_perllib()
#ifndef PRIVLIB_EXP
#define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
#endif
+#if defined(WIN32)
+ incpush(PRIVLIB_EXP, TRUE);
+#else
incpush(PRIVLIB_EXP, FALSE);
+#endif
#ifdef SITEARCH_EXP
incpush(SITEARCH_EXP, FALSE);
#endif
#ifdef SITELIB_EXP
+#if defined(WIN32)
+ incpush(SITELIB_EXP, TRUE);
+#else
incpush(SITELIB_EXP, FALSE);
#endif
-#ifdef OLDARCHLIB_EXP /* 5.00[01] compatibility */
- incpush(OLDARCHLIB_EXP, FALSE);
#endif
-
- if (!tainting)
+ if (!PL_tainting)
incpush(".", FALSE);
}
@@ -2562,41 +2744,38 @@ init_perllib()
# define PERLLIB_MANGLE(s,n) (s)
#endif
-static void
-incpush(p, addsubdirs)
-char *p;
-int addsubdirs;
+STATIC void
+incpush(char *p, int addsubdirs)
{
SV *subdir = Nullsv;
- static char *archpat_auto;
if (!p)
return;
if (addsubdirs) {
- subdir = newSV(0);
- if (!archpat_auto) {
- STRLEN len = (sizeof(ARCHNAME) + strlen(patchlevel)
+ subdir = sv_newmortal();
+ if (!PL_archpat_auto) {
+ STRLEN len = (sizeof(ARCHNAME) + strlen(PL_patchlevel)
+ sizeof("//auto"));
- New(55, archpat_auto, len, char);
- sprintf(archpat_auto, "/%s/%s/auto", ARCHNAME, patchlevel);
+ New(55, PL_archpat_auto, len, char);
+ sprintf(PL_archpat_auto, "/%s/%s/auto", ARCHNAME, PL_patchlevel);
#ifdef VMS
for (len = sizeof(ARCHNAME) + 2;
- archpat_auto[len] != '\0' && archpat_auto[len] != '/'; len++)
- if (archpat_auto[len] == '.') archpat_auto[len] = '_';
+ PL_archpat_auto[len] != '\0' && PL_archpat_auto[len] != '/'; len++)
+ if (PL_archpat_auto[len] == '.') PL_archpat_auto[len] = '_';
#endif
}
}
/* Break at all separators */
while (p && *p) {
- SV *libdir = newSV(0);
+ SV *libdir = NEWSV(55,0);
char *s;
/* skip any consecutive separators */
while ( *p == PERLLIB_SEP ) {
/* Uncomment the next line for PATH semantics */
- /* av_push(GvAVn(incgv), newSVpv(".", 1)); */
+ /* av_push(GvAVn(PL_incgv), newSVpv(".", 1)); */
p++;
}
@@ -2620,7 +2799,7 @@ int addsubdirs;
char *unix;
STRLEN len;
- if ((unix = tounixspec_ts(SvPV(libdir,na),Nullch)) != Nullch) {
+ if ((unix = tounixspec_ts(SvPV(libdir,len),Nullch)) != Nullch) {
len = strlen(unix);
while (unix[len-1] == '/') len--; /* Cosmetic */
sv_usepvn(libdir,unix,len);
@@ -2628,63 +2807,131 @@ int addsubdirs;
else
PerlIO_printf(PerlIO_stderr(),
"Failed to unixify @INC element \"%s\"\n",
- SvPV(libdir,na));
+ SvPV(libdir,len));
#endif
/* .../archname/version if -d .../archname/version/auto */
sv_setsv(subdir, libdir);
- sv_catpv(subdir, archpat_auto);
- if (Stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+ sv_catpv(subdir, PL_archpat_auto);
+ if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
S_ISDIR(tmpstatbuf.st_mode))
- av_push(GvAVn(incgv),
+ av_push(GvAVn(PL_incgv),
newSVpv(SvPVX(subdir), SvCUR(subdir) - sizeof "auto"));
/* .../archname if -d .../archname/auto */
sv_insert(subdir, SvCUR(libdir) + sizeof(ARCHNAME),
- strlen(patchlevel) + 1, "", 0);
- if (Stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+ strlen(PL_patchlevel) + 1, "", 0);
+ if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
S_ISDIR(tmpstatbuf.st_mode))
- av_push(GvAVn(incgv),
+ av_push(GvAVn(PL_incgv),
newSVpv(SvPVX(subdir), SvCUR(subdir) - sizeof "auto"));
}
/* finally push this lib directory on the end of @INC */
- av_push(GvAVn(incgv), libdir);
+ av_push(GvAVn(PL_incgv), libdir);
}
+}
+
+#ifdef USE_THREADS
+STATIC struct perl_thread *
+init_main_thread()
+{
+ struct perl_thread *thr;
+ XPV *xpv;
+
+ Newz(53, thr, 1, struct perl_thread);
+ PL_curcop = &PL_compiling;
+ thr->cvcache = newHV();
+ thr->threadsv = newAV();
+ /* thr->threadsvp is set when find_threadsv is called */
+ thr->specific = newAV();
+ thr->errhv = newHV();
+ thr->flags = THRf_R_JOINABLE;
+ MUTEX_INIT(&thr->mutex);
+ /* Handcraft thrsv similarly to mess_sv */
+ New(53, PL_thrsv, 1, SV);
+ Newz(53, xpv, 1, XPV);
+ SvFLAGS(PL_thrsv) = SVt_PV;
+ SvANY(PL_thrsv) = (void*)xpv;
+ SvREFCNT(PL_thrsv) = 1 << 30; /* practically infinite */
+ SvPVX(PL_thrsv) = (char*)thr;
+ SvCUR_set(PL_thrsv, sizeof(thr));
+ SvLEN_set(PL_thrsv, sizeof(thr));
+ *SvEND(PL_thrsv) = '\0'; /* in the trailing_nul field */
+ thr->oursv = PL_thrsv;
+ PL_chopset = " \n-";
+
+ MUTEX_LOCK(&PL_threads_mutex);
+ PL_nthreads++;
+ thr->tid = 0;
+ thr->next = thr;
+ thr->prev = thr;
+ MUTEX_UNLOCK(&PL_threads_mutex);
+
+#ifdef HAVE_THREAD_INTERN
+ init_thread_intern(thr);
+#endif
+
+#ifdef SET_THREAD_SELF
+ SET_THREAD_SELF(thr);
+#else
+ thr->self = pthread_self();
+#endif /* SET_THREAD_SELF */
+ SET_THR(thr);
- SvREFCNT_dec(subdir);
+ /*
+ * These must come after the SET_THR because sv_setpvn does
+ * SvTAINT and the taint fields require dTHR.
+ */
+ PL_toptarget = NEWSV(0,0);
+ sv_upgrade(PL_toptarget, SVt_PVFM);
+ sv_setpvn(PL_toptarget, "", 0);
+ PL_bodytarget = NEWSV(0,0);
+ sv_upgrade(PL_bodytarget, SVt_PVFM);
+ sv_setpvn(PL_bodytarget, "", 0);
+ PL_formtarget = PL_bodytarget;
+ thr->errsv = newSVpv("", 0);
+ (void) find_threadsv("@"); /* Ensure $@ is initialised early */
+
+ PL_maxscream = -1;
+ PL_regcompp = FUNC_NAME_TO_PTR(pregcomp);
+ PL_regexecp = FUNC_NAME_TO_PTR(regexec_flags);
+ PL_regindent = 0;
+ PL_reginterp_cnt = 0;
+
+ return thr;
}
+#endif /* USE_THREADS */
void
-call_list(oldscope, list)
-I32 oldscope;
-AV* list;
+call_list(I32 oldscope, AV *paramList)
{
- line_t oldline = curcop->cop_line;
+ dTHR;
+ line_t oldline = PL_curcop->cop_line;
STRLEN len;
dJMPENV;
int ret;
- while (AvFILL(list) >= 0) {
- CV *cv = (CV*)av_shift(list);
+ while (AvFILL(paramList) >= 0) {
+ CV *cv = (CV*)av_shift(paramList);
SAVEFREESV(cv);
JMPENV_PUSH(ret);
switch (ret) {
case 0: {
- SV* atsv = GvSV(errgv);
- PUSHMARK(stack_sp);
+ SV* atsv = ERRSV;
+ PUSHMARK(PL_stack_sp);
perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
(void)SvPV(atsv, len);
if (len) {
JMPENV_POP;
- curcop = &compiling;
- curcop->cop_line = oldline;
- if (list == beginav)
+ PL_curcop = &PL_compiling;
+ PL_curcop->cop_line = oldline;
+ if (paramList == PL_beginav)
sv_catpv(atsv, "BEGIN failed--compilation aborted");
else
sv_catpv(atsv, "END failed--cleanup aborted");
- while (scopestack_ix > oldscope)
+ while (PL_scopestack_ix > oldscope)
LEAVE;
croak("%s", SvPVX(atsv));
}
@@ -2695,17 +2942,17 @@ AV* list;
/* FALL THROUGH */
case 2:
/* my_exit() was called */
- while (scopestack_ix > oldscope)
+ while (PL_scopestack_ix > oldscope)
LEAVE;
FREETMPS;
- curstash = defstash;
- if (endav)
- call_list(oldscope, endav);
+ PL_curstash = PL_defstash;
+ if (PL_endav)
+ call_list(oldscope, PL_endav);
JMPENV_POP;
- curcop = &compiling;
- curcop->cop_line = oldline;
- if (statusvalue) {
- if (list == beginav)
+ PL_curcop = &PL_compiling;
+ PL_curcop->cop_line = oldline;
+ if (PL_statusvalue) {
+ if (paramList == PL_beginav)
croak("BEGIN failed--compilation aborted");
else
croak("END failed--cleanup aborted");
@@ -2713,14 +2960,14 @@ AV* list;
my_exit_jump();
/* NOTREACHED */
case 3:
- if (!restartop) {
+ if (!PL_restartop) {
PerlIO_printf(PerlIO_stderr(), "panic: restartop\n");
FREETMPS;
break;
}
JMPENV_POP;
- curcop = &compiling;
- curcop->cop_line = oldline;
+ PL_curcop = &PL_compiling;
+ PL_curcop->cop_line = oldline;
JMPENV_JUMP(3);
}
JMPENV_POP;
@@ -2728,9 +2975,12 @@ AV* list;
}
void
-my_exit(status)
-U32 status;
+my_exit(U32 status)
{
+ dTHR;
+
+ DEBUG_S(PerlIO_printf(Perl_debug_log, "my_exit: thread %p, status %lu\n",
+ thr, (unsigned long) status));
switch (status) {
case 0:
STATUS_ALL_SUCCESS;
@@ -2746,7 +2996,7 @@ U32 status;
}
void
-my_failure_exit()
+my_failure_exit(void)
{
#ifdef VMS
if (vaxc$errno & 1) {
@@ -2760,37 +3010,68 @@ my_failure_exit()
STATUS_NATIVE_SET(vaxc$errno);
}
#else
+ int exitstatus;
if (errno & 255)
STATUS_POSIX_SET(errno);
- else if (STATUS_POSIX == 0)
- STATUS_POSIX_SET(255);
+ else {
+ exitstatus = STATUS_POSIX >> 8;
+ if (exitstatus & 255)
+ STATUS_POSIX_SET(exitstatus);
+ else
+ STATUS_POSIX_SET(255);
+ }
#endif
my_exit_jump();
}
-static void
-my_exit_jump()
+STATIC void
+my_exit_jump(void)
{
- register CONTEXT *cx;
+ dSP;
+ register PERL_CONTEXT *cx;
I32 gimme;
SV **newsp;
- if (e_tmpname) {
- if (e_fp) {
- PerlIO_close(e_fp);
- e_fp = Nullfp;
- }
- (void)UNLINK(e_tmpname);
- Safefree(e_tmpname);
- e_tmpname = Nullch;
+ if (PL_e_script) {
+ SvREFCNT_dec(PL_e_script);
+ PL_e_script = Nullsv;
}
+ POPSTACK_TO(PL_mainstack);
if (cxstack_ix >= 0) {
if (cxstack_ix > 0)
dounwind(0);
- POPBLOCK(cx,curpm);
+ POPBLOCK(cx,PL_curpm);
LEAVE;
}
JMPENV_JUMP(2);
}
+
+#ifdef PERL_OBJECT
+#define NO_XSLOCKS
+#endif /* PERL_OBJECT */
+
+#include "XSUB.h"
+
+static I32
+#ifdef PERL_OBJECT
+read_e_script(CPerlObj *pPerl, int idx, SV *buf_sv, int maxlen)
+#else
+read_e_script(int idx, SV *buf_sv, int maxlen)
+#endif
+{
+ char *p, *nl;
+ p = SvPVX(PL_e_script);
+ nl = strchr(p, '\n');
+ nl = (nl) ? nl+1 : SvEND(PL_e_script);
+ if (nl-p == 0) {
+ filter_del(read_e_script);
+ return 0;
+ }
+ sv_catpvn(buf_sv, p, nl-p);
+ sv_chop(PL_e_script, nl);
+ return 1;
+}
+
+
diff --git a/gnu/usr.bin/perl/perl.h b/gnu/usr.bin/perl/perl.h
index fefceeda816..cab0bbc2981 100644
--- a/gnu/usr.bin/perl/perl.h
+++ b/gnu/usr.bin/perl/perl.h
@@ -1,6 +1,6 @@
/* perl.h
*
- * Copyright (c) 1987-1997, Larry Wall
+ * Copyright (c) 1987-1999, 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.
@@ -24,11 +24,145 @@
#define USE_STDIO
#endif /* PERL_FOR_X2P */
+#ifdef PERL_OBJECT
+
+/* PERL_OBJECT explained - DickH and DougL @ ActiveState.com
+
+Defining PERL_OBJECT turns on creation of a C++ object that
+contains all writable core perl global variables and functions.
+Stated another way, all necessary global variables and functions
+are members of a big C++ object. This object's class is CPerlObj.
+This allows a Perl Host to have multiple, independent perl
+interpreters in the same process space. This is very important on
+Win32 systems as the overhead of process creation is quite high --
+this could be even higher than the script compile and execute time
+for small scripts.
+
+The perl executable implementation on Win32 is composed of perl.exe
+(the Perl Host) and perlX.dll. (the Perl Core). This allows the
+same Perl Core to easily be embedded in other applications that use
+the perl interpreter.
+
++-----------+
+| Perl Host |
++-----------+
+ ^
+ |
+ v
++-----------+ +-----------+
+| Perl Core |<->| Extension |
++-----------+ +-----------+ ...
+
+Defining PERL_OBJECT has the following effects:
+
+PERL CORE
+1. CPerlObj is defined (this is the PERL_OBJECT)
+2. all static functions that needed to access either global
+variables or functions needed are made member functions
+3. all writable static variables are made member variables
+4. all global variables and functions are defined as:
+ #define var CPerlObj::Perl_var
+ #define func CPerlObj::Perl_func
+ * these are in objpp.h
+This necessitated renaming some local variables and functions that
+had the same name as a global variable or function. This was
+probably a _good_ thing anyway.
+
+
+EXTENSIONS
+1. Access to global variables and perl functions is through a
+pointer to the PERL_OBJECT. This pointer type is CPerlObj*. This is
+made transparent to extension developers by the following macros:
+ #define var pPerl->Perl_var
+ #define func pPerl->Perl_func
+ * these are done in objXSUB.h
+This requires that the extension be compiled as C++, which means
+that the code must be ANSI C and not K&R C. For K&R extensions,
+please see the C API notes located in Win32/GenCAPI.pl. This script
+creates a perlCAPI.lib that provides a K & R compatible C interface
+to the PERL_OBJECT.
+2. Local variables and functions cannot have the same name as perl's
+variables or functions since the macros will redefine these. Look for
+this if you get some strange error message and it does not look like
+the code that you had written. This often happens with variables that
+are local to a function.
+
+PERL HOST
+1. The perl host is linked with perlX.lib to get perl_alloc. This
+function will return a pointer to CPerlObj (the PERL_OBJECT). It
+takes pointers to the various PerlXXX_YYY interfaces (see iperlsys.h
+for more information on this).
+2. The perl host calls the same functions as normally would be
+called in setting up and running a perl script, except that the
+functions are now member functions of the PERL_OBJECT.
+
+*/
+
+
+class CPerlObj;
+
+#define STATIC
+#define CPERLscope(x) CPerlObj::x
+#define CPERLproto CPerlObj *
+#define _CPERLproto ,CPERLproto
+#define CPERLarg CPerlObj *pPerl
+#define CPERLarg_ CPERLarg,
+#define _CPERLarg ,CPERLarg
+#define PERL_OBJECT_THIS this
+#define _PERL_OBJECT_THIS ,this
+#define PERL_OBJECT_THIS_ this,
+#define CALLRUNOPS (this->*PL_runops)
+#define CALLREGCOMP (this->*PL_regcompp)
+#define CALLREGEXEC (this->*PL_regexecp)
+
+#else /* !PERL_OBJECT */
+
+#define STATIC static
+#define CPERLscope(x) x
+#define CPERLproto
+#define _CPERLproto
+#define CPERLarg void
+#define CPERLarg_
+#define _CPERLarg
+#define PERL_OBJECT_THIS
+#define _PERL_OBJECT_THIS
+#define PERL_OBJECT_THIS_
+#define CALLRUNOPS PL_runops
+#define CALLREGCOMP (*PL_regcompp)
+#define CALLREGEXEC (*PL_regexecp)
+
+#endif /* PERL_OBJECT */
+
#define VOIDUSED 1
#include "config.h"
#include "embed.h"
+#undef START_EXTERN_C
+#undef END_EXTERN_C
+#undef EXTERN_C
+#ifdef __cplusplus
+# define START_EXTERN_C extern "C" {
+# define END_EXTERN_C }
+# define EXTERN_C extern "C"
+#else
+# define START_EXTERN_C
+# define END_EXTERN_C
+# define EXTERN_C
+#endif
+
+#ifdef OP_IN_REGISTER
+# ifdef __GNUC__
+# define stringify_immed(s) #s
+# define stringify(s) stringify_immed(s)
+#ifdef EMBED
+register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
+#else
+register struct op *op asm(stringify(OP_IN_REGISTER));
+#endif
+# endif
+#endif
+
/*
* STMT_START { statements; } STMT_END;
* can be used as a single statement, as in
@@ -52,6 +186,10 @@
# endif
#endif
+#define NOOP (void)0
+
+#define WITH_THR(s) STMT_START { dTHR; s; } STMT_END
+
/*
* SOFT_CAST can be used for args to prototyped functions to retain some
* type checking; it only casts if the compiler does not know prototypes.
@@ -62,7 +200,7 @@
#define SOFT_CAST(type) (type)
#endif
-#ifndef BYTEORDER
+#ifndef BYTEORDER /* Should never happen -- byteorder is in config.h */
# define BYTEORDER 0x1234
#endif
@@ -71,6 +209,12 @@
# define LIBERAL 1
#endif
+#if 'A' == 65 && 'I' == 73 && 'J' == 74 && 'Z' == 90
+#define ASCIIish
+#else
+#undef ASCIIish
+#endif
+
/*
* The following contortions are brought to you on behalf of all the
* standards, semi-standards, de facto standards, not-so-de-facto standards
@@ -88,7 +232,7 @@
# define STANDARD_C 1
#endif
-#if defined(__cplusplus) || defined(WIN32)
+#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX)
# define DONT_DECLARE_STD 1
#endif
@@ -102,11 +246,11 @@
# define VOL
#endif
-#define TAINT (tainted = TRUE)
-#define TAINT_NOT (tainted = FALSE)
-#define TAINT_IF(c) if (c) { tainted = TRUE; }
-#define TAINT_ENV() if (tainting) { taint_env(); }
-#define TAINT_PROPER(s) if (tainting) { taint_proper(no_security, s); }
+#define TAINT (PL_tainted = TRUE)
+#define TAINT_NOT (PL_tainted = FALSE)
+#define TAINT_IF(c) if (c) { PL_tainted = TRUE; }
+#define TAINT_ENV() if (PL_tainting) { taint_env(); }
+#define TAINT_PROPER(s) if (PL_tainting) { taint_proper(Nullch, s); }
/* XXX All process group stuff is handled in pp_sys.c. Should these
defines move there? If so, I could simplify this a lot. --AD 9/96.
@@ -178,7 +322,7 @@
# endif
#endif
-#include "perlio.h"
+#include "iperlsys.h"
#ifdef USE_NEXT_CTYPE
@@ -229,6 +373,8 @@
# include <stdlib.h>
#endif
+#define MEM_SIZE Size_t
+
/* This comes after <stdlib.h> so we don't try to change the standard
* library prototypes; we'll use our own in proto.h instead. */
@@ -237,14 +383,32 @@
# ifdef HIDEMYMALLOC
# define malloc Mymalloc
# define calloc Mycalloc
-# define realloc Myremalloc
+# define realloc Myrealloc
# define free Myfree
+Malloc_t Mymalloc _((MEM_SIZE nbytes));
+Malloc_t Mycalloc _((MEM_SIZE elements, MEM_SIZE size));
+Malloc_t Myrealloc _((Malloc_t where, MEM_SIZE nbytes));
+Free_t Myfree _((Malloc_t where));
# endif
# ifdef EMBEDMYMALLOC
# define malloc Perl_malloc
# define calloc Perl_calloc
# define realloc Perl_realloc
+/* VMS' external symbols are case-insensitive, and there's already a */
+/* perl_free in perl.h */
+#ifdef VMS
+# define free Perl_myfree
+#else
# define free Perl_free
+#endif
+Malloc_t Perl_malloc _((MEM_SIZE nbytes));
+Malloc_t Perl_calloc _((MEM_SIZE elements, MEM_SIZE size));
+Malloc_t Perl_realloc _((Malloc_t where, MEM_SIZE nbytes));
+#ifdef VMS
+Free_t Perl_myfree _((Malloc_t where));
+#else
+Free_t Perl_free _((Malloc_t where));
+#endif
# endif
# undef safemalloc
@@ -258,8 +422,6 @@
#endif /* MYMALLOC */
-#define MEM_SIZE Size_t
-
#if defined(STANDARD_C) && defined(I_STDDEF)
# include <stddef.h>
# define STRUCT_OFFSET(s,m) offsetof(s,m)
@@ -361,6 +523,10 @@
# include <netinet/in.h>
#endif
+#ifdef I_ARPA_INET
+# include <arpa/inet.h>
+#endif
+
#if defined(SF_APPEND) && defined(USE_SFIO) && defined(I_SFIO)
/* <sfio.h> defines SF_APPEND and <sys/stat.h> might define SF_APPEND
* (the neo-BSD seem to do this). */
@@ -411,12 +577,6 @@
# undef HAS_STRERROR
#endif
-#ifndef HAS_MKFIFO
-# ifndef mkfifo
-# define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
-# endif
-#endif /* !HAS_MKFIFO */
-
#include <errno.h>
#ifdef HAS_SOCKET
# ifdef I_NET_ERRNO
@@ -431,9 +591,21 @@
set_vaxc_errno(vmserrcode); \
} STMT_END
#else
-# define SETERRNO(errcode,vmserrcode) errno = (errcode)
+# define SETERRNO(errcode,vmserrcode) (errno = (errcode))
#endif
+#ifdef USE_THREADS
+# define ERRSV (thr->errsv)
+# define ERRHV (thr->errhv)
+# define DEFSV THREADSV(0)
+# define SAVE_DEFSV save_threadsv(0)
+#else
+# define ERRSV GvSV(PL_errgv)
+# define ERRHV GvHV(PL_errgv)
+# define DEFSV GvSV(PL_defgv)
+# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
+#endif /* USE_THREADS */
+
#ifndef errno
extern int errno; /* ANSI allows errno to be an lvalue expr */
#endif
@@ -641,12 +813,21 @@
# ifdef convex
# define Quad_t long long
# else
-# if BYTEORDER > 0xFFFF
+# if LONGSIZE == 8
# define Quad_t long
# endif
# endif
#endif
+/* XXX Experimental set-up for long long. Just add -DUSE_LONG_LONG
+ to your ccflags. --Andy Dougherty 4/1998
+*/
+#ifdef USE_LONG_LONG
+# if defined(HAS_LONG_LONG) && LONGLONGSIZE == 8
+# define Quad_t long long
+# endif
+#endif
+
#ifdef Quad_t
# define HAS_QUAD
typedef Quad_t IV;
@@ -733,7 +914,11 @@
# ifdef MAXUSHORT
# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
# else
-# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
+# ifdef USHRT_MAX
+# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
+# else
+# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
+# endif
# endif
#endif
@@ -743,7 +928,11 @@
# ifdef MAXSHORT /* Often used in <values.h> */
# define PERL_SHORT_MAX ((short)MAXSHORT)
# else
-# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
+# ifdef SHRT_MAX
+# define PERL_SHORT_MAX ((short)SHRT_MAX)
+# else
+# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
+# endif
# endif
#endif
@@ -753,7 +942,11 @@
# ifdef MINSHORT
# define PERL_SHORT_MIN ((short)MINSHORT)
# else
-# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
+# ifdef SHRT_MIN
+# define PERL_SHORT_MIN ((short)SHRT_MIN)
+# else
+# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
+# endif
# endif
#endif
@@ -873,7 +1066,7 @@ typedef struct regexp REGEXP;
typedef struct gp GP;
typedef struct gv GV;
typedef struct io IO;
-typedef struct context CONTEXT;
+typedef struct context PERL_CONTEXT;
typedef struct block BLOCK;
typedef struct magic MAGIC;
@@ -896,10 +1089,15 @@ typedef union any ANY;
#include "handy.h"
+#ifdef PERL_OBJECT
+typedef I32 (*filter_t) _((CPerlObj*, int, SV *, int));
+#else
typedef I32 (*filter_t) _((int, SV *, int));
+#endif
+
#define FILTER_READ(idx, sv, len) filter_read(idx, sv, len)
-#define FILTER_DATA(idx) (AvARRAY(rsfp_filters)[idx])
-#define FILTER_ISREADER(idx) (idx >= AvFILL(rsfp_filters))
+#define FILTER_DATA(idx) (AvARRAY(PL_rsfp_filters)[idx])
+#define FILTER_ISREADER(idx) (idx >= AvFILLp(PL_rsfp_filters))
#ifdef DOSISH
# if defined(OS2)
@@ -914,28 +1112,84 @@ typedef I32 (*filter_t) _((int, SV *, int));
# if defined(PLAN9)
# include "./plan9/plan9ish.h"
# else
-# include "unixish.h"
+# if defined(MPE)
+# include "mpeix/mpeixish.h"
+# else
+# if defined(__VOS__)
+# include "vosish.h"
+# else
+# include "unixish.h"
+# endif
+# endif
# endif
# endif
+#endif
+
+#ifndef FUNC_NAME_TO_PTR
+#define FUNC_NAME_TO_PTR(name) name
#endif
+
+/*
+ * USE_THREADS needs to be after unixish.h as <pthread.h> includes
+ * <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h>
+ * this results in many functions being undeclared which bothers C++
+ * May make sense to have threads after "*ish.h" anyway
+ */
+
+#ifdef USE_THREADS
+ /* pending resolution of licensing issues, we avoid the erstwhile
+ * atomic.h everywhere */
+# define EMULATE_ATOMIC_REFCOUNTS
+
+# ifdef FAKE_THREADS
+# include "fakethr.h"
+# else
+# ifdef WIN32
+# include <win32thread.h>
+# else
+# ifdef OS2
+# include "os2thread.h"
+# else
+# ifdef I_MACH_CTHREADS
+# include <mach/cthreads.h>
+# ifdef NeXT
+# define MUTEX_INIT_CALLS_MALLOC
+# endif
+typedef cthread_t perl_os_thread;
+typedef mutex_t perl_mutex;
+typedef condition_t perl_cond;
+typedef void * perl_key;
+# else /* Posix threads */
+# include <pthread.h>
+typedef pthread_t perl_os_thread;
+typedef pthread_mutex_t perl_mutex;
+typedef pthread_cond_t perl_cond;
+typedef pthread_key_t perl_key;
+# endif /* I_MACH_CTHREADS */
+# endif /* OS2 */
+# endif /* WIN32 */
+# endif /* FAKE_THREADS */
+#endif /* USE_THREADS */
+
+
#ifdef VMS
-# define STATUS_NATIVE statusvalue_vms
+# define STATUS_NATIVE PL_statusvalue_vms
# define STATUS_NATIVE_EXPORT \
- ((I32)statusvalue_vms == -1 ? 44 : statusvalue_vms)
+ ((I32)PL_statusvalue_vms == -1 ? 44 : PL_statusvalue_vms)
# define STATUS_NATIVE_SET(n) \
STMT_START { \
- statusvalue_vms = (n); \
- if ((I32)statusvalue_vms == -1) \
- statusvalue = -1; \
- else if (statusvalue_vms & STS$M_SUCCESS) \
- statusvalue = 0; \
- else if ((statusvalue_vms & STS$M_SEVERITY) == 0) \
- statusvalue = 1 << 8; \
+ PL_statusvalue_vms = (n); \
+ if ((I32)PL_statusvalue_vms == -1) \
+ PL_statusvalue = -1; \
+ else if (PL_statusvalue_vms & STS$M_SUCCESS) \
+ PL_statusvalue = 0; \
+ else if ((PL_statusvalue_vms & STS$M_SEVERITY) == 0) \
+ PL_statusvalue = 1 << 8; \
else \
- statusvalue = (statusvalue_vms & STS$M_SEVERITY) << 8; \
+ PL_statusvalue = (PL_statusvalue_vms & STS$M_SEVERITY) << 8; \
} STMT_END
-# define STATUS_POSIX statusvalue
+# define STATUS_POSIX PL_statusvalue
# ifdef VMSISH_STATUS
# define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_POSIX)
# else
@@ -943,29 +1197,29 @@ typedef I32 (*filter_t) _((int, SV *, int));
# endif
# define STATUS_POSIX_SET(n) \
STMT_START { \
- statusvalue = (n); \
- if (statusvalue != -1) { \
- statusvalue &= 0xFFFF; \
- statusvalue_vms = statusvalue ? 44 : 1; \
+ PL_statusvalue = (n); \
+ if (PL_statusvalue != -1) { \
+ PL_statusvalue &= 0xFFFF; \
+ PL_statusvalue_vms = PL_statusvalue ? 44 : 1; \
} \
- else statusvalue_vms = -1; \
+ else PL_statusvalue_vms = -1; \
} STMT_END
-# define STATUS_ALL_SUCCESS (statusvalue = 0, statusvalue_vms = 1)
-# define STATUS_ALL_FAILURE (statusvalue = 1, statusvalue_vms = 44)
+# define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_vms = 1)
+# define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_vms = 44)
#else
# define STATUS_NATIVE STATUS_POSIX
# define STATUS_NATIVE_EXPORT STATUS_POSIX
# define STATUS_NATIVE_SET STATUS_POSIX_SET
-# define STATUS_POSIX statusvalue
+# define STATUS_POSIX PL_statusvalue
# define STATUS_POSIX_SET(n) \
STMT_START { \
- statusvalue = (n); \
- if (statusvalue != -1) \
- statusvalue &= 0xFFFF; \
+ PL_statusvalue = (n); \
+ if (PL_statusvalue != -1) \
+ PL_statusvalue &= 0xFFFF; \
} STMT_END
# define STATUS_CURRENT STATUS_POSIX
-# define STATUS_ALL_SUCCESS (statusvalue = 0)
-# define STATUS_ALL_FAILURE (statusvalue = 1)
+# define STATUS_ALL_SUCCESS (PL_statusvalue = 0)
+# define STATUS_ALL_FAILURE (PL_statusvalue = 1)
#endif
/* Some unistd.h's give a prototype for pause() even though
@@ -988,13 +1242,23 @@ typedef I32 (*filter_t) _((int, SV *, int));
# endif
#endif
+#ifdef UNION_ANY_DEFINITION
+UNION_ANY_DEFINITION;
+#else
union any {
void* any_ptr;
I32 any_i32;
IV any_iv;
long any_long;
- void (*any_dptr) _((void*));
+ void (CPERLscope(*any_dptr)) _((void*));
};
+#endif
+
+#ifdef USE_THREADS
+#define ARGSproto struct perl_thread *thr
+#else
+#define ARGSproto void
+#endif /* USE_THREADS */
/* Work around some cygwin32 problems with importing global symbols */
#if defined(CYGWIN32) && defined(DLLIMPORT)
@@ -1014,6 +1278,57 @@ union any {
#include "hv.h"
#include "mg.h"
#include "scope.h"
+#include "bytecode.h"
+#include "byterun.h"
+
+/* Current curly descriptor */
+typedef struct curcur CURCUR;
+struct curcur {
+ int parenfloor; /* how far back to strip paren data */
+ int cur; /* how many instances of scan we've matched */
+ int min; /* the minimal number of scans to match */
+ int max; /* the maximal number of scans to match */
+ int minmod; /* whether to work our way up or down */
+ regnode * scan; /* the thing to match */
+ regnode * next; /* what has to match after it */
+ char * lastloc; /* where we started matching this scan */
+ CURCUR * oldcc; /* current curly before we started this one */
+};
+
+typedef struct _sublex_info SUBLEXINFO;
+struct _sublex_info {
+ I32 super_state; /* lexer state to save */
+ I32 sub_inwhat; /* "lex_inwhat" to use */
+ OP *sub_op; /* "lex_op" to use */
+};
+
+#ifdef PERL_OBJECT
+struct magic_state {
+ SV* mgs_sv;
+ U32 mgs_flags;
+};
+typedef struct magic_state MGS;
+
+typedef struct {
+ I32 len_min;
+ I32 len_delta;
+ I32 pos_min;
+ I32 pos_delta;
+ SV *last_found;
+ I32 last_end; /* min value, <0 unless valid. */
+ I32 last_start_min;
+ I32 last_start_max;
+ SV **longest; /* Either &l_fixed, or &l_float. */
+ SV *longest_fixed;
+ I32 offset_fixed;
+ SV *longest_float;
+ I32 offset_float_min;
+ I32 offset_float_max;
+ I32 flags;
+} scan_data_t;
+
+typedef I32 CHECKPOINT;
+#endif /* PERL_OBJECT */
/* work around some libPW problems */
#ifdef DOINIT
@@ -1066,7 +1381,7 @@ EXT char Error[1];
# define HAS_VTOHS
# define HAS_HTOVL
# define HAS_HTOVS
-# if BYTEORDER == 0x4321
+# if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
# define vtohl(x) ((((x)&0xFF)<<24) \
+(((x)>>24)&0xFF) \
+(((x)&0x0000FF00)<<8) \
@@ -1083,13 +1398,7 @@ EXT char Error[1];
#define U_I(what) ((unsigned int)(what))
#define U_L(what) ((U32)(what))
#else
-# ifdef __cplusplus
- extern "C" {
-# endif
-U32 cast_ulong _((double));
-# ifdef __cplusplus
- }
-# endif
+EXTERN_C U32 cast_ulong _((double));
#define U_S(what) ((U16)cast_ulong((double)(what)))
#define U_I(what) ((unsigned int)cast_ulong((double)(what)))
#define U_L(what) (cast_ulong((double)(what)))
@@ -1100,15 +1409,11 @@ U32 cast_ulong _((double));
#define I_V(what) ((IV)(what))
#define U_V(what) ((UV)(what))
#else
-# ifdef __cplusplus
- extern "C" {
-# endif
+START_EXTERN_C
I32 cast_i32 _((double));
IV cast_iv _((double));
UV cast_uv _((double));
-# ifdef __cplusplus
- }
-# endif
+END_EXTERN_C
#define I_32(what) (cast_i32((double)(what)))
#define I_V(what) (cast_iv((double)(what)))
#define U_V(what) (cast_uv((double)(what)))
@@ -1139,25 +1444,31 @@ Gid_t getegid _((void));
#ifndef Perl_debug_log
#define Perl_debug_log PerlIO_stderr()
#endif
+#undef YYDEBUG
#define YYDEBUG 1
#define DEB(a) a
-#define DEBUG(a) if (debug) a
-#define DEBUG_p(a) if (debug & 1) a
-#define DEBUG_s(a) if (debug & 2) a
-#define DEBUG_l(a) if (debug & 4) a
-#define DEBUG_t(a) if (debug & 8) a
-#define DEBUG_o(a) if (debug & 16) a
-#define DEBUG_c(a) if (debug & 32) a
-#define DEBUG_P(a) if (debug & 64) a
-#define DEBUG_m(a) if (curinterp && debug & 128) a
-#define DEBUG_f(a) if (debug & 256) a
-#define DEBUG_r(a) if (debug & 512) a
-#define DEBUG_x(a) if (debug & 1024) a
-#define DEBUG_u(a) if (debug & 2048) a
-#define DEBUG_L(a) if (debug & 4096) a
-#define DEBUG_H(a) if (debug & 8192) a
-#define DEBUG_X(a) if (debug & 16384) a
-#define DEBUG_D(a) if (debug & 32768) a
+#define DEBUG(a) if (PL_debug) a
+#define DEBUG_p(a) if (PL_debug & 1) a
+#define DEBUG_s(a) if (PL_debug & 2) a
+#define DEBUG_l(a) if (PL_debug & 4) a
+#define DEBUG_t(a) if (PL_debug & 8) a
+#define DEBUG_o(a) if (PL_debug & 16) a
+#define DEBUG_c(a) if (PL_debug & 32) a
+#define DEBUG_P(a) if (PL_debug & 64) a
+#define DEBUG_m(a) if (PL_curinterp && PL_debug & 128) a
+#define DEBUG_f(a) if (PL_debug & 256) a
+#define DEBUG_r(a) if (PL_debug & 512) a
+#define DEBUG_x(a) if (PL_debug & 1024) a
+#define DEBUG_u(a) if (PL_debug & 2048) a
+#define DEBUG_L(a) if (PL_debug & 4096) a
+#define DEBUG_H(a) if (PL_debug & 8192) a
+#define DEBUG_X(a) if (PL_debug & 16384) a
+#define DEBUG_D(a) if (PL_debug & 32768) a
+# ifdef USE_THREADS
+# define DEBUG_S(a) if (PL_debug & (1<<16)) a
+# else
+# define DEBUG_S(a)
+# endif
#else
#define DEB(a)
#define DEBUG(a)
@@ -1173,10 +1484,11 @@ Gid_t getegid _((void));
#define DEBUG_r(a)
#define DEBUG_x(a)
#define DEBUG_u(a)
-#define DEBUG_L(a)
+#define DEBUG_S(a)
#define DEBUG_H(a)
#define DEBUG_X(a)
#define DEBUG_D(a)
+#define DEBUG_S(a)
#endif
#define YYMAXDEPTH 300
@@ -1185,7 +1497,7 @@ Gid_t getegid _((void));
if (!(what)) { \
croak("Assertion failed: file \"%s\", line %d", \
__FILE__, __LINE__); \
- exit(1); \
+ PerlProc_exit(1); \
}})
#endif
@@ -1205,17 +1517,20 @@ double atof _((const char*));
/* All of these are in stdlib.h or time.h for ANSI C */
Time_t time();
struct tm *gmtime(), *localtime();
+#ifdef OEMVS
+char *(strchr)(), *(strrchr)();
+char *(strcpy)(), *(strcat)();
+#else
char *strchr(), *strrchr();
char *strcpy(), *strcat();
+#endif
#endif /* ! STANDARD_C */
#ifdef I_MATH
# include <math.h>
#else
-# ifdef __cplusplus
- extern "C" {
-# endif
+START_EXTERN_C
double exp _((double));
double log _((double));
double log10 _((double));
@@ -1227,31 +1542,31 @@ char *strcpy(), *strcat();
double cos _((double));
double atan2 _((double,double));
double pow _((double,double));
-# ifdef __cplusplus
- };
-# endif
+END_EXTERN_C
#endif
#ifndef __cplusplus
-#ifdef __NeXT__ /* or whatever catches all NeXTs */
+# ifdef __NeXT__ /* or whatever catches all NeXTs */
char *crypt (); /* Maybe more hosts will need the unprototyped version */
-#else
+# else
+# if !defined(WIN32) || !defined(HAVE_DES_FCRYPT)
char *crypt _((const char*, const char*));
-#endif
-#ifndef DONT_DECLARE_STD
-#ifndef getenv
+# endif /* !WIN32 && !HAVE_CRYPT_SOURCE */
+# endif /* !__NeXT__ */
+# ifndef DONT_DECLARE_STD
+# ifndef getenv
char *getenv _((const char*));
-#endif
+# endif /* !getenv */
Off_t lseek _((int,Off_t,int));
-#endif
+# endif /* !DONT_DECLARE_STD */
char *getlogin _((void));
-#endif
+#endif /* !__cplusplus */
#ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */
#define UNLINK unlnk
I32 unlnk _((char*));
#else
-#define UNLINK unlink
+#define UNLINK PerlLIO_unlink
#endif
#ifndef HAS_SETREUID
@@ -1284,19 +1599,56 @@ typedef Sighandler_t Sigsave_t;
# define register
# endif
# define PAD_SV(po) pad_sv(po)
+# define RUNOPS_DEFAULT runops_debug
#else
-# define PAD_SV(po) curpad[po]
+# define PAD_SV(po) PL_curpad[po]
+# define RUNOPS_DEFAULT runops_standard
#endif
-/****************/
-/* Truly global */
-/****************/
+#ifdef MYMALLOC
+# ifdef MUTEX_INIT_CALLS_MALLOC
+# define MALLOC_INIT \
+ STMT_START { \
+ PL_malloc_mutex = NULL; \
+ MUTEX_INIT(&PL_malloc_mutex); \
+ } STMT_END
+# define MALLOC_TERM \
+ STMT_START { \
+ perl_mutex tmp = PL_malloc_mutex; \
+ PL_malloc_mutex = NULL; \
+ MUTEX_DESTROY(&tmp); \
+ } STMT_END
+# else
+# define MALLOC_INIT MUTEX_INIT(&PL_malloc_mutex)
+# define MALLOC_TERM MUTEX_DESTROY(&PL_malloc_mutex)
+# endif
+#else
+# define MALLOC_INIT
+# define MALLOC_TERM
+#endif
+
+
+/*
+ * These need prototyping here because <proto.h> isn't
+ * included until after runops is initialised.
+ */
+
+#ifndef PERL_OBJECT
+typedef int runops_proc_t _((void));
+int runops_standard _((void));
+#ifdef DEBUGGING
+int runops_debug _((void));
+#endif
+#endif /* PERL_OBJECT */
+
+/* _ (for $_) must be first in the following list (DEFSV requires it) */
+#define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@"
-/* global state */
-EXT PerlInterpreter * curinterp; /* currently running interpreter */
/* VMS doesn't use environ array and NeXT has problems with crt0.o globals */
#if !defined(VMS) && !(defined(NeXT) && defined(__DYNAMIC__))
-#ifndef DONT_DECLARE_STD
+#if !defined(DONT_DECLARE_STD) \
+ || (defined(__svr4__) && defined(__GNUC__) && defined(sun)) \
+ || defined(__sgi) || defined(__DGUX)
extern char ** environ; /* environment variables supplied via exec */
#endif
#else
@@ -1308,69 +1660,6 @@ EXT char *** environ_pointer;
# endif
#endif /* environ processing */
-EXT int uid; /* current real user id */
-EXT int euid; /* current effective user id */
-EXT int gid; /* current real group id */
-EXT int egid; /* current effective group id */
-EXT bool nomemok; /* let malloc context handle nomem */
-EXT U32 an; /* malloc sequence number */
-EXT U32 cop_seqmax; /* statement sequence number */
-EXT U16 op_seqmax; /* op sequence number */
-EXT U32 evalseq; /* eval sequence number */
-EXT U32 sub_generation; /* inc to force methods to be looked up again */
-EXT char ** origenviron;
-EXT U32 origalen;
-EXT HV * pidstatus; /* pid-to-status mappings for waitpid */
-EXT U32 * profiledata;
-EXT int maxo INIT(MAXO);/* Number of ops */
-EXT char * osname; /* operating system */
-EXT char * sh_path INIT(SH_PATH); /* full path of shell */
-
-EXT XPV* xiv_arenaroot; /* list of allocated xiv areas */
-EXT IV ** xiv_root; /* free xiv list--shared by interpreters */
-EXT double * xnv_root; /* free xnv list--shared by interpreters */
-EXT XRV * xrv_root; /* free xrv list--shared by interpreters */
-EXT XPV * xpv_root; /* free xpv list--shared by interpreters */
-EXT HE * he_root; /* free he list--shared by interpreters */
-EXT char * nice_chunk; /* a nice chunk of memory to reuse */
-EXT U32 nice_chunk_size;/* how nice the chunk of memory is */
-
-/* Stack for currently executing thread--context switch must handle this. */
-EXT SV ** stack_base; /* stack->array_ary */
-EXT SV ** stack_sp; /* stack pointer now */
-EXT SV ** stack_max; /* stack->array_ary + stack->array_max */
-
-/* likewise for these */
-
-EXT OP * op; /* current op--oughta be in a global register */
-
-EXT I32 * scopestack; /* blocks we've entered */
-EXT I32 scopestack_ix;
-EXT I32 scopestack_max;
-
-EXT ANY* savestack; /* to save non-local values on */
-EXT I32 savestack_ix;
-EXT I32 savestack_max;
-
-EXT OP ** retstack; /* returns we've pushed */
-EXT I32 retstack_ix;
-EXT I32 retstack_max;
-
-EXT I32 * markstack; /* stackmarks we're remembering */
-EXT I32 * markstack_ptr; /* stackmarks we're remembering */
-EXT I32 * markstack_max; /* stackmarks we're remembering */
-
-EXT SV ** curpad;
-
-/* temp space */
-EXT SV * Sv;
-EXT XPV * Xpv;
-EXT char tokenbuf[256];
-EXT struct stat statbuf;
-#ifdef HAS_TIMES
-EXT struct tms timesbuf;
-#endif
-EXT STRLEN na; /* for use in SvPV when length is Not Applicable */
/* for tmp use in stupid debuggers */
EXT int * di;
@@ -1378,12 +1667,6 @@ EXT short * ds;
EXT char * dc;
/* handy constants */
-EXTCONST char * Yes INIT("1");
-EXTCONST char * No INIT("");
-EXTCONST char * hexdigit INIT("0123456789abcdef0123456789ABCDEFx");
-EXTCONST char * patleave INIT("\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}");
-EXTCONST char * vert INIT("|");
-
EXTCONST char warn_uninit[]
INIT("Use of uninitialized value");
EXTCONST char warn_nosemi[]
@@ -1417,14 +1700,6 @@ EXTCONST char no_func[]
EXTCONST char no_myglob[]
INIT("\"my\" variable %s can't be in a package");
-EXT SV sv_undef;
-EXT SV sv_no;
-EXT SV sv_yes;
-#ifdef CSH
- EXT char * cshname INIT(CSH);
- EXT I32 cshlen;
-#endif
-
#ifdef DOINIT
EXT char *sig_name[] = { SIG_NAME };
EXT int sig_num[] = { SIG_NUM };
@@ -1440,6 +1715,42 @@ EXT SV * psig_name[];
/* fast case folding tables */
#ifdef DOINIT
+#ifdef EBCDIC
+EXT unsigned char fold[] = { /* fast EBCDIC case folding table */
+ 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, 49, 50, 51, 52, 53, 54, 55,
+ 56, 57, 58, 59, 60, 61, 62, 63,
+ 64, 65, 66, 67, 68, 69, 70, 71,
+ 72, 73, 74, 75, 76, 77, 78, 79,
+ 80, 81, 82, 83, 84, 85, 86, 87,
+ 88, 89, 90, 91, 92, 93, 94, 95,
+ 96, 97, 98, 99, 100, 101, 102, 103,
+ 104, 105, 106, 107, 108, 109, 110, 111,
+ 112, 113, 114, 115, 116, 117, 118, 119,
+ 120, 121, 122, 123, 124, 125, 126, 127,
+ 128, 'A', 'B', 'C', 'D', 'E', 'F', 'G',
+ 'H', 'I', 138, 139, 140, 141, 142, 143,
+ 144, 'J', 'K', 'L', 'M', 'N', 'O', 'P',
+ 'Q', 'R', 154, 155, 156, 157, 158, 159,
+ 160, 161, 'S', 'T', 'U', 'V', 'W', 'X',
+ 'Y', 'Z', 170, 171, 172, 173, 174, 175,
+ 176, 177, 178, 179, 180, 181, 182, 183,
+ 184, 185, 186, 187, 188, 189, 190, 191,
+ 192, 'a', 'b', 'c', 'd', 'e', 'f', 'g',
+ 'h', 'i', 202, 203, 204, 205, 206, 207,
+ 208, 'j', 'k', 'l', 'm', 'n', 'o', 'p',
+ 'q', 'r', 218, 219, 220, 221, 222, 223,
+ 224, 225, 's', 't', 'u', 'v', 'w', 'x',
+ 'y', 'z', 234, 235, 236, 237, 238, 239,
+ 240, 241, 242, 243, 244, 245, 246, 247,
+ 248, 249, 250, 251, 252, 253, 254, 255
+};
+#else /* ascii rather than ebcdic */
EXTCONST unsigned char fold[] = {
0, 1, 2, 3, 4, 5, 6, 7,
8, 9, 10, 11, 12, 13, 14, 15,
@@ -1474,6 +1785,7 @@ EXTCONST unsigned char fold[] = {
240, 241, 242, 243, 244, 245, 246, 247,
248, 249, 250, 251, 252, 253, 254, 255
};
+#endif /* !EBCDIC */
#else
EXTCONST unsigned char fold[];
#endif
@@ -1518,6 +1830,42 @@ EXT unsigned char fold_locale[];
#endif
#ifdef DOINIT
+#ifdef EBCDIC
+EXT unsigned char freq[] = {/* EBCDIC frequencies for mixed English/C */
+ 1, 2, 84, 151, 154, 155, 156, 157,
+ 165, 246, 250, 3, 158, 7, 18, 29,
+ 40, 51, 62, 73, 85, 96, 107, 118,
+ 129, 140, 147, 148, 149, 150, 152, 153,
+ 255, 6, 8, 9, 10, 11, 12, 13,
+ 14, 15, 24, 25, 26, 27, 28, 226,
+ 29, 30, 31, 32, 33, 43, 44, 45,
+ 46, 47, 48, 49, 50, 76, 77, 78,
+ 79, 80, 81, 82, 83, 84, 85, 86,
+ 87, 94, 95, 234, 181, 233, 187, 190,
+ 180, 96, 97, 98, 99, 100, 101, 102,
+ 104, 112, 182, 174, 236, 232, 229, 103,
+ 228, 226, 114, 115, 116, 117, 118, 119,
+ 120, 121, 122, 235, 176, 230, 194, 162,
+ 130, 131, 132, 133, 134, 135, 136, 137,
+ 138, 139, 201, 205, 163, 217, 220, 224,
+ 5, 248, 227, 244, 242, 255, 241, 231,
+ 240, 253, 16, 197, 19, 20, 21, 187,
+ 23, 169, 210, 245, 237, 249, 247, 239,
+ 168, 252, 34, 196, 36, 37, 38, 39,
+ 41, 42, 251, 254, 238, 223, 221, 213,
+ 225, 177, 52, 53, 54, 55, 56, 57,
+ 58, 59, 60, 61, 63, 64, 65, 66,
+ 67, 68, 69, 70, 71, 72, 74, 75,
+ 205, 208, 186, 202, 200, 218, 198, 179,
+ 178, 214, 88, 89, 90, 91, 92, 93,
+ 217, 166, 170, 207, 199, 209, 206, 204,
+ 160, 212, 105, 106, 108, 109, 110, 111,
+ 203, 113, 216, 215, 192, 175, 193, 243,
+ 172, 161, 123, 124, 125, 126, 127, 128,
+ 222, 219, 211, 195, 188, 193, 185, 184,
+ 191, 183, 141, 142, 143, 144, 145, 146
+};
+#else /* ascii rather than ebcdic */
EXTCONST unsigned char freq[] = { /* letter frequencies for mixed English/C */
1, 2, 84, 151, 154, 155, 156, 157,
165, 246, 250, 3, 158, 7, 18, 29,
@@ -1552,6 +1900,7 @@ EXTCONST unsigned char freq[] = { /* letter frequencies for mixed English/C */
130, 131, 132, 133, 134, 135, 136, 137,
138, 139, 141, 142, 143, 144, 145, 146
};
+#endif
#else
EXTCONST unsigned char freq[];
#endif
@@ -1589,69 +1938,39 @@ typedef enum {
XTERMBLOCK
} expectation;
-EXT U32 lex_state; /* next token is determined */
-EXT U32 lex_defer; /* state after determined token */
-EXT expectation lex_expect; /* expect after determined token */
-EXT I32 lex_brackets; /* bracket count */
-EXT I32 lex_formbrack; /* bracket count at outer format level */
-EXT I32 lex_fakebrack; /* outer bracket is mere delimiter */
-EXT I32 lex_casemods; /* casemod count */
-EXT I32 lex_dojoin; /* doing an array interpolation */
-EXT I32 lex_starts; /* how many interps done on level */
-EXT SV * lex_stuff; /* runtime pattern from m// or s/// */
-EXT SV * lex_repl; /* runtime replacement from s/// */
-EXT OP * lex_op; /* extra info to pass back on op */
-EXT OP * lex_inpat; /* in pattern $) and $| are special */
-EXT I32 lex_inwhat; /* what kind of quoting are we in */
-EXT char * lex_brackstack; /* what kind of brackets to pop */
-EXT char * lex_casestack; /* what kind of case mods in effect */
-
-/* What we know when we're in LEX_KNOWNEXT state. */
-EXT YYSTYPE nextval[5]; /* value of next token, if any */
-EXT I32 nexttype[5]; /* type of next token */
-EXT I32 nexttoke;
-
-EXT PerlIO * VOL rsfp INIT(Nullfp);
-EXT SV * linestr;
-EXT char * bufptr;
-EXT char * oldbufptr;
-EXT char * oldoldbufptr;
-EXT char * bufend;
-EXT expectation expect INIT(XSTATE); /* how to interpret ambiguous tokens */
-EXT AV * rsfp_filters;
-
-EXT I32 multi_start; /* 1st line of multi-line string */
-EXT I32 multi_end; /* last line of multi-line string */
-EXT I32 multi_open; /* delimiter of said string */
-EXT I32 multi_close; /* delimiter of said string */
-
-EXT GV * scrgv;
-EXT I32 error_count; /* how many errors so far, max 10 */
-EXT I32 subline; /* line this subroutine began on */
-EXT SV * subname; /* name of current subroutine */
-
-EXT CV * compcv; /* currently compiling subroutine */
-EXT AV * comppad; /* storage for lexically scoped temporaries */
-EXT AV * comppad_name; /* variable names for "my" variables */
-EXT I32 comppad_name_fill;/* last "introduced" variable offset */
-EXT I32 comppad_name_floor;/* start of vars in innermost block */
-EXT I32 min_intro_pending;/* start of vars to introduce */
-EXT I32 max_intro_pending;/* end of vars to introduce */
-EXT I32 padix; /* max used index in current "register" pad */
-EXT I32 padix_floor; /* how low may inner block reset padix */
-EXT I32 pad_reset_pending; /* reset pad on next attempted alloc */
-EXT COP compiling;
-
-EXT I32 thisexpr; /* name id for nothing_in_common() */
-EXT char * last_uni; /* position of last named-unary operator */
-EXT char * last_lop; /* position of last list operator */
-EXT OPCODE last_lop_op; /* last list operator */
-EXT bool in_my; /* we're compiling a "my" declaration */
-#ifdef FCRYPT
-EXT I32 cryptseen; /* has fast crypt() been initialized? */
-#endif
-
-EXT U32 hints; /* various compilation flags */
+enum { /* pass one of these to get_vtbl */
+ want_vtbl_sv,
+ want_vtbl_env,
+ want_vtbl_envelem,
+ want_vtbl_sig,
+ want_vtbl_sigelem,
+ want_vtbl_pack,
+ want_vtbl_packelem,
+ want_vtbl_dbline,
+ want_vtbl_isa,
+ want_vtbl_isaelem,
+ want_vtbl_arylen,
+ want_vtbl_glob,
+ want_vtbl_mglob,
+ want_vtbl_nkeys,
+ want_vtbl_taint,
+ want_vtbl_substr,
+ want_vtbl_vec,
+ want_vtbl_pos,
+ want_vtbl_bm,
+ want_vtbl_fm,
+ want_vtbl_uvar,
+ want_vtbl_defelem,
+ want_vtbl_regexp,
+ want_vtbl_collxfrm,
+ want_vtbl_amagic,
+ want_vtbl_amagicelem
+#ifdef USE_THREADS
+ ,
+ want_vtbl_mutex
+#endif
+};
+
/* Note: the lowest 8 bits are reserved for
stuffing into op->op_private */
@@ -1663,253 +1982,130 @@ EXT U32 hints; /* various compilation flags */
#define HINT_STRICT_VARS 0x00000400
#define HINT_LOCALE 0x00000800
-/**************************************************************************/
-/* This regexp stuff is global since it always happens within 1 expr eval */
-/**************************************************************************/
-
-EXT char * regprecomp; /* uncompiled string. */
-EXT char * regparse; /* Input-scan pointer. */
-EXT char * regxend; /* End of input for compile */
-EXT I32 regnpar; /* () count. */
-EXT char * regcode; /* Code-emit pointer; &regdummy = don't. */
-EXT I32 regsize; /* Code size. */
-EXT I32 regnaughty; /* How bad is this pattern? */
-EXT I32 regsawback; /* Did we see \1, ...? */
-
-EXT char * reginput; /* String-input pointer. */
-EXT char * regbol; /* Beginning of input, for ^ check. */
-EXT char * regeol; /* End of input, for $ check. */
-EXT char ** regstartp; /* Pointer to startp array. */
-EXT char ** regendp; /* Ditto for endp. */
-EXT U32 * reglastparen; /* Similarly for lastparen. */
-EXT char * regtill; /* How far we are required to go. */
-EXT U16 regflags; /* are we folding, multilining? */
-EXT char regprev; /* char before regbol, \n if none */
-
-EXT bool do_undump; /* -u or dump seen? */
-EXT VOL U32 debug;
-
-/***********************************************/
-/* Global only to current interpreter instance */
-/***********************************************/
+#define HINT_NEW_INTEGER 0x00001000
+#define HINT_NEW_FLOAT 0x00002000
+#define HINT_NEW_BINARY 0x00004000
+#define HINT_NEW_STRING 0x00008000
+#define HINT_NEW_RE 0x00010000
+#define HINT_LOCALIZE_HH 0x00020000 /* %^H needs to be copied */
-#ifdef MULTIPLICITY
-#define IEXT
-#define IINIT(x)
-struct interpreter {
-#else
-#define IEXT EXT
-#define IINIT(x) INIT(x)
-#endif
-
-/* pseudo environmental stuff */
-IEXT int Iorigargc;
-IEXT char ** Iorigargv;
-IEXT GV * Ienvgv;
-IEXT GV * Isiggv;
-IEXT GV * Iincgv;
-IEXT char * Iorigfilename;
-IEXT SV * Idiehook;
-IEXT SV * Iwarnhook;
-IEXT SV * Iparsehook;
+#define HINT_RE_TAINT 0x00100000
+#define HINT_RE_EVAL 0x00200000
/* Various states of an input record separator SV (rs, nrs) */
#define RsSNARF(sv) (! SvOK(sv))
#define RsSIMPLE(sv) (SvOK(sv) && SvCUR(sv))
#define RsPARA(sv) (SvOK(sv) && ! SvCUR(sv))
+#define RsRECORD(sv) (SvROK(sv) && (SvIV(SvRV(sv)) > 0))
+
+/* Enable variables which are pointers to functions */
+#ifdef PERL_OBJECT
+typedef regexp*(CPerlObj::*regcomp_t) _((char* exp, char* xend, PMOP* pm));
+typedef I32 (CPerlObj::*regexec_t) _((regexp* prog, char* stringarg,
+ char* strend, char* strbeg,
+ I32 minend, SV* screamer, void* data,
+ U32 flags));
+#else
+typedef regexp*(*regcomp_t) _((char* exp, char* xend, PMOP* pm));
+typedef I32 (*regexec_t) _((regexp* prog, char* stringarg, char* strend, char*
+ strbeg, I32 minend, SV* screamer, void* data,
+ U32 flags));
-/* switches */
-IEXT char * Icddir;
-IEXT bool Iminus_c;
-IEXT char Ipatchlevel[10];
-IEXT char ** Ilocalpatches;
-IEXT SV * Inrs;
-IEXT char * Isplitstr IINIT(" ");
-IEXT bool Ipreprocess;
-IEXT bool Iminus_n;
-IEXT bool Iminus_p;
-IEXT bool Iminus_l;
-IEXT bool Iminus_a;
-IEXT bool Iminus_F;
-IEXT bool Idoswitches;
-IEXT bool Idowarn;
-IEXT bool Idoextract;
-IEXT bool Isawampersand; /* must save all match strings */
-IEXT bool Isawstudy; /* do fbm_instr on all strings */
-IEXT bool Isawvec;
-IEXT bool Iunsafe;
-IEXT char * Iinplace;
-IEXT char * Ie_tmpname;
-IEXT PerlIO * Ie_fp;
-IEXT U32 Iperldb;
- /* This value may be raised by extensions for testing purposes */
-IEXT int Iperl_destruct_level IINIT(0); /* 0=none, 1=full, 2=full with checks */
-
-/* magical thingies */
-IEXT Time_t Ibasetime; /* $^T */
-IEXT SV * Iformfeed; /* $^L */
-IEXT char * Ichopset IINIT(" \n-"); /* $: */
-IEXT SV * Irs; /* $/ */
-IEXT char * Iofs; /* $, */
-IEXT STRLEN Iofslen;
-IEXT char * Iors; /* $\ */
-IEXT STRLEN Iorslen;
-IEXT char * Iofmt; /* $# */
-IEXT I32 Imaxsysfd IINIT(MAXSYSFD); /* top fd to pass to subprocesses */
-IEXT int Imultiline; /* $*--do strings hold >1 line? */
-IEXT I32 Istatusvalue; /* $? */
-#ifdef VMS
-IEXT U32 Istatusvalue_vms;
-#endif
-
-IEXT struct stat Istatcache; /* _ */
-IEXT GV * Istatgv;
-IEXT SV * Istatname IINIT(Nullsv);
-
-/* shortcuts to various I/O objects */
-IEXT GV * Istdingv;
-IEXT GV * Ilast_in_gv;
-IEXT GV * Idefgv;
-IEXT GV * Iargvgv;
-IEXT GV * Idefoutgv;
-IEXT GV * Iargvoutgv;
-
-/* shortcuts to regexp stuff */
-IEXT GV * Ileftgv;
-IEXT GV * Iampergv;
-IEXT GV * Irightgv;
-IEXT PMOP * Icurpm; /* what to do \ interps from */
-IEXT I32 * Iscreamfirst;
-IEXT I32 * Iscreamnext;
-IEXT I32 Imaxscream IINIT(-1);
-IEXT SV * Ilastscream;
-
-/* shortcuts to misc objects */
-IEXT GV * Ierrgv;
-
-/* shortcuts to debugging objects */
-IEXT GV * IDBgv;
-IEXT GV * IDBline;
-IEXT GV * IDBsub;
-IEXT SV * IDBsingle;
-IEXT SV * IDBtrace;
-IEXT SV * IDBsignal;
-IEXT AV * Ilineary; /* lines of script for debugger */
-IEXT AV * Idbargs; /* args to call listed by caller function */
-
-/* symbol tables */
-IEXT HV * Idefstash; /* main symbol table */
-IEXT HV * Icurstash; /* symbol table for current package */
-IEXT HV * Idebstash; /* symbol table for perldb package */
-IEXT SV * Icurstname; /* name of current package */
-IEXT AV * Ibeginav; /* names of BEGIN subroutines */
-IEXT AV * Iendav; /* names of END subroutines */
-IEXT HV * Istrtab; /* shared string table */
-
-/* memory management */
-IEXT SV ** Itmps_stack;
-IEXT I32 Itmps_ix IINIT(-1);
-IEXT I32 Itmps_floor IINIT(-1);
-IEXT I32 Itmps_max;
-IEXT I32 Isv_count; /* how many SV* are currently allocated */
-IEXT I32 Isv_objcount; /* how many objects are currently allocated */
-IEXT SV* Isv_root; /* storage for SVs belonging to interp */
-IEXT SV* Isv_arenaroot; /* list of areas for garbage collection */
-
-/* funky return mechanisms */
-IEXT I32 Ilastspbase;
-IEXT I32 Ilastsize;
-IEXT int Iforkprocess; /* so do_open |- can return proc# */
-
-/* subprocess state */
-IEXT AV * Ifdpid; /* keep fd-to-pid mappings for my_popen */
-
-/* internal state */
-IEXT VOL int Iin_eval; /* trap "fatal" errors? */
-IEXT OP * Irestartop; /* Are we propagating an error from croak? */
-IEXT int Idelaymagic; /* ($<,$>) = ... */
-IEXT bool Idirty; /* In the middle of tearing things down? */
-IEXT U8 Ilocalizing; /* are we processing a local() list? */
-IEXT bool Itainted; /* using variables controlled by $< */
-IEXT bool Itainting; /* doing taint checks */
-IEXT char * Iop_mask IINIT(NULL); /* masked operations for safe evals */
-
-/* trace state */
-IEXT I32 Idlevel;
-IEXT I32 Idlmax IINIT(128);
-IEXT char * Idebname;
-IEXT char * Idebdelim;
-
-/* current interpreter roots */
-IEXT CV * Imain_cv;
-IEXT OP * Imain_root;
-IEXT OP * Imain_start;
-IEXT OP * Ieval_root;
-IEXT OP * Ieval_start;
-
-/* runtime control stuff */
-IEXT COP * VOL Icurcop IINIT(&compiling);
-IEXT COP * Icurcopdb IINIT(NULL);
-IEXT line_t Icopline IINIT(NOLINE);
-IEXT CONTEXT * Icxstack;
-IEXT I32 Icxstack_ix IINIT(-1);
-IEXT I32 Icxstack_max IINIT(128);
-IEXT JMPENV Istart_env; /* empty startup sigjmp() environment */
-IEXT JMPENV * Itop_env; /* ptr. to current sigjmp() environment */
-IEXT I32 Irunlevel;
-
-/* stack stuff */
-IEXT AV * Icurstack; /* THE STACK */
-IEXT AV * Imainstack; /* the stack when nothing funny is happening */
-IEXT SV ** Imystack_base; /* stack->array_ary */
-IEXT SV ** Imystack_sp; /* stack pointer now */
-IEXT SV ** Imystack_max; /* stack->array_ary + stack->array_max */
-
-/* format accumulators */
-IEXT SV * Iformtarget;
-IEXT SV * Ibodytarget;
-IEXT SV * Itoptarget;
-
-/* statics moved here for shared library purposes */
-IEXT SV Istrchop; /* return value from chop */
-IEXT int Ifilemode; /* so nextargv() can preserve mode */
-IEXT int Ilastfd; /* what to preserve mode on */
-IEXT char * Ioldname; /* what to preserve mode on */
-IEXT char ** IArgv; /* stuff to free from do_aexec, vfork safe */
-IEXT char * ICmd; /* stuff to free from do_aexec, vfork safe */
-IEXT OP * Isortcop; /* user defined sort routine */
-IEXT HV * Isortstash; /* which is in some package or other */
-IEXT GV * Ifirstgv; /* $a */
-IEXT GV * Isecondgv; /* $b */
-IEXT AV * Isortstack; /* temp stack during pp_sort() */
-IEXT AV * Isignalstack; /* temp stack during sighandler() */
-IEXT SV * Imystrk; /* temp key string for do_each() */
-IEXT I32 Idumplvl; /* indentation level on syntax tree dump */
-IEXT PMOP * Ioldlastpm; /* for saving regexp context during debugger */
-IEXT I32 Igensym; /* next symbol for getsym() to define */
-IEXT bool Ipreambled;
-IEXT AV * Ipreambleav;
-IEXT int Ilaststatval IINIT(-1);
-IEXT I32 Ilaststype IINIT(OP_STAT);
-IEXT SV * Imess_sv;
-
-#undef IEXT
-#undef IINIT
+#endif
+
+/* Set up PERLVAR macros for populating structs */
+#define PERLVAR(var,type) type var;
+#define PERLVARI(var,type,init) type var;
+#define PERLVARIC(var,type,init) type var;
+
+/* Interpreter exitlist entry */
+typedef struct exitlistentry {
+#ifdef PERL_OBJECT
+ void (*fn) _((CPerlObj*, void*));
+#else
+ void (*fn) _((void*));
+#endif
+ void *ptr;
+} PerlExitListEntry;
+
+#ifdef PERL_OBJECT
+extern "C" CPerlObj* perl_alloc _((IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*));
+
+typedef int (CPerlObj::*runops_proc_t) _((void));
+#undef EXT
+#define EXT
+#undef EXTCONST
+#define EXTCONST
+#undef INIT
+#define INIT(x)
+
+class CPerlObj {
+public:
+ CPerlObj(IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*);
+ void Init(void);
+ void* operator new(size_t nSize, IPerlMem *pvtbl);
+#endif /* PERL_OBJECT */
+
+#ifdef PERL_GLOBAL_STRUCT
+struct perl_vars {
+#include "perlvars.h"
+};
+
+#ifdef PERL_CORE
+EXT struct perl_vars PL_Vars;
+EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars);
+#else /* PERL_CORE */
+#if !defined(__GNUC__) || !defined(WIN32)
+EXT
+#endif /* WIN32 */
+struct perl_vars *PL_VarsPtr;
+#define PL_Vars (*((PL_VarsPtr) ? PL_VarsPtr : (PL_VarsPtr = Perl_GetVars())))
+#endif /* PERL_CORE */
+#endif /* PERL_GLOBAL_STRUCT */
#ifdef MULTIPLICITY
+/* If we have multiple interpreters define a struct
+ holding variables which must be per-interpreter
+ If we don't have threads anything that would have
+ be per-thread is per-interpreter.
+*/
+
+struct interpreter {
+#ifndef USE_THREADS
+#include "thrdvar.h"
+#endif
+#include "intrpvar.h"
};
+
#else
struct interpreter {
char broiled;
};
#endif
-#include "pp.h"
+#ifdef USE_THREADS
+/* If we have threads define a struct with all the variables
+ * that have to be per-thread
+ */
-#ifdef __cplusplus
-extern "C" {
+
+struct perl_thread {
+#include "thrdvar.h"
+};
+
+typedef struct perl_thread *Thread;
+
+#else
+typedef void *Thread;
#endif
+/* Done with PERLVAR macros for now ... */
+#undef PERLVAR
+#undef PERLVARI
+#undef PERLVARIC
+
+#include "thread.h"
+#include "pp.h"
#include "proto.h"
#ifdef EMBED
@@ -1920,11 +2116,109 @@ extern "C" {
#define sv_setptrref(rv,ptr) sv_setref_iv(rv,Nullch,(IV)ptr)
#endif
-#ifdef __cplusplus
+/* The following must follow proto.h as #defines mess up syntax */
+
+#include "embedvar.h"
+
+/* Now include all the 'global' variables
+ * If we don't have threads or multiple interpreters
+ * these include variables that would have been their struct-s
+ */
+
+#define PERLVAR(var,type) EXT type PL_##var;
+#define PERLVARI(var,type,init) EXT type PL_##var INIT(init);
+#define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init);
+
+#ifndef PERL_GLOBAL_STRUCT
+#include "perlvars.h"
+#endif
+
+#ifndef MULTIPLICITY
+
+# include "intrpvar.h"
+# ifndef USE_THREADS
+# include "thrdvar.h"
+# endif
+
+#endif
+
+#ifdef PERL_OBJECT
+/* from perly.c */
+#undef yydebug
+#undef yynerrs
+#undef yyerrflag
+#undef yychar
+#undef yyssp
+#undef yyvsp
+#undef yyval
+#undef yylval
+#define yydebug PL_yydebug
+#define yynerrs PL_yynerrs
+#define yyerrflag PL_yyerrflag
+#define yychar PL_yychar
+#define yyssp PL_yyssp
+#define yyvsp PL_yyvsp
+#define yyval PL_yyval
+#define yylval PL_yylval
+PERLVAR(yydebug, int)
+PERLVAR(yynerrs, int)
+PERLVAR(yyerrflag, int)
+PERLVAR(yychar, int)
+PERLVAR(yyssp, short*)
+PERLVAR(yyvsp, YYSTYPE*)
+PERLVAR(yyval, YYSTYPE)
+PERLVAR(yylval, YYSTYPE)
+
+#define efloatbuf PL_efloatbuf
+#define efloatsize PL_efloatsize
+PERLVAR(efloatbuf, char *)
+PERLVAR(efloatsize, STRLEN)
+
+#define glob_index PL_glob_index
+#define srand_called PL_srand_called
+#define uudmap PL_uudmap
+#define bitcount PL_bitcount
+#define filter_debug PL_filter_debug
+PERLVAR(glob_index, int)
+PERLVAR(srand_called, bool)
+PERLVAR(uudmap[256], char)
+PERLVAR(bitcount, char*)
+PERLVAR(filter_debug, int)
+PERLVAR(super_bufptr, char*) /* PL_bufptr that was */
+PERLVAR(super_bufend, char*) /* PL_bufend that was */
+
+/*
+ * The following is a buffer where new variables must
+ * be defined to maintain binary compatibility with PERL_OBJECT
+ * for 5.005
+ */
+PERLVAR(object_compatibility[30], char)
};
+
+#include "objpp.h"
+#ifdef DOINIT
+#include "INTERN.h"
+#else
+#include "EXTERN.h"
#endif
+#endif /* PERL_OBJECT */
+
-/* The following must follow proto.h */
+#undef PERLVAR
+#undef PERLVARI
+#undef PERLVARIC
+
+#if defined(HASATTRIBUTE) && defined(WIN32)
+/*
+ * This provides a layer of functions and macros to ensure extensions will
+ * get to use the same RTL functions as the core.
+ * It has to go here or #define of printf messes up __attribute__
+ * stuff in proto.h
+ */
+#ifndef PERL_OBJECT
+# include <win32iop.h>
+#endif /* PERL_OBJECT */
+#endif /* WIN32 */
#ifdef DOINIT
@@ -1943,7 +2237,7 @@ EXT MGVTBL vtbl_sigelem = {magic_getsig,
magic_setsig,
0, magic_clearsig,
0};
-EXT MGVTBL vtbl_pack = {0, 0, 0, magic_wipepack,
+EXT MGVTBL vtbl_pack = {0, 0, magic_sizepack, magic_wipepack,
0};
EXT MGVTBL vtbl_packelem = {magic_getpack,
magic_setpack,
@@ -1964,13 +2258,15 @@ EXT MGVTBL vtbl_glob = {magic_getglob,
0, 0, 0};
EXT MGVTBL vtbl_mglob = {0, magic_setmglob,
0, 0, 0};
-EXT MGVTBL vtbl_nkeys = {0, magic_setnkeys,
+EXT MGVTBL vtbl_nkeys = {magic_getnkeys,
+ magic_setnkeys,
0, 0, 0};
EXT MGVTBL vtbl_taint = {magic_gettaint,magic_settaint,
0, 0, 0};
-EXT MGVTBL vtbl_substr = {0, magic_setsubstr,
+EXT MGVTBL vtbl_substr = {magic_getsubstr, magic_setsubstr,
0, 0, 0};
-EXT MGVTBL vtbl_vec = {0, magic_setvec,
+EXT MGVTBL vtbl_vec = {magic_getvec,
+ magic_setvec,
0, 0, 0};
EXT MGVTBL vtbl_pos = {magic_getpos,
magic_setpos,
@@ -1982,8 +2278,13 @@ EXT MGVTBL vtbl_fm = {0, magic_setfm,
EXT MGVTBL vtbl_uvar = {magic_getuvar,
magic_setuvar,
0, 0, 0};
+#ifdef USE_THREADS
+EXT MGVTBL vtbl_mutex = {0, 0, 0, 0, magic_mutexfree};
+#endif /* USE_THREADS */
EXT MGVTBL vtbl_defelem = {magic_getdefelem,magic_setdefelem,
- 0, 0, magic_freedefelem};
+ 0, 0, 0};
+
+EXT MGVTBL vtbl_regexp = {0,0,0,0, magic_freeregexp};
#ifdef USE_LOCALE_COLLATE
EXT MGVTBL vtbl_collxfrm = {0,
@@ -2021,7 +2322,13 @@ EXT MGVTBL vtbl_pos;
EXT MGVTBL vtbl_bm;
EXT MGVTBL vtbl_fm;
EXT MGVTBL vtbl_uvar;
+
+#ifdef USE_THREADS
+EXT MGVTBL vtbl_mutex;
+#endif /* USE_THREADS */
+
EXT MGVTBL vtbl_defelem;
+EXT MGVTBL vtbl_regexp;
#ifdef USE_LOCALE_COLLATE
EXT MGVTBL vtbl_collxfrm;
@@ -2036,8 +2343,6 @@ EXT MGVTBL vtbl_amagicelem;
#ifdef OVERLOAD
-EXT long amagic_generation;
-
#define NofAMmeth 58
#ifdef DOINIT
EXTCONST char * AMG_names[NofAMmeth] = {
@@ -2107,7 +2412,7 @@ enum {
subtr_amg, subtr_ass_amg,
mult_amg, mult_ass_amg,
div_amg, div_ass_amg,
- mod_amg, mod_ass_amg,
+ modulo_amg, modulo_ass_amg,
pow_amg, pow_ass_amg,
lshift_amg, lshift_ass_amg,
rshift_amg, rshift_ass_amg,
@@ -2164,7 +2469,7 @@ enum {
#endif /* OVERLOAD */
-#define PERLDB_ALL 0xff
+#define PERLDB_ALL 0x3f /* No _NONAME, _GOTO */
#define PERLDBf_SUB 0x01 /* Debug sub enter/exit. */
#define PERLDBf_LINE 0x02 /* Keep line #. */
#define PERLDBf_NOOPT 0x04 /* Switch off optimizations. */
@@ -2172,37 +2477,30 @@ enum {
later inspections. */
#define PERLDBf_SUBLINE 0x10 /* Keep subr source lines. */
#define PERLDBf_SINGLE 0x20 /* Start with single-step on. */
+#define PERLDBf_NONAME 0x40 /* For _SUB: no name of the subr. */
+#define PERLDBf_GOTO 0x80 /* Report goto: call DB::goto. */
-#define PERLDB_SUB (perldb && (perldb & PERLDBf_SUB))
-#define PERLDB_LINE (perldb && (perldb & PERLDBf_LINE))
-#define PERLDB_NOOPT (perldb && (perldb & PERLDBf_NOOPT))
-#define PERLDB_INTER (perldb && (perldb & PERLDBf_INTER))
-#define PERLDB_SUBLINE (perldb && (perldb & PERLDBf_SUBLINE))
-#define PERLDB_SINGLE (perldb && (perldb & PERLDBf_SINGLE))
+#define PERLDB_SUB (PL_perldb && (PL_perldb & PERLDBf_SUB))
+#define PERLDB_LINE (PL_perldb && (PL_perldb & PERLDBf_LINE))
+#define PERLDB_NOOPT (PL_perldb && (PL_perldb & PERLDBf_NOOPT))
+#define PERLDB_INTER (PL_perldb && (PL_perldb & PERLDBf_INTER))
+#define PERLDB_SUBLINE (PL_perldb && (PL_perldb & PERLDBf_SUBLINE))
+#define PERLDB_SINGLE (PL_perldb && (PL_perldb & PERLDBf_SINGLE))
+#define PERLDB_SUB_NN (PL_perldb && (PL_perldb & (PERLDBf_NONAME)))
+#define PERLDB_GOTO (PL_perldb && (PL_perldb & PERLDBf_GOTO))
-#ifdef USE_LOCALE_COLLATE
-EXT U32 collation_ix; /* Collation generation index */
-EXT char * collation_name; /* Name of current collation */
-EXT bool collation_standard INIT(TRUE); /* Assume simple collation */
-EXT Size_t collxfrm_base; /* Basic overhead in *xfrm() */
-EXT Size_t collxfrm_mult INIT(2); /* Expansion factor in *xfrm() */
-#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
-EXT char * numeric_name; /* Name of current numeric locale */
-EXT bool numeric_standard INIT(TRUE); /* Assume simple numerics */
-EXT bool numeric_local INIT(TRUE); /* Assume local numerics */
-
#define SET_NUMERIC_STANDARD() \
STMT_START { \
- if (! numeric_standard) \
+ if (! PL_numeric_standard) \
perl_set_numeric_standard(); \
} STMT_END
#define SET_NUMERIC_LOCAL() \
STMT_START { \
- if (! numeric_local) \
+ if (! PL_numeric_local) \
perl_set_numeric_local(); \
} STMT_END
@@ -2213,7 +2511,7 @@ EXT bool numeric_local INIT(TRUE); /* Assume local numerics */
#endif /* !USE_LOCALE_NUMERIC */
-#if !defined(PERLIO_IS_STDIO) && defined(HAS_ATTRIBUTE)
+#if !defined(PERLIO_IS_STDIO) && defined(HASATTRIBUTE)
/*
* Now we have __attribute__ out of the way
* Remap printf
@@ -2221,5 +2519,60 @@ EXT bool numeric_local INIT(TRUE); /* Assume local numerics */
#define printf PerlIO_stdoutf
#endif
-#endif /* Include guard */
+#ifndef PERL_SCRIPT_MODE
+#define PERL_SCRIPT_MODE "r"
+#endif
+/*
+ * nice_chunk and nice_chunk size need to be set
+ * and queried under the protection of sv_mutex
+ */
+#define offer_nice_chunk(chunk, chunk_size) do { \
+ LOCK_SV_MUTEX; \
+ if (!PL_nice_chunk) { \
+ PL_nice_chunk = (char*)(chunk); \
+ PL_nice_chunk_size = (chunk_size); \
+ } \
+ else { \
+ Safefree(chunk); \
+ } \
+ UNLOCK_SV_MUTEX; \
+ } while (0)
+
+#ifdef HAS_SEM
+# include <sys/ipc.h>
+# include <sys/sem.h>
+# ifndef HAS_UNION_SEMUN /* Provide the union semun. */
+ union semun {
+ int val;
+ struct semid_ds *buf;
+ unsigned short *array;
+ };
+# endif
+# ifdef USE_SEMCTL_SEMUN
+# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun)
+# else
+# ifdef USE_SEMCTL_SEMID_DS
+# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buf)
+# endif
+# endif
+# ifndef Semctl /* Place our bets on the semun horse. */
+# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun)
+# endif
+#endif
+
+#ifdef IAMSUID
+
+#ifdef I_SYS_STATVFS
+# include <sys/statvfs.h> /* for f?statvfs() */
+#endif
+#ifdef I_SYS_MOUNT
+# include <sys/mount.h> /* for *BSD f?statfs() */
+#endif
+#ifdef I_MNTENT
+# include <mntent.h> /* for getmntent() */
+#endif
+
+#endif /* IAMSUID */
+
+#endif /* Include guard */
diff --git a/gnu/usr.bin/perl/perl_exp.SH b/gnu/usr.bin/perl/perl_exp.SH
index 06b587f9ef9..d8ae94951f0 100644
--- a/gnu/usr.bin/perl/perl_exp.SH
+++ b/gnu/usr.bin/perl/perl_exp.SH
@@ -1,18 +1,28 @@
#!/bin/sh
#
-# Written: Nov 1994 Wayne Scott (wscott@ichips.intel.com)
+# Written: Nov 1994 Wayne Scott <wscott@ichips.intel.com>
+#
+# Updated: 1997-8 Jarkko Hietaniemi <jhi@iki.fi>
#
# Create the export list for perl.
# Needed by AIX to do dynamic linking.
#
-# This simple program relys on 'global.sym' and other *.sym files
-# being up to date with all of the global symbols that a dynamic
-# link library might want to access.
+# This simple program relies on 'global.sym' and few other *.sym files
+# and the *var*.h files being up to date with all of the global
+# symbols that a dynamic link library might want to access.
#
-# Most symbols have a Perl_ prefix because that's what embed.h sticks
-# in front of them. Variations depend on binary compatibility with
-# Perl 5.003.
+# Most symbols have a Perl_ or PL_prefix because that's what embed.h
+# sticks in front of them.
#
+# AIX requires the list of external symbols (variables or functions)
+# that are made available for another executable object file the import.
+# The list is called the export file and it is a simple text file.
+# The first line must be
+#!
+# That is, hash-bang, pound-shout, however you want to call it.
+# The remainder of the file are the names of the symbols, one per line.
+# The file is then given to the system loader (cc/xlc command line)
+# as -bE:export.file.
case $CONFIG in
'')
@@ -38,27 +48,20 @@ echo "Extracting perl.exp"
rm -f perl.exp
echo "#!" > perl.exp
-case "$bincompat3" in
-y*)
- global=/tmp/exp$$g
- interp=/tmp/exp$$i
- compat3=/tmp/exp$$c
- grep '^[A-Za-z]' global.sym | sort >$global
- grep '^[A-Za-z]' interp.sym | sort >$interp
- grep '^[A-Za-z]' compat3.sym | sort >$compat3
- comm -23 $global $compat3 | sed 's/^/Perl_/' >> perl.exp
- comm -12 $interp $compat3 | sed 's/^/Perl_/' >> perl.exp
- comm -12 $global $compat3 >> perl.exp
- comm -23 $interp $compat3 >> perl.exp
- rm -f $global $interp $compat3
- ;;
-*)
- sed -n '/^[A-Za-z]/ s/^/Perl_/p' global.sym interp.sym >> perl.exp
- ;;
-esac
+# No compat3 since 5.004_50.
+# No interp.sym since 5.005_03.
+# perlio.sym will added later if needed.
+
+syms="global.sym thread.sym"
+
+sed -n '/^[A-Za-z]/ s/^/Perl_/p' $syms >> perl.exp
+
+sed -n 's/^PERLVAR.*(G\([^[,]*\).*/PL_\1/p' perlvars.h >> perl.exp
+sed -n 's/^PERLVAR.*(I\([^[,]*\).*/PL_\1/p' intrpvar.h >> perl.exp
+sed -n 's/^PERLVAR.*(T\([^[,]*\).*/PL_\1/p' thrdvar.h >> perl.exp
#
-# If we use the PerlIO abstraction layer, add its symbols
+# If we use the PerlIO abstraction layer, add its symbols.
#
if [ $useperlio = "define" ]
@@ -71,7 +74,7 @@ fi
# not actually be defined, but there's no harm in that).
#
-cat <<END >> perl.exp
+cat >> perl.exp <<END
perl_init_i18nl10n
perl_init_i18nl14n
perl_new_collate
@@ -96,12 +99,34 @@ perl_call_sv
perl_eval_pv
perl_eval_sv
perl_require_pv
+cast_i32
+cast_iv
+cast_uv
+END
+
+case "$ccflags" in
+*-DHIDEMYMALLOC*)
+ cat >>perl.exp <<END
Mymalloc
Mycalloc
Myremalloc
Myfree
+END
+ ;;
+esac
+
+case "$ccflags" in
+*-DEMBEDMYMALLOC*)
+ cat >>perl.exp <<END
Perl_malloc
Perl_calloc
Perl_realloc
Perl_free
END
+ ;;
+esac
+
+# The shebang line nicely sorts as the first one.
+sort -o perl.exp -u perl.exp
+
+# eof
diff --git a/gnu/usr.bin/perl/perlio.c b/gnu/usr.bin/perl/perlio.c
index f269dcdb1de..f18f5a3c96b 100644
--- a/gnu/usr.bin/perl/perlio.c
+++ b/gnu/usr.bin/perl/perlio.c
@@ -16,7 +16,7 @@
#endif
/*
* This file provides those parts of PerlIO abstraction
- * which are not #defined in perlio.h.
+ * which are not #defined in iperlsys.h.
* Which these are depends on various Configure #ifdef's
*/
@@ -26,7 +26,7 @@
#ifdef PERLIO_IS_STDIO
void
-PerlIO_init()
+PerlIO_init(void)
{
/* Does nothing (yet) except force this file to be included
in perl binary. That allows this file to force inclusion
@@ -37,7 +37,7 @@ PerlIO_init()
#undef PerlIO_tmpfile
PerlIO *
-PerlIO_tmpfile()
+PerlIO_tmpfile(void)
{
return tmpfile();
}
@@ -55,13 +55,13 @@ PerlIO_tmpfile()
#undef PerlIO_tmpfile
PerlIO *
-PerlIO_tmpfile()
+PerlIO_tmpfile(void)
{
return sftmp(0);
}
void
-PerlIO_init()
+PerlIO_init(void)
{
/* Force this file to be included in perl binary. Which allows
* this file to force inclusion of other functions that may be
@@ -76,7 +76,7 @@ PerlIO_init()
sfset(sfstdout,SF_SHARE,0);
}
-#else
+#else /* USE_SFIO */
/* Implement all the PerlIO interface using stdio.
- this should be only file to include <stdio.h>
@@ -84,29 +84,28 @@ PerlIO_init()
#undef PerlIO_stderr
PerlIO *
-PerlIO_stderr()
+PerlIO_stderr(void)
{
return (PerlIO *) stderr;
}
#undef PerlIO_stdin
PerlIO *
-PerlIO_stdin()
+PerlIO_stdin(void)
{
return (PerlIO *) stdin;
}
#undef PerlIO_stdout
PerlIO *
-PerlIO_stdout()
+PerlIO_stdout(void)
{
return (PerlIO *) stdout;
}
#undef PerlIO_fast_gets
int
-PerlIO_fast_gets(f)
-PerlIO *f;
+PerlIO_fast_gets(PerlIO *f)
{
#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
return 1;
@@ -117,8 +116,7 @@ PerlIO *f;
#undef PerlIO_has_cntptr
int
-PerlIO_has_cntptr(f)
-PerlIO *f;
+PerlIO_has_cntptr(PerlIO *f)
{
#if defined(USE_STDIO_PTR)
return 1;
@@ -129,8 +127,7 @@ PerlIO *f;
#undef PerlIO_canset_cnt
int
-PerlIO_canset_cnt(f)
-PerlIO *f;
+PerlIO_canset_cnt(PerlIO *f)
{
#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
return 1;
@@ -141,9 +138,7 @@ PerlIO *f;
#undef PerlIO_set_cnt
void
-PerlIO_set_cnt(f,cnt)
-PerlIO *f;
-int cnt;
+PerlIO_set_cnt(PerlIO *f, int cnt)
{
if (cnt < -1)
warn("Setting cnt to %d\n",cnt);
@@ -156,10 +151,7 @@ int cnt;
#undef PerlIO_set_ptrcnt
void
-PerlIO_set_ptrcnt(f,ptr,cnt)
-PerlIO *f;
-STDCHAR *ptr;
-int cnt;
+PerlIO_set_ptrcnt(PerlIO *f, STDCHAR *ptr, int cnt)
{
#ifdef FILE_bufsiz
STDCHAR *e = FILE_base(f) + FILE_bufsiz(f);
@@ -183,8 +175,7 @@ int cnt;
#undef PerlIO_get_cnt
int
-PerlIO_get_cnt(f)
-PerlIO *f;
+PerlIO_get_cnt(PerlIO *f)
{
#ifdef FILE_cnt
return FILE_cnt(f);
@@ -196,8 +187,7 @@ PerlIO *f;
#undef PerlIO_get_bufsiz
int
-PerlIO_get_bufsiz(f)
-PerlIO *f;
+PerlIO_get_bufsiz(PerlIO *f)
{
#ifdef FILE_bufsiz
return FILE_bufsiz(f);
@@ -209,8 +199,7 @@ PerlIO *f;
#undef PerlIO_get_ptr
STDCHAR *
-PerlIO_get_ptr(f)
-PerlIO *f;
+PerlIO_get_ptr(PerlIO *f)
{
#ifdef FILE_ptr
return FILE_ptr(f);
@@ -222,8 +211,7 @@ PerlIO *f;
#undef PerlIO_get_base
STDCHAR *
-PerlIO_get_base(f)
-PerlIO *f;
+PerlIO_get_base(PerlIO *f)
{
#ifdef FILE_base
return FILE_base(f);
@@ -235,8 +223,7 @@ PerlIO *f;
#undef PerlIO_has_base
int
-PerlIO_has_base(f)
-PerlIO *f;
+PerlIO_has_base(PerlIO *f)
{
#ifdef FILE_base
return 1;
@@ -247,62 +234,49 @@ PerlIO *f;
#undef PerlIO_puts
int
-PerlIO_puts(f,s)
-PerlIO *f;
-const char *s;
+PerlIO_puts(PerlIO *f, const char *s)
{
return fputs(s,f);
}
#undef PerlIO_open
PerlIO *
-PerlIO_open(path,mode)
-const char *path;
-const char *mode;
+PerlIO_open(const char *path, const char *mode)
{
return fopen(path,mode);
}
#undef PerlIO_fdopen
PerlIO *
-PerlIO_fdopen(fd,mode)
-int fd;
-const char *mode;
+PerlIO_fdopen(int fd, const char *mode)
{
return fdopen(fd,mode);
}
#undef PerlIO_reopen
PerlIO *
-PerlIO_reopen(name, mode, f)
-const char *name;
-const char *mode;
-PerlIO *f;
+PerlIO_reopen(const char *name, const char *mode, PerlIO *f)
{
return freopen(name,mode,f);
}
#undef PerlIO_close
int
-PerlIO_close(f)
-PerlIO *f;
+PerlIO_close(PerlIO *f)
{
return fclose(f);
}
#undef PerlIO_eof
int
-PerlIO_eof(f)
-PerlIO *f;
+PerlIO_eof(PerlIO *f)
{
return feof(f);
}
#undef PerlIO_getname
char *
-PerlIO_getname(f,buf)
-PerlIO *f;
-char *buf;
+PerlIO_getname(PerlIO *f, char *buf)
{
#ifdef VMS
return fgetname(f,buf);
@@ -314,48 +288,42 @@ char *buf;
#undef PerlIO_getc
int
-PerlIO_getc(f)
-PerlIO *f;
+PerlIO_getc(PerlIO *f)
{
return fgetc(f);
}
#undef PerlIO_error
int
-PerlIO_error(f)
-PerlIO *f;
+PerlIO_error(PerlIO *f)
{
return ferror(f);
}
#undef PerlIO_clearerr
void
-PerlIO_clearerr(f)
-PerlIO *f;
+PerlIO_clearerr(PerlIO *f)
{
clearerr(f);
}
#undef PerlIO_flush
int
-PerlIO_flush(f)
-PerlIO *f;
+PerlIO_flush(PerlIO *f)
{
return Fflush(f);
}
#undef PerlIO_fileno
int
-PerlIO_fileno(f)
-PerlIO *f;
+PerlIO_fileno(PerlIO *f)
{
return fileno(f);
}
#undef PerlIO_setlinebuf
void
-PerlIO_setlinebuf(f)
-PerlIO *f;
+PerlIO_setlinebuf(PerlIO *f)
{
#ifdef HAS_SETLINEBUF
setlinebuf(f);
@@ -370,97 +338,68 @@ PerlIO *f;
#undef PerlIO_putc
int
-PerlIO_putc(f,ch)
-PerlIO *f;
-int ch;
+PerlIO_putc(PerlIO *f, int ch)
{
return putc(ch,f);
}
#undef PerlIO_ungetc
int
-PerlIO_ungetc(f,ch)
-PerlIO *f;
-int ch;
+PerlIO_ungetc(PerlIO *f, int ch)
{
return ungetc(ch,f);
}
#undef PerlIO_read
SSize_t
-PerlIO_read(f,buf,count)
-PerlIO *f;
-void *buf;
-Size_t count;
+PerlIO_read(PerlIO *f, void *buf, Size_t count)
{
return fread(buf,1,count,f);
}
#undef PerlIO_write
SSize_t
-PerlIO_write(f,buf,count)
-PerlIO *f;
-const void *buf;
-Size_t count;
+PerlIO_write(PerlIO *f, const void *buf, Size_t count)
{
return fwrite1(buf,1,count,f);
}
#undef PerlIO_vprintf
int
-PerlIO_vprintf(f,fmt,ap)
-PerlIO *f;
-const char *fmt;
-va_list ap;
+PerlIO_vprintf(PerlIO *f, const char *fmt, va_list ap)
{
return vfprintf(f,fmt,ap);
}
#undef PerlIO_tell
-long
-PerlIO_tell(f)
-PerlIO *f;
+Off_t
+PerlIO_tell(PerlIO *f)
{
return ftell(f);
}
#undef PerlIO_seek
int
-PerlIO_seek(f,offset,whence)
-PerlIO *f;
-off_t offset;
-int whence;
+PerlIO_seek(PerlIO *f, Off_t offset, int whence)
{
return fseek(f,offset,whence);
}
#undef PerlIO_rewind
void
-PerlIO_rewind(f)
-PerlIO *f;
+PerlIO_rewind(PerlIO *f)
{
rewind(f);
}
#undef PerlIO_printf
int
-#ifdef I_STDARG
PerlIO_printf(PerlIO *f,const char *fmt,...)
-#else
-PerlIO_printf(f,fmt,va_alist)
-PerlIO *f;
-const char *fmt;
-va_dcl
-#endif
{
va_list ap;
int result;
-#ifdef I_STDARG
va_start(ap,fmt);
-#else
- va_start(ap);
-#endif
result = vfprintf(f,fmt,ap);
va_end(ap);
return result;
@@ -468,21 +407,11 @@ va_dcl
#undef PerlIO_stdoutf
int
-#ifdef I_STDARG
PerlIO_stdoutf(const char *fmt,...)
-#else
-PerlIO_stdoutf(fmt, va_alist)
-const char *fmt;
-va_dcl
-#endif
{
va_list ap;
int result;
-#ifdef I_STDARG
va_start(ap,fmt);
-#else
- va_start(ap);
-#endif
result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap);
va_end(ap);
return result;
@@ -490,47 +419,40 @@ va_dcl
#undef PerlIO_tmpfile
PerlIO *
-PerlIO_tmpfile()
+PerlIO_tmpfile(void)
{
return tmpfile();
}
#undef PerlIO_importFILE
PerlIO *
-PerlIO_importFILE(f,fl)
-FILE *f;
-int fl;
+PerlIO_importFILE(FILE *f, int fl)
{
return f;
}
#undef PerlIO_exportFILE
FILE *
-PerlIO_exportFILE(f,fl)
-PerlIO *f;
-int fl;
+PerlIO_exportFILE(PerlIO *f, int fl)
{
return f;
}
#undef PerlIO_findFILE
FILE *
-PerlIO_findFILE(f)
-PerlIO *f;
+PerlIO_findFILE(PerlIO *f)
{
return f;
}
#undef PerlIO_releaseFILE
void
-PerlIO_releaseFILE(p,f)
-PerlIO *p;
-FILE *f;
+PerlIO_releaseFILE(PerlIO *p, FILE *f)
{
}
void
-PerlIO_init()
+PerlIO_init(void)
{
/* Does nothing (yet) except force this file to be included
in perl binary. That allows this file to force inclusion
@@ -545,9 +467,7 @@ PerlIO_init()
#ifndef HAS_FSETPOS
#undef PerlIO_setpos
int
-PerlIO_setpos(f,pos)
-PerlIO *f;
-const Fpos_t *pos;
+PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
{
return PerlIO_seek(f,*pos,0);
}
@@ -555,9 +475,7 @@ const Fpos_t *pos;
#ifndef PERLIO_IS_STDIO
#undef PerlIO_setpos
int
-PerlIO_setpos(f,pos)
-PerlIO *f;
-const Fpos_t *pos;
+PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
{
return fsetpos(f, pos);
}
@@ -567,9 +485,7 @@ const Fpos_t *pos;
#ifndef HAS_FGETPOS
#undef PerlIO_getpos
int
-PerlIO_getpos(f,pos)
-PerlIO *f;
-Fpos_t *pos;
+PerlIO_getpos(PerlIO *f, Fpos_t *pos)
{
*pos = PerlIO_tell(f);
return 0;
@@ -578,9 +494,7 @@ Fpos_t *pos;
#ifndef PERLIO_IS_STDIO
#undef PerlIO_getpos
int
-PerlIO_getpos(f,pos)
-PerlIO *f;
-Fpos_t *pos;
+PerlIO_getpos(PerlIO *f, Fpos_t *pos)
{
return fgetpos(f, pos);
}
@@ -590,17 +504,14 @@ Fpos_t *pos;
#if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
int
-vprintf(pat, args)
-char *pat, *args;
+vprintf(char *pat, char *args)
{
_doprnt(pat, args, stdout);
return 0; /* wrong, but perl doesn't use the return value */
}
int
-vfprintf(fd, pat, args)
-FILE *fd;
-char *pat, *args;
+vfprintf(FILE *fd, char *pat, char *args)
{
_doprnt(pat, args, fd);
return 0; /* wrong, but perl doesn't use the return value */
@@ -610,11 +521,7 @@ char *pat, *args;
#ifndef PerlIO_vsprintf
int
-PerlIO_vsprintf(s,n,fmt,ap)
-char *s;
-const char *fmt;
-int n;
-va_list ap;
+PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
{
int val = vsprintf(s, fmt, ap);
if (n >= 0)
@@ -631,23 +538,11 @@ va_list ap;
#ifndef PerlIO_sprintf
int
-#ifdef I_STDARG
PerlIO_sprintf(char *s, int n, const char *fmt,...)
-#else
-PerlIO_sprintf(s, n, fmt, va_alist)
-char *s;
-int n;
-const char *fmt;
-va_dcl
-#endif
{
va_list ap;
int result;
-#ifdef I_STDARG
va_start(ap,fmt);
-#else
- va_start(ap);
-#endif
result = PerlIO_vsprintf(s, n, fmt, ap);
va_end(ap);
return result;
diff --git a/gnu/usr.bin/perl/perlio.h b/gnu/usr.bin/perl/perlio.h
index 59d1a193f85..e699a3eafed 100644
--- a/gnu/usr.bin/perl/perlio.h
+++ b/gnu/usr.bin/perl/perlio.h
@@ -1,199 +1 @@
-#ifndef H_PERLIO
-#define H_PERLIO 1
-
-/* Clean up (or at least document) the various possible #defines.
- This section attempts to match the 5.003_03 Configure variables
- onto the 5.003_02 header file values.
- I can't figure out where USE_STDIO was supposed to be set.
- --AD
-*/
-#ifndef USE_PERLIO
-# define PERLIO_IS_STDIO
-#endif
-
-/* Below is the 5.003_02 stuff. */
-#ifdef USE_STDIO
-# ifndef PERLIO_IS_STDIO
-# define PERLIO_IS_STDIO
-# endif
-#else
-extern void PerlIO_init _((void));
-#endif
-
-#include "perlsdio.h"
-
-#ifndef PERLIO_IS_STDIO
-#ifdef USE_SFIO
-#include "perlsfio.h"
-#endif /* USE_SFIO */
-#endif /* PERLIO_IS_STDIO */
-
-#ifndef EOF
-#define EOF (-1)
-#endif
-
-/* This is to catch case with no stdio */
-#ifndef BUFSIZ
-#define BUFSIZ 1024
-#endif
-
-#ifndef SEEK_SET
-#define SEEK_SET 0
-#endif
-
-#ifndef SEEK_CUR
-#define SEEK_CUR 1
-#endif
-
-#ifndef SEEK_END
-#define SEEK_END 2
-#endif
-
-#ifndef PerlIO
-struct _PerlIO;
-#define PerlIO struct _PerlIO
-#endif /* No PerlIO */
-
-#ifndef Fpos_t
-#define Fpos_t long
-#endif
-
-#ifndef NEXT30_NO_ATTRIBUTE
-#ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */
-#ifdef __attribute__ /* Avoid possible redefinition errors */
-#undef __attribute__
-#endif
-#define __attribute__(attr)
-#endif
-#endif
-
-#ifndef PerlIO_stdoutf
-extern int PerlIO_stdoutf _((const char *,...))
- __attribute__((format (printf, 1, 2)));
-#endif
-#ifndef PerlIO_puts
-extern int PerlIO_puts _((PerlIO *,const char *));
-#endif
-#ifndef PerlIO_open
-extern PerlIO * PerlIO_open _((const char *,const char *));
-#endif
-#ifndef PerlIO_close
-extern int PerlIO_close _((PerlIO *));
-#endif
-#ifndef PerlIO_eof
-extern int PerlIO_eof _((PerlIO *));
-#endif
-#ifndef PerlIO_error
-extern int PerlIO_error _((PerlIO *));
-#endif
-#ifndef PerlIO_clearerr
-extern void PerlIO_clearerr _((PerlIO *));
-#endif
-#ifndef PerlIO_getc
-extern int PerlIO_getc _((PerlIO *));
-#endif
-#ifndef PerlIO_putc
-extern int PerlIO_putc _((PerlIO *,int));
-#endif
-#ifndef PerlIO_flush
-extern int PerlIO_flush _((PerlIO *));
-#endif
-#ifndef PerlIO_ungetc
-extern int PerlIO_ungetc _((PerlIO *,int));
-#endif
-#ifndef PerlIO_fileno
-extern int PerlIO_fileno _((PerlIO *));
-#endif
-#ifndef PerlIO_fdopen
-extern PerlIO * PerlIO_fdopen _((int, const char *));
-#endif
-#ifndef PerlIO_importFILE
-extern PerlIO * PerlIO_importFILE _((FILE *,int));
-#endif
-#ifndef PerlIO_exportFILE
-extern FILE * PerlIO_exportFILE _((PerlIO *,int));
-#endif
-#ifndef PerlIO_findFILE
-extern FILE * PerlIO_findFILE _((PerlIO *));
-#endif
-#ifndef PerlIO_releaseFILE
-extern void PerlIO_releaseFILE _((PerlIO *,FILE *));
-#endif
-#ifndef PerlIO_read
-extern SSize_t PerlIO_read _((PerlIO *,void *,Size_t));
-#endif
-#ifndef PerlIO_write
-extern SSize_t PerlIO_write _((PerlIO *,const void *,Size_t));
-#endif
-#ifndef PerlIO_setlinebuf
-extern void PerlIO_setlinebuf _((PerlIO *));
-#endif
-#ifndef PerlIO_printf
-extern int PerlIO_printf _((PerlIO *, const char *,...))
- __attribute__((format (printf, 2, 3)));
-#endif
-#ifndef PerlIO_sprintf
-extern int PerlIO_sprintf _((char *, int, const char *,...))
- __attribute__((format (printf, 3, 4)));
-#endif
-#ifndef PerlIO_vprintf
-extern int PerlIO_vprintf _((PerlIO *, const char *, va_list));
-#endif
-#ifndef PerlIO_tell
-extern long PerlIO_tell _((PerlIO *));
-#endif
-#ifndef PerlIO_seek
-extern int PerlIO_seek _((PerlIO *,off_t,int));
-#endif
-#ifndef PerlIO_rewind
-extern void PerlIO_rewind _((PerlIO *));
-#endif
-#ifndef PerlIO_has_base
-extern int PerlIO_has_base _((PerlIO *));
-#endif
-#ifndef PerlIO_has_cntptr
-extern int PerlIO_has_cntptr _((PerlIO *));
-#endif
-#ifndef PerlIO_fast_gets
-extern int PerlIO_fast_gets _((PerlIO *));
-#endif
-#ifndef PerlIO_canset_cnt
-extern int PerlIO_canset_cnt _((PerlIO *));
-#endif
-#ifndef PerlIO_get_ptr
-extern STDCHAR * PerlIO_get_ptr _((PerlIO *));
-#endif
-#ifndef PerlIO_get_cnt
-extern int PerlIO_get_cnt _((PerlIO *));
-#endif
-#ifndef PerlIO_set_cnt
-extern void PerlIO_set_cnt _((PerlIO *,int));
-#endif
-#ifndef PerlIO_set_ptrcnt
-extern void PerlIO_set_ptrcnt _((PerlIO *,STDCHAR *,int));
-#endif
-#ifndef PerlIO_get_base
-extern STDCHAR * PerlIO_get_base _((PerlIO *));
-#endif
-#ifndef PerlIO_get_bufsiz
-extern int PerlIO_get_bufsiz _((PerlIO *));
-#endif
-#ifndef PerlIO_tmpfile
-extern PerlIO * PerlIO_tmpfile _((void));
-#endif
-#ifndef PerlIO_stdin
-extern PerlIO * PerlIO_stdin _((void));
-#endif
-#ifndef PerlIO_stdout
-extern PerlIO * PerlIO_stdout _((void));
-#endif
-#ifndef PerlIO_stderr
-extern PerlIO * PerlIO_stderr _((void));
-#endif
-#ifndef PerlIO_getpos
-extern int PerlIO_getpos _((PerlIO *,Fpos_t *));
-#endif
-#ifndef PerlIO_setpos
-extern int PerlIO_setpos _((PerlIO *,const Fpos_t *));
-#endif
-#endif /* Include guard */
+#include "iperlsys.h"
diff --git a/gnu/usr.bin/perl/perlsdio.h b/gnu/usr.bin/perl/perlsdio.h
index 5a15a719ca7..efc52e1cd42 100644
--- a/gnu/usr.bin/perl/perlsdio.h
+++ b/gnu/usr.bin/perl/perlsdio.h
@@ -55,7 +55,12 @@
#define PerlIO_clearerr(f) clearerr(f)
#define PerlIO_flush(f) Fflush(f)
#define PerlIO_tell(f) ftell(f)
-#define PerlIO_seek(f,o,w) fseek(f,o,w)
+#if defined(VMS) && !defined(__DECC)
+ /* Old VAXC RTL doesn't reset EOF on seek; Perl folk seem to expect this */
+# define PerlIO_seek(f,o,w) (((f) && (*f) && ((*f)->_flag &= ~_IOEOF)),fseek(f,o,w))
+#else
+# define PerlIO_seek(f,o,w) fseek(f,o,w)
+#endif
#ifdef HAS_FGETPOS
#define PerlIO_getpos(f,p) fgetpos(f,p)
#endif
@@ -232,7 +237,9 @@
#undef fopen
#undef vfprintf
#undef fgetc
+#undef getc_unlocked
#undef fputc
+#undef putc_unlocked
#undef fputs
#undef ungetc
#undef fread
@@ -265,8 +272,14 @@
#define fputc(c,f) PerlIO_putc(f,c)
#define fputs(s,f) PerlIO_puts(f,s)
#define getc(f) PerlIO_getc(f)
+#ifdef getc_unlocked
+#undef getc_unlocked
+#endif
#define getc_unlocked(f) PerlIO_getc(f)
#define putc(c,f) PerlIO_putc(f,c)
+#ifdef putc_unlocked
+#undef putc_unlocked
+#endif
#define putc_unlocked(c,f) PerlIO_putc(c,f)
#define ungetc(c,f) PerlIO_ungetc(f,c)
#if 0
diff --git a/gnu/usr.bin/perl/perly.c b/gnu/usr.bin/perl/perly.c
index ae6a0da922a..f1c76912187 100644
--- a/gnu/usr.bin/perl/perly.c
+++ b/gnu/usr.bin/perl/perly.c
@@ -6,1061 +6,1058 @@ static char yysccsid[] = "@(#)yaccpar 1.8 (Berkeley) 01/20/91";
#include "EXTERN.h"
#include "perl.h"
+#ifdef PERL_OBJECT
static void
-dep()
+Dep(CPerlObj *pPerl)
+{
+ pPerl->deprecate("\"do\" to call subroutines");
+}
+#define dep() Dep(this)
+#else
+static void
+dep(void)
{
deprecate("\"do\" to call subroutines");
}
+#endif
-#line 16 "perly.c"
+#line 30 "perly.y"
#define YYERRCODE 256
short yylhs[] = { -1,
45, 0, 9, 7, 10, 8, 11, 11, 11, 12,
- 12, 12, 12, 24, 24, 24, 24, 24, 24, 15,
- 15, 15, 14, 14, 42, 42, 13, 13, 13, 13,
- 13, 13, 13, 26, 26, 27, 27, 28, 29, 30,
- 31, 32, 44, 44, 1, 1, 1, 1, 3, 38,
- 38, 46, 4, 5, 6, 39, 40, 40, 41, 41,
- 47, 47, 49, 48, 16, 16, 16, 25, 25, 25,
- 36, 36, 36, 36, 36, 36, 36, 50, 36, 37,
- 37, 17, 17, 17, 17, 17, 17, 17, 17, 17,
+ 12, 12, 12, 24, 24, 24, 24, 24, 24, 24,
+ 15, 15, 15, 14, 14, 42, 42, 13, 13, 13,
+ 13, 13, 13, 13, 26, 26, 27, 27, 28, 29,
+ 30, 31, 32, 44, 44, 1, 1, 1, 1, 3,
+ 38, 38, 46, 4, 5, 6, 39, 40, 40, 41,
+ 41, 47, 47, 49, 48, 16, 16, 16, 25, 25,
+ 25, 36, 36, 36, 36, 36, 36, 36, 50, 36,
+ 37, 37, 17, 17, 17, 17, 17, 17, 17, 17,
17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
- 17, 17, 17, 17, 17, 17, 17, 33, 33, 34,
- 34, 34, 2, 2, 43, 23, 18, 19, 20, 21,
- 22, 35, 35, 35, 35,
+ 17, 17, 17, 17, 17, 17, 17, 17, 33, 33,
+ 34, 34, 34, 2, 2, 43, 23, 18, 19, 20,
+ 21, 22, 35, 35, 35, 35,
};
short yylen[] = { 2,
0, 2, 4, 0, 4, 0, 0, 2, 2, 2,
- 1, 2, 3, 1, 1, 3, 3, 3, 3, 0,
- 2, 6, 7, 7, 0, 2, 8, 8, 10, 9,
- 8, 11, 3, 0, 1, 0, 1, 1, 1, 1,
- 1, 1, 0, 1, 1, 1, 1, 1, 4, 1,
- 0, 5, 0, 0, 0, 1, 0, 1, 1, 1,
- 3, 2, 0, 7, 3, 3, 1, 2, 3, 1,
- 3, 5, 6, 3, 5, 2, 4, 0, 5, 1,
- 1, 3, 3, 3, 3, 3, 3, 3, 3, 3,
- 3, 3, 3, 5, 3, 2, 2, 2, 2, 2,
- 2, 2, 2, 2, 2, 3, 2, 3, 2, 4,
- 3, 4, 1, 5, 1, 4, 5, 4, 1, 1,
- 1, 5, 6, 5, 6, 5, 4, 5, 1, 1,
- 3, 4, 3, 2, 2, 4, 5, 4, 5, 4,
- 5, 1, 2, 2, 1, 2, 2, 2, 1, 3,
- 1, 3, 4, 4, 6, 1, 1, 0, 1, 0,
- 1, 2, 1, 1, 1, 2, 2, 2, 2, 2,
- 2, 1, 1, 1, 1,
+ 1, 2, 3, 1, 1, 3, 3, 3, 3, 3,
+ 0, 2, 6, 7, 7, 0, 2, 8, 8, 10,
+ 9, 8, 11, 3, 0, 1, 0, 1, 1, 1,
+ 1, 1, 1, 0, 1, 1, 1, 1, 1, 4,
+ 1, 0, 5, 0, 0, 0, 1, 0, 1, 1,
+ 1, 3, 2, 0, 7, 3, 3, 1, 2, 3,
+ 1, 3, 5, 6, 3, 5, 2, 4, 0, 5,
+ 1, 1, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 5, 3, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 3, 2, 3, 2,
+ 4, 3, 4, 1, 5, 1, 4, 5, 4, 1,
+ 1, 1, 5, 6, 5, 6, 5, 4, 5, 1,
+ 1, 3, 4, 3, 2, 2, 4, 5, 4, 5,
+ 4, 5, 1, 2, 2, 1, 2, 2, 2, 1,
+ 3, 1, 3, 4, 4, 6, 1, 1, 0, 1,
+ 0, 1, 2, 1, 1, 1, 2, 2, 2, 2,
+ 2, 2, 1, 1, 1, 1,
};
short yydefred[] = { 1,
- 0, 7, 0, 44, 55, 53, 0, 53, 8, 45,
- 9, 11, 0, 46, 47, 48, 0, 0, 0, 62,
- 63, 14, 4, 156, 0, 0, 129, 0, 151, 0,
- 54, 54, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 163, 164, 0,
+ 0, 7, 0, 45, 56, 54, 0, 54, 8, 46,
+ 9, 11, 0, 47, 48, 49, 0, 0, 0, 63,
+ 64, 14, 4, 157, 0, 0, 130, 0, 152, 0,
+ 55, 55, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 164, 165, 0,
0, 0, 0, 0, 0, 0, 0, 12, 0, 0,
0, 0, 0, 0, 0, 0, 0, 10, 0, 0,
- 0, 0, 119, 121, 0, 0, 0, 0, 157, 50,
- 0, 56, 0, 61, 0, 7, 172, 175, 174, 173,
+ 0, 0, 120, 122, 0, 0, 0, 0, 158, 51,
+ 0, 57, 0, 62, 0, 7, 173, 176, 175, 174,
0, 0, 0, 0, 0, 0, 4, 4, 4, 4,
- 4, 4, 0, 0, 0, 0, 0, 146, 0, 0,
- 0, 0, 76, 0, 170, 0, 135, 0, 0, 0,
- 0, 0, 166, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 109, 0, 167, 168, 169, 171, 0,
- 0, 33, 0, 0, 0, 0, 0, 0, 0, 0,
+ 4, 4, 0, 0, 0, 0, 0, 147, 0, 0,
+ 0, 0, 77, 0, 171, 0, 136, 0, 0, 0,
+ 0, 0, 167, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 110, 0, 168, 169, 170, 172, 0,
+ 0, 34, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 101, 102, 0, 0, 0, 0, 0,
- 0, 0, 0, 13, 0, 49, 58, 0, 0, 0,
- 74, 0, 0, 78, 0, 0, 0, 0, 0, 0,
- 0, 4, 150, 152, 0, 0, 0, 0, 0, 0,
- 0, 111, 0, 133, 0, 0, 108, 26, 0, 0,
- 19, 0, 0, 0, 65, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 102, 103, 0, 0, 0, 0,
+ 0, 0, 0, 0, 13, 0, 50, 59, 0, 0,
+ 0, 75, 0, 0, 79, 0, 0, 0, 0, 0,
+ 0, 0, 4, 151, 153, 0, 0, 0, 0, 0,
+ 0, 0, 112, 0, 134, 0, 0, 109, 27, 0,
+ 0, 19, 0, 0, 0, 0, 66, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 80, 0, 0, 81, 0, 0, 0, 0, 0,
- 0, 0, 131, 0, 0, 60, 59, 52, 0, 3,
- 0, 154, 0, 0, 112, 0, 41, 0, 42, 0,
- 0, 0, 0, 165, 0, 0, 35, 40, 0, 0,
- 0, 153, 162, 77, 0, 136, 0, 138, 0, 110,
- 0, 0, 0, 0, 0, 140, 0, 0, 0, 118,
- 0, 116, 0, 127, 0, 132, 0, 75, 0, 79,
- 0, 0, 0, 0, 0, 0, 0, 0, 72, 137,
- 139, 126, 0, 124, 0, 0, 141, 117, 0, 122,
- 128, 114, 64, 155, 6, 0, 0, 0, 0, 0,
- 0, 0, 0, 125, 123, 73, 7, 27, 28, 0,
- 0, 23, 24, 0, 31, 0, 0, 0, 21, 0,
- 0, 0, 30, 5, 0, 29, 0, 0, 32, 0,
- 22,
+ 0, 0, 0, 81, 0, 0, 82, 0, 0, 0,
+ 0, 0, 0, 0, 132, 0, 0, 61, 60, 53,
+ 0, 3, 0, 155, 0, 0, 113, 0, 42, 0,
+ 43, 0, 0, 0, 0, 166, 0, 0, 36, 41,
+ 0, 0, 0, 154, 163, 78, 0, 137, 0, 139,
+ 0, 111, 0, 0, 0, 0, 0, 141, 0, 0,
+ 0, 119, 0, 117, 0, 128, 0, 133, 0, 76,
+ 0, 80, 0, 0, 0, 0, 0, 0, 0, 0,
+ 73, 138, 140, 127, 0, 125, 0, 0, 142, 118,
+ 0, 123, 129, 115, 65, 156, 6, 0, 0, 0,
+ 0, 0, 0, 0, 0, 126, 124, 74, 7, 28,
+ 29, 0, 0, 24, 25, 0, 32, 0, 0, 0,
+ 22, 0, 0, 0, 31, 5, 0, 30, 0, 0,
+ 33, 0, 23,
};
short yydgoto[] = { 1,
- 9, 66, 10, 18, 95, 17, 86, 337, 89, 326,
- 3, 11, 12, 68, 342, 261, 70, 71, 72, 73,
- 74, 75, 76, 267, 78, 268, 257, 259, 262, 270,
- 258, 260, 113, 197, 91, 79, 236, 81, 83, 178,
- 248, 142, 265, 13, 2, 14, 15, 16, 85, 254,
+ 9, 66, 10, 18, 95, 17, 86, 339, 89, 328,
+ 3, 11, 12, 68, 344, 263, 70, 71, 72, 73,
+ 74, 75, 76, 269, 78, 270, 259, 261, 264, 272,
+ 260, 262, 113, 198, 91, 79, 238, 81, 83, 179,
+ 250, 142, 267, 13, 2, 14, 15, 16, 85, 256,
};
short yysindex[] = { 0,
- 0, 0, -120, 0, 0, 0, -50, 0, 0, 0,
- 0, 0, 661, 0, 0, 0, -240, -238, -29, 0,
- 0, 0, 0, 0, -32, -32, 0, -8, 0, 2115,
- 0, 0, -4, 31, 32, 35, -35, 2115, 56, 57,
- 61, 1037, 981, -32, 1100, 1364, -218, 0, 0, -32,
- 2115, 2115, 2115, 2115, 2115, 2115, 1420, 0, 2115, 2115,
- 1476, -32, -32, -32, -32, 2115, -205, 0, 201, 306,
- -63, -62, 0, 0, -24, 67, 45, 65, 0, 0,
- -15, 0, -149, 0, -144, 0, 0, 0, 0, 0,
- 2115, 80, 2115, 841, -15, -149, 0, 0, 0, 0,
- 0, 0, 85, 306, 86, 1535, 981, 0, 841, 0,
- -63, 65, 0, 2115, 0, 88, 0, 841, -28, 4,
- -51, 2115, 0, 65, 340, 340, 340, -76, -76, 49,
- -31, 340, 340, 0, -82, 0, 0, 0, 0, 841,
- -15, 0, 2115, 2115, 2115, 2115, 2115, 2115, 2115, 2115,
- 2115, 2115, 2115, 2115, 2115, 2115, 2115, 2115, 2115, 2115,
- 2115, 2115, 2115, 0, 0, 48, 2115, 2115, 2115, 2115,
- 2115, 2115, 1710, 0, 2115, 0, 0, -43, -116, 241,
- 0, 2115, 1193, 0, -15, 2115, 2115, 2115, 2115, 106,
- 1769, 0, 0, 0, -23, 20, 104, 2115, 65, 1825,
- 1881, 0, 36, 0, 2115, 62, 0, 0, -232, -232,
- 0, -232, -232, -134, 0, -46, 1131, 841, 689, 316,
- 859, 306, 3778, 1980, 3652, 1299, 480, 396, 340, 340,
- 2115, 0, 1944, 2115, 0, 128, -58, 22, -56, 24,
- 33, 28, 0, -19, 306, 0, 0, 0, 2115, 0,
- 134, 0, 2115, 2115, 0, -232, 0, 142, 0, 148,
- -232, 149, 150, 0, 153, 201, 0, 0, 154, 138,
- 2115, 0, 0, 0, -7, 0, 2, 0, 16, 0,
- 70, 2115, 73, 2115, 30, 0, 18, 101, 2115, 0,
- 75, 0, 78, 0, 81, 0, 151, 0, 1247, 0,
- 90, 90, 90, 90, 2115, 90, 2115, 167, 0, 0,
- 0, 0, 103, 0, 3869, 84, 0, 0, 170, 0,
- 0, 0, 0, 0, 0, -205, -205, -207, -207, 176,
- -205, 168, 90, 0, 0, 0, 0, 0, 0, 90,
- 192, 0, 0, 90, 0, 1769, -205, 402, 0, 2115,
- -205, 207, 0, 0, 208, 0, 90, 90, 0, -207,
- 0,
+ 0, 0, -66, 0, 0, 0, -48, 0, 0, 0,
+ 0, 0, 645, 0, 0, 0, -232, -227, -27, 0,
+ 0, 0, 0, 0, -23, -23, 0, -6, 0, 2099,
+ 0, 0, 13, 20, 24, 25, -34, 2099, 27, 28,
+ 29, 1021, 965, -23, 1084, 1348, -217, 0, 0, -23,
+ 2099, 2099, 2099, 2099, 2099, 2099, 1404, 0, 2099, 2099,
+ 1460, -23, -23, -23, -23, 2099, -206, 0, 335, 3814,
+ -73, -68, 0, 0, -47, 40, 32, 61, 0, 0,
+ -39, 0, -157, 0, -145, 0, 0, 0, 0, 0,
+ 2099, 73, 2099, 825, -39, -157, 0, 0, 0, 0,
+ 0, 0, 75, 3814, 78, 1519, 965, 0, 825, 0,
+ -73, 61, 0, 2099, 0, 77, 0, 825, -16, -9,
+ -51, 2099, 0, 61, 87, 87, 87, -86, -86, 33,
+ -40, 87, 87, 0, -81, 0, 0, 0, 0, 825,
+ -39, 0, 2099, 2099, 2099, 2099, 2099, 2099, 2099, 2099,
+ 2099, 2099, 2099, 2099, 2099, 2099, 2099, 2099, 2099, 2099,
+ 2099, 2099, 2099, 2099, 0, 0, 30, 2099, 2099, 2099,
+ 2099, 2099, 2099, 1694, 0, 2099, 0, 0, -49, -118,
+ 189, 0, 2099, 353, 0, -39, 2099, 2099, 2099, 2099,
+ 104, 1753, 0, 0, 0, -24, 8, 85, 2099, 61,
+ 1809, 1865, 0, 23, 0, 2099, 54, 0, 0, -269,
+ -269, 0, -269, -269, -269, -151, 0, -43, 1121, 825,
+ 673, 50, 363, 3814, 1233, 2459, 3640, 2309, 266, -82,
+ 87, 87, 2099, 0, 1928, 2099, 0, 111, 51, 12,
+ 76, 14, 90, 39, 0, -22, 3814, 0, 0, 0,
+ 2099, 0, 121, 0, 2099, 2099, 0, -269, 0, 124,
+ 0, 125, -269, 126, 130, 0, 112, 335, 0, 0,
+ 131, 136, 2099, 0, 0, 0, -14, 0, 1, 0,
+ 4, 0, 133, 2099, 55, 2099, 49, 0, 6, 197,
+ 2099, 0, 89, 0, 94, 0, 100, 0, 144, 0,
+ 1175, 0, 92, 92, 92, 92, 2099, 92, 2099, 171,
+ 0, 0, 0, 0, 202, 0, 3900, 108, 0, 0,
+ 188, 0, 0, 0, 0, 0, 0, -206, -206, -238,
+ -238, 199, -206, 211, 92, 0, 0, 0, 0, 0,
+ 0, 92, 241, 0, 0, 92, 0, 1753, -206, 326,
+ 0, 2099, -206, 256, 0, 0, 259, 0, 92, 92,
+ 0, -238, 0,
};
short yyrindex[] = { 0,
- 0, 0, 265, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 131, 0, 0, 0,
+ 0, 0, 249, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 184, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 2156, -17, 0,
- 0, 2675, 2720, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 2228, 426, 0,
+ 0, 2833, 2876, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 79, 0, -3, 108,
- 2774, 2860, 0, 0, 2034, 121, 0, 140, 0, 0,
- 0, 0, -33, 0, 0, 0, 0, 0, 0, 0,
- 2203, 0, 0, 3504, 0, 145, 0, 0, 0, 0,
- 0, 0, 0, 3772, 0, 0, 252, 0, 3551, 541,
- 602, 2270, 0, 0, 0, 442, 0, 3587, 2774, 0,
- 0, 2203, 0, 2324, 3010, 3049, 3096, 2911, 2972, 2439,
- 0, 3147, 3193, 0, 0, 0, 0, 0, 0, 3633,
+ 0, 0, 0, 0, 0, 0, 59, 0, -10, 2038,
+ 2952, 2995, 0, 0, 2274, 2140, 0, 200, 0, 0,
+ 0, 0, -44, 0, 0, 0, 0, 0, 0, 0,
+ 2421, 0, 0, 105, 0, 198, 0, 0, 0, 0,
+ 0, 0, 0, 3753, 0, 0, 319, 0, 3505, 525,
+ 586, 2510, 0, 0, 0, 2185, 0, 3541, 2952, 0,
+ 0, 2421, 0, 2553, 3112, 3150, 3188, -37, 3069, 2597,
+ 0, 3231, 3269, 0, 0, 0, 0, 0, 0, 3584,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 2522, 0, 0, 0, 0, 925,
- 0, 252, 0, 0, 0, 263, 0, 0, 0, 0,
- 223, 0, 0, 0, 0, 282, 0, 0, 2576, 0,
- 0, 0, 0, 0, 0, 2624, 0, 0, -1, 26,
- 0, 27, 51, 718, 0, 0, 3752, 1576, 1632, 3368,
- 3413, 3799, 0, -38, 3710, 3678, 3060, 3459, 3285, 3332,
+ 0, 0, 0, 0, 0, 2673, 0, 0, 0, 0,
+ 909, 0, 319, 0, 0, 0, 320, 0, 0, 0,
+ 0, 306, 0, 0, 0, 0, 325, 0, 0, 2789,
+ 0, 0, 0, 0, 0, 0, 2716, 0, 0, -5,
+ 22, 0, 68, 69, 70, 702, 0, 0, 3741, 1296,
+ 1560, 3386, 3424, 3796, 0, 3703, 3660, 3622, 1616, 3467,
+ 3305, 3348, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 3809, 0, 0, 0,
+ 309, 0, 0, 0, 0, 2421, 0, 79, 0, 0,
+ 0, 0, 330, 0, 0, 0, 0, 84, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 3835, 0, 0, 0, 273, 0,
- 0, 0, 0, 2203, 0, 59, 0, 0, 0, 0,
- 293, 0, 0, 0, 0, 64, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 252, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 296, 0, 0, 0,
- 0, 0, 0, 0, 2380, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 79, 79, 186, 186, 0,
- 79, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 300, 79, 925, 0, 0,
- 79, 0, 0, 0, 0, 0, 0, 0, 0, 186,
- 0,
+ 319, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 317, 0,
+ 0, 0, 0, 0, 0, 0, 1982, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 59, 59, 154,
+ 154, 0, 59, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 340, 59, 909,
+ 0, 0, 59, 0, 0, 0, 0, 0, 0, 0,
+ 0, 154, 0,
};
short yygindex[] = { 0,
- 0, 0, 0, 349, 328, 0, -48, 0, 679, 378,
- -84, 0, 0, 0, -298, -13, 4075, 2485, 0, 0,
- 0, 0, 0, 363, 908, 0, 0, 233, -168, 38,
- 72, 196, -77, -175, 999, 0, 0, 0, 0, 290,
- 0, -249, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 374, 351, 0, -12, 0, 946, 413,
+ -83, 0, 0, 0, -311, -13, 4007, 2893, 0, 0,
+ 0, 0, 0, 372, -8, 0, 0, 246, -131, 43,
+ 86, 208, -45, -169, 987, 0, 0, 0, 0, 308,
+ 0, -271, 0, 0, 0, 0, 0, 0, 0, 0,
};
-#define YYTABLESIZE 4359
+#define YYTABLESIZE 4293
short yytable[] = { 69,
- 62, 180, 93, 62, 102, 93, 251, 203, 20, 206,
- 207, 201, 283, 181, 167, 246, 80, 272, 82, 93,
- 93, 296, 269, 149, 93, 57, 149, 169, 171, 84,
- 343, 93, 121, 309, 290, 97, 292, 15, 122, 18,
- 149, 149, 310, 131, 204, 149, 149, 135, 186, 187,
- 188, 189, 190, 191, 93, 15, 311, 18, 317, 168,
- 170, 361, 169, 273, 147, 148, 38, 16, 340, 341,
- 98, 99, 141, 149, 100, 149, 338, 339, 25, 23,
- 291, 345, 293, 62, 38, 16, 295, 233, 316, 57,
- 23, 17, 195, 196, 168, 105, 106, 353, 172, 37,
- 107, 356, 308, 174, 39, 149, 173, 23, 175, 17,
- 177, 25, 179, 319, 25, 25, 25, 37, 25, 182,
- 25, 25, 15, 25, 192, 294, 193, 200, 202, 209,
- 210, 212, 213, 214, 215, 216, 330, 25, 234, 205,
- 249, 62, 25, 271, 274, 4, 5, 6, 70, 7,
- 8, 70, 282, 237, 238, 239, 240, 241, 242, 244,
- 280, 130, 312, 148, 130, 70, 70, 289, 196, 25,
- 231, 297, 256, 210, 298, 210, 300, 266, 130, 130,
- 67, 355, 301, 130, 275, 20, 277, 279, 302, 303,
- 304, 281, 305, 318, 306, 334, 307, 314, 67, 320,
- 70, 25, 321, 25, 25, 322, 19, 333, 335, 323,
- 336, 130, 325, 130, 147, 148, 344, 285, 20, 287,
- 288, 20, 20, 20, 87, 20, 346, 20, 20, 88,
- 20, 350, 67, 93, 93, 93, 93, 166, 147, 148,
- 147, 148, 93, 130, 20, 147, 148, 357, 358, 20,
- 147, 148, 348, 51, 149, 149, 149, 149, 93, 93,
- 101, 93, 93, 149, 2, 147, 148, 57, 313, 149,
- 149, 149, 149, 147, 148, 196, 20, 147, 148, 149,
- 149, 34, 149, 149, 149, 149, 149, 149, 149, 147,
- 148, 149, 160, 256, 149, 149, 149, 43, 147, 148,
- 43, 43, 43, 36, 43, 232, 43, 43, 20, 43,
- 20, 20, 147, 148, 147, 148, 147, 148, 147, 148,
- 147, 148, 161, 43, 147, 148, 147, 148, 43, 147,
- 148, 158, 69, 39, 25, 25, 25, 25, 25, 25,
- 34, 25, 25, 25, 25, 25, 25, 25, 25, 25,
- 25, 25, 25, 25, 36, 43, 21, 25, 25, 96,
- 25, 25, 25, 25, 25, 250, 147, 148, 156, 25,
- 25, 25, 25, 25, 25, 77, 211, 25, 332, 70,
- 70, 70, 70, 352, 263, 185, 25, 43, 25, 25,
- 43, 0, 130, 130, 130, 130, 167, 147, 148, 147,
- 148, 130, 0, 0, 70, 70, 167, 130, 130, 130,
- 130, 67, 67, 67, 67, 0, 0, 130, 130, 0,
- 130, 130, 130, 130, 130, 130, 130, 0, 149, 130,
- 167, 0, 130, 130, 130, 0, 67, 67, 149, 0,
- 0, 20, 20, 20, 20, 20, 20, 0, 20, 20,
- 20, 20, 20, 20, 20, 20, 20, 20, 20, 20,
- 20, 0, 149, 0, 20, 20, 0, 20, 20, 20,
- 20, 20, 143, 144, 145, 146, 20, 20, 20, 20,
- 20, 20, 156, 0, 20, 156, 167, 0, 0, 0,
- 0, 0, 0, 20, 0, 20, 20, 147, 148, 156,
- 156, 0, 0, 0, 156, 0, 4, 5, 6, 0,
- 7, 8, 0, 0, 0, 0, 0, 0, 149, 0,
- 43, 43, 43, 43, 43, 43, 354, 43, 43, 43,
- 0, 0, 156, 43, 156, 0, 43, 43, 43, 43,
- 0, 0, 0, 43, 43, 0, 43, 43, 43, 43,
- 43, 0, 0, 0, 0, 43, 43, 43, 43, 43,
- 43, 0, 0, 43, 156, 0, 0, 0, 0, 0,
- 167, 0, 43, 172, 43, 43, 172, 172, 172, 0,
- 172, 156, 172, 172, 156, 172, 150, 0, 0, 0,
- 0, 0, 151, 152, 153, 154, 0, 0, 156, 156,
- 0, 0, 149, 156, 172, 155, 157, 158, 159, 160,
- 161, 162, 0, 0, 163, 0, 0, 164, 165, 166,
- 0, 162, 0, 0, 163, 0, 0, 164, 165, 166,
- 0, 156, 0, 156, 173, 0, 0, 173, 173, 173,
- 0, 173, 113, 173, 173, 113, 173, 0, 163, 0,
- 0, 164, 165, 166, 0, 0, 0, 0, 0, 113,
- 113, 0, 0, 156, 113, 173, 172, 4, 5, 6,
- 0, 7, 8, 0, 0, 0, 0, 0, 0, 327,
- 328, 329, 0, 331, 153, 154, 0, 0, 0, 0,
- 0, 67, 0, 52, 113, 0, 62, 64, 50, 0,
- 57, 162, 65, 60, 163, 59, 0, 164, 165, 166,
- 347, 0, 0, 156, 156, 156, 156, 349, 0, 58,
- 108, 351, 156, 117, 63, 0, 0, 173, 156, 156,
- 156, 156, 0, 0, 359, 360, 0, 0, 156, 156,
- 0, 156, 156, 156, 156, 156, 156, 156, 0, 0,
- 156, 61, 0, 156, 156, 156, 0, 0, 66, 176,
- 0, 66, 0, 0, 0, 0, 151, 152, 153, 154,
- 0, 0, 0, 184, 0, 0, 66, 0, 0, 167,
- 0, 0, 0, 23, 161, 162, 53, 0, 163, 0,
- 0, 164, 165, 166, 0, 0, 0, 172, 172, 172,
- 172, 172, 0, 172, 172, 172, 0, 0, 0, 172,
- 66, 149, 156, 156, 156, 156, 0, 0, 0, 208,
- 172, 156, 172, 172, 172, 172, 172, 156, 156, 156,
- 156, 172, 172, 172, 172, 172, 172, 156, 156, 172,
- 156, 156, 156, 156, 156, 156, 156, 0, 172, 156,
- 172, 172, 156, 156, 156, 0, 247, 0, 173, 173,
- 173, 173, 173, 255, 173, 173, 173, 0, 0, 0,
- 173, 0, 0, 113, 113, 113, 113, 0, 0, 0,
- 0, 173, 113, 173, 173, 173, 173, 173, 113, 113,
- 113, 113, 173, 173, 173, 173, 173, 173, 113, 113,
- 173, 113, 113, 113, 113, 113, 113, 113, 0, 173,
- 113, 173, 173, 113, 113, 113, 22, 24, 25, 26,
- 27, 28, 0, 29, 30, 31, 0, 0, 0, 32,
- 0, 167, 33, 34, 35, 36, 0, 0, 0, 37,
- 38, 0, 39, 40, 41, 42, 43, 0, 0, 167,
- 112, 44, 45, 46, 47, 48, 49, 43, 124, 51,
- 43, 43, 43, 149, 43, 0, 43, 43, 54, 43,
- 55, 56, 0, 0, 0, 151, 0, 153, 154, 0,
- 0, 149, 0, 43, 0, 0, 0, 0, 43, 66,
- 66, 66, 66, 161, 162, 0, 0, 163, 112, 0,
- 164, 165, 166, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 52, 66, 43, 62, 64, 50, 0,
- 57, 199, 65, 60, 92, 59, 0, 0, 0, 112,
+ 207, 62, 181, 104, 168, 102, 104, 204, 168, 248,
+ 20, 208, 62, 253, 58, 285, 274, 170, 298, 345,
+ 104, 104, 172, 202, 80, 104, 311, 148, 149, 82,
+ 15, 84, 121, 93, 112, 18, 150, 342, 343, 122,
+ 150, 312, 124, 131, 313, 182, 319, 135, 15, 169,
+ 363, 275, 97, 18, 171, 104, 340, 341, 26, 98,
+ 271, 347, 39, 99, 100, 62, 105, 106, 107, 235,
+ 293, 141, 295, 23, 170, 173, 205, 355, 58, 174,
+ 39, 358, 112, 23, 187, 188, 189, 190, 191, 192,
+ 175, 26, 196, 197, 26, 26, 26, 297, 26, 23,
+ 26, 26, 178, 26, 176, 200, 169, 318, 16, 17,
+ 20, 180, 183, 112, 193, 203, 201, 26, 194, 38,
+ 236, 321, 26, 206, 40, 276, 16, 17, 20, 210,
+ 211, 213, 214, 215, 216, 217, 218, 38, 251, 62,
+ 168, 310, 15, 292, 284, 149, 149, 282, 149, 26,
+ 291, 307, 233, 21, 239, 240, 241, 242, 243, 244,
+ 246, 300, 149, 149, 303, 304, 305, 149, 294, 197,
+ 306, 308, 150, 258, 211, 332, 211, 168, 268, 316,
+ 273, 26, 296, 26, 26, 277, 21, 279, 281, 21,
+ 21, 21, 283, 21, 309, 21, 21, 149, 21, 4,
+ 5, 6, 325, 7, 8, 299, 154, 155, 19, 150,
+ 302, 335, 21, 322, 327, 148, 149, 21, 323, 287,
+ 357, 289, 290, 163, 324, 314, 164, 167, 338, 165,
+ 166, 167, 337, 87, 104, 104, 104, 104, 88, 346,
+ 68, 104, 112, 104, 21, 148, 149, 112, 2, 104,
+ 104, 104, 104, 148, 149, 350, 148, 149, 68, 104,
+ 104, 101, 104, 104, 104, 104, 104, 104, 104, 348,
+ 315, 104, 148, 149, 148, 149, 21, 197, 21, 21,
+ 352, 44, 148, 149, 44, 44, 44, 234, 44, 320,
+ 44, 44, 68, 44, 336, 258, 359, 148, 149, 360,
+ 148, 149, 148, 149, 148, 149, 52, 44, 148, 149,
+ 148, 149, 44, 252, 26, 26, 26, 26, 26, 26,
+ 58, 26, 26, 26, 26, 26, 26, 26, 26, 26,
+ 26, 26, 26, 26, 69, 148, 149, 26, 26, 44,
+ 26, 26, 26, 26, 26, 148, 149, 148, 149, 26,
+ 26, 26, 26, 26, 26, 163, 168, 26, 164, 161,
+ 37, 165, 166, 167, 35, 162, 26, 159, 26, 26,
+ 40, 44, 148, 149, 44, 37, 149, 149, 149, 149,
+ 35, 21, 96, 149, 77, 149, 148, 149, 150, 212,
+ 354, 149, 149, 254, 334, 164, 255, 265, 165, 166,
+ 167, 149, 149, 186, 149, 149, 149, 149, 149, 21,
+ 21, 21, 21, 21, 21, 157, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 148,
+ 149, 0, 21, 21, 0, 21, 21, 21, 21, 21,
+ 0, 0, 0, 168, 21, 21, 21, 21, 21, 21,
+ 356, 0, 21, 168, 4, 5, 6, 0, 7, 8,
+ 0, 21, 0, 21, 21, 0, 150, 0, 0, 150,
+ 0, 68, 68, 68, 68, 150, 0, 0, 68, 0,
+ 0, 0, 0, 150, 150, 150, 0, 0, 150, 0,
+ 0, 0, 0, 148, 149, 0, 68, 68, 148, 149,
+ 0, 0, 0, 0, 44, 44, 44, 44, 44, 44,
+ 0, 44, 44, 44, 0, 0, 150, 44, 150, 0,
+ 44, 44, 44, 44, 0, 0, 0, 44, 44, 0,
+ 44, 44, 44, 44, 44, 0, 0, 0, 0, 44,
+ 44, 44, 44, 44, 44, 0, 0, 44, 150, 0,
+ 0, 0, 152, 153, 154, 155, 44, 173, 44, 44,
+ 173, 173, 173, 0, 173, 157, 173, 173, 157, 173,
+ 162, 163, 0, 0, 164, 0, 0, 165, 166, 167,
+ 0, 0, 157, 157, 0, 0, 0, 157, 173, 0,
+ 0, 4, 5, 6, 0, 7, 8, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 143, 144, 145, 146,
+ 0, 0, 0, 147, 0, 157, 0, 157, 174, 0,
+ 0, 174, 174, 174, 0, 174, 114, 174, 174, 114,
+ 174, 148, 149, 151, 0, 0, 0, 0, 0, 152,
+ 153, 154, 155, 114, 114, 0, 0, 157, 114, 174,
+ 173, 154, 156, 158, 159, 160, 161, 162, 163, 0,
+ 0, 164, 0, 0, 165, 166, 167, 0, 163, 0,
+ 0, 164, 0, 0, 165, 166, 167, 52, 114, 0,
+ 62, 64, 50, 0, 57, 0, 65, 60, 0, 59,
+ 0, 0, 0, 0, 0, 0, 0, 150, 150, 150,
+ 150, 0, 0, 58, 150, 0, 150, 0, 63, 0,
+ 0, 174, 150, 150, 150, 150, 329, 330, 331, 0,
+ 333, 0, 150, 150, 0, 150, 150, 150, 150, 150,
+ 150, 150, 0, 0, 150, 61, 0, 150, 150, 150,
+ 0, 0, 67, 0, 0, 67, 0, 349, 0, 0,
+ 0, 0, 0, 0, 351, 0, 0, 0, 353, 0,
+ 67, 0, 0, 168, 0, 0, 0, 23, 0, 0,
+ 53, 361, 362, 0, 0, 0, 0, 0, 0, 0,
+ 0, 173, 173, 173, 173, 173, 0, 173, 173, 173,
+ 0, 0, 0, 173, 67, 150, 157, 157, 157, 157,
+ 0, 0, 0, 157, 173, 157, 173, 173, 173, 173,
+ 173, 157, 157, 157, 157, 173, 173, 173, 173, 173,
+ 173, 157, 157, 173, 157, 157, 157, 157, 157, 157,
+ 157, 0, 173, 157, 173, 173, 157, 157, 157, 0,
+ 0, 0, 174, 174, 174, 174, 174, 0, 174, 174,
+ 174, 0, 0, 0, 174, 0, 0, 114, 114, 114,
+ 114, 0, 0, 0, 114, 174, 114, 174, 174, 174,
+ 174, 174, 114, 114, 114, 114, 174, 174, 174, 174,
+ 174, 174, 114, 114, 174, 114, 114, 114, 114, 114,
+ 114, 114, 0, 174, 114, 174, 174, 114, 114, 114,
+ 22, 24, 25, 26, 27, 28, 0, 29, 30, 31,
+ 0, 0, 0, 32, 0, 168, 33, 34, 35, 36,
+ 0, 0, 0, 37, 38, 0, 39, 40, 41, 42,
+ 43, 0, 0, 0, 0, 44, 45, 46, 47, 48,
+ 49, 44, 0, 51, 44, 44, 44, 150, 44, 0,
+ 44, 44, 54, 44, 55, 56, 0, 0, 67, 152,
+ 0, 154, 155, 0, 0, 0, 0, 44, 0, 0,
+ 0, 0, 44, 67, 67, 67, 67, 162, 163, 0,
+ 67, 164, 0, 0, 165, 166, 167, 108, 0, 0,
+ 117, 0, 0, 0, 0, 0, 0, 52, 67, 44,
+ 62, 64, 50, 0, 57, 0, 65, 60, 0, 59,
+ 0, 0, 92, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 177, 0, 63, 114,
+ 115, 44, 0, 0, 44, 0, 123, 0, 0, 0,
+ 185, 0, 0, 0, 0, 0, 0, 0, 136, 137,
+ 138, 139, 0, 52, 0, 61, 62, 64, 50, 0,
+ 57, 0, 65, 60, 0, 59, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 114, 115, 0, 63, 0, 0, 43, 123, 0,
- 43, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 136, 137, 138, 139, 0, 0, 0, 0, 0, 52,
- 0, 61, 62, 64, 50, 0, 57, 0, 65, 60,
- 0, 59, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 63, 0, 209, 23, 0, 0,
+ 53, 0, 0, 199, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 63, 0, 0, 23, 0, 198, 53, 0, 0, 0,
+ 0, 61, 0, 154, 155, 0, 52, 0, 0, 62,
+ 64, 50, 0, 57, 249, 65, 60, 0, 59, 162,
+ 163, 257, 0, 164, 0, 0, 165, 166, 167, 0,
+ 0, 0, 0, 23, 0, 0, 53, 63, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 61, 0, 153,
- 154, 0, 52, 0, 0, 62, 64, 50, 0, 57,
- 0, 65, 60, 0, 59, 161, 162, 153, 0, 163,
- 0, 0, 164, 165, 166, 0, 112, 0, 0, 23,
- 0, 112, 53, 63, 162, 0, 0, 163, 0, 0,
- 164, 165, 166, 0, 0, 0, 0, 0, 0, 0,
- 43, 43, 43, 43, 43, 43, 0, 43, 43, 43,
- 61, 0, 0, 43, 0, 0, 43, 43, 43, 43,
- 0, 0, 0, 43, 43, 0, 43, 43, 43, 43,
- 43, 0, 0, 0, 0, 43, 43, 43, 43, 43,
- 43, 167, 23, 43, 0, 53, 0, 0, 0, 0,
- 0, 0, 43, 252, 43, 43, 253, 110, 25, 26,
- 27, 28, 88, 29, 30, 31, 0, 0, 0, 32,
- 0, 0, 0, 149, 0, 156, 0, 0, 0, 0,
+ 0, 0, 0, 0, 44, 44, 44, 44, 44, 44,
+ 0, 44, 44, 44, 61, 0, 0, 44, 0, 0,
+ 44, 44, 44, 44, 0, 0, 0, 44, 44, 0,
+ 44, 44, 44, 44, 44, 0, 0, 0, 0, 44,
+ 44, 44, 44, 44, 44, 0, 23, 44, 0, 53,
+ 0, 168, 0, 0, 0, 326, 44, 0, 44, 44,
+ 0, 110, 25, 26, 27, 28, 88, 29, 30, 31,
+ 0, 0, 0, 32, 0, 0, 0, 157, 0, 0,
+ 0, 0, 0, 150, 38, 0, 39, 40, 41, 42,
+ 43, 0, 0, 0, 0, 44, 45, 46, 47, 48,
+ 49, 0, 0, 51, 0, 168, 0, 0, 0, 0,
+ 0, 0, 54, 0, 55, 56, 0, 24, 25, 26,
+ 27, 28, 0, 29, 30, 31, 0, 0, 0, 32,
+ 286, 0, 0, 0, 0, 157, 0, 150, 0, 0,
38, 0, 39, 40, 41, 42, 43, 0, 0, 0,
0, 44, 45, 46, 47, 48, 49, 0, 0, 51,
- 0, 0, 0, 167, 0, 0, 0, 324, 54, 0,
- 55, 56, 0, 24, 25, 26, 27, 28, 0, 29,
- 30, 31, 0, 0, 0, 32, 0, 0, 0, 156,
- 0, 0, 0, 0, 0, 149, 38, 0, 39, 40,
- 41, 42, 43, 0, 0, 0, 0, 44, 45, 46,
- 47, 48, 49, 0, 0, 51, 0, 167, 0, 0,
- 0, 0, 0, 0, 54, 0, 55, 56, 0, 0,
- 0, 0, 0, 0, 0, 0, 116, 25, 26, 27,
- 28, 0, 29, 30, 31, 0, 0, 0, 32, 149,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 38,
- 0, 39, 40, 41, 42, 43, 0, 0, 0, 167,
- 44, 45, 46, 47, 48, 49, 52, 0, 51, 62,
- 64, 50, 0, 57, 0, 65, 60, 54, 59, 55,
- 56, 0, 0, 0, 0, 0, 0, 151, 152, 153,
- 154, 149, 120, 0, 0, 0, 0, 63, 0, 0,
- 0, 157, 158, 159, 160, 161, 162, 0, 0, 163,
- 0, 0, 164, 165, 166, 0, 0, 0, 0, 0,
+ 0, 0, 0, 168, 0, 0, 0, 0, 54, 0,
+ 55, 56, 0, 0, 0, 0, 88, 0, 0, 88,
+ 116, 25, 26, 27, 28, 0, 29, 30, 31, 0,
+ 0, 0, 32, 88, 88, 150, 0, 0, 88, 0,
+ 0, 0, 0, 38, 0, 39, 40, 41, 42, 43,
+ 0, 0, 0, 0, 44, 45, 46, 47, 48, 49,
+ 52, 0, 51, 62, 64, 50, 0, 57, 88, 65,
+ 60, 54, 59, 55, 56, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 120, 152, 153, 154,
+ 155, 63, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 158, 159, 160, 161, 162, 163, 0, 0, 164,
+ 0, 0, 165, 166, 167, 0, 52, 0, 61, 62,
+ 64, 50, 0, 57, 130, 65, 60, 0, 59, 0,
+ 0, 0, 0, 0, 0, 151, 0, 0, 0, 0,
+ 0, 152, 153, 154, 155, 0, 0, 63, 0, 0,
+ 0, 0, 0, 53, 156, 158, 159, 160, 161, 162,
+ 163, 0, 0, 164, 0, 0, 165, 166, 167, 0,
0, 0, 52, 0, 61, 62, 64, 50, 0, 57,
- 130, 65, 60, 0, 59, 0, 0, 0, 0, 0,
- 0, 0, 0, 150, 0, 0, 0, 0, 0, 151,
- 152, 153, 154, 63, 0, 0, 0, 0, 0, 53,
- 0, 0, 155, 157, 158, 159, 160, 161, 162, 0,
- 0, 163, 0, 0, 164, 165, 166, 0, 52, 0,
- 61, 62, 64, 50, 0, 57, 0, 65, 60, 0,
- 59, 0, 0, 0, 0, 0, 0, 150, 0, 0,
- 0, 0, 0, 151, 152, 153, 154, 0, 0, 63,
- 0, 0, 0, 0, 0, 53, 155, 157, 158, 159,
- 160, 161, 162, 0, 0, 163, 0, 0, 164, 165,
- 166, 0, 0, 0, 0, 0, 61, 52, 134, 0,
- 62, 64, 50, 0, 57, 194, 65, 60, 0, 59,
- 0, 0, 0, 0, 0, 151, 152, 153, 154, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 63, 0,
- 0, 53, 160, 161, 162, 0, 0, 163, 0, 0,
- 164, 165, 166, 0, 0, 0, 87, 0, 0, 87,
- 24, 25, 26, 27, 28, 61, 29, 30, 31, 0,
- 0, 0, 32, 87, 87, 0, 0, 0, 87, 0,
+ 0, 65, 60, 0, 59, 0, 0, 0, 0, 0,
+ 0, 0, 0, 151, 0, 0, 0, 0, 0, 152,
+ 153, 154, 155, 63, 0, 0, 0, 0, 0, 53,
+ 0, 0, 156, 158, 159, 160, 161, 162, 163, 0,
+ 0, 164, 0, 0, 165, 166, 167, 0, 0, 0,
+ 61, 52, 134, 0, 62, 64, 50, 0, 57, 195,
+ 65, 60, 0, 59, 0, 0, 0, 88, 88, 88,
+ 88, 0, 0, 0, 88, 0, 88, 0, 0, 0,
+ 0, 0, 63, 88, 0, 53, 0, 0, 0, 0,
+ 0, 0, 88, 88, 0, 88, 88, 88, 88, 88,
+ 89, 0, 0, 89, 24, 25, 26, 27, 28, 61,
+ 29, 30, 31, 0, 0, 0, 32, 89, 89, 0,
+ 0, 0, 89, 0, 0, 0, 0, 38, 0, 39,
+ 40, 41, 42, 43, 0, 0, 0, 0, 44, 45,
+ 46, 47, 48, 49, 53, 0, 51, 0, 0, 0,
+ 0, 0, 89, 0, 0, 54, 90, 55, 56, 90,
+ 24, 25, 26, 27, 28, 0, 29, 30, 31, 0,
+ 0, 0, 32, 90, 90, 0, 0, 0, 90, 0,
0, 0, 0, 38, 0, 39, 40, 41, 42, 43,
0, 0, 0, 0, 44, 45, 46, 47, 48, 49,
- 53, 0, 51, 0, 0, 0, 0, 0, 87, 0,
- 0, 54, 88, 55, 56, 88, 24, 25, 26, 27,
- 28, 0, 29, 30, 31, 0, 0, 0, 32, 88,
- 88, 0, 0, 0, 88, 0, 0, 0, 0, 38,
- 0, 39, 40, 41, 42, 43, 0, 0, 0, 0,
- 44, 45, 46, 47, 48, 49, 0, 0, 51, 0,
- 0, 0, 0, 0, 88, 0, 0, 54, 0, 55,
- 56, 0, 24, 25, 26, 27, 28, 0, 29, 30,
- 31, 0, 52, 0, 32, 62, 64, 50, 0, 57,
- 243, 65, 60, 0, 59, 38, 0, 39, 40, 41,
- 42, 43, 0, 0, 0, 0, 44, 45, 46, 47,
- 48, 49, 0, 63, 51, 0, 0, 0, 0, 0,
- 0, 0, 0, 54, 0, 55, 56, 0, 0, 0,
- 0, 24, 25, 26, 27, 28, 0, 29, 30, 31,
- 61, 52, 0, 32, 62, 64, 50, 0, 57, 0,
- 65, 60, 0, 59, 38, 0, 39, 40, 41, 42,
- 43, 0, 0, 0, 0, 44, 45, 46, 47, 48,
- 49, 0, 63, 51, 0, 53, 0, 0, 0, 0,
- 0, 0, 54, 0, 55, 56, 0, 87, 87, 87,
- 87, 0, 0, 0, 0, 0, 87, 52, 0, 61,
- 62, 64, 50, 87, 57, 276, 65, 60, 0, 59,
- 0, 0, 87, 87, 0, 87, 87, 87, 87, 87,
- 0, 0, 0, 0, 0, 0, 0, 0, 63, 0,
- 0, 0, 0, 0, 53, 0, 0, 0, 0, 0,
- 0, 0, 0, 88, 88, 88, 88, 0, 0, 0,
- 0, 0, 88, 52, 0, 61, 62, 64, 50, 0,
- 57, 278, 65, 60, 0, 59, 0, 0, 88, 88,
- 0, 88, 88, 88, 88, 88, 0, 0, 0, 0,
- 0, 0, 0, 0, 63, 0, 0, 0, 0, 0,
- 53, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 24, 25, 26, 27,
- 28, 61, 29, 30, 31, 0, 52, 0, 32, 62,
- 64, 50, 0, 57, 286, 65, 60, 0, 59, 38,
+ 0, 0, 51, 0, 0, 0, 0, 0, 90, 0,
+ 0, 54, 0, 55, 56, 0, 24, 25, 26, 27,
+ 28, 0, 29, 30, 31, 0, 52, 0, 32, 62,
+ 64, 50, 0, 57, 245, 65, 60, 0, 59, 38,
0, 39, 40, 41, 42, 43, 0, 0, 0, 0,
- 44, 45, 46, 47, 48, 49, 53, 63, 51, 0,
+ 44, 45, 46, 47, 48, 49, 0, 63, 51, 0,
0, 0, 0, 0, 0, 0, 0, 54, 0, 55,
- 56, 0, 0, 0, 22, 24, 25, 26, 27, 28,
- 0, 29, 30, 31, 61, 0, 0, 32, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 38, 0,
+ 56, 0, 0, 0, 0, 24, 25, 26, 27, 28,
+ 0, 29, 30, 31, 61, 52, 0, 32, 62, 64,
+ 50, 0, 57, 0, 65, 60, 0, 59, 38, 0,
39, 40, 41, 42, 43, 0, 0, 0, 0, 44,
- 45, 46, 47, 48, 49, 0, 0, 51, 0, 53,
- 167, 0, 0, 0, 115, 0, 54, 115, 55, 56,
- 0, 24, 25, 26, 27, 28, 0, 29, 30, 31,
- 0, 115, 115, 32, 0, 0, 115, 0, 0, 0,
- 0, 0, 149, 0, 38, 0, 39, 40, 41, 42,
- 43, 0, 0, 0, 0, 44, 45, 46, 47, 48,
- 49, 0, 0, 51, 115, 0, 115, 0, 0, 0,
- 0, 0, 54, 0, 55, 56, 0, 24, 25, 26,
- 27, 28, 0, 29, 30, 31, 0, 52, 0, 32,
- 62, 64, 50, 0, 57, 0, 65, 60, 0, 59,
- 38, 0, 39, 40, 41, 42, 43, 0, 0, 0,
- 0, 44, 45, 46, 47, 48, 49, 0, 63, 51,
- 0, 0, 0, 0, 0, 0, 0, 0, 54, 0,
- 55, 56, 0, 0, 0, 0, 142, 0, 0, 142,
+ 45, 46, 47, 48, 49, 0, 63, 51, 0, 53,
+ 0, 0, 0, 0, 0, 0, 54, 0, 55, 56,
+ 0, 89, 89, 89, 89, 0, 0, 0, 89, 0,
+ 89, 52, 0, 61, 62, 64, 50, 0, 57, 278,
+ 65, 60, 0, 59, 0, 0, 89, 89, 0, 89,
+ 89, 89, 89, 89, 0, 0, 0, 0, 0, 0,
+ 0, 0, 63, 0, 0, 0, 0, 0, 53, 0,
+ 0, 0, 0, 0, 0, 0, 0, 90, 90, 90,
+ 90, 0, 0, 0, 90, 0, 90, 52, 0, 61,
+ 62, 64, 50, 0, 57, 280, 65, 60, 0, 59,
+ 0, 0, 90, 90, 0, 90, 90, 90, 90, 90,
+ 0, 0, 0, 0, 0, 0, 0, 0, 63, 0,
+ 0, 0, 0, 0, 53, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
24, 25, 26, 27, 28, 61, 29, 30, 31, 0,
- 0, 0, 32, 142, 142, 0, 0, 0, 142, 0,
- 0, 0, 0, 38, 0, 39, 40, 41, 42, 43,
+ 52, 0, 32, 62, 64, 50, 0, 57, 288, 65,
+ 60, 0, 59, 38, 0, 39, 40, 41, 42, 43,
0, 0, 0, 0, 44, 45, 46, 47, 48, 49,
- 53, 0, 51, 158, 0, 0, 158, 0, 142, 0,
- 0, 54, 0, 55, 56, 0, 0, 0, 0, 0,
- 158, 158, 0, 0, 0, 158, 151, 152, 153, 154,
- 0, 0, 0, 0, 0, 0, 0, 0, 142, 0,
- 0, 158, 159, 160, 161, 162, 0, 0, 163, 0,
- 0, 164, 165, 166, 0, 158, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 115, 115, 115, 115, 0,
- 159, 0, 0, 0, 115, 0, 0, 0, 0, 0,
- 115, 115, 115, 115, 0, 158, 0, 159, 159, 0,
- 115, 115, 159, 115, 115, 115, 115, 115, 115, 115,
- 0, 0, 115, 0, 0, 115, 115, 115, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 159, 0, 159, 0, 144, 0, 0, 0, 0, 0,
+ 53, 63, 51, 0, 0, 0, 0, 0, 0, 0,
+ 0, 54, 0, 55, 56, 0, 0, 0, 22, 24,
+ 25, 26, 27, 28, 0, 29, 30, 31, 61, 0,
+ 0, 32, 95, 0, 0, 95, 0, 0, 0, 0,
+ 0, 0, 38, 0, 39, 40, 41, 42, 43, 95,
+ 95, 0, 0, 44, 45, 46, 47, 48, 49, 0,
+ 0, 51, 0, 53, 0, 0, 0, 0, 0, 0,
+ 54, 0, 55, 56, 0, 24, 25, 26, 27, 28,
+ 0, 29, 30, 31, 95, 0, 0, 32, 71, 0,
+ 0, 71, 0, 0, 0, 0, 0, 0, 38, 0,
+ 39, 40, 41, 42, 43, 71, 71, 0, 0, 44,
+ 45, 46, 47, 48, 49, 0, 0, 51, 0, 0,
+ 0, 0, 0, 0, 0, 0, 54, 0, 55, 56,
0, 24, 25, 26, 27, 28, 0, 29, 30, 31,
- 0, 144, 144, 32, 0, 0, 144, 0, 0, 0,
- 0, 0, 159, 0, 38, 0, 39, 40, 41, 42,
+ 71, 52, 0, 32, 62, 64, 50, 0, 57, 0,
+ 65, 60, 0, 59, 38, 0, 39, 40, 41, 42,
43, 0, 0, 0, 0, 44, 45, 46, 47, 48,
- 49, 0, 0, 51, 144, 0, 144, 0, 0, 0,
- 94, 0, 54, 94, 55, 56, 0, 142, 142, 142,
- 142, 0, 0, 0, 0, 0, 142, 94, 94, 0,
- 0, 0, 142, 142, 142, 142, 144, 0, 0, 0,
- 0, 0, 142, 142, 0, 142, 142, 142, 142, 142,
- 142, 142, 0, 0, 142, 0, 0, 142, 142, 142,
- 0, 0, 94, 0, 158, 158, 158, 158, 0, 107,
- 0, 0, 107, 158, 0, 0, 0, 0, 0, 158,
- 158, 158, 158, 0, 0, 0, 107, 107, 0, 158,
- 158, 107, 158, 158, 158, 158, 158, 158, 158, 90,
- 90, 158, 0, 0, 158, 158, 158, 0, 0, 0,
- 0, 103, 0, 0, 0, 0, 0, 111, 90, 119,
- 0, 107, 0, 0, 90, 0, 0, 0, 0, 0,
- 0, 159, 159, 159, 159, 0, 90, 90, 90, 90,
- 159, 0, 0, 0, 0, 0, 159, 159, 159, 159,
- 0, 107, 68, 0, 0, 68, 159, 159, 0, 159,
- 159, 159, 159, 159, 159, 159, 0, 0, 159, 68,
- 68, 159, 159, 159, 68, 0, 0, 0, 0, 0,
- 0, 111, 0, 0, 0, 144, 144, 144, 144, 0,
- 0, 0, 0, 0, 144, 0, 0, 0, 0, 0,
- 144, 144, 144, 144, 68, 0, 71, 0, 0, 0,
- 144, 144, 0, 144, 144, 144, 144, 144, 144, 144,
- 0, 0, 144, 71, 71, 144, 144, 144, 71, 0,
- 0, 0, 0, 0, 68, 0, 0, 0, 0, 0,
- 235, 94, 94, 94, 94, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 106, 0, 71, 106, 71, 0,
- 0, 0, 0, 0, 264, 0, 94, 94, 0, 94,
- 0, 106, 106, 0, 0, 0, 106, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 71, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 107, 107, 107, 107, 0, 145, 106, 0, 145, 107,
- 0, 0, 0, 0, 0, 107, 107, 107, 107, 0,
- 0, 0, 145, 145, 0, 107, 107, 145, 107, 107,
- 107, 107, 107, 107, 107, 0, 106, 107, 0, 0,
- 107, 107, 107, 0, 0, 0, 0, 0, 0, 0,
- 158, 0, 0, 158, 0, 0, 0, 145, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 158, 158, 0,
- 0, 0, 158, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 68, 68, 68, 68, 0, 0, 0,
- 0, 0, 68, 0, 0, 0, 0, 0, 68, 68,
- 68, 68, 158, 0, 113, 0, 0, 113, 68, 68,
- 0, 68, 68, 68, 68, 68, 68, 68, 0, 0,
- 68, 113, 113, 68, 68, 68, 113, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 71, 71, 71,
- 71, 0, 0, 0, 0, 0, 71, 0, 0, 0,
- 0, 0, 71, 71, 71, 71, 113, 0, 0, 0,
- 0, 0, 71, 71, 0, 71, 71, 71, 71, 71,
- 71, 71, 0, 0, 71, 0, 0, 71, 71, 71,
- 0, 0, 0, 0, 0, 106, 106, 106, 106, 0,
- 120, 0, 0, 120, 106, 0, 0, 0, 0, 0,
- 106, 106, 106, 106, 0, 0, 0, 120, 120, 0,
- 106, 106, 120, 106, 106, 106, 106, 106, 106, 106,
- 0, 0, 106, 0, 0, 106, 106, 106, 0, 0,
- 0, 0, 0, 0, 0, 0, 145, 145, 145, 145,
- 0, 103, 120, 0, 103, 145, 0, 0, 0, 0,
- 0, 145, 145, 145, 145, 0, 0, 0, 103, 103,
- 0, 145, 145, 103, 145, 145, 145, 145, 145, 145,
- 145, 0, 0, 145, 0, 0, 145, 145, 145, 0,
- 0, 158, 158, 158, 158, 0, 0, 0, 0, 0,
- 158, 0, 0, 103, 0, 0, 158, 158, 158, 158,
- 0, 0, 104, 0, 0, 104, 158, 158, 0, 158,
- 158, 158, 158, 158, 158, 158, 0, 0, 158, 104,
- 104, 158, 158, 158, 104, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 113, 113, 113, 113, 0,
- 98, 0, 0, 98, 113, 0, 0, 0, 0, 0,
- 113, 113, 113, 113, 104, 0, 0, 98, 98, 0,
- 113, 113, 98, 113, 113, 113, 113, 113, 113, 113,
- 0, 0, 113, 0, 0, 113, 113, 113, 0, 99,
- 0, 0, 99, 0, 0, 0, 0, 0, 0, 0,
- 89, 0, 98, 89, 0, 0, 99, 99, 0, 0,
- 0, 99, 0, 0, 0, 0, 0, 89, 89, 0,
- 0, 0, 89, 0, 0, 0, 0, 0, 0, 0,
- 0, 120, 120, 120, 120, 0, 100, 0, 0, 100,
- 120, 99, 0, 0, 0, 0, 120, 120, 120, 120,
- 0, 0, 89, 100, 100, 0, 120, 120, 100, 120,
- 120, 120, 120, 120, 120, 120, 0, 0, 120, 0,
- 0, 120, 120, 120, 0, 0, 0, 0, 0, 0,
- 0, 0, 103, 103, 103, 103, 0, 96, 100, 0,
- 96, 103, 0, 0, 0, 0, 0, 103, 103, 103,
- 103, 0, 0, 0, 96, 96, 0, 103, 103, 96,
- 103, 103, 103, 103, 103, 103, 103, 0, 0, 103,
+ 49, 0, 63, 51, 0, 0, 0, 0, 0, 0,
+ 0, 0, 54, 0, 55, 56, 0, 0, 0, 0,
+ 131, 0, 0, 131, 24, 25, 26, 27, 28, 61,
+ 29, 30, 31, 0, 0, 0, 32, 131, 131, 0,
+ 0, 0, 131, 0, 0, 0, 0, 38, 0, 39,
+ 40, 41, 42, 43, 0, 0, 0, 0, 44, 45,
+ 46, 47, 48, 49, 53, 157, 51, 0, 157, 0,
+ 131, 0, 131, 0, 0, 54, 0, 55, 56, 0,
+ 0, 0, 157, 157, 0, 0, 0, 157, 0, 0,
+ 0, 0, 0, 95, 95, 95, 95, 0, 0, 0,
+ 95, 0, 131, 0, 0, 0, 0, 0, 143, 0,
+ 0, 143, 0, 0, 0, 157, 0, 157, 95, 95,
+ 0, 95, 0, 0, 0, 143, 143, 0, 0, 0,
+ 143, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 157, 0, 71,
+ 71, 71, 71, 0, 116, 0, 71, 116, 0, 0,
+ 143, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 116, 116, 0, 71, 71, 116, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 97, 0, 0, 97, 0, 0, 96,
- 0, 0, 0, 104, 104, 104, 104, 0, 0, 0,
- 97, 97, 104, 0, 0, 97, 0, 0, 104, 104,
- 104, 104, 0, 0, 0, 0, 0, 0, 104, 104,
- 0, 104, 104, 104, 104, 104, 104, 104, 0, 0,
- 104, 98, 98, 98, 98, 97, 0, 0, 0, 0,
- 98, 0, 0, 0, 0, 0, 98, 98, 98, 98,
- 0, 0, 0, 0, 0, 0, 98, 98, 0, 98,
- 98, 98, 98, 98, 98, 98, 0, 0, 0, 0,
- 99, 99, 99, 99, 0, 95, 0, 0, 95, 99,
- 0, 89, 89, 89, 89, 99, 99, 99, 99, 0,
- 89, 0, 95, 95, 0, 99, 99, 95, 99, 99,
- 99, 99, 99, 99, 99, 0, 89, 89, 0, 89,
- 89, 89, 89, 89, 0, 0, 0, 100, 100, 100,
- 100, 0, 83, 0, 0, 83, 100, 95, 0, 0,
- 0, 0, 100, 100, 100, 100, 0, 0, 0, 83,
- 83, 0, 100, 100, 83, 100, 100, 100, 100, 100,
- 100, 100, 0, 0, 0, 0, 0, 0, 84, 0,
- 0, 84, 0, 0, 0, 0, 0, 0, 96, 96,
- 96, 96, 0, 0, 83, 84, 84, 96, 0, 0,
- 84, 0, 0, 96, 96, 96, 96, 0, 0, 0,
- 0, 0, 0, 96, 96, 0, 96, 96, 96, 96,
- 96, 96, 96, 85, 0, 0, 85, 0, 0, 0,
- 84, 0, 0, 0, 97, 97, 97, 97, 0, 0,
- 85, 85, 0, 97, 0, 85, 0, 0, 0, 97,
- 97, 97, 97, 0, 0, 0, 0, 0, 0, 97,
- 97, 0, 97, 97, 97, 97, 97, 97, 97, 86,
- 0, 0, 86, 0, 0, 85, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 86, 86, 0, 0,
- 0, 86, 0, 0, 0, 0, 0, 0, 0, 0,
+ 143, 0, 0, 0, 0, 24, 25, 26, 27, 28,
+ 0, 29, 30, 31, 116, 0, 116, 32, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 38, 0,
+ 39, 40, 41, 42, 43, 0, 0, 0, 0, 44,
+ 45, 46, 47, 48, 49, 0, 0, 51, 0, 168,
+ 0, 0, 0, 0, 0, 0, 54, 0, 55, 56,
+ 0, 131, 131, 131, 131, 0, 0, 0, 131, 0,
+ 131, 0, 0, 0, 0, 0, 131, 131, 131, 131,
+ 0, 150, 0, 0, 0, 0, 131, 131, 0, 131,
+ 131, 131, 131, 131, 131, 131, 0, 0, 131, 0,
+ 0, 131, 131, 131, 0, 0, 157, 157, 157, 157,
+ 0, 159, 0, 157, 159, 157, 0, 0, 0, 0,
+ 0, 157, 157, 157, 157, 0, 0, 0, 159, 159,
+ 0, 157, 157, 159, 157, 157, 157, 157, 157, 157,
+ 157, 0, 0, 157, 0, 0, 157, 157, 157, 143,
+ 143, 143, 143, 0, 0, 0, 143, 0, 143, 0,
+ 0, 0, 0, 159, 143, 143, 143, 143, 0, 0,
+ 0, 0, 0, 0, 143, 143, 0, 143, 143, 143,
+ 143, 143, 143, 143, 0, 0, 143, 0, 0, 143,
+ 143, 143, 0, 159, 0, 116, 116, 116, 116, 168,
+ 160, 0, 116, 0, 116, 0, 0, 0, 0, 0,
+ 116, 116, 116, 116, 0, 0, 0, 160, 160, 0,
+ 116, 116, 160, 116, 116, 116, 116, 116, 116, 116,
+ 0, 150, 116, 0, 0, 116, 116, 116, 0, 0,
+ 0, 0, 0, 145, 0, 152, 153, 154, 155, 0,
+ 160, 0, 160, 0, 0, 0, 0, 0, 0, 0,
+ 145, 145, 161, 162, 163, 145, 0, 164, 0, 0,
+ 165, 166, 167, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 160, 0, 0, 0, 0, 108, 0, 0,
+ 108, 0, 0, 145, 0, 145, 0, 0, 0, 0,
+ 0, 0, 0, 0, 108, 108, 0, 0, 0, 108,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 148, 0, 0, 148, 0, 0,
- 0, 86, 0, 0, 0, 0, 95, 95, 95, 95,
- 0, 148, 148, 0, 0, 95, 148, 0, 0, 0,
- 0, 95, 95, 95, 95, 0, 0, 0, 0, 0,
- 0, 95, 95, 0, 95, 95, 95, 95, 95, 95,
- 95, 147, 0, 0, 147, 0, 148, 0, 0, 0,
- 0, 0, 0, 83, 83, 83, 83, 0, 147, 147,
- 0, 0, 83, 147, 0, 0, 0, 0, 83, 83,
- 83, 83, 0, 0, 0, 0, 0, 134, 83, 83,
- 134, 83, 83, 83, 83, 83, 83, 83, 0, 84,
- 84, 84, 84, 147, 134, 134, 0, 0, 84, 134,
- 0, 0, 0, 0, 84, 84, 84, 84, 0, 0,
- 0, 0, 0, 0, 84, 84, 0, 84, 84, 84,
- 84, 84, 84, 105, 0, 0, 105, 0, 0, 134,
- 0, 0, 0, 0, 85, 85, 85, 85, 0, 0,
- 105, 105, 0, 85, 0, 105, 0, 0, 0, 85,
- 85, 0, 85, 0, 0, 0, 0, 0, 0, 85,
- 85, 0, 85, 85, 85, 85, 85, 85, 90, 0,
- 0, 90, 0, 0, 0, 105, 0, 0, 0, 0,
- 86, 86, 86, 86, 0, 90, 90, 0, 0, 86,
- 90, 0, 167, 0, 0, 86, 86, 0, 0, 0,
- 92, 0, 0, 92, 0, 86, 86, 0, 86, 86,
- 86, 86, 86, 86, 0, 0, 0, 92, 92, 0,
- 90, 0, 92, 0, 149, 148, 148, 148, 148, 0,
- 0, 0, 0, 0, 148, 0, 0, 0, 0, 0,
- 148, 148, 91, 0, 0, 91, 0, 0, 0, 0,
- 148, 148, 92, 148, 148, 148, 148, 148, 0, 91,
- 91, 0, 143, 0, 91, 143, 0, 0, 0, 0,
- 0, 0, 147, 147, 147, 147, 0, 0, 0, 143,
- 143, 147, 0, 0, 0, 284, 0, 147, 147, 82,
- 156, 0, 82, 0, 91, 0, 0, 147, 147, 0,
- 147, 147, 147, 147, 147, 0, 82, 82, 134, 134,
- 134, 134, 0, 0, 143, 0, 0, 134, 167, 0,
- 0, 0, 0, 134, 134, 69, 0, 0, 69, 0,
- 0, 0, 0, 134, 134, 0, 134, 134, 134, 134,
- 134, 82, 69, 69, 0, 0, 0, 0, 0, 0,
- 149, 0, 0, 0, 105, 105, 105, 105, 0, 0,
- 0, 0, 0, 105, 0, 0, 0, 0, 0, 105,
- 105, 0, 0, 0, 0, 0, 0, 69, 0, 105,
- 105, 156, 105, 105, 105, 105, 105, 0, 151, 152,
- 153, 154, 0, 0, 0, 0, 0, 0, 0, 90,
- 90, 90, 90, 0, 159, 160, 161, 162, 90, 167,
- 163, 0, 0, 164, 165, 166, 0, 0, 0, 0,
- 0, 0, 0, 0, 90, 90, 0, 90, 90, 90,
- 90, 92, 92, 92, 92, 0, 0, 0, 0, 0,
- 92, 149, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 92, 92, 0, 92,
- 92, 92, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 145, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 108,
+ 0, 0, 159, 159, 159, 159, 0, 0, 0, 159,
+ 0, 159, 0, 0, 0, 0, 0, 159, 159, 159,
+ 159, 0, 0, 69, 0, 0, 69, 159, 159, 108,
+ 159, 159, 159, 159, 159, 159, 159, 0, 0, 159,
+ 69, 69, 159, 159, 159, 69, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 152, 153, 154, 155, 0,
+ 0, 0, 0, 0, 0, 0, 107, 0, 0, 107,
+ 159, 160, 161, 162, 163, 69, 0, 164, 0, 0,
+ 165, 166, 167, 107, 107, 0, 0, 0, 107, 0,
+ 0, 160, 160, 160, 160, 0, 0, 0, 160, 0,
+ 160, 0, 0, 0, 0, 69, 160, 160, 160, 160,
+ 0, 0, 0, 0, 0, 0, 160, 160, 107, 160,
+ 160, 160, 160, 160, 160, 160, 0, 0, 160, 0,
+ 0, 160, 160, 160, 145, 145, 145, 145, 0, 72,
+ 0, 145, 0, 145, 0, 0, 0, 0, 107, 145,
+ 145, 145, 145, 0, 0, 0, 72, 72, 0, 145,
+ 145, 72, 145, 145, 145, 145, 145, 145, 145, 0,
+ 0, 145, 0, 0, 145, 145, 145, 0, 108, 108,
+ 108, 108, 0, 146, 0, 108, 146, 108, 0, 72,
+ 0, 72, 0, 108, 108, 108, 108, 0, 0, 0,
+ 146, 146, 0, 108, 108, 146, 108, 108, 108, 108,
+ 108, 108, 108, 0, 0, 108, 0, 0, 108, 108,
+ 108, 72, 0, 0, 0, 0, 159, 90, 90, 159,
+ 0, 0, 0, 0, 0, 146, 0, 0, 0, 103,
+ 0, 0, 0, 159, 159, 111, 90, 119, 159, 0,
+ 0, 0, 90, 0, 69, 69, 69, 69, 0, 0,
+ 0, 69, 0, 69, 90, 90, 90, 90, 0, 69,
+ 69, 69, 69, 0, 0, 0, 0, 0, 159, 69,
+ 69, 0, 69, 69, 69, 69, 69, 69, 69, 0,
+ 0, 69, 0, 0, 69, 69, 69, 107, 107, 107,
+ 107, 0, 114, 0, 107, 114, 107, 0, 0, 111,
+ 0, 0, 107, 107, 107, 107, 0, 0, 0, 114,
+ 114, 0, 107, 107, 114, 107, 107, 107, 107, 107,
+ 107, 107, 0, 0, 107, 0, 0, 107, 107, 107,
+ 0, 0, 0, 0, 0, 121, 0, 0, 121, 0,
+ 0, 0, 0, 0, 114, 0, 0, 0, 0, 0,
+ 0, 0, 121, 121, 0, 0, 0, 121, 0, 237,
+ 72, 72, 72, 72, 0, 0, 0, 72, 0, 72,
+ 0, 0, 0, 0, 0, 72, 72, 72, 72, 0,
+ 0, 0, 0, 266, 0, 72, 72, 121, 72, 72,
+ 72, 72, 72, 72, 72, 0, 0, 72, 0, 0,
+ 72, 72, 72, 0, 146, 146, 146, 146, 0, 105,
+ 0, 146, 105, 146, 0, 0, 0, 0, 0, 146,
+ 146, 146, 146, 0, 0, 0, 105, 105, 0, 146,
+ 146, 105, 146, 146, 146, 146, 146, 146, 146, 0,
+ 0, 146, 0, 0, 146, 146, 146, 159, 159, 159,
+ 159, 0, 99, 0, 159, 99, 159, 0, 0, 0,
+ 0, 105, 159, 159, 159, 159, 0, 0, 0, 99,
+ 99, 0, 159, 159, 99, 159, 159, 159, 159, 159,
+ 159, 159, 0, 0, 159, 0, 0, 159, 159, 159,
+ 100, 0, 0, 100, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 99, 0, 0, 100, 100, 0,
+ 0, 0, 100, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 114, 114, 114, 114, 0, 101, 0,
+ 114, 101, 114, 0, 0, 0, 0, 0, 114, 114,
+ 114, 114, 100, 0, 0, 101, 101, 0, 114, 114,
+ 101, 114, 114, 114, 114, 114, 114, 114, 0, 0,
+ 114, 0, 0, 114, 114, 114, 121, 121, 121, 121,
+ 0, 97, 0, 121, 97, 121, 0, 0, 0, 0,
+ 101, 121, 121, 121, 121, 0, 0, 0, 97, 97,
+ 0, 121, 121, 97, 121, 121, 121, 121, 121, 121,
+ 121, 0, 0, 121, 0, 0, 121, 121, 121, 98,
+ 0, 0, 98, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 97, 0, 0, 98, 98, 0, 0,
+ 0, 98, 0, 0, 0, 0, 0, 0, 0, 0,
+ 105, 105, 105, 105, 0, 96, 0, 105, 96, 105,
+ 0, 0, 0, 0, 0, 105, 105, 105, 105, 0,
+ 0, 98, 96, 96, 0, 105, 105, 96, 105, 105,
+ 105, 105, 105, 105, 105, 0, 0, 105, 0, 0,
+ 0, 0, 0, 99, 99, 99, 99, 0, 84, 0,
+ 99, 84, 99, 0, 0, 0, 0, 96, 99, 99,
+ 99, 99, 0, 0, 0, 84, 84, 0, 99, 99,
+ 84, 99, 99, 99, 99, 99, 99, 99, 0, 0,
+ 0, 100, 100, 100, 100, 0, 85, 0, 100, 85,
+ 100, 0, 0, 0, 0, 0, 100, 100, 100, 100,
+ 84, 0, 0, 85, 85, 0, 100, 100, 85, 100,
+ 100, 100, 100, 100, 100, 100, 0, 0, 0, 101,
+ 101, 101, 101, 0, 86, 0, 101, 86, 101, 0,
+ 0, 0, 0, 0, 101, 101, 101, 101, 85, 0,
+ 0, 86, 86, 0, 101, 101, 86, 101, 101, 101,
+ 101, 101, 101, 101, 0, 0, 0, 0, 0, 0,
+ 0, 0, 97, 97, 97, 97, 0, 87, 0, 97,
+ 87, 97, 0, 0, 0, 0, 86, 97, 97, 97,
+ 97, 0, 0, 0, 87, 87, 0, 97, 97, 87,
+ 97, 97, 97, 97, 97, 97, 97, 0, 0, 0,
+ 98, 98, 98, 98, 0, 148, 0, 98, 148, 98,
+ 0, 0, 0, 0, 0, 98, 98, 98, 98, 87,
+ 0, 0, 148, 148, 0, 98, 98, 148, 98, 98,
+ 98, 98, 98, 98, 98, 0, 96, 96, 96, 96,
+ 0, 135, 0, 96, 135, 96, 0, 0, 0, 0,
+ 0, 96, 96, 96, 96, 0, 0, 148, 135, 135,
+ 0, 96, 96, 135, 96, 96, 96, 96, 96, 96,
+ 96, 0, 0, 0, 0, 0, 0, 0, 0, 84,
+ 84, 84, 84, 0, 106, 0, 84, 106, 84, 0,
+ 0, 0, 0, 135, 84, 84, 84, 84, 0, 0,
+ 0, 106, 106, 0, 84, 84, 106, 84, 84, 84,
+ 84, 84, 84, 84, 0, 0, 0, 85, 85, 85,
+ 85, 0, 91, 0, 85, 91, 85, 0, 0, 0,
+ 0, 0, 85, 85, 85, 85, 106, 0, 0, 91,
+ 91, 0, 85, 85, 91, 85, 85, 85, 85, 85,
+ 85, 0, 0, 0, 0, 86, 86, 86, 86, 0,
+ 93, 0, 86, 93, 86, 0, 0, 0, 0, 0,
+ 86, 86, 0, 86, 91, 0, 0, 93, 93, 0,
+ 86, 86, 93, 86, 86, 86, 86, 86, 86, 0,
+ 168, 0, 0, 0, 0, 0, 0, 0, 87, 87,
+ 87, 87, 0, 94, 0, 87, 94, 87, 0, 0,
+ 0, 0, 93, 87, 87, 0, 0, 0, 0, 0,
+ 94, 94, 150, 87, 87, 94, 87, 87, 87, 87,
+ 87, 87, 0, 0, 0, 0, 148, 148, 148, 148,
+ 0, 92, 0, 148, 92, 148, 0, 0, 0, 0,
+ 0, 148, 148, 144, 0, 94, 144, 0, 92, 92,
+ 0, 148, 148, 92, 148, 148, 148, 148, 148, 0,
+ 144, 144, 135, 135, 135, 135, 0, 0, 0, 135,
+ 0, 135, 0, 0, 0, 0, 0, 135, 135, 0,
+ 0, 0, 0, 92, 0, 0, 83, 135, 135, 83,
+ 135, 135, 135, 135, 135, 144, 0, 0, 0, 70,
+ 0, 0, 70, 83, 83, 106, 106, 106, 106, 0,
+ 0, 0, 106, 0, 106, 0, 70, 70, 0, 0,
+ 106, 106, 0, 0, 0, 0, 157, 0, 0, 0,
+ 106, 106, 0, 106, 106, 106, 106, 106, 83, 0,
0, 0, 0, 91, 91, 91, 91, 0, 0, 0,
+ 91, 70, 91, 0, 168, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 91, 91,
+ 0, 91, 91, 91, 91, 0, 152, 153, 154, 155,
+ 0, 93, 93, 93, 93, 0, 150, 0, 93, 0,
+ 93, 0, 160, 161, 162, 163, 0, 0, 164, 0,
+ 0, 165, 166, 167, 0, 0, 93, 93, 0, 93,
+ 93, 93, 157, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 94, 94, 94, 94, 0, 0,
+ 0, 94, 0, 94, 0, 0, 0, 0, 0, 0,
+ 168, 0, 0, 0, 0, 0, 0, 0, 0, 94,
+ 94, 0, 94, 94, 0, 0, 0, 0, 0, 0,
+ 0, 0, 92, 92, 92, 92, 0, 0, 0, 92,
+ 0, 0, 150, 0, 144, 144, 144, 144, 0, 0,
+ 0, 144, 0, 0, 0, 0, 94, 92, 92, 0,
+ 92, 0, 0, 0, 104, 0, 0, 0, 109, 144,
+ 144, 118, 0, 0, 0, 0, 0, 0, 125, 126,
+ 127, 128, 129, 0, 0, 132, 133, 83, 83, 83,
+ 83, 0, 140, 0, 83, 0, 0, 0, 0, 0,
+ 70, 70, 70, 70, 0, 0, 0, 70, 0, 0,
+ 0, 0, 83, 83, 151, 0, 0, 0, 0, 184,
+ 152, 153, 154, 155, 0, 70, 70, 0, 0, 0,
+ 0, 0, 0, 156, 158, 159, 160, 161, 162, 163,
+ 0, 0, 164, 0, 0, 165, 166, 167, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 143, 143, 143, 143, 0, 91, 91,
- 0, 91, 0, 0, 0, 0, 0, 0, 150, 0,
- 0, 0, 0, 0, 151, 152, 153, 154, 143, 143,
- 82, 82, 82, 82, 0, 0, 0, 155, 157, 158,
- 159, 160, 161, 162, 0, 0, 163, 0, 0, 164,
- 165, 166, 0, 0, 0, 82, 82, 0, 0, 0,
- 0, 0, 0, 0, 94, 0, 69, 69, 69, 69,
- 0, 0, 104, 0, 0, 0, 109, 0, 0, 118,
- 0, 0, 0, 0, 0, 0, 125, 126, 127, 128,
- 129, 69, 69, 132, 133, 0, 0, 0, 0, 0,
- 140, 0, 0, 0, 0, 0, 0, 0, 0, 150,
- 0, 0, 0, 0, 0, 151, 152, 153, 154, 0,
- 0, 0, 0, 0, 0, 0, 0, 183, 0, 157,
- 158, 159, 160, 161, 162, 0, 0, 163, 0, 0,
- 164, 165, 166, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 217, 218, 219, 220, 221, 222,
- 223, 224, 225, 226, 227, 228, 229, 230, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 245,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 219, 220, 221,
+ 222, 223, 224, 225, 226, 227, 228, 229, 230, 231,
+ 232, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 151, 0, 247, 0, 0, 0, 152, 153, 154, 155,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 158, 159, 160, 161, 162, 163, 0, 0, 164, 0,
+ 0, 165, 166, 167, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 301, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 299, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 315,
+ 0, 0, 317,
};
short yycheck[] = { 13,
- 36, 86, 41, 36, 40, 44, 182, 59, 59, 41,
- 93, 40, 59, 91, 91, 59, 257, 41, 257, 58,
- 59, 41, 191, 41, 63, 59, 44, 91, 91, 59,
- 329, 40, 46, 41, 93, 40, 93, 41, 257, 41,
- 58, 59, 41, 57, 122, 63, 123, 61, 97, 98,
- 99, 100, 101, 102, 93, 59, 41, 59, 41, 123,
- 123, 360, 91, 44, 297, 298, 41, 41, 276, 277,
- 40, 40, 278, 91, 40, 93, 326, 327, 0, 123,
- 59, 331, 59, 36, 59, 59, 59, 40, 59, 123,
- 123, 41, 106, 107, 123, 40, 40, 347, 123, 41,
- 40, 351, 271, 59, 41, 123, 40, 123, 44, 59,
- 260, 33, 257, 289, 36, 37, 38, 59, 40, 40,
- 42, 43, 59, 45, 40, 93, 41, 40, 125, 143,
- 144, 145, 146, 147, 148, 149, 305, 59, 91, 91,
- 257, 36, 64, 192, 41, 266, 267, 268, 41, 270,
- 271, 44, 91, 167, 168, 169, 170, 171, 172, 173,
- 125, 41, 93, 298, 44, 58, 59, 40, 182, 91,
- 123, 249, 186, 187, 41, 189, 254, 191, 58, 59,
- 41, 350, 41, 63, 198, 0, 200, 201, 41, 41,
- 41, 205, 40, 93, 41, 93, 59, 125, 59, 125,
- 93, 123, 125, 125, 126, 125, 257, 41, 125, 59,
- 41, 91, 123, 93, 297, 298, 41, 231, 33, 233,
- 234, 36, 37, 38, 257, 40, 59, 42, 43, 262,
- 45, 40, 93, 272, 273, 274, 275, 314, 297, 298,
- 297, 298, 281, 123, 59, 297, 298, 41, 41, 64,
- 297, 298, 337, 123, 272, 273, 274, 275, 297, 298,
- 296, 300, 301, 281, 0, 297, 298, 123, 282, 287,
- 288, 289, 290, 297, 298, 289, 91, 297, 298, 297,
- 298, 59, 300, 301, 302, 303, 304, 305, 306, 297,
- 298, 309, 41, 307, 312, 313, 314, 33, 297, 298,
- 36, 37, 38, 41, 40, 258, 42, 43, 123, 45,
- 125, 126, 297, 298, 297, 298, 297, 298, 297, 298,
- 297, 298, 41, 59, 297, 298, 297, 298, 64, 297,
- 298, 59, 346, 41, 256, 257, 258, 259, 260, 261,
- 41, 263, 264, 265, 266, 267, 268, 269, 270, 271,
- 272, 273, 274, 275, 59, 91, 8, 279, 280, 32,
- 282, 283, 284, 285, 286, 125, 297, 298, 63, 291,
- 292, 293, 294, 295, 296, 13, 144, 299, 307, 272,
- 273, 274, 275, 346, 189, 96, 308, 123, 310, 311,
- 126, -1, 272, 273, 274, 275, 91, 297, 298, 297,
- 298, 281, -1, -1, 297, 298, 91, 287, 288, 289,
- 290, 272, 273, 274, 275, -1, -1, 297, 298, -1,
- 300, 301, 302, 303, 304, 305, 306, -1, 123, 309,
- 91, -1, 312, 313, 314, -1, 297, 298, 123, -1,
- -1, 256, 257, 258, 259, 260, 261, -1, 263, 264,
- 265, 266, 267, 268, 269, 270, 271, 272, 273, 274,
- 275, -1, 123, -1, 279, 280, -1, 282, 283, 284,
- 285, 286, 272, 273, 274, 275, 291, 292, 293, 294,
- 295, 296, 41, -1, 299, 44, 91, -1, -1, -1,
- -1, -1, -1, 308, -1, 310, 311, 297, 298, 58,
- 59, -1, -1, -1, 63, -1, 266, 267, 268, -1,
- 270, 271, -1, -1, -1, -1, -1, -1, 123, -1,
- 256, 257, 258, 259, 260, 261, 125, 263, 264, 265,
- -1, -1, 91, 269, 93, -1, 272, 273, 274, 275,
+ 41, 36, 86, 41, 91, 40, 44, 59, 91, 59,
+ 59, 93, 36, 183, 59, 59, 41, 91, 41, 331,
+ 58, 59, 91, 40, 257, 63, 41, 297, 298, 257,
+ 41, 59, 46, 40, 43, 41, 123, 276, 277, 257,
+ 123, 41, 51, 57, 41, 91, 41, 61, 59, 123,
+ 362, 44, 40, 59, 123, 93, 328, 329, 0, 40,
+ 192, 333, 41, 40, 40, 36, 40, 40, 40, 40,
+ 59, 278, 59, 123, 91, 123, 122, 349, 123, 40,
+ 59, 353, 91, 123, 97, 98, 99, 100, 101, 102,
+ 59, 33, 106, 107, 36, 37, 38, 59, 40, 123,
+ 42, 43, 260, 45, 44, 114, 123, 59, 41, 41,
+ 41, 257, 40, 122, 40, 125, 40, 59, 41, 41,
+ 91, 291, 64, 91, 41, 41, 59, 59, 59, 143,
+ 144, 145, 146, 147, 148, 149, 150, 59, 257, 36,
+ 91, 273, 59, 93, 91, 41, 298, 125, 44, 91,
+ 40, 40, 123, 0, 168, 169, 170, 171, 172, 173,
+ 174, 41, 58, 59, 41, 41, 41, 63, 93, 183,
+ 41, 41, 123, 187, 188, 307, 190, 91, 192, 125,
+ 193, 123, 93, 125, 126, 199, 33, 201, 202, 36,
+ 37, 38, 206, 40, 59, 42, 43, 93, 45, 266,
+ 267, 268, 59, 270, 271, 251, 289, 290, 257, 123,
+ 256, 41, 59, 125, 123, 297, 298, 64, 125, 233,
+ 352, 235, 236, 306, 125, 93, 309, 314, 41, 312,
+ 313, 314, 125, 257, 272, 273, 274, 275, 262, 41,
+ 41, 279, 251, 281, 91, 297, 298, 256, 0, 287,
+ 288, 289, 290, 297, 298, 339, 297, 298, 59, 297,
+ 298, 296, 300, 301, 302, 303, 304, 305, 306, 59,
+ 284, 309, 297, 298, 297, 298, 123, 291, 125, 126,
+ 40, 33, 297, 298, 36, 37, 38, 258, 40, 93,
+ 42, 43, 93, 45, 93, 309, 41, 297, 298, 41,
+ 297, 298, 297, 298, 297, 298, 123, 59, 297, 298,
+ 297, 298, 64, 125, 256, 257, 258, 259, 260, 261,
+ 123, 263, 264, 265, 266, 267, 268, 269, 270, 271,
+ 272, 273, 274, 275, 348, 297, 298, 279, 280, 91,
+ 282, 283, 284, 285, 286, 297, 298, 297, 298, 291,
+ 292, 293, 294, 295, 296, 306, 91, 299, 309, 41,
+ 41, 312, 313, 314, 59, 41, 308, 59, 310, 311,
+ 41, 123, 297, 298, 126, 59, 272, 273, 274, 275,
+ 41, 8, 32, 279, 13, 281, 297, 298, 123, 144,
+ 348, 287, 288, 41, 309, 309, 44, 190, 312, 313,
+ 314, 297, 298, 96, 300, 301, 302, 303, 304, 256,
+ 257, 258, 259, 260, 261, 63, 263, 264, 265, 266,
+ 267, 268, 269, 270, 271, 272, 273, 274, 275, 297,
+ 298, -1, 279, 280, -1, 282, 283, 284, 285, 286,
+ -1, -1, -1, 91, 291, 292, 293, 294, 295, 296,
+ 125, -1, 299, 91, 266, 267, 268, -1, 270, 271,
+ -1, 308, -1, 310, 311, -1, 41, -1, -1, 44,
+ -1, 272, 273, 274, 275, 123, -1, -1, 279, -1,
+ -1, -1, -1, 58, 59, 123, -1, -1, 63, -1,
+ -1, -1, -1, 297, 298, -1, 297, 298, 297, 298,
+ -1, -1, -1, -1, 256, 257, 258, 259, 260, 261,
+ -1, 263, 264, 265, -1, -1, 91, 269, 93, -1,
+ 272, 273, 274, 275, -1, -1, -1, 279, 280, -1,
+ 282, 283, 284, 285, 286, -1, -1, -1, -1, 291,
+ 292, 293, 294, 295, 296, -1, -1, 299, 123, -1,
+ -1, -1, 287, 288, 289, 290, 308, 33, 310, 311,
+ 36, 37, 38, -1, 40, 41, 42, 43, 44, 45,
+ 305, 306, -1, -1, 309, -1, -1, 312, 313, 314,
+ -1, -1, 58, 59, -1, -1, -1, 63, 64, -1,
+ -1, 266, 267, 268, -1, 270, 271, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, 272, 273, 274, 275,
+ -1, -1, -1, 279, -1, 91, -1, 93, 33, -1,
+ -1, 36, 37, 38, -1, 40, 41, 42, 43, 44,
+ 45, 297, 298, 281, -1, -1, -1, -1, -1, 287,
+ 288, 289, 290, 58, 59, -1, -1, 123, 63, 64,
+ 126, 289, 300, 301, 302, 303, 304, 305, 306, -1,
+ -1, 309, -1, -1, 312, 313, 314, -1, 306, -1,
+ -1, 309, -1, -1, 312, 313, 314, 33, 93, -1,
+ 36, 37, 38, -1, 40, -1, 42, 43, -1, 45,
+ -1, -1, -1, -1, -1, -1, -1, 272, 273, 274,
+ 275, -1, -1, 59, 279, -1, 281, -1, 64, -1,
+ -1, 126, 287, 288, 289, 290, 304, 305, 306, -1,
+ 308, -1, 297, 298, -1, 300, 301, 302, 303, 304,
+ 305, 306, -1, -1, 309, 91, -1, 312, 313, 314,
+ -1, -1, 41, -1, -1, 44, -1, 335, -1, -1,
+ -1, -1, -1, -1, 342, -1, -1, -1, 346, -1,
+ 59, -1, -1, 91, -1, -1, -1, 123, -1, -1,
+ 126, 359, 360, -1, -1, -1, -1, -1, -1, -1,
+ -1, 257, 258, 259, 260, 261, -1, 263, 264, 265,
+ -1, -1, -1, 269, 93, 123, 272, 273, 274, 275,
+ -1, -1, -1, 279, 280, 281, 282, 283, 284, 285,
+ 286, 287, 288, 289, 290, 291, 292, 293, 294, 295,
+ 296, 297, 298, 299, 300, 301, 302, 303, 304, 305,
+ 306, -1, 308, 309, 310, 311, 312, 313, 314, -1,
+ -1, -1, 257, 258, 259, 260, 261, -1, 263, 264,
+ 265, -1, -1, -1, 269, -1, -1, 272, 273, 274,
+ 275, -1, -1, -1, 279, 280, 281, 282, 283, 284,
+ 285, 286, 287, 288, 289, 290, 291, 292, 293, 294,
+ 295, 296, 297, 298, 299, 300, 301, 302, 303, 304,
+ 305, 306, -1, 308, 309, 310, 311, 312, 313, 314,
+ 256, 257, 258, 259, 260, 261, -1, 263, 264, 265,
+ -1, -1, -1, 269, -1, 91, 272, 273, 274, 275,
-1, -1, -1, 279, 280, -1, 282, 283, 284, 285,
286, -1, -1, -1, -1, 291, 292, 293, 294, 295,
- 296, -1, -1, 299, 123, -1, -1, -1, -1, -1,
- 91, -1, 308, 33, 310, 311, 36, 37, 38, -1,
- 40, 41, 42, 43, 44, 45, 281, -1, -1, -1,
- -1, -1, 287, 288, 289, 290, -1, -1, 58, 59,
- -1, -1, 123, 63, 64, 300, 301, 302, 303, 304,
- 305, 306, -1, -1, 309, -1, -1, 312, 313, 314,
- -1, 306, -1, -1, 309, -1, -1, 312, 313, 314,
- -1, 91, -1, 93, 33, -1, -1, 36, 37, 38,
- -1, 40, 41, 42, 43, 44, 45, -1, 309, -1,
- -1, 312, 313, 314, -1, -1, -1, -1, -1, 58,
- 59, -1, -1, 123, 63, 64, 126, 266, 267, 268,
- -1, 270, 271, -1, -1, -1, -1, -1, -1, 302,
- 303, 304, -1, 306, 289, 290, -1, -1, -1, -1,
- -1, 13, -1, 33, 93, -1, 36, 37, 38, -1,
- 40, 306, 42, 43, 309, 45, -1, 312, 313, 314,
- 333, -1, -1, 272, 273, 274, 275, 340, -1, 59,
- 42, 344, 281, 45, 64, -1, -1, 126, 287, 288,
- 289, 290, -1, -1, 357, 358, -1, -1, 297, 298,
- -1, 300, 301, 302, 303, 304, 305, 306, -1, -1,
- 309, 91, -1, 312, 313, 314, -1, -1, 41, 81,
- -1, 44, -1, -1, -1, -1, 287, 288, 289, 290,
- -1, -1, -1, 95, -1, -1, 59, -1, -1, 91,
- -1, -1, -1, 123, 305, 306, 126, -1, 309, -1,
- -1, 312, 313, 314, -1, -1, -1, 257, 258, 259,
- 260, 261, -1, 263, 264, 265, -1, -1, -1, 269,
- 93, 123, 272, 273, 274, 275, -1, -1, -1, 141,
- 280, 281, 282, 283, 284, 285, 286, 287, 288, 289,
- 290, 291, 292, 293, 294, 295, 296, 297, 298, 299,
- 300, 301, 302, 303, 304, 305, 306, -1, 308, 309,
- 310, 311, 312, 313, 314, -1, 178, -1, 257, 258,
- 259, 260, 261, 185, 263, 264, 265, -1, -1, -1,
- 269, -1, -1, 272, 273, 274, 275, -1, -1, -1,
- -1, 280, 281, 282, 283, 284, 285, 286, 287, 288,
- 289, 290, 291, 292, 293, 294, 295, 296, 297, 298,
- 299, 300, 301, 302, 303, 304, 305, 306, -1, 308,
- 309, 310, 311, 312, 313, 314, 256, 257, 258, 259,
- 260, 261, -1, 263, 264, 265, -1, -1, -1, 269,
- -1, 91, 272, 273, 274, 275, -1, -1, -1, 279,
- 280, -1, 282, 283, 284, 285, 286, -1, -1, 91,
- 43, 291, 292, 293, 294, 295, 296, 33, 51, 299,
- 36, 37, 38, 123, 40, -1, 42, 43, 308, 45,
- 310, 311, -1, -1, -1, 287, -1, 289, 290, -1,
- -1, 123, -1, 59, -1, -1, -1, -1, 64, 272,
- 273, 274, 275, 305, 306, -1, -1, 309, 91, -1,
- 312, 313, 314, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, 33, 297, 91, 36, 37, 38, -1,
- 40, 114, 42, 43, 26, 45, -1, -1, -1, 122,
+ 296, 33, -1, 299, 36, 37, 38, 123, 40, -1,
+ 42, 43, 308, 45, 310, 311, -1, -1, 13, 287,
+ -1, 289, 290, -1, -1, -1, -1, 59, -1, -1,
+ -1, -1, 64, 272, 273, 274, 275, 305, 306, -1,
+ 279, 309, -1, -1, 312, 313, 314, 42, -1, -1,
+ 45, -1, -1, -1, -1, -1, -1, 33, 297, 91,
+ 36, 37, 38, -1, 40, -1, 42, 43, -1, 45,
+ -1, -1, 26, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, 81, -1, 64, 43,
+ 44, 123, -1, -1, 126, -1, 50, -1, -1, -1,
+ 95, -1, -1, -1, -1, -1, -1, -1, 62, 63,
+ 64, 65, -1, 33, -1, 91, 36, 37, 38, -1,
+ 40, -1, 42, 43, -1, 45, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, 43, 44, -1, 64, -1, -1, 123, 50, -1,
- 126, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- 62, 63, 64, 65, -1, -1, -1, -1, -1, 33,
- -1, 91, 36, 37, 38, -1, 40, -1, 42, 43,
- -1, 45, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, 64, -1, 141, 123, -1, -1,
+ 126, -1, -1, 107, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- 64, -1, -1, 123, -1, 107, 126, -1, -1, -1,
+ -1, 91, -1, 289, 290, -1, 33, -1, -1, 36,
+ 37, 38, -1, 40, 179, 42, 43, -1, 45, 305,
+ 306, 186, -1, 309, -1, -1, 312, 313, 314, -1,
+ -1, -1, -1, 123, -1, -1, 126, 64, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, 91, -1, 289,
- 290, -1, 33, -1, -1, 36, 37, 38, -1, 40,
- -1, 42, 43, -1, 45, 305, 306, 289, -1, 309,
- -1, -1, 312, 313, 314, -1, 249, -1, -1, 123,
- -1, 254, 126, 64, 306, -1, -1, 309, -1, -1,
- 312, 313, 314, -1, -1, -1, -1, -1, -1, -1,
- 256, 257, 258, 259, 260, 261, -1, 263, 264, 265,
- 91, -1, -1, 269, -1, -1, 272, 273, 274, 275,
- -1, -1, -1, 279, 280, -1, 282, 283, 284, 285,
+ -1, -1, -1, -1, 256, 257, 258, 259, 260, 261,
+ -1, 263, 264, 265, 91, -1, -1, 269, -1, -1,
+ 272, 273, 274, 275, -1, -1, -1, 279, 280, -1,
+ 282, 283, 284, 285, 286, -1, -1, -1, -1, 291,
+ 292, 293, 294, 295, 296, -1, 123, 299, -1, 126,
+ -1, 91, -1, -1, -1, 41, 308, -1, 310, 311,
+ -1, 257, 258, 259, 260, 261, 262, 263, 264, 265,
+ -1, -1, -1, 269, -1, -1, -1, 63, -1, -1,
+ -1, -1, -1, 123, 280, -1, 282, 283, 284, 285,
286, -1, -1, -1, -1, 291, 292, 293, 294, 295,
- 296, 91, 123, 299, -1, 126, -1, -1, -1, -1,
- -1, -1, 308, 41, 310, 311, 44, 257, 258, 259,
- 260, 261, 262, 263, 264, 265, -1, -1, -1, 269,
- -1, -1, -1, 123, -1, 63, -1, -1, -1, -1,
+ 296, -1, -1, 299, -1, 91, -1, -1, -1, -1,
+ -1, -1, 308, -1, 310, 311, -1, 257, 258, 259,
+ 260, 261, -1, 263, 264, 265, -1, -1, -1, 269,
+ 58, -1, -1, -1, -1, 63, -1, 123, -1, -1,
280, -1, 282, 283, 284, 285, 286, -1, -1, -1,
-1, 291, 292, 293, 294, 295, 296, -1, -1, 299,
- -1, -1, -1, 91, -1, -1, -1, 41, 308, -1,
- 310, 311, -1, 257, 258, 259, 260, 261, -1, 263,
- 264, 265, -1, -1, -1, 269, -1, -1, -1, 63,
- -1, -1, -1, -1, -1, 123, 280, -1, 282, 283,
- 284, 285, 286, -1, -1, -1, -1, 291, 292, 293,
- 294, 295, 296, -1, -1, 299, -1, 91, -1, -1,
- -1, -1, -1, -1, 308, -1, 310, 311, -1, -1,
- -1, -1, -1, -1, -1, -1, 257, 258, 259, 260,
- 261, -1, 263, 264, 265, -1, -1, -1, 269, 123,
- -1, -1, -1, -1, -1, -1, -1, -1, -1, 280,
- -1, 282, 283, 284, 285, 286, -1, -1, -1, 91,
- 291, 292, 293, 294, 295, 296, 33, -1, 299, 36,
- 37, 38, -1, 40, -1, 42, 43, 308, 45, 310,
- 311, -1, -1, -1, -1, -1, -1, 287, 288, 289,
- 290, 123, 59, -1, -1, -1, -1, 64, -1, -1,
+ -1, -1, -1, 91, -1, -1, -1, -1, 308, -1,
+ 310, 311, -1, -1, -1, -1, 41, -1, -1, 44,
+ 257, 258, 259, 260, 261, -1, 263, 264, 265, -1,
+ -1, -1, 269, 58, 59, 123, -1, -1, 63, -1,
+ -1, -1, -1, 280, -1, 282, 283, 284, 285, 286,
+ -1, -1, -1, -1, 291, 292, 293, 294, 295, 296,
+ 33, -1, 299, 36, 37, 38, -1, 40, 93, 42,
+ 43, 308, 45, 310, 311, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, 59, 287, 288, 289,
+ 290, 64, -1, -1, -1, -1, -1, -1, -1, -1,
-1, 301, 302, 303, 304, 305, 306, -1, -1, 309,
- -1, -1, 312, 313, 314, -1, -1, -1, -1, -1,
+ -1, -1, 312, 313, 314, -1, 33, -1, 91, 36,
+ 37, 38, -1, 40, 41, 42, 43, -1, 45, -1,
+ -1, -1, -1, -1, -1, 281, -1, -1, -1, -1,
+ -1, 287, 288, 289, 290, -1, -1, 64, -1, -1,
+ -1, -1, -1, 126, 300, 301, 302, 303, 304, 305,
+ 306, -1, -1, 309, -1, -1, 312, 313, 314, -1,
-1, -1, 33, -1, 91, 36, 37, 38, -1, 40,
- 41, 42, 43, -1, 45, -1, -1, -1, -1, -1,
+ -1, 42, 43, -1, 45, -1, -1, -1, -1, -1,
-1, -1, -1, 281, -1, -1, -1, -1, -1, 287,
288, 289, 290, 64, -1, -1, -1, -1, -1, 126,
-1, -1, 300, 301, 302, 303, 304, 305, 306, -1,
- -1, 309, -1, -1, 312, 313, 314, -1, 33, -1,
- 91, 36, 37, 38, -1, 40, -1, 42, 43, -1,
- 45, -1, -1, -1, -1, -1, -1, 281, -1, -1,
- -1, -1, -1, 287, 288, 289, 290, -1, -1, 64,
- -1, -1, -1, -1, -1, 126, 300, 301, 302, 303,
- 304, 305, 306, -1, -1, 309, -1, -1, 312, 313,
- 314, -1, -1, -1, -1, -1, 91, 33, 93, -1,
- 36, 37, 38, -1, 40, 41, 42, 43, -1, 45,
- -1, -1, -1, -1, -1, 287, 288, 289, 290, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, 64, -1,
- -1, 126, 304, 305, 306, -1, -1, 309, -1, -1,
- 312, 313, 314, -1, -1, -1, 41, -1, -1, 44,
- 257, 258, 259, 260, 261, 91, 263, 264, 265, -1,
+ -1, 309, -1, -1, 312, 313, 314, -1, -1, -1,
+ 91, 33, 93, -1, 36, 37, 38, -1, 40, 41,
+ 42, 43, -1, 45, -1, -1, -1, 272, 273, 274,
+ 275, -1, -1, -1, 279, -1, 281, -1, -1, -1,
+ -1, -1, 64, 288, -1, 126, -1, -1, -1, -1,
+ -1, -1, 297, 298, -1, 300, 301, 302, 303, 304,
+ 41, -1, -1, 44, 257, 258, 259, 260, 261, 91,
+ 263, 264, 265, -1, -1, -1, 269, 58, 59, -1,
+ -1, -1, 63, -1, -1, -1, -1, 280, -1, 282,
+ 283, 284, 285, 286, -1, -1, -1, -1, 291, 292,
+ 293, 294, 295, 296, 126, -1, 299, -1, -1, -1,
+ -1, -1, 93, -1, -1, 308, 41, 310, 311, 44,
+ 257, 258, 259, 260, 261, -1, 263, 264, 265, -1,
-1, -1, 269, 58, 59, -1, -1, -1, 63, -1,
-1, -1, -1, 280, -1, 282, 283, 284, 285, 286,
-1, -1, -1, -1, 291, 292, 293, 294, 295, 296,
- 126, -1, 299, -1, -1, -1, -1, -1, 93, -1,
- -1, 308, 41, 310, 311, 44, 257, 258, 259, 260,
- 261, -1, 263, 264, 265, -1, -1, -1, 269, 58,
- 59, -1, -1, -1, 63, -1, -1, -1, -1, 280,
- -1, 282, 283, 284, 285, 286, -1, -1, -1, -1,
- 291, 292, 293, 294, 295, 296, -1, -1, 299, -1,
- -1, -1, -1, -1, 93, -1, -1, 308, -1, 310,
- 311, -1, 257, 258, 259, 260, 261, -1, 263, 264,
- 265, -1, 33, -1, 269, 36, 37, 38, -1, 40,
- 41, 42, 43, -1, 45, 280, -1, 282, 283, 284,
- 285, 286, -1, -1, -1, -1, 291, 292, 293, 294,
- 295, 296, -1, 64, 299, -1, -1, -1, -1, -1,
- -1, -1, -1, 308, -1, 310, 311, -1, -1, -1,
- -1, 257, 258, 259, 260, 261, -1, 263, 264, 265,
- 91, 33, -1, 269, 36, 37, 38, -1, 40, -1,
- 42, 43, -1, 45, 280, -1, 282, 283, 284, 285,
- 286, -1, -1, -1, -1, 291, 292, 293, 294, 295,
- 296, -1, 64, 299, -1, 126, -1, -1, -1, -1,
- -1, -1, 308, -1, 310, 311, -1, 272, 273, 274,
- 275, -1, -1, -1, -1, -1, 281, 33, -1, 91,
- 36, 37, 38, 288, 40, 41, 42, 43, -1, 45,
- -1, -1, 297, 298, -1, 300, 301, 302, 303, 304,
- -1, -1, -1, -1, -1, -1, -1, -1, 64, -1,
- -1, -1, -1, -1, 126, -1, -1, -1, -1, -1,
- -1, -1, -1, 272, 273, 274, 275, -1, -1, -1,
- -1, -1, 281, 33, -1, 91, 36, 37, 38, -1,
- 40, 41, 42, 43, -1, 45, -1, -1, 297, 298,
- -1, 300, 301, 302, 303, 304, -1, -1, -1, -1,
- -1, -1, -1, -1, 64, -1, -1, -1, -1, -1,
- 126, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, 257, 258, 259, 260,
- 261, 91, 263, 264, 265, -1, 33, -1, 269, 36,
+ -1, -1, 299, -1, -1, -1, -1, -1, 93, -1,
+ -1, 308, -1, 310, 311, -1, 257, 258, 259, 260,
+ 261, -1, 263, 264, 265, -1, 33, -1, 269, 36,
37, 38, -1, 40, 41, 42, 43, -1, 45, 280,
-1, 282, 283, 284, 285, 286, -1, -1, -1, -1,
- 291, 292, 293, 294, 295, 296, 126, 64, 299, -1,
+ 291, 292, 293, 294, 295, 296, -1, 64, 299, -1,
-1, -1, -1, -1, -1, -1, -1, 308, -1, 310,
- 311, -1, -1, -1, 256, 257, 258, 259, 260, 261,
- -1, 263, 264, 265, 91, -1, -1, 269, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, 280, -1,
+ 311, -1, -1, -1, -1, 257, 258, 259, 260, 261,
+ -1, 263, 264, 265, 91, 33, -1, 269, 36, 37,
+ 38, -1, 40, -1, 42, 43, -1, 45, 280, -1,
282, 283, 284, 285, 286, -1, -1, -1, -1, 291,
- 292, 293, 294, 295, 296, -1, -1, 299, -1, 126,
- 91, -1, -1, -1, 41, -1, 308, 44, 310, 311,
- -1, 257, 258, 259, 260, 261, -1, 263, 264, 265,
- -1, 58, 59, 269, -1, -1, 63, -1, -1, -1,
- -1, -1, 123, -1, 280, -1, 282, 283, 284, 285,
- 286, -1, -1, -1, -1, 291, 292, 293, 294, 295,
- 296, -1, -1, 299, 91, -1, 93, -1, -1, -1,
- -1, -1, 308, -1, 310, 311, -1, 257, 258, 259,
- 260, 261, -1, 263, 264, 265, -1, 33, -1, 269,
- 36, 37, 38, -1, 40, -1, 42, 43, -1, 45,
- 280, -1, 282, 283, 284, 285, 286, -1, -1, -1,
- -1, 291, 292, 293, 294, 295, 296, -1, 64, 299,
- -1, -1, -1, -1, -1, -1, -1, -1, 308, -1,
- 310, 311, -1, -1, -1, -1, 41, -1, -1, 44,
+ 292, 293, 294, 295, 296, -1, 64, 299, -1, 126,
+ -1, -1, -1, -1, -1, -1, 308, -1, 310, 311,
+ -1, 272, 273, 274, 275, -1, -1, -1, 279, -1,
+ 281, 33, -1, 91, 36, 37, 38, -1, 40, 41,
+ 42, 43, -1, 45, -1, -1, 297, 298, -1, 300,
+ 301, 302, 303, 304, -1, -1, -1, -1, -1, -1,
+ -1, -1, 64, -1, -1, -1, -1, -1, 126, -1,
+ -1, -1, -1, -1, -1, -1, -1, 272, 273, 274,
+ 275, -1, -1, -1, 279, -1, 281, 33, -1, 91,
+ 36, 37, 38, -1, 40, 41, 42, 43, -1, 45,
+ -1, -1, 297, 298, -1, 300, 301, 302, 303, 304,
+ -1, -1, -1, -1, -1, -1, -1, -1, 64, -1,
+ -1, -1, -1, -1, 126, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
257, 258, 259, 260, 261, 91, 263, 264, 265, -1,
- -1, -1, 269, 58, 59, -1, -1, -1, 63, -1,
- -1, -1, -1, 280, -1, 282, 283, 284, 285, 286,
+ 33, -1, 269, 36, 37, 38, -1, 40, 41, 42,
+ 43, -1, 45, 280, -1, 282, 283, 284, 285, 286,
-1, -1, -1, -1, 291, 292, 293, 294, 295, 296,
- 126, -1, 299, 41, -1, -1, 44, -1, 93, -1,
- -1, 308, -1, 310, 311, -1, -1, -1, -1, -1,
- 58, 59, -1, -1, -1, 63, 287, 288, 289, 290,
- -1, -1, -1, -1, -1, -1, -1, -1, 123, -1,
- -1, 302, 303, 304, 305, 306, -1, -1, 309, -1,
- -1, 312, 313, 314, -1, 93, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, 272, 273, 274, 275, -1,
- 41, -1, -1, -1, 281, -1, -1, -1, -1, -1,
- 287, 288, 289, 290, -1, 123, -1, 58, 59, -1,
- 297, 298, 63, 300, 301, 302, 303, 304, 305, 306,
- -1, -1, 309, -1, -1, 312, 313, 314, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- 91, -1, 93, -1, 41, -1, -1, -1, -1, -1,
+ 126, 64, 299, -1, -1, -1, -1, -1, -1, -1,
+ -1, 308, -1, 310, 311, -1, -1, -1, 256, 257,
+ 258, 259, 260, 261, -1, 263, 264, 265, 91, -1,
+ -1, 269, 41, -1, -1, 44, -1, -1, -1, -1,
+ -1, -1, 280, -1, 282, 283, 284, 285, 286, 58,
+ 59, -1, -1, 291, 292, 293, 294, 295, 296, -1,
+ -1, 299, -1, 126, -1, -1, -1, -1, -1, -1,
+ 308, -1, 310, 311, -1, 257, 258, 259, 260, 261,
+ -1, 263, 264, 265, 93, -1, -1, 269, 41, -1,
+ -1, 44, -1, -1, -1, -1, -1, -1, 280, -1,
+ 282, 283, 284, 285, 286, 58, 59, -1, -1, 291,
+ 292, 293, 294, 295, 296, -1, -1, 299, -1, -1,
+ -1, -1, -1, -1, -1, -1, 308, -1, 310, 311,
-1, 257, 258, 259, 260, 261, -1, 263, 264, 265,
- -1, 58, 59, 269, -1, -1, 63, -1, -1, -1,
- -1, -1, 123, -1, 280, -1, 282, 283, 284, 285,
+ 93, 33, -1, 269, 36, 37, 38, -1, 40, -1,
+ 42, 43, -1, 45, 280, -1, 282, 283, 284, 285,
286, -1, -1, -1, -1, 291, 292, 293, 294, 295,
- 296, -1, -1, 299, 91, -1, 93, -1, -1, -1,
- 41, -1, 308, 44, 310, 311, -1, 272, 273, 274,
- 275, -1, -1, -1, -1, -1, 281, 58, 59, -1,
- -1, -1, 287, 288, 289, 290, 123, -1, -1, -1,
- -1, -1, 297, 298, -1, 300, 301, 302, 303, 304,
- 305, 306, -1, -1, 309, -1, -1, 312, 313, 314,
- -1, -1, 93, -1, 272, 273, 274, 275, -1, 41,
- -1, -1, 44, 281, -1, -1, -1, -1, -1, 287,
- 288, 289, 290, -1, -1, -1, 58, 59, -1, 297,
- 298, 63, 300, 301, 302, 303, 304, 305, 306, 25,
- 26, 309, -1, -1, 312, 313, 314, -1, -1, -1,
- -1, 37, -1, -1, -1, -1, -1, 43, 44, 45,
- -1, 93, -1, -1, 50, -1, -1, -1, -1, -1,
- -1, 272, 273, 274, 275, -1, 62, 63, 64, 65,
- 281, -1, -1, -1, -1, -1, 287, 288, 289, 290,
- -1, 123, 41, -1, -1, 44, 297, 298, -1, 300,
- 301, 302, 303, 304, 305, 306, -1, -1, 309, 58,
- 59, 312, 313, 314, 63, -1, -1, -1, -1, -1,
- -1, 107, -1, -1, -1, 272, 273, 274, 275, -1,
- -1, -1, -1, -1, 281, -1, -1, -1, -1, -1,
- 287, 288, 289, 290, 93, -1, 41, -1, -1, -1,
- 297, 298, -1, 300, 301, 302, 303, 304, 305, 306,
- -1, -1, 309, 58, 59, 312, 313, 314, 63, -1,
- -1, -1, -1, -1, 123, -1, -1, -1, -1, -1,
- 166, 272, 273, 274, 275, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, 41, -1, 91, 44, 93, -1,
- -1, -1, -1, -1, 190, -1, 297, 298, -1, 300,
- -1, 58, 59, -1, -1, -1, 63, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, 123, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- 272, 273, 274, 275, -1, 41, 93, -1, 44, 281,
- -1, -1, -1, -1, -1, 287, 288, 289, 290, -1,
- -1, -1, 58, 59, -1, 297, 298, 63, 300, 301,
- 302, 303, 304, 305, 306, -1, 123, 309, -1, -1,
- 312, 313, 314, -1, -1, -1, -1, -1, -1, -1,
- 41, -1, -1, 44, -1, -1, -1, 93, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, 58, 59, -1,
- -1, -1, 63, -1, -1, -1, -1, -1, -1, -1,
+ 296, -1, 64, 299, -1, -1, -1, -1, -1, -1,
+ -1, -1, 308, -1, 310, 311, -1, -1, -1, -1,
+ 41, -1, -1, 44, 257, 258, 259, 260, 261, 91,
+ 263, 264, 265, -1, -1, -1, 269, 58, 59, -1,
+ -1, -1, 63, -1, -1, -1, -1, 280, -1, 282,
+ 283, 284, 285, 286, -1, -1, -1, -1, 291, 292,
+ 293, 294, 295, 296, 126, 41, 299, -1, 44, -1,
+ 91, -1, 93, -1, -1, 308, -1, 310, 311, -1,
+ -1, -1, 58, 59, -1, -1, -1, 63, -1, -1,
-1, -1, -1, 272, 273, 274, 275, -1, -1, -1,
- -1, -1, 281, -1, -1, -1, -1, -1, 287, 288,
- 289, 290, 93, -1, 41, -1, -1, 44, 297, 298,
- -1, 300, 301, 302, 303, 304, 305, 306, -1, -1,
- 309, 58, 59, 312, 313, 314, 63, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, 272, 273, 274,
- 275, -1, -1, -1, -1, -1, 281, -1, -1, -1,
- -1, -1, 287, 288, 289, 290, 93, -1, -1, -1,
- -1, -1, 297, 298, -1, 300, 301, 302, 303, 304,
- 305, 306, -1, -1, 309, -1, -1, 312, 313, 314,
- -1, -1, -1, -1, -1, 272, 273, 274, 275, -1,
- 41, -1, -1, 44, 281, -1, -1, -1, -1, -1,
- 287, 288, 289, 290, -1, -1, -1, 58, 59, -1,
- 297, 298, 63, 300, 301, 302, 303, 304, 305, 306,
- -1, -1, 309, -1, -1, 312, 313, 314, -1, -1,
- -1, -1, -1, -1, -1, -1, 272, 273, 274, 275,
- -1, 41, 93, -1, 44, 281, -1, -1, -1, -1,
+ 279, -1, 123, -1, -1, -1, -1, -1, 41, -1,
+ -1, 44, -1, -1, -1, 91, -1, 93, 297, 298,
+ -1, 300, -1, -1, -1, 58, 59, -1, -1, -1,
+ 63, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, 123, -1, 272,
+ 273, 274, 275, -1, 41, -1, 279, 44, -1, -1,
+ 93, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, 58, 59, -1, 297, 298, 63, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ 123, -1, -1, -1, -1, 257, 258, 259, 260, 261,
+ -1, 263, 264, 265, 91, -1, 93, 269, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, 280, -1,
+ 282, 283, 284, 285, 286, -1, -1, -1, -1, 291,
+ 292, 293, 294, 295, 296, -1, -1, 299, -1, 91,
+ -1, -1, -1, -1, -1, -1, 308, -1, 310, 311,
+ -1, 272, 273, 274, 275, -1, -1, -1, 279, -1,
+ 281, -1, -1, -1, -1, -1, 287, 288, 289, 290,
+ -1, 123, -1, -1, -1, -1, 297, 298, -1, 300,
+ 301, 302, 303, 304, 305, 306, -1, -1, 309, -1,
+ -1, 312, 313, 314, -1, -1, 272, 273, 274, 275,
+ -1, 41, -1, 279, 44, 281, -1, -1, -1, -1,
-1, 287, 288, 289, 290, -1, -1, -1, 58, 59,
-1, 297, 298, 63, 300, 301, 302, 303, 304, 305,
- 306, -1, -1, 309, -1, -1, 312, 313, 314, -1,
- -1, 272, 273, 274, 275, -1, -1, -1, -1, -1,
- 281, -1, -1, 93, -1, -1, 287, 288, 289, 290,
- -1, -1, 41, -1, -1, 44, 297, 298, -1, 300,
- 301, 302, 303, 304, 305, 306, -1, -1, 309, 58,
- 59, 312, 313, 314, 63, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, 272, 273, 274, 275, -1,
- 41, -1, -1, 44, 281, -1, -1, -1, -1, -1,
- 287, 288, 289, 290, 93, -1, -1, 58, 59, -1,
+ 306, -1, -1, 309, -1, -1, 312, 313, 314, 272,
+ 273, 274, 275, -1, -1, -1, 279, -1, 281, -1,
+ -1, -1, -1, 93, 287, 288, 289, 290, -1, -1,
+ -1, -1, -1, -1, 297, 298, -1, 300, 301, 302,
+ 303, 304, 305, 306, -1, -1, 309, -1, -1, 312,
+ 313, 314, -1, 123, -1, 272, 273, 274, 275, 91,
+ 41, -1, 279, -1, 281, -1, -1, -1, -1, -1,
+ 287, 288, 289, 290, -1, -1, -1, 58, 59, -1,
297, 298, 63, 300, 301, 302, 303, 304, 305, 306,
- -1, -1, 309, -1, -1, 312, 313, 314, -1, 41,
- -1, -1, 44, -1, -1, -1, -1, -1, -1, -1,
- 41, -1, 93, 44, -1, -1, 58, 59, -1, -1,
- -1, 63, -1, -1, -1, -1, -1, 58, 59, -1,
- -1, -1, 63, -1, -1, -1, -1, -1, -1, -1,
- -1, 272, 273, 274, 275, -1, 41, -1, -1, 44,
- 281, 93, -1, -1, -1, -1, 287, 288, 289, 290,
- -1, -1, 93, 58, 59, -1, 297, 298, 63, 300,
- 301, 302, 303, 304, 305, 306, -1, -1, 309, -1,
- -1, 312, 313, 314, -1, -1, -1, -1, -1, -1,
- -1, -1, 272, 273, 274, 275, -1, 41, 93, -1,
- 44, 281, -1, -1, -1, -1, -1, 287, 288, 289,
- 290, -1, -1, -1, 58, 59, -1, 297, 298, 63,
- 300, 301, 302, 303, 304, 305, 306, -1, -1, 309,
+ -1, 123, 309, -1, -1, 312, 313, 314, -1, -1,
+ -1, -1, -1, 41, -1, 287, 288, 289, 290, -1,
+ 91, -1, 93, -1, -1, -1, -1, -1, -1, -1,
+ 58, 59, 304, 305, 306, 63, -1, 309, -1, -1,
+ 312, 313, 314, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, 123, -1, -1, -1, -1, 41, -1, -1,
+ 44, -1, -1, 91, -1, 93, -1, -1, -1, -1,
+ -1, -1, -1, -1, 58, 59, -1, -1, -1, 63,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, 41, -1, -1, 44, -1, -1, 93,
- -1, -1, -1, 272, 273, 274, 275, -1, -1, -1,
- 58, 59, 281, -1, -1, 63, -1, -1, 287, 288,
- 289, 290, -1, -1, -1, -1, -1, -1, 297, 298,
- -1, 300, 301, 302, 303, 304, 305, 306, -1, -1,
- 309, 272, 273, 274, 275, 93, -1, -1, -1, -1,
- 281, -1, -1, -1, -1, -1, 287, 288, 289, 290,
- -1, -1, -1, -1, -1, -1, 297, 298, -1, 300,
- 301, 302, 303, 304, 305, 306, -1, -1, -1, -1,
- 272, 273, 274, 275, -1, 41, -1, -1, 44, 281,
- -1, 272, 273, 274, 275, 287, 288, 289, 290, -1,
- 281, -1, 58, 59, -1, 297, 298, 63, 300, 301,
- 302, 303, 304, 305, 306, -1, 297, 298, -1, 300,
- 301, 302, 303, 304, -1, -1, -1, 272, 273, 274,
- 275, -1, 41, -1, -1, 44, 281, 93, -1, -1,
+ -1, -1, -1, -1, -1, 123, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, 93,
+ -1, -1, 272, 273, 274, 275, -1, -1, -1, 279,
+ -1, 281, -1, -1, -1, -1, -1, 287, 288, 289,
+ 290, -1, -1, 41, -1, -1, 44, 297, 298, 123,
+ 300, 301, 302, 303, 304, 305, 306, -1, -1, 309,
+ 58, 59, 312, 313, 314, 63, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, 287, 288, 289, 290, -1,
+ -1, -1, -1, -1, -1, -1, 41, -1, -1, 44,
+ 302, 303, 304, 305, 306, 93, -1, 309, -1, -1,
+ 312, 313, 314, 58, 59, -1, -1, -1, 63, -1,
+ -1, 272, 273, 274, 275, -1, -1, -1, 279, -1,
+ 281, -1, -1, -1, -1, 123, 287, 288, 289, 290,
+ -1, -1, -1, -1, -1, -1, 297, 298, 93, 300,
+ 301, 302, 303, 304, 305, 306, -1, -1, 309, -1,
+ -1, 312, 313, 314, 272, 273, 274, 275, -1, 41,
+ -1, 279, -1, 281, -1, -1, -1, -1, 123, 287,
+ 288, 289, 290, -1, -1, -1, 58, 59, -1, 297,
+ 298, 63, 300, 301, 302, 303, 304, 305, 306, -1,
+ -1, 309, -1, -1, 312, 313, 314, -1, 272, 273,
+ 274, 275, -1, 41, -1, 279, 44, 281, -1, 91,
+ -1, 93, -1, 287, 288, 289, 290, -1, -1, -1,
+ 58, 59, -1, 297, 298, 63, 300, 301, 302, 303,
+ 304, 305, 306, -1, -1, 309, -1, -1, 312, 313,
+ 314, 123, -1, -1, -1, -1, 41, 25, 26, 44,
+ -1, -1, -1, -1, -1, 93, -1, -1, -1, 37,
+ -1, -1, -1, 58, 59, 43, 44, 45, 63, -1,
+ -1, -1, 50, -1, 272, 273, 274, 275, -1, -1,
+ -1, 279, -1, 281, 62, 63, 64, 65, -1, 287,
+ 288, 289, 290, -1, -1, -1, -1, -1, 93, 297,
+ 298, -1, 300, 301, 302, 303, 304, 305, 306, -1,
+ -1, 309, -1, -1, 312, 313, 314, 272, 273, 274,
+ 275, -1, 41, -1, 279, 44, 281, -1, -1, 107,
-1, -1, 287, 288, 289, 290, -1, -1, -1, 58,
59, -1, 297, 298, 63, 300, 301, 302, 303, 304,
- 305, 306, -1, -1, -1, -1, -1, -1, 41, -1,
- -1, 44, -1, -1, -1, -1, -1, -1, 272, 273,
- 274, 275, -1, -1, 93, 58, 59, 281, -1, -1,
- 63, -1, -1, 287, 288, 289, 290, -1, -1, -1,
- -1, -1, -1, 297, 298, -1, 300, 301, 302, 303,
- 304, 305, 306, 41, -1, -1, 44, -1, -1, -1,
- 93, -1, -1, -1, 272, 273, 274, 275, -1, -1,
- 58, 59, -1, 281, -1, 63, -1, -1, -1, 287,
- 288, 289, 290, -1, -1, -1, -1, -1, -1, 297,
- 298, -1, 300, 301, 302, 303, 304, 305, 306, 41,
- -1, -1, 44, -1, -1, 93, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, 58, 59, -1, -1,
+ 305, 306, -1, -1, 309, -1, -1, 312, 313, 314,
+ -1, -1, -1, -1, -1, 41, -1, -1, 44, -1,
+ -1, -1, -1, -1, 93, -1, -1, -1, -1, -1,
+ -1, -1, 58, 59, -1, -1, -1, 63, -1, 167,
+ 272, 273, 274, 275, -1, -1, -1, 279, -1, 281,
+ -1, -1, -1, -1, -1, 287, 288, 289, 290, -1,
+ -1, -1, -1, 191, -1, 297, 298, 93, 300, 301,
+ 302, 303, 304, 305, 306, -1, -1, 309, -1, -1,
+ 312, 313, 314, -1, 272, 273, 274, 275, -1, 41,
+ -1, 279, 44, 281, -1, -1, -1, -1, -1, 287,
+ 288, 289, 290, -1, -1, -1, 58, 59, -1, 297,
+ 298, 63, 300, 301, 302, 303, 304, 305, 306, -1,
+ -1, 309, -1, -1, 312, 313, 314, 272, 273, 274,
+ 275, -1, 41, -1, 279, 44, 281, -1, -1, -1,
+ -1, 93, 287, 288, 289, 290, -1, -1, -1, 58,
+ 59, -1, 297, 298, 63, 300, 301, 302, 303, 304,
+ 305, 306, -1, -1, 309, -1, -1, 312, 313, 314,
+ 41, -1, -1, 44, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, 93, -1, -1, 58, 59, -1,
+ -1, -1, 63, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, 272, 273, 274, 275, -1, 41, -1,
+ 279, 44, 281, -1, -1, -1, -1, -1, 287, 288,
+ 289, 290, 93, -1, -1, 58, 59, -1, 297, 298,
+ 63, 300, 301, 302, 303, 304, 305, 306, -1, -1,
+ 309, -1, -1, 312, 313, 314, 272, 273, 274, 275,
+ -1, 41, -1, 279, 44, 281, -1, -1, -1, -1,
+ 93, 287, 288, 289, 290, -1, -1, -1, 58, 59,
+ -1, 297, 298, 63, 300, 301, 302, 303, 304, 305,
+ 306, -1, -1, 309, -1, -1, 312, 313, 314, 41,
+ -1, -1, 44, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, 93, -1, -1, 58, 59, -1, -1,
-1, 63, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, 41, -1, -1, 44, -1, -1,
- -1, 93, -1, -1, -1, -1, 272, 273, 274, 275,
- -1, 58, 59, -1, -1, 281, 63, -1, -1, -1,
- -1, 287, 288, 289, 290, -1, -1, -1, -1, -1,
- -1, 297, 298, -1, 300, 301, 302, 303, 304, 305,
- 306, 41, -1, -1, 44, -1, 93, -1, -1, -1,
- -1, -1, -1, 272, 273, 274, 275, -1, 58, 59,
- -1, -1, 281, 63, -1, -1, -1, -1, 287, 288,
- 289, 290, -1, -1, -1, -1, -1, 41, 297, 298,
- 44, 300, 301, 302, 303, 304, 305, 306, -1, 272,
- 273, 274, 275, 93, 58, 59, -1, -1, 281, 63,
- -1, -1, -1, -1, 287, 288, 289, 290, -1, -1,
- -1, -1, -1, -1, 297, 298, -1, 300, 301, 302,
- 303, 304, 305, 41, -1, -1, 44, -1, -1, 93,
- -1, -1, -1, -1, 272, 273, 274, 275, -1, -1,
- 58, 59, -1, 281, -1, 63, -1, -1, -1, 287,
- 288, -1, 290, -1, -1, -1, -1, -1, -1, 297,
- 298, -1, 300, 301, 302, 303, 304, 305, 41, -1,
- -1, 44, -1, -1, -1, 93, -1, -1, -1, -1,
- 272, 273, 274, 275, -1, 58, 59, -1, -1, 281,
- 63, -1, 91, -1, -1, 287, 288, -1, -1, -1,
- 41, -1, -1, 44, -1, 297, 298, -1, 300, 301,
- 302, 303, 304, 305, -1, -1, -1, 58, 59, -1,
- 93, -1, 63, -1, 123, 272, 273, 274, 275, -1,
- -1, -1, -1, -1, 281, -1, -1, -1, -1, -1,
- 287, 288, 41, -1, -1, 44, -1, -1, -1, -1,
- 297, 298, 93, 300, 301, 302, 303, 304, -1, 58,
- 59, -1, 41, -1, 63, 44, -1, -1, -1, -1,
- -1, -1, 272, 273, 274, 275, -1, -1, -1, 58,
- 59, 281, -1, -1, -1, 58, -1, 287, 288, 41,
- 63, -1, 44, -1, 93, -1, -1, 297, 298, -1,
- 300, 301, 302, 303, 304, -1, 58, 59, 272, 273,
- 274, 275, -1, -1, 93, -1, -1, 281, 91, -1,
- -1, -1, -1, 287, 288, 41, -1, -1, 44, -1,
- -1, -1, -1, 297, 298, -1, 300, 301, 302, 303,
- 304, 93, 58, 59, -1, -1, -1, -1, -1, -1,
- 123, -1, -1, -1, 272, 273, 274, 275, -1, -1,
- -1, -1, -1, 281, -1, -1, -1, -1, -1, 287,
- 288, -1, -1, -1, -1, -1, -1, 93, -1, 297,
- 298, 63, 300, 301, 302, 303, 304, -1, 287, 288,
- 289, 290, -1, -1, -1, -1, -1, -1, -1, 272,
- 273, 274, 275, -1, 303, 304, 305, 306, 281, 91,
- 309, -1, -1, 312, 313, 314, -1, -1, -1, -1,
- -1, -1, -1, -1, 297, 298, -1, 300, 301, 302,
- 303, 272, 273, 274, 275, -1, -1, -1, -1, -1,
- 281, 123, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, 297, 298, -1, 300,
- 301, 302, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, 272, 273, 274, 275, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, 272, 273, 274, 275, -1, 297, 298,
- -1, 300, -1, -1, -1, -1, -1, -1, 281, -1,
- -1, -1, -1, -1, 287, 288, 289, 290, 297, 298,
- 272, 273, 274, 275, -1, -1, -1, 300, 301, 302,
- 303, 304, 305, 306, -1, -1, 309, -1, -1, 312,
- 313, 314, -1, -1, -1, 297, 298, -1, -1, -1,
- -1, -1, -1, -1, 30, -1, 272, 273, 274, 275,
- -1, -1, 38, -1, -1, -1, 42, -1, -1, 45,
- -1, -1, -1, -1, -1, -1, 52, 53, 54, 55,
- 56, 297, 298, 59, 60, -1, -1, -1, -1, -1,
- 66, -1, -1, -1, -1, -1, -1, -1, -1, 281,
+ 272, 273, 274, 275, -1, 41, -1, 279, 44, 281,
-1, -1, -1, -1, -1, 287, 288, 289, 290, -1,
- -1, -1, -1, -1, -1, -1, -1, 93, -1, 301,
+ -1, 93, 58, 59, -1, 297, 298, 63, 300, 301,
302, 303, 304, 305, 306, -1, -1, 309, -1, -1,
- 312, 313, 314, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, 150, 151, 152, 153, 154, 155,
- 156, 157, 158, 159, 160, 161, 162, 163, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, -1, 175,
+ -1, -1, -1, 272, 273, 274, 275, -1, 41, -1,
+ 279, 44, 281, -1, -1, -1, -1, 93, 287, 288,
+ 289, 290, -1, -1, -1, 58, 59, -1, 297, 298,
+ 63, 300, 301, 302, 303, 304, 305, 306, -1, -1,
+ -1, 272, 273, 274, 275, -1, 41, -1, 279, 44,
+ 281, -1, -1, -1, -1, -1, 287, 288, 289, 290,
+ 93, -1, -1, 58, 59, -1, 297, 298, 63, 300,
+ 301, 302, 303, 304, 305, 306, -1, -1, -1, 272,
+ 273, 274, 275, -1, 41, -1, 279, 44, 281, -1,
+ -1, -1, -1, -1, 287, 288, 289, 290, 93, -1,
+ -1, 58, 59, -1, 297, 298, 63, 300, 301, 302,
+ 303, 304, 305, 306, -1, -1, -1, -1, -1, -1,
+ -1, -1, 272, 273, 274, 275, -1, 41, -1, 279,
+ 44, 281, -1, -1, -1, -1, 93, 287, 288, 289,
+ 290, -1, -1, -1, 58, 59, -1, 297, 298, 63,
+ 300, 301, 302, 303, 304, 305, 306, -1, -1, -1,
+ 272, 273, 274, 275, -1, 41, -1, 279, 44, 281,
+ -1, -1, -1, -1, -1, 287, 288, 289, 290, 93,
+ -1, -1, 58, 59, -1, 297, 298, 63, 300, 301,
+ 302, 303, 304, 305, 306, -1, 272, 273, 274, 275,
+ -1, 41, -1, 279, 44, 281, -1, -1, -1, -1,
+ -1, 287, 288, 289, 290, -1, -1, 93, 58, 59,
+ -1, 297, 298, 63, 300, 301, 302, 303, 304, 305,
+ 306, -1, -1, -1, -1, -1, -1, -1, -1, 272,
+ 273, 274, 275, -1, 41, -1, 279, 44, 281, -1,
+ -1, -1, -1, 93, 287, 288, 289, 290, -1, -1,
+ -1, 58, 59, -1, 297, 298, 63, 300, 301, 302,
+ 303, 304, 305, 306, -1, -1, -1, 272, 273, 274,
+ 275, -1, 41, -1, 279, 44, 281, -1, -1, -1,
+ -1, -1, 287, 288, 289, 290, 93, -1, -1, 58,
+ 59, -1, 297, 298, 63, 300, 301, 302, 303, 304,
+ 305, -1, -1, -1, -1, 272, 273, 274, 275, -1,
+ 41, -1, 279, 44, 281, -1, -1, -1, -1, -1,
+ 287, 288, -1, 290, 93, -1, -1, 58, 59, -1,
+ 297, 298, 63, 300, 301, 302, 303, 304, 305, -1,
+ 91, -1, -1, -1, -1, -1, -1, -1, 272, 273,
+ 274, 275, -1, 41, -1, 279, 44, 281, -1, -1,
+ -1, -1, 93, 287, 288, -1, -1, -1, -1, -1,
+ 58, 59, 123, 297, 298, 63, 300, 301, 302, 303,
+ 304, 305, -1, -1, -1, -1, 272, 273, 274, 275,
+ -1, 41, -1, 279, 44, 281, -1, -1, -1, -1,
+ -1, 287, 288, 41, -1, 93, 44, -1, 58, 59,
+ -1, 297, 298, 63, 300, 301, 302, 303, 304, -1,
+ 58, 59, 272, 273, 274, 275, -1, -1, -1, 279,
+ -1, 281, -1, -1, -1, -1, -1, 287, 288, -1,
+ -1, -1, -1, 93, -1, -1, 41, 297, 298, 44,
+ 300, 301, 302, 303, 304, 93, -1, -1, -1, 41,
+ -1, -1, 44, 58, 59, 272, 273, 274, 275, -1,
+ -1, -1, 279, -1, 281, -1, 58, 59, -1, -1,
+ 287, 288, -1, -1, -1, -1, 63, -1, -1, -1,
+ 297, 298, -1, 300, 301, 302, 303, 304, 93, -1,
+ -1, -1, -1, 272, 273, 274, 275, -1, -1, -1,
+ 279, 93, 281, -1, 91, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, 297, 298,
+ -1, 300, 301, 302, 303, -1, 287, 288, 289, 290,
+ -1, 272, 273, 274, 275, -1, 123, -1, 279, -1,
+ 281, -1, 303, 304, 305, 306, -1, -1, 309, -1,
+ -1, 312, 313, 314, -1, -1, 297, 298, -1, 300,
+ 301, 302, 63, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, 272, 273, 274, 275, -1, -1,
+ -1, 279, -1, 281, -1, -1, -1, -1, -1, -1,
+ 91, -1, -1, -1, -1, -1, -1, -1, -1, 297,
+ 298, -1, 300, 301, -1, -1, -1, -1, -1, -1,
+ -1, -1, 272, 273, 274, 275, -1, -1, -1, 279,
+ -1, -1, 123, -1, 272, 273, 274, 275, -1, -1,
+ -1, 279, -1, -1, -1, -1, 30, 297, 298, -1,
+ 300, -1, -1, -1, 38, -1, -1, -1, 42, 297,
+ 298, 45, -1, -1, -1, -1, -1, -1, 52, 53,
+ 54, 55, 56, -1, -1, 59, 60, 272, 273, 274,
+ 275, -1, 66, -1, 279, -1, -1, -1, -1, -1,
+ 272, 273, 274, 275, -1, -1, -1, 279, -1, -1,
+ -1, -1, 297, 298, 281, -1, -1, -1, -1, 93,
+ 287, 288, 289, 290, -1, 297, 298, -1, -1, -1,
+ -1, -1, -1, 300, 301, 302, 303, 304, 305, 306,
+ -1, -1, 309, -1, -1, 312, 313, 314, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, 151, 152, 153,
+ 154, 155, 156, 157, 158, 159, 160, 161, 162, 163,
+ 164, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ 281, -1, 176, -1, -1, -1, 287, 288, 289, 290,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ 301, 302, 303, 304, 305, 306, -1, -1, 309, -1,
+ -1, 312, 313, 314, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, 253, -1, -1,
+ -1, 255, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, 284,
+ -1, -1, 286,
};
#define YYFINAL 1
#ifndef YYDEBUG
@@ -1106,6 +1103,7 @@ char *yyrule[] = {
"sideff : expr UNLESS expr",
"sideff : expr WHILE expr",
"sideff : expr UNTIL iexpr",
+"sideff : expr FOR expr",
"else :",
"else : ELSE mblock",
"else : ELSIF '(' mexpr ')' mblock else",
@@ -1278,15 +1276,19 @@ char *yyrule[] = {
#define YYMAXDEPTH 500
#endif
#endif
+#ifndef PERL_OBJECT
int yydebug;
int yynerrs;
int yyerrflag;
int yychar;
+short *yyssp;
+YYSTYPE *yyvsp;
YYSTYPE yyval;
YYSTYPE yylval;
-#line 631 "perly.y"
+#endif
+#line 643 "perly.y"
/* PROGRAM */
-#line 1360 "perly.c"
+#line 1353 "perly.c"
#define YYABORT goto yyabort
#define YYACCEPT goto yyaccept
#define YYERROR goto yyerrlab
@@ -1303,8 +1305,7 @@ struct ysv {
};
void
-yydestruct(ptr)
-void* ptr;
+yydestruct(void *ptr)
{
struct ysv* ysave = (struct ysv*)ptr;
if (ysave->yyss) Safefree(ysave->yyss);
@@ -1319,7 +1320,7 @@ void* ptr;
}
int
-yyparse()
+yyparse(void)
{
register int yym, yyn, yystate;
register short *yyssp;
@@ -1330,10 +1331,13 @@ yyparse()
int retval = 0;
#if YYDEBUG
register char *yys;
+#ifndef __cplusplus
extern char *getenv();
#endif
+#endif
- struct ysv *ysave = (struct ysv*)safemalloc(sizeof(struct ysv));
+ struct ysv *ysave;
+ New(73, ysave, 1, struct ysv);
SAVEDESTRUCTOR(yydestruct, ysave);
ysave->oldyydebug = yydebug;
ysave->oldyynerrs = yynerrs;
@@ -1358,8 +1362,10 @@ yyparse()
/*
** Initialize private stacks (yyparse may be called from an action)
*/
- ysave->yyss = yyss = (short*)safemalloc(yystacksize*sizeof(short));
- ysave->yyvs = yyvs = (YYSTYPE*)safemalloc(yystacksize*sizeof(YYSTYPE));
+ New(73, yyss, yystacksize, short);
+ New(73, yyvs, yystacksize, YYSTYPE);
+ ysave->yyss = yyss;
+ ysave->yyvs = yyvs;
if (!yyvs || !yyss)
goto yyoverflow;
@@ -1401,9 +1407,9 @@ yyloop:
int yypv_index = (yyvsp - yyvs);
yystacksize += YYSTACKSIZE;
ysave->yyvs = yyvs =
- (YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
+ (YYSTYPE*)PerlMem_realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
ysave->yyss = yyss =
- (short*)realloc((char*)yyss,yystacksize * sizeof(short));
+ (short*)PerlMem_realloc((char*)yyss,yystacksize * sizeof(short));
if (!yyvs || !yyss)
goto yyoverflow;
yyssp = yyss + yyps_index;
@@ -1456,9 +1462,9 @@ yyinrecovery:
int yyps_index = (yyssp - yyss);
int yypv_index = (yyvsp - yyvs);
yystacksize += YYSTACKSIZE;
- ysave->yyvs = yyvs = (YYSTYPE*)realloc((char*)yyvs,
+ ysave->yyvs = yyvs = (YYSTYPE*)PerlMem_realloc((char*)yyvs,
yystacksize * sizeof(YYSTYPE));
- ysave->yyss = yyss = (short*)realloc((char*)yyss,
+ ysave->yyss = yyss = (short*)PerlMem_realloc((char*)yyss,
yystacksize * sizeof(short));
if (!yyvs || !yyss)
goto yyoverflow;
@@ -1511,602 +1517,608 @@ yyreduce:
switch (yyn)
{
case 1:
-#line 86 "perly.y"
+#line 94 "perly.y"
{
#if defined(YYDEBUG) && defined(DEBUGGING)
- yydebug = (debug & 1);
+ yydebug = (PL_debug & 1);
#endif
- expect = XSTATE;
+ PL_expect = XSTATE;
}
break;
case 2:
-#line 93 "perly.y"
+#line 101 "perly.y"
{ newPROG(yyvsp[0].opval); }
break;
case 3:
-#line 97 "perly.y"
-{ if (copline > (line_t)yyvsp[-3].ival)
- copline = yyvsp[-3].ival;
+#line 105 "perly.y"
+{ if (PL_copline > (line_t)yyvsp[-3].ival)
+ PL_copline = yyvsp[-3].ival;
yyval.opval = block_end(yyvsp[-2].ival, yyvsp[-1].opval); }
break;
case 4:
-#line 103 "perly.y"
+#line 111 "perly.y"
{ yyval.ival = block_start(TRUE); }
break;
case 5:
-#line 107 "perly.y"
-{ if (copline > (line_t)yyvsp[-3].ival)
- copline = yyvsp[-3].ival;
+#line 115 "perly.y"
+{ if (PL_copline > (line_t)yyvsp[-3].ival)
+ PL_copline = yyvsp[-3].ival;
yyval.opval = block_end(yyvsp[-2].ival, yyvsp[-1].opval); }
break;
case 6:
-#line 113 "perly.y"
+#line 121 "perly.y"
{ yyval.ival = block_start(FALSE); }
break;
case 7:
-#line 117 "perly.y"
+#line 125 "perly.y"
{ yyval.opval = Nullop; }
break;
case 8:
-#line 119 "perly.y"
+#line 127 "perly.y"
{ yyval.opval = yyvsp[-1].opval; }
break;
case 9:
-#line 121 "perly.y"
+#line 129 "perly.y"
{ yyval.opval = append_list(OP_LINESEQ,
(LISTOP*)yyvsp[-1].opval, (LISTOP*)yyvsp[0].opval);
- pad_reset_pending = TRUE;
- if (yyvsp[-1].opval && yyvsp[0].opval) hints |= HINT_BLOCK_SCOPE; }
+ PL_pad_reset_pending = TRUE;
+ if (yyvsp[-1].opval && yyvsp[0].opval) PL_hints |= HINT_BLOCK_SCOPE; }
break;
case 10:
-#line 128 "perly.y"
+#line 136 "perly.y"
{ yyval.opval = newSTATEOP(0, yyvsp[-1].pval, yyvsp[0].opval); }
break;
case 12:
-#line 131 "perly.y"
+#line 139 "perly.y"
{ if (yyvsp[-1].pval != Nullch) {
yyval.opval = newSTATEOP(0, yyvsp[-1].pval, newOP(OP_NULL, 0));
}
else {
yyval.opval = Nullop;
- copline = NOLINE;
+ PL_copline = NOLINE;
}
- expect = XSTATE; }
+ PL_expect = XSTATE; }
break;
case 13:
-#line 140 "perly.y"
+#line 148 "perly.y"
{ yyval.opval = newSTATEOP(0, yyvsp[-2].pval, yyvsp[-1].opval);
- expect = XSTATE; }
+ PL_expect = XSTATE; }
break;
case 14:
-#line 145 "perly.y"
+#line 153 "perly.y"
{ yyval.opval = Nullop; }
break;
case 15:
-#line 147 "perly.y"
+#line 155 "perly.y"
{ yyval.opval = yyvsp[0].opval; }
break;
case 16:
-#line 149 "perly.y"
+#line 157 "perly.y"
{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[0].opval, yyvsp[-2].opval); }
break;
case 17:
-#line 151 "perly.y"
+#line 159 "perly.y"
{ yyval.opval = newLOGOP(OP_OR, 0, yyvsp[0].opval, yyvsp[-2].opval); }
break;
case 18:
-#line 153 "perly.y"
+#line 161 "perly.y"
{ yyval.opval = newLOOPOP(OPf_PARENS, 1, scalar(yyvsp[0].opval), yyvsp[-2].opval); }
break;
case 19:
-#line 155 "perly.y"
+#line 163 "perly.y"
{ yyval.opval = newLOOPOP(OPf_PARENS, 1, yyvsp[0].opval, yyvsp[-2].opval);}
break;
case 20:
-#line 159 "perly.y"
-{ yyval.opval = Nullop; }
+#line 165 "perly.y"
+{ yyval.opval = newFOROP(0, Nullch, yyvsp[-1].ival,
+ Nullop, yyvsp[0].opval, yyvsp[-2].opval, Nullop); }
break;
case 21:
-#line 161 "perly.y"
-{ yyval.opval = scope(yyvsp[0].opval); }
+#line 170 "perly.y"
+{ yyval.opval = Nullop; }
break;
case 22:
-#line 163 "perly.y"
-{ copline = yyvsp[-5].ival;
+#line 172 "perly.y"
+{ yyval.opval = scope(yyvsp[0].opval); }
+break;
+case 23:
+#line 174 "perly.y"
+{ PL_copline = yyvsp[-5].ival;
yyval.opval = newSTATEOP(0, Nullch,
newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval));
- hints |= HINT_BLOCK_SCOPE; }
+ PL_hints |= HINT_BLOCK_SCOPE; }
break;
-case 23:
-#line 170 "perly.y"
-{ copline = yyvsp[-6].ival;
+case 24:
+#line 181 "perly.y"
+{ PL_copline = yyvsp[-6].ival;
yyval.opval = block_end(yyvsp[-4].ival,
newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); }
break;
-case 24:
-#line 174 "perly.y"
-{ copline = yyvsp[-6].ival;
+case 25:
+#line 185 "perly.y"
+{ PL_copline = yyvsp[-6].ival;
yyval.opval = block_end(yyvsp[-4].ival,
newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); }
break;
-case 25:
-#line 180 "perly.y"
+case 26:
+#line 191 "perly.y"
{ yyval.opval = Nullop; }
break;
-case 26:
-#line 182 "perly.y"
+case 27:
+#line 193 "perly.y"
{ yyval.opval = scope(yyvsp[0].opval); }
break;
-case 27:
-#line 186 "perly.y"
-{ copline = yyvsp[-6].ival;
+case 28:
+#line 197 "perly.y"
+{ PL_copline = yyvsp[-6].ival;
yyval.opval = block_end(yyvsp[-4].ival,
newSTATEOP(0, yyvsp[-7].pval,
newWHILEOP(0, 1, (LOOP*)Nullop,
yyvsp[-6].ival, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval))); }
break;
-case 28:
-#line 192 "perly.y"
-{ copline = yyvsp[-6].ival;
+case 29:
+#line 203 "perly.y"
+{ PL_copline = yyvsp[-6].ival;
yyval.opval = block_end(yyvsp[-4].ival,
newSTATEOP(0, yyvsp[-7].pval,
newWHILEOP(0, 1, (LOOP*)Nullop,
yyvsp[-6].ival, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval))); }
break;
-case 29:
-#line 198 "perly.y"
+case 30:
+#line 209 "perly.y"
{ yyval.opval = block_end(yyvsp[-6].ival,
newFOROP(0, yyvsp[-9].pval, yyvsp[-8].ival, yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); }
break;
-case 30:
-#line 201 "perly.y"
+case 31:
+#line 212 "perly.y"
{ yyval.opval = block_end(yyvsp[-4].ival,
newFOROP(0, yyvsp[-8].pval, yyvsp[-7].ival, mod(yyvsp[-6].opval, OP_ENTERLOOP),
yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); }
break;
-case 31:
-#line 205 "perly.y"
+case 32:
+#line 216 "perly.y"
{ yyval.opval = block_end(yyvsp[-4].ival,
newFOROP(0, yyvsp[-7].pval, yyvsp[-6].ival, Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); }
break;
-case 32:
-#line 209 "perly.y"
+case 33:
+#line 220 "perly.y"
{ OP *forop = append_elem(OP_LINESEQ,
scalar(yyvsp[-6].opval),
newWHILEOP(0, 1, (LOOP*)Nullop,
yyvsp[-9].ival, scalar(yyvsp[-4].opval),
yyvsp[0].opval, scalar(yyvsp[-2].opval)));
- copline = yyvsp[-9].ival;
+ PL_copline = yyvsp[-9].ival;
yyval.opval = block_end(yyvsp[-7].ival, newSTATEOP(0, yyvsp[-10].pval, forop)); }
break;
-case 33:
-#line 217 "perly.y"
+case 34:
+#line 228 "perly.y"
{ yyval.opval = newSTATEOP(0, yyvsp[-2].pval,
newWHILEOP(0, 1, (LOOP*)Nullop,
NOLINE, Nullop, yyvsp[-1].opval, yyvsp[0].opval)); }
break;
-case 34:
-#line 223 "perly.y"
+case 35:
+#line 234 "perly.y"
{ yyval.opval = Nullop; }
break;
-case 36:
-#line 228 "perly.y"
+case 37:
+#line 239 "perly.y"
{ (void)scan_num("1"); yyval.opval = yylval.opval; }
break;
-case 38:
-#line 233 "perly.y"
-{ yyval.opval = invert(scalar(yyvsp[0].opval)); }
-break;
case 39:
-#line 237 "perly.y"
-{ yyval.opval = yyvsp[0].opval; intro_my(); }
+#line 244 "perly.y"
+{ yyval.opval = invert(scalar(yyvsp[0].opval)); }
break;
case 40:
-#line 241 "perly.y"
+#line 248 "perly.y"
{ yyval.opval = yyvsp[0].opval; intro_my(); }
break;
case 41:
-#line 245 "perly.y"
+#line 252 "perly.y"
{ yyval.opval = yyvsp[0].opval; intro_my(); }
break;
case 42:
-#line 249 "perly.y"
+#line 256 "perly.y"
{ yyval.opval = yyvsp[0].opval; intro_my(); }
break;
case 43:
-#line 253 "perly.y"
-{ yyval.pval = Nullch; }
+#line 260 "perly.y"
+{ yyval.opval = yyvsp[0].opval; intro_my(); }
break;
-case 45:
-#line 258 "perly.y"
-{ yyval.ival = 0; }
+case 44:
+#line 264 "perly.y"
+{ yyval.pval = Nullch; }
break;
case 46:
-#line 260 "perly.y"
+#line 269 "perly.y"
{ yyval.ival = 0; }
break;
case 47:
-#line 262 "perly.y"
+#line 271 "perly.y"
{ yyval.ival = 0; }
break;
case 48:
-#line 264 "perly.y"
+#line 273 "perly.y"
{ yyval.ival = 0; }
break;
case 49:
-#line 268 "perly.y"
-{ newFORM(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); }
+#line 275 "perly.y"
+{ yyval.ival = 0; }
break;
case 50:
-#line 271 "perly.y"
-{ yyval.opval = yyvsp[0].opval; }
+#line 279 "perly.y"
+{ newFORM(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); }
break;
case 51:
-#line 272 "perly.y"
-{ yyval.opval = Nullop; }
+#line 282 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
break;
case 52:
-#line 276 "perly.y"
-{ newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, yyvsp[0].opval); }
+#line 283 "perly.y"
+{ yyval.opval = Nullop; }
break;
case 53:
-#line 280 "perly.y"
-{ yyval.ival = start_subparse(FALSE, 0); }
+#line 287 "perly.y"
+{ newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, yyvsp[0].opval); }
break;
case 54:
-#line 284 "perly.y"
-{ yyval.ival = start_subparse(FALSE, CVf_ANON); }
+#line 291 "perly.y"
+{ yyval.ival = start_subparse(FALSE, 0); }
break;
case 55:
-#line 288 "perly.y"
-{ yyval.ival = start_subparse(TRUE, 0); }
+#line 295 "perly.y"
+{ yyval.ival = start_subparse(FALSE, CVf_ANON); }
break;
case 56:
-#line 291 "perly.y"
-{ char *name = SvPVx(((SVOP*)yyvsp[0].opval)->op_sv, na);
- if (strEQ(name, "BEGIN") || strEQ(name, "END"))
- CvUNIQUE_on(compcv);
- yyval.opval = yyvsp[0].opval; }
+#line 299 "perly.y"
+{ yyval.ival = start_subparse(TRUE, 0); }
break;
case 57:
-#line 298 "perly.y"
-{ yyval.opval = Nullop; }
-break;
-case 59:
#line 302 "perly.y"
-{ yyval.opval = yyvsp[0].opval; }
+{ STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, n_a);
+ if (strEQ(name, "BEGIN") || strEQ(name, "END")
+ || strEQ(name, "INIT"))
+ CvSPECIAL_on(PL_compcv);
+ yyval.opval = yyvsp[0].opval; }
+break;
+case 58:
+#line 310 "perly.y"
+{ yyval.opval = Nullop; }
break;
case 60:
-#line 303 "perly.y"
-{ yyval.opval = Nullop; expect = XSTATE; }
+#line 314 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
break;
case 61:
-#line 307 "perly.y"
-{ package(yyvsp[-1].opval); }
+#line 315 "perly.y"
+{ yyval.opval = Nullop; PL_expect = XSTATE; }
break;
case 62:
-#line 309 "perly.y"
-{ package(Nullop); }
+#line 319 "perly.y"
+{ package(yyvsp[-1].opval); }
break;
case 63:
-#line 313 "perly.y"
-{ CvUNIQUE_on(compcv); /* It's a BEGIN {} */ }
+#line 321 "perly.y"
+{ package(Nullop); }
break;
case 64:
-#line 315 "perly.y"
-{ utilize(yyvsp[-6].ival, yyvsp[-5].ival, yyvsp[-3].opval, yyvsp[-2].opval, yyvsp[-1].opval); }
+#line 325 "perly.y"
+{ CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
break;
case 65:
-#line 319 "perly.y"
-{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); }
+#line 327 "perly.y"
+{ utilize(yyvsp[-6].ival, yyvsp[-5].ival, yyvsp[-3].opval, yyvsp[-2].opval, yyvsp[-1].opval); }
break;
case 66:
-#line 321 "perly.y"
+#line 331 "perly.y"
+{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); }
+break;
+case 67:
+#line 333 "perly.y"
{ yyval.opval = newLOGOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, yyvsp[0].opval); }
break;
-case 68:
-#line 326 "perly.y"
+case 69:
+#line 338 "perly.y"
{ yyval.opval = yyvsp[-1].opval; }
break;
-case 69:
-#line 328 "perly.y"
+case 70:
+#line 340 "perly.y"
{ yyval.opval = append_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval); }
break;
-case 71:
-#line 333 "perly.y"
+case 72:
+#line 345 "perly.y"
{ yyval.opval = convert(yyvsp[-2].ival, OPf_STACKED,
prepend_elem(OP_LIST, newGVREF(yyvsp[-2].ival,yyvsp[-1].opval), yyvsp[0].opval) ); }
break;
-case 72:
-#line 336 "perly.y"
+case 73:
+#line 348 "perly.y"
{ yyval.opval = convert(yyvsp[-4].ival, OPf_STACKED,
prepend_elem(OP_LIST, newGVREF(yyvsp[-4].ival,yyvsp[-2].opval), yyvsp[-1].opval) ); }
break;
-case 73:
-#line 339 "perly.y"
+case 74:
+#line 351 "perly.y"
{ yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
prepend_elem(OP_LIST, scalar(yyvsp[-5].opval), yyvsp[-1].opval),
newUNOP(OP_METHOD, 0, yyvsp[-3].opval))); }
break;
-case 74:
-#line 344 "perly.y"
+case 75:
+#line 356 "perly.y"
{ yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
prepend_elem(OP_LIST, yyvsp[-1].opval, yyvsp[0].opval),
newUNOP(OP_METHOD, 0, yyvsp[-2].opval))); }
break;
-case 75:
-#line 349 "perly.y"
+case 76:
+#line 361 "perly.y"
{ yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
prepend_elem(OP_LIST, yyvsp[-3].opval, yyvsp[-1].opval),
newUNOP(OP_METHOD, 0, yyvsp[-4].opval))); }
break;
-case 76:
-#line 354 "perly.y"
+case 77:
+#line 366 "perly.y"
{ yyval.opval = convert(yyvsp[-1].ival, 0, yyvsp[0].opval); }
break;
-case 77:
-#line 356 "perly.y"
+case 78:
+#line 368 "perly.y"
{ yyval.opval = convert(yyvsp[-3].ival, 0, yyvsp[-1].opval); }
break;
-case 78:
-#line 358 "perly.y"
+case 79:
+#line 370 "perly.y"
{ yyvsp[0].opval = newANONSUB(yyvsp[-1].ival, 0, yyvsp[0].opval); }
break;
-case 79:
-#line 360 "perly.y"
+case 80:
+#line 372 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
prepend_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval), yyvsp[-4].opval)); }
break;
-case 82:
-#line 370 "perly.y"
+case 83:
+#line 382 "perly.y"
{ yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[-1].ival, yyvsp[0].opval); }
break;
-case 83:
-#line 372 "perly.y"
+case 84:
+#line 384 "perly.y"
{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
-case 84:
-#line 374 "perly.y"
+case 85:
+#line 386 "perly.y"
{ if (yyvsp[-1].ival != OP_REPEAT)
scalar(yyvsp[-2].opval);
yyval.opval = newBINOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, scalar(yyvsp[0].opval)); }
break;
-case 85:
-#line 378 "perly.y"
-{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
-break;
case 86:
-#line 380 "perly.y"
+#line 390 "perly.y"
{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
case 87:
-#line 382 "perly.y"
+#line 392 "perly.y"
{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
case 88:
-#line 384 "perly.y"
+#line 394 "perly.y"
{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
case 89:
-#line 386 "perly.y"
+#line 396 "perly.y"
{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
case 90:
-#line 388 "perly.y"
+#line 398 "perly.y"
{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
case 91:
-#line 390 "perly.y"
-{ yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));}
+#line 400 "perly.y"
+{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
case 92:
-#line 392 "perly.y"
-{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); }
+#line 402 "perly.y"
+{ yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));}
break;
case 93:
-#line 394 "perly.y"
-{ yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); }
+#line 404 "perly.y"
+{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); }
break;
case 94:
-#line 396 "perly.y"
-{ yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); }
+#line 406 "perly.y"
+{ yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); }
break;
case 95:
-#line 398 "perly.y"
-{ yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); }
+#line 408 "perly.y"
+{ yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); }
break;
case 96:
-#line 401 "perly.y"
-{ yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); }
+#line 410 "perly.y"
+{ yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); }
break;
case 97:
-#line 403 "perly.y"
-{ yyval.opval = yyvsp[0].opval; }
+#line 413 "perly.y"
+{ yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); }
break;
case 98:
-#line 405 "perly.y"
-{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
+#line 415 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
break;
case 99:
-#line 407 "perly.y"
-{ yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));}
+#line 417 "perly.y"
+{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
break;
case 100:
-#line 409 "perly.y"
-{ yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); }
+#line 419 "perly.y"
+{ yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));}
break;
case 101:
-#line 411 "perly.y"
+#line 421 "perly.y"
+{ yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); }
+break;
+case 102:
+#line 423 "perly.y"
{ yyval.opval = newUNOP(OP_POSTINC, 0,
mod(scalar(yyvsp[-1].opval), OP_POSTINC)); }
break;
-case 102:
-#line 414 "perly.y"
+case 103:
+#line 426 "perly.y"
{ yyval.opval = newUNOP(OP_POSTDEC, 0,
mod(scalar(yyvsp[-1].opval), OP_POSTDEC)); }
break;
-case 103:
-#line 417 "perly.y"
+case 104:
+#line 429 "perly.y"
{ yyval.opval = newUNOP(OP_PREINC, 0,
mod(scalar(yyvsp[0].opval), OP_PREINC)); }
break;
-case 104:
-#line 420 "perly.y"
+case 105:
+#line 432 "perly.y"
{ yyval.opval = newUNOP(OP_PREDEC, 0,
mod(scalar(yyvsp[0].opval), OP_PREDEC)); }
break;
-case 105:
-#line 423 "perly.y"
-{ yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); }
-break;
case 106:
-#line 425 "perly.y"
-{ yyval.opval = sawparens(yyvsp[-1].opval); }
+#line 435 "perly.y"
+{ yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); }
break;
case 107:
-#line 427 "perly.y"
-{ yyval.opval = sawparens(newNULLLIST()); }
+#line 437 "perly.y"
+{ yyval.opval = sawparens(yyvsp[-1].opval); }
break;
case 108:
-#line 429 "perly.y"
-{ yyval.opval = newANONLIST(yyvsp[-1].opval); }
+#line 439 "perly.y"
+{ yyval.opval = sawparens(newNULLLIST()); }
break;
case 109:
-#line 431 "perly.y"
-{ yyval.opval = newANONLIST(Nullop); }
+#line 441 "perly.y"
+{ yyval.opval = newANONLIST(yyvsp[-1].opval); }
break;
case 110:
-#line 433 "perly.y"
-{ yyval.opval = newANONHASH(yyvsp[-2].opval); }
+#line 443 "perly.y"
+{ yyval.opval = newANONLIST(Nullop); }
break;
case 111:
-#line 435 "perly.y"
-{ yyval.opval = newANONHASH(Nullop); }
+#line 445 "perly.y"
+{ yyval.opval = newANONHASH(yyvsp[-2].opval); }
break;
case 112:
-#line 437 "perly.y"
-{ yyval.opval = newANONSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); }
+#line 447 "perly.y"
+{ yyval.opval = newANONHASH(Nullop); }
break;
case 113:
-#line 439 "perly.y"
-{ yyval.opval = yyvsp[0].opval; }
+#line 449 "perly.y"
+{ yyval.opval = newANONSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); }
break;
case 114:
-#line 441 "perly.y"
-{ yyval.opval = newBINOP(OP_GELEM, 0, newGVREF(0,yyvsp[-4].opval), yyvsp[-2].opval); }
+#line 451 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
break;
case 115:
-#line 443 "perly.y"
-{ yyval.opval = yyvsp[0].opval; }
+#line 453 "perly.y"
+{ yyval.opval = newBINOP(OP_GELEM, 0, yyvsp[-4].opval, scalar(yyvsp[-2].opval)); }
break;
case 116:
-#line 445 "perly.y"
-{ yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); }
+#line 455 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
break;
case 117:
-#line 447 "perly.y"
+#line 457 "perly.y"
+{ yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); }
+break;
+case 118:
+#line 459 "perly.y"
{ yyval.opval = newBINOP(OP_AELEM, 0,
ref(newAVREF(yyvsp[-4].opval),OP_RV2AV),
scalar(yyvsp[-1].opval));}
break;
-case 118:
-#line 451 "perly.y"
+case 119:
+#line 463 "perly.y"
{ assertref(yyvsp[-3].opval); yyval.opval = newBINOP(OP_AELEM, 0,
ref(newAVREF(yyvsp[-3].opval),OP_RV2AV),
scalar(yyvsp[-1].opval));}
break;
-case 119:
-#line 455 "perly.y"
-{ yyval.opval = yyvsp[0].opval; }
-break;
case 120:
-#line 457 "perly.y"
+#line 467 "perly.y"
{ yyval.opval = yyvsp[0].opval; }
break;
case 121:
-#line 459 "perly.y"
-{ yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));}
+#line 469 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
break;
case 122:
-#line 461 "perly.y"
-{ yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval));
- expect = XOPERATOR; }
+#line 471 "perly.y"
+{ yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));}
break;
case 123:
-#line 464 "perly.y"
+#line 473 "perly.y"
+{ yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval));
+ PL_expect = XOPERATOR; }
+break;
+case 124:
+#line 476 "perly.y"
{ yyval.opval = newBINOP(OP_HELEM, 0,
ref(newHVREF(yyvsp[-5].opval),OP_RV2HV),
jmaybe(yyvsp[-2].opval));
- expect = XOPERATOR; }
+ PL_expect = XOPERATOR; }
break;
-case 124:
-#line 469 "perly.y"
+case 125:
+#line 481 "perly.y"
{ assertref(yyvsp[-4].opval); yyval.opval = newBINOP(OP_HELEM, 0,
ref(newHVREF(yyvsp[-4].opval),OP_RV2HV),
jmaybe(yyvsp[-2].opval));
- expect = XOPERATOR; }
+ PL_expect = XOPERATOR; }
break;
-case 125:
-#line 474 "perly.y"
+case 126:
+#line 486 "perly.y"
{ yyval.opval = newSLICEOP(0, yyvsp[-1].opval, yyvsp[-4].opval); }
break;
-case 126:
-#line 476 "perly.y"
+case 127:
+#line 488 "perly.y"
{ yyval.opval = newSLICEOP(0, yyvsp[-1].opval, Nullop); }
break;
-case 127:
-#line 478 "perly.y"
+case 128:
+#line 490 "perly.y"
{ yyval.opval = prepend_elem(OP_ASLICE,
newOP(OP_PUSHMARK, 0),
newLISTOP(OP_ASLICE, 0,
list(yyvsp[-1].opval),
ref(yyvsp[-3].opval, OP_ASLICE))); }
break;
-case 128:
-#line 484 "perly.y"
+case 129:
+#line 496 "perly.y"
{ yyval.opval = prepend_elem(OP_HSLICE,
newOP(OP_PUSHMARK, 0),
newLISTOP(OP_HSLICE, 0,
list(yyvsp[-2].opval),
ref(oopsHV(yyvsp[-4].opval), OP_HSLICE)));
- expect = XOPERATOR; }
+ PL_expect = XOPERATOR; }
break;
-case 129:
-#line 491 "perly.y"
+case 130:
+#line 503 "perly.y"
{ yyval.opval = yyvsp[0].opval; }
break;
-case 130:
-#line 493 "perly.y"
+case 131:
+#line 505 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); }
break;
-case 131:
-#line 495 "perly.y"
+case 132:
+#line 507 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[-2].opval)); }
break;
-case 132:
-#line 497 "perly.y"
+case 133:
+#line 509 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, yyvsp[-1].opval, scalar(yyvsp[-3].opval))); }
break;
-case 133:
-#line 500 "perly.y"
+case 134:
+#line 512 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
break;
-case 134:
-#line 503 "perly.y"
-{ yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); }
-break;
case 135:
-#line 505 "perly.y"
-{ yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); }
+#line 515 "perly.y"
+{ yyval.opval = dofile(yyvsp[0].opval); }
break;
case 136:
-#line 507 "perly.y"
+#line 517 "perly.y"
+{ yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); }
+break;
+case 137:
+#line 519 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB,
OPf_SPECIAL|OPf_STACKED,
prepend_elem(OP_LIST,
@@ -2115,8 +2127,8 @@ case 136:
scalar(yyvsp[-2].opval)
)),Nullop)); dep();}
break;
-case 137:
-#line 515 "perly.y"
+case 138:
+#line 527 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB,
OPf_SPECIAL|OPf_STACKED,
append_elem(OP_LIST,
@@ -2126,162 +2138,162 @@ case 137:
scalar(yyvsp[-3].opval)
)))); dep();}
break;
-case 138:
-#line 524 "perly.y"
+case 139:
+#line 536 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
prepend_elem(OP_LIST,
scalar(newCVREF(0,scalar(yyvsp[-2].opval))), Nullop)); dep();}
break;
-case 139:
-#line 528 "perly.y"
+case 140:
+#line 540 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
prepend_elem(OP_LIST,
yyvsp[-1].opval,
scalar(newCVREF(0,scalar(yyvsp[-3].opval))))); dep();}
break;
-case 140:
-#line 533 "perly.y"
+case 141:
+#line 545 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
newCVREF(0, scalar(yyvsp[-3].opval))); }
break;
-case 141:
-#line 536 "perly.y"
+case 142:
+#line 548 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, yyvsp[-1].opval,
newCVREF(0, scalar(yyvsp[-4].opval)))); }
break;
-case 142:
-#line 540 "perly.y"
-{ yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL);
- hints |= HINT_BLOCK_SCOPE; }
-break;
case 143:
-#line 543 "perly.y"
-{ yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); }
+#line 552 "perly.y"
+{ yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL);
+ PL_hints |= HINT_BLOCK_SCOPE; }
break;
case 144:
-#line 545 "perly.y"
-{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
+#line 555 "perly.y"
+{ yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); }
break;
case 145:
-#line 547 "perly.y"
-{ yyval.opval = newOP(yyvsp[0].ival, 0); }
+#line 557 "perly.y"
+{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
break;
case 146:
-#line 549 "perly.y"
-{ yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
+#line 559 "perly.y"
+{ yyval.opval = newOP(yyvsp[0].ival, 0); }
break;
case 147:
-#line 551 "perly.y"
+#line 561 "perly.y"
{ yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
break;
case 148:
-#line 553 "perly.y"
+#line 563 "perly.y"
+{ yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
+break;
+case 149:
+#line 565 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
break;
-case 149:
-#line 556 "perly.y"
+case 150:
+#line 568 "perly.y"
{ yyval.opval = newOP(yyvsp[0].ival, 0); }
break;
-case 150:
-#line 558 "perly.y"
+case 151:
+#line 570 "perly.y"
{ yyval.opval = newOP(yyvsp[-2].ival, 0); }
break;
-case 151:
-#line 560 "perly.y"
+case 152:
+#line 572 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
scalar(yyvsp[0].opval)); }
break;
-case 152:
-#line 563 "perly.y"
+case 153:
+#line 575 "perly.y"
{ yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); }
break;
-case 153:
-#line 565 "perly.y"
+case 154:
+#line 577 "perly.y"
{ yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); }
break;
-case 154:
-#line 567 "perly.y"
+case 155:
+#line 579 "perly.y"
{ yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); }
break;
-case 155:
-#line 569 "perly.y"
+case 156:
+#line 581 "perly.y"
{ yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); }
break;
-case 158:
-#line 575 "perly.y"
-{ yyval.opval = Nullop; }
-break;
case 159:
-#line 577 "perly.y"
-{ yyval.opval = yyvsp[0].opval; }
+#line 587 "perly.y"
+{ yyval.opval = Nullop; }
break;
case 160:
-#line 581 "perly.y"
-{ yyval.opval = Nullop; }
+#line 589 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
break;
case 161:
-#line 583 "perly.y"
-{ yyval.opval = yyvsp[0].opval; }
+#line 593 "perly.y"
+{ yyval.opval = Nullop; }
break;
case 162:
-#line 585 "perly.y"
-{ yyval.opval = yyvsp[-1].opval; }
+#line 595 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
break;
case 163:
-#line 588 "perly.y"
-{ yyval.ival = 0; }
+#line 597 "perly.y"
+{ yyval.opval = yyvsp[-1].opval; }
break;
case 164:
-#line 589 "perly.y"
-{ yyval.ival = 1; }
+#line 600 "perly.y"
+{ yyval.ival = 0; }
break;
case 165:
-#line 593 "perly.y"
-{ in_my = 0; yyval.opval = my(yyvsp[0].opval); }
+#line 601 "perly.y"
+{ yyval.ival = 1; }
break;
case 166:
-#line 597 "perly.y"
-{ yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); }
+#line 605 "perly.y"
+{ PL_in_my = 0; yyval.opval = my(yyvsp[0].opval); }
break;
case 167:
-#line 601 "perly.y"
-{ yyval.opval = newSVREF(yyvsp[0].opval); }
+#line 609 "perly.y"
+{ yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); }
break;
case 168:
-#line 605 "perly.y"
-{ yyval.opval = newAVREF(yyvsp[0].opval); }
+#line 613 "perly.y"
+{ yyval.opval = newSVREF(yyvsp[0].opval); }
break;
case 169:
-#line 609 "perly.y"
-{ yyval.opval = newHVREF(yyvsp[0].opval); }
+#line 617 "perly.y"
+{ yyval.opval = newAVREF(yyvsp[0].opval); }
break;
case 170:
-#line 613 "perly.y"
-{ yyval.opval = newAVREF(yyvsp[0].opval); }
+#line 621 "perly.y"
+{ yyval.opval = newHVREF(yyvsp[0].opval); }
break;
case 171:
-#line 617 "perly.y"
-{ yyval.opval = newGVREF(0,yyvsp[0].opval); }
+#line 625 "perly.y"
+{ yyval.opval = newAVREF(yyvsp[0].opval); }
break;
case 172:
-#line 621 "perly.y"
-{ yyval.opval = scalar(yyvsp[0].opval); }
+#line 629 "perly.y"
+{ yyval.opval = newGVREF(0,yyvsp[0].opval); }
break;
case 173:
-#line 623 "perly.y"
-{ yyval.opval = scalar(yyvsp[0].opval); }
+#line 633 "perly.y"
+{ yyval.opval = scalar(yyvsp[0].opval); }
break;
case 174:
-#line 625 "perly.y"
-{ yyval.opval = scope(yyvsp[0].opval); }
+#line 635 "perly.y"
+{ yyval.opval = scalar(yyvsp[0].opval); }
break;
case 175:
-#line 628 "perly.y"
+#line 637 "perly.y"
+{ yyval.opval = scope(yyvsp[0].opval); }
+break;
+case 176:
+#line 640 "perly.y"
{ yyval.opval = yyvsp[0].opval; }
break;
-#line 2271 "perly.c"
+#line 2270 "perly.c"
}
yyssp -= yym;
yystate = *yyssp;
@@ -2336,9 +2348,9 @@ break;
int yypv_index = (yyvsp - yyvs);
yystacksize += YYSTACKSIZE;
ysave->yyvs = yyvs =
- (YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
+ (YYSTYPE*)PerlMem_realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
ysave->yyss = yyss =
- (short*)realloc((char*)yyss,yystacksize * sizeof(short));
+ (short*)PerlMem_realloc((char*)yyss,yystacksize * sizeof(short));
if (!yyvs || !yyss)
goto yyoverflow;
yyssp = yyss + yyps_index;
diff --git a/gnu/usr.bin/perl/perly.c.diff b/gnu/usr.bin/perl/perly.c.diff
deleted file mode 100644
index b4aec9d5981..00000000000
--- a/gnu/usr.bin/perl/perly.c.diff
+++ /dev/null
@@ -1,387 +0,0 @@
-Index: perly.c
-***************
-*** 13,82 ****
- }
-
-! #line 29 "perly.y"
-! typedef union {
-! I32 ival;
-! char *pval;
-! OP *opval;
-! GV *gvval;
-! } YYSTYPE;
-! #line 23 "y.tab.c"
-! #define WORD 257
-! #define METHOD 258
-! #define FUNCMETH 259
-! #define THING 260
-! #define PMFUNC 261
-! #define PRIVATEREF 262
-! #define FUNC0SUB 263
-! #define UNIOPSUB 264
-! #define LSTOPSUB 265
-! #define LABEL 266
-! #define FORMAT 267
-! #define SUB 268
-! #define ANONSUB 269
-! #define PACKAGE 270
-! #define USE 271
-! #define WHILE 272
-! #define UNTIL 273
-! #define IF 274
-! #define UNLESS 275
-! #define ELSE 276
-! #define ELSIF 277
-! #define CONTINUE 278
-! #define FOR 279
-! #define LOOPEX 280
-! #define DOTDOT 281
-! #define FUNC0 282
-! #define FUNC1 283
-! #define FUNC 284
-! #define UNIOP 285
-! #define LSTOP 286
-! #define RELOP 287
-! #define EQOP 288
-! #define MULOP 289
-! #define ADDOP 290
-! #define DOLSHARP 291
-! #define DO 292
-! #define HASHBRACK 293
-! #define NOAMP 294
-! #define LOCAL 295
-! #define MY 296
-! #define OROP 297
-! #define ANDOP 298
-! #define NOTOP 299
-! #define ASSIGNOP 300
-! #define OROR 301
-! #define ANDAND 302
-! #define BITOROP 303
-! #define BITANDOP 304
-! #define SHIFTOP 305
-! #define MATCHOP 306
-! #define UMINUS 307
-! #define REFGEN 308
-! #define POWOP 309
-! #define PREINC 310
-! #define PREDEC 311
-! #define POSTINC 312
-! #define POSTDEC 313
-! #define ARROW 314
- #define YYERRCODE 256
- short yylhs[] = { -1,
---- 13,17 ----
- }
-
-! #line 16 "perly.c"
- #define YYERRCODE 256
- short yylhs[] = { -1,
-***************
-*** 1348,1358 ****
- int yyerrflag;
- int yychar;
-- short *yyssp;
-- YYSTYPE *yyvsp;
- YYSTYPE yyval;
- YYSTYPE yylval;
-- short yyss[YYSTACKSIZE];
-- YYSTYPE yyvs[YYSTACKSIZE];
-- #define yystacksize YYSTACKSIZE
- #line 631 "perly.y"
- /* PROGRAM */
---- 1283,1288 ----
-***************
-*** 1361,1372 ****
---- 1291,1347 ----
- #define YYACCEPT goto yyaccept
- #define YYERROR goto yyerrlab
-+
-+ struct ysv {
-+ short* yyss;
-+ YYSTYPE* yyvs;
-+ int oldyydebug;
-+ int oldyynerrs;
-+ int oldyyerrflag;
-+ int oldyychar;
-+ YYSTYPE oldyyval;
-+ YYSTYPE oldyylval;
-+ };
-+
-+ void
-+ yydestruct(ptr)
-+ void* ptr;
-+ {
-+ struct ysv* ysave = (struct ysv*)ptr;
-+ if (ysave->yyss) Safefree(ysave->yyss);
-+ if (ysave->yyvs) Safefree(ysave->yyvs);
-+ yydebug = ysave->oldyydebug;
-+ yynerrs = ysave->oldyynerrs;
-+ yyerrflag = ysave->oldyyerrflag;
-+ yychar = ysave->oldyychar;
-+ yyval = ysave->oldyyval;
-+ yylval = ysave->oldyylval;
-+ Safefree(ysave);
-+ }
-+
- int
- yyparse()
- {
- register int yym, yyn, yystate;
-+ register short *yyssp;
-+ register YYSTYPE *yyvsp;
-+ short* yyss;
-+ YYSTYPE* yyvs;
-+ unsigned yystacksize = YYSTACKSIZE;
-+ int retval = 0;
- #if YYDEBUG
- register char *yys;
- extern char *getenv();
-+ #endif
-+
-+ struct ysv *ysave = (struct ysv*)safemalloc(sizeof(struct ysv));
-+ SAVEDESTRUCTOR(yydestruct, ysave);
-+ ysave->oldyydebug = yydebug;
-+ ysave->oldyynerrs = yynerrs;
-+ ysave->oldyyerrflag = yyerrflag;
-+ ysave->oldyychar = yychar;
-+ ysave->oldyyval = yyval;
-+ ysave->oldyylval = yylval;
-
-+ #if YYDEBUG
- if (yys = getenv("YYDEBUG"))
- {
-***************
-*** 1381,1384 ****
---- 1356,1367 ----
- yychar = (-1);
-
-+ /*
-+ ** Initialize private stacks (yyparse may be called from an action)
-+ */
-+ ysave->yyss = yyss = (short*)safemalloc(yystacksize*sizeof(short));
-+ ysave->yyvs = yyvs = (YYSTYPE*)safemalloc(yystacksize*sizeof(YYSTYPE));
-+ if (!yyvs || !yyss)
-+ goto yyoverflow;
-+
- yyssp = yyss;
- yyvsp = yyvs;
-***************
-*** 1396,1400 ****
- if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
- if (!yys) yys = "illegal-symbol";
-! printf("yydebug: state %d, reading %d (%s)\n", yystate,
- yychar, yys);
- }
---- 1379,1383 ----
- if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
- if (!yys) yys = "illegal-symbol";
-! fprintf(stderr, "yydebug: state %d, reading %d (%s)\n", yystate,
- yychar, yys);
- }
-***************
-*** 1406,1415 ****
- #if YYDEBUG
- if (yydebug)
-! printf("yydebug: state %d, shifting to state %d\n",
- yystate, yytable[yyn]);
- #endif
- if (yyssp >= yyss + yystacksize - 1)
- {
-! goto yyoverflow;
- }
- *++yyssp = yystate = yytable[yyn];
---- 1389,1412 ----
- #if YYDEBUG
- if (yydebug)
-! fprintf(stderr, "yydebug: state %d, shifting to state %d\n",
- yystate, yytable[yyn]);
- #endif
- if (yyssp >= yyss + yystacksize - 1)
- {
-! /*
-! ** reallocate and recover. Note that pointers
-! ** have to be reset, or bad things will happen
-! */
-! int yyps_index = (yyssp - yyss);
-! int yypv_index = (yyvsp - yyvs);
-! yystacksize += YYSTACKSIZE;
-! ysave->yyvs = yyvs =
-! (YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
-! ysave->yyss = yyss =
-! (short*)realloc((char*)yyss,yystacksize * sizeof(short));
-! if (!yyvs || !yyss)
-! goto yyoverflow;
-! yyssp = yyss + yyps_index;
-! yyvsp = yyvs + yypv_index;
- }
- *++yyssp = yystate = yytable[yyn];
-***************
-*** 1447,1456 ****
- #if YYDEBUG
- if (yydebug)
-! printf("yydebug: state %d, error recovery shifting\
-! to state %d\n", *yyssp, yytable[yyn]);
- #endif
- if (yyssp >= yyss + yystacksize - 1)
- {
-! goto yyoverflow;
- }
- *++yyssp = yystate = yytable[yyn];
---- 1444,1468 ----
- #if YYDEBUG
- if (yydebug)
-! fprintf(stderr,
-! "yydebug: state %d, error recovery shifting to state %d\n",
-! *yyssp, yytable[yyn]);
- #endif
- if (yyssp >= yyss + yystacksize - 1)
- {
-! /*
-! ** reallocate and recover. Note that pointers
-! ** have to be reset, or bad things will happen
-! */
-! int yyps_index = (yyssp - yyss);
-! int yypv_index = (yyvsp - yyvs);
-! yystacksize += YYSTACKSIZE;
-! ysave->yyvs = yyvs = (YYSTYPE*)realloc((char*)yyvs,
-! yystacksize * sizeof(YYSTYPE));
-! ysave->yyss = yyss = (short*)realloc((char*)yyss,
-! yystacksize * sizeof(short));
-! if (!yyvs || !yyss)
-! goto yyoverflow;
-! yyssp = yyss + yyps_index;
-! yyvsp = yyvs + yypv_index;
- }
- *++yyssp = yystate = yytable[yyn];
-***************
-*** 1462,1467 ****
- #if YYDEBUG
- if (yydebug)
-! printf("yydebug: error recovery discarding state %d\n",
-! *yyssp);
- #endif
- if (yyssp <= yyss) goto yyabort;
---- 1474,1480 ----
- #if YYDEBUG
- if (yydebug)
-! fprintf(stderr,
-! "yydebug: error recovery discarding state %d\n",
-! *yyssp);
- #endif
- if (yyssp <= yyss) goto yyabort;
-***************
-*** 1480,1485 ****
- if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
- if (!yys) yys = "illegal-symbol";
-! printf("yydebug: state %d, error recovery discards token %d (%s)\n",
-! yystate, yychar, yys);
- }
- #endif
---- 1493,1499 ----
- if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
- if (!yys) yys = "illegal-symbol";
-! fprintf(stderr,
-! "yydebug: state %d, error recovery discards token %d (%s)\n",
-! yystate, yychar, yys);
- }
- #endif
-***************
-*** 1490,1494 ****
- #if YYDEBUG
- if (yydebug)
-! printf("yydebug: state %d, reducing by rule %d (%s)\n",
- yystate, yyn, yyrule[yyn]);
- #endif
---- 1504,1508 ----
- #if YYDEBUG
- if (yydebug)
-! fprintf(stderr, "yydebug: state %d, reducing by rule %d (%s)\n",
- yystate, yyn, yyrule[yyn]);
- #endif
-***************
-*** 2278,2283 ****
- #if YYDEBUG
- if (yydebug)
-! printf("yydebug: after reduction, shifting from state 0 to\
-! state %d\n", YYFINAL);
- #endif
- yystate = YYFINAL;
---- 2292,2298 ----
- #if YYDEBUG
- if (yydebug)
-! fprintf(stderr,
-! "yydebug: after reduction, shifting from state 0 to state %d\n",
-! YYFINAL);
- #endif
- yystate = YYFINAL;
-***************
-*** 2293,2297 ****
- if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
- if (!yys) yys = "illegal-symbol";
-! printf("yydebug: state %d, reading %d (%s)\n",
- YYFINAL, yychar, yys);
- }
---- 2308,2312 ----
- if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
- if (!yys) yys = "illegal-symbol";
-! fprintf(stderr, "yydebug: state %d, reading %d (%s)\n",
- YYFINAL, yychar, yys);
- }
-***************
-*** 2308,2317 ****
- #if YYDEBUG
- if (yydebug)
-! printf("yydebug: after reduction, shifting from state %d \
-! to state %d\n", *yyssp, yystate);
- #endif
- if (yyssp >= yyss + yystacksize - 1)
- {
-! goto yyoverflow;
- }
- *++yyssp = yystate;
---- 2323,2347 ----
- #if YYDEBUG
- if (yydebug)
-! fprintf(stderr,
-! "yydebug: after reduction, shifting from state %d to state %d\n",
-! *yyssp, yystate);
- #endif
- if (yyssp >= yyss + yystacksize - 1)
- {
-! /*
-! ** reallocate and recover. Note that pointers
-! ** have to be reset, or bad things will happen
-! */
-! int yyps_index = (yyssp - yyss);
-! int yypv_index = (yyvsp - yyvs);
-! yystacksize += YYSTACKSIZE;
-! ysave->yyvs = yyvs =
-! (YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
-! ysave->yyss = yyss =
-! (short*)realloc((char*)yyss,yystacksize * sizeof(short));
-! if (!yyvs || !yyss)
-! goto yyoverflow;
-! yyssp = yyss + yyps_index;
-! yyvsp = yyvs + yypv_index;
- }
- *++yyssp = yystate;
-***************
-*** 2319,2326 ****
- goto yyloop;
- yyoverflow:
-! yyerror("yacc stack overflow");
- yyabort:
-! return (1);
- yyaccept:
-! return (0);
- }
---- 2349,2356 ----
- goto yyloop;
- yyoverflow:
-! yyerror("Out of memory for yacc stack");
- yyabort:
-! retval = 1;
- yyaccept:
-! return retval;
- }
diff --git a/gnu/usr.bin/perl/perly.fixer b/gnu/usr.bin/perl/perly.fixer
index 156881657f0..afe1a383cfa 100644
--- a/gnu/usr.bin/perl/perly.fixer
+++ b/gnu/usr.bin/perl/perly.fixer
@@ -21,8 +21,8 @@ tmp=/tmp/f$$
if grep 'yaccpar 1.8 (Berkeley)' $input >/dev/null 2>&1; then
cp $input $output
- if test -f perly.c.diff; then
- patch -F3 $output <perly.c.diff
+ if test -f perly_c.diff; then
+ patch -F3 $output <perly_c.diff
rm -rf $input
fi
exit
@@ -50,7 +50,7 @@ echo "Warning: the yacc you have used is not directly supported by perl."
echo "The perly.fixer script will attempt to make some changes to the generated"
echo "file. The changes may be incomplete and that might lead to problems later"
echo "(especially with complex scripts). You may need to apply the changes"
-echo "embedded in perl.fixer (and/or perly.c.dif*) by hand."
+echo "embedded in perl.fixer (and/or perly_c.dif*) by hand."
echo ""
# Below, we check for various characteristic yaccpar outputs.
@@ -105,8 +105,8 @@ short *maxyyps;
/yypv *= *&yyv\[ *-1 *\];/c\
\ if (!yyv) {\
-\ yyv = (YYSTYPE*) safemalloc(yymaxdepth * sizeof(YYSTYPE));\
-\ yys = (short*) safemalloc(yymaxdepth * sizeof(short));\
+\ New(73, yyv, yymaxdepth, YYSTYPE);\
+\ New(73, yys, yymaxdepth, short);\
\ if ( !yyv || !yys ) {\
\ yyerror( "out of memory" );\
\ return(1);\
@@ -123,10 +123,8 @@ short *maxyyps;
\ int ts = yyps - yys;\
\
\ yymaxdepth *= 2;\
-\ yyv = (YYSTYPE*)realloc((char*)yyv,\
-\ yymaxdepth*sizeof(YYSTYPE));\
-\ yys = (short*)realloc((char*)yys,\
-\ yymaxdepth*sizeof(short));\
+\ Renew(yyv, yymaxdepth, YYSTYPE);\
+\ Renew(yys, yymaxdepth, short);\
\ if ( !yyv || !yys ) {\
\ yyerror( "yacc stack overflow" );\
\ return(1);\
@@ -170,8 +168,8 @@ int *maxyyps;
/yypv *= *&yyv\[ *-1 *\];/c\
\ if (!yyv) {\
-\ yyv = (YYSTYPE*) safemalloc(yymaxdepth * sizeof(YYSTYPE));\
-\ yys = (int*) safemalloc(yymaxdepth * sizeof(int));\
+\ New(73, yyv, yymaxdepth, YYSTYPE);\
+\ New(73, yys, yymaxdepth, int);\
\ maxyyps = &yys[yymaxdepth];\
\ }\
\ yyps = &yys[-1];\
@@ -183,10 +181,8 @@ int *maxyyps;
\ int ts = yy_ps - yys;\
\
\ yymaxdepth *= 2;\
-\ yyv = (YYSTYPE*)realloc((char*)yyv,\
-\ yymaxdepth*sizeof(YYSTYPE));\
-\ yys = (int*)realloc((char*)yys,\
-\ yymaxdepth*sizeof(int));\
+\ Renew(yyv, yymaxdepth, YYSTYPE);\
+\ Renew(yys, yymaxdepth, int);\
\ yy_ps = yyps = yys + ts;\
\ yy_pv = yypv = yyv + tv;\
\ maxyyps = &yys[yymaxdepth];\
diff --git a/gnu/usr.bin/perl/perly.h b/gnu/usr.bin/perl/perly.h
index 99077270011..c1f7806e3f0 100644
--- a/gnu/usr.bin/perl/perly.h
+++ b/gnu/usr.bin/perl/perly.h
@@ -63,4 +63,3 @@ typedef union {
GV *gvval;
} YYSTYPE;
extern YYSTYPE yylval;
-extern YYSTYPE yylval;
diff --git a/gnu/usr.bin/perl/perly.y b/gnu/usr.bin/perl/perly.y
index 6313061934f..41c6acd6eec 100644
--- a/gnu/usr.bin/perl/perly.y
+++ b/gnu/usr.bin/perl/perly.y
@@ -1,6 +1,6 @@
/* perly.y
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -17,7 +17,7 @@
#include "perl.h"
static void
-dep()
+dep(void)
{
deprecate("\"do\" to call subroutines");
}
@@ -26,6 +26,10 @@ dep()
%start prog
+%{
+#ifndef OEMVS
+%}
+
%union {
I32 ival;
char *pval;
@@ -33,6 +37,10 @@ dep()
GV *gvval;
}
+%{
+#endif /* OEMVS */
+%}
+
%token <ival> '{' ')'
%token <opval> WORD METHOD FUNCMETH THING PMFUNC PRIVATEREF
@@ -85,17 +93,17 @@ dep()
prog : /* NULL */
{
#if defined(YYDEBUG) && defined(DEBUGGING)
- yydebug = (debug & 1);
+ yydebug = (PL_debug & 1);
#endif
- expect = XSTATE;
+ PL_expect = XSTATE;
}
/*CONTINUED*/ lineseq
{ newPROG($2); }
;
block : '{' remember lineseq '}'
- { if (copline > (line_t)$1)
- copline = $1;
+ { if (PL_copline > (line_t)$1)
+ PL_copline = $1;
$$ = block_end($2, $3); }
;
@@ -104,8 +112,8 @@ remember: /* NULL */ /* start a full lexical scope */
;
mblock : '{' mremember lineseq '}'
- { if (copline > (line_t)$1)
- copline = $1;
+ { if (PL_copline > (line_t)$1)
+ PL_copline = $1;
$$ = block_end($2, $3); }
;
@@ -120,8 +128,8 @@ lineseq : /* NULL */
| lineseq line
{ $$ = append_list(OP_LINESEQ,
(LISTOP*)$1, (LISTOP*)$2);
- pad_reset_pending = TRUE;
- if ($1 && $2) hints |= HINT_BLOCK_SCOPE; }
+ PL_pad_reset_pending = TRUE;
+ if ($1 && $2) PL_hints |= HINT_BLOCK_SCOPE; }
;
line : label cond
@@ -133,12 +141,12 @@ line : label cond
}
else {
$$ = Nullop;
- copline = NOLINE;
+ PL_copline = NOLINE;
}
- expect = XSTATE; }
+ PL_expect = XSTATE; }
| label sideff ';'
{ $$ = newSTATEOP(0, $1, $2);
- expect = XSTATE; }
+ PL_expect = XSTATE; }
;
sideff : error
@@ -153,6 +161,9 @@ sideff : error
{ $$ = newLOOPOP(OPf_PARENS, 1, scalar($3), $1); }
| expr UNTIL iexpr
{ $$ = newLOOPOP(OPf_PARENS, 1, $3, $1);}
+ | expr FOR expr
+ { $$ = newFOROP(0, Nullch, $2,
+ Nullop, $3, $1, Nullop); }
;
else : /* NULL */
@@ -160,18 +171,18 @@ else : /* NULL */
| ELSE mblock
{ $$ = scope($2); }
| ELSIF '(' mexpr ')' mblock else
- { copline = $1;
+ { PL_copline = $1;
$$ = newSTATEOP(0, Nullch,
newCONDOP(0, $3, scope($5), $6));
- hints |= HINT_BLOCK_SCOPE; }
+ PL_hints |= HINT_BLOCK_SCOPE; }
;
cond : IF '(' remember mexpr ')' mblock else
- { copline = $1;
+ { PL_copline = $1;
$$ = block_end($3,
newCONDOP(0, $4, scope($6), $7)); }
| UNLESS '(' remember miexpr ')' mblock else
- { copline = $1;
+ { PL_copline = $1;
$$ = block_end($3,
newCONDOP(0, $4, scope($6), $7)); }
;
@@ -183,13 +194,13 @@ cont : /* NULL */
;
loop : label WHILE '(' remember mtexpr ')' mblock cont
- { copline = $2;
+ { PL_copline = $2;
$$ = block_end($4,
newSTATEOP(0, $1,
newWHILEOP(0, 1, (LOOP*)Nullop,
$2, $5, $7, $8))); }
| label UNTIL '(' remember miexpr ')' mblock cont
- { copline = $2;
+ { PL_copline = $2;
$$ = block_end($4,
newSTATEOP(0, $1,
newWHILEOP(0, 1, (LOOP*)Nullop,
@@ -211,7 +222,7 @@ loop : label WHILE '(' remember mtexpr ')' mblock cont
newWHILEOP(0, 1, (LOOP*)Nullop,
$2, scalar($7),
$11, scalar($9)));
- copline = $2;
+ PL_copline = $2;
$$ = block_end($4, newSTATEOP(0, $1, forop)); }
| label block cont /* a block is a loop that happens once */
{ $$ = newSTATEOP(0, $1,
@@ -288,9 +299,10 @@ startformsub: /* NULL */ /* start a format subroutine scope */
{ $$ = start_subparse(TRUE, 0); }
;
-subname : WORD { char *name = SvPVx(((SVOP*)$1)->op_sv, na);
- if (strEQ(name, "BEGIN") || strEQ(name, "END"))
- CvUNIQUE_on(compcv);
+subname : WORD { STRLEN n_a; char *name = SvPV(((SVOP*)$1)->op_sv, n_a);
+ if (strEQ(name, "BEGIN") || strEQ(name, "END")
+ || strEQ(name, "INIT"))
+ CvSPECIAL_on(PL_compcv);
$$ = $1; }
;
@@ -300,7 +312,7 @@ proto : /* NULL */
;
subbody : block { $$ = $1; }
- | ';' { $$ = Nullop; expect = XSTATE; }
+ | ';' { $$ = Nullop; PL_expect = XSTATE; }
;
package : PACKAGE WORD ';'
@@ -310,7 +322,7 @@ package : PACKAGE WORD ';'
;
use : USE startsub
- { CvUNIQUE_on(compcv); /* It's a BEGIN {} */ }
+ { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
WORD WORD listexpr ';'
{ utilize($1, $2, $4, $5, $6); }
;
@@ -438,7 +450,7 @@ term : term ASSIGNOP term
| scalar %prec '('
{ $$ = $1; }
| star '{' expr ';' '}'
- { $$ = newBINOP(OP_GELEM, 0, newGVREF(0,$1), $3); }
+ { $$ = newBINOP(OP_GELEM, 0, $1, scalar($3)); }
| star %prec '('
{ $$ = $1; }
| scalar '[' expr ']' %prec '('
@@ -459,17 +471,17 @@ term : term ASSIGNOP term
{ $$ = newUNOP(OP_AV2ARYLEN, 0, ref($1, OP_AV2ARYLEN));}
| scalar '{' expr ';' '}' %prec '('
{ $$ = newBINOP(OP_HELEM, 0, oopsHV($1), jmaybe($3));
- expect = XOPERATOR; }
+ PL_expect = XOPERATOR; }
| term ARROW '{' expr ';' '}' %prec '('
{ $$ = newBINOP(OP_HELEM, 0,
ref(newHVREF($1),OP_RV2HV),
jmaybe($4));
- expect = XOPERATOR; }
+ PL_expect = XOPERATOR; }
| term '{' expr ';' '}' %prec '('
{ assertref($1); $$ = newBINOP(OP_HELEM, 0,
ref(newHVREF($1),OP_RV2HV),
jmaybe($3));
- expect = XOPERATOR; }
+ PL_expect = XOPERATOR; }
| '(' expr ')' '[' expr ']' %prec '('
{ $$ = newSLICEOP(0, $5, $2); }
| '(' ')' '[' expr ']' %prec '('
@@ -486,7 +498,7 @@ term : term ASSIGNOP term
newLISTOP(OP_HSLICE, 0,
list($3),
ref(oopsHV($1), OP_HSLICE)));
- expect = XOPERATOR; }
+ PL_expect = XOPERATOR; }
| THING %prec '('
{ $$ = $1; }
| amper
@@ -500,7 +512,7 @@ term : term ASSIGNOP term
{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, $3, scalar($2))); }
| DO term %prec UNIOP
- { $$ = newUNOP(OP_DOFILE, 0, scalar($2)); }
+ { $$ = dofile($2); }
| DO block %prec '('
{ $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2)); }
| DO WORD '(' ')'
@@ -538,7 +550,7 @@ term : term ASSIGNOP term
newCVREF(0, scalar($1)))); }
| LOOPEX
{ $$ = newOP($1, OPf_SPECIAL);
- hints |= HINT_BLOCK_SCOPE; }
+ PL_hints |= HINT_BLOCK_SCOPE; }
| LOOPEX term
{ $$ = newLOOPEX($1,$2); }
| NOTOP argexpr
@@ -590,7 +602,7 @@ local : LOCAL { $$ = 0; }
;
my_scalar: scalar
- { in_my = 0; $$ = my($1); }
+ { PL_in_my = 0; $$ = my($1); }
;
amper : '&' indirob
diff --git a/gnu/usr.bin/perl/plan9/config.plan9 b/gnu/usr.bin/perl/plan9/config.plan9
index 463c0942fbb..b35f60a93a6 100644
--- a/gnu/usr.bin/perl/plan9/config.plan9
+++ b/gnu/usr.bin/perl/plan9/config.plan9
@@ -365,6 +365,13 @@
*/
#undef HAS_ISASCII /**/
+/* 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_KILLPG:
* This symbol, if defined, indicates that the killpg routine is available
* to kill process groups. If unavailable, you probably should use kill
@@ -1144,12 +1151,17 @@
* This symbol, if defined, indicates to the C program that struct passwd
* contains pw_comment.
*/
+/* PWGECOS:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_gecos.
+ */
#define I_PWD /**/
#undef PWQUOTA /**/
#undef PWAGE /**/
#undef PWCHANGE /**/
#undef PWCLASS /**/
#undef PWEXPIRE /**/
+#define PWGECOS /**/
#undef PWCOMMENT /**/
/* I_STDDEF:
diff --git a/gnu/usr.bin/perl/plan9/plan9ish.h b/gnu/usr.bin/perl/plan9/plan9ish.h
index 3a5ad5eb1a3..06a30fee3a5 100644
--- a/gnu/usr.bin/perl/plan9/plan9ish.h
+++ b/gnu/usr.bin/perl/plan9/plan9ish.h
@@ -21,16 +21,16 @@
#define HAS_UTIME /**/
/* HAS_GROUP
- * This symbol, if defined, indicates that the getgrnam(),
- * getgrgid(), and getgrent() routines are available to
- * get group entries.
+ * This symbol, if defined, indicates that the getgrnam() and
+ * getgrgid() routines are available to get group entries.
+ * The getgrent() has a separate definition, HAS_GETGRENT.
*/
/*#define HAS_GROUP /**/
/* HAS_PASSWD
- * This symbol, if defined, indicates that the getpwnam(),
- * getpwuid(), and getpwent() routines are available to
- * get password entries.
+ * This symbol, if defined, indicates that the getpwnam() and
+ * getpwuid() routines are available to get password entries.
+ * The getpwent() has a separate definition, HAS_GETPWENT.
*/
/*#define HAS_PASSWD /**/
@@ -60,6 +60,14 @@
*/
#undef USEMYBINMODE
+/* Stat_t:
+ * This symbol holds the type used to declare buffers for information
+ * returned by stat(). It's usually just struct stat. It may be necessary
+ * to include <sys/stat.h> and <sys/types.h> to get any typedef'ed
+ * information.
+ */
+#define Stat_t struct stat
+
/* USE_STAT_RDEV:
* This symbol is defined if this system has a stat structure declaring
* st_rdev
@@ -98,9 +106,9 @@
#define ABORT() kill(getpid(),SIGABRT);
#define BIT_BUCKET "/dev/null"
-#define PERL_SYS_INIT(c,v)
+#define PERL_SYS_INIT(c,v) MALLOC_INIT
#define dXSUB_SYS
-#define PERL_SYS_TERM()
+#define PERL_SYS_TERM() MALLOC_TERM
/*
* fwrite1() should be a routine with the same calling sequence as fwrite(),
diff --git a/gnu/usr.bin/perl/pod/Makefile b/gnu/usr.bin/perl/pod/Makefile
index 7eeabd943b0..eb3fcfe7f93 100644
--- a/gnu/usr.bin/perl/pod/Makefile
+++ b/gnu/usr.bin/perl/pod/Makefile
@@ -8,24 +8,31 @@ POD2HTML = pod2html \
all: $(CONVERTERS) man
+converters: $(CONVERTERS)
+
PERL = ../miniperl
+REALPERL = ../perl
POD = \
perl.pod \
perldelta.pod \
+ perl5004delta.pod \
perldata.pod \
perlsyn.pod \
perlop.pod \
perlre.pod \
perlrun.pod \
perlfunc.pod \
+ perlopentut.pod \
perlvar.pod \
perlsub.pod \
perlmod.pod \
perlmodlib.pod \
+ perlmodinstall.pod \
perlform.pod \
perllocale.pod \
perlref.pod \
+ perlreftut.pod \
perldsc.pod \
perllol.pod \
perltoot.pod \
@@ -33,10 +40,12 @@ POD = \
perltie.pod \
perlbot.pod \
perlipc.pod \
+ perlthrtut.pod \
perldebug.pod \
perldiag.pod \
perlsec.pod \
perltrap.pod \
+ perlport.pod \
perlstyle.pod \
perlpod.pod \
perlbook.pod \
@@ -46,6 +55,7 @@ POD = \
perlxstut.pod \
perlguts.pod \
perlcall.pod \
+ perlhist.pod \
perlfaq.pod \
perlfaq1.pod \
perlfaq2.pod \
@@ -61,19 +71,23 @@ POD = \
MAN = \
perl.man \
perldelta.man \
+ perl5004delta.man \
perldata.man \
perlsyn.man \
perlop.man \
perlre.man \
perlrun.man \
perlfunc.man \
+ perlopentut.man \
perlvar.man \
perlsub.man \
perlmod.man \
perlmodlib.man \
+ perlmodinstall.man \
perlform.man \
perllocale.man \
perlref.man \
+ perlreftut.man \
perldsc.man \
perllol.man \
perltoot.man \
@@ -81,10 +95,12 @@ MAN = \
perltie.man \
perlbot.man \
perlipc.man \
+ perlthrtut.man \
perldebug.man \
perldiag.man \
perlsec.man \
perltrap.man \
+ perlport.man \
perlstyle.man \
perlpod.man \
perlbook.man \
@@ -94,6 +110,7 @@ MAN = \
perlxstut.man \
perlguts.man \
perlcall.man \
+ perlhist.man \
perlfaq.man \
perlfaq1.man \
perlfaq2.man \
@@ -109,19 +126,23 @@ MAN = \
HTML = \
perl.html \
perldelta.html \
+ perl5004delta.html \
perldata.html \
perlsyn.html \
perlop.html \
perlre.html \
perlrun.html \
perlfunc.html \
+ perlopentut.html \
perlvar.html \
perlsub.html \
perlmod.html \
perlmodlib.html \
+ perlmodinstall.html \
perlform.html \
perllocale.html \
perlref.html \
+ perlreftut.html \
perldsc.html \
perllol.html \
perltoot.html \
@@ -129,10 +150,12 @@ HTML = \
perltie.html \
perlbot.html \
perlipc.html \
+ perlthrtut.html \
perldebug.html \
perldiag.html \
perlsec.html \
perltrap.html \
+ perlport.html \
perlstyle.html \
perlpod.html \
perlbook.html \
@@ -142,6 +165,7 @@ HTML = \
perlxstut.html \
perlguts.html \
perlcall.html \
+ perlhist.html \
perlfaq.html \
perlfaq1.html \
perlfaq2.html \
@@ -157,19 +181,24 @@ HTML = \
TEX = \
perl.tex \
perldelta.tex \
+ perl5004delta.tex \
perldata.tex \
perlsyn.tex \
perlop.tex \
perlre.tex \
perlrun.tex \
perlfunc.tex \
+ perlopentut.tex \
perlvar.tex \
perlsub.tex \
perlmod.tex \
perlmodlib.tex \
+ perlmodinstall.tex \
perlform.tex \
perllocale.tex \
perlref.tex \
+ perlreftut.tex \
+ perlopentut.tex \
perldsc.tex \
perllol.tex \
perltoot.tex \
@@ -177,10 +206,12 @@ TEX = \
perltie.tex \
perlbot.tex \
perlipc.tex \
+ perlthrtut.tex \
perldebug.tex \
perldiag.tex \
perlsec.tex \
perltrap.tex \
+ perlport.tex \
perlstyle.tex \
perlpod.tex \
perlbook.tex \
@@ -190,6 +221,7 @@ TEX = \
perlxstut.tex \
perlguts.tex \
perlcall.tex \
+ perlhist.tex \
perlfaq.tex \
perlfaq1.tex \
perlfaq2.tex \
@@ -238,9 +270,11 @@ toc:
$(PERL) -I../lib pod2latex $*.pod
clean:
- rm -f $(MAN) $(HTML) $(TEX)
+ rm -f $(MAN)
+ rm -f $(HTML)
+ rm -f $(TEX)
rm -f pod2html-*cache
- rm -f *.aux *.log
+ rm -f *.aux *.log *.exe
realclean: clean
rm -f $(CONVERTERS)
@@ -267,4 +301,7 @@ pod2text: pod2text.PL ../lib/Config.pm
checkpods: checkpods.PL ../lib/Config.pm
$(PERL) -I ../lib checkpods.PL
+compile: all
+ $(REALPERL) -I../lib ../utils/perlcc -regex 's/$$/.exe/' pod2latex pod2man pod2text checkpods -prog -verbose dcf -log ../compilelog;
+
diff --git a/gnu/usr.bin/perl/pod/buildtoc b/gnu/usr.bin/perl/pod/buildtoc
index d657d68c848..a4b9d5aa9fc 100644
--- a/gnu/usr.bin/perl/pod/buildtoc
+++ b/gnu/usr.bin/perl/pod/buildtoc
@@ -6,12 +6,13 @@ sub output ($);
@pods = qw(
perl perlfaq perlfaq1 perlfaq2 perlfaq3 perlfaq4 perlfaq5
- perlfaq6 perlfaq7 perlfaq8 perlfaq9 perldelta perldata
- perlsyn perlop perlre perlrun perlfunc perlvar perlsub
- perlmod perlmodlib perlform perllocale perlref perldsc
- perllol perltoot perlobj perltie perlbot perlipc perldebug
- perldiag perlsec perltrap perlstyle perlpod perlbook
+ perlfaq6 perlfaq7 perlfaq8 perlfaq9 perldelta perldata perlopentut
+ perlsyn perlop perlre perlreftut perlrun perlfunc perlvar perlsub
+ perlmod perlmodlib perlmodinstall perlform perllocale perlref perldsc
+ perllol perltoot perlobj perltie perlthrtut perlbot perlipc perldebug
+ perldiag perlsec perltrap perlport perlstyle perlpod perlbook
perlembed perlapio perlxs perlxstut perlguts perlcall
+ perlhist
);
for (@pods) { s/$/.pod/ }
@@ -171,7 +172,7 @@ sub podset {
output $_; nl(); next;
}
- if (s/^=item (.*)\n/$1/) {
+ if (s/^=item ([^=].*)\n/$1/) {
next if $pod eq 'perldiag';
s/^\s*\*\s*$// && next;
s/^\s*\*\s*//;
diff --git a/gnu/usr.bin/perl/pod/checkpods.PL b/gnu/usr.bin/perl/pod/checkpods.PL
index ccd78ec9cf0..92b7ae6e4c1 100644
--- a/gnu/usr.bin/perl/pod/checkpods.PL
+++ b/gnu/usr.bin/perl/pod/checkpods.PL
@@ -2,6 +2,7 @@
use Config;
use File::Basename qw(&basename &dirname);
+use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
@@ -12,6 +13,7 @@ use File::Basename qw(&basename &dirname);
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
@@ -37,7 +39,7 @@ print OUT <<'!NO!SUBS!';
# From: Roderick Schertler <roderick@gate.net>
# To: perl5-porters@africa.nicoh.com
# Subject: POD lines with only spaces
-#
+#
# There are some places in the documentation where a POD directive is
# ignored because the line before it contains whitespace (and so the
# directive doesn't start a paragraph). This patch adds a way to check
@@ -53,18 +55,25 @@ print OUT <<'!NO!SUBS!';
# to grow. Someone will probably want to rewrite in terms of
# some sort of Pod::Checker module. Or something. Consider this
# a placeholder for the future.
-$exit = $last_blank = 0;
+# Version 1.02 Roderick Schertler <roderick@argon.org>
+# Check for pod directives following any kind of unempty line, not
+# just lines of whitespace.
+
+@directive = qw(head1 head2 item over back cut pod for begin end);
+@directive{@directive} = (1) x @directive;
+
+$exit = $last_unempty = 0;
while (<>) {
- chop;
- if (/^(=\S+)/ && $last_blank) {
- printf "%s: line %5d, Non-empty line preceeding directive %s\n",
+ chomp;
+ if (/^=(\S+)/ && $directive{$1} && $last_unempty) {
+ printf "%s: line %5d, no blank line preceeding directive =%s\n",
$ARGV, $., $1;
$exit = 1;
}
- $last_blank = /^\s+$/;
+ $last_unempty = ($_ ne '');
if (eof) {
close(ARGV);
- $last_blank = 0;
+ $last_unempty = 0;
}
}
exit $exit
@@ -73,3 +82,4 @@ exit $exit
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;
diff --git a/gnu/usr.bin/perl/pod/perl.pod b/gnu/usr.bin/perl/pod/perl.pod
index e989ebaacf4..6e218cd1f39 100644
--- a/gnu/usr.bin/perl/pod/perl.pod
+++ b/gnu/usr.bin/perl/pod/perl.pod
@@ -18,53 +18,62 @@ B<perl> S<[ B<-sTuU> ]>
For ease of access, the Perl manual has been split up into a number
of sections:
- perl Perl overview (this section)
- perldelta Perl changes since previous version
- perlfaq Perl frequently asked questions
-
- perldata Perl data structures
- perlsyn Perl syntax
- perlop Perl operators and precedence
- perlre Perl regular expressions
- perlrun Perl execution and options
- perlfunc Perl builtin functions
- perlvar Perl predefined variables
- perlsub Perl subroutines
- perlmod Perl modules: how they work
- perlmodlib Perl modules: how to write and use
- perlform Perl formats
- perllocale Perl locale support
-
- perlref Perl references
- perldsc Perl data structures intro
- perllol Perl data structures: lists of lists
- perltoot Perl OO tutorial
- perlobj Perl objects
- perltie Perl objects hidden behind simple variables
- perlbot Perl OO tricks and examples
- perlipc Perl interprocess communication
-
- perldebug Perl debugging
- perldiag Perl diagnostic messages
- perlsec Perl security
- perltrap Perl traps for the unwary
- perlstyle Perl style guide
-
- perlpod Perl plain old documentation
- perlbook Perl book information
-
- perlembed Perl ways to embed perl in your C or C++ application
- perlapio Perl internal IO abstraction interface
- perlxs Perl XS application programming interface
- perlxstut Perl XS tutorial
- perlguts Perl internal functions for those doing extensions
- perlcall Perl calling conventions from C
+ perl Perl overview (this section)
+ perldelta Perl changes since previous version
+ perl5004delta Perl changes in version 5.004
+ perlfaq Perl frequently asked questions
+ perltoc Perl documentation table of contents
+
+ perldata Perl data structures
+ perlsyn Perl syntax
+ perlop Perl operators and precedence
+ perlre Perl regular expressions
+ perlrun Perl execution and options
+ perlfunc Perl builtin functions
+ perlopentut Perl open() tutorial
+ perlvar Perl predefined variables
+ perlsub Perl subroutines
+ perlmod Perl modules: how they work
+ perlmodlib Perl modules: how to write and use
+ perlmodinstall Perl modules: how to install from CPAN
+ perlform Perl formats
+ perllocale Perl locale support
+
+ perlref Perl references
+ perlreftut Perl references short introduction
+ perldsc Perl data structures intro
+ perllol Perl data structures: lists of lists
+ perltoot Perl OO tutorial
+ perlobj Perl objects
+ perltie Perl objects hidden behind simple variables
+ perlbot Perl OO tricks and examples
+ perlipc Perl interprocess communication
+ perlthrtut Perl threads tutorial
+
+ perldebug Perl debugging
+ perldiag Perl diagnostic messages
+ perlsec Perl security
+ perltrap Perl traps for the unwary
+ perlport Perl portability guide
+ perlstyle Perl style guide
+
+ perlpod Perl plain old documentation
+ perlbook Perl book information
+
+ perlembed Perl ways to embed perl in your C or C++ application
+ perlapio Perl internal IO abstraction interface
+ perlxs Perl XS application programming interface
+ perlxstut Perl XS tutorial
+ perlguts Perl internal functions for those doing extensions
+ perlcall Perl calling conventions from C
+
+ perlhist Perl history records
(If you're intending to read these straight through for the first time,
the suggested order will tend to reduce the number of forward references.)
-By default, all of the above manpages are installed in the
-F</usr/local/man/> directory.
+By default, all of the above manpages are installed in the
+F</usr/local/man/> directory.
Extensive additional documentation for Perl modules is available. The
default configuration for perl will place this additional documentation
@@ -111,9 +120,9 @@ BASIC-PLUS.) Expression syntax corresponds quite closely to C
expression syntax. Unlike most Unix utilities, Perl does not
arbitrarily limit the size of your data--if you've got the memory,
Perl can slurp in your whole file as a single string. Recursion is of
-unlimited depth. And the tables used by hashes (previously called
+unlimited depth. And the tables used by hashes (sometimes called
"associative arrays") grow as necessary to prevent degraded
-performance. Perl uses sophisticated pattern matching techniques to
+performance. Perl can use sophisticated pattern matching techniques to
scan large amounts of data very quickly. Although optimized for
scanning text, Perl can also deal with binary data, and can make dbm
files look like hashes. Setuid Perl scripts are safer than C programs
@@ -234,6 +243,79 @@ optimized C code.
Okay, that's I<definitely> enough hype.
+=head1 AVAILABILITY
+
+Perl is available for the vast majority of operating system platforms,
+including most Unix-like platforms. The following situation is as of
+February 1999 and Perl 5.005_03.
+
+The following platforms are able to build Perl from the standard
+source code distribution available at
+F<http://www.perl.com/CPAN/src/index.html>
+
+ AIX Linux SCO ODT/OSR
+ A/UX MachTen Solaris
+ BeOS MPE/iX SunOS
+ BSD/OS NetBSD SVR4
+ DG/UX NextSTEP Tru64 UNIX 3)
+ DomainOS OpenBSD Ultrix
+ DOS DJGPP 1) OpenSTEP UNICOS
+ DYNIX/ptx OS/2 VMS
+ FreeBSD OS390 2) VOS
+ HP-UX PowerMAX Windows 3.1 1)
+ Hurd QNX Windows 95 1) 4)
+ IRIX Windows 98 1) 4)
+ Windows NT 1) 4)
+
+ 1) in DOS mode either the DOS or OS/2 ports can be used
+ 2) formerly known as MVS
+ 3) formerly known as Digital UNIX and before that DEC OSF/1
+ 4) compilers: Borland, Cygwin32, Mingw32 EGCS/GCC, VC++
+
+The following platforms have been known to build Perl from the source
+but for the Perl release 5.005_03 we haven't been able to verify them,
+either because the hardware/software platforms are rather rare or
+because we don't have an active champion on these platforms, or both.
+
+ 3b1 FPS Plan 9
+ AmigaOS GENIX PowerUX
+ ConvexOS Greenhills RISC/os
+ CX/UX ISC Stellar
+ DC/OSx MachTen 68k SVR2
+ DDE SMES MiNT TI1500
+ DOS EMX MPC TitanOS
+ Dynix NEWS-OS UNICOS/mk
+ EP/IX Opus Unisys Dynix
+ ESIX Unixware
+
+The following platforms are planned to be supported in the standard
+source code distribution of the Perl release 5.006 but are not
+supported in the Perl release 5.005_03:
+
+ BS2000
+ Netware
+ Rhapsody
+ VM/ESA
+
+The following platforms have their own source code distributions and
+binaries available via F<http://www.perl.com/CPAN/ports/index.html>.
+
+ Perl release
+
+ AS/400 5.003
+ MacOS 5.004
+ Netware 5.003_07
+ Tandem Guardian 5.004
+
+The following platforms have only binaries available via
+F<http://www.perl.com/CPAN/ports/index.html>.
+
+ Perl release
+
+ Acorn RISCOS 5.005_02
+ AOS 5.002
+ LynxOS 5.004_02
+
=head1 ENVIRONMENT
See L<perlrun>.
@@ -242,14 +324,13 @@ See L<perlrun>.
Larry Wall <F<larry@wall.org>>, with the help of oodles of other folks.
-If your Perl success stories and testimonials may be of help to others
-who wish to advocate the use of Perl in their applications,
-or if you wish to simply express your gratitude to Larry and the
+If your Perl success stories and testimonials may be of help to others
+who wish to advocate the use of Perl in their applications,
+or if you wish to simply express your gratitude to Larry and the
Perl developers, please write to <F<perl-thanks@perl.org>>.
=head1 FILES
- "/tmp/perl-e$$" temporary file for -e commands
"@INC" locations of perl libraries
=head1 SEE ALSO
@@ -262,7 +343,9 @@ Perl developers, please write to <F<perl-thanks@perl.org>>.
The B<-w> switch produces some lovely diagnostics.
-See L<perldiag> for explanations of all Perl's diagnostics.
+See L<perldiag> for explanations of all Perl's diagnostics. The C<use
+diagnostics> pragma automatically turns Perl's normally terse warnings
+and errors into these longer forms.
Compilation errors will tell you the line number of the error, with an
indication of the next token or token type that was to be examined.
@@ -289,9 +372,10 @@ and syswrite().)
While none of the built-in data types have any arbitrary size limits
(apart from memory size), there are still a few arbitrary limits: a
-given variable name may not be longer than 255 characters, and no
-component of your PATH may be longer than 255 if you use B<-S>. A regular
-expression may not compile to more than 32767 bytes internally.
+given variable name may not be longer than 251 characters. Line numbers
+displayed by diagnostics are internally stored as short integers,
+so they are limited to a maximum of 65535 (higher numbers usually being
+affected by wraparound).
You may mail your bug reports (be sure to include full configuration
information as output by the myconfig program in the perl source tree,
diff --git a/gnu/usr.bin/perl/pod/perlapio.pod b/gnu/usr.bin/perl/pod/perlapio.pod
index c963d232f6c..90475a9543f 100644
--- a/gnu/usr.bin/perl/pod/perlapio.pod
+++ b/gnu/usr.bin/perl/pod/perlapio.pod
@@ -57,7 +57,7 @@ perlapio - perl's IO abstraction interface.
=head1 DESCRIPTION
Perl's source code should use the above functions instead of those
-defined in ANSI C's I<stdio.h>, I<perlio.h> will the C<#define> them to
+defined in ANSI C's I<stdio.h>. The perl headers will C<#define> them to
the I/O mechanism selected at Configure time.
The functions are modeled on those in I<stdio.h>, but parameter order
@@ -67,7 +67,7 @@ has been "tidied up a little".
=item B<PerlIO *>
-This takes the place of FILE *. Unlike FILE * it should be treated as
+This takes the place of FILE *. Like FILE * it should be treated as
opaque (it is probably safe to assume it is a pointer to something).
=item B<PerlIO_stdin()>, B<PerlIO_stdout()>, B<PerlIO_stderr()>
@@ -84,7 +84,7 @@ These correspond to fopen()/fdopen() arguments are the same.
=item B<PerlIO_printf(f,fmt,...)>, B<PerlIO_vprintf(f,fmt,a)>
-These are is fprintf()/vfprintf equivalents.
+These are fprintf()/vfprintf() equivalents.
=item B<PerlIO_stdoutf(fmt,...)>
@@ -201,8 +201,8 @@ behaviour.
=item B<PerlIO_setlinebuf(f)>
This corresponds to setlinebuf(). Use is deprecated pending
-further discussion. (Perl core uses it I<only> when "dumping"
-is has nothing to do with $| auto-flush.)
+further discussion. (Perl core uses it I<only> when "dumping";
+it has nothing to do with $| auto-flush.)
=back
diff --git a/gnu/usr.bin/perl/pod/perlbook.pod b/gnu/usr.bin/perl/pod/perlbook.pod
index 9a725cb8330..76763cd8be1 100644
--- a/gnu/usr.bin/perl/pod/perlbook.pod
+++ b/gnu/usr.bin/perl/pod/perlbook.pod
@@ -4,30 +4,13 @@ perlbook - Perl book information
=head1 DESCRIPTION
-You can order Perl books from O'Reilly & Associates, 1-800-998-9938.
-Local/overseas is +1 707 829 0515. If you can locate an O'Reilly
-order form, you can also fax to +1 707 829 0104. If you're
-web-connected, you can even mosey on over to http://www.ora.com/ for
-an online order form.
-
-I<Programming Perl, Second Edition> is a reference work that covers
-nearly all of Perl, while I<Learning Perl, Second Edition> is a
-tutorial that covers the most frequently used subset of the language.
-You might also check out the very handy, inexpensive, and compact
-I<Perl 5 Desktop Reference>, especially when the thought of lugging
-the 676-page Camel around doesn't make much sense. I<Mastering
-Regular Expressions>, by Jeffrey Friedl, is a reference work that
-covers the art and implementation of regular expressions in various
-languages including Perl.
-
- Programming Perl, Second Edition (the Camel Book):
- ISBN 1-56592-149-6 (English)
-
- Learning Perl, Second Edition (the Llama Book):
- ISBN 1-56592-284-0 (English)
-
- Perl 5 Desktop Reference (the reference card):
- ISBN 1-56592-187-9 (brief English)
-
- Mastering Regular Expressions (the Hip Owl Book):
- ISBN 1-56592-257-3 (English)
+The Camel Book, officially known as I<Programming Perl, Second Edition>,
+by Larry Wall et al, is the definitive reference work covering nearly
+all of Perl. You can order it and other Perl books from O'Reilly &
+Associates, 1-800-998-9938. Local/overseas is +1 707 829 0515. If you
+can locate an O'Reilly order form, you can also fax to +1 707 829 0104.
+If you're web-connected, you can even mosey on over to http://www.ora.com/
+for an online order form.
+
+Other Perl books from various publishers and authors
+can be found listed in L<perlfaq3>.
diff --git a/gnu/usr.bin/perl/pod/perlcall.pod b/gnu/usr.bin/perl/pod/perlcall.pod
index f90e09f2384..2b837808a19 100644
--- a/gnu/usr.bin/perl/pod/perlcall.pod
+++ b/gnu/usr.bin/perl/pod/perlcall.pod
@@ -72,7 +72,7 @@ Each of the functions will now be discussed in turn.
=over 5
-=item B<perl_call_sv>
+=item perl_call_sv
I<perl_call_sv> takes two parameters, the first, C<sv>, is an SV*.
This allows you to specify the Perl subroutine to be called either as a
@@ -80,7 +80,7 @@ C string (which has first been converted to an SV) or a reference to a
subroutine. The section, I<Using perl_call_sv>, shows how you can make
use of I<perl_call_sv>.
-=item B<perl_call_pv>
+=item perl_call_pv
The function, I<perl_call_pv>, is similar to I<perl_call_sv> except it
expects its first parameter to be a C char* which identifies the Perl
@@ -88,7 +88,7 @@ subroutine you want to call, e.g., C<perl_call_pv("fred", 0)>. If the
subroutine you want to call is in another package, just include the
package name in the string, e.g., C<"pkg::fred">.
-=item B<perl_call_method>
+=item perl_call_method
The function I<perl_call_method> is used to call a method from a Perl
class. The parameter C<methname> corresponds to the name of the method
@@ -99,7 +99,7 @@ object (for a virtual method). See L<perlobj> for more information on
static and virtual methods and L<Using perl_call_method> for an example
of using I<perl_call_method>.
-=item B<perl_call_argv>
+=item perl_call_argv
I<perl_call_argv> calls the Perl subroutine specified by the C string
stored in the C<subname> parameter. It also takes the usual C<flags>
@@ -279,8 +279,8 @@ belongs to C<joe>.
It is possible for the Perl subroutine you are calling to terminate
abnormally, e.g., by calling I<die> explicitly or by not actually
-existing. By default, when either of these of events occurs, the
-process will terminate immediately. If though, you want to trap this
+existing. By default, when either of these events occurs, the
+process will terminate immediately. If you want to trap this
type of event, specify the G_EVAL flag. It will put an I<eval { }>
around the subroutine call.
@@ -404,7 +404,7 @@ via this XSUB
void
Call_fred()
CODE:
- PUSHMARK(sp) ;
+ PUSHMARK(SP) ;
perl_call_pv("fred", G_DISCARD|G_NOARGS) ;
fprintf(stderr, "back in Call_fred\n") ;
@@ -421,7 +421,7 @@ higher, or use the G_EVAL flag with I<perl_call_*> as shown below
void
Call_fred()
CODE:
- PUSHMARK(sp) ;
+ PUSHMARK(SP) ;
perl_call_pv("fred", G_EVAL|G_DISCARD|G_NOARGS) ;
fprintf(stderr, "back in Call_fred\n") ;
@@ -462,7 +462,7 @@ and here is a C function to call it
{
dSP ;
- PUSHMARK(sp) ;
+ PUSHMARK(SP) ;
perl_call_pv("PrintUID", G_DISCARD|G_NOARGS) ;
}
@@ -474,7 +474,7 @@ A few points to note about this example.
=item 1.
-Ignore C<dSP> and C<PUSHMARK(sp)> for now. They will be discussed in
+Ignore C<dSP> and C<PUSHMARK(SP)> for now. They will be discussed in
the next example.
=item 2.
@@ -526,12 +526,18 @@ The C function required to call I<LeftString> would look like this.
{
dSP ;
- PUSHMARK(sp) ;
+ ENTER ;
+ SAVETMPS ;
+
+ PUSHMARK(SP) ;
XPUSHs(sv_2mortal(newSVpv(a, 0)));
XPUSHs(sv_2mortal(newSViv(b)));
PUTBACK ;
perl_call_pv("LeftString", G_DISCARD);
+
+ FREETMPS ;
+ LEAVE ;
}
Here are a few notes on the C function I<call_LeftString>.
@@ -542,8 +548,9 @@ Here are a few notes on the C function I<call_LeftString>.
Parameters are passed to the Perl subroutine using the Perl stack.
This is the purpose of the code beginning with the line C<dSP> and
-ending with the line C<PUTBACK>.
-
+ending with the line C<PUTBACK>. The C<dSP> declares a local copy
+of the stack pointer. This local copy should B<always> be accessed
+as C<SP>.
=item 2.
@@ -597,6 +604,36 @@ on how the XPUSH macros work.
=item 6.
+Because we created temporary values (by means of sv_2mortal() calls)
+we will have to tidy up the Perl stack and dispose of mortal SVs.
+
+This is the purpose of
+
+ ENTER ;
+ SAVETMPS ;
+
+at the start of the function, and
+
+ FREETMPS ;
+ LEAVE ;
+
+at the end. The C<ENTER>/C<SAVETMPS> pair creates a boundary for any
+temporaries we create. This means that the temporaries we get rid of
+will be limited to those which were created after these calls.
+
+The C<FREETMPS>/C<LEAVE> pair will get rid of any values returned by
+the Perl subroutine (see next example), plus it will also dump the
+mortal SVs we have created. Having C<ENTER>/C<SAVETMPS> at the
+beginning of the code makes sure that no other mortals are destroyed.
+
+Think of these macros as working a bit like using C<{> and C<}> in Perl
+to limit the scope of local variables.
+
+See the section I<Using Perl to dispose of temporaries> for details of
+an alternative to using these macros.
+
+=item 7.
+
Finally, I<LeftString> can now be called via the I<perl_call_pv>
function.
@@ -630,7 +667,7 @@ function required to call it is now a bit more complex.
ENTER ;
SAVETMPS;
- PUSHMARK(sp) ;
+ PUSHMARK(SP) ;
XPUSHs(sv_2mortal(newSViv(a)));
XPUSHs(sv_2mortal(newSViv(b)));
PUTBACK ;
@@ -659,40 +696,8 @@ The only flag specified this time was G_SCALAR. That means the C<@_>
array will be created and that the value returned by I<Adder> will
still exist after the call to I<perl_call_pv>.
-
-
=item 2.
-Because we are interested in what is returned from I<Adder> we cannot
-specify G_DISCARD. This means that we will have to tidy up the Perl
-stack and dispose of any temporary values ourselves. This is the
-purpose of
-
- ENTER ;
- SAVETMPS ;
-
-at the start of the function, and
-
- FREETMPS ;
- LEAVE ;
-
-at the end. The C<ENTER>/C<SAVETMPS> pair creates a boundary for any
-temporaries we create. This means that the temporaries we get rid of
-will be limited to those which were created after these calls.
-
-The C<FREETMPS>/C<LEAVE> pair will get rid of any values returned by
-the Perl subroutine, plus it will also dump the mortal SVs we have
-created. Having C<ENTER>/C<SAVETMPS> at the beginning of the code
-makes sure that no other mortals are destroyed.
-
-Think of these macros as working a bit like using C<{> and C<}> in Perl
-to limit the scope of local variables.
-
-See the section I<Using Perl to dispose of temporaries> for details of
-an alternative to using these macros.
-
-=item 3.
-
The purpose of the macro C<SPAGAIN> is to refresh the local copy of the
stack pointer. This is necessary because it is possible that the memory
allocated to the Perl stack has been reallocated whilst in the
@@ -702,7 +707,7 @@ If you are making use of the Perl stack pointer in your code you must
always refresh the local copy using SPAGAIN whenever you make use
of the I<perl_call_*> functions or any other Perl internal function.
-=item 4.
+=item 3.
Although only a single value was expected to be returned from I<Adder>,
it is still good practice to check the return code from I<perl_call_pv>
@@ -714,7 +719,7 @@ didn't check for that possibility and take appropriate action the Perl
stack would end up in an inconsistent state. That is something you
I<really> don't want to happen ever.
-=item 5.
+=item 4.
The C<POPi> macro is used here to pop the return value from the stack.
In this case we wanted an integer, so C<POPi> was used.
@@ -729,7 +734,7 @@ they return.
POPi integer
POPl long
-=item 6.
+=item 5.
The final C<PUTBACK> is used to leave the Perl stack in a consistent
state before exiting the function. This is necessary because when we
@@ -766,7 +771,7 @@ and this is the C function
ENTER ;
SAVETMPS;
- PUSHMARK(sp) ;
+ PUSHMARK(SP) ;
XPUSHs(sv_2mortal(newSViv(a)));
XPUSHs(sv_2mortal(newSViv(b)));
PUTBACK ;
@@ -829,7 +834,7 @@ context, like this
ENTER ;
SAVETMPS;
- PUSHMARK(sp) ;
+ PUSHMARK(SP) ;
XPUSHs(sv_2mortal(newSViv(a)));
XPUSHs(sv_2mortal(newSViv(b)));
PUTBACK ;
@@ -897,7 +902,7 @@ and here is a C function to call it.
sva = sv_2mortal(newSViv(a)) ;
svb = sv_2mortal(newSViv(b)) ;
- PUSHMARK(sp) ;
+ PUSHMARK(SP) ;
XPUSHs(sva);
XPUSHs(svb);
PUTBACK ;
@@ -954,7 +959,7 @@ and some C to call it
ENTER ;
SAVETMPS;
- PUSHMARK(sp) ;
+ PUSHMARK(SP) ;
XPUSHs(sv_2mortal(newSViv(a)));
XPUSHs(sv_2mortal(newSViv(b)));
PUTBACK ;
@@ -964,9 +969,10 @@ and some C to call it
SPAGAIN ;
/* Check the eval first */
- if (SvTRUE(GvSV(errgv)))
+ if (SvTRUE(ERRSV))
{
- printf ("Uh oh - %s\n", SvPV(GvSV(errgv), na)) ;
+ STRLEN n_a;
+ printf ("Uh oh - %s\n", SvPV(ERRSV, n_a)) ;
POPs ;
}
else
@@ -1006,9 +1012,10 @@ I<Subtract>.
The code
- if (SvTRUE(GvSV(errgv)))
+ if (SvTRUE(ERRSV))
{
- printf ("Uh oh - %s\n", SvPV(GvSV(errgv), na)) ;
+ STRLEN n_a;
+ printf ("Uh oh - %s\n", SvPV(ERRSV, n_a)) ;
POPs ;
}
@@ -1016,14 +1023,14 @@ is the direct equivalent of this bit of Perl
print "Uh oh - $@\n" if $@ ;
-C<errgv> is a perl global of type C<GV *> that points to the
-symbol table entry containing the error. C<GvSV(errgv)> therefore
+C<PL_errgv> is a perl global of type C<GV *> that points to the
+symbol table entry containing the error. C<ERRSV> therefore
refers to the C equivalent of C<$@>.
=item 3.
Note that the stack is popped using C<POPs> in the block where
-C<SvTRUE(GvSV(errgv))> is true. This is necessary because whenever a
+C<SvTRUE(ERRSV)> is true. This is necessary because whenever a
I<perl_call_*> function invoked with G_EVAL|G_SCALAR returns an error,
the top of the stack holds the value I<undef>. Because we want the
program to continue after detecting this error, it is essential that
@@ -1087,7 +1094,7 @@ Here is a snippet of XSUB which defines I<CallSubPV>.
CallSubPV(name)
char * name
CODE:
- PUSHMARK(sp) ;
+ PUSHMARK(SP) ;
perl_call_pv(name, G_DISCARD|G_NOARGS) ;
That is fine as far as it goes. The thing is, the Perl subroutine
@@ -1103,7 +1110,7 @@ I<perl_call_sv> instead of I<perl_call_pv>.
CallSubSV(name)
SV * name
CODE:
- PUSHMARK(sp) ;
+ PUSHMARK(SP) ;
perl_call_sv(name, G_DISCARD|G_NOARGS) ;
Because we are using an SV to call I<fred> the following can all be used
@@ -1133,7 +1140,7 @@ pointer to the SV. Say the code above had been like this
void
CallSavedSub1()
CODE:
- PUSHMARK(sp) ;
+ PUSHMARK(SP) ;
perl_call_sv(rememberSub, G_DISCARD|G_NOARGS) ;
The reason this is wrong is that by the time you come to use the
@@ -1209,7 +1216,7 @@ SV. The code below shows C<SaveSub2> modified to do that
void
CallSavedSub2()
CODE:
- PUSHMARK(sp) ;
+ PUSHMARK(SP) ;
perl_call_sv(keepSub, G_DISCARD|G_NOARGS) ;
To avoid creating a new SV every time C<SaveSub2> is called,
@@ -1318,7 +1325,7 @@ the C<PrintID> and C<Display> methods from C.
char * method
int index
CODE:
- PUSHMARK(sp);
+ PUSHMARK(SP);
XPUSHs(ref);
XPUSHs(sv_2mortal(newSViv(index))) ;
PUTBACK;
@@ -1330,7 +1337,7 @@ the C<PrintID> and C<Display> methods from C.
char * class
char * method
CODE:
- PUSHMARK(sp);
+ PUSHMARK(SP);
XPUSHs(sv_2mortal(newSVpv(class, 0))) ;
PUTBACK;
@@ -1522,7 +1529,7 @@ Now change that to call a Perl subroutine instead
{
dSP ;
- PUSHMARK(sp) ;
+ PUSHMARK(SP) ;
/* Call the Perl sub to process the callback */
perl_call_sv(callback, G_DISCARD) ;
@@ -1625,7 +1632,7 @@ and C<asynch_read_if> could look like this
if (sv == (SV**)NULL)
croak("Internal error...\n") ;
- PUSHMARK(sp) ;
+ PUSHMARK(SP) ;
XPUSHs(sv_2mortal(newSViv(fh))) ;
XPUSHs(sv_2mortal(newSVpv(buffer, 0))) ;
PUTBACK ;
@@ -1709,7 +1716,7 @@ series of C functions to act as the interface to Perl, thus
{
dSP ;
- PUSHMARK(sp) ;
+ PUSHMARK(SP) ;
XPUSHs(sv_2mortal(newSVpv(buffer, 0))) ;
PUTBACK ;
@@ -1863,7 +1870,7 @@ of values> recoded to use C<ST> instead of C<POP*>.
ENTER ;
SAVETMPS;
- PUSHMARK(sp) ;
+ PUSHMARK(SP) ;
XPUSHs(sv_2mortal(newSViv(a)));
XPUSHs(sv_2mortal(newSViv(b)));
PUTBACK ;
@@ -1871,8 +1878,8 @@ of values> recoded to use C<ST> instead of C<POP*>.
count = perl_call_pv("AddSubtract", G_ARRAY);
SPAGAIN ;
- sp -= count ;
- ax = (sp - stack_base) + 1 ;
+ SP -= count ;
+ ax = (SP - PL_stack_base) + 1 ;
if (count != 2)
croak("Big trouble\n") ;
@@ -1901,8 +1908,8 @@ you.
The code
SPAGAIN ;
- sp -= count ;
- ax = (sp - stack_base) + 1 ;
+ SP -= count ;
+ ax = (SP - PL_stack_base) + 1 ;
sets the stack up so that we can use the C<ST> macro.
@@ -1917,9 +1924,9 @@ refers to the last.
=head2 Creating and calling an anonymous subroutine in C
-As we've already shown, L<perl_call_sv> can be used to invoke an
-anonymous subroutine. However, our example showed how Perl script
-invoking an XSUB to preform this operation. Let's see how it can be
+As we've already shown, C<perl_call_sv> can be used to invoke an
+anonymous subroutine. However, our example showed a Perl script
+invoking an XSUB to perform this operation. Let's see how it can be
done inside our C code:
...
@@ -1930,8 +1937,9 @@ done inside our C code:
perl_call_sv(cvrv, G_VOID|G_NOARGS);
-L<perlguts/perl_eval_pv> is used to compile the anonymous subroutine, which
-will be the return value as well. Once this code reference is in hand, it
+C<perl_eval_pv> is used to compile the anonymous subroutine, which
+will be the return value as well (read more about C<perl_eval_pv> in
+L<perlguts/perl_eval_pv>). Once this code reference is in hand, it
can be mixed in with all the previous examples we've shown.
=head1 SEE ALSO
diff --git a/gnu/usr.bin/perl/pod/perldata.pod b/gnu/usr.bin/perl/pod/perldata.pod
index dc2975a7d44..9e41c2c3687 100644
--- a/gnu/usr.bin/perl/pod/perldata.pod
+++ b/gnu/usr.bin/perl/pod/perldata.pod
@@ -22,15 +22,15 @@ that's deprecated); all but the last are interpreted as names of
packages, to locate the namespace in which to look
up the final identifier (see L<perlmod/Packages> for details).
It's possible to substitute for a simple identifier an expression
-which produces a reference to the value at runtime; this is
+that produces a reference to the value at runtime; this is
described in more detail below, and in L<perlref>.
There are also special variables whose names don't follow these
rules, so that they don't accidentally collide with one of your
-normal variables. Strings which match parenthesized parts of a
+normal variables. Strings that match parenthesized parts of a
regular expression are saved under names containing only digits after
the C<$> (see L<perlop> and L<perlre>). In addition, several special
-variables which provide windows into the inner working of Perl have names
+variables that provide windows into the inner working of Perl have names
containing punctuation characters (see L<perlvar>).
Scalar values are always named with '$', even when referring to a scalar
@@ -81,7 +81,7 @@ that returns a reference to an object of that type. For a description
of this, see L<perlref>.
Names that start with a digit may contain only more digits. Names
-which do not start with a letter, underscore, or digit are limited to
+that do not start with a letter, underscore, or digit are limited to
one character, e.g., C<$%> or C<$$>. (Most of these one character names
have a predefined significance to Perl. For instance, C<$$> is the
current process id.)
@@ -171,13 +171,15 @@ numbers count as 0, just as they do in B<awk>:
That's usually preferable because otherwise you won't treat IEEE notations
like C<NaN> or C<Infinity> properly. At other times you might prefer to
-use a regular expression to check whether data is numeric. See L<perlre>
-for details on regular expressions.
+use the POSIX::strtod function or a regular expression to check whether
+data is numeric. See L<perlre> for details on regular expressions.
warn "has nondigits" if /\D/;
- warn "not a whole number" unless /^\d+$/;
- warn "not an integer" unless /^[+-]?\d+$/
- warn "not a decimal number" unless /^[+-]?\d+\.?\d*$/
+ warn "not a natural number" unless /^\d+$/; # rejects -3
+ warn "not an integer" unless /^-?\d+$/; # rejects +3
+ warn "not an integer" unless /^[+-]?\d+$/;
+ warn "not a decimal number" unless /^-?\d+\.?\d*$/; # rejects .2
+ warn "not a decimal number" unless /^-?(?:\d+(?:\.\d*)?|\.\d+)$/;
warn "not a C float"
unless /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/;
@@ -189,7 +191,7 @@ length of the array. Shortening an array by this method destroys
intervening values. Lengthening an array that was previously shortened
I<NO LONGER> recovers the values that were in those elements. (It used to
in Perl 4, but we had to break this to make sure destructors were
-called when expected.) You can also gain some measure of efficiency by
+called when expected.) You can also gain some miniscule measure of efficiency by
pre-extending an array that is going to get big. (You can also extend
an array by assigning to an element that is off the end of the array.)
You can truncate an array down to nothing by assigning the null list ()
@@ -200,7 +202,8 @@ to it. The following are equivalent:
If you evaluate a named array in a scalar context, it returns the length of
the array. (Note that this is not true of lists, which return the
-last value, like the C comma operator.) The following is always true:
+last value, like the C comma operator, nor of built-in functions, which return
+whatever they feel like returning.) The following is always true:
scalar(@whatever) == $#whatever - $[ + 1;
@@ -216,7 +219,7 @@ left to doubt:
$element_count = scalar(@whatever);
-If you evaluate a hash in a scalar context, it returns a value which is
+If you evaluate a hash in a scalar context, it returns a value that is
true if and only if the hash contains any key/value pairs. (If there
are any key/value pairs, the value returned is a string consisting of
the number of used buckets and the number of allocated buckets, separated
@@ -227,6 +230,11 @@ scalar context reveals "1/16", which means only one out of sixteen buckets
has been touched, and presumably contains all 10,000 of your items. This
isn't supposed to happen.)
+You can preallocate space for a hash by assigning to the keys() function.
+This rounds up the allocated bucked to the next power of two:
+
+ keys(%users) = 1000; # allocate 1024 buckets
+
=head2 Scalar value constructors
Numeric literals are specified in any of the customary floating point or
@@ -245,7 +253,7 @@ literals are subject to backslash and variable substitution;
single-quoted strings are not (except for "C<\'>" and "C<\\>").
The usual Unix backslash rules apply for making characters such as
newline, tab, etc., as well as some more exotic forms. See
-L<perlop/Quote and Quotelike Operators> for a list.
+L<perlop/"Quote and Quotelike Operators"> for a list.
Octal or hex representations in string literals (e.g. '0xffff') are not
automatically converted to their integer representation. The hex() and
@@ -288,7 +296,7 @@ Three special literals are __FILE__, __LINE__, and __PACKAGE__, which
represent the current filename, line number, and package name at that
point in your program. They may be used only as separate tokens; they
will not be interpolated into strings. If there is no current package
-(due to a C<package;> directive), __PACKAGE__ is the undefined value.
+(due to an empty C<package;> directive), __PACKAGE__ is the undefined value.
The tokens __END__ and __DATA__ may be used to indicate the logical end
of the script before the actual end of file. Any following text is
@@ -421,14 +429,14 @@ list literal, so that you can say:
LISTs do automatic interpolation of sublists. That is, when a LIST is
evaluated, each element of the list is evaluated in a list context, and
the resulting list value is interpolated into LIST just as if each
-individual element were a member of LIST. Thus arrays lose their
+individual element were a member of LIST. Thus arrays and hashes lose their
identity in a LIST--the list
- (@foo,@bar,&SomeSub)
+ (@foo,@bar,&SomeSub,%glarch)
contains all the elements of @foo followed by all the elements of @bar,
-followed by all the elements returned by the subroutine named SomeSub when
-it's called in a list context.
+followed by all the elements returned by the subroutine named SomeSub
+called in a list context, followed by the key/value pairs of %glarch.
To make a list reference that does I<NOT> interpolate, see L<perlref>.
The null list is represented by (). Interpolating it in a list
@@ -463,7 +471,7 @@ is legal to assign to:
($map{'red'}, $map{'blue'}, $map{'green'}) = (0x00f, 0x0f0, 0xf00);
-Array assignment in a scalar context returns the number of elements
+List assignment in a scalar context returns the number of elements
produced by the expression on the right side of the assignment:
$x = (($foo,$bar) = (3,2,1)); # set $x to 3, not 2
@@ -476,7 +484,7 @@ which when assigned produces a 0, which is interpreted as FALSE.
The final element may be an array or a hash:
($a, $b, @rest) = split;
- local($a, $b, %rest) = @_;
+ my($a, $b, %rest) = @_;
You can actually put an array or hash anywhere in the list, but the first one
in the list will soak up all the values, and anything after it will get
@@ -498,7 +506,7 @@ key/value pairs. That's why it's good to use references sometimes.
It is often more readable to use the C<=E<gt>> operator between key/value
pairs. The C<=E<gt>> operator is mostly just a more visually distinctive
synonym for a comma, but it also arranges for its left-hand operand to be
-interpreted as a string, if it's a bareword which would be a legal identifier.
+interpreted as a string--if it's a bareword that would be a legal identifier.
This makes it nice for initializing hashes:
%map = (
@@ -535,13 +543,28 @@ Perl uses an internal type called a I<typeglob> to hold an entire
symbol table entry. The type prefix of a typeglob is a C<*>, because
it represents all types. This used to be the preferred way to
pass arrays and hashes by reference into a function, but now that
-we have real references, this is seldom needed. It also used to be the
-preferred way to pass filehandles into a function, but now
-that we have the *foo{THING} notation it isn't often needed for that,
-either. It is still needed to pass new filehandles into functions
-(*HANDLE{IO} only works if HANDLE has already been used).
+we have real references, this is seldom needed.
+
+The main use of typeglobs in modern Perl is create symbol table aliases.
+This assignment:
+
+ *this = *that;
+
+makes $this an alias for $that, @this an alias for @that, %this an alias
+for %that, &this an alias for &that, etc. Much safer is to use a reference.
+This:
-If you need to use a typeglob to save away a filehandle, do it this way:
+ local *Here::blue = \$There::green;
+
+temporarily makes $Here::blue an alias for $There::green, but doesn't
+make @Here::blue an alias for @There::green, or %Here::blue an alias for
+%There::green, etc. See L<perlmod/"Symbol Tables"> for more examples
+of this. Strange though this may seem, this is the basis for the whole
+module import/export system.
+
+Another use for typeglobs is to to pass filehandles into a function or
+to create new filehandles. If you need to use a typeglob to save away
+a filehandle, do it this way:
$fh = *STDOUT;
@@ -549,18 +572,32 @@ or perhaps as a real reference, like this:
$fh = \*STDOUT;
-This is also a way to create a local filehandle. For example:
+See L<perlsub> for examples of using these as indirect filehandles
+in functions.
+
+Typeglobs are also a way to create a local filehandle using the local()
+operator. These last until their block is exited, but may be passed back.
+For example:
sub newopen {
my $path = shift;
local *FH; # not my!
- open (FH, $path) || return undef;
+ open (FH, $path) or return undef;
return *FH;
}
$fh = newopen('/etc/passwd');
-Another way to create local filehandles is with IO::Handle and its ilk,
-see the bottom of L<perlfunc/open()>.
+Now that we have the *foo{THING} notation, typeglobs aren't used as much
+for filehandle manipulations, although they're still needed to pass brand
+new file and directory handles into or out of functions. That's because
+*HANDLE{IO} only works if HANDLE has already been used as a handle.
+In other words, *FH can be used to create new symbol table entries,
+but *foo{THING} cannot.
+
+Another way to create anonymous filehandles is with the IO::Handle
+module and its ilk. These modules have the advantage of not hiding
+different types of the same name during the local(). See the bottom of
+L<perlfunc/open()> for an example.
See L<perlref>, L<perlsub>, and L<perlmod/"Symbol Tables"> for more
-discussion on typeglobs.
+discussion on typeglobs and the *foo{THING} syntax.
diff --git a/gnu/usr.bin/perl/pod/perldebug.pod b/gnu/usr.bin/perl/pod/perldebug.pod
index a02fd5c7103..760d517f978 100644
--- a/gnu/usr.bin/perl/pod/perldebug.pod
+++ b/gnu/usr.bin/perl/pod/perldebug.pod
@@ -63,7 +63,7 @@ it prints out the description for just that command. The special
argument of C<h h> produces a more compact help listing, designed to fit
together on one screen.
-If the output the C<h> command (or any command, for that matter) scrolls
+If the output of the C<h> command (or any command, for that matter) scrolls
past your screen, either precede the command with a leading pipe symbol so
it's run through your pager, as in
@@ -281,7 +281,7 @@ The sequence of steps taken by the debugger is
4. prompt user if at a breakpoint or in single-step
5. evaluate line
-For example, this will print out C<$foo> every time line
+For example, this will print out $foo every time line
53 is passed:
a 53 print "DB FOUND $foo\n"
@@ -290,6 +290,14 @@ For example, this will print out C<$foo> every time line
Delete all installed actions.
+=item W [expr]
+
+Add a global watch-expression.
+
+=item W
+
+Delete all watch-expressions.
+
=item O [opt[=val]] [opt"val"] [opt?]...
Set or query values of options. val defaults to 1. opt can
@@ -392,6 +400,10 @@ Dump arrays holding debugged files.
Dump symbol tables of packages.
+=item C<DumpReused>
+
+Dump contents of "reused" addresses.
+
=item C<quote>, C<HighBit>, C<undefPrint>
Change style of string dump. Default value of C<quote> is C<auto>, one
@@ -655,8 +667,8 @@ C<main::pests> was called in a scalar context, also from I<camel_flea>,
but from line 4.
Note that if you execute C<T> command from inside an active C<use>
-statement, the backtrace will contain both C<L<perlfunc/require>>
-frame and an C<L<perlfunc/eval EXPR>>) frame.
+statement, the backtrace will contain both C<require>
+frame and an C<eval>) frame.
=item Listing
@@ -856,7 +868,7 @@ compile subname> for the same purpose.
=head2 Debugger Customization
-Most probably you not want to modify the debugger, it contains enough
+Most probably you do not want to modify the debugger, it contains enough
hooks to satisfy most needs. You may change the behaviour of debugger
from the debugger itself, using C<O>ptions, from the command line via
C<PERLDB_OPTS> environment variable, and from I<customization files>.
@@ -954,14 +966,14 @@ application.
=item *
-The array C<@{"_<$filename"}> is the line-by-line contents of
+The array C<@{"_E<lt>$filename"}> is the line-by-line contents of
$filename for all the compiled files. Same for C<eval>ed strings which
contain subroutines, or which are currently executed. The C<$filename>
for C<eval>ed strings looks like C<(eval 34)>.
=item *
-The hash C<%{"_<$filename"}> contains breakpoints and action (it is
+The hash C<%{"_E<lt>$filename"}> contains breakpoints and action (it is
keyed by line number), and individual entries are settable (as opposed
to the whole hash). Only true/false is important to Perl, though the
values used by F<perl5db.pl> have the form
@@ -969,22 +981,22 @@ C<"$break_condition\0$action">. Values are magical in numeric context:
they are zeros if the line is not breakable.
Same for evaluated strings which contain subroutines, or which are
-currently executed. The C<$filename> for C<eval>ed strings looks like
+currently executed. The $filename for C<eval>ed strings looks like
C<(eval 34)>.
=item *
-The scalar C<${"_<$filename"}> contains C<"_<$filename">. Same for
+The scalar C<${"_E<lt>$filename"}> contains C<"_E<lt>$filename">. Same for
evaluated strings which contain subroutines, or which are currently
-executed. The C<$filename> for C<eval>ed strings looks like C<(eval
+executed. The $filename for C<eval>ed strings looks like C<(eval
34)>.
=item *
After each C<require>d file is compiled, but before it is executed,
-C<DB::postponed(*{"_<$filename"})> is called (if subroutine
+C<DB::postponed(*{"_E<lt>$filename"})> is called (if subroutine
C<DB::postponed> exists). Here the $filename is the expanded name of
-the C<require>d file (as found in values of C<%INC>).
+the C<require>d file (as found in values of %INC).
=item *
@@ -1071,7 +1083,7 @@ file.
Some functions are provided to simplify customization. See L<"Debugger
Customization"> for description of C<DB::parse_options(string)>. The
function C<DB::dump_trace(skip[, count])> skips the specified number
-of frames, and returns an array containing info about the caller
+of frames, and returns a list containing info about the caller
frames (all if C<count> is missing). Each entry is a hash with keys
C<context> (C<$> or C<@>), C<sub> (subroutine name, or info about
eval), C<args> (C<undef> or a reference to an array), C<file>, and
@@ -1085,10 +1097,565 @@ convenient as arguments to C<E<lt>>, C<E<lt>E<lt>> commands.
You did try the B<-w> switch, didn't you?
-=head1 BUGS
+=head2 BUGS
You cannot get the stack frame information or otherwise debug functions
that were not compiled by Perl, such as C or C++ extensions.
If you alter your @_ arguments in a subroutine (such as with B<shift>
or B<pop>, the stack backtrace will not show the original values.
+
+=head1 Debugging Perl memory usage
+
+Perl is I<very> frivolous with memory. There is a saying that to
+estimate memory usage of Perl, assume a reasonable algorithm of
+allocation, and multiply your estimates by 10. This is not absolutely
+true, but may give you a good grasp of what happens.
+
+Say, an integer cannot take less than 20 bytes of memory, a float
+cannot take less than 24 bytes, a string cannot take less than 32
+bytes (all these examples assume 32-bit architectures, the result are
+much worse on 64-bit architectures). If a variable is accessed in two
+of three different ways (which require an integer, a float, or a
+string), the memory footprint may increase by another 20 bytes. A
+sloppy malloc() implementation will make these numbers yet more.
+
+On the opposite end of the scale, a declaration like
+
+ sub foo;
+
+may take (on some versions of perl) up to 500 bytes of memory.
+
+Off-the-cuff anecdotal estimates of a code bloat give a factor around
+8. This means that the compiled form of reasonable (commented
+indented etc.) code will take approximately 8 times more than the
+disk space the code takes.
+
+There are two Perl-specific ways to analyze the memory usage:
+$ENV{PERL_DEBUG_MSTATS} and B<-DL> switch. First one is available
+only if perl is compiled with Perl's malloc(), the second one only if
+Perl compiled with C<-DDEBUGGING> (as with giving C<-D optimise=-g>
+option to F<Configure>).
+
+=head2 Using C<$ENV{PERL_DEBUG_MSTATS}>
+
+If your perl is using Perl's malloc(), and compiled with correct
+switches (this is the default), then it will print memory usage
+statistics after compiling your code (if C<$ENV{PERL_DEBUG_MSTATS}> >
+1), and before termination of the script (if
+C<$ENV{PERL_DEBUG_MSTATS}> >= 1). The report format is similar to one
+in the following example:
+
+ env PERL_DEBUG_MSTATS=2 perl -e "require Carp"
+ Memory allocation statistics after compilation: (buckets 4(4)..8188(8192)
+ 14216 free: 130 117 28 7 9 0 2 2 1 0 0
+ 437 61 36 0 5
+ 60924 used: 125 137 161 55 7 8 6 16 2 0 1
+ 74 109 304 84 20
+ Total sbrk(): 77824/21:119. Odd ends: pad+heads+chain+tail: 0+636+0+2048.
+ Memory allocation statistics after execution: (buckets 4(4)..8188(8192)
+ 30888 free: 245 78 85 13 6 2 1 3 2 0 1
+ 315 162 39 42 11
+ 175816 used: 265 176 1112 111 26 22 11 27 2 1 1
+ 196 178 1066 798 39
+ Total sbrk(): 215040/47:145. Odd ends: pad+heads+chain+tail: 0+2192+0+6144.
+
+It is possible to ask for such a statistic at arbitrary moment by
+using Devel::Peek::mstats() (module Devel::Peek is available on CPAN).
+
+Here is the explanation of different parts of the format:
+
+=over
+
+=item C<buckets SMALLEST(APPROX)..GREATEST(APPROX)>
+
+Perl's malloc() uses bucketed allocations. Every request is rounded
+up to the closest bucket size available, and a bucket of these size is
+taken from the pool of the buckets of this size.
+
+The above line describes limits of buckets currently in use. Each
+bucket has two sizes: memory footprint, and the maximal size of user
+data which may be put into this bucket. Say, in the above example the
+smallest bucket is both sizes 4. The biggest bucket has usable size
+8188, and the memory footprint 8192.
+
+With debugging Perl some buckets may have negative usable size. This
+means that these buckets cannot (and will not) be used. For greater
+buckets the memory footprint may be one page greater than a power of
+2. In such a case the corresponding power of two is printed instead
+in the C<APPROX> field above.
+
+=item Free/Used
+
+The following 1 or 2 rows of numbers correspond to the number of
+buckets of each size between C<SMALLEST> and C<GREATEST>. In the
+first row the sizes (memory footprints) of buckets are powers of two
+(or possibly one page greater). In the second row (if present) the
+memory footprints of the buckets are between memory footprints of two
+buckets "above".
+
+Say, with the above example the memory footprints are (with current
+algorithm)
+
+ free: 8 16 32 64 128 256 512 1024 2048 4096 8192
+ 4 12 24 48 80
+
+With non-C<DEBUGGING> perl the buckets starting from C<128>-long ones
+have 4-byte overhead, thus 8192-long bucket may take up to
+8188-byte-long allocations.
+
+=item C<Total sbrk(): SBRKed/SBRKs:CONTINUOUS>
+
+The first two fields give the total amount of memory perl sbrk()ed,
+and number of sbrk()s used. The third number is what perl thinks
+about continuity of returned chunks. As far as this number is
+positive, malloc() will assume that it is probable that sbrk() will
+provide continuous memory.
+
+The amounts sbrk()ed by external libraries is not counted.
+
+=item C<pad: 0>
+
+The amount of sbrk()ed memory needed to keep buckets aligned.
+
+=item C<heads: 2192>
+
+While memory overhead of bigger buckets is kept inside the bucket, for
+smaller buckets it is kept in separate areas. This field gives the
+total size of these areas.
+
+=item C<chain: 0>
+
+malloc() may want to subdivide a bigger bucket into smaller buckets.
+If only a part of the deceased-bucket is left non-subdivided, the rest
+is kept as an element of a linked list. This field gives the total
+size of these chunks.
+
+=item C<tail: 6144>
+
+To minimize amount of sbrk()s malloc() asks for more memory. This
+field gives the size of the yet-unused part, which is sbrk()ed, but
+never touched.
+
+=back
+
+=head2 Example of using B<-DL> switch
+
+Below we show how to analyse memory usage by
+
+ do 'lib/auto/POSIX/autosplit.ix';
+
+The file in question contains a header and 146 lines similar to
+
+ sub getcwd ;
+
+B<Note:> I<the discussion below supposes 32-bit architecture. In the
+newer versions of perl the memory usage of the constructs discussed
+here is much improved, but the story discussed below is a real-life
+story. This story is very terse, and assumes more than cursory
+knowledge of Perl internals.>
+
+Here is the itemized list of Perl allocations performed during parsing
+of this file:
+
+ !!! "after" at test.pl line 3.
+ Id subtot 4 8 12 16 20 24 28 32 36 40 48 56 64 72 80 80+
+ 0 02 13752 . . . . 294 . . . . . . . . . . 4
+ 0 54 5545 . . 8 124 16 . . . 1 1 . . . . . 3
+ 5 05 32 . . . . . . . 1 . . . . . . . .
+ 6 02 7152 . . . . . . . . . . 149 . . . . .
+ 7 02 3600 . . . . . 150 . . . . . . . . . .
+ 7 03 64 . -1 . 1 . . 2 . . . . . . . . .
+ 7 04 7056 . . . . . . . . . . . . . . . 7
+ 7 17 38404 . . . . . . . 1 . . 442 149 . . 147 .
+ 9 03 2078 17 249 32 . . . . 2 . . . . . . . .
+
+
+To see this list insert two C<warn('!...')> statements around the call:
+
+ warn('!');
+ do 'lib/auto/POSIX/autosplit.ix';
+ warn('!!! "after"');
+
+and run it with B<-DL> option. The first warn() will print memory
+allocation info before the parsing of the file, and will memorize the
+statistics at this point (we ignore what it prints). The second warn()
+will print increments w.r.t. this memorized statistics. This is the
+above printout.
+
+Different I<Id>s on the left correspond to different subsystems of
+perl interpreter, they are just first argument given to perl memory
+allocation API New(). To find what C<9 03> means C<grep> the perl
+source for C<903>. You will see that it is F<util.c>, function
+savepvn(). This function is used to store a copy of existing chunk of
+memory. Using C debugger, one can see that it is called either
+directly from gv_init(), or via sv_magic(), and gv_init() is called
+from gv_fetchpv() - which is called from newSUB().
+
+B<Note:> to reach this place in debugger and skip all the calls to
+savepvn during the compilation of the main script, set a C breakpoint
+in Perl_warn(), C<continue> this point is reached, I<then> set
+breakpoint in Perl_savepvn(). Note that you may need to skip a
+handful of Perl_savepvn() which do not correspond to mass production
+of CVs (there are more C<903> allocations than 146 similar lines of
+F<lib/auto/POSIX/autosplit.ix>). Note also that C<Perl_> prefixes are
+added by macroization code in perl header files to avoid conflicts
+with external libraries.
+
+Anyway, we see that C<903> ids correspond to creation of globs, twice
+per glob - for glob name, and glob stringification magic.
+
+Here are explanations for other I<Id>s above:
+
+=over
+
+=item C<717>
+
+is for creation of bigger C<XPV*> structures. In the above case it
+creates 3 C<AV> per subroutine, one for a list of lexical variable
+names, one for a scratchpad (which contains lexical variables and
+C<targets>), and one for the array of scratchpads needed for
+recursion.
+
+It also creates a C<GV> and a C<CV> per subroutine (all called from
+start_subparse()).
+
+=item C<002>
+
+Creates C array corresponding to the C<AV> of scratchpads, and the
+scratchpad itself (the first fake entry of this scratchpad is created
+though the subroutine itself is not defined yet).
+
+It also creates C arrays to keep data for the stash (this is one HV,
+but it grows, thus there are 4 big allocations: the big chunks are not
+freed, but are kept as additional arenas for C<SV> allocations).
+
+=item C<054>
+
+creates a C<HEK> for the name of the glob for the subroutine (this
+name is a key in a I<stash>).
+
+Big allocations with this I<Id> correspond to allocations of new
+arenas to keep C<HE>.
+
+=item C<602>
+
+creates a C<GP> for the glob for the subroutine.
+
+=item C<702>
+
+creates the C<MAGIC> for the glob for the subroutine.
+
+=item C<704>
+
+creates I<arenas> which keep SVs.
+
+=back
+
+=head2 B<-DL> details
+
+If Perl is run with B<-DL> option, then warn()s which start with `!'
+behave specially. They print a list of I<categories> of memory
+allocations, and statistics of allocations of different sizes for
+these categories.
+
+If warn() string starts with
+
+=over
+
+=item C<!!!>
+
+print changed categories only, print the differences in counts of allocations;
+
+=item C<!!>
+
+print grown categories only; print the absolute values of counts, and totals;
+
+=item C<!>
+
+print nonempty categories, print the absolute values of counts and totals.
+
+=back
+
+=head2 Limitations of B<-DL> statistic
+
+If an extension or an external library does not use Perl API to
+allocate memory, these allocations are not counted.
+
+=head1 Debugging regular expressions
+
+There are two ways to enable debugging output for regular expressions.
+
+If your perl is compiled with C<-DDEBUGGING>, you may use the
+B<-Dr> flag on the command line.
+
+Otherwise, one can C<use re 'debug'>, which has effects both at
+compile time, and at run time (and is I<not> lexically scoped).
+
+=head2 Compile-time output
+
+The debugging output for the compile time looks like this:
+
+ compiling RE `[bc]d(ef*g)+h[ij]k$'
+ size 43 first at 1
+ 1: ANYOF(11)
+ 11: EXACT <d>(13)
+ 13: CURLYX {1,32767}(27)
+ 15: OPEN1(17)
+ 17: EXACT <e>(19)
+ 19: STAR(22)
+ 20: EXACT <f>(0)
+ 22: EXACT <g>(24)
+ 24: CLOSE1(26)
+ 26: WHILEM(0)
+ 27: NOTHING(28)
+ 28: EXACT <h>(30)
+ 30: ANYOF(40)
+ 40: EXACT <k>(42)
+ 42: EOL(43)
+ 43: END(0)
+ anchored `de' at 1 floating `gh' at 3..2147483647 (checking floating)
+ stclass `ANYOF' minlen 7
+
+The first line shows the pre-compiled form of the regexp, and the
+second shows the size of the compiled form (in arbitrary units,
+usually 4-byte words) and the label I<id> of the first node which
+does a match.
+
+The last line (split into two lines in the above) contains the optimizer
+info. In the example shown, the optimizer found that the match
+should contain a substring C<de> at the offset 1, and substring C<gh>
+at some offset between 3 and infinity. Moreover, when checking for
+these substrings (to abandon impossible matches quickly) it will check
+for the substring C<gh> before checking for the substring C<de>. The
+optimizer may also use the knowledge that the match starts (at the
+C<first> I<id>) with a character class, and the match cannot be
+shorter than 7 chars.
+
+The fields of interest which may appear in the last line are
+
+=over
+
+=item C<anchored> I<STRING> C<at> I<POS>
+
+=item C<floating> I<STRING> C<at> I<POS1..POS2>
+
+see above;
+
+=item C<matching floating/anchored>
+
+which substring to check first;
+
+=item C<minlen>
+
+the minimal length of the match;
+
+=item C<stclass> I<TYPE>
+
+The type of the first matching node.
+
+=item C<noscan>
+
+which advises to not scan for the found substrings;
+
+=item C<isall>
+
+which says that the optimizer info is in fact all that the regular
+expression contains (thus one does not need to enter the RE engine at
+all);
+
+=item C<GPOS>
+
+if the pattern contains C<\G>;
+
+=item C<plus>
+
+if the pattern starts with a repeated char (as in C<x+y>);
+
+=item C<implicit>
+
+if the pattern starts with C<.*>;
+
+=item C<with eval>
+
+if the pattern contain eval-groups (see L<perlre/(?{ code })>);
+
+=item C<anchored(TYPE)>
+
+if the pattern may
+match only at a handful of places (with C<TYPE> being
+C<BOL>, C<MBOL>, or C<GPOS>, see the table below).
+
+=back
+
+If a substring is known to match at end-of-line only, it may be
+followed by C<$>, as in C<floating `k'$>.
+
+The optimizer-specific info is used to avoid entering (a slow) RE
+engine on strings which will definitely not match. If C<isall> flag
+is set, a call to the RE engine may be avoided even when optimizer
+found an appropriate place for the match.
+
+The rest of the output contains the list of I<nodes> of the compiled
+form of the RE. Each line has format
+
+C< >I<id>: I<TYPE> I<OPTIONAL-INFO> (I<next-id>)
+
+=head2 Types of nodes
+
+Here is the list of possible types with short descriptions:
+
+ # TYPE arg-description [num-args] [longjump-len] DESCRIPTION
+
+ # Exit points
+ END no End of program.
+ SUCCEED no Return from a subroutine, basically.
+
+ # Anchors:
+ BOL no Match "" at beginning of line.
+ MBOL no Same, assuming multiline.
+ SBOL no Same, assuming singleline.
+ EOS no Match "" at end of string.
+ EOL no Match "" at end of line.
+ MEOL no Same, assuming multiline.
+ SEOL no Same, assuming singleline.
+ BOUND no Match "" at any word boundary
+ BOUNDL no Match "" at any word boundary
+ NBOUND no Match "" at any word non-boundary
+ NBOUNDL no Match "" at any word non-boundary
+ GPOS no Matches where last m//g left off.
+
+ # [Special] alternatives
+ ANY no Match any one character (except newline).
+ SANY no Match any one character.
+ ANYOF sv Match character in (or not in) this class.
+ ALNUM no Match any alphanumeric character
+ ALNUML no Match any alphanumeric char in locale
+ NALNUM no Match any non-alphanumeric character
+ NALNUML no Match any non-alphanumeric char in locale
+ SPACE no Match any whitespace character
+ SPACEL no Match any whitespace char in locale
+ NSPACE no Match any non-whitespace character
+ NSPACEL no Match any non-whitespace char in locale
+ DIGIT no Match any numeric character
+ NDIGIT no Match any non-numeric character
+
+ # BRANCH The set of branches constituting a single choice are hooked
+ # together with their "next" pointers, since precedence prevents
+ # anything being concatenated to any individual branch. The
+ # "next" pointer of the last BRANCH in a choice points to the
+ # thing following the whole choice. This is also where the
+ # final "next" pointer of each individual branch points; each
+ # branch starts with the operand node of a BRANCH node.
+ #
+ BRANCH node Match this alternative, or the next...
+
+ # BACK Normal "next" pointers all implicitly point forward; BACK
+ # exists to make loop structures possible.
+ # not used
+ BACK no Match "", "next" ptr points backward.
+
+ # Literals
+ EXACT sv Match this string (preceded by length).
+ EXACTF sv Match this string, folded (prec. by length).
+ EXACTFL sv Match this string, folded in locale (w/len).
+
+ # Do nothing
+ NOTHING no Match empty string.
+ # A variant of above which delimits a group, thus stops optimizations
+ TAIL no Match empty string. Can jump here from outside.
+
+ # STAR,PLUS '?', and complex '*' and '+', are implemented as circular
+ # BRANCH structures using BACK. Simple cases (one character
+ # per match) are implemented with STAR and PLUS for speed
+ # and to minimize recursive plunges.
+ #
+ STAR node Match this (simple) thing 0 or more times.
+ PLUS node Match this (simple) thing 1 or more times.
+
+ CURLY sv 2 Match this simple thing {n,m} times.
+ CURLYN no 2 Match next-after-this simple thing
+ # {n,m} times, set parenths.
+ CURLYM no 2 Match this medium-complex thing {n,m} times.
+ CURLYX sv 2 Match this complex thing {n,m} times.
+
+ # This terminator creates a loop structure for CURLYX
+ WHILEM no Do curly processing and see if rest matches.
+
+ # OPEN,CLOSE,GROUPP ...are numbered at compile time.
+ OPEN num 1 Mark this point in input as start of #n.
+ CLOSE num 1 Analogous to OPEN.
+
+ REF num 1 Match some already matched string
+ REFF num 1 Match already matched string, folded
+ REFFL num 1 Match already matched string, folded in loc.
+
+ # grouping assertions
+ IFMATCH off 1 2 Succeeds if the following matches.
+ UNLESSM off 1 2 Fails if the following matches.
+ SUSPEND off 1 1 "Independent" sub-RE.
+ IFTHEN off 1 1 Switch, should be preceeded by switcher .
+ GROUPP num 1 Whether the group matched.
+
+ # Support for long RE
+ LONGJMP off 1 1 Jump far away.
+ BRANCHJ off 1 1 BRANCH with long offset.
+
+ # The heavy worker
+ EVAL evl 1 Execute some Perl code.
+
+ # Modifiers
+ MINMOD no Next operator is not greedy.
+ LOGICAL no Next opcode should set the flag only.
+
+ # This is not used yet
+ RENUM off 1 1 Group with independently numbered parens.
+
+ # This is not really a node, but an optimized away piece of a "long" node.
+ # To simplify debugging output, we mark it as if it were a node
+ OPTIMIZED off Placeholder for dump.
+
+=head2 Run-time output
+
+First of all, when doing a match, one may get no run-time output even
+if debugging is enabled. this means that the RE engine was never
+entered, all of the job was done by the optimizer.
+
+If RE engine was entered, the output may look like this:
+
+ Matching `[bc]d(ef*g)+h[ij]k$' against `abcdefg__gh__'
+ Setting an EVAL scope, savestack=3
+ 2 <ab> <cdefg__gh_> | 1: ANYOF
+ 3 <abc> <defg__gh_> | 11: EXACT <d>
+ 4 <abcd> <efg__gh_> | 13: CURLYX {1,32767}
+ 4 <abcd> <efg__gh_> | 26: WHILEM
+ 0 out of 1..32767 cc=effff31c
+ 4 <abcd> <efg__gh_> | 15: OPEN1
+ 4 <abcd> <efg__gh_> | 17: EXACT <e>
+ 5 <abcde> <fg__gh_> | 19: STAR
+ EXACT <f> can match 1 times out of 32767...
+ Setting an EVAL scope, savestack=3
+ 6 <bcdef> <g__gh__> | 22: EXACT <g>
+ 7 <bcdefg> <__gh__> | 24: CLOSE1
+ 7 <bcdefg> <__gh__> | 26: WHILEM
+ 1 out of 1..32767 cc=effff31c
+ Setting an EVAL scope, savestack=12
+ 7 <bcdefg> <__gh__> | 15: OPEN1
+ 7 <bcdefg> <__gh__> | 17: EXACT <e>
+ restoring \1 to 4(4)..7
+ failed, try continuation...
+ 7 <bcdefg> <__gh__> | 27: NOTHING
+ 7 <bcdefg> <__gh__> | 28: EXACT <h>
+ failed...
+ failed...
+
+The most significant information in the output is about the particular I<node>
+of the compiled RE which is currently being tested against the target string.
+The format of these lines is
+
+C< >I<STRING-OFFSET> <I<PRE-STRING>> <I<POST-STRING>> |I<ID>: I<TYPE>
+
+The I<TYPE> info is indented with respect to the backtracking level.
+Other incidental information appears interspersed within.
+
+=cut
diff --git a/gnu/usr.bin/perl/pod/perldelta.pod b/gnu/usr.bin/perl/pod/perldelta.pod
index 7400940dcad..a0af1e16ddb 100644
--- a/gnu/usr.bin/perl/pod/perldelta.pod
+++ b/gnu/usr.bin/perl/pod/perldelta.pod
@@ -1,1556 +1,1000 @@
=head1 NAME
-perldelta - what's new for perl5.004
+perldelta - what's new for perl5.005
=head1 DESCRIPTION
-This document describes differences between the 5.003 release (as
-documented in I<Programming Perl>, second edition--the Camel Book) and
-this one.
+This document describes differences between the 5.004 release and this one.
-=head1 Supported Environments
+=head1 About the new versioning system
-Perl5.004 builds out of the box on Unix, Plan 9, LynxOS, VMS, OS/2,
-QNX, AmigaOS, and Windows NT. Perl runs on Windows 95 as well, but it
-cannot be built there, for lack of a reasonable command interpreter.
+Perl is now developed on two tracks: a maintenance track that makes
+small, safe updates to released production versions with emphasis on
+compatibility; and a development track that pursues more aggressive
+evolution. Maintenance releases (which should be considered production
+quality) have subversion numbers that run from C<1> to C<49>, and
+development releases (which should be considered "alpha" quality) run
+from C<50> to C<99>.
-=head1 Core Changes
-
-Most importantly, many bugs were fixed, including several security
-problems. See the F<Changes> file in the distribution for details.
-
-=head2 List assignment to %ENV works
-
-C<%ENV = ()> and C<%ENV = @list> now work as expected (except on VMS
-where it generates a fatal error).
-
-=head2 "Can't locate Foo.pm in @INC" error now lists @INC
-
-=head2 Compilation option: Binary compatibility with 5.003
-
-There is a new Configure question that asks if you want to maintain
-binary compatibility with Perl 5.003. If you choose binary
-compatibility, you do not have to recompile your extensions, but you
-might have symbol conflicts if you embed Perl in another application,
-just as in the 5.003 release. By default, binary compatibility
-is preserved at the expense of symbol table pollution.
-
-=head2 $PERL5OPT environment variable
-
-You may now put Perl options in the $PERL5OPT environment variable.
-Unless Perl is running with taint checks, it will interpret this
-variable as if its contents had appeared on a "#!perl" line at the
-beginning of your script, except that hyphens are optional. PERL5OPT
-may only be used to set the following switches: B<-[DIMUdmw]>.
-
-=head2 Limitations on B<-M>, B<-m>, and B<-T> options
-
-The C<-M> and C<-m> options are no longer allowed on the C<#!> line of
-a script. If a script needs a module, it should invoke it with the
-C<use> pragma.
-
-The B<-T> option is also forbidden on the C<#!> line of a script,
-unless it was present on the Perl command line. Due to the way C<#!>
-works, this usually means that B<-T> must be in the first argument.
-Thus:
+Perl 5.005 is the combined product of the new dual-track development
+scheme.
- #!/usr/bin/perl -T -w
+=head1 Incompatible Changes
-will probably work for an executable script invoked as C<scriptname>,
-while:
+=head2 WARNING: This version is not binary compatible with Perl 5.004.
- #!/usr/bin/perl -w -T
+Starting with Perl 5.004_50 there were many deep and far-reaching changes
+to the language internals. If you have dynamically loaded extensions
+that you built under perl 5.003 or 5.004, you can continue to use them
+with 5.004, but you will need to rebuild and reinstall those extensions
+to use them 5.005. See L<INSTALL> for detailed instructions on how to
+upgrade.
-will probably fail under the same conditions. (Non-Unix systems will
-probably not follow this rule.) But C<perl scriptname> is guaranteed
-to fail, since then there is no chance of B<-T> being found on the
-command line before it is found on the C<#!> line.
+=head2 Default installation structure has changed
-=head2 More precise warnings
+The new Configure defaults are designed to allow a smooth upgrade from
+5.004 to 5.005, but you should read L<INSTALL> for a detailed
+discussion of the changes in order to adapt them to your system.
-If you removed the B<-w> option from your Perl 5.003 scripts because it
-made Perl too verbose, we recommend that you try putting it back when
-you upgrade to Perl 5.004. Each new perl version tends to remove some
-undesirable warnings, while adding new warnings that may catch bugs in
-your scripts.
+=head2 Perl Source Compatibility
-=head2 Deprecated: Inherited C<AUTOLOAD> for non-methods
+When none of the experimental features are enabled, there should be
+very few user-visible Perl source compatibility issues.
-Before Perl 5.004, C<AUTOLOAD> functions were looked up as methods
-(using the C<@ISA> hierarchy), even when the function to be autoloaded
-was called as a plain function (e.g. C<Foo::bar()>), not a method
-(e.g. C<Foo-E<gt>bar()> or C<$obj-E<gt>bar()>).
+If threads are enabled, then some caveats apply. C<@_> and C<$_> become
+lexical variables. The effect of this should be largely transparent to
+the user, but there are some boundary conditions under which user will
+need to be aware of the issues. For example, C<local(@_)> results in
+a "Can't localize lexical variable @_ ..." message. This may be enabled
+in a future version.
-Perl 5.005 will use method lookup only for methods' C<AUTOLOAD>s.
-However, there is a significant base of existing code that may be using
-the old behavior. So, as an interim step, Perl 5.004 issues an optional
-warning when a non-method uses an inherited C<AUTOLOAD>.
+Some new keywords have been introduced. These are generally expected to
+have very little impact on compatibility. See L<New C<INIT> keyword>,
+L<New C<lock> keyword>, and L<New C<qr//> operator>.
-The simple rule is: Inheritance will not work when autoloading
-non-methods. The simple fix for old code is: In any module that used to
-depend on inheriting C<AUTOLOAD> for non-methods from a base class named
-C<BaseClass>, execute C<*AUTOLOAD = \&BaseClass::AUTOLOAD> during startup.
+Certain barewords are now reserved. Use of these will provoke a warning
+if you have asked for them with the C<-w> switch.
+See L<C<our> is now a reserved word>.
-=head2 Previously deprecated %OVERLOAD is no longer usable
+=head2 C Source Compatibility
-Using %OVERLOAD to define overloading was deprecated in 5.003.
-Overloading is now defined using the overload pragma. %OVERLOAD is
-still used internally but should not be used by Perl scripts. See
-L<overload> for more details.
+There have been a large number of changes in the internals to support
+the new features in this release.
-=head2 Subroutine arguments created only when they're modified
+=over 4
-In Perl 5.004, nonexistent array and hash elements used as subroutine
-parameters are brought into existence only if they are actually
-assigned to (via C<@_>).
+=item Core sources now require ANSI C compiler
-Earlier versions of Perl vary in their handling of such arguments.
-Perl versions 5.002 and 5.003 always brought them into existence.
-Perl versions 5.000 and 5.001 brought them into existence only if
-they were not the first argument (which was almost certainly a bug).
-Earlier versions of Perl never brought them into existence.
+An ANSI C compiler is now B<required> to build perl. See F<INSTALL>.
-For example, given this code:
+=item All Perl global variables must now be referenced with an explicit prefix
- undef @a; undef %a;
- sub show { print $_[0] };
- sub change { $_[0]++ };
- show($a[2]);
- change($a{b});
+All Perl global variables that are visible for use by extensions now
+have a C<PL_> prefix. New extensions should C<not> refer to perl globals
+by their unqualified names. To preserve sanity, we provide limited
+backward compatibility for globals that are being widely used like
+C<sv_undef> and C<na> (which should now be written as C<PL_sv_undef>,
+C<PL_na> etc.)
-After this code executes in Perl 5.004, $a{b} exists but $a[2] does
-not. In Perl 5.002 and 5.003, both $a{b} and $a[2] would have existed
-(but $a[2]'s value would have been undefined).
+If you find that your XS extension does not compile anymore because a
+perl global is not visible, try adding a C<PL_> prefix to the global
+and rebuild.
-=head2 Group vector changeable with C<$)>
+It is strongly recommended that all functions in the Perl API that don't
+begin with C<perl> be referenced with a C<Perl_> prefix. The bare function
+names without the C<Perl_> prefix are supported with macros, but this
+support may cease in a future release.
-The C<$)> special variable has always (well, in Perl 5, at least)
-reflected not only the current effective group, but also the group list
-as returned by the C<getgroups()> C function (if there is one).
-However, until this release, there has not been a way to call the
-C<setgroups()> C function from Perl.
+See L<perlguts/"API LISTING">.
-In Perl 5.004, assigning to C<$)> is exactly symmetrical with examining
-it: The first number in its string value is used as the effective gid;
-if there are any numbers after the first one, they are passed to the
-C<setgroups()> C function (if there is one).
+=item Enabling threads has source compatibility issues
-=head2 Fixed parsing of $$<digit>, &$<digit>, etc.
+Perl built with threading enabled requires extensions to use the new
+C<dTHR> macro to initialize the handle to access per-thread data.
+If you see a compiler error that talks about the variable C<thr> not
+being declared (when building a module that has XS code), you need
+to add C<dTHR;> at the beginning of the block that elicited the error.
-Perl versions before 5.004 misinterpreted any type marker followed by
-"$" and a digit. For example, "$$0" was incorrectly taken to mean
-"${$}0" instead of "${$0}". This bug is (mostly) fixed in Perl 5.004.
+The API function C<perl_get_sv("@",FALSE)> should be used instead of
+directly accessing perl globals as C<GvSV(errgv)>. The API call is
+backward compatible with existing perls and provides source compatibility
+with threading is enabled.
-However, the developers of Perl 5.004 could not fix this bug completely,
-because at least two widely-used modules depend on the old meaning of
-"$$0" in a string. So Perl 5.004 still interprets "$$<digit>" in the
-old (broken) way inside strings; but it generates this message as a
-warning. And in Perl 5.005, this special treatment will cease.
-
-=head2 Fixed localization of $<digit>, $&, etc.
-
-Perl versions before 5.004 did not always properly localize the
-regex-related special variables. Perl 5.004 does localize them, as
-the documentation has always said it should. This may result in $1,
-$2, etc. no longer being set where existing programs use them.
-
-=head2 No resetting of $. on implicit close
-
-The documentation for Perl 5.0 has always stated that C<$.> is I<not>
-reset when an already-open file handle is reopened with no intervening
-call to C<close>. Due to a bug, perl versions 5.000 through 5.003
-I<did> reset C<$.> under that circumstance; Perl 5.004 does not.
-
-=head2 C<wantarray> may return undef
-
-The C<wantarray> operator returns true if a subroutine is expected to
-return a list, and false otherwise. In Perl 5.004, C<wantarray> can
-also return the undefined value if a subroutine's return value will
-not be used at all, which allows subroutines to avoid a time-consuming
-calculation of a return value if it isn't going to be used.
-
-=head2 Changes to tainting checks
-
-A bug in previous versions may have failed to detect some insecure
-conditions when taint checks are turned on. (Taint checks are used
-in setuid or setgid scripts, or when explicitly turned on with the
-C<-T> invocation option.) Although it's unlikely, this may cause a
-previously-working script to now fail -- which should be construed
-as a blessing, since that indicates a potentially-serious security
-hole was just plugged.
-
-The new restrictions when tainting include:
-
-=over
-
-=item No glob() or <*>
-
-These operators may spawn the C shell (csh), which cannot be made
-safe. This restriction will be lifted in a future version of Perl
-when globbing is implemented without the use of an external program.
-
-=item No spawning if tainted $CDPATH, $ENV, $BASH_ENV
-
-These environment variables may alter the behavior of spawned programs
-(especially shells) in ways that subvert security. So now they are
-treated as dangerous, in the manner of $IFS and $PATH.
-
-=item No spawning if tainted $TERM doesn't look like a terminal name
-
-Some termcap libraries do unsafe things with $TERM. However, it would be
-unnecessarily harsh to treat all $TERM values as unsafe, since only shell
-metacharacters can cause trouble in $TERM. So a tainted $TERM is
-considered to be safe if it contains only alphanumerics, underscores,
-dashes, and colons, and unsafe if it contains other characters (including
-whitespace).
+See L<"C Source Compatibility"> for more information.
=back
-=head2 New Opcode module and revised Safe module
-
-A new Opcode module supports the creation, manipulation and
-application of opcode masks. The revised Safe module has a new API
-and is implemented using the new Opcode module. Please read the new
-Opcode and Safe documentation.
-
-=head2 Embedding improvements
-
-In older versions of Perl it was not possible to create more than one
-Perl interpreter instance inside a single process without leaking like a
-sieve and/or crashing. The bugs that caused this behavior have all been
-fixed. However, you still must take care when embedding Perl in a C
-program. See the updated perlembed manpage for tips on how to manage
-your interpreters.
-
-=head2 Internal change: FileHandle class based on IO::* classes
-
-File handles are now stored internally as type IO::Handle. The
-FileHandle module is still supported for backwards compatibility, but
-it is now merely a front end to the IO::* modules -- specifically,
-IO::Handle, IO::Seekable, and IO::File. We suggest, but do not
-require, that you use the IO::* modules in new code.
+=head2 Binary Compatibility
-In harmony with this change, C<*GLOB{FILEHANDLE}> is now just a
-backward-compatible synonym for C<*GLOB{IO}>.
+This version is NOT binary compatible with older versions. All extensions
+will need to be recompiled. Further binaries built with threads enabled
+are incompatible with binaries built without. This should largely be
+transparent to the user, as all binary incompatible configurations have
+their own unique architecture name, and extension binaries get installed at
+unique locations. This allows coexistence of several configurations in
+the same directory hierarchy. See F<INSTALL>.
-=head2 Internal change: PerlIO abstraction interface
+=head2 Security fixes may affect compatibility
-It is now possible to build Perl with AT&T's sfio IO package
-instead of stdio. See L<perlapio> for more details, and
-the F<INSTALL> file for how to use it.
+A few taint leaks and taint omissions have been corrected. This may lead
+to "failure" of scripts that used to work with older versions. Compiling
+with -DINCOMPLETE_TAINTS provides a perl with minimal amounts of changes
+to the tainting behavior. But note that the resulting perl will have
+known insecurities.
-=head2 New and changed syntax
+Oneliners with the C<-e> switch do not create temporary files anymore.
-=over
+=head2 Relaxed new mandatory warnings introduced in 5.004
-=item $coderef->(PARAMS)
+Many new warnings that were introduced in 5.004 have been made
+optional. Some of these warnings are still present, but perl's new
+features make them less often a problem. See L<New Diagnostics>.
-A subroutine reference may now be suffixed with an arrow and a
-(possibly empty) parameter list. This syntax denotes a call of the
-referenced subroutine, with the given parameters (if any).
+=head2 Licensing
-This new syntax follows the pattern of S<C<$hashref-E<gt>{FOO}>> and
-S<C<$aryref-E<gt>[$foo]>>: You may now write S<C<&$subref($foo)>> as
-S<C<$subref-E<gt>($foo)>>. All of these arrow terms may be chained;
-thus, S<C<&{$table-E<gt>{FOO}}($bar)>> may now be written
-S<C<$table-E<gt>{FOO}-E<gt>($bar)>>.
+Perl has a new Social Contract for contributors. See F<Porting/Contract>.
-=back
+The license included in much of the Perl documentation has changed.
+Most of the Perl documentation was previously under the implicit GNU
+General Public License or the Artistic License (at the user's choice).
+Now much of the documentation unambigously states the terms under which
+it may be distributed. Those terms are in general much less restrictive
+than the GNU GPL. See L<perl> and the individual perl man pages listed
+therein.
-=head2 New and changed builtin constants
+=head1 Core Changes
-=over
-=item __PACKAGE__
+=head2 Threads
-The current package name at compile time, or the undefined value if
-there is no current package (due to a C<package;> directive). Like
-C<__FILE__> and C<__LINE__>, C<__PACKAGE__> does I<not> interpolate
-into strings.
+WARNING: Threading is considered an B<experimental> feature. Details of the
+implementation may change without notice. There are known limitations
+and some bugs. These are expected to be fixed in future versions.
-=back
+See L<README.threads>.
-=head2 New and changed builtin variables
+Mach cthreads (NEXTSTEP, OPENSTEP, Rhapsody) are now supported by
+the Thread extension.
-=over
+=head2 Compiler
-=item $^E
+WARNING: The Compiler and related tools are considered B<experimental>.
+Features may change without notice, and there are known limitations
+and bugs. Since the compiler is fully external to perl, the default
+configuration will build and install it.
-Extended error message on some platforms. (Also known as
-$EXTENDED_OS_ERROR if you C<use English>).
+The Compiler produces three different types of transformations of a
+perl program. The C backend generates C code that captures perl's state
+just before execution begins. It eliminates the compile-time overheads
+of the regular perl interpreter, but the run-time performance remains
+comparatively the same. The CC backend generates optimized C code
+equivalent to the code path at run-time. The CC backend has greater
+potential for big optimizations, but only a few optimizations are
+implemented currently. The Bytecode backend generates a platform
+independent bytecode representation of the interpreter's state
+just before execution. Thus, the Bytecode back end also eliminates
+much of the compilation overhead of the interpreter.
-=item $^H
+The compiler comes with several valuable utilities.
-The current set of syntax checks enabled by C<use strict>. See the
-documentation of C<strict> for more details. Not actually new, but
-newly documented.
-Because it is intended for internal use by Perl core components,
-there is no C<use English> long name for this variable.
+C<B::Lint> is an experimental module to detect and warn about suspicious
+code, especially the cases that the C<-w> switch does not detect.
-=item $^M
+C<B::Deparse> can be used to demystify perl code, and understand
+how perl optimizes certain constructs.
-By default, running out of memory it is not trappable. However, if
-compiled for this, Perl may use the contents of C<$^M> as an emergency
-pool after die()ing with this message. Suppose that your Perl were
-compiled with -DPERL_EMERGENCY_SBRK and used Perl's malloc. Then
+C<B::Xref> generates cross reference reports of all definition and use
+of variables, subroutines and formats in a program.
- $^M = 'a' x (1<<16);
+C<B::Showlex> show the lexical variables used by a subroutine or file
+at a glance.
-would allocate a 64K buffer for use when in emergency.
-See the F<INSTALL> file for information on how to enable this option.
-As a disincentive to casual use of this advanced feature,
-there is no C<use English> long name for this variable.
+C<perlcc> is a simple frontend for compiling perl.
-=back
+See C<ext/B/README>, L<B>, and the respective compiler modules.
-=head2 New and changed builtin functions
+=head2 Regular Expressions
-=over
+Perl's regular expression engine has been seriously overhauled, and
+many new constructs are supported. Several bugs have been fixed.
-=item delete on slices
+Here is an itemized summary:
-This now works. (e.g. C<delete @ENV{'PATH', 'MANPATH'}>)
+=over 4
-=item flock
+=item Many new and improved optimizations
-is now supported on more platforms, prefers fcntl to lockf when
-emulating, and always flushes before (un)locking.
+Changes in the RE engine:
-=item printf and sprintf
+ Unneeded nodes removed;
+ Substrings merged together;
+ New types of nodes to process (SUBEXPR)* and similar expressions
+ quickly, used if the SUBEXPR has no side effects and matches
+ strings of the same length;
+ Better optimizations by lookup for constant substrings;
+ Better search for constants substrings anchored by $ ;
-Perl now implements these functions itself; it doesn't use the C
-library function sprintf() any more, except for floating-point
-numbers, and even then only known flags are allowed. As a result, it
-is now possible to know which conversions and flags will work, and
-what they will do.
+Changes in Perl code using RE engine:
-The new conversions in Perl's sprintf() are:
+ More optimizations to s/longer/short/;
+ study() was not working;
+ /blah/ may be optimized to an analogue of index() if $& $` $' not seen;
+ Unneeded copying of matched-against string removed;
+ Only matched part of the string is copying if $` $' were not seen;
- %i a synonym for %d
- %p a pointer (the address of the Perl value, in hexadecimal)
- %n special: *stores* the number of characters output so far
- into the next variable in the parameter list
+=item Many bug fixes
-The new flags that go between the C<%> and the conversion are:
+Note that only the major bug fixes are listed here. See F<Changes> for others.
- # prefix octal with "0", hex with "0x"
- h interpret integer as C type "short" or "unsigned short"
- V interpret integer as Perl's standard integer type
+ Backtracking might not restore start of $3.
+ No feedback if max count for * or + on "complex" subexpression
+ was reached, similarly (but at compile time) for {3,34567}
+ Primitive restrictions on max count introduced to decrease a
+ possibility of a segfault;
+ (ZERO-LENGTH)* could segfault;
+ (ZERO-LENGTH)* was prohibited;
+ Long REs were not allowed;
+ /RE/g could skip matches at the same position after a
+ zero-length match;
-Also, where a number would appear in the flags, an asterisk ("*") may
-be used instead, in which case Perl uses the next item in the
-parameter list as the given number (that is, as the field width or
-precision). If a field width obtained through "*" is negative, it has
-the same effect as the '-' flag: left-justification.
+=item New regular expression constructs
-See L<perlfunc/sprintf> for a complete list of conversion and flags.
+The following new syntax elements are supported:
-=item keys as an lvalue
+ (?<=RE)
+ (?<!RE)
+ (?{ CODE })
+ (?i-x)
+ (?i:RE)
+ (?(COND)YES_RE|NO_RE)
+ (?>RE)
+ \z
-As an lvalue, C<keys> allows you to increase the number of hash buckets
-allocated for the given hash. This can gain you a measure of efficiency if
-you know the hash is going to get big. (This is similar to pre-extending
-an array by assigning a larger number to $#array.) If you say
+=item New operator for precompiled regular expressions
- keys %hash = 200;
+See L<New C<qr//> operator>.
-then C<%hash> will have at least 200 buckets allocated for it. These
-buckets will be retained even if you do C<%hash = ()>; use C<undef
-%hash> if you want to free the storage while C<%hash> is still in scope.
-You can't shrink the number of buckets allocated for the hash using
-C<keys> in this way (but you needn't worry about doing this by accident,
-as trying has no effect).
+=item Other improvements
-=item my() in Control Structures
+ Better debugging output (possibly with colors),
+ even from non-debugging Perl;
+ RE engine code now looks like C, not like assembler;
+ Behaviour of RE modifiable by `use re' directive;
+ Improved documentation;
+ Test suite significantly extended;
+ Syntax [:^upper:] etc., reserved inside character classes;
-You can now use my() (with or without the parentheses) in the control
-expressions of control structures such as:
+=item Incompatible changes
- while (defined(my $line = <>)) {
- $line = lc $line;
- } continue {
- print $line;
- }
-
- if ((my $answer = <STDIN>) =~ /^y(es)?$/i) {
- user_agrees();
- } elsif ($answer =~ /^n(o)?$/i) {
- user_disagrees();
- } else {
- chomp $answer;
- die "`$answer' is neither `yes' nor `no'";
- }
+ (?i) localized inside enclosing group;
+ $( is not interpolated into RE any more;
+ /RE/g may match at the same position (with non-zero length)
+ after a zero-length match (bug fix).
-Also, you can declare a foreach loop control variable as lexical by
-preceding it with the word "my". For example, in:
+=back
- foreach my $i (1, 2, 3) {
- some_function();
- }
+See L<perlre> and L<perlop>.
-$i is a lexical variable, and the scope of $i extends to the end of
-the loop, but not beyond it.
+=head2 Improved malloc()
-Note that you still cannot use my() on global punctuation variables
-such as $_ and the like.
+See banner at the beginning of C<malloc.c> for details.
-=item pack() and unpack()
+=head2 Quicksort is internally implemented
-A new format 'w' represents a BER compressed integer (as defined in
-ASN.1). Its format is a sequence of one or more bytes, each of which
-provides seven bits of the total value, with the most significant
-first. Bit eight of each byte is set, except for the last byte, in
-which bit eight is clear.
+Perl now contains its own highly optimized qsort() routine. The new qsort()
+is resistant to inconsistent comparison functions, so Perl's C<sort()> will
+not provoke coredumps any more when given poorly written sort subroutines.
+(Some C library C<qsort()>s that were being used before used to have this
+problem.) In our testing, the new C<qsort()> required the minimal number
+of pair-wise compares on average, among all known C<qsort()> implementations.
-If 'p' or 'P' are given undef as values, they now generate a NULL
-pointer.
+See C<perlfunc/sort>.
-Both pack() and unpack() now fail when their templates contain invalid
-types. (Invalid types used to be ignored.)
+=head2 Reliable signals
-=item sysseek()
+Perl's signal handling is susceptible to random crashes, because signals
+arrive asynchronously, and the Perl runtime is not reentrant at arbitrary
+times.
-The new sysseek() operator is a variant of seek() that sets and gets the
-file's system read/write position, using the lseek(2) system call. It is
-the only reliable way to seek before using sysread() or syswrite(). Its
-return value is the new position, or the undefined value on failure.
+However, one experimental implementation of reliable signals is available
+when threads are enabled. See C<Thread::Signal>. Also see F<INSTALL> for
+how to build a Perl capable of threads.
-=item use VERSION
+=head2 Reliable stack pointers
-If the first argument to C<use> is a number, it is treated as a version
-number instead of a module name. If the version of the Perl interpreter
-is less than VERSION, then an error message is printed and Perl exits
-immediately. Because C<use> occurs at compile time, this check happens
-immediately during the compilation process, unlike C<require VERSION>,
-which waits until runtime for the check. This is often useful if you
-need to check the current Perl version before C<use>ing library modules
-which have changed in incompatible ways from older versions of Perl.
-(We try not to do this more than we have to.)
+The internals now reallocate the perl stack only at predictable times.
+In particular, magic calls never trigger reallocations of the stack,
+because all reentrancy of the runtime is handled using a "stack of stacks".
+This should improve reliability of cached stack pointers in the internals
+and in XSUBs.
-=item use Module VERSION LIST
+=head2 More generous treatment of carriage returns
-If the VERSION argument is present between Module and LIST, then the
-C<use> will call the VERSION method in class Module with the given
-version as an argument. The default VERSION method, inherited from
-the UNIVERSAL class, croaks if the given version is larger than the
-value of the variable $Module::VERSION. (Note that there is not a
-comma after VERSION!)
+Perl used to complain if it encountered literal carriage returns in
+scripts. Now they are mostly treated like whitespace within program text.
+Inside string literals and here documents, literal carriage returns are
+ignored if they occur paired with linefeeds, or get interpreted as whitespace
+if they stand alone. This behavior means that literal carriage returns
+in files should be avoided. You can get the older, more compatible (but
+less generous) behavior by defining the preprocessor symbol
+C<PERL_STRICT_CR> when building perl. Of course, all this has nothing
+whatever to do with how escapes like C<\r> are handled within strings.
-This version-checking mechanism is similar to the one currently used
-in the Exporter module, but it is faster and can be used with modules
-that don't use the Exporter. It is the recommended method for new
-code.
+Note that this doesn't somehow magically allow you to keep all text files
+in DOS format. The generous treatment only applies to files that perl
+itself parses. If your C compiler doesn't allow carriage returns in
+files, you may still be unable to build modules that need a C compiler.
-=item prototype(FUNCTION)
+=head2 Memory leaks
-Returns the prototype of a function as a string (or C<undef> if the
-function has no prototype). FUNCTION is a reference to or the name of the
-function whose prototype you want to retrieve.
-(Not actually new; just never documented before.)
+C<substr>, C<pos> and C<vec> don't leak memory anymore when used in lvalue
+context. Many small leaks that impacted applications that embed multiple
+interpreters have been fixed.
-=item srand
+=head2 Better support for multiple interpreters
-The default seed for C<srand>, which used to be C<time>, has been changed.
-Now it's a heady mix of difficult-to-predict system-dependent values,
-which should be sufficient for most everyday purposes.
+The build-time option C<-DMULTIPLICITY> has had many of the details
+reworked. Some previously global variables that should have been
+per-interpreter now are. With care, this allows interpreters to call
+each other. See the C<PerlInterp> extension on CPAN.
-Previous to version 5.004, calling C<rand> without first calling C<srand>
-would yield the same sequence of random numbers on most or all machines.
-Now, when perl sees that you're calling C<rand> and haven't yet called
-C<srand>, it calls C<srand> with the default seed. You should still call
-C<srand> manually if your code might ever be run on a pre-5.004 system,
-of course, or if you want a seed other than the default.
+=head2 Behavior of local() on array and hash elements is now well-defined
-=item $_ as Default
+See L<perlsub/"Temporary Values via local()">.
-Functions documented in the Camel to default to $_ now in
-fact do, and all those that do are so documented in L<perlfunc>.
+=head2 C<%!> is transparently tied to the L<Errno> module
-=item C<m//gc> does not reset search position on failure
+See L<perlvar>, and L<Errno>.
-The C<m//g> match iteration construct has always reset its target
-string's search position (which is visible through the C<pos> operator)
-when a match fails; as a result, the next C<m//g> match after a failure
-starts again at the beginning of the string. With Perl 5.004, this
-reset may be disabled by adding the "c" (for "continue") modifier,
-i.e. C<m//gc>. This feature, in conjunction with the C<\G> zero-width
-assertion, makes it possible to chain matches together. See L<perlop>
-and L<perlre>.
+=head2 Pseudo-hashes are supported
-=item C<m//x> ignores whitespace before ?*+{}
+See L<perlref>.
-The C<m//x> construct has always been intended to ignore all unescaped
-whitespace. However, before Perl 5.004, whitespace had the effect of
-escaping repeat modifiers like "*" or "?"; for example, C</a *b/x> was
-(mis)interpreted as C</a\*b/x>. This bug has been fixed in 5.004.
+=head2 C<EXPR foreach EXPR> is supported
-=item nested C<sub{}> closures work now
+See L<perlsyn>.
-Prior to the 5.004 release, nested anonymous functions didn't work
-right. They do now.
+=head2 Keywords can be globally overridden
-=item formats work right on changing lexicals
+See L<perlsub>.
-Just like anonymous functions that contain lexical variables
-that change (like a lexical index variable for a C<foreach> loop),
-formats now work properly. For example, this silently failed
-before (printed only zeros), but is fine now:
+=head2 C<$^E> is meaningful on Win32
- my $i;
- foreach $i ( 1 .. 10 ) {
- write;
- }
- format =
- my i is @#
- $i
- .
-
-However, it still fails (without a warning) if the foreach is within a
-subroutine:
-
- my $i;
- sub foo {
- foreach $i ( 1 .. 10 ) {
- write;
- }
- }
- foo;
- format =
- my i is @#
- $i
- .
+See L<perlvar>.
-=back
+=head2 C<foreach (1..1000000)> optimized
-=head2 New builtin methods
+C<foreach (1..1000000)> is now optimized into a counting loop. It does
+not try to allocate a 1000000-size list anymore.
-The C<UNIVERSAL> package automatically contains the following methods that
-are inherited by all other classes:
+=head2 C<Foo::> can be used as implicitly quoted package name
-=over
+Barewords caused unintuitive behavior when a subroutine with the same
+name as a package happened to be defined. Thus, C<new Foo @args>,
+use the result of the call to C<Foo()> instead of C<Foo> being treated
+as a literal. The recommended way to write barewords in the indirect
+object slot is C<new Foo:: @args>. Note that the method C<new()> is
+called with a first argument of C<Foo>, not C<Foo::> when you do that.
-=item isa(CLASS)
+=head2 C<exists $Foo::{Bar::}> tests existence of a package
-C<isa> returns I<true> if its object is blessed into a subclass of C<CLASS>
+It was impossible to test for the existence of a package without
+actually creating it before. Now C<exists $Foo::{Bar::}> can be
+used to test if the C<Foo::Bar> namespace has been created.
-C<isa> is also exportable and can be called as a sub with two arguments. This
-allows the ability to check what a reference points to. Example:
+=head2 Better locale support
- use UNIVERSAL qw(isa);
+See L<perllocale>.
- if(isa($ref, 'ARRAY')) {
- ...
- }
-
-=item can(METHOD)
-
-C<can> checks to see if its object has a method called C<METHOD>,
-if it does then a reference to the sub is returned; if it does not then
-I<undef> is returned.
+=head2 Experimental support for 64-bit platforms
-=item VERSION( [NEED] )
+Perl5 has always had 64-bit support on systems with 64-bit longs.
+Starting with 5.005, the beginnings of experimental support for systems
+with 32-bit long and 64-bit 'long long' integers has been added.
+If you add -DUSE_LONG_LONG to your ccflags in config.sh (or manually
+define it in perl.h) then perl will be built with 'long long' support.
+There will be many compiler warnings, and the resultant perl may not
+work on all systems. There are many other issues related to
+third-party extensions and libraries. This option exists to allow
+people to work on those issues.
-C<VERSION> returns the version number of the class (package). If the
-NEED argument is given then it will check that the current version (as
-defined by the $VERSION variable in the given package) not less than
-NEED; it will die if this is not the case. This method is normally
-called as a class method. This method is called automatically by the
-C<VERSION> form of C<use>.
+=head2 prototype() returns useful results on builtins
- use A 1.2 qw(some imported subs);
- # implies:
- A->VERSION(1.2);
-
-=back
+See L<perlfunc/prototype>.
-B<NOTE:> C<can> directly uses Perl's internal code for method lookup, and
-C<isa> uses a very similar method and caching strategy. This may cause
-strange effects if the Perl code dynamically changes @ISA in any package.
+=head2 Extended support for exception handling
-You may add other methods to the UNIVERSAL class via Perl or XS code.
-You do not need to C<use UNIVERSAL> in order to make these methods
-available to your program. This is necessary only if you wish to
-have C<isa> available as a plain subroutine in the current package.
+C<die()> now accepts a reference value, and C<$@> gets set to that
+value in exception traps. This makes it possible to propagate
+exception objects. This is an undocumented B<experimental> feature.
-=head2 TIEHANDLE now supported
+=head2 Re-blessing in DESTROY() supported for chaining DESTROY() methods
-See L<perltie> for other kinds of tie()s.
+See L<perlobj/Destructors>.
-=over
+=head2 All C<printf> format conversions are handled internally
-=item TIEHANDLE classname, LIST
+See L<perlfunc/printf>.
-This is the constructor for the class. That means it is expected to
-return an object of some sort. The reference can be used to
-hold some internal information.
+=head2 New C<INIT> keyword
- sub TIEHANDLE {
- print "<shout>\n";
- my $i;
- return bless \$i, shift;
- }
+C<INIT> subs are like C<BEGIN> and C<END>, but they get run just before
+the perl runtime begins execution. e.g., the Perl Compiler makes use of
+C<INIT> blocks to initialize and resolve pointers to XSUBs.
-=item PRINT this, LIST
+=head2 New C<lock> keyword
-This method will be triggered every time the tied handle is printed to.
-Beyond its self reference it also expects the list that was passed to
-the print function.
+The C<lock> keyword is the fundamental synchronization primitive
+in threaded perl. When threads are not enabled, it is currently a noop.
- sub PRINT {
- $r = shift;
- $$r++;
- return print join( $, => map {uc} @_), $\;
- }
+To minimize impact on source compatibility this keyword is "weak", i.e., any
+user-defined subroutine of the same name overrides it, unless a C<use Thread>
+has been seen.
-=item PRINTF this, LIST
+=head2 New C<qr//> operator
-This method will be triggered every time the tied handle is printed to
-with the C<printf()> function.
-Beyond its self reference it also expects the format and list that was
-passed to the printf function.
+The C<qr//> operator, which is syntactically similar to the other quote-like
+operators, is used to create precompiled regular expressions. This compiled
+form can now be explicitly passed around in variables, and interpolated in
+other regular expressions. See L<perlop>.
- sub PRINTF {
- shift;
- my $fmt = shift;
- print sprintf($fmt, @_)."\n";
- }
+=head2 C<our> is now a reserved word
-=item READ this LIST
+Calling a subroutine with the name C<our> will now provoke a warning when
+using the C<-w> switch.
-This method will be called when the handle is read from via the C<read>
-or C<sysread> functions.
+=head2 Tied arrays are now fully supported
- sub READ {
- $r = shift;
- my($buf,$len,$offset) = @_;
- print "READ called, \$buf=$buf, \$len=$len, \$offset=$offset";
- }
+See L<Tie::Array>.
-=item READLINE this
+=head2 Tied handles support is better
-This method will be called when the handle is read from. The method
-should return undef when there is no more data.
+Several missing hooks have been added. There is also a new base class for
+TIEARRAY implementations. See L<Tie::Array>.
- sub READLINE {
- $r = shift;
- return "PRINT called $$r times\n"
- }
+=head2 4th argument to substr
-=item GETC this
+substr() can now both return and replace in one operation. The optional
+4th argument is the replacement string. See L<perlfunc/substr>.
-This method will be called when the C<getc> function is called.
+=head2 Negative LENGTH argument to splice
- sub GETC { print "Don't GETC, Get Perl"; return "a"; }
+splice() with a negative LENGTH argument now work similar to what the
+LENGTH did for substr(). Previously a negative LENGTH was treated as
+0. See L<perlfunc/splice>.
-=item DESTROY this
+=head2 Magic lvalues are now more magical
-As with the other types of ties, this method will be called when the
-tied handle is about to be destroyed. This is useful for debugging and
-possibly for cleaning up.
+When you say something like C<substr($x, 5) = "hi">, the scalar returned
+by substr() is special, in that any modifications to it affect $x.
+(This is called a 'magic lvalue' because an 'lvalue' is something on
+the left side of an assignment.) Normally, this is exactly what you
+would expect to happen, but Perl uses the same magic if you use substr(),
+pos(), or vec() in a context where they might be modified, like taking
+a reference with C<\> or as an argument to a sub that modifies C<@_>.
+In previous versions, this 'magic' only went one way, but now changes
+to the scalar the magic refers to ($x in the above example) affect the
+magic lvalue too. For instance, this code now acts differently:
- sub DESTROY {
- print "</shout>\n";
+ $x = "hello";
+ sub printit {
+ $x = "g'bye";
+ print $_[0], "\n";
}
+ printit(substr($x, 0, 5));
-=back
-
-=head2 Malloc enhancements
-
-If perl is compiled with the malloc included with the perl distribution
-(that is, if C<perl -V:d_mymalloc> is 'define') then you can print
-memory statistics at runtime by running Perl thusly:
-
- env PERL_DEBUG_MSTATS=2 perl your_script_here
-
-The value of 2 means to print statistics after compilation and on
-exit; with a value of 1, the statistics are printed only on exit.
-(If you want the statistics at an arbitrary time, you'll need to
-install the optional module Devel::Peek.)
+In previous versions, this would print "hello", but it now prints "g'bye".
-Three new compilation flags are recognized by malloc.c. (They have no
-effect if perl is compiled with system malloc().)
+=head2 E<lt>E<gt> now reads in records
-=over
+If C<$/> is a referenence to an integer, or a scalar that holds an integer,
+E<lt>E<gt> will read in records instead of lines. For more info, see
+L<perlvar/$/>.
-=item -DPERL_EMERGENCY_SBRK
+=head2 pack() format 'Z' supported
-If this macro is defined, running out of memory need not be a fatal
-error: a memory pool can allocated by assigning to the special
-variable C<$^M>. See L<"$^M">.
+The new format type 'Z' is useful for packing and unpacking null-terminated
+strings. See L<perlfunc/"pack">.
-=item -DPACK_MALLOC
+=head1 Significant bug fixes
-Perl memory allocation is by bucket with sizes close to powers of two.
-Because of these malloc overhead may be big, especially for data of
-size exactly a power of two. If C<PACK_MALLOC> is defined, perl uses
-a slightly different algorithm for small allocations (up to 64 bytes
-long), which makes it possible to have overhead down to 1 byte for
-allocations which are powers of two (and appear quite often).
+=head2 E<lt>HANDLEE<gt> on empty files
-Expected memory savings (with 8-byte alignment in C<alignbytes>) is
-about 20% for typical Perl usage. Expected slowdown due to additional
-malloc overhead is in fractions of a percent (hard to measure, because
-of the effect of saved memory on speed).
+With C<$/> set to C<undef>, slurping an empty file returns a string of
+zero length (instead of C<undef>, as it used to) for the first time the
+HANDLE is read. Subsequent reads yield C<undef>.
-=item -DTWO_POT_OPTIMIZE
+This means that the following will append "foo" to an empty file (it used
+to not do anything before):
-Similarly to C<PACK_MALLOC>, this macro improves allocations of data
-with size close to a power of two; but this works for big allocations
-(starting with 16K by default). Such allocations are typical for big
-hashes and special-purpose scripts, especially image processing.
+ perl -0777 -pi -e 's/^/foo/' empty_file
-On recent systems, the fact that perl requires 2M from system for 1M
-allocation will not affect speed of execution, since the tail of such
-a chunk is not going to be touched (and thus will not require real
-memory). However, it may result in a premature out-of-memory error.
-So if you will be manipulating very large blocks with sizes close to
-powers of two, it would be wise to define this macro.
+Note that the behavior of:
-Expected saving of memory is 0-100% (100% in applications which
-require most memory in such 2**n chunks); expected slowdown is
-negligible.
+ perl -pi -e 's/^/foo/' empty_file
-=back
+is unchanged (it continues to leave the file empty).
-=head2 Miscellaneous efficiency enhancements
+=head1 Supported Platforms
-Functions that have an empty prototype and that do nothing but return
-a fixed value are now inlined (e.g. C<sub PI () { 3.14159 }>).
+Configure has many incremental improvements. Site-wide policy for building
+perl can now be made persistent, via Policy.sh. Configure also records
+the command-line arguments used in F<config.sh>.
-Each unique hash key is only allocated once, no matter how many hashes
-have an entry with that key. So even if you have 100 copies of the
-same hash, the hash keys never have to be reallocated.
+=head2 New Platforms
-=head1 Support for More Operating Systems
+BeOS is now supported. See L<README.beos>.
-Support for the following operating systems is new in Perl 5.004.
+DOS is now supported under the DJGPP tools. See L<README.dos>.
-=head2 Win32
+GNU/Hurd is now supported.
-Perl 5.004 now includes support for building a "native" perl under
-Windows NT, using the Microsoft Visual C++ compiler (versions 2.0
-and above) or the Borland C++ compiler (versions 5.02 and above).
-The resulting perl can be used under Windows 95 (if it
-is installed in the same directory locations as it got installed
-in Windows NT). This port includes support for perl extension
-building tools like L<MakeMaker> and L<h2xs>, so that many extensions
-available on the Comprehensive Perl Archive Network (CPAN) can now be
-readily built under Windows NT. See http://www.perl.com/ for more
-information on CPAN, and L<README.win32> for more details on how to
-get started with building this port.
+MiNT is now supported. See L<README.mint>.
-There is also support for building perl under the Cygwin32 environment.
-Cygwin32 is a set of GNU tools that make it possible to compile and run
-many UNIX programs under Windows NT by providing a mostly UNIX-like
-interface for compilation and execution. See L<README.cygwin32> for
-more details on this port, and how to obtain the Cygwin32 toolkit.
+MPE/iX is now supported. See L<README.mpeix>.
-=head2 Plan 9
+MVS (aka OS390, aka Open Edition) is now supported. See L<README.os390>.
-See L<README.plan9>.
+Stratus VOS is now supported. See L<README.vos>.
-=head2 QNX
+=head2 Changes in existing support
-See L<README.qnx>.
+Win32 support has been vastly enhanced. Support for Perl Object, a C++
+encapsulation of Perl. GCC and EGCS are now supported on Win32.
+See F<README.win32>, aka L<perlwin32>.
-=head2 AmigaOS
+VMS configuration system has been rewritten. See L<README.vms>.
-See L<README.amigaos>.
+The hints files for most Unix platforms have seen incremental improvements.
-=head1 Pragmata
+=head1 Modules and Pragmata
-Six new pragmatic modules exist:
+=head2 New Modules
=over
-=item use autouse MODULE => qw(sub1 sub2 sub3)
-
-Defers C<require MODULE> until someone calls one of the specified
-subroutines (which must be exported by MODULE). This pragma should be
-used with caution, and only when necessary.
-
-=item use blib
-
-=item use blib 'dir'
-
-Looks for MakeMaker-like I<'blib'> directory structure starting in
-I<dir> (or current directory) and working back up to five levels of
-parent directories.
-
-Intended for use on command line with B<-M> option as a way of testing
-arbitrary scripts against an uninstalled version of a package.
-
-=item use constant NAME => VALUE
-
-Provides a convenient interface for creating compile-time constants,
-See L<perlsub/"Constant Functions">.
-
-=item use locale
-
-Tells the compiler to enable (or disable) the use of POSIX locales for
-builtin operations.
-
-When C<use locale> is in effect, the current LC_CTYPE locale is used
-for regular expressions and case mapping; LC_COLLATE for string
-ordering; and LC_NUMERIC for numeric formating in printf and sprintf
-(but B<not> in print). LC_NUMERIC is always used in write, since
-lexical scoping of formats is problematic at best.
-
-Each C<use locale> or C<no locale> affects statements to the end of
-the enclosing BLOCK or, if not inside a BLOCK, to the end of the
-current file. Locales can be switched and queried with
-POSIX::setlocale().
-
-See L<perllocale> for more information.
-
-=item use ops
-
-Disable unsafe opcodes, or any named opcodes, when compiling Perl code.
-
-=item use vmsish
-
-Enable VMS-specific language features. Currently, there are three
-VMS-specific features available: 'status', which makes C<$?> and
-C<system> return genuine VMS status values instead of emulating POSIX;
-'exit', which makes C<exit> take a genuine VMS status value instead of
-assuming that C<exit 1> is an error; and 'time', which makes all times
-relative to the local time zone, in the VMS tradition.
-
-=back
-
-=head1 Modules
-
-=head2 Required Updates
+=item B
-Though Perl 5.004 is compatible with almost all modules that work
-with Perl 5.003, there are a few exceptions:
+Perl compiler and tools. See L<B>.
- Module Required Version for Perl 5.004
- ------ -------------------------------
- Filter Filter-1.12
- LWP libwww-perl-5.08
- Tk Tk400.202 (-w makes noise)
+=item Data::Dumper
-Also, the majordomo mailing list program, version 1.94.1, doesn't work
-with Perl 5.004 (nor with perl 4), because it executes an invalid
-regular expression. This bug is fixed in majordomo version 1.94.2.
+A module to pretty print Perl data. See L<Data::Dumper>.
-=head2 Installation directories
+=item Dumpvalue
-The I<installperl> script now places the Perl source files for
-extensions in the architecture-specific library directory, which is
-where the shared libraries for extensions have always been. This
-change is intended to allow administrators to keep the Perl 5.004
-library directory unchanged from a previous version, without running
-the risk of binary incompatibility between extensions' Perl source and
-shared libraries.
+A module to dump perl values to the screen. See L<Dumpvalue>.
-=head2 Module information summary
+=item Errno
-Brand new modules, arranged by topic rather than strictly
-alphabetically:
+A module to look up errors more conveniently. See L<Errno>.
- CGI.pm Web server interface ("Common Gateway Interface")
- CGI/Apache.pm Support for Apache's Perl module
- CGI/Carp.pm Log server errors with helpful context
- CGI/Fast.pm Support for FastCGI (persistent server process)
- CGI/Push.pm Support for server push
- CGI/Switch.pm Simple interface for multiple server types
+=item File::Spec
- CPAN Interface to Comprehensive Perl Archive Network
- CPAN::FirstTime Utility for creating CPAN configuration file
- CPAN::Nox Runs CPAN while avoiding compiled extensions
+A portable API for file operations.
- IO.pm Top-level interface to IO::* classes
- IO/File.pm IO::File extension Perl module
- IO/Handle.pm IO::Handle extension Perl module
- IO/Pipe.pm IO::Pipe extension Perl module
- IO/Seekable.pm IO::Seekable extension Perl module
- IO/Select.pm IO::Select extension Perl module
- IO/Socket.pm IO::Socket extension Perl module
+=item ExtUtils::Installed
- Opcode.pm Disable named opcodes when compiling Perl code
+Query and manage installed modules.
- ExtUtils/Embed.pm Utilities for embedding Perl in C programs
- ExtUtils/testlib.pm Fixes up @INC to use just-built extension
+=item ExtUtils::Packlist
- FindBin.pm Find path of currently executing program
+Manipulate .packlist files.
- Class/Struct.pm Declare struct-like datatypes as Perl classes
- File/stat.pm By-name interface to Perl's builtin stat
- Net/hostent.pm By-name interface to Perl's builtin gethost*
- Net/netent.pm By-name interface to Perl's builtin getnet*
- Net/protoent.pm By-name interface to Perl's builtin getproto*
- Net/servent.pm By-name interface to Perl's builtin getserv*
- Time/gmtime.pm By-name interface to Perl's builtin gmtime
- Time/localtime.pm By-name interface to Perl's builtin localtime
- Time/tm.pm Internal object for Time::{gm,local}time
- User/grent.pm By-name interface to Perl's builtin getgr*
- User/pwent.pm By-name interface to Perl's builtin getpw*
+=item Fatal
- Tie/RefHash.pm Base class for tied hashes with references as keys
+Make functions/builtins succeed or die.
- UNIVERSAL.pm Base class for *ALL* classes
+=item IPC::SysV
-=head2 Fcntl
+Constants and other support infrastructure for System V IPC operations
+in perl.
-New constants in the existing Fcntl modules are now supported,
-provided that your operating system happens to support them:
+=item Test
- F_GETOWN F_SETOWN
- O_ASYNC O_DEFER O_DSYNC O_FSYNC O_SYNC
- O_EXLOCK O_SHLOCK
+A framework for writing testsuites.
-These constants are intended for use with the Perl operators sysopen()
-and fcntl() and the basic database modules like SDBM_File. For the
-exact meaning of these and other Fcntl constants please refer to your
-operating system's documentation for fcntl() and open().
+=item Tie::Array
-In addition, the Fcntl module now provides these constants for use
-with the Perl operator flock():
+Base class for tied arrays.
- LOCK_SH LOCK_EX LOCK_NB LOCK_UN
+=item Tie::Handle
-These constants are defined in all environments (because where there is
-no flock() system call, Perl emulates it). However, for historical
-reasons, these constants are not exported unless they are explicitly
-requested with the ":flock" tag (e.g. C<use Fcntl ':flock'>).
+Base class for tied handles.
-=head2 IO
+=item Thread
-The IO module provides a simple mechanism to load all of the IO modules at one
-go. Currently this includes:
+Perl thread creation, manipulation, and support.
- IO::Handle
- IO::Seekable
- IO::File
- IO::Pipe
- IO::Socket
+=item attrs
-For more information on any of these modules, please see its
-respective documentation.
+Set subroutine attributes.
-=head2 Math::Complex
+=item fields
-The Math::Complex module has been totally rewritten, and now supports
-more operations. These are overloaded:
+Compile-time class fields.
- + - * / ** <=> neg ~ abs sqrt exp log sin cos atan2 "" (stringify)
+=item re
-And these functions are now exported:
+Various pragmata to control behavior of regular expressions.
- pi i Re Im arg
- log10 logn ln cbrt root
- tan
- csc sec cot
- asin acos atan
- acsc asec acot
- sinh cosh tanh
- csch sech coth
- asinh acosh atanh
- acsch asech acoth
- cplx cplxe
-
-=head2 Math::Trig
-
-This new module provides a simpler interface to parts of Math::Complex for
-those who need trigonometric functions only for real numbers.
-
-=head2 DB_File
+=back
-There have been quite a few changes made to DB_File. Here are a few of
-the highlights:
+=head2 Changes in existing modules
=over
-=item *
-
-Fixed a handful of bugs.
-
-=item *
+=item Benchmark
-By public demand, added support for the standard hash function exists().
+You can now run tests for I<n> seconds instead of guessing the right
+number of tests to run: e.g. timethese(-5, ...) will run each of the
+codes for at least 5 CPU seconds. Zero as the "number of repetitions"
+means "for at least 3 CPU seconds". The output format has also
+changed. For example:
-=item *
+use Benchmark;$x=3;timethese(-5,{a=>sub{$x*$x},b=>sub{$x**2}})
-Made it compatible with Berkeley DB 1.86.
+will now output something like this:
-=item *
+Benchmark: running a, b, each for at least 5 CPU seconds...
+ a: 5 wallclock secs ( 5.77 usr + 0.00 sys = 5.77 CPU) @ 200551.91/s (n=1156516)
+ b: 4 wallclock secs ( 5.00 usr + 0.02 sys = 5.02 CPU) @ 159605.18/s (n=800686)
-Made negative subscripts work with RECNO interface.
+New features: "each for at least N CPU seconds...", "wallclock secs",
+and the "@ operations/CPU second (n=operations)".
-=item *
+=item Carp
-Changed the default flags from O_RDWR to O_CREAT|O_RDWR and the default
-mode from 0640 to 0666.
+Carp has a new function cluck(). cluck() warns, like carp(), but also adds
+a stack backtrace to the error message, like confess().
-=item *
-
-Made DB_File automatically import the open() constants (O_RDWR,
-O_CREAT etc.) from Fcntl, if available.
-
-=item *
-
-Updated documentation.
-
-=back
+=item CGI
-Refer to the HISTORY section in DB_File.pm for a complete list of
-changes. Everything after DB_File 1.01 has been added since 5.003.
+CGI has been updated to version 2.42.
-=head2 Net::Ping
+=item Fcntl
-Major rewrite - support added for both udp echo and real icmp pings.
+More Fcntl constants added: F_SETLK64, F_SETLKW64, O_LARGEFILE for
+large (more than 4G) file access (the 64-bit support is not yet
+working, though, so no need to get overly excited), Free/Net/OpenBSD
+locking behaviour flags F_FLOCK, F_POSIX, Linux F_SHLCK, and
+O_ACCMODE: the mask of O_RDONLY, O_WRONLY, and O_RDWR.
-=head2 Object-oriented overrides for builtin operators
+=item Math::Complex
-Many of the Perl builtins returning lists now have
-object-oriented overrides. These are:
+The accessor methods Re, Im, arg, abs, rho, and theta, can now also
+act as mutators (accessor $z->Re(), mutator $z->Re(3)).
- File::stat
- Net::hostent
- Net::netent
- Net::protoent
- Net::servent
- Time::gmtime
- Time::localtime
- User::grent
- User::pwent
+=item Math::Trig
-For example, you can now say
+A little bit of radial trigonometry (cylindrical and spherical) added:
+radial coordinate conversions and the great circle distance.
- use File::stat;
- use User::pwent;
- $his = (stat($filename)->st_uid == pwent($whoever)->pw_uid);
+=item POSIX
-=head1 Utility Changes
+POSIX now has its own platform-specific hints files.
-=head2 pod2html
+=item DB_File
-=over
+DB_File supports version 2.x of Berkeley DB. See C<ext/DB_File/Changes>.
-=item Sends converted HTML to standard output
+=item MakeMaker
-The I<pod2html> utility included with Perl 5.004 is entirely new.
-By default, it sends the converted HTML to its standard output,
-instead of writing it to a file like Perl 5.003's I<pod2html> did.
-Use the B<--outfile=FILENAME> option to write to a file.
+MakeMaker now supports writing empty makefiles, provides a way to
+specify that site umask() policy should be honored. There is also
+better support for manipulation of .packlist files, and getting
+information about installed modules.
-=back
+Extensions that have both architecture-dependent and
+architecture-independent files are now always installed completely in
+the architecture-dependent locations. Previously, the shareable parts
+were shared both across architectures and across perl versions and were
+therefore liable to be overwritten with newer versions that might have
+subtle incompatibilities.
-=head2 xsubpp
+=item CPAN
-=over
+See <perlmodinstall> and L<CPAN>.
-=item C<void> XSUBs now default to returning nothing
+=item Cwd
-Due to a documentation/implementation bug in previous versions of
-Perl, XSUBs with a return type of C<void> have actually been
-returning one value. Usually that value was the GV for the XSUB,
-but sometimes it was some already freed or reused value, which would
-sometimes lead to program failure.
+Cwd::cwd is faster on most platforms.
-In Perl 5.004, if an XSUB is declared as returning C<void>, it
-actually returns no value, i.e. an empty list (though there is a
-backward-compatibility exception; see below). If your XSUB really
-does return an SV, you should give it a return type of C<SV *>.
+=item Benchmark
-For backward compatibility, I<xsubpp> tries to guess whether a
-C<void> XSUB is really C<void> or if it wants to return an C<SV *>.
-It does so by examining the text of the XSUB: if I<xsubpp> finds
-what looks like an assignment to C<ST(0)>, it assumes that the
-XSUB's return type is really C<SV *>.
+Keeps better time.
=back
-=head1 C Language API Changes
-
-=over
-
-=item C<gv_fetchmethod> and C<perl_call_sv>
-
-The C<gv_fetchmethod> function finds a method for an object, just like
-in Perl 5.003. The GV it returns may be a method cache entry.
-However, in Perl 5.004, method cache entries are not visible to users;
-therefore, they can no longer be passed directly to C<perl_call_sv>.
-Instead, you should use the C<GvCV> macro on the GV to extract its CV,
-and pass the CV to C<perl_call_sv>.
-
-The most likely symptom of passing the result of C<gv_fetchmethod> to
-C<perl_call_sv> is Perl's producing an "Undefined subroutine called"
-error on the I<second> call to a given method (since there is no cache
-on the first call).
-
-=item C<perl_eval_pv>
+=head1 Utility Changes
-A new function handy for eval'ing strings of Perl code inside C code.
-This function returns the value from the eval statement, which can
-be used instead of fetching globals from the symbol table. See
-L<perlguts>, L<perlembed> and L<perlcall> for details and examples.
+C<h2ph> and related utilities have been vastly overhauled.
-=item Extended API for manipulating hashes
+C<perlcc>, a new experimental front end for the compiler is available.
-Internal handling of hash keys has changed. The old hashtable API is
-still fully supported, and will likely remain so. The additions to the
-API allow passing keys as C<SV*>s, so that C<tied> hashes can be given
-real scalars as keys rather than plain strings (nontied hashes still
-can only use strings as keys). New extensions must use the new hash
-access functions and macros if they wish to use C<SV*> keys. These
-additions also make it feasible to manipulate C<HE*>s (hash entries),
-which can be more efficient. See L<perlguts> for details.
+The crude GNU C<configure> emulator is now called C<configure.gnu> to
+avoid trampling on C<Configure> under case-insensitive filesystems.
-=back
+C<perldoc> used to be rather slow. The slower features are now optional.
+In particular, case-insensitive searches need the C<-i> switch, and
+recursive searches need C<-r>. You can set these switches in the
+C<PERLDOC> environment variable to get the old behavior.
=head1 Documentation Changes
-Many of the base and library pods were updated. These
-new pods are included in section 1:
-
-=over
-
-=item L<perldelta>
-
-This document.
-
-=item L<perlfaq>
-
-Frequently asked questions.
-
-=item L<perllocale>
-
-Locale support (internationalization and localization).
-
-=item L<perltoot>
-
-Tutorial on Perl OO programming.
+Config.pm now has a glossary of variables.
-=item L<perlapio>
+F<Porting/patching.pod> has detailed instructions on how to create and
+submit patches for perl.
-Perl internal IO abstraction interface.
+L<perlport> specifies guidelines on how to write portably.
-=item L<perlmodlib>
+L<perlmodinstall> describes how to fetch and install modules from C<CPAN>
+sites.
-Perl module library and recommended practice for module creation.
-Extracted from L<perlmod> (which is much smaller as a result).
+Some more Perl traps are documented now. See L<perltrap>.
-=item L<perldebug>
+L<perlopentut> gives a tutorial on using open().
-Although not new, this has been massively updated.
+L<perlreftut> gives a tutorial on references.
-=item L<perlsec>
-
-Although not new, this has been massively updated.
-
-=back
+L<perlthrtut> gives a tutorial on threads.
=head1 New Diagnostics
-Several new conditions will trigger warnings that were
-silent before. Some only affect certain platforms.
-The following new warnings and errors outline these.
-These messages are classified as follows (listed in
-increasing order of desperation):
-
- (W) A warning (optional).
- (D) A deprecation (optional).
- (S) A severe warning (mandatory).
- (F) A fatal error (trappable).
- (P) An internal error you should never see (trappable).
- (X) A very fatal error (nontrappable).
- (A) An alien error message (not generated by Perl).
-
=over
-=item "my" variable %s masks earlier declaration in same scope
-
-(W) A lexical variable has been redeclared in the same scope, effectively
-eliminating all access to the previous instance. This is almost always
-a typographical error. Note that the earlier variable will still exist
-until the end of the scope or until all closure referents to it are
-destroyed.
-
-=item %s argument is not a HASH element or slice
-
-(F) The argument to delete() must be either a hash element, such as
-
- $foo{$bar}
- $ref->[12]->{"susie"}
-
-or a hash slice, such as
-
- @foo{$bar, $baz, $xyzzy}
- @{$ref->[12]}{"susie", "queue"}
+=item Ambiguous call resolved as CORE::%s(), qualify as such or use &
-=item Allocation too large: %lx
+(W) A subroutine you have declared has the same name as a Perl keyword,
+and you have used the name without qualification for calling one or the
+other. Perl decided to call the builtin because the subroutine is
+not imported.
-(X) You can't allocate more than 64K on an MS-DOS machine.
+To force interpretation as a subroutine call, either put an ampersand
+before the subroutine name, or qualify the name with its package.
+Alternatively, you can import the subroutine (or pretend that it's
+imported with the C<use subs> pragma).
-=item Allocation too large
+To silently interpret it as the Perl operator, use the C<CORE::> prefix
+on the operator (e.g. C<CORE::log($x)>) or by declaring the subroutine
+to be an object method (see L<attrs>).
-(F) You can't allocate more than 2^31+"small amount" bytes.
+=item Bad index while coercing array into hash
-=item Applying %s to %s will act on scalar(%s)
+(F) The index looked up in the hash found as the 0'th element of a
+pseudo-hash is not legal. Index values must be at 1 or greater.
+See L<perlref>.
-(W) The pattern match (//), substitution (s///), and translation (tr///)
-operators work on scalar values. If you apply one of them to an array
-or a hash, it will convert the array or hash to a scalar value -- the
-length of an array, or the population info of a hash -- and then work on
-that scalar value. This is probably not what you meant to do. See
-L<perlfunc/grep> and L<perlfunc/map> for alternatives.
+=item Bareword "%s" refers to nonexistent package
-=item Attempt to free nonexistent shared string
+(W) You used a qualified bareword of the form C<Foo::>, but
+the compiler saw no other uses of that namespace before that point.
+Perhaps you need to predeclare a package?
-(P) Perl maintains a reference counted internal table of strings to
-optimize the storage and access of hash keys and other strings. This
-indicates someone tried to decrement the reference count of a string
-that can no longer be found in the table.
+=item Can't call method "%s" on an undefined value
-=item Attempt to use reference as lvalue in substr
+(F) You used the syntax of a method call, but the slot filled by the
+object reference or package name contains an undefined value.
+Something like this will reproduce the error:
-(W) You supplied a reference as the first argument to substr() used
-as an lvalue, which is pretty strange. Perhaps you forgot to
-dereference it first. See L<perlfunc/substr>.
+ $BADREF = 42;
+ process $BADREF 1,2,3;
+ $BADREF->process(1,2,3);
-=item Can't redefine active sort subroutine %s
+=item Can't check filesystem of script "%s" for nosuid
-(F) Perl optimizes the internal handling of sort subroutines and keeps
-pointers into them. You tried to redefine one such sort subroutine when it
-was currently active, which is not allowed. If you really want to do
-this, you should write C<sort { &func } @x> instead of C<sort func @x>.
+(P) For some reason you can't check the filesystem of the script for nosuid.
-=item Can't use bareword ("%s") as %s ref while "strict refs" in use
+=item Can't coerce array into hash
-(F) Only hard references are allowed by "strict refs". Symbolic references
-are disallowed. See L<perlref>.
+(F) You used an array where a hash was expected, but the array has no
+information on how to map from keys to array indices. You can do that
+only with arrays that have a hash reference at index 0.
-=item Cannot resolve method `%s' overloading `%s' in package `%s'
+=item Can't goto subroutine from an eval-string
-(P) Internal error trying to resolve overloading specified by a method
-name (as opposed to a subroutine reference).
+(F) The "goto subroutine" call can't be used to jump out of an eval "string".
+(You can use it to jump out of an eval {BLOCK}, but you probably don't want to.)
-=item Constant subroutine %s redefined
+=item Can't localize pseudo-hash element
-(S) You redefined a subroutine which had previously been eligible for
-inlining. See L<perlsub/"Constant Functions"> for commentary and
-workarounds.
+(F) You said something like C<local $ar-E<gt>{'key'}>, where $ar is
+a reference to a pseudo-hash. That hasn't been implemented yet, but
+you can get a similar effect by localizing the corresponding array
+element directly -- C<local $ar-E<gt>[$ar-E<gt>[0]{'key'}]>.
-=item Constant subroutine %s undefined
+=item Can't use %%! because Errno.pm is not available
-(S) You undefined a subroutine which had previously been eligible for
-inlining. See L<perlsub/"Constant Functions"> for commentary and
-workarounds.
+(F) The first time the %! hash is used, perl automatically loads the
+Errno.pm module. The Errno module is expected to tie the %! hash to
+provide symbolic names for C<$!> errno values.
-=item Copy method did not return a reference
+=item Cannot find an opnumber for "%s"
-(F) The method which overloads "=" is buggy. See L<overload/Copy Constructor>.
+(F) A string of a form C<CORE::word> was given to prototype(), but
+there is no builtin with the name C<word>.
-=item Died
+=item Character class syntax [. .] is reserved for future extensions
-(F) You passed die() an empty string (the equivalent of C<die "">) or
-you called it with no args and both C<$@> and C<$_> were empty.
+(W) Within regular expression character classes ([]) the syntax beginning
+with "[." and ending with ".]" is reserved for future extensions.
+If you need to represent those character sequences inside a regular
+expression character class, just quote the square brackets with the
+backslash: "\[." and ".\]".
-=item Exiting pseudo-block via %s
+=item Character class syntax [: :] is reserved for future extensions
-(W) You are exiting a rather special block construct (like a sort block or
-subroutine) by unconventional means, such as a goto, or a loop control
-statement. See L<perlfunc/sort>.
+(W) Within regular expression character classes ([]) the syntax beginning
+with "[:" and ending with ":]" is reserved for future extensions.
+If you need to represent those character sequences inside a regular
+expression character class, just quote the square brackets with the
+backslash: "\[:" and ":\]".
-=item Identifier too long
+=item Character class syntax [= =] is reserved for future extensions
-(F) Perl limits identifiers (names for variables, functions, etc.) to
-252 characters for simple names, somewhat more for compound names (like
-C<$A::B>). You've exceeded Perl's limits. Future versions of Perl are
-likely to eliminate these arbitrary limitations.
+(W) Within regular expression character classes ([]) the syntax
+beginning with "[=" and ending with "=]" is reserved for future extensions.
+If you need to represent those character sequences inside a regular
+expression character class, just quote the square brackets with the
+backslash: "\[=" and "=\]".
-=item Illegal character %s (carriage return)
+=item %s: Eval-group in insecure regular expression
-(F) A carriage return character was found in the input. This is an
-error, and not a warning, because carriage return characters can break
-multi-line strings, including here documents (e.g., C<print E<lt>E<lt>EOF;>).
+(F) Perl detected tainted data when trying to compile a regular expression
+that contains the C<(?{ ... })> zero-width assertion, which is unsafe.
+See L<perlre/(?{ code })>, and L<perlsec>.
-=item Illegal switch in PERL5OPT: %s
+=item %s: Eval-group not allowed, use re 'eval'
-(X) The PERL5OPT environment variable may only be used to set the
-following switches: B<-[DIMUdmw]>.
+(F) A regular expression contained the C<(?{ ... })> zero-width assertion,
+but that construct is only allowed when the C<use re 'eval'> pragma is
+in effect. See L<perlre/(?{ code })>.
-=item Integer overflow in hex number
+=item %s: Eval-group not allowed at run time
-(S) The literal hex number you have specified is too big for your
-architecture. On a 32-bit architecture the largest hex literal is
-0xFFFFFFFF.
+(F) Perl tried to compile a regular expression containing the C<(?{ ... })>
+zero-width assertion at run time, as it would when the pattern contains
+interpolated values. Since that is a security risk, it is not allowed.
+If you insist, you may still do this by explicitly building the pattern
+from an interpolated string at run time and using that in an eval().
+See L<perlre/(?{ code })>.
-=item Integer overflow in octal number
+=item Explicit blessing to '' (assuming package main)
-(S) The literal octal number you have specified is too big for your
-architecture. On a 32-bit architecture the largest octal literal is
-037777777777.
+(W) You are blessing a reference to a zero length string. This has
+the effect of blessing the reference into the package main. This is
+usually not what you want. Consider providing a default target
+package, e.g. bless($ref, $p || 'MyPackage');
-=item internal error: glob failed
+=item Illegal hex digit ignored
-(P) Something went wrong with the external program(s) used for C<glob>
-and C<E<lt>*.cE<gt>>. This may mean that your csh (C shell) is
-broken. If so, you should change all of the csh-related variables in
-config.sh: If you have tcsh, make the variables refer to it as if it
-were csh (e.g. C<full_csh='/usr/bin/tcsh'>); otherwise, make them all
-empty (except that C<d_csh> should be C<'undef'>) so that Perl will
-think csh is missing. In either case, after editing config.sh, run
-C<./Configure -S> and rebuild Perl.
+(W) You may have tried to use a character other than 0 - 9 or A - F in a
+hexadecimal number. Interpretation of the hexadecimal number stopped
+before the illegal character.
-=item Invalid conversion in %s: "%s"
+=item No such array field
-(W) Perl does not understand the given format conversion.
-See L<perlfunc/sprintf>.
+(F) You tried to access an array as a hash, but the field name used is
+not defined. The hash at index 0 should map all valid field names to
+array indices for that to work.
-=item Invalid type in pack: '%s'
+=item No such field "%s" in variable %s of type %s
-(F) The given character is not a valid pack type. See L<perlfunc/pack>.
+(F) You tried to access a field of a typed variable where the type
+does not know about the field name. The field names are looked up in
+the %FIELDS hash in the type package at compile time. The %FIELDS hash
+is usually set up with the 'fields' pragma.
-=item Invalid type in unpack: '%s'
+=item Out of memory during ridiculously large request
-(F) The given character is not a valid unpack type. See L<perlfunc/unpack>.
+(F) You can't allocate more than 2^31+"small amount" bytes. This error
+is most likely to be caused by a typo in the Perl program. e.g., C<$arr[time]>
+instead of C<$arr[$time]>.
-=item Name "%s::%s" used only once: possible typo
+=item Range iterator outside integer range
-(W) Typographical errors often show up as unique variable names.
-If you had a good reason for having a unique name, then just mention
-it again somehow to suppress the message (the C<use vars> pragma is
-provided for just this purpose).
+(F) One (or both) of the numeric arguments to the range operator ".."
+are outside the range which can be represented by integers internally.
+One possible workaround is to force Perl to use magical string
+increment by prepending "0" to your numbers.
-=item Null picture in formline
+=item Recursive inheritance detected while looking for method '%s' in package '%s'
-(F) The first argument to formline must be a valid format picture
-specification. It was found to be empty, which probably means you
-supplied it an uninitialized value. See L<perlform>.
+(F) More than 100 levels of inheritance were encountered while invoking a
+method. Probably indicates an unintended loop in your inheritance hierarchy.
-=item Offset outside string
+=item Reference found where even-sized list expected
-(F) You tried to do a read/write/send/recv operation with an offset
-pointing outside the buffer. This is difficult to imagine.
-The sole exception to this is that C<sysread()>ing past the buffer
-will extend the buffer and zero pad the new area.
+(W) You gave a single reference where Perl was expecting a list with
+an even number of elements (for assignment to a hash). This
+usually means that you used the anon hash constructor when you meant
+to use parens. In any case, a hash requires key/value B<pairs>.
-=item Out of memory!
+ %hash = { one => 1, two => 2, }; # WRONG
+ %hash = [ qw/ an anon array / ]; # WRONG
+ %hash = ( one => 1, two => 2, ); # right
+ %hash = qw( one 1 two 2 ); # also fine
-(X|F) The malloc() function returned 0, indicating there was insufficient
-remaining memory (or virtual memory) to satisfy the request.
+=item Undefined value assigned to typeglob
-The request was judged to be small, so the possibility to trap it
-depends on the way Perl was compiled. By default it is not trappable.
-However, if compiled for this, Perl may use the contents of C<$^M> as
-an emergency pool after die()ing with this message. In this case the
-error is trappable I<once>.
+(W) An undefined value was assigned to a typeglob, a la C<*foo = undef>.
+This does nothing. It's possible that you really mean C<undef *foo>.
-=item Out of memory during request for %s
+=item Use of reserved word "%s" is deprecated
-(F) The malloc() function returned 0, indicating there was insufficient
-remaining memory (or virtual memory) to satisfy the request. However,
-the request was judged large enough (compile-time default is 64K), so
-a possibility to shut down by trapping this error is granted.
+(D) The indicated bareword is a reserved word. Future versions of perl
+may use it as a keyword, so you're better off either explicitly quoting
+the word in a manner appropriate for its context of use, or using a
+different name altogether. The warning can be suppressed for subroutine
+names by either adding a C<&> prefix, or using a package qualifier,
+e.g. C<&our()>, or C<Foo::our()>.
-=item panic: frexp
+=item perl: warning: Setting locale failed.
-(P) The library function frexp() failed, making printf("%f") impossible.
+(S) The whole warning message will look something like:
-=item Possible attempt to put comments in qw() list
+ perl: warning: Setting locale failed.
+ perl: warning: Please check that your locale settings:
+ LC_ALL = "En_US",
+ LANG = (unset)
+ are supported and installed on your system.
+ perl: warning: Falling back to the standard locale ("C").
-(W) qw() lists contain items separated by whitespace; as with literal
-strings, comment characters are not ignored, but are instead treated
-as literal data. (You may have used different delimiters than the
-exclamation marks parentheses shown here; braces are also frequently
-used.)
+Exactly what were the failed locale settings varies. In the above the
+settings were that the LC_ALL was "En_US" and the LANG had no value.
+This error means that Perl detected that you and/or your system
+administrator have set up the so-called variable system but Perl could
+not use those settings. This was not dead serious, fortunately: there
+is a "default locale" called "C" that Perl can and will use, the
+script will be run. Before you really fix the problem, however, you
+will get the same error message each time you run Perl. How to really
+fix the problem can be found in L<perllocale/"LOCALE PROBLEMS">.
-You probably wrote something like this:
-
- @list = qw(
- a # a comment
- b # another comment
- );
-
-when you should have written this:
-
- @list = qw(
- a
- b
- );
-
-If you really want comments, build your list the
-old-fashioned way, with quotes and commas:
-
- @list = (
- 'a', # a comment
- 'b', # another comment
- );
-
-=item Possible attempt to separate words with commas
-
-(W) qw() lists contain items separated by whitespace; therefore commas
-aren't needed to separate the items. (You may have used different
-delimiters than the parentheses shown here; braces are also frequently
-used.)
-
-You probably wrote something like this:
-
- qw! a, b, c !;
-
-which puts literal commas into some of the list items. Write it without
-commas if you don't want them to appear in your data:
-
- qw! a b c !;
-
-=item Scalar value @%s{%s} better written as $%s{%s}
-
-(W) You've used a hash slice (indicated by @) to select a single element of
-a hash. Generally it's better to ask for a scalar value (indicated by $).
-The difference is that C<$foo{&bar}> always behaves like a scalar, both when
-assigning to it and when evaluating its argument, while C<@foo{&bar}> behaves
-like a list when you assign to it, and provides a list context to its
-subscript, which can do weird things if you're expecting only one subscript.
-
-=item Stub found while resolving method `%s' overloading `%s' in package `%s'
-
-(P) Overloading resolution over @ISA tree may be broken by importing stubs.
-Stubs should never be implicitely created, but explicit calls to C<can>
-may break this.
-
-=item Too late for "B<-T>" option
-
-(X) The #! line (or local equivalent) in a Perl script contains the
-B<-T> option, but Perl was not invoked with B<-T> in its argument
-list. This is an error because, by the time Perl discovers a B<-T> in
-a script, it's too late to properly taint everything from the
-environment. So Perl gives up.
-
-=item untie attempted while %d inner references still exist
-
-(W) A copy of the object returned from C<tie> (or C<tied>) was still
-valid when C<untie> was called.
-
-=item Unrecognized character %s
-
-(F) The Perl parser has no idea what to do with the specified character
-in your Perl script (or eval). Perhaps you tried to run a compressed
-script, a binary program, or a directory as a Perl program.
-
-=item Unsupported function fork
-
-(F) Your version of executable does not support forking.
-
-Note that under some systems, like OS/2, there may be different flavors of
-Perl executables, some of which may support fork, some not. Try changing
-the name you call Perl by to C<perl_>, C<perl__>, and so on.
-
-=item Use of "$$<digit>" to mean "${$}<digit>" is deprecated
-
-(D) Perl versions before 5.004 misinterpreted any type marker followed
-by "$" and a digit. For example, "$$0" was incorrectly taken to mean
-"${$}0" instead of "${$0}". This bug is (mostly) fixed in Perl 5.004.
-
-However, the developers of Perl 5.004 could not fix this bug completely,
-because at least two widely-used modules depend on the old meaning of
-"$$0" in a string. So Perl 5.004 still interprets "$$<digit>" in the
-old (broken) way inside strings; but it generates this message as a
-warning. And in Perl 5.005, this special treatment will cease.
-
-=item Value of %s can be "0"; test with defined()
-
-(W) In a conditional expression, you used <HANDLE>, <*> (glob), C<each()>,
-or C<readdir()> as a boolean value. Each of these constructs can return a
-value of "0"; that would make the conditional expression false, which is
-probably not what you intended. When using these constructs in conditional
-expressions, test their values with the C<defined> operator.
-
-=item Variable "%s" may be unavailable
-
-(W) An inner (nested) I<anonymous> subroutine is inside a I<named>
-subroutine, and outside that is another subroutine; and the anonymous
-(innermost) subroutine is referencing a lexical variable defined in
-the outermost subroutine. For example:
-
- sub outermost { my $a; sub middle { sub { $a } } }
-
-If the anonymous subroutine is called or referenced (directly or
-indirectly) from the outermost subroutine, it will share the variable
-as you would expect. But if the anonymous subroutine is called or
-referenced when the outermost subroutine is not active, it will see
-the value of the shared variable as it was before and during the
-*first* call to the outermost subroutine, which is probably not what
-you want.
-
-In these circumstances, it is usually best to make the middle
-subroutine anonymous, using the C<sub {}> syntax. Perl has specific
-support for shared variables in nested anonymous subroutines; a named
-subroutine in between interferes with this feature.
-
-=item Variable "%s" will not stay shared
-
-(W) An inner (nested) I<named> subroutine is referencing a lexical
-variable defined in an outer subroutine.
-
-When the inner subroutine is called, it will probably see the value of
-the outer subroutine's variable as it was before and during the
-*first* call to the outer subroutine; in this case, after the first
-call to the outer subroutine is complete, the inner and outer
-subroutines will no longer share a common value for the variable. In
-other words, the variable will no longer be shared.
-
-Furthermore, if the outer subroutine is anonymous and references a
-lexical variable outside itself, then the outer and inner subroutines
-will I<never> share the given variable.
-
-This problem can usually be solved by making the inner subroutine
-anonymous, using the C<sub {}> syntax. When inner anonymous subs that
-reference variables in outer subroutines are called or referenced,
-they are automatically rebound to the current values of such
-variables.
+=back
-=item Warning: something's wrong
-(W) You passed warn() an empty string (the equivalent of C<warn "">) or
-you called it with no args and C<$_> was empty.
+=head1 Obsolete Diagnostics
-=item Ill-formed logical name |%s| in prime_env_iter
+=over
-(W) A warning peculiar to VMS. A logical name was encountered when preparing
-to iterate over %ENV which violates the syntactic rules governing logical
-names. Since it cannot be translated normally, it is skipped, and will not
-appear in %ENV. This may be a benign occurrence, as some software packages
-might directly modify logical name tables and introduce nonstandard names,
-or it may indicate that a logical name table has been corrupted.
+=item Can't mktemp()
-=item Got an error from DosAllocMem
+(F) The mktemp() routine failed for some reason while trying to process
+a B<-e> switch. Maybe your /tmp partition is full, or clobbered.
-(P) An error peculiar to OS/2. Most probably you're using an obsolete
-version of Perl, and this should not happen anyway.
+Removed because B<-e> doesn't use temporary files any more.
-=item Malformed PERLLIB_PREFIX
+=item Can't write to temp file for B<-e>: %s
-(F) An error peculiar to OS/2. PERLLIB_PREFIX should be of the form
+(F) The write routine failed for some reason while trying to process
+a B<-e> switch. Maybe your /tmp partition is full, or clobbered.
- prefix1;prefix2
+Removed because B<-e> doesn't use temporary files any more.
-or
+=item Cannot open temporary file
- prefix1 prefix2
+(F) The create routine failed for some reason while trying to process
+a B<-e> switch. Maybe your /tmp partition is full, or clobbered.
-with nonempty prefix1 and prefix2. If C<prefix1> is indeed a prefix
-of a builtin library search path, prefix2 is substituted. The error
-may appear if components are not found, or are too long. See
-"PERLLIB_PREFIX" in F<README.os2>.
+Removed because B<-e> doesn't use temporary files any more.
-=item PERL_SH_DIR too long
+=item regexp too big
-(F) An error peculiar to OS/2. PERL_SH_DIR is the directory to find the
-C<sh>-shell in. See "PERL_SH_DIR" in F<README.os2>.
+(F) The current implementation of regular expressions uses shorts as
+address offsets within a string. Unfortunately this means that if
+the regular expression compiles to longer than 32767, it'll blow up.
+Usually when you want a regular expression this big, there is a better
+way to do it with multiple statements. See L<perlre>.
-=item Process terminated by SIG%s
+=back
-(W) This is a standard message issued by OS/2 applications, while *nix
-applications die in silence. It is considered a feature of the OS/2
-port. One can easily disable this by appropriate sighandlers, see
-L<perlipc/"Signals">. See also "Process terminated by SIGTERM/SIGINT"
-in F<README.os2>.
+=head1 Configuration Changes
-=back
+You can use "Configure -Uinstallusrbinperl" which causes installperl
+to skip installing perl also as /usr/bin/perl. This is useful if you
+prefer not to modify /usr/bin for some reason or another but harmful
+because many scripts assume to find Perl in /usr/bin/perl.
=head1 BUGS
@@ -1569,18 +1013,17 @@ analysed by the Perl porting team.
The F<Changes> file for exhaustive details on what changed.
-The F<INSTALL> file for how to build Perl. This file has been
-significantly updated for 5.004, so even veteran users should
-look through it.
+The F<INSTALL> file for how to build Perl.
The F<README> file for general stuff.
-The F<Copying> file for copyright information.
+The F<Artistic> and F<Copying> files for copyright information.
=head1 HISTORY
-Constructed by Tom Christiansen, grabbing material with permission
-from innumerable contributors, with kibitzing by more than a few Perl
-porters.
+Written by Gurusamy Sarathy <F<gsar@umich.edu>>, with many contributions
+from The Perl Porters.
+
+Send omissions or corrections to <F<perlbug@perl.com>>.
-Last update: Wed May 14 11:14:09 EDT 1997
+=cut
diff --git a/gnu/usr.bin/perl/pod/perldiag.pod b/gnu/usr.bin/perl/pod/perldiag.pod
index 166e046f22b..fe319912029 100644
--- a/gnu/usr.bin/perl/pod/perldiag.pod
+++ b/gnu/usr.bin/perl/pod/perldiag.pod
@@ -33,11 +33,11 @@ The symbols C<"%(-?@> sort before the letters, while C<[> and C<\> sort after.
to try to declare one with a package qualifier on the front. Use local()
if you want to localize a package variable.
-=item "my" variable %s masks earlier declaration in same scope
+=item "my" variable %s masks earlier declaration in same %s
-(W) A lexical variable has been redeclared in the same scope, effectively
-eliminating all access to the previous instance. This is almost always
-a typographical error. Note that the earlier variable will still exist
+(W) A lexical variable has been redeclared in the current scope or statement,
+effectively eliminating all access to the previous instance. This is almost
+always a typographical error. Note that the earlier variable will still exist
until the end of the scope or until all closure referents to it are
destroyed.
@@ -143,6 +143,18 @@ Perl yourself.
instead of Perl. Check the #! line, or manually feed your script
into Perl yourself.
+=item (in cleanup) %s
+
+(W) This prefix usually indicates that a DESTROY() method raised
+the indicated exception. Since destructors are usually called by
+the system at arbitrary points during execution, and often a vast
+number of times, the warning is issued only once for any number
+of failures that would otherwise result in the same message being
+repeated.
+
+Failure of user callbacks dispatched using the C<G_KEEPERR> flag
+could also result in this warning. See L<perlcall/G_KEEPERR>.
+
=item (Missing semicolon on previous line?)
(S) This is an educated guess made in conjunction with the message "%s
@@ -188,13 +200,9 @@ the return value of your socket() call? See L<perlfunc/accept>.
(X) You can't allocate more than 64K on an MS-DOS machine.
-=item Allocation too large
-
-(F) You can't allocate more than 2^31+"small amount" bytes.
-
=item Applying %s to %s will act on scalar(%s)
-(W) The pattern match (//), substitution (s///), and translation (tr///)
+(W) The pattern match (//), substitution (s///), and transliteration (tr///)
operators work on scalar values. If you apply one of them to an array
or a hash, it will convert the array or hash to a scalar value -- the
length of an array, or the population info of a hash -- and then work on
@@ -211,6 +219,22 @@ L<perlfunc/grep> and L<perlfunc/map> for alternatives.
you thought. Normally it's pretty easy to disambiguate it by supplying
a missing quote, operator, parenthesis pair or declaration.
+=item Ambiguous call resolved as CORE::%s(), qualify as such or use &
+
+(W) A subroutine you have declared has the same name as a Perl keyword,
+and you have used the name without qualification for calling one or the
+other. Perl decided to call the builtin because the subroutine is
+not imported.
+
+To force interpretation as a subroutine call, either put an ampersand
+before the subroutine name, or qualify the name with its package.
+Alternatively, you can import the subroutine (or pretend that it's
+imported with the C<use subs> pragma).
+
+To silently interpret it as the Perl operator, use the C<CORE::> prefix
+on the operator (e.g. C<CORE::log($x)>) or by declaring the subroutine
+to be an object method (see L<attrs>).
+
=item Args must match #! line
(F) The setuid emulator requires that the arguments Perl was invoked
@@ -320,6 +344,12 @@ system malloc().
(P) One of the internal hash routines was passed a null HV pointer.
+=item Bad index while coercing array into hash
+
+(F) The index looked up in the hash found as the 0'th element of a
+pseudo-hash is not legal. Index values must be at 1 or greater.
+See L<perlref>.
+
=item Bad name after %s::
(F) You started to name a symbol by using a package prefix, and then didn't
@@ -358,9 +388,15 @@ Perl yourself.
=item Bareword "%s" not allowed while "strict subs" in use
(F) With "strict subs" in use, a bareword is only allowed as a
-subroutine identifier, in curly braces or to the left of the "=>" symbol.
+subroutine identifier, in curly brackets or to the left of the "=>" symbol.
Perhaps you need to predeclare a subroutine?
+=item Bareword "%s" refers to nonexistent package
+
+(W) You used a qualified bareword of the form C<Foo::>, but
+the compiler saw no other uses of that namespace before that point.
+Perhaps you need to predeclare a package?
+
=item BEGIN failed--compilation aborted
(F) An untrapped exception was raised while executing a BEGIN subroutine.
@@ -453,7 +489,17 @@ an object reference until it has been blessed. See L<perlobj>.
(F) You used the syntax of a method call, but the slot filled by the
object reference or package name contains an expression that returns
-neither an object reference nor a package name. (Perhaps it's null?)
+a defined value which is neither an object reference nor a package name.
+Something like this will reproduce the error:
+
+ $BADREF = 42;
+ process $BADREF 1,2,3;
+ $BADREF->process(1,2,3);
+
+=item Can't call method "%s" on an undefined value
+
+(F) You used the syntax of a method call, but the slot filled by the
+object reference or package name contains an undefined value.
Something like this will reproduce the error:
$BADREF = undef;
@@ -465,6 +511,10 @@ Something like this will reproduce the error:
(F) You called C<perl -x/foo/bar>, but C</foo/bar> is not a directory
that you can chdir to, possibly because it doesn't exist.
+=item Can't check filesystem of script "%s" for nosuid
+
+(P) For some reason you can't check the filesystem of the script for nosuid.
+
=item Can't coerce %s to integer in %s
(F) Certain types of SVs, in particular real symbol table entries
@@ -490,6 +540,12 @@ but then $foo no longer contains a glob.
(F) Certain types of SVs, in particular real symbol table entries
(typeglobs), can't be forced to stop being what they are.
+=item Can't coerce array into hash
+
+(F) You used an array where a hash was expected, but the array has no
+information on how to map from keys to array indices. You can do that
+only with arrays that have a hash reference at index 0.
+
=item Can't create pipe mailbox
(P) An error peculiar to VMS. The process is suffering from exhausted quotas
@@ -638,6 +694,11 @@ call for another. It can't manufacture one out of whole cloth. In general
you should be calling it out of only an AUTOLOAD routine anyway. See
L<perlfunc/goto>.
+=item Can't goto subroutine from an eval-string
+
+(F) The "goto subroutine" call can't be used to jump out of an eval "string".
+(You can use it to jump out of an eval {BLOCK}, but you probably don't want to.)
+
=item Can't localize through a reference
(F) You said something like C<local $$ref>, which Perl can't currently
@@ -652,6 +713,13 @@ lexical variable using "my". This is not allowed. If you want to
localize a package variable of the same name, qualify it with the
package name.
+=item Can't localize pseudo-hash element
+
+(F) You said something like C<local $ar-E<gt>{'key'}>, where $ar is
+a reference to a pseudo-hash. That hasn't been implemented yet, but
+you can get a similar effect by localizing the corresponding array
+element directly -- C<local $ar-E<gt>[$ar-E<gt>[0]{'key'}]>.
+
=item Can't locate auto/%s.al in @INC
(F) A function (or method) was called in a package which allows autoload,
@@ -682,11 +750,6 @@ to exist.
(F) List assignment to %ENV is not supported on some systems, notably VMS.
-=item Can't mktemp()
-
-(F) The mktemp() routine failed for some reason while trying to process
-a B<-e> switch. Maybe your /tmp partition is full, or clobbered.
-
=item Can't modify %s in %s
(F) You aren't allowed to assign to the item indicated, or otherwise try to
@@ -817,6 +880,12 @@ message indicates that such a conversion was attempted.
of upgradability. Upgrading to undef indicates an error in the
code calling sv_upgrade.
+=item Can't use %%! because Errno.pm is not available
+
+(F) The first time the %! hash is used, perl automatically loads the
+Errno.pm module. The Errno module is expected to tie the %! hash to
+provide symbolic names for C<$!> errno values.
+
=item Can't use "my %s" in sort comparison
(F) The global variables $a and $b are reserved for sort comparisons.
@@ -872,21 +941,16 @@ weren't.
subscript. But to the left of the brackets was an expression that
didn't look like an array reference, or anything else subscriptable.
-=item Can't write to temp file for B<-e>: %s
-
-(F) The write routine failed for some reason while trying to process
-a B<-e> switch. Maybe your /tmp partition is full, or clobbered.
-
=item Can't x= to read-only value
(F) You tried to repeat a constant value (often the undefined value) with
an assignment operator, which implies modifying the value itself.
Perhaps you need to copy the value to a temporary, and repeat that.
-=item Cannot open temporary file
+=item Cannot find an opnumber for "%s"
-(F) The create routine failed for some reason while trying to process
-a B<-e> switch. Maybe your /tmp partition is full, or clobbered.
+(F) A string of a form C<CORE::word> was given to prototype(), but
+there is no builtin with the name C<word>.
=item Cannot resolve method `%s' overloading `%s' in package `%s'
@@ -894,6 +958,30 @@ a B<-e> switch. Maybe your /tmp partition is full, or clobbered.
opposed to a subroutine reference): no such method callable via the
package. If method name is C<???>, this is an internal error.
+=item Character class syntax [. .] is reserved for future extensions
+
+(W) Within regular expression character classes ([]) the syntax beginning
+with "[." and ending with ".]" is reserved for future extensions.
+If you need to represent those character sequences inside a regular
+expression character class, just quote the square brackets with the
+backslash: "\[." and ".\]".
+
+=item Character class syntax [: :] is reserved for future extensions
+
+(W) Within regular expression character classes ([]) the syntax beginning
+with "[:" and ending with ":]" is reserved for future extensions.
+If you need to represent those character sequences inside a regular
+expression character class, just quote the square brackets with the
+backslash: "\[:" and ":\]".
+
+=item Character class syntax [= =] is reserved for future extensions
+
+(W) Within regular expression character classes ([]) the syntax
+beginning with "[=" and ending with "=]" is reserved for future extensions.
+If you need to represent those character sequences inside a regular
+expression character class, just quote the square brackets with the
+backslash: "\[=" and "=\]".
+
=item chmod: mode argument is missing initial 0
(W) A novice will sometimes say
@@ -913,11 +1001,31 @@ to 01411. Octal constants are introduced with a leading 0 in Perl, as in C.
Perl uses this generic message when none of the errors that it encountered
were severe enough to halt compilation immediately.
+=item Complex regular subexpression recursion limit (%d) exceeded
+
+(W) The regular expression engine uses recursion in complex situations
+where back-tracking is required. Recursion depth is limited to 32766,
+or perhaps less in architectures where the stack cannot grow
+arbitrarily. ("Simple" and "medium" situations are handled without
+recursion and are not subject to a limit.) Try shortening the string
+under examination; looping in Perl code (e.g. with C<while>) rather
+than in the regular expression engine; or rewriting the regular
+expression so that it is simpler or backtracks less. (See L<perlbook>
+for information on I<Mastering Regular Expressions>.)
+
=item connect() on closed fd
(W) You tried to do a connect on a closed socket. Did you forget to check
the return value of your socket() call? See L<perlfunc/connect>.
+=item Constant is not %s reference
+
+(F) A constant value (perhaps declared using the C<use constant> pragma)
+is being dereferenced, but it amounts to the wrong type of reference. The
+message indicates the type of reference that was expected. This usually
+indicates a syntax error in dereferencing the constant value.
+See L<perlsub/"Constant Functions"> and L<constant>.
+
=item Constant subroutine %s redefined
(S) You redefined a subroutine which had previously been eligible for
@@ -1020,6 +1128,27 @@ single form when it must operate on them directly. Either you've
passed an invalid file specification to Perl, or you've found a
case the conversion routines don't handle. Drat.
+=item %s: Eval-group in insecure regular expression
+
+(F) Perl detected tainted data when trying to compile a regular expression
+that contains the C<(?{ ... })> zero-width assertion, which is unsafe.
+See L<perlre/(?{ code })>, and L<perlsec>.
+
+=item %s: Eval-group not allowed, use re 'eval'
+
+(F) A regular expression contained the C<(?{ ... })> zero-width assertion,
+but that construct is only allowed when the C<use re 'eval'> pragma is
+in effect. See L<perlre/(?{ code })>.
+
+=item %s: Eval-group not allowed at run time
+
+(F) Perl tried to compile a regular expression containing the C<(?{ ... })>
+zero-width assertion at run time, as it would when the pattern contains
+interpolated values. Since that is a security risk, it is not allowed.
+If you insist, you may still do this by explicitly building the pattern
+from an interpolated string at run time and using that in an eval().
+See L<perlre/(?{ code })>.
+
=item Excessively long <> operator
(F) The contents of a <> operator may not exceed the maximum size of a
@@ -1052,6 +1181,13 @@ a goto, or a loop control statement.
(W) You are exiting a substitution by unconventional means, such as
a return, a goto, or a loop control statement.
+=item Explicit blessing to '' (assuming package main)
+
+(W) You are blessing a reference to a zero length string. This has
+the effect of blessing the reference into the package main. This is
+usually not what you want. Consider providing a default target
+package, e.g. bless($ref, $p || 'MyPackage');
+
=item Fatal VMS error at %s, line %d
(P) An error peculiar to VMS. Something untoward happened in a VMS system
@@ -1146,7 +1282,6 @@ Did you forget to check the return value of your socket() call?
(S) A warning peculiar to VMS. The call to C<sys$getuai> underlying the
C<getpwnam> operator returned an invalid UIC.
-
=item Glob not terminated
(F) The lexer saw a left angle bracket in a place where it was expecting
@@ -1230,6 +1365,12 @@ don't take to this kindly.
(W) You may have tried to use an 8 or 9 in a octal number. Interpretation
of the octal number stopped before the 8 or 9.
+=item Illegal hex digit ignored
+
+(W) You may have tried to use a character other than 0 - 9 or A - F in a
+hexadecimal number. Interpretation of the hexadecimal number stopped
+before the illegal character.
+
=item Illegal switch in PERL5OPT: %s
(X) The PERL5OPT environment variable may only be used to set the
@@ -1261,10 +1402,11 @@ for more information.
script if C<$ENV{PATH}> contains a directory that is writable by the world.
See L<perlsec>.
-=item Insecure PATH
+=item Insecure $ENV{%s} while running %s
(F) You can't use system(), exec(), or a piped open in a setuid or
-setgid script if C<$ENV{PATH}> is derived from data supplied (or
+setgid script if any of C<$ENV{PATH}>, C<$ENV{IFS}>, C<$ENV{CDPATH}>,
+C<$ENV{ENV}> or C<$ENV{BASH_ENV}> are derived from data supplied (or
potentially supplied) by the user. The script must set the path to a
known value, using trustworthy data. See L<perlsec>.
@@ -1285,7 +1427,7 @@ architecture. On a 32-bit architecture the largest octal literal is
(S) A warning peculiar to VMS. Perl keeps track of the number
of times you've called C<fork> and C<exec>, to determine
whether the current call to C<exec> should affect the current
-script or a subprocess (see L<perlvms/exec>). Somehow, this count
+script or a subprocess (see L<perlvms/"exec LIST">). Somehow, this count
has become scrambled, so Perl is making a guess and treating
this C<exec> as a request to terminate the Perl script
and execute the specified command.
@@ -1294,16 +1436,19 @@ and execute the specified command.
(P) Something went badly wrong in the regular expression parser.
-=item internal error: glob failed
+=item glob failed (%s)
-(P) Something went wrong with the external program(s) used for C<glob>
-and C<E<lt>*.cE<gt>>. This may mean that your csh (C shell) is
-broken. If so, you should change all of the csh-related variables in
-config.sh: If you have tcsh, make the variables refer to it as if it
-were csh (e.g. C<full_csh='/usr/bin/tcsh'>); otherwise, make them all
-empty (except that C<d_csh> should be C<'undef'>) so that Perl will
-think csh is missing. In either case, after editing config.sh, run
-C<./Configure -S> and rebuild Perl.
+(W) Something went wrong with the external program(s) used for C<glob>
+and C<E<lt>*.cE<gt>>. Usually, this means that you supplied a C<glob>
+pattern that caused the external program to fail and exit with a nonzero
+status. If the message indicates that the abnormal exit resulted in a
+coredump, this may also mean that your csh (C shell) is broken. If so,
+you should change all of the csh-related variables in config.sh: If you
+have tcsh, make the variables refer to it as if it were csh (e.g.
+C<full_csh='/usr/bin/tcsh'>); otherwise, make them all empty (except that
+C<d_csh> should be C<'undef'>) so that Perl will think csh is missing.
+In either case, after editing config.sh, run C<./Configure -S> and
+rebuild Perl.
=item internal urp in regexp at /%s/
@@ -1411,15 +1556,15 @@ catches that. But an easy way to do the same thing is:
Another way is to assign to a substr() that's off the end of the string.
-=item Modification of noncreatable array value attempted, subscript %d
+=item Modification of non-creatable array value attempted, subscript %d
(F) You tried to make an array value spring into existence, and the
subscript was probably negative, even counting from end of the array
backwards.
-=item Modification of noncreatable hash value attempted, subscript "%s"
+=item Modification of non-creatable hash value attempted, subscript "%s"
-(F) You tried to make a hash value spring into existence, and it couldn't
+(P) You tried to make a hash value spring into existence, and it couldn't
be created for some peculiar reason.
=item Module name must be constant
@@ -1560,6 +1705,19 @@ your system.
(F) The argument to B<-I> must follow the B<-I> immediately with no
intervening space.
+=item No such array field
+
+(F) You tried to access an array as a hash, but the field name used is
+not defined. The hash at index 0 should map all valid field names to
+array indices for that to work.
+
+=item No such field "%s" in variable %s of type %s
+
+(F) You tried to access a field of a typed variable where the type
+does not know about the field name. The field names are looked up in
+the %FIELDS hash in the type package at compile time. The %FIELDS hash
+is usually set up with the 'fields' pragma.
+
=item No such pipe open
(P) An error peculiar to VMS. The internal routine my_pclose() tried to
@@ -1669,10 +1827,10 @@ about 250 characters. You've exceeded that length. Future versions of
Perl are likely to eliminate this arbitrary limitation. In the meantime,
try using scientific notation (e.g. "1e6" instead of "1_000_000").
-=item Odd number of elements in hash list
+=item Odd number of elements in hash assignment
-(S) You specified an odd number of elements to a hash list, which is odd,
-because hash lists come in key/value pairs.
+(S) You specified an odd number of elements to initialize a hash, which
+is odd, because hashes come in key/value pairs.
=item Offset outside string
@@ -1689,7 +1847,7 @@ will extend the buffer and zero pad the new area.
(S) An internal warning that the grammar is screwed up.
-=item Operation `%s': no method found,%s
+=item Operation `%s': no method found, %s
(F) An attempt was made to perform an overloaded operation for which
no handler was defined. While some handlers can be autogenerated in
@@ -1710,7 +1868,7 @@ if you said "*foo * 'foo'".
(F) The yacc parser wanted to grow its stack so it could continue parsing,
but realloc() wouldn't give it more memory, virtual or otherwise.
-=item Out of memory!
+=item Out of memory during request for %s
(X|F) The malloc() function returned 0, indicating there was insufficient
remaining memory (or virtual memory) to satisfy the request.
@@ -1721,13 +1879,19 @@ However, if compiled for this, Perl may use the contents of C<$^M> as
an emergency pool after die()ing with this message. In this case the
error is trappable I<once>.
-=item Out of memory during request for %s
+=item Out of memory during "large" request for %s
(F) The malloc() function returned 0, indicating there was insufficient
remaining memory (or virtual memory) to satisfy the request. However,
the request was judged large enough (compile-time default is 64K), so
a possibility to shut down by trapping this error is granted.
+=item Out of memory during ridiculously large request
+
+(F) You can't allocate more than 2^31+"small amount" bytes. This error
+is most likely to be caused by a typo in the Perl program. e.g., C<$arr[time]>
+instead of C<$arr[$time]>.
+
=item page overflow
(W) A single call to write() produced more lines than can fit on a page.
@@ -1877,7 +2041,7 @@ was string.
(P) The lexer got into a bad state while processing a case modifier.
-=item Pareneses missing around "%s" list
+=item Parentheses missing around "%s" list
(W) You said something like
@@ -1915,8 +2079,7 @@ the BSD version, which takes a pid.
(W) qw() lists contain items separated by whitespace; as with literal
strings, comment characters are not ignored, but are instead treated
as literal data. (You may have used different delimiters than the
-exclamation marks parentheses shown here; braces are also frequently
-used.)
+parentheses shown here; braces are also frequently used.)
You probably wrote something like this:
@@ -2001,6 +2164,13 @@ last argument of the previous construct, for example:
(S) The subroutine being declared or defined had previously been declared
or defined with a different function prototype.
+=item Range iterator outside integer range
+
+(F) One (or both) of the numeric arguments to the range operator ".."
+are outside the range which can be represented by integers internally.
+One possible workaround is to force Perl to use magical string
+increment by prepending "0" to your numbers.
+
=item Read on closed filehandle E<lt>%sE<gt>
(W) The filehandle you're reading from got itself closed sometime before now.
@@ -2016,11 +2186,28 @@ Check your logic flow.
desired output is compiled into Perl, which entails some overhead,
which is why it's currently left out of your copy.
-=item Recursive inheritance detected
+=item Recursive inheritance detected in package '%s'
(F) More than 100 levels of inheritance were used. Probably indicates
an unintended loop in your inheritance hierarchy.
+=item Recursive inheritance detected while looking for method '%s' in package '%s'
+
+(F) More than 100 levels of inheritance were encountered while invoking a
+method. Probably indicates an unintended loop in your inheritance hierarchy.
+
+=item Reference found where even-sized list expected
+
+(W) You gave a single reference where Perl was expecting a list with
+an even number of elements (for assignment to a hash). This
+usually means that you used the anon hash constructor when you meant
+to use parens. In any case, a hash requires key/value B<pairs>.
+
+ %hash = { one => 1, two => 2, }; # WRONG
+ %hash = [ qw/ an anon array / ]; # WRONG
+ %hash = ( one => 1, two => 2, ); # right
+ %hash = qw( one 1 two 2 ); # also fine
+
=item Reference miscount in sv_replace()
(W) The internal sv_replace() function was handed a new SV with a
@@ -2129,6 +2316,7 @@ or possibly some other missing operator, such as a comma.
Check your logic flow.
=item Sequence (? incomplete
+
(F) A regular expression ended with an incomplete extension (?.
See L<perlre>.
@@ -2160,12 +2348,14 @@ from the user it isn't running under, and isn't in a location where the CGI
server can't find it, basically, more or less. Please see the following
for more information:
- http://www.perl.com/perl/faq/idiots-guide.html
- http://www.perl.com/perl/faq/perl-cgi-faq.html
+ http://www.perl.com/CPAN/doc/FAQs/cgi/idiots-guide.html
+ http://www.perl.com/CPAN/doc/FAQs/cgi/perl-cgi-faq.html
ftp://rtfm.mit.edu/pub/usenet/news.answers/www/cgi-faq
http://hoohoo.ncsa.uiuc.edu/cgi/interface.html
http://www-genome.wi.mit.edu/WWW/faqs/www-security-faq.html
+You should also look at L<perlfaq9>.
+
=item setegid() not implemented
(F) You tried to assign to C<$)>, and your operating system doesn't support
@@ -2243,6 +2433,14 @@ there was a failure. You probably wanted to use system() instead,
which does return. To suppress this warning, put the exec() in a block
by itself.
+=item Strange *+?{} on zero-length expression
+
+(W) You applied a regular expression quantifier in a place where it
+makes no sense, such as on a zero-width assertion.
+Try putting the quantifier inside the assertion instead. For example,
+the way to match "abc" provided that it is followed by three
+repetitions of "xyz" is C</abc(?=(?:xyz){3})/>, not C</abc(?=xyz){3}/>.
+
=item Stub found while resolving method `%s' overloading `%s' in package `%s'
(P) Overloading resolution over @ISA tree may be broken by importation stubs.
@@ -2317,10 +2515,12 @@ if the error went away. Sort of the cybernetic version of S<20 questions>.
instead of Perl. Check the #! line, or manually feed your script
into Perl yourself.
-=item System V IPC is not implemented on this machine
+=item System V %s is not implemented on this machine
-(F) You tried to do something with a function beginning with "sem", "shm",
-or "msg". See L<perlfunc/semctl>, for example.
+(F) You tried to do something with a function beginning with "sem",
+"shm", or "msg" but that System V IPC is not implemented in your
+machine. In some machines the functionality can exist but be
+unconfigured. Consult your system support.
=item Syswrite on closed filehandle
@@ -2429,13 +2629,13 @@ Perl yourself.
(F) The regular expression ends with an unbackslashed backslash. Backslash
it. See L<perlre>.
-=item Translation pattern not terminated
+=item Transliteration pattern not terminated
(F) The lexer couldn't find the interior delimiter of a tr/// or tr[][]
or y/// or y[][] construct. Missing the leading C<$> from variables
C<$tr> or C<$y> may cause this error.
-=item Translation replacement not terminated
+=item Transliteration replacement not terminated
(F) The lexer couldn't find the final delimiter of a tr/// or tr[][]
construct.
@@ -2454,8 +2654,13 @@ certain type. Arrays must be @NAME or C<@{EXPR}>. Hashes must be
=item umask: argument is missing initial 0
-(W) A umask of 222 is incorrect. It should be 0222, because octal literals
-always start with 0 in Perl, as in C.
+(W) A umask of 222 is incorrect. It should be 0222, because octal
+literals always start with 0 in Perl, as in C.
+
+=item umask not implemented
+
+(F) Your machine doesn't implement the umask function and you tried
+to use it to restrict permissions for yourself (EXPR & 0700).
=item Unable to create sub named "%s"
@@ -2511,6 +2716,11 @@ have been defined yet. See L<perlfunc/sort>.
(F) The format indicated doesn't seem to exist. Perhaps it's really in
another package? See L<perlform>.
+=item Undefined value assigned to typeglob
+
+(W) An undefined value was assigned to a typeglob, a la C<*foo = undef>.
+This does nothing. It's possible that you really mean C<undef *foo>.
+
=item unexec of %s into %s failed!
(F) The unexec() routine failed for some reason. See your local FSF
@@ -2582,7 +2792,7 @@ the name you call Perl by to C<perl_>, C<perl__>, and so on.
=item Unsupported function %s
-(F) This machines doesn't implement the indicated function, apparently.
+(F) This machine doesn't implement the indicated function, apparently.
At least, Configure doesn't think so.
=item Unsupported socket function "%s" called
@@ -2642,7 +2852,7 @@ a split() explicitly to an array (or list).
(D) As an (ahem) accidental feature, C<AUTOLOAD> subroutines are looked
up as methods (using the C<@ISA> hierarchy) even when the subroutines to
be autoloaded were called as plain functions (e.g. C<Foo::bar()>), not
-as methods (e.g. C<Foo->bar()> or C<$obj->bar()>).
+as methods (e.g. C<Foo-E<gt>bar()> or C<$obj-E<gt>bar()>).
This bug will be rectified in Perl 5.005, which will use method lookup
only for methods' C<AUTOLOAD>s. However, there is a significant base
@@ -2657,7 +2867,16 @@ C<BaseClass>, execute C<*AUTOLOAD = \&BaseClass::AUTOLOAD> during startup.
In code that currently says C<use AutoLoader; @ISA = qw(AutoLoader);> you
should remove AutoLoader from @ISA and change C<use AutoLoader;> to
-C<C<use AutoLoader 'AUTOLOAD';>.
+C<use AutoLoader 'AUTOLOAD';>.
+
+=item Use of reserved word "%s" is deprecated
+
+(D) The indicated bareword is a reserved word. Future versions of perl
+may use it as a keyword, so you're better off either explicitly quoting
+the word in a manner appropriate for its context of use, or using a
+different name altogether. The warning can be suppressed for subroutine
+names by either adding a C<&> prefix, or using a package qualifier,
+e.g. C<&our()>, or C<Foo::our()>.
=item Use of %s is deprecated
@@ -2671,6 +2890,10 @@ bad side effects.
interpreted as a "" or a 0, but maybe it was a mistake. To suppress this
warning assign an initial value to your variables.
+=item Useless use of "re" pragma
+
+(W) You did C<use re;> without any arguments. That isn't very useful.
+
=item Useless use of %s in void context
(W) You did something without a side effect in a context that does nothing
@@ -2773,6 +2996,27 @@ variables.
of Perl. Check the #! line, or manually feed your script into
Perl yourself.
+=item perl: warning: Setting locale failed.
+
+(S) The whole warning message will look something like:
+
+ perl: warning: Setting locale failed.
+ perl: warning: Please check that your locale settings:
+ LC_ALL = "En_US",
+ LANG = (unset)
+ are supported and installed on your system.
+ perl: warning: Falling back to the standard locale ("C").
+
+Exactly what were the failed locale settings varies. In the above the
+settings were that the LC_ALL was "En_US" and the LANG had no value.
+This error means that Perl detected that you and/or your system
+administrator have set up the so-called variable system but Perl could
+not use those settings. This was not dead serious, fortunately: there
+is a "default locale" called "C" that Perl can and will use, the
+script will be run. Before you really fix the problem, however, you
+will get the same error message each time you run Perl. How to really
+fix the problem can be found in L<perllocale> section B<LOCALE PROBLEMS>.
+
=item Warning: something's wrong
(W) You passed warn() an empty string (the equivalent of C<warn "">) or
diff --git a/gnu/usr.bin/perl/pod/perldsc.pod b/gnu/usr.bin/perl/pod/perldsc.pod
index 48750dd5de3..ef3ae750a55 100644
--- a/gnu/usr.bin/perl/pod/perldsc.pod
+++ b/gnu/usr.bin/perl/pod/perldsc.pod
@@ -64,8 +64,8 @@ sections on each of the following:
=back
-But for now, let's look at some of the general issues common to all
-of these types of data structures.
+But for now, let's look at general issues common to all
+these types of data structures.
=head1 REFERENCES
@@ -305,7 +305,7 @@ debugger includes several new features, including command line editing as
well as the C<x> command to dump out complex data structures. For
example, given the assignment to $LoL above, here's the debugger output:
- DB<1> X $LoL
+ DB<1> x $LoL
$LoL = ARRAY(0x13b5a0)
0 ARRAY(0x1f0a24)
0 'fred'
@@ -324,8 +324,6 @@ example, given the assignment to $LoL above, here's the debugger output:
2 'elroy'
3 'judy'
-There's also a lowercase B<x> command which is nearly the same.
-
=head1 CODE EXAMPLES
Presented with little comment (these will get their own manpages someday)
@@ -463,7 +461,7 @@ types of data structures.
$a cmp $b
} keys %HoL )
{
- print "$family: ", join(", ", sort @{ $HoL{$family}), "\n";
+ print "$family: ", join(", ", sort @{ $HoL{$family} }), "\n";
}
=head1 LISTS OF HASHES
@@ -616,7 +614,7 @@ types of data structures.
# append new members to an existing family
%new_folks = (
wife => "wilma",
- pet => "dino";
+ pet => "dino",
);
for $what (keys %new_folks) {
@@ -692,7 +690,7 @@ many different sorts:
print $rec->{TEXT};
- print $rec->{LIST}[0];
+ print $rec->{SEQUENCE}[0];
$last = pop @ { $rec->{SEQUENCE} };
print $rec->{LOOKUP}{"key"};
diff --git a/gnu/usr.bin/perl/pod/perlembed.pod b/gnu/usr.bin/perl/pod/perlembed.pod
index c43ed556aa7..03c5507655a 100644
--- a/gnu/usr.bin/perl/pod/perlembed.pod
+++ b/gnu/usr.bin/perl/pod/perlembed.pod
@@ -12,7 +12,7 @@ Do you want to:
=item B<Use C from Perl?>
-Read L<perlcall> and L<perlxs>.
+Read L<perlxstut>, L<perlxs>, L<h2xs>, and L<perlguts>.
=item B<Use a Unix program from Perl?>
@@ -20,7 +20,7 @@ Read about back-quotes and about C<system> and C<exec> in L<perlfunc>.
=item B<Use Perl from Perl?>
-Read about L<perlfunc/do> and L<perlfunc/eval> and L<perlfunc/require>
+Read about L<perlfunc/do> and L<perlfunc/eval> and L<perlfunc/require>
and L<perlfunc/use>.
=item B<Use C from C?>
@@ -35,9 +35,9 @@ Read on...
=head2 ROADMAP
-L<Compiling your C program>
+=over 5
-There's one example in each of the nine sections:
+L<Compiling your C program>
L<Adding a Perl interpreter to your C program>
@@ -57,6 +57,8 @@ L<Using Perl modules, which themselves use C libraries, from your C program>
L<Embedding Perl under Win32>
+=back
+
=head2 Compiling your C program
If you have trouble compiling the scripts in this documentation,
@@ -103,8 +105,8 @@ L<Adding a Perl interpreter to your C program>, on my Linux box:
-L/usr/local/lib/perl5/i586-linux/5.003/CORE
-o interp interp.c -lperl -lm
-(That's all one line.) On my DEC Alpha running 5.003_05, the incantation
-is a bit different:
+(That's all one line.) On my DEC Alpha running old 5.003_05, the
+incantation is a bit different:
% cc -O2 -Olimit 2900 -DSTANDARD_C -I/usr/local/include
-I/usr/local/lib/perl5/alpha-dec_osf/5.00305/CORE
@@ -139,7 +141,7 @@ you:
If the B<ExtUtils::Embed> module isn't part of your Perl distribution,
you can retrieve it from
-http://www.perl.com/perl/CPAN/modules/by-module/ExtUtils::Embed. (If
+http://www.perl.com/perl/CPAN/modules/by-module/ExtUtils/. (If
this documentation came from your Perl distribution, then you're
running 5.004 or better and you already have it.)
@@ -151,7 +153,7 @@ information you may find useful.
In a sense, perl (the C program) is a good example of embedding Perl
(the language), so I'll demonstrate embedding with I<miniperlmain.c>,
-from the source distribution. Here's a bastardized, nonportable
+included in the source distribution. Here's a bastardized, nonportable
version of I<miniperlmain.c> containing the essentials of embedding:
#include <EXTERN.h> /* from the Perl distribution */
@@ -194,13 +196,13 @@ or
You can also read and execute Perl statements from a file while in the
midst of your C program, by placing the filename in I<argv[1]> before
-calling I<perl_run()>.
+calling I<perl_run>.
=head2 Calling a Perl subroutine from your C program
To call individual Perl subroutines, you can use any of the B<perl_call_*>
-functions documented in the L<perlcall> manpage.
-In this example we'll use I<perl_call_argv>.
+functions documented in L<perlcall>.
+In this example we'll use C<perl_call_argv>.
That's shown below, in a program I'll call I<showtime.c>.
@@ -263,15 +265,15 @@ your C program>.
=head2 Evaluating a Perl statement from your C program
Perl provides two API functions to evaluate pieces of Perl code.
-These are L<perlguts/perl_eval_sv()> and L<perlguts/perl_eval_pv()>.
+These are L<perlguts/perl_eval_sv> and L<perlguts/perl_eval_pv>.
Arguably, these are the only routines you'll ever need to execute
-snippets of Perl code from within your C program. Your code can be
-as long as you wish; it can contain multiple statements; it can employ
-L<perlfunc/use>, L<perlfunc/require> and L<perlfunc/do> to include
-external Perl files.
+snippets of Perl code from within your C program. Your code can be as
+long as you wish; it can contain multiple statements; it can employ
+L<perlfunc/use>, L<perlfunc/require>, and L<perlfunc/do> to
+include external Perl files.
-I<perl_eval_pv()> lets us evaluate individual Perl strings, and then
+I<perl_eval_pv> lets us evaluate individual Perl strings, and then
extract variables for coercion into C types. The following program,
I<string.c>, executes three Perl strings, extracting an C<int> from
the first, a C<float> from the second, and a C<char *> from the third.
@@ -283,6 +285,7 @@ the first, a C<float> from the second, and a C<char *> from the third.
main (int argc, char **argv, char **env)
{
+ STRLEN n_a;
char *embedding[] = { "", "-e", "0" };
my_perl = perl_alloc();
@@ -301,7 +304,7 @@ the first, a C<float> from the second, and a C<char *> from the third.
/** Treat $a as a string **/
perl_eval_pv("$a = 'rekcaH lreP rehtonA tsuJ'; $a = reverse($a);", TRUE);
- printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), na));
+ printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), n_a));
perl_destruct(my_perl);
perl_free(my_perl);
@@ -320,11 +323,12 @@ I<SvPV()> to create a string:
In the example above, we've created a global variable to temporarily
store the computed value of our eval'd expression. It is also
possible and in most cases a better strategy to fetch the return value
-from L<perl_eval_pv> instead. Example:
+from I<perl_eval_pv()> instead. Example:
...
+ STRLEN n_a;
SV *val = perl_eval_pv("reverse 'rekcaH lreP rehtonA tsuJ'", TRUE);
- printf("%s\n", SvPV(val,na));
+ printf("%s\n", SvPV(val,n_a));
...
This way, we avoid namespace pollution by not creating global
@@ -332,11 +336,11 @@ variables and we've simplified our code as well.
=head2 Performing Perl pattern matches and substitutions from your C program
-The I<perl_eval_sv()> function lets us evaluate chunks of Perl code, so we can
+The I<perl_eval_sv()> function lets us evaluate strings of Perl code, so we can
define some functions that use it to "specialize" in matches and
substitutions: I<match()>, I<substitute()>, and I<matches()>.
- char match(SV *string, char *pattern);
+ I32 match(SV *string, char *pattern);
Given a string and a pattern (e.g., C<m/clasp/> or C</\b\w*\b/>, which
in your C program might appear as "/\\b\\w*\\b/"), match()
@@ -369,16 +373,17 @@ been wrapped here):
{
dSP;
SV* retval;
+ STRLEN n_a;
- PUSHMARK(sp);
+ PUSHMARK(SP);
perl_eval_sv(sv, G_SCALAR);
SPAGAIN;
retval = POPs;
PUTBACK;
- if (croak_on_error && SvTRUE(GvSV(errgv)))
- croak(SvPVx(GvSV(errgv), na));
+ if (croak_on_error && SvTRUE(ERRSV))
+ croak(SvPVx(ERRSV, n_a));
return retval;
}
@@ -392,10 +397,11 @@ been wrapped here):
I32 match(SV *string, char *pattern)
{
- SV *command = newSV(0), *retval;
+ SV *command = NEWSV(1099, 0), *retval;
+ STRLEN n_a;
sv_setpvf(command, "my $string = '%s'; $string =~ %s",
- SvPV(string,na), pattern);
+ SvPV(string,n_a), pattern);
retval = my_perl_eval_sv(command, TRUE);
SvREFCNT_dec(command);
@@ -413,10 +419,11 @@ been wrapped here):
I32 substitute(SV **string, char *pattern)
{
- SV *command = newSV(0), *retval;
+ SV *command = NEWSV(1099, 0), *retval;
+ STRLEN n_a;
sv_setpvf(command, "$string = '%s'; ($string =~ %s)",
- SvPV(*string,na), pattern);
+ SvPV(*string,n_a), pattern);
retval = my_perl_eval_sv(command, TRUE);
SvREFCNT_dec(command);
@@ -435,11 +442,12 @@ been wrapped here):
I32 matches(SV *string, char *pattern, AV **match_list)
{
- SV *command = newSV(0);
+ SV *command = NEWSV(1099, 0);
I32 num_matches;
+ STRLEN n_a;
sv_setpvf(command, "my $string = '%s'; @array = ($string =~ %s)",
- SvPV(string,na), pattern);
+ SvPV(string,n_a), pattern);
my_perl_eval_sv(command, TRUE);
SvREFCNT_dec(command);
@@ -456,7 +464,8 @@ been wrapped here):
char *embedding[] = { "", "-e", "0" };
AV *match_list;
I32 num_matches, i;
- SV *text = newSV(0);
+ SV *text = NEWSV(1099,0);
+ STRLEN n_a;
perl_construct(my_perl);
perl_parse(my_perl, NULL, 3, embedding, NULL);
@@ -478,7 +487,7 @@ been wrapped here):
printf("matches: m/(wi..)/g found %d matches...\n", num_matches);
for (i = 0; i < num_matches; i++)
- printf("match: %s\n", SvPV(*av_fetch(match_list, i, FALSE),na));
+ printf("match: %s\n", SvPV(*av_fetch(match_list, i, FALSE),n_a));
printf("\n");
/** Remove all vowels from text **/
@@ -486,7 +495,7 @@ been wrapped here):
if (num_matches) {
printf("substitute: s/[aeiou]//gi...%d substitutions made.\n",
num_matches);
- printf("Now text is: %s\n\n", SvPV(text,na));
+ printf("Now text is: %s\n\n", SvPV(text,n_a));
}
/** Attempt a substitution **/
@@ -495,7 +504,7 @@ been wrapped here):
}
SvREFCNT_dec(text);
- perl_destruct_level = 1;
+ PL_perl_destruct_level = 1;
perl_destruct(my_perl);
perl_free(my_perl);
}
@@ -563,7 +572,7 @@ deep breath...
dSP; /* initialize stack pointer */
ENTER; /* everything created after here */
SAVETMPS; /* ...is a temporary variable. */
- PUSHMARK(sp); /* remember the stack pointer */
+ PUSHMARK(SP); /* remember the stack pointer */
XPUSHs(sv_2mortal(newSViv(a))); /* push the base onto the stack */
XPUSHs(sv_2mortal(newSViv(b))); /* push the exponent onto stack */
PUTBACK; /* make local stack pointer global */
@@ -648,6 +657,7 @@ with L<perlfunc/my> whenever possible.
use strict;
use vars '%Cache';
+ use Symbol qw(delete_package);
sub valid_package_name {
my($string) = @_;
@@ -660,20 +670,6 @@ with L<perlfunc/my> whenever possible.
return "Embed" . $string;
}
- #borrowed from Safe.pm
- sub delete_package {
- my $pkg = shift;
- my ($stem, $leaf);
-
- no strict 'refs';
- $pkg = "main::$pkg\::"; # expand to full symbol table name
- ($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
-
- my $stem_symtab = *{$stem}{HASH};
-
- delete $stem_symtab->{$leaf};
- }
-
sub eval_file {
my($filename, $delete) = @_;
my $package = valid_package_name($filename);
@@ -737,6 +733,7 @@ with L<perlfunc/my> whenever possible.
char *args[] = { "", DO_CLEAN, NULL };
char filename [1024];
int exitstatus = 0;
+ STRLEN n_a;
if((perl = perl_alloc()) == NULL) {
fprintf(stderr, "no memory!");
@@ -757,12 +754,12 @@ with L<perlfunc/my> whenever possible.
G_DISCARD | G_EVAL, args);
/* check $@ */
- if(SvTRUE(GvSV(errgv)))
- fprintf(stderr, "eval error: %s\n", SvPV(GvSV(errgv),na));
+ if(SvTRUE(ERRSV))
+ fprintf(stderr, "eval error: %s\n", SvPV(ERRSV,n_a));
}
}
- perl_destruct_level = 0;
+ PL_perl_destruct_level = 0;
perl_destruct(perl);
perl_free(perl);
exit(exitstatus);
@@ -800,16 +797,16 @@ release any resources associated with the interpreter.
The program must take care to ensure that this takes place I<before>
the next interpreter is constructed. By default, the global variable
-C<perl_destruct_level> is set to C<0>, since extra cleaning isn't
+C<PL_perl_destruct_level> is set to C<0>, since extra cleaning isn't
needed when a program has only one interpreter.
-Setting C<perl_destruct_level> to C<1> makes everything squeaky clean:
+Setting C<PL_perl_destruct_level> to C<1> makes everything squeaky clean:
- perl_destruct_level = 1;
+ PL_perl_destruct_level = 1;
while(1) {
...
- /* reset global variables here with perl_destruct_level = 1 */
+ /* reset global variables here with PL_perl_destruct_level = 1 */
perl_construct(my_perl);
...
/* clean and reset _everything_ during perl_destruct */
@@ -825,7 +822,7 @@ and symbol tables are cleaned up, and global variables are reset.
Now suppose we have more than one interpreter instance running at the
same time. This is feasible, but only if you used the
C<-DMULTIPLICITY> flag when building Perl. By default, that sets
-C<perl_destruct_level> to C<1>.
+C<PL_perl_destruct_level> to C<1>.
Let's give it a try:
@@ -960,39 +957,39 @@ Consult L<perlxs> and L<perlguts> for more details.
=head1 Embedding Perl under Win32
-At the time of this writing, there are two versions of Perl which run
-under Win32. Interfacing to Activeware's Perl library is quite
-different from the examples in this documentation, as significant
-changes were made to the internal Perl API. However, it is possible
-to embed Activeware's Perl runtime, see the Perl for Win32 FAQ:
-http://www.perl.com/perl/faq/win32/Perl_for_Win32_FAQ.html
+At the time of this writing (5.004), there are two versions of Perl
+which run under Win32. (The two versions are merging in 5.005.)
+Interfacing to ActiveState's Perl library is quite different from the
+examples in this documentation, as significant changes were made to
+the internal Perl API. However, it is possible to embed ActiveState's
+Perl runtime. For details, see the Perl for Win32 FAQ at
+http://www.perl.com/CPAN/doc/FAQs/win32/perlwin32faq.html.
With the "official" Perl version 5.004 or higher, all the examples
-within this documentation will compile and run untouched, although,
+within this documentation will compile and run untouched, although
the build process is slightly different between Unix and Win32.
-For starters, backticks don't work under the Win32 native command shell!
+For starters, backticks don't work under the Win32 native command shell.
The ExtUtils::Embed kit on CPAN ships with a script called
B<genmake>, which generates a simple makefile to build a program from
-a single C source file. It can be used like so:
+a single C source file. It can be used like this:
C:\ExtUtils-Embed\eg> perl genmake interp.c
C:\ExtUtils-Embed\eg> nmake
C:\ExtUtils-Embed\eg> interp -e "print qq{I'm embedded in Win32!\n}"
-You may wish to use a more robust environment such as the MS Developer
-stdio. In this case, to generate perlxsi.c run:
+You may wish to use a more robust environment such as the Microsoft
+Developer Studio. In this case, run this to generate perlxsi.c:
perl -MExtUtils::Embed -e xsinit
-Create a new project, Insert -> Files into Project: perlxsi.c, perl.lib,
-and your own source files, e.g. interp.c. Typically you'll find
-perl.lib in B<C:\perl\lib\CORE>, if not, you should see the B<CORE>
-directory relative to C<perl -V:archlib>.
-The studio will also need this path so it knows where to find Perl
-include files. This path can be added via the Tools -> Options ->
-Directories menu. Finnally, select Build -> Build interp.exe and
-you're ready to go!
+Create a new project and Insert -> Files into Project: perlxsi.c,
+perl.lib, and your own source files, e.g. interp.c. Typically you'll
+find perl.lib in B<C:\perl\lib\CORE>, if not, you should see the
+B<CORE> directory relative to C<perl -V:archlib>. The studio will
+also need this path so it knows where to find Perl include files.
+This path can be added via the Tools -> Options -> Directories menu.
+Finally, select Build -> Build interp.exe and you're ready to go.
=head1 MORAL
@@ -1003,28 +1000,38 @@ each from the other, combine them as you wish.
=head1 AUTHOR
-Jon Orwant and <F<orwant@tpj.com>> and Doug MacEachern <F<dougm@osf.org>>,
-with small contributions from Tim Bunce, Tom Christiansen, Hallvard Furuseth,
-Dov Grobgeld, and Ilya Zakharevich.
-
-Check out Doug's article on embedding in Volume 1, Issue 4 of The Perl
-Journal. Info about TPJ is available from http://tpj.com.
+Jon Orwant <F<orwant@tpj.com>> and Doug MacEachern
+<F<dougm@osf.org>>, with small contributions from Tim Bunce, Tom
+Christiansen, Guy Decoux, Hallvard Furuseth, Dov Grobgeld, and Ilya
+Zakharevich.
-July 17, 1997
+Doug MacEachern has an article on embedding in Volume 1, Issue 4 of
+The Perl Journal (http://tpj.com). Doug is also the developer of the
+most widely-used Perl embedding: the mod_perl system
+(perl.apache.org), which embeds Perl in the Apache web server.
+Oracle, Binary Evolution, ActiveState, and Ben Sugars's nsapi_perl
+have used this model for Oracle, Netscape and Internet Information
+Server Perl plugins.
-Some of this material is excerpted from Jon Orwant's book: I<Perl 5
-Interactive>, Waite Group Press, 1996 (ISBN 1-57169-064-6) and appears
-courtesy of Waite Group Press.
+July 22, 1998
=head1 COPYRIGHT
-Copyright (C) 1995, 1996, 1997 Doug MacEachern and Jon Orwant. All
+Copyright (C) 1995, 1996, 1997, 1998 Doug MacEachern and Jon Orwant. All
Rights Reserved.
-Although destined for release with the standard Perl distribution,
-this document is not public domain, nor is any of Perl and its
-documentation. Permission is granted to freely distribute verbatim
-copies of this document provided that no modifications outside of
-formatting be made, and that this notice remain intact. You are
-permitted and encouraged to use its code and derivatives thereof in
-your own source code for fun or for profit as you see fit.
+Permission is granted to make and distribute verbatim copies of this
+documentation provided the copyright notice and this permission notice are
+preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+documentation under the conditions for verbatim copying, provided also
+that they are marked clearly as modified versions, that the authors'
+names and title are unchanged (though subtitles and additional
+authors' names may be added), and that the entire resulting derived
+work is distributed under the terms of a permission notice identical
+to this one.
+
+Permission is granted to copy and distribute translations of this
+documentation into another language, under the above conditions for
+modified versions.
diff --git a/gnu/usr.bin/perl/pod/perlfaq.pod b/gnu/usr.bin/perl/pod/perlfaq.pod
index 2213a0f2f01..cb354931ccc 100644
--- a/gnu/usr.bin/perl/pod/perlfaq.pod
+++ b/gnu/usr.bin/perl/pod/perlfaq.pod
@@ -1,6 +1,6 @@
=head1 NAME
-perlfaq - frequently asked questions about Perl ($Date: 1997/04/24 22:46:06 $)
+perlfaq - frequently asked questions about Perl ($Date: 1999/01/08 05:54:52 $)
=head1 DESCRIPTION
@@ -16,42 +16,682 @@ This document.
Very general, high-level information about Perl.
+=over 4
+
+=item * What is Perl?
+
+=item * Who supports Perl? Who develops it? Why is it free?
+
+=item * Which version of Perl should I use?
+
+=item * What are perl4 and perl5?
+
+=item * What is perl6?
+
+=item * How stable is Perl?
+
+=item * Is Perl difficult to learn?
+
+=item * How does Perl compare with other languages like Java, Python, REXX, Scheme, or Tcl?
+
+=item * Can I do [task] in Perl?
+
+=item * When shouldn't I program in Perl?
+
+=item * What's the difference between "perl" and "Perl"?
+
+=item * Is it a Perl program or a Perl script?
+
+=item * What is a JAPH?
+
+=item * Where can I get a list of Larry Wall witticisms?
+
+=item * How can I convince my sysadmin/supervisor/employees to use version (5/5.005/Perl instead of some other language)?
+
+=back
+
+
=item L<perlfaq2>: Obtaining and Learning about Perl
-Where to find source and documentation to Perl, support and training,
+Where to find source and documentation to Perl, support,
and related matters.
+=over 4
+
+=item * What machines support Perl? Where do I get it?
+
+=item * How can I get a binary version of Perl?
+
+=item * I don't have a C compiler on my system. How can I compile perl?
+
+=item * I copied the Perl binary from one machine to another, but scripts don't work.
+
+=item * I grabbed the sources and tried to compile but gdbm/dynamic loading/malloc/linking/... failed. How do I make it work?
+
+=item * What modules and extensions are available for Perl? What is CPAN? What does CPAN/src/... mean?
+
+=item * Is there an ISO or ANSI certified version of Perl?
+
+=item * Where can I get information on Perl?
+
+=item * What are the Perl newsgroups on USENET? Where do I post questions?
+
+=item * Where should I post source code?
+
+=item * Perl Books
+
+=item * Perl in Magazines
+
+=item * Perl on the Net: FTP and WWW Access
+
+=item * What mailing lists are there for perl?
+
+=item * Archives of comp.lang.perl.misc
+
+=item * Where can I buy a commercial version of Perl?
+
+=item * Where do I send bug reports?
+
+=item * What is perl.com?
+
+=back
+
+
=item L<perlfaq3>: Programming Tools
Programmer tools and programming support.
+=over 4
+
+=item * How do I do (anything)?
+
+=item * How can I use Perl interactively?
+
+=item * Is there a Perl shell?
+
+=item * How do I debug my Perl programs?
+
+=item * How do I profile my Perl programs?
+
+=item * How do I cross-reference my Perl programs?
+
+=item * Is there a pretty-printer (formatter) for Perl?
+
+=item * Is there a ctags for Perl?
+
+=item * Is there an IDE or Windows Perl Editor?
+
+=item * Where can I get Perl macros for vi?
+
+=item * Where can I get perl-mode for emacs?
+
+=item * How can I use curses with Perl?
+
+=item * How can I use X or Tk with Perl?
+
+=item * How can I generate simple menus without using CGI or Tk?
+
+=item * What is undump?
+
+=item * How can I make my Perl program run faster?
+
+=item * How can I make my Perl program take less memory?
+
+=item * Is it unsafe to return a pointer to local data?
+
+=item * How can I free an array or hash so my program shrinks?
+
+=item * How can I make my CGI script more efficient?
+
+=item * How can I hide the source for my Perl program?
+
+=item * How can I compile my Perl program into byte code or C?
+
+=item * How can I compile Perl into Java?
+
+=item * How can I get C<#!perl> to work on [MS-DOS,NT,...]?
+
+=item * Can I write useful perl programs on the command line?
+
+=item * Why don't perl one-liners work on my DOS/Mac/VMS system?
+
+=item * Where can I learn about CGI or Web programming in Perl?
+
+=item * Where can I learn about object-oriented Perl programming?
+
+=item * Where can I learn about linking C with Perl? [h2xs, xsubpp]
+
+=item * I've read perlembed, perlguts, etc., but I can't embed perl in
+my C program, what am I doing wrong?
+
+=item * When I tried to run my script, I got this message. What does it
+mean?
+
+=item * What's MakeMaker?
+
+=back
+
+
=item L<perlfaq4>: Data Manipulation
Manipulating numbers, dates, strings, arrays, hashes, and
miscellaneous data issues.
+=over 4
+
+=item * Why am I getting long decimals (eg, 19.9499999999999) instead of the numbers I should be getting (eg, 19.95)?
+
+=item * Why isn't my octal data interpreted correctly?
+
+=item * Does Perl have a round() function? What about ceil() and floor()? Trig functions?
+
+=item * How do I convert bits into ints?
+
+=item * Why doesn't & work the way I want it to?
+
+=item * How do I multiply matrices?
+
+=item * How do I perform an operation on a series of integers?
+
+=item * How can I output Roman numerals?
+
+=item * Why aren't my random numbers random?
+
+=item * How do I find the week-of-the-year/day-of-the-year?
+
+=item * How can I compare two dates and find the difference?
+
+=item * How can I take a string and turn it into epoch seconds?
+
+=item * How can I find the Julian Day?
+
+=item * How do I find yesterday's date?
+
+=item * Does Perl have a year 2000 problem? Is Perl Y2K compliant?
+
+=item * How do I validate input?
+
+=item * How do I unescape a string?
+
+=item * How do I remove consecutive pairs of characters?
+
+=item * How do I expand function calls in a string?
+
+=item * How do I find matching/nesting anything?
+
+=item * How do I reverse a string?
+
+=item * How do I expand tabs in a string?
+
+=item * How do I reformat a paragraph?
+
+=item * How can I access/change the first N letters of a string?
+
+=item * How do I change the Nth occurrence of something?
+
+=item * How can I count the number of occurrences of a substring within a string?
+
+=item * How do I capitalize all the words on one line?
+
+=item * How can I split a [character] delimited string except when inside
+[character]? (Comma-separated files)
+
+=item * How do I strip blank space from the beginning/end of a string?
+
+=item * How do I pad a string with blanks or pad a number with zeroes?
+
+=item * How do I extract selected columns from a string?
+
+=item * How do I find the soundex value of a string?
+
+=item * How can I expand variables in text strings?
+
+=item * What's wrong with always quoting "$vars"?
+
+=item * Why don't my E<lt>E<lt>HERE documents work?
+
+=item * What is the difference between a list and an array?
+
+=item * What is the difference between $array[1] and @array[1]?
+
+=item * How can I extract just the unique elements of an array?
+
+=item * How can I tell whether a list or array contains a certain element?
+
+=item * How do I compute the difference of two arrays? How do I compute the intersection of two arrays?
+
+=item * How do I test whether two arrays or hashes are equal?
+
+=item * How do I find the first array element for which a condition is true?
+
+=item * How do I handle linked lists?
+
+=item * How do I handle circular lists?
+
+=item * How do I shuffle an array randomly?
+
+=item * How do I process/modify each element of an array?
+
+=item * How do I select a random element from an array?
+
+=item * How do I permute N elements of a list?
+
+=item * How do I sort an array by (anything)?
+
+=item * How do I manipulate arrays of bits?
+
+=item * Why does defined() return true on empty arrays and hashes?
+
+=item * How do I process an entire hash?
+
+=item * What happens if I add or remove keys from a hash while iterating over it?
+
+=item * How do I look up a hash element by value?
+
+=item * How can I know how many entries are in a hash?
+
+=item * How do I sort a hash (optionally by value instead of key)?
+
+=item * How can I always keep my hash sorted?
+
+=item * What's the difference between "delete" and "undef" with hashes?
+
+=item * Why don't my tied hashes make the defined/exists distinction?
+
+=item * How do I reset an each() operation part-way through?
+
+=item * How can I get the unique keys from two hashes?
+
+=item * How can I store a multidimensional array in a DBM file?
+
+=item * How can I make my hash remember the order I put elements into it?
+
+=item * Why does passing a subroutine an undefined element in a hash create it?
+
+=item * How can I make the Perl equivalent of a C structure/C++ class/hash or array of hashes or arrays?
+
+=item * How can I use a reference as a hash key?
+
+=item * How do I handle binary data correctly?
+
+=item * How do I determine whether a scalar is a number/whole/integer/float?
+
+=item * How do I keep persistent data across program calls?
+
+=item * How do I print out or copy a recursive data structure?
+
+=item * How do I define methods for every class/object?
+
+=item * How do I verify a credit card checksum?
+
+=item * How do I pack arrays of doubles or floats for XS code?
+
+=back
+
+
=item L<perlfaq5>: Files and Formats
I/O and the "f" issues: filehandles, flushing, formats and footers.
+=over 4
+
+=item * How do I flush/unbuffer an output filehandle? Why must I do this?
+
+=item * How do I change one line in a file/delete a line in a file/insert a line in the middle of a file/append to the beginning of a file?
+
+=item * How do I count the number of lines in a file?
+
+=item * How do I make a temporary file name?
+
+=item * How can I manipulate fixed-record-length files?
+
+=item * How can I make a filehandle local to a subroutine? How do I pass filehandles between subroutines? How do I make an array of filehandles?
+
+=item * How can I use a filehandle indirectly?
+
+=item * How can I set up a footer format to be used with write()?
+
+=item * How can I write() into a string?
+
+=item * How can I output my numbers with commas added?
+
+=item * How can I translate tildes (~) in a filename?
+
+=item * How come when I open a file read-write it wipes it out?
+
+=item * Why do I sometimes get an "Argument list too long" when I use E<lt>*E<gt>?
+
+=item * Is there a leak/bug in glob()?
+
+=item * How can I open a file with a leading "E<gt>" or trailing blanks?
+
+=item * How can I reliably rename a file?
+
+=item * How can I lock a file?
+
+=item * Why can't I just open(FH, ">file.lock")?
+
+=item * I still don't get locking. I just want to increment the number in the file. How can I do this?
+
+=item * How do I randomly update a binary file?
+
+=item * How do I get a file's timestamp in perl?
+
+=item * How do I set a file's timestamp in perl?
+
+=item * How do I print to more than one file at once?
+
+=item * How can I read in a file by paragraphs?
+
+=item * How can I read a single character from a file? From the keyboard?
+
+=item * How can I tell whether there's a character waiting on a filehandle?
+
+=item * How do I do a C<tail -f> in perl?
+
+=item * How do I dup() a filehandle in Perl?
+
+=item * How do I close a file descriptor by number?
+
+=item * Why can't I use "C:\temp\foo" in DOS paths? What doesn't `C:\temp\foo.exe` work?
+
+=item * Why doesn't glob("*.*") get all the files?
+
+=item * Why does Perl let me delete read-only files? Why does C<-i> clobber protected files? Isn't this a bug in Perl?
+
+=item * How do I select a random line from a file?
+
+=item * Why do I get weird spaces when I print an array of lines?
+
+=back
+
+
=item L<perlfaq6>: Regexps
Pattern matching and regular expressions.
+=over 4
+
+=item * How can I hope to use regular expressions without creating illegible and unmaintainable code?
+
+=item * I'm having trouble matching over more than one line. What's wrong?
+
+=item * How can I pull out lines between two patterns that are themselves on different lines?
+
+=item * I put a regular expression into $/ but it didn't work. What's wrong?
+
+=item * How do I substitute case insensitively on the LHS, but preserving case on the RHS?
+
+=item * How can I make C<\w> match national character sets?
+
+=item * How can I match a locale-smart version of C</[a-zA-Z]/>?
+
+=item * How can I quote a variable to use in a regexp?
+
+=item * What is C</o> really for?
+
+=item * How do I use a regular expression to strip C style comments from a file?
+
+=item * Can I use Perl regular expressions to match balanced text?
+
+=item * What does it mean that regexps are greedy? How can I get around it?
+
+=item * How do I process each word on each line?
+
+=item * How can I print out a word-frequency or line-frequency summary?
+
+=item * How can I do approximate matching?
+
+=item * How do I efficiently match many regular expressions at once?
+
+=item * Why don't word-boundary searches with C<\b> work for me?
+
+=item * Why does using $&, $`, or $' slow my program down?
+
+=item * What good is C<\G> in a regular expression?
+
+=item * Are Perl regexps DFAs or NFAs? Are they POSIX compliant?
+
+=item * What's wrong with using grep or map in a void context?
+
+=item * How can I match strings with multibyte characters?
+
+=item * How do I match a pattern that is supplied by the user?
+
+=back
+
+
=item L<perlfaq7>: General Perl Language Issues
General Perl language issues that don't clearly fit into any of the
other sections.
+=over 4
+
+=item * Can I get a BNF/yacc/RE for the Perl language?
+
+=item * What are all these $@%* punctuation signs, and how do I know when to use them?
+
+=item * Do I always/never have to quote my strings or use semicolons and commas?
+
+=item * How do I skip some return values?
+
+=item * How do I temporarily block warnings?
+
+=item * What's an extension?
+
+=item * Why do Perl operators have different precedence than C operators?
+
+=item * How do I declare/create a structure?
+
+=item * How do I create a module?
+
+=item * How do I create a class?
+
+=item * How can I tell if a variable is tainted?
+
+=item * What's a closure?
+
+=item * What is variable suicide and how can I prevent it?
+
+=item * How can I pass/return a {Function, FileHandle, Array, Hash, Method, Regexp}?
+
+=item * How do I create a static variable?
+
+=item * What's the difference between dynamic and lexical (static) scoping? Between local() and my()?
+
+=item * How can I access a dynamic variable while a similarly named lexical is in scope?
+
+=item * What's the difference between deep and shallow binding?
+
+=item * Why doesn't "my($foo) = E<lt>FILEE<gt>;" work right?
+
+=item * How do I redefine a builtin function, operator, or method?
+
+=item * What's the difference between calling a function as &foo and foo()?
+
+=item * How do I create a switch or case statement?
+
+=item * How can I catch accesses to undefined variables/functions/methods?
+
+=item * Why can't a method included in this same file be found?
+
+=item * How can I find out my current package?
+
+=item * How can I comment out a large block of perl code?
+
+=item * How do I clear a package?
+
+=back
+
+
=item L<perlfaq8>: System Interaction
Interprocess communication (IPC), control over the user-interface
(keyboard, screen and pointing devices).
+=over 4
+
+=item * How do I find out which operating system I'm running under?
+
+=item * How come exec() doesn't return?
+
+=item * How do I do fancy stuff with the keyboard/screen/mouse?
+
+=item * How do I print something out in color?
+
+=item * How do I read just one key without waiting for a return key?
+
+=item * How do I check whether input is ready on the keyboard?
+
+=item * How do I clear the screen?
+
+=item * How do I get the screen size?
+
+=item * How do I ask the user for a password?
+
+=item * How do I read and write the serial port?
+
+=item * How do I decode encrypted password files?
+
+=item * How do I start a process in the background?
+
+=item * How do I trap control characters/signals?
+
+=item * How do I modify the shadow password file on a Unix system?
+
+=item * How do I set the time and date?
+
+=item * How can I sleep() or alarm() for under a second?
+
+=item * How can I measure time under a second?
+
+=item * How can I do an atexit() or setjmp()/longjmp()? (Exception handling)
+
+=item * Why doesn't my sockets program work under System V (Solaris)? What does the error message "Protocol not supported" mean?
+
+=item * How can I call my system's unique C functions from Perl?
+
+=item * Where do I get the include files to do ioctl() or syscall()?
+
+=item * Why do setuid perl scripts complain about kernel problems?
+
+=item * How can I open a pipe both to and from a command?
+
+=item * Why can't I get the output of a command with system()?
+
+=item * How can I capture STDERR from an external command?
+
+=item * Why doesn't open() return an error when a pipe open fails?
+
+=item * What's wrong with using backticks in a void context?
+
+=item * How can I call backticks without shell processing?
+
+=item * Why can't my script read from STDIN after I gave it EOF (^D on Unix, ^Z on MS-DOS)?
+
+=item * How can I convert my shell script to perl?
+
+=item * Can I use perl to run a telnet or ftp session?
+
+=item * How can I write expect in Perl?
+
+=item * Is there a way to hide perl's command line from programs such as "ps"?
+
+=item * I {changed directory, modified my environment} in a perl script. How come the change disappeared when I exited the script? How do I get my changes to be visible?
+
+=item * How do I close a process's filehandle without waiting for it to complete?
+
+=item * How do I fork a daemon process?
+
+=item * How do I make my program run with sh and csh?
+
+=item * How do I find out if I'm running interactively or not?
+
+=item * How do I timeout a slow event?
+
+=item * How do I set CPU limits?
+
+=item * How do I avoid zombies on a Unix system?
+
+=item * How do I use an SQL database?
+
+=item * How do I make a system() exit on control-C?
+
+=item * How do I open a file without blocking?
+
+=item * How do I install a CPAN module?
+
+=item * What's the difference between require and use?
+
+=item * How do I keep my own module/library directory?
+
+=item * How do I add the directory my program lives in to the module/library search path?
+
+=item * How do I add a directory to my include path at runtime?
+
+=item * What is socket.ph and where do I get it?
+
+=back
+
+
=item L<perlfaq9>: Networking
Networking, the Internet, and a few on the web.
+=over 4
+
+=item * My CGI script runs from the command line but not the browser. (500 Server Error)
+
+=item * How can I get better error messages from a CGI program?
+
+=item * How do I remove HTML from a string?
+
+=item * How do I extract URLs?
+
+=item * How do I download a file from the user's machine? How do I open a file on another machine?
+
+=item * How do I make a pop-up menu in HTML?
+
+=item * How do I fetch an HTML file?
+
+=item * How do I automate an HTML form submission?
+
+=item * How do I decode or create those %-encodings on the web?
+
+=item * How do I redirect to another page?
+
+=item * How do I put a password on my web pages?
+
+=item * How do I edit my .htpasswd and .htgroup files with Perl?
+
+=item * How do I make sure users can't enter values into a form that cause my CGI script to do bad things?
+
+=item * How do I parse a mail header?
+
+=item * How do I decode a CGI form?
+
+=item * How do I check a valid mail address?
+
+=item * How do I decode a MIME/BASE64 string?
+
+=item * How do I return the user's mail address?
+
+=item * How do I send mail?
+
+=item * How do I read mail?
+
+=item * How do I find out my hostname/domainname/IP address?
+
+=item * How do I fetch a news article or the active newsgroups?
+
+=item * How do I fetch/put an FTP file?
+
+=item * How can I do RPC in Perl?
+
+=back
+
+
=back
=head2 Where to get this document
@@ -64,8 +704,9 @@ at http://www.perl.com/perl/faq/ .
=head2 How to contribute to this document
You may mail corrections, additions, and suggestions to
-perlfaq-suggestions@perl.com . Mail sent to the old perlfaq alias
-will merely cause the FAQ to be sent to you.
+perlfaq-suggestions@perl.com . This alias should not be
+used to I<ask> FAQs. It's for fixing the current FAQ.
+Send questions to the comp.lang.perl.misc newsgroup.
=head2 What will happen if you mail your Perl programming problems to the authors
@@ -88,30 +729,23 @@ Perl Porters.
=head1 Author and Copyright Information
-Copyright (c) 1997 Tom Christiansen and Nathan Torkington.
+Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
All rights reserved.
-=head2 Noncommercial Reproduction
-
-Permission is granted to distribute this document, in part or in full,
-via electronic means or printed copy providing that (1) that all credits
-and copyright notices be retained, (2) that no charges beyond reproduction
-be involved, and (3) that a reasonable attempt be made to use the most
-current version available.
-
-Furthermore, you may include this document in any distribution of the
-full Perl source or binaries, in its verbatim documentation, or on a
-complete dump of the CPAN archive, providing that the three stipulations
-given above continue to be met.
+=head2 Bundled Distributions
-=head2 Commercial Reproduction
+When included as part of the Standard Version of Perl, or as part of
+its complete documentation whether printed or otherwise, this work
+may be distributed only under the terms of Perl's Artistic License.
+Any distribution of this file or derivatives thereof I<outside>
+of that package require that special arrangements be made with
+copyright holder.
-Requests for all other distribution rights, including the incorporation
-in part or in full of this text or its code into commercial products
-such as but not limited to books, magazine articles, or CD-ROMs, must
-be made to perlfaq-legal@perl.com. Any commercial use of any portion
-of this document without prior written authorization by its authors
-will be subject to appropriate action.
+Irrespective of its distribution, all code examples in these files
+are hereby placed into the public domain. You are permitted and
+encouraged to use this code in your own programs for fun
+or for profit as you see fit. A simple comment in the code giving
+credit would be courteous but is not required.
=head2 Disclaimer
@@ -124,6 +758,16 @@ in respect of this information or its use.
=over 4
+=item 7/January/99
+
+Small touchups here and there. Added all questions in this
+document as a sort of table of contents.
+
+=item 22/June/98
+
+Significant changes throughout in preparation for the 5.005
+release.
+
=item 24/April/97
Style and whitespace changes from Chip, new question on reading one
@@ -141,7 +785,7 @@ and added mass commenting to L<perlfaq7>. Added Net::Telnet, fixed
backticks, added reader/writer pair to telnet question, added FindBin,
grouped module questions together in L<perlfaq8>. Expanded caveats
for the simple URL extractor, gave LWP example, added CGI security
-question, expanded on the email address answer in L<perlfaq9>.
+question, expanded on the mail address answer in L<perlfaq9>.
=item 25/March/97
@@ -172,3 +816,4 @@ This is the initial release of version 3 of the FAQ; consequently there
have been no changes since its initial release.
=back
+
diff --git a/gnu/usr.bin/perl/pod/perlfaq1.pod b/gnu/usr.bin/perl/pod/perlfaq1.pod
index a9a5fd48586..d4cac42a9ac 100644
--- a/gnu/usr.bin/perl/pod/perlfaq1.pod
+++ b/gnu/usr.bin/perl/pod/perlfaq1.pod
@@ -1,6 +1,6 @@
=head1 NAME
-perlfaq1 - General Questions About Perl ($Revision: 1.12 $, $Date: 1997/04/24 22:43:34 $)
+perlfaq1 - General Questions About Perl ($Revision: 1.20 $, $Date: 1999/01/08 04:22:09 $)
=head1 DESCRIPTION
@@ -29,14 +29,17 @@ distribution policy of perl. Perl is supported by its users. The
core, the standard Perl library, the optional modules, and the
documentation you're reading now were all written by volunteers. See
the personal note at the end of the README file in the perl source
-distribution for more details.
-
-In particular, the core development team (known as the Perl
-Porters) are a rag-tag band of highly altruistic individuals
-committed to producing better software for free than you
-could hope to purchase for money. You may snoop on pending
-developments via news://genetics.upenn.edu/perl.porters-gw/ and
-http://www.frii.com/~gnat/perl/porters/summary.html.
+distribution for more details. See L<perlhist> (new as of 5.005)
+for Perl's milestone releases.
+
+In particular, the core development team (known as the Perl Porters)
+are a rag-tag band of highly altruistic individuals committed
+to producing better software for free than you could hope to
+purchase for money. You may snoop on pending developments via
+nntp://news.perl.com/perl.porters-gw/ and the Deja News archive at
+http://www.dejanews.com/ using the perl.porters-gw newsgroup, or you can
+subscribe to the mailing list by sending perl5-porters-request@perl.org
+a subscription request.
While the GNU project includes Perl in its distributions, there's no
such thing as "GNU Perl". Perl is not produced nor maintained by the
@@ -50,12 +53,16 @@ users the informal support will more than suffice. See the answer to
=head2 Which version of Perl should I use?
You should definitely use version 5. Version 4 is old, limited, and
-no longer maintained; its last patch (4.036) was in 1992. The most
-recent production release is 5.004. Further references to the Perl
-language in this document refer to this production release unless
-otherwise specified. There may be one or more official bug fixes for
-5.004 by the time you read this, and also perhaps some experimental
-versions on the way to the next release.
+no longer maintained; its last patch (4.036) was in 1992, long ago and
+far away. Sure, it's stable, but so is anything that's dead; in fact,
+perl4 had been called a dead, flea-bitten camel carcass. The most recent
+production release is 5.005_02 (although 5.004_04 is still supported).
+The most cutting-edge development release is 5.005_54. Further references
+to the Perl language in this document refer to the production release
+unless otherwise specified. There may be one or more official bug
+fixes for 5.005_02 by the time you read this, and also perhaps some
+experimental versions on the way to the next release. All releases
+prior to 5.004 were subject to buffer overruns, a grave security issue.
=head2 What are perl4 and perl5?
@@ -67,16 +74,40 @@ Perl5 is merely the popular name for the fifth major release (October 1994),
while perl4 was the fourth major release (March 1991). There was also a
perl1 (in January 1988), a perl2 (June 1988), and a perl3 (October 1989).
-The 5.0 release is, essentially, a complete rewrite of the perl source
-code from the ground up. It has been modularized, object-oriented,
-tweaked, trimmed, and optimized until it almost doesn't look like the
-old code. However, the interface is mostly the same, and compatibility
-with previous releases is very high.
+The 5.0 release is, essentially, a ground-up rewrite of the original
+perl source code from releases 1 through 4. It has been modularized,
+object-oriented, tweaked, trimmed, and optimized until it almost doesn't
+look like the old code. However, the interface is mostly the same, and
+compatibility with previous releases is very high. See L<perltrap/"Perl4
+to Perl5 Traps">.
To avoid the "what language is perl5?" confusion, some people prefer to
simply use "perl" to refer to the latest version of perl and avoid using
"perl5" altogether. It's not really that big a deal, though.
+See L<perlhist> for a history of Perl revisions.
+
+=head2 What is perl6?
+
+Perl6 is a semi-jocular reference to the Topaz project. Headed by Chip
+Salzenberg, Topaz is yet-another ground-up rewrite of the current release
+of Perl, one whose major goal is to create a more maintainable core than
+found in release 5. Written in nominally portable C++, Topaz hopes to
+maintain 100% source-compatibility with previous releases of Perl but to
+run significantly faster and smaller. The Topaz team hopes to provide
+an XS compatibility interface to allow most XS modules to work unchanged,
+albeit perhaps without the efficiency that the new interface uowld allow.
+New features in Topaz are as yet undetermined, and will be addressed
+once compatibility and performance goals are met.
+
+If you are a hard-working C++ wizard with a firm command of Perl's
+internals, and you would like to work on the project, send a request to
+perl6-porters-request@perl.org to subscribe to the Topaz mailing list.
+
+There is no ETA for Topaz. It is expected to be several years before it
+achieves enough robustness, compatibility, portability, and performance
+to replace perl5 for ordinary use by mere mortals.
+
=head2 How stable is Perl?
Production releases, which incorporate bug fixes and new functionality,
@@ -92,10 +123,10 @@ and the rare new keyword).
=head2 Is Perl difficult to learn?
-Perl is easy to start learning -- and easy to keep learning. It looks
-like most programming languages you're likely to have had experience
+No, Perl is easy to start learning -- and easy to keep learning. It looks
+like most programming languages you're likely to have experience
with, so if you've ever written an C program, an awk script, a shell
-script, or even an Excel macro, you're already part way there.
+script, or even BASIC program, you're already part way there.
Most tasks only require a small subset of the Perl language. One of
the guiding mottos for Perl development is "there's more than one way
@@ -103,18 +134,18 @@ to do it" (TMTOWTDI, sometimes pronounced "tim toady"). Perl's
learning curve is therefore shallow (easy to learn) and long (there's
a whole lot you can do if you really want).
-Finally, Perl is (frequently) an interpreted language. This means
-that you can write your programs and test them without an intermediate
-compilation step, allowing you to experiment and test/debug quickly
-and easily. This ease of experimentation flattens the learning curve
-even more.
+Finally, because Perl is frequently (but not always, and certainly not by
+definition) an interpreted language, you can write your programs and test
+them without an intermediate compilation step, allowing you to experiment
+and test/debug quickly and easily. This ease of experimentation flattens
+the learning curve even more.
Things that make Perl easier to learn: Unix experience, almost any kind
of programming experience, an understanding of regular expressions, and
the ability to understand other people's code. If there's something you
need to do, then it's probably already been done, and a working example is
usually available for free. Don't forget the new perl modules, either.
-They're discussed in Part 3 of this FAQ, along with the CPAN, which is
+They're discussed in Part 3 of this FAQ, along with CPAN, which is
discussed in Part 2.
=head2 How does Perl compare with other languages like Java, Python, REXX, Scheme, or Tcl?
@@ -127,22 +158,25 @@ Probably the best thing to do is try to write equivalent code to do a
set of tasks. These languages have their own newsgroups in which you
can learn about (but hopefully not argue about) them.
+Some comparison documents can be found at http://language.perl.com/versus/
+if you really can't stop yourself.
+
=head2 Can I do [task] in Perl?
-Perl is flexible and extensible enough for you to use on almost any
-task, from one-line file-processing tasks to complex systems. For
-many people, Perl serves as a great replacement for shell scripting.
-For others, it serves as a convenient, high-level replacement for most
-of what they'd program in low-level languages like C or C++. It's
-ultimately up to you (and possibly your management ...) which tasks
-you'll use Perl for and which you won't.
+Perl is flexible and extensible enough for you to use on virtually any
+task, from one-line file-processing tasks to large, elaborate systems.
+For many people, Perl serves as a great replacement for shell scripting.
+For others, it serves as a convenient, high-level replacement for most of
+what they'd program in low-level languages like C or C++. It's ultimately
+up to you (and possibly your management) which tasks you'll use Perl
+for and which you won't.
If you have a library that provides an API, you can make any component
of it available as just another Perl function or variable using a Perl
extension written in C or C++ and dynamically linked into your main
perl interpreter. You can also go the other direction, and write your
main program in C or C++, and then link in some Perl code on the fly,
-to create a powerful application.
+to create a powerful application. See L<perlembed>.
That said, there will always be small, focused, special-purpose
languages dedicated to a specific problem domain that are simply more
@@ -161,17 +195,16 @@ certain task (e.g. prolog, make).
For various reasons, Perl is probably not well-suited for real-time
embedded systems, low-level operating systems development work like
-device drivers or context-switching code, complex multithreaded
+device drivers or context-switching code, complex multi-threaded
shared-memory applications, or extremely large applications. You'll
notice that perl is not itself written in Perl.
-The new native-code compiler for Perl may reduce the limitations given
-in the previous statement to some degree, but understand that Perl
-remains fundamentally a dynamically typed language, and not a
-statically typed one. You certainly won't be chastized if you don't
-trust nuclear-plant or brain-surgery monitoring code to it. And
-Larry will sleep easier, too -- Wall Street programs not
-withstanding. :-)
+The new, native-code compiler for Perl may eventually reduce the
+limitations given in the previous statement to some degree, but understand
+that Perl remains fundamentally a dynamically typed language, not
+a statically typed one. You certainly won't be chastised if you don't
+trust nuclear-plant or brain-surgery monitoring code to it. And Larry
+will sleep easier, too -- Wall Street programs not withstanding. :-)
=head2 What's the difference between "perl" and "Perl"?
@@ -180,35 +213,60 @@ signify the language proper and "perl" the implementation of it,
i.e. the current interpreter. Hence Tom's quip that "Nothing but perl
can parse Perl." You may or may not choose to follow this usage. For
example, parallelism means "awk and perl" and "Python and Perl" look
-ok, while "awk and Perl" and "Python and perl" do not.
+ok, while "awk and Perl" and "Python and perl" do not. But never
+write "PERL", because perl isn't really an acronym, aprocryphal
+folklore and post-facto expansions notwithstanding.
=head2 Is it a Perl program or a Perl script?
-It doesn't matter.
-
-In "standard terminology" a I<program> has been compiled to physical
-machine code once, and can then be be run multiple times, whereas a
-I<script> must be translated by a program each time it's used. Perl
-programs, however, are usually neither strictly compiled nor strictly
-interpreted. They can be compiled to a byte code form (something of a
+Larry doesn't really care. He says (half in jest) that "a script is
+what you give the actors. A program is what you give the audience."
+
+Originally, a script was a canned sequence of normally interactive
+commands, that is, a chat script. Something like a uucp or ppp chat
+script or an expect script fits the bill nicely, as do configuration
+scripts run by a program at its start up, such F<.cshrc> or F<.ircrc>,
+for example. Chat scripts were just drivers for existing programs,
+not stand-alone programs in their own right.
+
+A computer scientist will correctly explain that all programs are
+interpreted, and that the only question is at what level. But if you
+ask this question of someone who isn't a computer scientist, they might
+tell you that a I<program> has been compiled to physical machine code
+once, and can then be run multiple times, whereas a I<script> must be
+translated by a program each time it's used.
+
+Perl programs are (usually) neither strictly compiled nor strictly
+interpreted. They can be compiled to a byte-code form (something of a
Perl virtual machine) or to completely different languages, like C or
-assembly language. You can't tell just by looking whether the source
-is destined for a pure interpreter, a parse-tree interpreter, a byte
-code interpreter, or a native-code compiler, so it's hard to give a
-definitive answer here.
+assembly language. You can't tell just by looking at it whether the
+source is destined for a pure interpreter, a parse-tree interpreter,
+a byte-code interpreter, or a native-code compiler, so it's hard to give
+a definitive answer here.
+
+Now that "script" and "scripting" are terms that have been seized by
+unscrupulous or unknowing marketeers for their own nefarious purposes,
+they have begun to take on strange and often pejorative meanings,
+like "non serious" or "not real programming". Consequently, some perl
+programmers prefer to avoid them altogether.
=head2 What is a JAPH?
These are the "just another perl hacker" signatures that some people
-sign their postings with. About 100 of the of the earlier ones are
-available from http://www.perl.com/CPAN/misc/japh .
+sign their postings with. Randal Schwartz made these famous. About
+100 of the earlier ones are available from
+http://www.perl.com/CPAN/misc/japh .
=head2 Where can I get a list of Larry Wall witticisms?
Over a hundred quips by Larry, from postings of his or source code,
-can be found at http://www.perl.com/CPAN/misc/lwall-quotes .
+can be found at http://www.perl.com/CPAN/misc/lwall-quotes.txt.gz .
+
+Newer examples can be found by perusing Larry's postings:
-=head2 How can I convince my sysadmin/supervisor/employees to use version (5/5.004/Perl instead of some other language)?
+ http://x1.dejanews.com/dnquery.xp?QRY=*&DBS=2&ST=PS&defaultOp=AND&LNG=ALL&format=terse&showsort=date&maxhits=100&subjects=&groups=&authors=larry@*wall.org&fromdate=&todate=
+
+=head2 How can I convince my sysadmin/supervisor/employees to use version (5/5.005/Perl instead of some other language)?
If your manager or employees are wary of unsupported software, or
software which doesn't officially ship with your Operating System, you
@@ -220,7 +278,7 @@ sometimes helpful to point out that delivery times may be reduced
using Perl, as compared to other languages.
If you have a project which has a bottleneck, especially in terms of
-translation, or testing, Perl almost certainly will provide a viable,
+translation or testing, Perl almost certainly will provide a viable,
and quick solution. In conjunction with any persuasion effort, you
should not fail to point out that Perl is used, quite extensively, and
with extremely reliable and valuable results, at many large computer
@@ -229,21 +287,39 @@ many Unix vendors now ship Perl by default, and support is usually
just a news-posting away, if you can't find the answer in the
I<comprehensive> documentation, including this FAQ.
+See http://www.perl.org/advocacy/ for more information.
+
If you face reluctance to upgrading from an older version of perl,
then point out that version 4 is utterly unmaintained and unsupported
by the Perl Development Team. Another big sell for Perl5 is the large
number of modules and extensions which greatly reduce development time
for any given task. Also mention that the difference between version
4 and version 5 of Perl is like the difference between awk and C++.
-(Well, ok, maybe not quite that distinct, but you get the idea.) If
-you want support and a reasonable guarantee that what you're
-developing will continue to work in the future, then you have to run
-the supported version. That probably means running the 5.004 release,
-although 5.003 isn't that bad (it's just one year and one release
-behind). Several important bugs were fixed from the 5.000 through
-5.002 versions, though, so try upgrading past them if possible.
+(Well, ok, maybe not quite that distinct, but you get the idea.) If you
+want support and a reasonable guarantee that what you're developing
+will continue to work in the future, then you have to run the supported
+version. That probably means running the 5.005 release, although 5.004
+isn't that bad. Several important bugs were fixed from the 5.000 through
+5.003 versions, though, so try upgrading past them if possible.
+
+Of particular note is the massive bughunt for buffer overflow
+problems that went into the 5.004 release. All releases prior to
+that, including perl4, are considered insecure and should be upgraded
+as soon as possible.
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997 Tom Christiansen and Nathan Torkington.
-All rights reserved. See L<perlfaq> for distribution information.
+Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
+All rights reserved.
+
+When included as an integrated part of the Standard Distribution
+of Perl or of its documentation (printed or otherwise), this work is
+covered under Perl's Artistic Licence. For separate distributions of
+all or part of this FAQ outside of that, see L<perlfaq>.
+
+Irrespective of its distribution, all code examples here are public
+domain. You are permitted and encouraged to use this code and any
+derivatives thereof in your own programs for fun or for profit as you
+see fit. A simple comment in the code giving credit to the FAQ would
+be courteous but is not required.
+
diff --git a/gnu/usr.bin/perl/pod/perlfaq2.pod b/gnu/usr.bin/perl/pod/perlfaq2.pod
index 8a954da64e4..32970af58a3 100644
--- a/gnu/usr.bin/perl/pod/perlfaq2.pod
+++ b/gnu/usr.bin/perl/pod/perlfaq2.pod
@@ -1,49 +1,53 @@
=head1 NAME
-perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.16 $, $Date: 1997/04/23 18:04:09 $)
+perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.30 $, $Date: 1998/12/29 19:43:32 $)
=head1 DESCRIPTION
This section of the FAQ answers questions about where to find
-source and documentation for Perl, support and training, and
+source and documentation for Perl, support, and
related matters.
=head2 What machines support Perl? Where do I get it?
The standard release of Perl (the one maintained by the perl
-development team) is distributed only in source code form. You can
-find this at http://www.perl.com/CPAN/src/latest.tar.gz, which is a
-gzipped archive in POSIX tar format. This source builds with no
-porting whatsoever on most Unix systems (Perl's native environment),
-as well as Plan 9, VMS, QNX, OS/2, and the Amiga.
-
-Although it's rumored that the (imminent) 5.004 release may build
-on Windows NT, this is yet to be proven. Binary distributions
-for 32-bit Microsoft systems and for Apple systems can be found
-http://www.perl.com/CPAN/ports/ directory. Because these are not part of
-the standard distribution, they may and in fact do differ from the base
-Perl port in a variety of ways. You'll have to check their respective
-release notes to see just what the differences are. These differences
-can be either positive (e.g. extensions for the features of the particular
-platform that are not supported in the source release of perl) or negative
-(e.g. might be based upon a less current source release of perl).
-
-A useful FAQ for Win32 Perl users is
-http://www.endcontsw.com/people/evangelo/Perl_for_Win32_FAQ.html
+development team) is distributed only in source code form. You
+can find this at http://www.perl.com/CPAN/src/latest.tar.gz , which
+in standard Internet format (a gzipped archive in POSIX tar format).
+
+Perl builds and runs on a bewildering number of platforms. Virtually
+all known and current Unix derivatives are supported (Perl's native
+platform), as are proprietary systems like VMS, DOS, OS/2, Windows,
+QNX, BeOS, and the Amiga. There are also the beginnings of support
+for MPE/iX.
+
+Binary distributions for some proprietary platforms, including
+Apple systems, can be found http://www.perl.com/CPAN/ports/ directory.
+Because these are not part of the standard distribution, they may
+and in fact do differ from the base Perl port in a variety of ways.
+You'll have to check their respective release notes to see just
+what the differences are. These differences can be either positive
+(e.g. extensions for the features of the particular platform that
+are not supported in the source release of perl) or negative (e.g.
+might be based upon a less current source release of perl).
=head2 How can I get a binary version of Perl?
-If you don't have a C compiler because for whatever reasons your
-vendor did not include one with your system, the best thing to do is
+If you don't have a C compiler because your vendor for whatever
+reasons did not include one with your system, the best thing to do is
grab a binary version of gcc from the net and use that to compile perl
with. CPAN only has binaries for systems that are terribly hard to
get free compilers for, not for Unix systems.
-Your first stop should be http://www.perl.com/CPAN/ports to see what
-information is already available. A simple installation guide for
-MS-DOS is available at http://www.cs.ruu.nl/~piet/perl5dos.html , and
-similarly for Windows 3.1 at http://www.cs.ruu.nl/~piet/perlwin3.html
-.
+Some URLs that might help you are:
+
+ http://language.perl.com/info/software.html
+ http://www.perl.com/latest/
+ http://www.perl.com/CPAN/ports/
+
+If you want information on proprietary systems. A simple installation
+guide for MS-DOS is available at http://www.cs.ruu.nl/~piet/perl5dos.html
+and similarly for Windows 3.1 at http://www.cs.ruu.nl/~piet/perlwin3.html .
=head2 I don't have a C compiler on my system. How can I compile perl?
@@ -64,11 +68,14 @@ approaches are doomed to failure.
One simple way to check that things are in the right place is to print out
the hard-coded @INC which perl is looking for.
- perl -e 'print join("\n",@INC)'
+ % perl -e 'print join("\n",@INC)'
If this command lists any paths which don't exist on your system, then you
may need to move the appropriate libraries to these locations, or create
-symlinks, aliases, or shortcuts appropriately.
+symlinks, aliases, or shortcuts appropriately. @INC is also printed as
+part of the output of
+
+ % perl -V
You might also want to check out L<perlfaq8/"How do I keep my own
module/library directory?">.
@@ -76,7 +83,7 @@ module/library directory?">.
=head2 I grabbed the sources and tried to compile but gdbm/dynamic loading/malloc/linking/... failed. How do I make it work?
Read the F<INSTALL> file, which is part of the source distribution.
-It describes in detail how to cope with most idiosyncracies that the
+It describes in detail how to cope with most idiosyncrasies that the
Configure script can't work around for any given system or
architecture.
@@ -118,13 +125,13 @@ Certainly not. Larry expects that he'll be certified before Perl is.
=head2 Where can I get information on Perl?
-The complete Perl documentation is available with the perl
-distribution. If you have perl installed locally, you probably have
-the documentation installed as well: type C<man perl> if you're on a
-system resembling Unix. This will lead you to other important man
-pages. If you're not on a Unix system, access to the documentation
-will be different; for example, it might be only in HTML format. But
-all proper perl installations have fully-accessible documentation.
+The complete Perl documentation is available with the perl distribution.
+If you have perl installed locally, you probably have the documentation
+installed as well: type C<man perl> if you're on a system resembling Unix.
+This will lead you to other important man pages, including how to set your
+$MANPATH. If you're not on a Unix system, access to the documentation
+will be different; for example, it might be only in HTML format. But all
+proper perl installations have fully-accessible documentation.
You might also try C<perldoc perl> in case your system doesn't
have a proper man command, or it's been misinstalled. If that doesn't
@@ -135,13 +142,19 @@ complete documentation in various formats, including native pod,
troff, html, and plain text. There's also a web page at
http://www.perl.com/perl/info/documentation.html that might help.
-It's also worth noting that there's a PDF version of the complete
-documentation for perl available in the CPAN/authors/id/BMIDD
-directory.
-
Many good books have been written about Perl -- see the section below
for more details.
+Tutorial documents are included in current or upcoming Perl releases
+include L<perltoot> for objects, L<perlopentut> for file opening
+semantics, L<perlreftut> for managing references, and L<perlxstut>
+for linking C and Perl together. There may be more by the
+time you read this. The following URLs might also be of
+assistance:
+
+ http://language.perl.com/info/documentation.html
+ http://reference.perl.com/query.cgi?tutorials
+
=head2 What are the Perl newsgroups on USENET? Where do I post questions?
The now defunct comp.lang.perl newsgroup has been superseded by the
@@ -149,6 +162,7 @@ following groups:
comp.lang.perl.announce Moderated announcement group
comp.lang.perl.misc Very busy group about Perl in general
+ comp.lang.perl.moderated Moderated discussion group
comp.lang.perl.modules Use and development of Perl modules
comp.lang.perl.tk Using Tk (and X) from Perl
@@ -156,180 +170,183 @@ following groups:
There is also USENET gateway to the mailing list used by the crack
Perl development team (perl5-porters) at
-news://genetics.upenn.edu/perl.porters-gw/ .
+news://news.perl.com/perl.porters-gw/ .
=head2 Where should I post source code?
-You should post source code to whichever group is most appropriate,
-but feel free to cross-post to comp.lang.perl.misc. If you want to
-cross-post to alt.sources, please make sure it follows their posting
-standards, including setting the Followup-To header line to NOT
-include alt.sources; see their FAQ for details.
+You should post source code to whichever group is most appropriate, but
+feel free to cross-post to comp.lang.perl.misc. If you want to cross-post
+to alt.sources, please make sure it follows their posting standards,
+including setting the Followup-To header line to NOT include alt.sources;
+see their FAQ (http://www.faqs.org/faqs/alt-sources-intro/) for details.
+
+If you're just looking for software, first use Alta Vista, Deja News, and
+search CPAN. This is faster and more productive than just posting
+a request.
=head2 Perl Books
-A number books on Perl and/or CGI programming are available. A few of
+A number of books on Perl and/or CGI programming are available. A few of
these are good, some are ok, but many aren't worth your money. Tom
Christiansen maintains a list of these books, some with extensive
reviews, at http://www.perl.com/perl/critiques/index.html.
-The incontestably definitive reference book on Perl, written by the
-creator of Perl and his apostles, is now in its second edition and
-fourth printing.
+The incontestably definitive reference book on Perl, written by
+the creator of Perl, is now in its second edition:
Programming Perl (the "Camel Book"):
- Authors: Larry Wall, Tom Christiansen, and Randal Schwartz
+ by Larry Wall, Tom Christiansen, and Randal Schwartz
ISBN 1-56592-149-6 (English)
ISBN 4-89052-384-7 (Japanese)
- (French and German translations in progress)
+ URL: http://www.oreilly.com/catalog/pperl2/
+ (French, German, Italian, and Hungarian translations also
+ available)
+
+The companion volume to the Camel containing thousands
+of real-world examples, mini-tutorials, and complete programs
+(first premiering at the 1998 Perl Conference), is:
+
+ The Perl Cookbook (the "Ram Book"):
+ by Tom Christiansen and Nathan Torkington,
+ with Foreword by Larry Wall
+ ISBN: 1-56592-243-3
+ URL: http://perl.oreilly.com/cookbook/
-Note that O'Reilly books are color-coded: turquoise (some would call
-it teal) covers indicate perl5 coverage, while magenta (some would
-call it pink) covers indicate perl4 only. Check the cover color
-before you buy!
+If you're already a hard-core systems programmer, then the Camel Book
+might suffice for you to learn Perl from. But if you're not, check
+out:
+
+ Learning Perl (the "Llama Book"):
+ by Randal Schwartz and Tom Christiansen
+ with Foreword by Larry Wall
+ ISBN: 1-56592-284-0
+ URL: http://www.oreilly.com/catalog/lperl2/
+
+Despite the picture at the URL above, the second edition of "Llama
+Book" really has a blue cover, and is updated for the 5.004 release
+of Perl. Various foreign language editions are available, including
+I<Learning Perl on Win32 Systems> (the Gecko Book).
+
+If you're not an accidental programmer, but a more serious and possibly
+even degreed computer scientist who doesn't need as much hand-holding as
+we try to provide in the Llama or its defurred cousin the Gecko, please
+check out the delightful book, I<Perl: The Programmer's Companion>,
+written by Nigel Chapman.
+
+You can order O'Reilly books directly from O'Reilly & Associates,
+1-800-998-9938. Local/overseas is 1-707-829-0515. If you can
+locate an O'Reilly order form, you can also fax to 1-707-829-0104.
+See http://www.ora.com/ on the Web.
What follows is a list of the books that the FAQ authors found personally
useful. Your mileage may (but, we hope, probably won't) vary.
-If you're already a hard-core systems programmer, then the Camel Book
-just might suffice for you to learn Perl from. But if you're not,
-check out the "Llama Book". It currently doesn't cover perl5, but the
-2nd edition is nearly done and should be out by summer 97:
+Recommended books on (or mostly on) Perl follow; those marked with
+a star may be ordered from O'Reilly.
- Learning Perl (the Llama Book):
- Author: Randal Schwartz, with intro by Larry Wall
- ISBN 1-56592-042-2 (English)
- ISBN 4-89502-678-1 (Japanese)
- ISBN 2-84177-005-2 (French)
- ISBN 3-930673-08-8 (German)
+=over
-Another stand-out book in the turquoise O'Reilly Perl line is the "Hip
-Owls" book. It covers regular expressions inside and out, with quite a
-bit devoted exclusively to Perl:
+=item References
- Mastering Regular Expressions (the Cute Owls Book):
- Author: Jeffrey Friedl
- ISBN 1-56592-257-3
+ *Programming Perl
+ by Larry Wall, Tom Christiansen, and Randal L. Schwartz
-You can order any of these books from O'Reilly & Associates,
-1-800-998-9938. Local/overseas is 1-707-829-0515. If you can locate
-an O'Reilly order form, you can also fax to 1-707-829-0104. See
-http://www.ora.com/ on the Web.
+ *Perl 5 Desktop Reference
+ By Johan Vromans
-Recommended Perl books that are not from O'Reilly are the following:
+=item Tutorials
+
+ *Learning Perl [2nd edition]
+ by Randal L. Schwartz and Tom Christiansen
+ with foreword by Larry Wall
- Cross-Platform Perl, (for Unix and Windows NT)
- Author: Eric F. Johnson
- ISBN: 1-55851-483-X
+ *Learning Perl on Win32 Systems
+ by Randal L. Schwartz, Erik Olson, and Tom Christiansen,
+ with foreword by Larry Wall
- How to Set up and Maintain a World Wide Web Site, (2nd edition)
- Author: Lincoln Stein, M.D., Ph.D.
- ISBN: 0-201-63462-7
+ Perl: The Programmer's Companion
+ by Nigel Chapman
- CGI Programming in C & Perl,
- Author: Thomas Boutell
- ISBN: 0-201-42219-0
+ Cross-Platform Perl
+ by Eric F. Johnson
-Note that some of these address specific application areas (e.g. the
-Web) and are not general-purpose programming books.
+ MacPerl: Power and Ease
+ by Vicki Brown and Chris Nandor, foreword by Matthias Neeracher
-=head2 Perl in Magazines
+=item Task-Oriented
-The Perl Journal is the first and only magazine dedicated to Perl.
-It is published (on paper, not online) quarterly by Jon Orwant
-(orwant@tpj.com), editor. Subscription information is at http://tpj.com
-or via email to subscriptions@tpj.com.
+ *The Perl Cookbook
+ by Tom Christiansen and Nathan Torkington
+ with foreword by Larry Wall
-Beyond this, two other magazines that frequently carry high-quality
-articles on Perl are Web Techniques (see
-http://www.webtechniques.com/) and Unix Review
-(http://www.unixreview.com/). Randal Schwartz's Web Technique's
-columns are available on the web at
-http://www.stonehenge.com/merlyn/WebTechniques/ .
+ Perl5 Interactive Course [2nd edition]
+ by Jon Orwant
+
+ *Advanced Perl Programming
+ by Sriram Srinivasan
+
+ Effective Perl Programming
+ by Joseph Hall
+
+=item Special Topics
+
+ *Mastering Regular Expressions
+ by Jeffrey Friedl
+
+ How to Set up and Maintain a World Wide Web Site [2nd edition]
+ by Lincoln Stein
+
+=back
+
+=head2 Perl in Magazines
+
+The first and only periodical devoted to All Things Perl, I<The
+Perl Journal> contains tutorials, demonstrations, case studies,
+announcements, contests, and much more. TPJ has columns on web
+development, databases, Win32 Perl, graphical programming, regular
+expressions, and networking, and sponsors the Obfuscated Perl
+Contest. It is published quarterly under the gentle hand of its
+editor, Jon Orwant. See http://www.tpj.com/ or send mail to
+subscriptions@tpj.com .
+
+Beyond this, magazines that frequently carry high-quality articles
+on Perl are I<Web Techniques> (see http://www.webtechniques.com/),
+I<Performance Computing> (http://www.performance-computing.com/), and Usenix's
+newsletter/magazine to its members, I<login:>, at http://www.usenix.org/.
+Randal's Web Technique's columns are available on the web at
+http://www.stonehenge.com/merlyn/WebTechniques/.
=head2 Perl on the Net: FTP and WWW Access
To get the best (and possibly cheapest) performance, pick a site from
the list below and use it to grab the complete list of mirror sites.
-From there you can find the quickest site for you. Remember, the
+>From there you can find the quickest site for you. Remember, the
following list is I<not> the complete list of CPAN mirrors.
- http://www.perl.com/CPAN (redirects to another mirror)
+ http://www.perl.com/CPAN-local
+ http://www.perl.com/CPAN (redirects to an ftp mirror)
http://www.perl.org/CPAN
ftp://ftp.funet.fi/pub/languages/perl/CPAN/
http://www.cs.ruu.nl/pub/PERL/CPAN/
ftp://ftp.cs.colorado.edu/pub/perl/CPAN/
-http:/www.oasis.leo.org/perl/ has, amongst other things, source to
-versions 1 through 5 of Perl.
-
=head2 What mailing lists are there for perl?
Most of the major modules (tk, CGI, libwww-perl) have their own
mailing lists. Consult the documentation that came with the module for
-subscription information. The following are a list of mailing lists
-related to perl itself.
-
-If you subscribe to a mailing list, it behooves you to know how to
-unsubscribe from it. Strident pleas to the list itself to get you off
-will not be favorably received.
+subscription information. The Perl Institute attempts to maintain a
+list of mailing lists at:
-=over 4
+ http://www.perl.org/maillist.html
-=item MacPerl
-
-There is a mailing list for discussing Macintosh Perl. Contact
-"mac-perl-request@iis.ee.ethz.ch".
-
-Also see Matthias Neeracher's (the creator and maintainer of MacPerl)
-webpage at http://www.iis.ee.ethz.ch/~neeri/macintosh/perl.html for
-many links to interesting MacPerl sites, and the applications/MPW
-tools, precompiled.
-
-=item Perl5-Porters
-
-The core development team have a mailing list for discussing fixes and
-changes to the language. Send mail to
-"perl5-porters-request@perl.org" with help in the body of the message
-for information on subscribing.
-
-=item NTPerl
-
-This list is used to discuss issues involving Win32 Perl 5 (Windows NT
-and Win95). Subscribe by emailing ListManager@ActiveWare.com with the
-message body:
-
- subscribe Perl-Win32-Users
-
-The list software, also written in perl, will automatically determine
-your address, and subscribe you automatically. To unsubscribe, email
-the following in the message body to the same address like so:
-
- unsubscribe Perl-Win32-Users
-
-You can also check http://www.activeware.com/ and select "Mailing Lists"
-to join or leave this list.
-
-=item Perl-Packrats
-
-Discussion related to archiving of perl materials, particularly the
-Comprehensive PerlArchive Network (CPAN). Subscribe by emailing
-majordomo@cis.ufl.edu:
-
- subscribe perl-packrats
-
-The list software, also written in perl, will automatically determine
-your address, and subscribe you automatically. To unsubscribe, simple
-prepend the same command with an "un", and mail to the same address
-like so:
-
- unsubscribe perl-packrats
+=head2 Archives of comp.lang.perl.misc
-=back
+Have you tried Deja News or Alta Vista? Those are the
+best archives. Just look up "*perl*" as a newsgroup.
-=head2 Archives of comp.lang.perl.misc
+ http://www.dejanews.com/dnquery.xp?QRY=&DBS=2&ST=PS&defaultOp=AND&LNG=ALL&format=terse&showsort=date&maxhits=25&subjects=&groups=*perl*&authors=&fromdate=&todate=
-Have you tried Deja News or Alta Vista?
+You'll probably want to trim that down a bit, though.
ftp.cis.ufl.edu:/pub/perl/comp.lang.perl.*/monthly has an almost
complete collection dating back to 12/89 (missing 08/91 through
@@ -345,35 +362,26 @@ very slow to select on 18000 articles.
If you have, or know where can be found, the missing sections, please
let perlfaq-suggestions@perl.com know.
-=head2 Perl Training
-
-While some large training companies offer their own courses on Perl,
-you may prefer to contact individuals near and dear to the heart of
-Perl development. Two well-known members of the Perl development team
-who offer such things are Tom Christiansen <perl-classes@perl.com>
-and Randal Schwartz <perl-training-info@stonehenge.com>, plus their
-respective minions, who offer a variety of professional tutorials
-and seminars on Perl. These courses include large public seminars,
-private corporate training, and fly-ins to Colorado and Oregon.
-See http://www.perl.com/perl/info/training.html for more details.
-
=head2 Where can I buy a commercial version of Perl?
-In a sense, Perl already I<is> commercial software: It has a licence
-that you can grab and carefully read to your manager. It is
-distributed in releases and comes in well-defined packages. There is a
-very large user community and an extensive literature. The
-comp.lang.perl.* newsgroups and several of the mailing lists provide
-free answers to your questions in near real-time. Perl has
-traditionally been supported by Larry, dozens of software designers
-and developers, and thousands of programmers, all working for free
-to create a useful thing to make life better for everyone.
+In a real sense, Perl already I<is> commercial software: It has a licence
+that you can grab and carefully read to your manager. It is distributed
+in releases and comes in well-defined packages. There is a very large
+user community and an extensive literature. The comp.lang.perl.*
+newsgroups and several of the mailing lists provide free answers to your
+questions in near real-time. Perl has traditionally been supported by
+Larry, scores of software designers and developers, and myriads of
+programmers, all working for free to create a useful thing to make life
+better for everyone.
However, these answers may not suffice for managers who require a
-purchase order from a company whom they can sue should anything go
-wrong. Or maybe they need very serious hand-holding and contractual
-obligations. Shrink-wrapped CDs with perl on them are available from
-several sources if that will help.
+purchase order from a company whom they can sue should anything go awry.
+Or maybe they need very serious hand-holding and contractual obligations.
+Shrink-wrapped CDs with perl on them are available from several sources if
+that will help. For example, many perl books carry a perl distribution
+on them, as do the O'Reily Perl Resource Kits (in both the Unix flavor
+and in the proprietary Microsoft flavor); the free Unix distributions
+also all come with Perl.
Or you can purchase a real support contract. Although Cygnus historically
provided this service, they no longer sell support contracts for Perl.
@@ -395,18 +403,20 @@ Oraperl and related modules (which Oracle is planning to ship as part
of Oracle Web Server 3). 20% of the profit from our Perl support work
will be donated to The Perl Institute."
-For more information, contact the The Perl Clinic:
+For more information, contact The Perl Clinic:
Tel: +44 1483 424424
Fax: +44 1483 419419
Web: http://www.perl.co.uk/
Email: perl-support-info@perl.co.uk or Tim.Bunce@ig.co.uk
+See also www.perl.com for updates on tutorials, training, and support.
+
=head2 Where do I send bug reports?
If you are reporting a bug in the perl interpreter or the modules
-shipped with perl, use the perlbug program in the perl distribution or
-email your report to perlbug@perl.com.
+shipped with perl, use the I<perlbug> program in the perl distribution or
+mail your report to perlbug@perl.com .
If you are posting a bug with a non-standard port (see the answer to
"What platforms is Perl available for?"), a binary distribution, or a
@@ -414,30 +424,36 @@ non-standard module (such as Tk, CGI, etc), then please see the
documentation that came with it to determine the correct place to post
bugs.
-Read the perlbug man page (perl5.004 or later) for more information.
+Read the perlbug(1) man page (perl5.004 or later) for more information.
-=head2 What is perl.com? perl.org? The Perl Institute?
+=head2 What is perl.com?
-perl.org is the official vehicle for The Perl Institute. The motto of
-TPI is "helping people help Perl help people" (or something like
-that). It's a non-profit organization supporting development,
-documentation, and dissemination of perl. Current directors of TPI
-include Larry Wall, Tom Christiansen, and Randal Schwartz, whom you
-may have heard of somewhere else around here.
+The perl.com domain is owned by Tom Christiansen, who created it as a
+public service long before perl.org came about. Despite the name, it's a
+pretty non-commercial site meant to be a clearinghouse for information
+about all things Perlian, accepting no paid advertisements, bouncy
+happy gifs, or silly java applets on its pages. The Perl Home Page at
+http://www.perl.com/ is currently hosted on a T3 line courtesy of Songline
+Systems, a software-oriented subsidiary of O'Reilly and Associates.
+Other starting points include
-The perl.com domain is Tom Christiansen's domain. He created it as a
-public service long before perl.org came about. It's the original PBS
-of the Perl world, a clearinghouse for information about all things
-Perlian, accepting no paid advertisements, glossy gifs, or (gasp!)
-java applets on its pages.
+ http://language.perl.com/
+ http://conference.perl.com/
+ http://reference.perl.com/
-=head2 How do I learn about object-oriented Perl programming?
+=head1 AUTHOR AND COPYRIGHT
-L<perltoot> (distributed with 5.004 or later) is a good place to start.
-Also, L<perlobj>, L<perlref>, and L<perlmod> are useful references,
-while L<perlbot> has some excellent tips and tricks.
+Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
+All rights reserved.
-=head1 AUTHOR AND COPYRIGHT
+When included as an integrated part of the Standard Distribution
+of Perl or of its documentation (printed or otherwise), this work is
+covered under Perl's Artistic Licence. For separate distributions of
+all or part of this FAQ outside of that, see L<perlfaq>.
+
+Irrespective of its distribution, all code examples here are public
+domain. You are permitted and encouraged to use this code and any
+derivatives thereof in your own programs for fun or for profit as you
+see fit. A simple comment in the code giving credit to the FAQ would
+be courteous but is not required.
-Copyright (c) 1997 Tom Christiansen and Nathan Torkington.
-All rights reserved. See L<perlfaq> for distribution information.
diff --git a/gnu/usr.bin/perl/pod/perlfaq3.pod b/gnu/usr.bin/perl/pod/perlfaq3.pod
index 65ebafdea50..a811c3ce9b9 100644
--- a/gnu/usr.bin/perl/pod/perlfaq3.pod
+++ b/gnu/usr.bin/perl/pod/perlfaq3.pod
@@ -1,6 +1,6 @@
=head1 NAME
-perlfaq3 - Programming Tools ($Revision: 1.22 $, $Date: 1997/04/24 22:43:42 $)
+perlfaq3 - Programming Tools ($Revision: 1.33 $, $Date: 1998/12/29 20:12:12 $)
=head1 DESCRIPTION
@@ -13,10 +13,13 @@ Have you looked at CPAN (see L<perlfaq2>)? The chances are that
someone has already written a module that can solve your problem.
Have you read the appropriate man pages? Here's a brief index:
+ Basics perldata, perlvar, perlsyn, perlop, perlsub
+ Execution perlrun, perldebug
+ Functions perlfunc
Objects perlref, perlmod, perlobj, perltie
Data Structures perlref, perllol, perldsc
Modules perlmod, perlmodlib, perlsub
- Regexps perlre, perlfunc, perlop
+ Regexps perlre, perlfunc, perlop, perllocale
Moving to perl5 perltrap, perl
Linking w/C perlxstut, perlxs, perlcall, perlguts, perlembed
Various http://www.perl.com/CPAN/doc/FMTEYEWTK/index.html
@@ -27,14 +30,14 @@ L<perltoc> provides a crude table of contents for the perl man page set.
=head2 How can I use Perl interactively?
The typical approach uses the Perl debugger, described in the
-perldebug(1) man page, on an "empty" program, like this:
+perldebug(1) man page, on an ``empty'' program, like this:
perl -de 42
Now just type in any legal Perl code, and it will be immediately
evaluated. You can also examine the symbol table, get stack
backtraces, check variable values, set breakpoints, and other
-operations typically found in symbolic debuggers
+operations typically found in symbolic debuggers.
=head2 Is there a Perl shell?
@@ -45,15 +48,27 @@ uninteresting, but may still be what you want.
=head2 How do I debug my Perl programs?
-Have you used C<-w>?
+Have you used C<-w>? It enables warnings for dubious practices.
-Have you tried C<use strict>?
+Have you tried C<use strict>? It prevents you from using symbolic
+references, makes you predeclare any subroutines that you call as bare
+words, and (probably most importantly) forces you to predeclare your
+variables with C<my> or C<use vars>.
-Did you check the returns of each and every system call?
+Did you check the returns of each and every system call? The operating
+system (and thus Perl) tells you whether they worked or not, and if not
+why.
-Did you read L<perltrap>?
+ open(FH, "> /etc/cantwrite")
+ or die "Couldn't write to /etc/cantwrite: $!\n";
-Have you tried the Perl debugger, described in L<perldebug>?
+Did you read L<perltrap>? It's full of gotchas for old and new Perl
+programmers, and even has sections for those of you who are upgrading
+from languages like I<awk> and I<C>.
+
+Have you tried the Perl debugger, described in L<perldebug>? You can
+step through your program and see what it's doing and thus work out
+why what it's doing isn't what it should be doing.
=head2 How do I profile my Perl programs?
@@ -62,47 +77,109 @@ Benchmark.pm from the standard distribution. Benchmark lets you time
specific portions of your code, while Devel::DProf gives detailed
breakdowns of where your code spends its time.
+Here's a sample use of Benchmark:
+
+ use Benchmark;
+
+ @junk = `cat /etc/motd`;
+ $count = 10_000;
+
+ timethese($count, {
+ 'map' => sub { my @a = @junk;
+ map { s/a/b/ } @a;
+ return @a
+ },
+ 'for' => sub { my @a = @junk;
+ local $_;
+ for (@a) { s/a/b/ };
+ return @a },
+ });
+
+This is what it prints (on one machine--your results will be dependent
+on your hardware, operating system, and the load on your machine):
+
+ Benchmark: timing 10000 iterations of for, map...
+ for: 4 secs ( 3.97 usr 0.01 sys = 3.98 cpu)
+ map: 6 secs ( 4.97 usr 0.00 sys = 4.97 cpu)
+
+Be aware that a good benchmark is very hard to write. It only tests the
+data you give it, and really proves little about differing complexities
+of contrasting algorithms.
+
=head2 How do I cross-reference my Perl programs?
The B::Xref module, shipped with the new, alpha-release Perl compiler
-(not the general distribution), can be used to generate
-cross-reference reports for Perl programs.
+(not the general distribution prior to the 5.005 release), can be used
+to generate cross-reference reports for Perl programs.
- perl -MO=Xref[,OPTIONS] foo.pl
+ perl -MO=Xref[,OPTIONS] scriptname.plx
=head2 Is there a pretty-printer (formatter) for Perl?
-There is no program that will reformat Perl as much as indent(1) will
-do for C. The complex feedback between the scanner and the parser
-(this feedback is what confuses the vgrind and emacs programs) makes it
+There is no program that will reformat Perl as much as indent(1) does
+for C. The complex feedback between the scanner and the parser (this
+feedback is what confuses the vgrind and emacs programs) makes it
challenging at best to write a stand-alone Perl parser.
Of course, if you simply follow the guidelines in L<perlstyle>, you
-shouldn't need to reformat.
-
-Your editor can and should help you with source formatting. The
-perl-mode for emacs can provide a remarkable amount of help with most
-(but not all) code, and even less programmable editors can provide
-significant assistance.
-
-If you are using to using vgrind program for printing out nice code to
-a laser printer, you can take a stab at this using
+shouldn't need to reformat. The habit of formatting your code as you
+write it will help prevent bugs. Your editor can and should help you
+with this. The perl-mode for emacs can provide a remarkable amount of
+help with most (but not all) code, and even less programmable editors
+can provide significant assistance. Tom swears by the following
+settings in vi and its clones:
+
+ set ai sw=4
+ map ^O {^M}^[O^T
+
+Now put that in your F<.exrc> file (replacing the caret characters
+with control characters) and away you go. In insert mode, ^T is
+for indenting, ^D is for undenting, and ^O is for blockdenting --
+as it were. If you haven't used the last one, you're missing
+a lot. A more complete example, with comments, can be found at
+http://www.perl.com/CPAN-local/authors/id/TOMC/scripts/toms.exrc.gz
+
+If you are used to using the I<vgrind> program for printing out nice code
+to a laser printer, you can take a stab at this using
http://www.perl.com/CPAN/doc/misc/tips/working.vgrind.entry, but the
results are not particularly satisfying for sophisticated code.
-=head2 Is there a ctags for Perl?
+The a2ps at http://www.infres.enst.fr/~demaille/a2ps/ does lots of things
+related to generating nicely printed output of documents.
+
+=head2 Is there a etags/ctags for perl?
-There's a simple one at
+With respect to the source code for the Perl interpreter, yes.
+There has been support for etags in the source for a long time.
+Ctags was introduced in v5.005_54 (and probably 5.005_03).
+After building perl, type 'make etags' or 'make ctags' and both
+sets of tag files will be built.
+
+Now, if you're looking to build a tag file for perl code, then there's
+a simple one at
http://www.perl.com/CPAN/authors/id/TOMC/scripts/ptags.gz which may do
-the trick.
+the trick. And if not, it's easy to hack into what you want.
+
+=head2 Is there an IDE or Windows Perl Editor?
+
+If you're on Unix, you already have an IDE -- Unix itself.
+You just have to learn the toolbox. If you're not, then you
+probably don't have a toolbox, so may need something else.
+
+PerlBuilder (XXX URL to follow) is an integrated development
+environment for Windows that supports Perl development. Perl programs
+are just plain text, though, so you could download emacs for Windows
+(XXX) or vim for win32 (http://www.cs.vu.nl/~tmgil/vi.html). If
+you're transferring Windows files to Unix, be sure to transfer in
+ASCII mode so the ends of lines are appropriately converted.
=head2 Where can I get Perl macros for vi?
For a complete version of Tom Christiansen's vi configuration file,
-see ftp://ftp.perl.com/pub/vi/toms.exrc, the standard benchmark file
-for vi emulators. This runs best with nvi, the current version of vi
-out of Berkeley, which incidentally can be built with an embedded Perl
-interpreter -- see http://www.perl.com/CPAN/src/misc .
+see http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/toms.exrc.gz,
+the standard benchmark file for vi emulators. This runs best with nvi,
+the current version of vi out of Berkeley, which incidentally can be built
+with an embedded Perl interpreter -- see http://www.perl.com/CPAN/src/misc.
=head2 Where can I get perl-mode for emacs?
@@ -114,43 +191,54 @@ In the perl source directory, you'll find a directory called "emacs",
which contains a cperl-mode that color-codes keywords, provides
context-sensitive help, and other nifty things.
-Note that the perl-mode of emacs will have fits with "main'foo"
+Note that the perl-mode of emacs will have fits with C<"main'foo">
(single quote), and mess up the indentation and hilighting. You
-should be using "main::foo", anyway.
+are probably using C<"main::foo"> in new Perl code anyway, so this
+shouldn't be an issue.
=head2 How can I use curses with Perl?
The Curses module from CPAN provides a dynamically loadable object
-module interface to a curses library.
+module interface to a curses library. A small demo can be found at the
+directory http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/rep;
+this program repeats a command and updates the screen as needed, rendering
+B<rep ps axu> similar to B<top>.
=head2 How can I use X or Tk with Perl?
-Tk is a completely Perl-based, object-oriented interface to the Tk
-toolkit that doesn't force you to use Tcl just to get at Tk. Sx is an
-interface to the Athena Widget set. Both are available from CPAN.
+Tk is a completely Perl-based, object-oriented interface to the Tk toolkit
+that doesn't force you to use Tcl just to get at Tk. Sx is an interface
+to the Athena Widget set. Both are available from CPAN. See the
+directory http://www.perl.com/CPAN/modules/by-category/08_User_Interfaces/
+
+Invaluable for Perl/Tk programming are: the Perl/Tk FAQ at
+http://w4.lns.cornell.edu/~pvhp/ptk/ptkTOC.html , the Perl/Tk Reference
+Guide available at
+http://www.perl.com/CPAN-local/authors/Stephen_O_Lidie/ , and the
+online manpages at
+http://www-users.cs.umn.edu/~amundson/perl/perltk/toc.html .
=head2 How can I generate simple menus without using CGI or Tk?
The http://www.perl.com/CPAN/authors/id/SKUNZ/perlmenu.v4.0.tar.gz
module, which is curses-based, can help with this.
-=head2 Can I dynamically load C routines into Perl?
-
-If your system architecture supports it, then the standard perl
-on your system should also provide you with this via the
-DynaLoader module. Read L<perlxstut> for details.
-
=head2 What is undump?
See the next questions.
=head2 How can I make my Perl program run faster?
-The best way to do this is to come up with a better algorithm.
-This can often make a dramatic difference. Chapter 8 in the Camel
-has some efficiency tips in it you might want to look at.
+The best way to do this is to come up with a better algorithm. This
+can often make a dramatic difference. Chapter 8 in the Camel has some
+efficiency tips in it you might want to look at. Jon Bentley's book
+``Programming Pearls'' (that's not a misspelling!) has some good tips
+on optimization, too. Advice on benchmarking boils down to: benchmark
+and profile to make sure you're optimizing the right part, look for
+better algorithms instead of microtuning your code, and when all else
+fails consider just buying faster hardware.
-Other approaches include autoloading seldom-used Perl code. See the
+A different approach is to autoload seldom-used Perl code. See the
AutoSplit and AutoLoader modules in the standard distribution for
that. Or you could locate the bottleneck and think about writing just
that part in C, the way we used to take bottlenecks in C code and
@@ -162,9 +250,10 @@ In some cases, it may be worth it to use the backend compiler to
produce byte code (saving compilation time) or compile into C, which
will certainly save compilation time and sometimes a small amount (but
not much) execution time. See the question about compiling your Perl
-programs.
+programs for more on the compiler--the wins aren't as obvious as you'd
+hope.
-If you're currently linking your perl executable to a shared libc.so,
+If you're currently linking your perl executable to a shared I<libc.so>,
you can often gain a 10-25% performance benefit by rebuilding it to
link with a static libc.a instead. This will make a bigger perl
executable, but your Perl programs (and programmers) may thank you for
@@ -174,7 +263,7 @@ information.
Unsubstantiated reports allege that Perl interpreters that use sfio
outperform those that don't (for IO intensive applications). To try
this, see the F<INSTALL> file in the source distribution, especially
-the "Selecting File IO mechanisms" section.
+the ``Selecting File IO mechanisms'' section.
The undump program was an old attempt to speed up your Perl program
by storing the already-compiled form to disk. This is no longer
@@ -185,7 +274,7 @@ wasn't a good solution anyway.
When it comes to time-space tradeoffs, Perl nearly always prefers to
throw memory at a problem. Scalars in Perl use more memory than
-strings in C, arrays take more that, and hashes use even more. While
+strings in C, arrays take more than that, and hashes use even more. While
there's still a lot to be done, recent releases have been addressing
these issues. For example, as of 5.004, duplicate hash keys are
shared amongst all hashes using them, so require no reallocation.
@@ -225,14 +314,21 @@ No, Perl's garbage collection system takes care of this.
=head2 How can I free an array or hash so my program shrinks?
-You can't. Memory the system allocates to a program will never be
-returned to the system. That's why long-running programs sometimes
-re-exec themselves.
+You can't. On most operating systems, memory allocated to a program
+can never be returned to the system. That's why long-running programs
+sometimes re-exec themselves. Some operating systems (notably,
+FreeBSD and Linux) allegedly reclaim large chunks of memory that is no
+longer used, but it doesn't appear to happen with Perl (yet). The Mac
+appears to be the only platform that will reliably (albeit, slowly)
+return memory to the OS.
+
+We've had reports that on Linux (Redhat 5.1) on Intel, C<undef
+$scalar> will return memory to the system, while on Solaris 2.6 it
+won't. In general, try it yourself and see.
However, judicious use of my() on your variables will help make sure
that they go out of scope so that Perl can free up their storage for
-use in other parts of your program. (NB: my() variables also execute
-about 10% faster than globals.) A global variable, of course, never
+use in other parts of your program. A global variable, of course, never
goes out of scope, so you can't get its space automatically reclaimed,
although undef()ing and/or delete()ing it will achieve the same effect.
In general, memory allocation and de-allocation isn't something you can
@@ -248,34 +344,48 @@ to be re-compiled and will often allocate a megabyte or more of system
memory, this can be a killer. Compiling into C B<isn't going to help
you> because the process start-up overhead is where the bottleneck is.
-There are at least two popular ways to avoid this overhead. One
-solution involves running the Apache HTTP server (available from
+There are two popular ways to avoid this overhead. One solution
+involves running the Apache HTTP server (available from
http://www.apache.org/) with either of the mod_perl or mod_fastcgi
-plugin modules. With mod_perl and the Apache::* modules (from CPAN),
-httpd will run with an embedded Perl interpreter which pre-compiles
-your script and then executes it within the same address space without
-forking. The Apache extension also gives Perl access to the internal
-server API, so modules written in Perl can do just about anything a
-module written in C can. With the FCGI module (from CPAN), a Perl
-executable compiled with sfio (see the F<INSTALL> file in the
-distribution) and the mod_fastcgi module (available from
-http://www.fastcgi.com/) each of your perl scripts becomes a permanent
-CGI daemon processes.
+plugin modules.
+
+With mod_perl and the Apache::Registry module (distributed with
+mod_perl), httpd will run with an embedded Perl interpreter which
+pre-compiles your script and then executes it within the same address
+space without forking. The Apache extension also gives Perl access to
+the internal server API, so modules written in Perl can do just about
+anything a module written in C can. For more on mod_perl, see
+http://perl.apache.org/
+
+With the FCGI module (from CPAN) and the mod_fastcgi
+module (available from http://www.fastcgi.com/) each of your perl
+scripts becomes a permanent CGI daemon process.
Both of these solutions can have far-reaching effects on your system
and on the way you write your CGI scripts, so investigate them with
care.
+See http://www.perl.com/CPAN/modules/by-category/15_World_Wide_Web_HTML_HTTP_CGI/ .
+
+A non-free, commercial product, ``The Velocity Engine for Perl'',
+(http://www.binevolve.com/ or
+also be worth looking at. It will allow you to increase the performance
+of your perl scripts, upto 25 times faster than normal CGI perl by
+running in persistent perl mode, or 4 to 5 times faster without any
+modification to your existing CGI scripts. Fully functional evaluation
+copies are available from the web site.
+
=head2 How can I hide the source for my Perl program?
Delete it. :-) Seriously, there are a number of (mostly
-unsatisfactory) solutions with varying levels of "security".
+unsatisfactory) solutions with varying levels of ``security''.
First of all, however, you I<can't> take away read permission, because
the source code has to be readable in order to be compiled and
interpreted. (That doesn't mean that a CGI script's source is
-readable by people on the web, though.) So you have to leave the
-permissions at the socially friendly 0755 level.
+readable by people on the web, though, only by people with access to
+the filesystem) So you have to leave the permissions at the socially
+friendly 0755 level.
Some people regard this as a security problem. If your program does
insecure things, and relies on people not knowing how to exploit those
@@ -284,57 +394,70 @@ determine the insecure things and exploit them without viewing the
source. Security through obscurity, the name for hiding your bugs
instead of fixing them, is little security indeed.
-You can try using encryption via source filters (Filter::* from CPAN).
-But crackers might be able to decrypt it. You can try using the byte
-code compiler and interpreter described below, but crackers might be
-able to de-compile it. You can try using the native-code compiler
-described below, but crackers might be able to disassemble it. These
-pose varying degrees of difficulty to people wanting to get at your
-code, but none can definitively conceal it (this is true of every
+You can try using encryption via source filters (Filter::* from CPAN),
+but any decent programmer will be able to decrypt it. You can try using
+the byte code compiler and interpreter described below, but the curious
+might still be able to de-compile it. You can try using the native-code
+compiler described below, but crackers might be able to disassemble it.
+These pose varying degrees of difficulty to people wanting to get at
+your code, but none can definitively conceal it (this is true of every
language, not just Perl).
If you're concerned about people profiting from your code, then the
bottom line is that nothing but a restrictive licence will give you
legal security. License your software and pepper it with threatening
-statements like "This is unpublished proprietary software of XYZ Corp.
+statements like ``This is unpublished proprietary software of XYZ Corp.
Your access to it does not give you permission to use it blah blah
-blah." We are not lawyers, of course, so you should see a lawyer if
+blah.'' We are not lawyers, of course, so you should see a lawyer if
you want to be sure your licence's wording will stand up in court.
=head2 How can I compile my Perl program into byte code or C?
Malcolm Beattie has written a multifunction backend compiler,
-available from CPAN, that can do both these things. It is as of
-Feb-1997 in late alpha release, which means it's fun to play with if
-you're a programmer but not really for people looking for turn-key
-solutions.
-
-I<Please> understand that merely compiling into C does not in and of
-itself guarantee that your code will run very much faster. That's
-because except for lucky cases where a lot of native type inferencing
-is possible, the normal Perl run time system is still present and thus
-will still take just as long to run and be just as big. Most programs
-save little more than compilation time, leaving execution no more than
-10-30% faster. A few rare programs actually benefit significantly
-(like several times faster), but this takes some tweaking of your
-code.
-
-Malcolm will be in charge of the 5.005 release of Perl itself
-to try to unify and merge his compiler and multithreading work into
-the main release.
+available from CPAN, that can do both these things. It is included
+in the perl5.005 release, but is still considered experimental.
+This means it's fun to play with if you're a programmer but not
+really for people looking for turn-key solutions.
+
+Merely compiling into C does not in and of itself guarantee that your
+code will run very much faster. That's because except for lucky cases
+where a lot of native type inferencing is possible, the normal Perl
+run time system is still present and so your program will take just as
+long to run and be just as big. Most programs save little more than
+compilation time, leaving execution no more than 10-30% faster. A few
+rare programs actually benefit significantly (like several times
+faster), but this takes some tweaking of your code.
You'll probably be astonished to learn that the current version of the
compiler generates a compiled form of your script whose executable is
just as big as the original perl executable, and then some. That's
because as currently written, all programs are prepared for a full
eval() statement. You can tremendously reduce this cost by building a
-shared libperl.so library and linking against that. See the
+shared I<libperl.so> library and linking against that. See the
F<INSTALL> podfile in the perl source distribution for details. If
you link your main perl binary with this, it will make it miniscule.
-For example, on one author's system, /usr/bin/perl is only 11k in
+For example, on one author's system, F</usr/bin/perl> is only 11k in
size!
-=head2 How can I get '#!perl' to work on [MS-DOS,NT,...]?
+In general, the compiler will do nothing to make a Perl program smaller,
+faster, more portable, or more secure. In fact, it will usually hurt
+all of those. The executable will be bigger, your VM system may take
+longer to load the whole thing, the binary is fragile and hard to fix,
+and compilation never stopped software piracy in the form of crackers,
+viruses, or bootleggers. The real advantage of the compiler is merely
+packaging, and once you see the size of what it makes (well, unless
+you use a shared I<libperl.so>), you'll probably want a complete
+Perl install anyway.
+
+=head2 How can I compile Perl into Java?
+
+You can't. Not yet, anyway. You can integrate Java and Perl with the
+Perl Resource Kit from O'Reilly and Associates. See
+http://www.oreilly.com/catalog/prkunix/ for more information.
+The Java interface will be supported in the core 5.006 release
+of Perl.
+
+=head2 How can I get C<#!perl> to work on [MS-DOS,NT,...]?
For OS/2 just use
@@ -345,13 +468,17 @@ as the first line in C<*.cmd> file (C<-S> due to a bug in cmd.exe's
batch file, and codify it in C<ALTERNATIVE_SHEBANG> (see the
F<INSTALL> file in the source distribution for more information).
-The Win95/NT installation, when using the Activeware port of Perl,
-will modify the Registry to associate the .pl extension with the perl
-interpreter. If you install another port, or (eventually) build your
-own Win95/NT Perl using WinGCC, then you'll have to modify the
-Registry yourself.
-
-Macintosh perl scripts will have the the appropriate Creator and
+The Win95/NT installation, when using the ActiveState port of Perl,
+will modify the Registry to associate the C<.pl> extension with the
+perl interpreter. If you install another port (Gurusamy Sarathy's is
+the recommended Win95/NT port), or (eventually) build your own
+Win95/NT Perl using a Windows port of gcc (e.g., with cygwin32 or
+mingw32), then you'll have to modify the Registry yourself. In
+addition to associating C<.pl> with the interpreter, NT people can
+use: C<SET PATHEXT=%PATHEXT%;.PL> to let them run the program
+C<install-linux.pl> merely by typing C<install-linux>.
+
+Macintosh perl scripts will have the appropriate Creator and
Type, so that double-clicking them will invoke the perl application.
I<IMPORTANT!>: Whatever you do, PLEASE don't get frustrated, and just
@@ -365,12 +492,12 @@ Yes. Read L<perlrun> for more information. Some examples follow.
(These assume standard Unix shell quoting rules.)
# sum first and last fields
- perl -lane 'print $F[0] + $F[-1]'
+ perl -lane 'print $F[0] + $F[-1]' *
# identify text files
perl -le 'for(@ARGV) {print if -f && -T _}' *
- # remove comments from C program
+ # remove (most) comments from C program
perl -0777 -pe 's{/\*.*?\*/}{}gs' foo.c
# make file a month younger than today, defeating reaper daemons
@@ -408,10 +535,10 @@ For example:
# VMS
perl -e "print ""Hello world\n"""
-The problem is that none of this is reliable: it depends on the command
-interpreter. Under Unix, the first two often work. Under DOS, it's
-entirely possible neither works. If 4DOS was the command shell, I'd
-probably have better luck like this:
+The problem is that none of this is reliable: it depends on the
+command interpreter. Under Unix, the first two often work. Under DOS,
+it's entirely possible neither works. If 4DOS was the command shell,
+you'd probably have better luck like this:
perl -e "print <Ctrl-x>"Hello world\n<Ctrl-x>""
@@ -420,8 +547,11 @@ shell, or MPW, is much like Unix shells in its support for several
quoting variants, except that it makes free use of the Mac's non-ASCII
characters as control characters.
-I'm afraid that there is no general solution to all of this. It is a
-mess, pure and simple.
+Using qq(), q(), and qx(), instead of "double quotes", 'single
+quotes', and `backticks`, may make one-liners easier to write.
+
+There is no general solution to all of this. It is a mess, pure and
+simple. Sucks to be away from Unix, huh? :-)
[Some of this answer was contributed by Kenneth Albanowski.]
@@ -429,25 +559,33 @@ mess, pure and simple.
For modules, get the CGI or LWP modules from CPAN. For textbooks,
see the two especially dedicated to web stuff in the question on
-books. For problems and questions related to the web, like "Why
-do I get 500 Errors" or "Why doesn't it run from the browser right
-when it runs fine on the command line", see these sources:
+books. For problems and questions related to the web, like ``Why
+do I get 500 Errors'' or ``Why doesn't it run from the browser right
+when it runs fine on the command line'', see these sources:
+
+ WWW Security FAQ
+ http://www.w3.org/Security/Faq/
- The Idiot's Guide to Solving Perl/CGI Problems, by Tom Christiansen
- http://www.perl.com/perl/faq/idiots-guide.html
+ Web FAQ
+ http://www.boutell.com/faq/
- Frequently Asked Questions about CGI Programming, by Nick Kew
- ftp://rtfm.mit.edu/pub/usenet/news.answers/www/cgi-faq
- http://www3.pair.com/webthing/docs/cgi/faqs/cgifaq.shtml
+ CGI FAQ
+ http://www.webthing.com/tutorials/cgifaq.html
- Perl/CGI programming FAQ, by Shishir Gundavaram and Tom Christiansen
- http://www.perl.com/perl/faq/perl-cgi-faq.html
+ HTTP Spec
+ http://www.w3.org/pub/WWW/Protocols/HTTP/
- The WWW Security FAQ, by Lincoln Stein
- http://www-genome.wi.mit.edu/WWW/faqs/www-security-faq.html
+ HTML Spec
+ http://www.w3.org/TR/REC-html40/
+ http://www.w3.org/pub/WWW/MarkUp/
- World Wide Web FAQ, by Thomas Boutell
- http://www.boutell.com/faq/
+ CGI Spec
+ http://www.w3.org/CGI/
+
+ CGI Security FAQ
+ http://www.go2net.com/people/paulp/cgi-security/safe-cgi.txt
+
+Also take a look at L<perlfaq9>
=head2 Where can I learn about object-oriented Perl programming?
@@ -499,6 +637,17 @@ information, see L<ExtUtils::MakeMaker>.
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997 Tom Christiansen and Nathan Torkington.
-All rights reserved. See L<perlfaq> for distribution information.
+Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
+All rights reserved.
+
+When included as an integrated part of the Standard Distribution
+of Perl or of its documentation (printed or otherwise), this work is
+covered under Perl's Artistic Licence. For separate distributions of
+all or part of this FAQ outside of that, see L<perlfaq>.
+
+Irrespective of its distribution, all code examples here are public
+domain. You are permitted and encouraged to use this code and any
+derivatives thereof in your own programs for fun or for profit as you
+see fit. A simple comment in the code giving credit to the FAQ would
+be courteous but is not required.
diff --git a/gnu/usr.bin/perl/pod/perlfaq4.pod b/gnu/usr.bin/perl/pod/perlfaq4.pod
index a5b505c4a7a..92aee2c7af1 100644
--- a/gnu/usr.bin/perl/pod/perlfaq4.pod
+++ b/gnu/usr.bin/perl/pod/perlfaq4.pod
@@ -1,6 +1,6 @@
=head1 NAME
-perlfaq4 - Data Manipulation ($Revision: 1.19 $, $Date: 1997/04/24 22:43:57 $)
+perlfaq4 - Data Manipulation ($Revision: 1.40 $, $Date: 1999/01/08 04:26:39 $)
=head1 DESCRIPTION
@@ -12,9 +12,13 @@ data issues.
=head2 Why am I getting long decimals (eg, 19.9499999999999) instead of the numbers I should be getting (eg, 19.95)?
+The infinite set that a mathematician thinks of as the real numbers can
+only be approximate on a computer, since the computer only has a finite
+number of bits to store an infinite number of, um, numbers.
+
Internally, your computer represents floating-point numbers in binary.
-Floating-point numbers read in from a file, or appearing as literals
-in your program, are converted from their decimal floating-point
+Floating-point numbers read in from a file or appearing as literals
+in your program are converted from their decimal floating-point
representation (eg, 19.95) to the internal binary representation.
However, 19.95 can't be precisely represented as a binary
@@ -37,6 +41,7 @@ are consequently slower.
To get rid of the superfluous digits, just use a format (eg,
C<printf("%.2f", 19.95)>) to get the required precision.
+See L<perlop/"Floating-point Arithmetic">.
=head2 Why isn't my octal data interpreted correctly?
@@ -54,16 +59,22 @@ umask(), or sysopen(), which all want permissions in octal.
chmod(644, $file); # WRONG -- perl -w catches this
chmod(0644, $file); # right
-=head2 Does perl have a round function? What about ceil() and floor()?
-Trig functions?
+=head2 Does Perl have a round() function? What about ceil() and floor()? Trig functions?
+
+Remember that int() merely truncates toward 0. For rounding to a
+certain number of digits, sprintf() or printf() is usually the easiest
+route.
-For rounding to a certain number of digits, sprintf() or printf() is
-usually the easiest route.
+ printf("%.3f", 3.1415926535); # prints 3.142
The POSIX module (part of the standard perl distribution) implements
ceil(), floor(), and a number of other mathematical and trigonometric
functions.
+ use POSIX;
+ $ceil = ceil(3.5); # 4
+ $floor = floor(3.5); # 3
+
In 5.000 to 5.003 Perls, trigonometry was done in the Math::Complex
module. With 5.004, the Math::Trig module (part of the standard perl
distribution) implements the trigonometric functions. Internally it
@@ -77,9 +88,22 @@ cases, it probably pays not to trust whichever system rounding is
being used by Perl, but to instead implement the rounding function you
need yourself.
+To see why, notice how you'll still have an issue on half-way-point
+alternation:
+
+ for ($i = 0; $i < 1.01; $i += 0.05) { printf "%.1f ",$i}
+
+ 0.0 0.1 0.1 0.2 0.2 0.2 0.3 0.3 0.4 0.4 0.5 0.5 0.6 0.7 0.7
+ 0.8 0.8 0.9 0.9 1.0 1.0
+
+Don't blame Perl. It's the same as in C. IEEE says we have to do this.
+Perl numbers whose absolute values are integers under 2**31 (on 32 bit
+machines) will work pretty much like mathematical integers. Other numbers
+are not guaranteed.
+
=head2 How do I convert bits into ints?
-To turn a string of 1s and 0s like '10110110' into a scalar containing
+To turn a string of 1s and 0s like C<10110110> into a scalar containing
its binary value, use the pack() function (documented in
L<perlfunc/"pack">):
@@ -89,6 +113,33 @@ Here's an example of going the other way:
$binary_string = join('', unpack('B*', "\x29"));
+=head2 Why doesn't & work the way I want it to?
+
+The behavior of binary arithmetic operators depends on whether they're
+used on numbers or strings. The operators treat a string as a series
+of bits and work with that (the string C<"3"> is the bit pattern
+C<00110011>). The operators work with the binary form of a number
+(the number C<3> is treated as the bit pattern C<00000011>).
+
+So, saying C<11 & 3> performs the "and" operation on numbers (yielding
+C<1>). Saying C<"11" & "3"> performs the "and" operation on strings
+(yielding C<"1">).
+
+Most problems with C<&> and C<|> arise because the programmer thinks
+they have a number but really it's a string. The rest arise because
+the programmer says:
+
+ if ("\020\020" & "\101\101") {
+ # ...
+ }
+
+but a string consisting of two null bytes (the result of C<"\020\020"
+& "\101\101">) is not a false value in Perl. You need:
+
+ if ( ("\020\020" & "\101\101") !~ /[^\000]/) {
+ # ...
+ }
+
=head2 How do I multiply matrices?
Use the Math::Matrix or Math::MatrixReal modules (available from CPAN)
@@ -109,12 +160,12 @@ To call a function on each element of an array, but ignore the
results:
foreach $iterator (@array) {
- &my_func($iterator);
+ some_func($iterator);
}
To call a function on each integer in a (small) range, you B<can> use:
- @results = map { &my_func($_) } (5 .. 25);
+ @results = map { some_func($_) } (5 .. 25);
but you should be aware that the C<..> operator creates an array of
all integers in the range. This can take a lot of memory for large
@@ -122,7 +173,7 @@ ranges. Instead use:
@results = ();
for ($i=5; $i < 500_005; $i++) {
- push(@results, &my_func($i));
+ push(@results, some_func($i));
}
=head2 How can I output Roman numerals?
@@ -131,13 +182,25 @@ Get the http://www.perl.com/CPAN/modules/by-module/Roman module.
=head2 Why aren't my random numbers random?
-The short explanation is that you're getting pseudorandom numbers, not
-random ones, because that's how these things work. A longer
-explanation is available on
+If you're using a version of Perl before 5.004, you must call C<srand>
+once at the start of your program to seed the random number generator.
+5.004 and later automatically call C<srand> at the beginning. Don't
+call C<srand> more than once--you make your numbers less random, rather
+than more.
+
+Computers are good at being predictable and bad at being random
+(despite appearances caused by bugs in your programs :-).
http://www.perl.com/CPAN/doc/FMTEYEWTK/random, courtesy of Tom
-Phoenix.
+Phoenix, talks more about this.. John von Neumann said, ``Anyone who
+attempts to generate random numbers by deterministic means is, of
+course, living in a state of sin.''
-You should also check out the Math::TrulyRandom module from CPAN.
+If you want numbers that are more random than C<rand> with C<srand>
+provides, you should also check out the Math::TrulyRandom module from
+CPAN. It uses the imperfections in your system's timer to generate
+random numbers, but this takes quite a while. If you want a better
+pseudorandom generator than comes with your operating system, look at
+``Numerical Recipes in C'' at http://www.nr.com/ .
=head1 Data: Dates
@@ -157,62 +220,97 @@ You can find the week of the year by dividing this by 7:
$week_of_year = int($day_of_year / 7);
-Of course, this believes that weeks start at zero.
+Of course, this believes that weeks start at zero. The Date::Calc
+module from CPAN has a lot of date calculation functions, including
+day of the year, week of the year, and so on. Note that not
+all businesses consider ``week 1'' to be the same; for example,
+American businesses often consider the first week with a Monday
+in it to be Work Week #1, despite ISO 8601, which considers
+WW1 to be the first week with a Thursday in it.
-=head2 How can I compare two date strings?
+=head2 How can I compare two dates and find the difference?
-Use the Date::Manip or Date::DateCalc modules from CPAN.
+If you're storing your dates as epoch seconds then simply subtract one
+from the other. If you've got a structured date (distinct year, day,
+month, hour, minute, seconds values) then use one of the Date::Manip
+and Date::Calc modules from CPAN.
=head2 How can I take a string and turn it into epoch seconds?
If it's a regular enough string that it always has the same format,
-you can split it up and pass the parts to timelocal in the standard
-Time::Local module. Otherwise, you should look into one of the
-Date modules from CPAN.
+you can split it up and pass the parts to C<timelocal> in the standard
+Time::Local module. Otherwise, you should look into the Date::Calc
+and Date::Manip modules from CPAN.
=head2 How can I find the Julian Day?
-Neither Date::Manip nor Date::DateCalc deal with Julian days.
-Instead, there is an example of Julian date calculation in
-http://www.perl.com/CPAN/authors/David_Muir_Sharnoff/modules/Time/JulianDay.pm.gz,
-which should help.
+Neither Date::Manip nor Date::Calc deal with Julian days. Instead,
+there is an example of Julian date calculation that should help you in
+Time::JulianDay (part of the Time-modules bundle) which can be found at
+http://www.perl.com/CPAN/modules/by-module/Time/.
+
+
+=head2 How do I find yesterday's date?
+
+The C<time()> function returns the current time in seconds since the
+epoch. Take one day off that:
+
+ $yesterday = time() - ( 24 * 60 * 60 );
+
+Then you can pass this to C<localtime()> and get the individual year,
+month, day, hour, minute, seconds values.
+
+=head2 Does Perl have a year 2000 problem? Is Perl Y2K compliant?
+
+Short answer: No, Perl does not have a Year 2000 problem. Yes, Perl is
+Y2K compliant (whatever that means). The programmers you've hired to
+use it, however, probably are not.
-=head2 Does Perl have a year 2000 problem?
+Long answer: The question belies a true understanding of the issue.
+Perl is just as Y2K compliant as your pencil--no more, and no less.
+Can you use your pencil to write a non-Y2K-compliant memo? Of course
+you can. Is that the pencil's fault? Of course it isn't.
-Not unless you use Perl to create one. The date and time functions
-supplied with perl (gmtime and localtime) supply adequate information
-to determine the year well beyond 2000 (2038 is when trouble strikes).
-The year returned by these functions when used in an array context is
-the year minus 1900. For years between 1910 and 1999 this I<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.
+The date and time functions supplied with perl (gmtime and 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 years between 1910 and 1999 this I<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.
-When gmtime() and localtime() are used in a scalar context they return
+When gmtime() and localtime() are used in scalar context they return
a timestamp string that contains a fully-expanded year. For example,
C<$timestamp = gmtime(1005613200)> sets $timestamp to "Tue Nov 13 01:00:00
2001". There's no year 2000 problem here.
+That doesn't mean that Perl can't be used to create non-Y2K compliant
+programs. It can. But so can your pencil. It's the fault of the user,
+not the language. At the risk of inflaming the NRA: ``Perl doesn't
+break Y2K, people do.'' See http://language.perl.com/news/y2k.html for
+a longer exposition.
+
=head1 Data: Strings
=head2 How do I validate input?
The answer to this question is usually a regular expression, perhaps
-with auxiliary logic. See the more specific questions (numbers, email
+with auxiliary logic. See the more specific questions (numbers, mail
addresses, etc.) for details.
=head2 How do I unescape a string?
-It depends just what you mean by "escape". URL escapes are dealt with
-in L<perlfaq9>. Shell escapes with the backslash (\)
+It depends just what you mean by ``escape''. URL escapes are dealt
+with in L<perlfaq9>. Shell escapes with the backslash (C<\>)
character are removed with:
s/\\(.)/$1/g;
-Note that this won't expand \n or \t or any other special escapes.
+This won't expand C<"\n"> or C<"\t"> or any other special escapes.
=head2 How do I remove consecutive pairs of characters?
-To turn "abbcccd" into "abccd":
+To turn C<"abbcccd"> into C<"abccd">:
s/(.)\1/$1/g;
@@ -220,7 +318,7 @@ To turn "abbcccd" into "abccd":
This is documented in L<perlref>. In general, this is fraught with
quoting and readability problems, but it is possible. To interpolate
-a subroutine call (in a list context) into a string:
+a subroutine call (in list context) into a string:
print "My sub returned @{[mysub(1,2,3)]} that time.\n";
@@ -229,28 +327,61 @@ arbitrary expressions:
print "That yields ${\($n + 5)} widgets\n";
-See also "How can I expand variables in text strings?" in this section
-of the FAQ.
+Version 5.004 of Perl had a bug that gave list context to the
+expression in C<${...}>, but this is fixed in version 5.005.
+
+See also ``How can I expand variables in text strings?'' in this
+section of the FAQ.
=head2 How do I find matching/nesting anything?
-This isn't something that can be tackled in one regular expression, no
-matter how complicated. To find something between two single characters,
-a pattern like C</x([^x]*)x/> will get the intervening bits in $1. For
-multiple ones, then something more like C</alpha(.*?)omega/> would
-be needed. But none of these deals with nested patterns, nor can they.
-For that you'll have to write a parser.
+This isn't something that can be done in one regular expression, no
+matter how complicated. To find something between two single
+characters, a pattern like C</x([^x]*)x/> will get the intervening
+bits in $1. For multiple ones, then something more like
+C</alpha(.*?)omega/> would be needed. But none of these deals with
+nested patterns, nor can they. For that you'll have to write a
+parser.
+
+If you are serious about writing a parser, there are a number of
+modules or oddities that will make your life a lot easier. There is
+the CPAN module Parse::RecDescent, the standard module Text::Balanced,
+the byacc program, the CPAN module Parse::Yapp, and Mark-Jason
+Dominus's excellent I<py> tool at http://www.plover.com/~mjd/perl/py/
+.
+
+One simple destructive, inside-out approach that you might try is to
+pull out the smallest nesting parts one at a time:
+
+ while (s//BEGIN((?:(?!BEGIN)(?!END).)*)END/gs) {
+ # do something with $1
+ }
+
+A more complicated and sneaky approach is to make Perl's regular
+expression engine do it for you. This is courtesy Dean Inada, and
+rather has the nature of an Obfuscated Perl Contest entry, but it
+really does work:
+
+ # $_ contains the string to parse
+ # BEGIN and END are the opening and closing markers for the
+ # nested text.
+
+ @( = ('(','');
+ @) = (')','');
+ ($re=$_)=~s/((BEGIN)|(END)|.)/$)[!$3]\Q$1\E$([!$2]/gs;
+ @$ = (eval{/$re/},$@!~/unmatched/);
+ print join("\n",@$[0..$#$]) if( $$[-1] );
=head2 How do I reverse a string?
-Use reverse() in a scalar context, as documented in
+Use reverse() in scalar context, as documented in
L<perlfunc/reverse>.
$reversed = reverse $string;
=head2 How do I expand tabs in a string?
-You can do it the old-fashioned way:
+You can do it yourself:
1 while $string =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;
@@ -267,13 +398,13 @@ Use Text::Wrap (part of the standard perl distribution):
use Text::Wrap;
print wrap("\t", ' ', @paragraphs);
-The paragraphs you give to Text::Wrap may not contain embedded
+The paragraphs you give to Text::Wrap should not contain embedded
newlines. Text::Wrap doesn't justify the lines (flush-right).
=head2 How can I access/change the first N letters of a string?
There are many ways. If you just want to grab a copy, use
-substr:
+substr():
$first_byte = substr($a, 0, 1);
@@ -282,15 +413,16 @@ use substr() as an lvalue:
substr($a, 0, 3) = "Tom";
-Although those with a regexp kind of thought process will likely prefer
+Although those with a pattern matching kind of thought process will
+likely prefer:
$a =~ s/^.../Tom/;
=head2 How do I change the Nth occurrence of something?
-You have to keep track. For example, let's say you want
-to change the fifth occurrence of "whoever" or "whomever"
-into "whosoever" or "whomsoever", case insensitively.
+You have to keep track of N yourself. For example, let's say you want
+to change the fifth occurrence of C<"whoever"> or C<"whomever"> into
+C<"whosoever"> or C<"whomsoever">, case insensitively.
$count = 0;
s{((whom?)ever)}{
@@ -299,13 +431,30 @@ into "whosoever" or "whomsoever", case insensitively.
: $1 # renege and leave it there
}igex;
+In the more general case, you can use the C</g> modifier in a C<while>
+loop, keeping count of matches.
+
+ $WANT = 3;
+ $count = 0;
+ while (/(\w+)\s+fish\b/gi) {
+ if (++$count == $WANT) {
+ print "The third fish is a $1 one.\n";
+ # Warning: don't `last' out of this loop
+ }
+ }
+
+That prints out: C<"The third fish is a red one."> You can also use a
+repetition count and repeated pattern like this:
+
+ /(?:\w+\s+fish\s+){2}(\w+)\s+fish/i;
+
=head2 How can I count the number of occurrences of a substring within a string?
There are a number of ways, with varying efficiency: If you want a
count of a certain single character (X) within a string, you can use the
C<tr///> function like so:
- $string = "ThisXlineXhasXsomeXx'sXinXit":
+ $string = "ThisXlineXhasXsomeXx'sXinXit";
$count = ($string =~ tr/X//);
print "There are $count X charcters in the string";
@@ -327,7 +476,7 @@ To make the first letter of each word upper case:
This has the strange effect of turning "C<don't do it>" into "C<Don'T
Do It>". Sometimes you might want this, instead (Suggested by Brian
-Foy E<lt>comdog@computerdog.comE<gt>):
+Foy):
$string =~ s/ (
(^\w) #at the beginning of the line
@@ -345,6 +494,15 @@ To force each word to be lower case, with the first letter upper case:
$line =~ s/(\w+)/\u\L$1/g;
+You can (and probably should) enable locale awareness of those
+characters by placing a C<use locale> pragma in your program.
+See L<perllocale> for endless details on locales.
+
+This is sometimes referred to as putting something into "title
+case", but that's not quite accurate. Consdier the proper
+capitalization of the movie I<Dr. Strangelove or: How I Learned to
+Stop Worrying and Love the Bomb>, for example.
+
=head2 How can I split a [character] delimited string except when inside
[character]? (Comma-separated files)
@@ -380,13 +538,16 @@ distribution) lets you say:
use Text::ParseWords;
@new = quotewords(",", 0, $text);
+There's also a Text::CSV module on CPAN.
+
=head2 How do I strip blank space from the beginning/end of a string?
-The simplest approach, albeit not the fastest, is probably like this:
+Although the simplest approach would seem to be:
$string =~ s/^\s*(.*?)\s*$/$1/;
-It would be faster to do this in two steps:
+This is unnecessarily slow, destructive, and fails with embedded newlines.
+It is much better faster to do this in two steps:
$string =~ s/^\s+//;
$string =~ s/\s+$//;
@@ -398,9 +559,77 @@ Or more nicely written as:
s/\s+$//;
}
+This idiom takes advantage of the C<foreach> loop's aliasing
+behavior to factor out common code. You can do this
+on several strings at once, or arrays, or even the
+values of a hash if you use a slide:
+
+ # trim whitespace in the scalar, the array,
+ # and all the values in the hash
+ foreach ($scalar, @array, @hash{keys %hash}) {
+ s/^\s+//;
+ s/\s+$//;
+ }
+
+=head2 How do I pad a string with blanks or pad a number with zeroes?
+
+(This answer contributed by Uri Guttman)
+
+In the following examples, C<$pad_len> is the length to which you wish
+to pad the string, C<$text> or C<$num> contains the string to be
+padded, and C<$pad_char> contains the padding character. You can use a
+single character string constant instead of the C<$pad_char> variable
+if you know what it is in advance.
+
+The simplest method use the C<sprintf> function. It can pad on the
+left or right with blanks and on the left with zeroes.
+
+ # Left padding with blank:
+ $padded = sprintf( "%${pad_len}s", $text ) ;
+
+ # Right padding with blank:
+ $padded = sprintf( "%${pad_len}s", $text ) ;
+
+ # Left padding with 0:
+ $padded = sprintf( "%0${pad_len}d", $num ) ;
+
+If you need to pad with a character other than blank or zero you can use
+one of the following methods.
+
+These methods generate a pad string with the C<x> operator and
+concatenate that with the original text.
+
+Left and right padding with any character:
+
+ $padded = $pad_char x ( $pad_len - length( $text ) ) . $text ;
+ $padded = $text . $pad_char x ( $pad_len - length( $text ) ) ;
+
+Or you can left or right pad $text directly:
+
+ $text .= $pad_char x ( $pad_len - length( $text ) ) ;
+ substr( $text, 0, 0 ) = $pad_char x ( $pad_len - length( $text ) ) ;
+
=head2 How do I extract selected columns from a string?
Use substr() or unpack(), both documented in L<perlfunc>.
+If you prefer thinking in terms of columns instead of widths,
+you can use this kind of thing:
+
+ # determine the unpack format needed to split Linux ps output
+ # arguments are cut columns
+ my $fmt = cut2fmt(8, 14, 20, 26, 30, 34, 41, 47, 59, 63, 67, 72);
+
+ sub cut2fmt {
+ my(@positions) = @_;
+ my $template = '';
+ my $lastpos = 1;
+ for my $place (@positions) {
+ $template .= "A" . ($place - $lastpos) . " ";
+ $lastpos = $place;
+ }
+ $template .= "A*";
+ return $template;
+ }
=head2 How do I find the soundex value of a string?
@@ -411,24 +640,37 @@ Use the standard Text::Soundex module distributed with perl.
Let's assume that you have a string like:
$text = 'this has a $foo in it and a $bar';
- $text =~ s/\$(\w+)/${$1}/g;
-Before version 5 of perl, this had to be done with a double-eval
-substitution:
+If those were both global variables, then this would
+suffice:
+
+ $text =~ s/\$(\w+)/${$1}/g; # no /e needed
+
+But since they are probably lexicals, or at least, they could
+be, you'd have to do this:
$text =~ s/(\$\w+)/$1/eeg;
+ die if $@; # needed /ee, not /e
-Which is bizarre enough that you'll probably actually need an EEG
-afterwards. :-)
+It's probably better in the general case to treat those
+variables as entries in some special hash. For example:
-See also "How do I expand function calls in a string?" in this section
+ %user_defs = (
+ foo => 23,
+ bar => 19,
+ );
+ $text =~ s/\$(\w+)/$user_defs{$1}/g;
+
+See also ``How do I expand function calls in a string?'' in this section
of the FAQ.
=head2 What's wrong with always quoting "$vars"?
The problem is that those double-quotes force stringification,
coercing numbers and references into strings, even when you
-don't want them to be.
+don't want them to be. Think of it this way: double-quote
+expansion is used to produce new strings. If you already
+have a string, why do you need more?
If you get used to writing odd things like these:
@@ -458,7 +700,13 @@ that actually do care about the difference between a string and a
number, such as the magical C<++> autoincrement operator or the
syscall() function.
-=head2 Why don't my <<HERE documents work?
+Stringification also destroys arrays.
+
+ @lines = `command`;
+ print "@lines"; # WRONG - extra blanks
+ print @lines; # right
+
+=head2 Why don't my E<lt>E<lt>HERE documents work?
Check for these three things:
@@ -472,8 +720,95 @@ Check for these three things:
=back
+If you want to indent the text in the here document, you
+can do this:
+
+ # all in one
+ ($VAR = <<HERE_TARGET) =~ s/^\s+//gm;
+ your text
+ goes here
+ HERE_TARGET
+
+But the HERE_TARGET must still be flush against the margin.
+If you want that indented also, you'll have to quote
+in the indentation.
+
+ ($quote = <<' FINIS') =~ s/^\s+//gm;
+ ...we will have peace, when you and all your works have
+ perished--and the works of your dark master to whom you
+ would deliver us. You are a liar, Saruman, and a corrupter
+ of men's hearts. --Theoden in /usr/src/perl/taint.c
+ FINIS
+ $quote =~ s/\s*--/\n--/;
+
+A nice general-purpose fixer-upper function for indented here documents
+follows. It expects to be called with a here document as its argument.
+It looks to see whether each line begins with a common substring, and
+if so, strips that off. Otherwise, it takes the amount of leading
+white space found on the first line and removes that much off each
+subsequent line.
+
+ sub fix {
+ local $_ = shift;
+ my ($white, $leader); # common white space and common leading string
+ if (/^\s*(?:([^\w\s]+)(\s*).*\n)(?:\s*\1\2?.*\n)+$/) {
+ ($white, $leader) = ($2, quotemeta($1));
+ } else {
+ ($white, $leader) = (/^(\s+)/, '');
+ }
+ s/^\s*?$leader(?:$white)?//gm;
+ return $_;
+ }
+
+This works with leading special strings, dynamically determined:
+
+ $remember_the_main = fix<<' MAIN_INTERPRETER_LOOP';
+ @@@ int
+ @@@ runops() {
+ @@@ SAVEI32(runlevel);
+ @@@ runlevel++;
+ @@@ while ( op = (*op->op_ppaddr)() ) ;
+ @@@ TAINT_NOT;
+ @@@ return 0;
+ @@@ }
+ MAIN_INTERPRETER_LOOP
+
+Or with a fixed amount of leading white space, with remaining
+indentation correctly preserved:
+
+ $poem = fix<<EVER_ON_AND_ON;
+ Now far ahead the Road has gone,
+ And I must follow, if I can,
+ Pursuing it with eager feet,
+ Until it joins some larger way
+ Where many paths and errands meet.
+ And whither then? I cannot say.
+ --Bilbo in /usr/src/perl/pp_ctl.c
+ EVER_ON_AND_ON
+
=head1 Data: Arrays
+=head2 What is the difference between a list and an array?
+
+An array has a changeable length. A list does not. An array is something
+you can push or pop, while a list is a set of values. Some people make
+the distinction that a list is a value while an array is a variable.
+Subroutines are passed and return lists, you put things into list
+context, you initialize arrays with lists, and you foreach() across
+a list. C<@> variables are arrays, anonymous arrays are arrays, arrays
+in scalar context behave like the number of elements in them, subroutines
+access their arguments through the array C<@_>, push/pop/shift only work
+on arrays.
+
+As a side note, there's no such thing as a list in scalar context.
+When you say
+
+ $scalar = (2, 5, 7, 9);
+
+you're using the comma operator in scalar context, so it evaluates the
+left hand side, then evaluates and returns the left hand side. This
+causes the last value to be returned: 9.
+
=head2 What is the difference between $array[1] and @array[1]?
The former is a scalar value, the latter an array slice, which makes
@@ -500,13 +835,15 @@ ordered and whether you wish to preserve the ordering.
=over 4
=item a) If @in is sorted, and you want @out to be sorted:
+(this assumes all true values in the array)
$prev = 'nonesuch';
@out = grep($_ ne $prev && ($prev = $_), @in);
-This is nice in that it doesn't use much extra memory,
-simulating uniq(1)'s behavior of removing only adjacent
-duplicates.
+This is nice in that it doesn't use much extra memory, simulating
+uniq(1)'s behavior of removing only adjacent duplicates. It's less
+nice in that it won't work with false values like undef, 0, or "";
+"0 but true" is ok, though.
=item b) If you don't know whether @in is sorted:
@@ -531,11 +868,17 @@ duplicates.
=back
-=head2 How can I tell whether an array contains a certain element?
+But perhaps you should have been using a hash all along, eh?
+
+=head2 How can I tell whether a list or array contains a certain element?
-There are several ways to approach this. If you are going to make
-this query many times and the values are arbitrary strings, the
-fastest way is probably to invert the original array and keep an
+Hearing the word "in" is an I<in>dication that you probably should have
+used a hash, not a list or array, to store your data. Hashes are
+designed to answer this question quickly and efficiently. Arrays aren't.
+
+That being said, there are several ways to approach this. If you
+are going to make this query many times over arbitrary string values,
+the fastest way is probably to invert the original array and keep an
associative array lying about whose keys are the first array's values.
@blues = qw/azure cerulean teal turquoise lapis-lazuli/;
@@ -559,7 +902,7 @@ quite a lot of space by using bit strings instead:
@articles = ( 1..10, 150..2000, 2017 );
undef $read;
- grep (vec($read,$_,1) = 1, @articles);
+ for (@articles) { vec($read,$_,1) = 1 }
Now check whether C<vec($read,$n,1)> is true for some C<$n>.
@@ -573,7 +916,17 @@ or worse yet
These are slow (checks every element even if the first matches),
inefficient (same reason), and potentially buggy (what if there are
-regexp characters in $whatever?).
+regexp characters in $whatever?). If you're only testing once, then
+use:
+
+ $is_there = 0;
+ foreach $elt (@array) {
+ if ($elt eq $elt_to_find) {
+ $is_there = 1;
+ last;
+ }
+ }
+ if ($is_there) { ... }
=head2 How do I compute the difference of two arrays? How do I compute the intersection of two arrays?
@@ -588,11 +941,60 @@ each element is unique in a given array:
push @{ $count{$element} > 1 ? \@intersection : \@difference }, $element;
}
+=head2 How do I test whether two arrays or hashes are equal?
+
+The following code works for single-level arrays. It uses a stringwise
+comparison, and does not distinguish defined versus undefined empty
+strings. Modify if you have other needs.
+
+ $are_equal = compare_arrays(\@frogs, \@toads);
+
+ sub compare_arrays {
+ my ($first, $second) = @_;
+ local $^W = 0; # silence spurious -w undef complaints
+ return 0 unless @$first == @$second;
+ for (my $i = 0; $i < @$first; $i++) {
+ return 0 if $first->[$i] ne $second->[$i];
+ }
+ return 1;
+ }
+
+For multilevel structures, you may wish to use an approach more
+like this one. It uses the CPAN module FreezeThaw:
+
+ use FreezeThaw qw(cmpStr);
+ @a = @b = ( "this", "that", [ "more", "stuff" ] );
+
+ printf "a and b contain %s arrays\n",
+ cmpStr(\@a, \@b) == 0
+ ? "the same"
+ : "different";
+
+This approach also works for comparing hashes. Here
+we'll demonstrate two different answers:
+
+ use FreezeThaw qw(cmpStr cmpStrHard);
+
+ %a = %b = ( "this" => "that", "extra" => [ "more", "stuff" ] );
+ $a{EXTRA} = \%b;
+ $b{EXTRA} = \%a;
+
+ printf "a and b contain %s hashes\n",
+ cmpStr(\%a, \%b) == 0 ? "the same" : "different";
+
+ printf "a and b contain %s hashes\n",
+ cmpStrHard(\%a, \%b) == 0 ? "the same" : "different";
+
+
+The first reports that both those the hashes contain the same data,
+while the second reports that they do not. Which you prefer is left as
+an exercise to the reader.
+
=head2 How do I find the first array element for which a condition is true?
You can use this if you care about the index:
- for ($i=0; $i < @array; $i++) {
+ for ($i= 0; $i < @array; $i++) {
if ($array[$i] eq "Waldo") {
$found_index = $i;
last;
@@ -605,12 +1007,50 @@ Now C<$found_index> has what you want.
In general, you usually don't need a linked list in Perl, since with
regular arrays, you can push and pop or shift and unshift at either end,
-or you can use splice to add and/or remove arbitrary number of elements
-at arbitrary points.
+or you can use splice to add and/or remove arbitrary number of elements at
+arbitrary points. Both pop and shift are both O(1) operations on perl's
+dynamic arrays. In the absence of shifts and pops, push in general
+needs to reallocate on the order every log(N) times, and unshift will
+need to copy pointers each time.
If you really, really wanted, you could use structures as described in
L<perldsc> or L<perltoot> and do just what the algorithm book tells you
-to do.
+to do. For example, imagine a list node like this:
+
+ $node = {
+ VALUE => 42,
+ LINK => undef,
+ };
+
+You could walk the list this way:
+
+ print "List: ";
+ for ($node = $head; $node; $node = $node->{LINK}) {
+ print $node->{VALUE}, " ";
+ }
+ print "\n";
+
+You could grow the list this way:
+
+ my ($head, $tail);
+ $tail = append($head, 1); # grow a new head
+ for $value ( 2 .. 10 ) {
+ $tail = append($tail, $value);
+ }
+
+ sub append {
+ my($list, $value) = @_;
+ my $node = { VALUE => $value };
+ if ($list) {
+ $node->{LINK} = $list->{LINK};
+ $list->{LINK} = $node;
+ } else {
+ $_[0] = $node; # replace caller's version
+ }
+ return $node;
+ }
+
+But again, Perl's built-in are virtually always good enough.
=head2 How do I handle circular lists?
@@ -622,7 +1062,23 @@ lists, or you could just do something like this with an array:
=head2 How do I shuffle an array randomly?
-Here's a shuffling algorithm which works its way through the list,
+Use this:
+
+ # fisher_yates_shuffle( \@array ) :
+ # generate a random permutation of @array in place
+ sub fisher_yates_shuffle {
+ my $array = shift;
+ my $i;
+ for ($i = @$array; --$i; ) {
+ my $j = int rand ($i+1);
+ next if $i == $j;
+ @$array[$i,$j] = @$array[$j,$i];
+ }
+ }
+
+ fisher_yates_shuffle( \@array ); # permutes @array in place
+
+You've probably seen shuffling algorithms that works using splice,
randomly picking another element to swap the current element with:
srand;
@@ -632,65 +1088,70 @@ randomly picking another element to swap the current element with:
push(@new, splice(@old, rand @old, 1));
}
-For large arrays, this avoids a lot of the reshuffling:
-
- srand;
- @new = ();
- @old = 1 .. 10000; # just a demo
- for( @old ){
- my $r = rand @new+1;
- push(@new,$new[$r]);
- $new[$r] = $_;
- }
+This is bad because splice is already O(N), and since you do it N times,
+you just invented a quadratic algorithm; that is, O(N**2). This does
+not scale, although Perl is so efficient that you probably won't notice
+this until you have rather largish arrays.
=head2 How do I process/modify each element of an array?
Use C<for>/C<foreach>:
for (@lines) {
- s/foo/bar/;
- tr[a-z][A-Z];
+ s/foo/bar/; # change that word
+ y/XZ/ZX/; # swap those letters
}
Here's another; let's compute spherical volumes:
- for (@radii) {
+ for (@volumes = @radii) { # @volumes has changed parts
$_ **= 3;
$_ *= (4/3) * 3.14159; # this will be constant folded
}
+If you want to do the same thing to modify the values of the hash,
+you may not use the C<values> function, oddly enough. You need a slice:
+
+ for $orbit ( @orbits{keys %orbits} ) {
+ ($orbit **= 3) *= (4/3) * 3.14159;
+ }
+
=head2 How do I select a random element from an array?
Use the rand() function (see L<perlfunc/rand>):
+ # at the top of the program:
srand; # not needed for 5.004 and later
+
+ # then later on
$index = rand @array;
$element = $array[$index];
+Make sure you I<only call srand once per program, if then>.
+If you are calling it more than once (such as before each
+call to rand), you're almost certainly doing something wrong.
+
=head2 How do I permute N elements of a list?
Here's a little program that generates all permutations
of all the words on each line of input. The algorithm embodied
-in the permut() function should work on any list:
+in the permute() function should work on any list:
#!/usr/bin/perl -n
- # permute - tchrist@perl.com
- permut([split], []);
- sub permut {
- my @head = @{ $_[0] };
- my @tail = @{ $_[1] };
- unless (@head) {
- # stop recursing when there are no elements in the head
- print "@tail\n";
+ # tsc-permute: permute each word of input
+ permute([split], []);
+ sub permute {
+ my @items = @{ $_[0] };
+ my @perms = @{ $_[1] };
+ unless (@items) {
+ print "@perms\n";
} else {
- # for all elements in @head, move one from @head to @tail
- # and call permut() on the new @head and @tail
- my(@newhead,@newtail,$i);
- foreach $i (0 .. $#head) {
- @newhead = @head;
- @newtail = @tail;
- unshift(@newtail, splice(@newhead, $i, 1));
- permut([@newhead], [@newtail]);
+ my(@newitems,@newperms,$i);
+ foreach $i (0 .. $#items) {
+ @newitems = @items;
+ @newperms = @perms;
+ unshift(@newperms, splice(@newitems, $i, 1));
+ permute([@newitems], [@newperms]);
}
}
}
@@ -785,9 +1246,54 @@ get those bits into your @ints array:
This method gets faster the more sparse the bit vector is.
(Courtesy of Tim Bunce and Winfried Koenig.)
+Here's a demo on how to use vec():
+
+ # vec demo
+ $vector = "\xff\x0f\xef\xfe";
+ print "Ilya's string \\xff\\x0f\\xef\\xfe represents the number ",
+ unpack("N", $vector), "\n";
+ $is_set = vec($vector, 23, 1);
+ print "Its 23rd bit is ", $is_set ? "set" : "clear", ".\n";
+ pvec($vector);
+
+ set_vec(1,1,1);
+ set_vec(3,1,1);
+ set_vec(23,1,1);
+
+ set_vec(3,1,3);
+ set_vec(3,2,3);
+ set_vec(3,4,3);
+ set_vec(3,4,7);
+ set_vec(3,8,3);
+ set_vec(3,8,7);
+
+ set_vec(0,32,17);
+ set_vec(1,32,17);
+
+ sub set_vec {
+ my ($offset, $width, $value) = @_;
+ my $vector = '';
+ vec($vector, $offset, $width) = $value;
+ print "offset=$offset width=$width value=$value\n";
+ pvec($vector);
+ }
+
+ sub pvec {
+ my $vector = shift;
+ my $bits = unpack("b*", $vector);
+ my $i = 0;
+ my $BASE = 8;
+
+ print "vector length in bytes: ", length($vector), "\n";
+ @bytes = unpack("A8" x length($vector), $bits);
+ print "bits are: @bytes\n\n";
+ }
+
=head2 Why does defined() return true on empty arrays and hashes?
-See L<perlfunc/defined> in the 5.004 release or later of Perl.
+The short story is that you should probably only use defined on scalars or
+functions, not on aggregates (arrays and hashes). See L<perlfunc/defined>
+in the 5.004 release or later of Perl for more detail.
=head1 Data: Hashes (Associative Arrays)
@@ -796,7 +1302,7 @@ See L<perlfunc/defined> in the 5.004 release or later of Perl.
Use the each() function (see L<perlfunc/each>) if you don't care
whether it's sorted:
- while (($key,$value) = each %hash) {
+ while ( ($key, $value) = each %hash) {
print "$key = $value\n";
}
@@ -862,6 +1368,7 @@ L<perllocale>).
You can look into using the DB_File module and tie() using the
$DB_BTREE hash bindings as documented in L<DB_File/"In Memory Databases">.
+The Tie::IxHash module from CPAN might also be instructive.
=head2 What's the difference between "delete" and "undef" with hashes?
@@ -953,7 +1460,7 @@ they end up doing is not what they do with ordinary hashes.
=head2 How do I reset an each() operation part-way through?
-Using C<keys %hash> in a scalar context returns the number of keys in
+Using C<keys %hash> in scalar context returns the number of keys in
the hash I<and> resets the iterator associated with the hash. You may
need to do this if you use C<last> to exit a loop early so that when you
re-enter it, the hash iterator has been reset.
@@ -1021,9 +1528,21 @@ awk's behavior.
=head2 How can I make the Perl equivalent of a C structure/C++ class/hash or array of hashes or arrays?
-Use references (documented in L<perlref>). Examples of complex data
-structures are given in L<perldsc> and L<perllol>. Examples of
-structures and object-oriented classes are in L<perltoot>.
+Usually a hash ref, perhaps like this:
+
+ $record = {
+ NAME => "Jason",
+ EMPNO => 132,
+ TITLE => "deputy peon",
+ AGE => 23,
+ SALARY => 37_000,
+ PALS => [ "Norbert", "Rhys", "Phineas"],
+ };
+
+References are documented in L<perlref> and the upcoming L<perlreftut>.
+Examples of complex data structures are given in L<perldsc> and
+L<perllol>. Examples of structures and object-oriented classes are
+in L<perltoot>.
=head2 How can I use a reference as a hash key?
@@ -1041,8 +1560,9 @@ this works fine (assuming the files are found):
print "Your kernel is GNU-zip enabled!\n";
}
-On some systems, however, you have to play tedious games with "text"
-versus "binary" files. See L<perlfunc/"binmode">.
+On some legacy systems, however, you have to play tedious games with
+"text" versus "binary" files. See L<perlfunc/"binmode">, or the upcoming
+L<perlopentut> manpage.
If you're concerned about 8-bit ASCII data, then see L<perllocale>.
@@ -1054,37 +1574,73 @@ some gotchas. See the section on Regular Expressions.
Assuming that you don't care about IEEE notations like "NaN" or
"Infinity", you probably just want to use a regular expression.
- warn "has nondigits" if /\D/;
- warn "not a whole number" unless /^\d+$/;
- warn "not an integer" unless /^-?\d+$/; # reject +3
- warn "not an integer" unless /^[+-]?\d+$/;
- warn "not a decimal number" unless /^-?\d+\.?\d*$/; # rejects .2
- warn "not a decimal number" unless /^-?(?:\d+(?:\.\d*)?|\.\d+)$/;
- warn "not a C float"
- unless /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/;
-
-Or you could check out
-http://www.perl.com/CPAN/modules/by-module/String/String-Scanf-1.1.tar.gz
-instead. The POSIX module (part of the standard Perl distribution)
-provides the C<strtol> and C<strtod> for converting strings to double
+ if (/\D/) { print "has nondigits\n" }
+ if (/^\d+$/) { print "is a whole number\n" }
+ if (/^-?\d+$/) { print "is an integer\n" }
+ if (/^[+-]?\d+$/) { print "is a +/- integer\n" }
+ if (/^-?\d+\.?\d*$/) { print "is a real number\n" }
+ if (/^-?(?:\d+(?:\.\d*)?|\.\d+)$/) { print "is a decimal number" }
+ if (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/)
+ { print "a C float" }
+
+If you're on a POSIX system, Perl's supports the C<POSIX::strtod>
+function. Its semantics are somewhat cumbersome, so here's a C<getnum>
+wrapper function for more convenient access. This function takes
+a string and returns the number it found, or C<undef> for input that
+isn't a C float. The C<is_numeric> function is a front end to C<getnum>
+if you just want to say, ``Is this a float?''
+
+ sub getnum {
+ use POSIX qw(strtod);
+ my $str = shift;
+ $str =~ s/^\s+//;
+ $str =~ s/\s+$//;
+ $! = 0;
+ my($num, $unparsed) = strtod($str);
+ if (($str eq '') || ($unparsed != 0) || $!) {
+ return undef;
+ } else {
+ return $num;
+ }
+ }
+
+ sub is_numeric { defined &getnum }
+
+Or you could check out String::Scanf which can be found at
+http://www.perl.com/CPAN/modules/by-module/String/.
+The POSIX module (part of the standard Perl distribution) provides
+the C<strtol> and C<strtod> for converting strings to double
and longs, respectively.
=head2 How do I keep persistent data across program calls?
For some specific applications, you can use one of the DBM modules.
-See L<AnyDBM_File>. More generically, you should consult the
-FreezeThaw, Storable, or Class::Eroot modules from CPAN.
+See L<AnyDBM_File>. More generically, you should consult the FreezeThaw,
+Storable, or Class::Eroot modules from CPAN. Here's one example using
+Storable's C<store> and C<retrieve> functions:
+
+ use Storable;
+ store(\%hash, "filename");
+
+ # later on...
+ $href = retrieve("filename"); # by ref
+ %hash = %{ retrieve("filename") }; # direct to hash
=head2 How do I print out or copy a recursive data structure?
-The Data::Dumper module on CPAN is nice for printing out
-data structures, and FreezeThaw for copying them. For example:
+The Data::Dumper module on CPAN (or the 5.005 release of Perl) is great
+for printing out data structures. The Storable module, found on CPAN,
+provides a function called C<dclone> that recursively copies its argument.
- use FreezeThaw qw(freeze thaw);
- $new = thaw freeze $old;
+ use Storable qw(dclone);
+ $r2 = dclone($r1);
-Where $old can be (a reference to) any kind of data structure you'd like.
-It will be deeply copied.
+Where $r1 can be a reference to any kind of data structure you'd like.
+It will be deeply copied. Because C<dclone> takes and returns references,
+you'd have to add extra punctuation if you had a hash of arrays that
+you wanted to copy.
+
+ %newhash = %{ dclone(\%oldhash) };
=head2 How do I define methods for every class/object?
@@ -1094,8 +1650,27 @@ Use the UNIVERSAL class (see L<UNIVERSAL>).
Get the Business::CreditCard module from CPAN.
+=head2 How do I pack arrays of doubles or floats for XS code?
+
+The kgbpack.c code in the PGPLOT module on CPAN does just this.
+If you're doing a lot of float or double processing, consider using
+the PDL module from CPAN instead--it makes number-crunching easy.
+
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997 Tom Christiansen and Nathan Torkington.
-All rights reserved. See L<perlfaq> for distribution information.
+Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
+All rights reserved.
+
+When included as part of the Standard Version of Perl, or as part of
+its complete documentation whether printed or otherwise, this work
+may be distributed only under the terms of Perl's Artistic Licence.
+Any distribution of this file or derivatives thereof I<outside>
+of that package require that special arrangements be made with
+copyright holder.
+
+Irrespective of its distribution, all code examples in this file
+are hereby placed into the public domain. You are permitted and
+encouraged to use this code in your own programs for fun
+or for profit as you see fit. A simple comment in the code giving
+credit would be courteous but is not required.
diff --git a/gnu/usr.bin/perl/pod/perlfaq5.pod b/gnu/usr.bin/perl/pod/perlfaq5.pod
index 03d5e6a797b..99c25b775b1 100644
--- a/gnu/usr.bin/perl/pod/perlfaq5.pod
+++ b/gnu/usr.bin/perl/pod/perlfaq5.pod
@@ -1,13 +1,13 @@
=head1 NAME
-perlfaq5 - Files and Formats ($Revision: 1.22 $, $Date: 1997/04/24 22:44:02 $)
+perlfaq5 - Files and Formats ($Revision: 1.34 $, $Date: 1999/01/08 05:46:13 $)
=head1 DESCRIPTION
This section deals with I/O and the "f" issues: filehandles, flushing,
formats, and footers.
-=head2 How do I flush/unbuffer a filehandle? Why must I do this?
+=head2 How do I flush/unbuffer an output filehandle? Why must I do this?
The C standard I/O library (stdio) normally buffers characters sent to
devices. This is done for efficiency reasons, so that there isn't a
@@ -15,7 +15,7 @@ system call for each byte. Any time you use print() or write() in
Perl, you go though this buffering. syswrite() circumvents stdio and
buffering.
-In most stdio implementations, the type of buffering and the size of
+In most stdio implementations, the type of output buffering and the size of
the buffer varies according to the type of device. Disk files are block
buffered, often with a buffer size of more than 2k. Pipes and sockets
are often buffered with a buffer size between 1/2 and 2k. Serial devices
@@ -29,10 +29,23 @@ command. This isn't as hard on your system as unbuffering, but does
get the output where you want it when you want it.
If you expect characters to get to your device when you print them there,
-you'll want to autoflush its handle, as in the older:
+you'll want to autoflush its handle.
+Use select() and the C<$|> variable to control autoflushing
+(see L<perlvar/$|> and L<perlfunc/select>):
+
+ $old_fh = select(OUTPUT_HANDLE);
+ $| = 1;
+ select($old_fh);
+
+Or using the traditional idiom:
+
+ select((select(OUTPUT_HANDLE), $| = 1)[0]);
+
+Or if don't mind slowly loading several thousand lines of module code
+just because you're afraid of the C<$|> variable:
use FileHandle;
- open(DEV, "<+/dev/tty"); # ceci n'est pas une pipe
+ open(DEV, "+</dev/tty"); # ceci n'est pas une pipe
DEV->autoflush(1);
or the newer IO::* modules:
@@ -50,45 +63,44 @@ or even this:
die "$!" unless $sock;
$sock->autoflush();
- $sock->print("GET /\015\012");
- $document = join('', $sock->getlines());
+ print $sock "GET / HTTP/1.0" . "\015\012" x 2;
+ $document = join('', <$sock>);
print "DOC IS: $document\n";
-Note the hardcoded carriage return and newline in their octal
-equivalents. This is the ONLY way (currently) to assure a proper
-flush on all platforms, including Macintosh.
+Note the bizarrely hardcoded carriage return and newline in their octal
+equivalents. This is the ONLY way (currently) to assure a proper flush
+on all platforms, including Macintosh. That the way things work in
+network programming: you really should specify the exact bit pattern
+on the network line terminator. In practice, C<"\n\n"> often works,
+but this is not portable.
-You can use select() and the C<$|> variable to control autoflushing
-(see L<perlvar/$|> and L<perlfunc/select>):
-
- $oldh = select(DEV);
- $| = 1;
- select($oldh);
-
-You'll also see code that does this without a temporary variable, as in
-
- select((select(DEV), $| = 1)[0]);
+See L<perlfaq9> for other examples of fetching URLs over the web.
=head2 How do I change one line in a file/delete a line in a file/insert a line in the middle of a file/append to the beginning of a file?
+Those are operations of a text editor. Perl is not a text editor.
+Perl is a programming language. You have to decompose the problem into
+low-level calls to read, write, open, close, and seek.
+
Although humans have an easy time thinking of a text file as being a
-sequence of lines that operates much like a stack of playing cards --
-or punch cards -- computers usually see the text file as a sequence of
-bytes. In general, there's no direct way for Perl to seek to a
-particular line of a file, insert text into a file, or remove text
-from a file.
+sequence of lines that operates much like a stack of playing cards -- or
+punch cards -- computers usually see the text file as a sequence of bytes.
+In general, there's no direct way for Perl to seek to a particular line
+of a file, insert text into a file, or remove text from a file.
-(There are exceptions in special circumstances. Replacing a sequence
-of bytes with another sequence of the same length is one. Another is
-using the C<$DB_RECNO> array bindings as documented in L<DB_File>.
-Yet another is manipulating files with all lines the same length.)
+(There are exceptions in special circumstances. You can add or remove at
+the very end of the file. Another is replacing a sequence of bytes with
+another sequence of the same length. Another is using the C<$DB_RECNO>
+array bindings as documented in L<DB_File>. Yet another is manipulating
+files with all lines the same length.)
The general solution is to create a temporary copy of the text file with
-the changes you want, then copy that over the original.
+the changes you want, then copy that over the original. This assumes
+no locking.
$old = $file;
$new = "$file.tmp.$$";
- $bak = "$file.bak";
+ $bak = "$file.orig";
open(OLD, "< $old") or die "can't open $old: $!";
open(NEW, "> $new") or die "can't open $new: $!";
@@ -115,7 +127,7 @@ platform-specific documentation that came with your port.
perl -pi -e 's/(^\s+test\s+)\d+/ $1 . ++$count /e' t/op/taint.t
# form a script
- local($^I, @ARGV) = ('.bak', glob("*.c"));
+ local($^I, @ARGV) = ('.orig', glob("*.c"));
while (<>) {
if ($. == 1) {
print "This line should appear at the top of each file\n";
@@ -157,45 +169,73 @@ proper text file, so this may report one fewer line than you expect.
}
close FILE;
+This assumes no funny games with newline translations.
+
=head2 How do I make a temporary file name?
-Use the process ID and/or the current time-value. If you need to have
-many temporary files in one process, use a counter:
+Use the C<new_tmpfile> class method from the IO::File module to get a
+filehandle opened for reading and writing. Use this if you don't
+need to know the file's name.
+
+ use IO::File;
+ $fh = IO::File->new_tmpfile()
+ or die "Unable to make new temporary file: $!";
+
+Or you can use the C<tmpnam> function from the POSIX module to get a
+filename that you then open yourself. Use this if you do need to know
+the file's name.
+
+ use Fcntl;
+ use POSIX qw(tmpnam);
+
+ # try new temporary filenames until we get one that didn't already
+ # exist; the check should be unnecessary, but you can't be too careful
+ do { $name = tmpnam() }
+ until sysopen(FH, $name, O_RDWR|O_CREAT|O_EXCL);
+
+ # install atexit-style handler so that when we exit or die,
+ # we automatically delete this temporary file
+ END { unlink($name) or die "Couldn't unlink $name : $!" }
+
+ # now go on to use the file ...
+
+If you're committed to doing this by hand, use the process ID and/or
+the current time-value. If you need to have many temporary files in
+one process, use a counter:
BEGIN {
- use IO::File;
use Fcntl;
my $temp_dir = -d '/tmp' ? '/tmp' : $ENV{TMP} || $ENV{TEMP};
my $base_name = sprintf("%s/%d-%d-0000", $temp_dir, $$, time());
sub temp_file {
- my $fh = undef;
+ local *FH;
my $count = 0;
- until (defined($fh) || $count > 100) {
+ until (defined(fileno(FH)) || $count++ > 100) {
$base_name =~ s/-(\d+)$/"-" . (1 + $1)/e;
- $fh = IO::File->new($base_name, O_WRONLY|O_EXCL|O_CREAT, 0644)
+ sysopen(FH, $base_name, O_WRONLY|O_EXCL|O_CREAT);
}
- if (defined($fh)) {
- return ($fh, $base_name);
+ if (defined(fileno(FH))
+ return (*FH, $base_name);
} else {
return ();
}
}
}
-Or you could simply use IO::Handle::new_tmpfile.
-
=head2 How can I manipulate fixed-record-length files?
-The most efficient way is using pack() and unpack(). This is faster
-than using substr(). Here is a sample chunk of code to break up and
-put back together again some fixed-format input lines, in this case
-from the output of a normal, Berkeley-style ps:
+The most efficient way is using pack() and unpack(). This is faster than
+using substr() when taking many, many strings. It is slower for just a few.
+
+Here is a sample chunk of code to break up and put back together again
+some fixed-format input lines, in this case from the output of a normal,
+Berkeley-style ps:
# sample input line:
# 15158 p5 T 0:00 perl /home/tchrist/scripts/now-what
$PS_T = 'A6 A4 A7 A5 A*';
open(PS, "ps|");
- $_ = <PS>; print;
+ print scalar <PS>;
while (<PS>) {
($pid, $tt, $stat, $time, $command) = unpack($PS_T, $_);
for $var (qw!pid tt stat time command!) {
@@ -205,61 +245,178 @@ from the output of a normal, Berkeley-style ps:
"\n";
}
+We've used C<$$var> in a way that forbidden by C<use strict 'refs'>.
+That is, we've promoted a string to a scalar variable reference using
+symbolic references. This is ok in small programs, but doesn't scale
+well. It also only works on global variables, not lexicals.
+
=head2 How can I make a filehandle local to a subroutine? How do I pass filehandles between subroutines? How do I make an array of filehandles?
-You may have some success with typeglobs, as we always had to use
-in days of old:
+The fastest, simplest, and most direct way is to localize the typeglob
+of the filehandle in question:
- local(*FH);
+ local *TmpHandle;
-But while still supported, that isn't the best to go about getting
-local filehandles. Typeglobs have their drawbacks. You may well want
-to use the C<FileHandle> module, which creates new filehandles for you
-(see L<FileHandle>):
+Typeglobs are fast (especially compared with the alternatives) and
+reasonably easy to use, but they also have one subtle drawback. If you
+had, for example, a function named TmpHandle(), or a variable named
+%TmpHandle, you just hid it from yourself.
- use FileHandle;
sub findme {
- my $fh = FileHandle->new();
- open($fh, "</etc/hosts") or die "no /etc/hosts: $!";
- while (<$fh>) {
+ local *HostFile;
+ open(HostFile, "</etc/hosts") or die "no /etc/hosts: $!";
+ local $_; # <- VERY IMPORTANT
+ while (<HostFile>) {
print if /\b127\.(0\.0\.)?1\b/;
}
- # $fh automatically closes/disappears here
+ # *HostFile automatically closes/disappears here
}
-Internally, Perl believes filehandles to be of class IO::Handle. You
-may use that module directly if you'd like (see L<IO::Handle>), or
-one of its more specific derived classes.
+Here's how to use this in a loop to open and store a bunch of
+filehandles. We'll use as values of the hash an ordered
+pair to make it easy to sort the hash in insertion order.
-Once you have IO::File or FileHandle objects, you can pass them
-between subroutines or store them in hashes as you would any other
-scalar values:
+ @names = qw(motd termcap passwd hosts);
+ my $i = 0;
+ foreach $filename (@names) {
+ local *FH;
+ open(FH, "/etc/$filename") || die "$filename: $!";
+ $file{$filename} = [ $i++, *FH ];
+ }
+
+ # Using the filehandles in the array
+ foreach $name (sort { $file{$a}[0] <=> $file{$b}[0] } keys %file) {
+ my $fh = $file{$name}[1];
+ my $line = <$fh>;
+ print "$name $. $line";
+ }
+
+For passing filehandles to functions, the easiest way is to
+preface them with a star, as in func(*STDIN). See L<perlfaq7/"Passing
+Filehandles"> for details.
+
+If you want to create many anonymous handles, you should check out the
+Symbol, FileHandle, or IO::Handle (etc.) modules. Here's the equivalent
+code with Symbol::gensym, which is reasonably light-weight:
+
+ foreach $filename (@names) {
+ use Symbol;
+ my $fh = gensym();
+ open($fh, "/etc/$filename") || die "open /etc/$filename: $!";
+ $file{$filename} = [ $i++, $fh ];
+ }
+
+Or here using the semi-object-oriented FileHandle module, which certainly
+isn't light-weight:
use FileHandle;
- # Storing filehandles in a hash and array
foreach $filename (@names) {
- my $fh = new FileHandle($filename) or die;
- $file{$filename} = $fh;
- push(@files, $fh);
+ my $fh = FileHandle->new("/etc/$filename") or die "$filename: $!";
+ $file{$filename} = [ $i++, $fh ];
}
- # Using the filehandles in the array
- foreach $file (@files) {
- print $file "Testing\n";
+Please understand that whether the filehandle happens to be a (probably
+localized) typeglob or an anonymous handle from one of the modules,
+in no way affects the bizarre rules for managing indirect handles.
+See the next question.
+
+=head2 How can I use a filehandle indirectly?
+
+An indirect filehandle is using something other than a symbol
+in a place that a filehandle is expected. Here are ways
+to get those:
+
+ $fh = SOME_FH; # bareword is strict-subs hostile
+ $fh = "SOME_FH"; # strict-refs hostile; same package only
+ $fh = *SOME_FH; # typeglob
+ $fh = \*SOME_FH; # ref to typeglob (bless-able)
+ $fh = *SOME_FH{IO}; # blessed IO::Handle from *SOME_FH typeglob
+
+Or to use the C<new> method from the FileHandle or IO modules to
+create an anonymous filehandle, store that in a scalar variable,
+and use it as though it were a normal filehandle.
+
+ use FileHandle;
+ $fh = FileHandle->new();
+
+ use IO::Handle; # 5.004 or higher
+ $fh = IO::Handle->new();
+
+Then use any of those as you would a normal filehandle. Anywhere that
+Perl is expecting a filehandle, an indirect filehandle may be used
+instead. An indirect filehandle is just a scalar variable that contains
+a filehandle. Functions like C<print>, C<open>, C<seek>, or
+the C<E<lt>FHE<gt>> diamond operator will accept either a read filehandle
+or a scalar variable containing one:
+
+ ($ifh, $ofh, $efh) = (*STDIN, *STDOUT, *STDERR);
+ print $ofh "Type it: ";
+ $got = <$ifh>
+ print $efh "What was that: $got";
+
+If you're passing a filehandle to a function, you can write
+the function in two ways:
+
+ sub accept_fh {
+ my $fh = shift;
+ print $fh "Sending to indirect filehandle\n";
}
- # You have to do the { } ugliness when you're specifying the
- # filehandle by anything other than a simple scalar variable.
- print { $files[2] } "Testing\n";
+Or it can localize a typeglob and use the filehandle directly:
- # Passing filehandles to subroutines
- sub debug {
- my $filehandle = shift;
- printf $filehandle "DEBUG: ", @_;
+ sub accept_fh {
+ local *FH = shift;
+ print FH "Sending to localized filehandle\n";
}
- debug($fh, "Testing\n");
+Both styles work with either objects or typeglobs of real filehandles.
+(They might also work with strings under some circumstances, but this
+is risky.)
+
+ accept_fh(*STDOUT);
+ accept_fh($handle);
+
+In the examples above, we assigned the filehandle to a scalar variable
+before using it. That is because only simple scalar variables,
+not expressions or subscripts into hashes or arrays, can be used with
+built-ins like C<print>, C<printf>, or the diamond operator. These are
+illegal and won't even compile:
+
+ @fd = (*STDIN, *STDOUT, *STDERR);
+ print $fd[1] "Type it: "; # WRONG
+ $got = <$fd[0]> # WRONG
+ print $fd[2] "What was that: $got"; # WRONG
+
+With C<print> and C<printf>, you get around this by using a block and
+an expression where you would place the filehandle:
+
+ print { $fd[1] } "funny stuff\n";
+ printf { $fd[1] } "Pity the poor %x.\n", 3_735_928_559;
+ # Pity the poor deadbeef.
+
+That block is a proper block like any other, so you can put more
+complicated code there. This sends the message out to one of two places:
+
+ $ok = -x "/bin/cat";
+ print { $ok ? $fd[1] : $fd[2] } "cat stat $ok\n";
+ print { $fd[ 1+ ($ok || 0) ] } "cat stat $ok\n";
+
+This approach of treating C<print> and C<printf> like object methods
+calls doesn't work for the diamond operator. That's because it's a
+real operator, not just a function with a comma-less argument. Assuming
+you've been storing typeglobs in your structure as we did above, you
+can use the built-in function named C<readline> to reads a record just
+as C<E<lt>E<gt>> does. Given the initialization shown above for @fd, this
+would work, but only because readline() require a typeglob. It doesn't
+work with objects or strings, which might be a bug we haven't fixed yet.
+
+ $got = readline($fd[0]);
+
+Let it be noted that the flakiness of indirect filehandles is not
+related to whether they're strings, typeglobs, objects, or anything else.
+It's the syntax of the fundamental operators. Playing the object
+game doesn't help you at all here.
=head2 How can I set up a footer format to be used with write()?
@@ -268,7 +425,7 @@ techniques to make it possible for the intrepid hacker.
=head2 How can I write() into a string?
-See L<perlform> for an swrite() function.
+See L<perlform/"Accessing Formatting Internals"> for an swrite() function.
=head2 How can I output my numbers with commas added?
@@ -276,7 +433,7 @@ This one will do it for you:
sub commify {
local $_ = shift;
- 1 while s/^(-?\d+)(\d{3})/$1,$2/;
+ 1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
return $_;
}
@@ -287,7 +444,7 @@ This one will do it for you:
You can't just:
- s/^(-?\d+)(\d{3})/$1,$2/g;
+ s/^([-+]?\d+)(\d{3})/$1,$2/g;
because you have to put the comma in and then recalculate your
position.
@@ -301,7 +458,7 @@ whatever:
my $input = shift;
$input = reverse $input;
$input =~ s<(\d\d\d)(?=\d)(?!\d*\.)><$1,>g;
- return reverse $input;
+ return scalar reverse $input;
}
=head2 How can I translate tildes (~) in a filename?
@@ -326,25 +483,76 @@ Within Perl, you may use this directly:
: ( $ENV{HOME} || $ENV{LOGDIR} )
}ex;
-=head2 How come when I open the file read-write it wipes it out?
+=head2 How come when I open a file read-write it wipes it out?
Because you're using something like this, which truncates the file and
I<then> gives you read-write access:
- open(FH, "+> /path/name"); # WRONG
+ open(FH, "+> /path/name"); # WRONG (almost always)
Whoops. You should instead use this, which will fail if the file
-doesn't exist.
+doesn't exist. Using "E<gt>" always clobbers or creates.
+Using "E<lt>" never does either. The "+" doesn't change this.
- open(FH, "+< /path/name"); # open for update
+Here are examples of many kinds of file opens. Those using sysopen()
+all assume
-If this is an issue, try:
+ use Fcntl;
- sysopen(FH, "/path/name", O_RDWR|O_CREAT, 0644);
+To open file for reading:
-Error checking is left as an exercise for the reader.
+ open(FH, "< $path") || die $!;
+ sysopen(FH, $path, O_RDONLY) || die $!;
+
+To open file for writing, create new file if needed or else truncate old file:
+
+ open(FH, "> $path") || die $!;
+ sysopen(FH, $path, O_WRONLY|O_TRUNC|O_CREAT) || die $!;
+ sysopen(FH, $path, O_WRONLY|O_TRUNC|O_CREAT, 0666) || die $!;
+
+To open file for writing, create new file, file must not exist:
+
+ sysopen(FH, $path, O_WRONLY|O_EXCL|O_CREAT) || die $!;
+ sysopen(FH, $path, O_WRONLY|O_EXCL|O_CREAT, 0666) || die $!;
+
+To open file for appending, create if necessary:
+
+ open(FH, ">> $path") || die $!;
+ sysopen(FH, $path, O_WRONLY|O_APPEND|O_CREAT) || die $!;
+ sysopen(FH, $path, O_WRONLY|O_APPEND|O_CREAT, 0666) || die $!;
+
+To open file for appending, file must exist:
+
+ sysopen(FH, $path, O_WRONLY|O_APPEND) || die $!;
+
+To open file for update, file must exist:
+
+ open(FH, "+< $path") || die $!;
+ sysopen(FH, $path, O_RDWR) || die $!;
+
+To open file for update, create file if necessary:
+
+ sysopen(FH, $path, O_RDWR|O_CREAT) || die $!;
+ sysopen(FH, $path, O_RDWR|O_CREAT, 0666) || die $!;
+
+To open file for update, file must not exist:
+
+ sysopen(FH, $path, O_RDWR|O_EXCL|O_CREAT) || die $!;
+ sysopen(FH, $path, O_RDWR|O_EXCL|O_CREAT, 0666) || die $!;
-=head2 Why do I sometimes get an "Argument list too long" when I use <*>?
+To open a file without blocking, creating if necessary:
+
+ sysopen(FH, "/tmp/somefile", O_WRONLY|O_NDELAY|O_CREAT)
+ or die "can't open /tmp/somefile: $!":
+
+Be warned that neither creation nor deletion of files is guaranteed to
+be an atomic operation over NFS. That is, two processes might both
+successful create or unlink the same file! Therefore O_EXCL
+isn't so exclusive as you might wish.
+
+See also the new L<perlopentut> if you have it (new for 5.006).
+
+=head2 Why do I sometimes get an "Argument list too long" when I use E<lt>*E<gt>?
The C<E<lt>E<gt>> operator performs a globbing operation (see above).
By default glob() forks csh(1) to do the actual glob expansion, but
@@ -352,9 +560,9 @@ csh can't handle more than 127 items and so gives the error message
C<Argument list too long>. People who installed tcsh as csh won't
have this problem, but their users may be surprised by it.
-To get around this, either do the glob yourself with C<Dirhandle>s and
+To get around this, either do the glob yourself with readdir() and
patterns, or use a module like Glob::KGlob, one that doesn't use the
-shell to do globbing.
+shell to do globbing. This is expected to be fixed soon.
=head2 Is there a leak/bug in glob()?
@@ -373,15 +581,28 @@ trailing null byte on the name to make perl leave it alone:
sub safe_filename {
local $_ = shift;
- return m#^/#
- ? "$_\0"
- : "./$_\0";
+ s#^([^./])#./$1#;
+ $_ .= "\0";
+ return $_;
}
- $fn = safe_filename("<<<something really wicked ");
- open(FH, "> $fn") or "couldn't open $fn: $!";
+ $badpath = "<<<something really wicked ";
+ $fn = safe_filename($badpath");
+ open(FH, "> $fn") or "couldn't open $badpath: $!";
-You could also use the sysopen() function (see L<perlfunc/sysopen>).
+This assumes that you are using POSIX (portable operating systems
+interface) paths. If you are on a closed, non-portable, proprietary
+system, you may have to adjust the C<"./"> above.
+
+It would be a lot clearer to use sysopen(), though:
+
+ use Fcntl;
+ $badpath = "<<<something really wicked ";
+ open (FH, $badpath, O_WRONLY | O_CREAT | O_TRUNC)
+ or die "can't open $badpath: $!";
+
+For more information, see also the new L<perlopentut> if you have it
+(new for 5.006).
=head2 How can I reliably rename a file?
@@ -398,6 +619,8 @@ then delete the old one. This isn't really the same semantics as a
real rename(), though, which preserves metainformation like
permissions, timestamps, inode info, etc.
+The newer version of File::Copy exports a move() function.
+
=head2 How can I lock a file?
Perl's builtin flock() function (see L<perlfunc> for details) will call
@@ -426,13 +649,12 @@ build Perl. See the flock entry of L<perlfunc>, and the F<INSTALL>
file in the source distribution for information on building Perl to do
this.
-=back
+For more information on file locking, see also L<perlopentut/"File
+Locking"> if you have it (new for 5.006).
-The CPAN module File::Lock offers similar functionality and (if you
-have dynamic loading) won't require you to rebuild perl if your
-flock() can't lock network files.
+=back
-=head2 What can't I just open(FH, ">file.lock")?
+=head2 Why can't I just open(FH, ">file.lock")?
A common bit of code B<NOT TO USE> is this:
@@ -443,28 +665,32 @@ This is a classic race condition: you take two steps to do something
which must be done in one. That's why computer hardware provides an
atomic test-and-set instruction. In theory, this "ought" to work:
- sysopen(FH, "file.lock", O_WRONLY|O_EXCL|O_CREAT, 0644)
+ sysopen(FH, "file.lock", O_WRONLY|O_EXCL|O_CREAT)
or die "can't open file.lock: $!":
except that lamentably, file creation (and deletion) is not atomic
over NFS, so this won't work (at least, not every time) over the net.
-Various schemes involving involving link() have been suggested, but
+Various schemes involving link() have been suggested, but
these tend to involve busy-wait, which is also subdesirable.
=head2 I still don't get locking. I just want to increment the number in the file. How can I do this?
Didn't anyone ever tell you web-page hit counters were useless?
+They don't count number of hits, they're a waste of time, and they serve
+only to stroke the writer's vanity. Better to pick a random number.
+It's more realistic.
-Anyway, this is what to do:
+Anyway, this is what you can do if you can't help yourself.
- use Fcntl;
- sysopen(FH, "numfile", O_RDWR|O_CREAT, 0644) or die "can't open numfile: $!";
- flock(FH, 2) or die "can't flock numfile: $!";
+ use Fcntl ':flock';
+ sysopen(FH, "numfile", O_RDWR|O_CREAT) or die "can't open numfile: $!";
+ flock(FH, LOCK_EX) or die "can't flock numfile: $!";
$num = <FH> || 0;
seek(FH, 0, 0) or die "can't rewind numfile: $!";
truncate(FH, 0) or die "can't truncate numfile: $!";
(print FH $num+1, "\n") or die "can't write numfile: $!";
- # DO NOT UNLOCK THIS UNTIL YOU CLOSE
+ # Perl as of 5.004 automatically flushes before unlocking
+ flock(FH, LOCK_UN) or die "can't flock numfile: $!";
close FH or die "can't close numfile: $!";
Here's a much better web-page hit counter:
@@ -489,17 +715,13 @@ like this:
seek(FH, $recno * $RECSIZE, 0);
read(FH, $record, $RECSIZE) == $RECSIZE || die "can't read record $recno: $!";
# munge the record
- seek(FH, $recno * $RECSIZE, 0);
+ seek(FH, -$RECSIZE, 1);
print FH $record;
close FH;
Locking and error checking are left as an exercise for the reader.
Don't forget them, or you'll be quite sorry.
-Don't forget to set binmode() under DOS-like platforms when operating
-on files that have anything other than straight text in them. See the
-docs on open() and on binmode() for more details.
-
=head2 How do I get a file's timestamp in perl?
If you want to retrieve the time at which the file was last read,
@@ -514,17 +736,21 @@ into human-readable form.
Here's an example:
$write_secs = (stat($file))[9];
- print "file $file updated at ", scalar(localtime($file)), "\n";
+ printf "file %s updated at %s\n", $file,
+ scalar localtime($write_secs);
If you prefer something more legible, use the File::stat module
(part of the standard distribution in version 5.004 and later):
+ # error checking left as an exercise for reader.
use File::stat;
use Time::localtime;
$date_string = ctime(stat($file)->mtime);
print "file $file updated at $date_string\n";
-Error checking is left as an exercise for the reader.
+The POSIX::strftime() approach has the benefit of being,
+in theory, independent of the current locale. See L<perllocale>
+for details.
=head2 How do I set a file's timestamp in perl?
@@ -540,7 +766,7 @@ of them.
($atime, $mtime) = (stat($timestamp))[8,9];
utime $atime, $mtime, @ARGV;
-Error checking is left as an exercise for the reader.
+Error checking is, as usual, left as an exercise for the reader.
Note that utime() currently doesn't work correctly with Win95/NT
ports. A bug has been reported. Check it carefully before using
@@ -558,21 +784,29 @@ of the multiplexing:
open (FH, "| tee file1 file2 file3");
-Otherwise you'll have to write your own multiplexing print function --
-or your own tee program -- or use Tom Christiansen's, at
-http://www.perl.com/CPAN/authors/id/TOMC/scripts/tct.gz, which is
-written in Perl.
+Or even:
+
+ # make STDOUT go to three files, plus original STDOUT
+ open (STDOUT, "| tee file1 file2 file3") or die "Teeing off: $!\n";
+ print "whatever\n" or die "Writing: $!\n";
+ close(STDOUT) or die "Closing: $!\n";
-In theory a IO::Tee class could be written, but to date we haven't
-seen such.
+Otherwise you'll have to write your own multiplexing print
+function -- or your own tee program -- or use Tom Christiansen's,
+at http://www.perl.com/CPAN/authors/id/TOMC/scripts/tct.gz, which is
+written in Perl and offers much greater functionality
+than the stock version.
=head2 How can I read in a file by paragraphs?
-Use the C<$\> variable (see L<perlvar> for details). You can either
+Use the C<$/> variable (see L<perlvar> for details). You can either
set it to C<""> to eliminate empty paragraphs (C<"abc\n\n\n\ndef">,
for instance, gets treated as two paragraphs and not three), or
C<"\n\n"> to accept empty paragraphs.
+Note that a blank line must have no blanks in it. Thus C<"fred\n
+\nstuff\n\n"> is one paragraph, but C<"fred\n\nstuff\n\n"> is two.
+
=head2 How can I read a single character from a file? From the keyboard?
You can use the builtin C<getc()> function for most filehandles, but
@@ -580,8 +814,9 @@ it won't (easily) work on a terminal device. For STDIN, either use
the Term::ReadKey module from CPAN, or use the sample code in
L<perlfunc/getc>.
-If your system supports POSIX, you can use the following code, which
-you'll note turns off echo processing as well.
+If your system supports the portable operating system programming
+interface (POSIX), you can use the following code, which you'll note
+turns off echo processing as well.
#!/usr/bin/perl -w
use strict;
@@ -632,7 +867,8 @@ you'll note turns off echo processing as well.
END { cooked() }
-The Term::ReadKey module from CPAN may be easier to use:
+The Term::ReadKey module from CPAN may be easier to use. Recent version
+include also support for non-portable systems as well.
use Term::ReadKey;
open(TTY, "</dev/tty");
@@ -643,7 +879,7 @@ The Term::ReadKey module from CPAN may be easier to use:
printf "\nYou said %s, char number %03d\n",
$key, ord $key;
-For DOS systems, Dan Carson <dbc@tc.fluke.COM> reports the following:
+For legacy DOS systems, Dan Carson <dbc@tc.fluke.COM> reports the following:
To put the PC in "raw" mode, use ioctl with some magic numbers gleaned
from msdos.c (Perl source file) and Ralf Brown's interrupt list (comes
@@ -689,9 +925,14 @@ table:
This is all trial and error I did a long time ago, I hope I'm reading the
file that worked.
-=head2 How can I tell if there's a character waiting on a filehandle?
+=head2 How can I tell whether there's a character waiting on a filehandle?
+
+The very first thing you should do is look into getting the Term::ReadKey
+extension from CPAN. As we mentioned earlier, it now even has limited
+support for non-portable (read: not open systems, closed, proprietary,
+not POSIX, not Unix, etc) systems.
-You should check out the Frequently Asked Questions list in
+You should also check out the Frequently Asked Questions list in
comp.unix.* for things like this: the answer is essentially the same.
It's very system dependent. Here's one solution that works on BSD
systems:
@@ -702,29 +943,46 @@ systems:
return $nfd = select($rin,undef,undef,0);
}
-You should look into getting the Term::ReadKey extension from CPAN.
+If you want to find out how many characters are waiting, there's
+also the FIONREAD ioctl call to be looked at. The I<h2ph> tool that
+comes with Perl tries to convert C include files to Perl code, which
+can be C<require>d. FIONREAD ends up defined as a function in the
+I<sys/ioctl.ph> file:
-=head2 How do I open a file without blocking?
+ require 'sys/ioctl.ph';
-You need to use the O_NDELAY or O_NONBLOCK flag from the Fcntl module
-in conjunction with sysopen():
+ $size = pack("L", 0);
+ ioctl(FH, FIONREAD(), $size) or die "Couldn't call ioctl: $!\n";
+ $size = unpack("L", $size);
- use Fcntl;
- sysopen(FH, "/tmp/somefile", O_WRONLY|O_NDELAY|O_CREAT, 0644)
- or die "can't open /tmp/somefile: $!":
+If I<h2ph> wasn't installed or doesn't work for you, you can
+I<grep> the include files by hand:
-=head2 How do I create a file only if it doesn't exist?
+ % grep FIONREAD /usr/include/*/*
+ /usr/include/asm/ioctls.h:#define FIONREAD 0x541B
-You need to use the O_CREAT and O_EXCL flags from the Fcntl module in
-conjunction with sysopen():
+Or write a small C program using the editor of champions:
- use Fcntl;
- sysopen(FH, "/tmp/somefile", O_WRONLY|O_EXCL|O_CREAT, 0644)
- or die "can't open /tmp/somefile: $!":
+ % cat > fionread.c
+ #include <sys/ioctl.h>
+ main() {
+ printf("%#08x\n", FIONREAD);
+ }
+ ^D
+ % cc -o fionread fionread.c
+ % ./fionread
+ 0x4004667f
-Be warned that neither creation nor deletion of files is guaranteed to
-be an atomic operation over NFS. That is, two processes might both
-successful create or unlink the same file!
+And then hard-code it, leaving porting as an exercise to your successor.
+
+ $FIONREAD = 0x4004667f; # XXX: opsys dependent
+
+ $size = pack("L", 0);
+ ioctl(FH, $FIONREAD, $size) or die "Couldn't call ioctl: $!\n";
+ $size = unpack("L", $size);
+
+FIONREAD requires a filehandle connected to a stream, meaning sockets,
+pipes, and tty devices work, but I<not> files.
=head2 How do I do a C<tail -f> in perl?
@@ -752,6 +1010,8 @@ the clearerr() method, which can remove the end of file condition on a
filehandle. The method: read until end of file, clearerr(), read some
more. Lather, rinse, repeat.
+There's also a File::Tail module from CPAN.
+
=head2 How do I dup() a filehandle in Perl?
If you check L<perlfunc/open>, you'll see that several of the ways
@@ -765,7 +1025,12 @@ Or even with a literal numeric descriptor:
$fd = $ENV{MHCONTEXTFD};
open(MHCONTEXT, "<&=$fd"); # like fdopen(3S)
-Error checking has been left as an exercise for the reader.
+Note that "E<lt>&STDIN" makes a copy, but "E<lt>&=STDIN" make
+an alias. That means if you close an aliased handle, all
+aliases become inaccessible. This is not true with
+a copied one.
+
+Error checking, as always, has been left as an exercise for the reader.
=head2 How do I close a file descriptor by number?
@@ -785,24 +1050,27 @@ Remember that within double quoted strings ("like\this"), the
backslash is an escape character. The full list of these is in
L<perlop/Quote and Quote-like Operators>. Unsurprisingly, you don't
have a file called "c:(tab)emp(formfeed)oo" or
-"c:(tab)emp(formfeed)oo.exe" on your DOS filesystem.
+"c:(tab)emp(formfeed)oo.exe" on your legacy DOS filesystem.
Either single-quote your strings, or (preferably) use forward slashes.
Since all DOS and Windows versions since something like MS-DOS 2.0 or so
have treated C</> and C<\> the same in a path, you might as well use the
one that doesn't clash with Perl -- or the POSIX shell, ANSI C and C++,
-awk, Tcl, Java, or Python, just to mention a few.
+awk, Tcl, Java, or Python, just to mention a few. POSIX paths
+are more portable, too.
=head2 Why doesn't glob("*.*") get all the files?
Because even on non-Unix ports, Perl's glob function follows standard
Unix globbing semantics. You'll need C<glob("*")> to get all (non-hidden)
-files.
+files. This makes glob() portable even to legacy systems. Your
+port may include proprietary globbing functions as well. Check its
+documentation for details.
=head2 Why does Perl let me delete read-only files? Why does C<-i> clobber protected files? Isn't this a bug in Perl?
This is elaborately and painstakingly described in the "Far More Than
-You Every Wanted To Know" in
+You Ever Wanted To Know" in
http://www.perl.com/CPAN/doc/FMTEYEWTK/file-dir-perms .
The executive summary: learn how your filesystem works. The
@@ -821,10 +1089,45 @@ Here's an algorithm from the Camel Book:
rand($.) < 1 && ($line = $_) while <>;
This has a significant advantage in space over reading the whole
-file in.
+file in. A simple proof by induction is available upon
+request if you doubt its correctness.
+
+=head2 Why do I get weird spaces when I print an array of lines?
+
+Saying
+
+ print "@lines\n";
+
+joins together the elements of C<@lines> with a space between them.
+If C<@lines> were C<("little", "fluffy", "clouds")> then the above
+statement would print:
+
+ little fluffy clouds
+
+but if each element of C<@lines> was a line of text, ending a newline
+character C<("little\n", "fluffy\n", "clouds\n")> then it would print:
+
+ little
+ fluffy
+ clouds
+
+If your array contains lines, just print them:
+
+ print @lines;
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997 Tom Christiansen and Nathan Torkington.
-All rights reserved. See L<perlfaq> for distribution information.
+Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
+All rights reserved.
+
+When included as an integrated part of the Standard Distribution
+of Perl or of its documentation (printed or otherwise), this work is
+covered under Perl's Artistic Licence. For separate distributions of
+all or part of this FAQ outside of that, see L<perlfaq>.
+
+Irrespective of its distribution, all code examples here are public
+domain. You are permitted and encouraged to use this code and any
+derivatives thereof in your own programs for fun or for profit as you
+see fit. A simple comment in the code giving credit to the FAQ would
+be courteous but is not required.
diff --git a/gnu/usr.bin/perl/pod/perlfaq6.pod b/gnu/usr.bin/perl/pod/perlfaq6.pod
index 535e4644551..234570df47c 100644
--- a/gnu/usr.bin/perl/pod/perlfaq6.pod
+++ b/gnu/usr.bin/perl/pod/perlfaq6.pod
@@ -1,6 +1,6 @@
=head1 NAME
-perlfaq6 - Regexps ($Revision: 1.17 $, $Date: 1997/04/24 22:44:10 $)
+perlfaq6 - Regexps ($Revision: 1.25 $, $Date: 1999/01/08 04:50:47 $)
=head1 DESCRIPTION
@@ -25,7 +25,7 @@ comments.
# turn the line into the first word, a colon, and the
# number of characters on the rest of the line
- s/^(\w+)(.*)/ lc($1) . ":" . length($2) /ge;
+ s/^(\w+)(.*)/ lc($1) . ":" . length($2) /meg;
=item Comments Inside the Regexp
@@ -69,8 +69,9 @@ delimiter within the pattern:
=head2 I'm having trouble matching over more than one line. What's wrong?
-Either you don't have newlines in your string, or you aren't using the
-correct modifier(s) on your pattern.
+Either you don't have more than one line in the string you're looking at
+(probably), or else you aren't using the correct modifier(s) on your
+pattern (possibly).
There are many ways to get multiline data into a string. If you want
it to happen automatically while reading input, you'll want to set $/
@@ -94,7 +95,7 @@ record read in.
$/ = ''; # read in more whole paragraph, not just one line
while ( <> ) {
- while ( /\b(\w\S+)(\s+\1)+\b/gi ) {
+ while ( /\b([\w'-]+)(\s+\1)+\b/gi ) { # word starts alpha
print "Duplicate $1 at paragraph $.\n";
}
}
@@ -127,12 +128,22 @@ L<perlop>):
If you wanted text and not lines, you would use
- perl -0777 -pe 'print "$1\n" while /START(.*?)END/gs' file1 file2 ...
+ perl -0777 -ne 'print "$1\n" while /START(.*?)END/gs' file1 file2 ...
But if you want nested occurrences of C<START> through C<END>, you'll
run up against the problem described in the question in this section
on matching balanced text.
+Here's another example of using C<..>:
+
+ while (<>) {
+ $in_header = 1 .. /^$/;
+ $in_body = /^$/ .. eof();
+ # now choose between them
+ } continue {
+ reset if eof(); # fix $.
+ }
+
=head2 I put a regular expression into $/ but it didn't work. What's wrong?
$/ must be a string, not a regular expression. Awk has to be better
@@ -211,7 +222,7 @@ This prints:
this is a SUcCESS case
-=head2 How can I make C<\w> match accented characters?
+=head2 How can I make C<\w> match national character sets?
See L<perllocale>.
@@ -376,48 +387,31 @@ See the module String::Approx available from CPAN.
=head2 How do I efficiently match many regular expressions at once?
-The following is super-inefficient:
-
- while (<FH>) {
- foreach $pat (@patterns) {
- if ( /$pat/ ) {
- # do something
- }
- }
- }
+The following is extremely inefficient:
-Instead, you either need to use one of the experimental Regexp extension
-modules from CPAN (which might well be overkill for your purposes),
-or else put together something like this, inspired from a routine
-in Jeffrey Friedl's book:
-
- sub _bm_build {
- my $condition = shift;
- my @regexp = @_; # this MUST not be local(); need my()
- my $expr = join $condition => map { "m/\$regexp[$_]/o" } (0..$#regexp);
- my $match_func = eval "sub { $expr }";
- die if $@; # propagate $@; this shouldn't happen!
- return $match_func;
- }
-
- sub bm_and { _bm_build('&&', @_) }
- sub bm_or { _bm_build('||', @_) }
-
- $f1 = bm_and qw{
- xterm
- (?i)window
- };
-
- $f2 = bm_or qw{
- \b[Ff]ree\b
- \bBSD\B
- (?i)sys(tem)?\s*[V5]\b
- };
-
- # feed me /etc/termcap, prolly
- while ( <> ) {
- print "1: $_" if &$f1;
- print "2: $_" if &$f2;
+ # slow but obvious way
+ @popstates = qw(CO ON MI WI MN);
+ while (defined($line = <>)) {
+ for $state (@popstates) {
+ if ($line =~ /\b$state\b/i) {
+ print $line;
+ last;
+ }
+ }
+ }
+
+That's because Perl has to recompile all those patterns for each of
+the lines of the file. As of the 5.005 release, there's a much better
+approach, one which makes use of the new C<qr//> operator:
+
+ # use spiffy new qr// operator, with /i flag even
+ use 5.005;
+ @popstates = qw(CO ON MI WI MN);
+ @poppats = map { qr/\b$_\b/i } @popstates;
+ while (defined($line = <>)) {
+ for $patobj (@poppats) {
+ print $line if $line =~ /$patobj/;
+ }
}
=head2 Why don't word-boundary searches with C<\b> work for me?
@@ -449,22 +443,24 @@ not "this" or "island".
=head2 Why does using $&, $`, or $' slow my program down?
-Because once Perl sees that you need one of these variables anywhere
-in the program, it has to provide them on each and every pattern
-match. The same mechanism that handles these provides for the use of
-$1, $2, etc., so you pay the same price for each regexp that contains
-capturing parentheses. But if you never use $&, etc., in your script,
-then regexps I<without> capturing parentheses won't be penalized. So
-avoid $&, $', and $` if you can, but if you can't (and some algorithms
-really appreciate them), once you've used them once, use them at will,
-because you've already paid the price.
+Because once Perl sees that you need one of these variables anywhere in
+the program, it has to provide them on each and every pattern match.
+The same mechanism that handles these provides for the use of $1, $2,
+etc., so you pay the same price for each regexp that contains capturing
+parentheses. But if you never use $&, etc., in your script, then regexps
+I<without> capturing parentheses won't be penalized. So avoid $&, $',
+and $` if you can, but if you can't, once you've used them at all, use
+them at will because you've already paid the price. Remember that some
+algorithms really appreciate them. As of the 5.005 release. the $&
+variable is no longer "expensive" the way the other two are.
=head2 What good is C<\G> in a regular expression?
The notation C<\G> is used in a match or substitution in conjunction the
C</g> modifier (and ignored if there's no C</g>) to anchor the regular
expression to the point just past where the last match occurred, i.e. the
-pos() point.
+pos() point. A failed match resets the position of C<\G> unless the
+C</c> modifier is in effect.
For example, suppose you had a line of text quoted in standard mail
and Usenet notation, (that is, with leading C<E<gt>> characters), and
@@ -534,12 +530,10 @@ L<perlfaq2>).
=head2 What's wrong with using grep or map in a void context?
-Strictly speaking, nothing. Stylistically speaking, it's not a good
-way to write maintainable code. That's because you're using these
-constructs not for their return values but rather for their
-side-effects, and side-effects can be mystifying. There's no void
-grep() that's not better written as a C<for> (well, C<foreach>,
-technically) loop.
+Both grep and map build a return list, regardless of their context.
+This means you're making Perl go to the trouble of building up a
+return list that you then just ignore. That's no way to treat a
+programming language, you insensitive scoundrel!
=head2 How can I match strings with multibyte characters?
@@ -587,19 +581,53 @@ Or like this:
Or like this:
- die "sorry, Perl doesn't (yet) have Martian support )-:\n";
-
-In addition, a sample program which converts half-width to full-width
-katakana (in Shift-JIS or EUC encoding) is available from CPAN as
-
-=for Tom make it so
+ die "sorry, Perl doesn't (yet) have Martian support )-:\n";
There are many double- (and multi-) byte encodings commonly used these
days. Some versions of these have 1-, 2-, 3-, and 4-byte characters,
all mixed.
+=head2 How do I match a pattern that is supplied by the user?
+
+Well, if it's really a pattern, then just use
+
+ chomp($pattern = <STDIN>);
+ if ($line =~ /$pattern/) { }
+
+Or, since you have no guarantee that your user entered
+a valid regular expression, trap the exception this way:
+
+ if (eval { $line =~ /$pattern/ }) { }
+
+But if all you really want to search for a string, not a pattern,
+then you should either use the index() function, which is made for
+string searching, or if you can't be disabused of using a pattern
+match on a non-pattern, then be sure to use C<\Q>...C<\E>, documented
+in L<perlre>.
+
+ $pattern = <STDIN>;
+
+ open (FILE, $input) or die "Couldn't open input $input: $!; aborting";
+ while (<FILE>) {
+ print if /\Q$pattern\E/;
+ }
+ close FILE;
+
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997 Tom Christiansen and Nathan Torkington.
-All rights reserved. See L<perlfaq> for distribution information.
+Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
+All rights reserved.
+
+When included as part of the Standard Version of Perl, or as part of
+its complete documentation whether printed or otherwise, this work
+may be distributed only under the terms of Perl's Artistic Licence.
+Any distribution of this file or derivatives thereof I<outside>
+of that package require that special arrangements be made with
+copyright holder.
+
+Irrespective of its distribution, all code examples in this file
+are hereby placed into the public domain. You are permitted and
+encouraged to use this code in your own programs for fun
+or for profit as you see fit. A simple comment in the code giving
+credit would be courteous but is not required.
diff --git a/gnu/usr.bin/perl/pod/perlfaq7.pod b/gnu/usr.bin/perl/pod/perlfaq7.pod
index 283aa2bb34b..a4ea872b857 100644
--- a/gnu/usr.bin/perl/pod/perlfaq7.pod
+++ b/gnu/usr.bin/perl/pod/perlfaq7.pod
@@ -1,6 +1,6 @@
=head1 NAME
-perlfaq7 - Perl Language Issues ($Revision: 1.18 $, $Date: 1997/04/24 22:44:14 $)
+perlfaq7 - Perl Language Issues ($Revision: 1.24 $, $Date: 1999/01/08 05:32:11 $)
=head1 DESCRIPTION
@@ -9,9 +9,14 @@ clearly fit into any of the other sections.
=head2 Can I get a BNF/yacc/RE for the Perl language?
-No, in the words of Chaim Frenkel: "Perl's grammar can not be reduced
-to BNF. The work of parsing perl is distributed between yacc, the
-lexer, smoke and mirrors."
+There is no BNF, but you can paw your way through the yacc grammar in
+perly.y in the source distribution if you're particularly brave. The
+grammar relies on very smart tokenizing code, so be prepared to
+venture into toke.c as well.
+
+In the words of Chaim Frenkel: "Perl's grammar can not be reduced to BNF.
+The work of parsing perl is distributed between yacc, the lexer, smoke
+and mirrors."
=head2 What are all these $@%* punctuation signs, and how do I know when to use them?
@@ -133,6 +138,12 @@ binds more tightly even than unary minus, making C<-2**2> product a
negative not a positive four. It is also right-associating, meaning
that C<2**3**2> is two raised to the ninth power, not eight squared.
+Although it has the same precedence as in C, Perl's C<?:> operator
+produces an lvalue. This assigns $x to either $a or $b, depending
+on the trueness of $maybe:
+
+ ($maybe ? $a : $b) = $x;
+
=head2 How do I declare/create a structure?
In general, you don't "declare" a structure. Just use a (probably
@@ -169,7 +180,7 @@ own module. Make sure to change the names appropriately.
# if using RCS/CVS, this next line may be preferred,
# but beware two-digit versions.
- $VERSION = do{my@r=q$Revision: 1.18 $=~/\d+/g;sprintf '%d.'.'%02d'x$#r,@r};
+ $VERSION = do{my@r=q$Revision: 1.24 $=~/\d+/g;sprintf '%d.'.'%02d'x$#r,@r};
@ISA = qw(Exporter);
@EXPORT = qw(&func1 &func2 &func3);
@@ -218,6 +229,10 @@ own module. Make sure to change the names appropriately.
1; # modules must return true
+The h2xs program will create stubs for all the important stuff for you:
+
+ % h2xs -XA -n My::Module
+
=head2 How do I create a class?
See L<perltoot> for an introduction to classes and objects, as well as
@@ -262,7 +277,7 @@ Here's a classic function-generating function:
}
$add_sub = add_function_generator();
- $sum = &$add_sub(4,5); # $sum is 9 now.
+ $sum = $add_sub->(4,5); # $sum is 9 now.
The closure works as a I<function template> with some customization
slots left out to be filled later. The anonymous subroutine returned
@@ -302,7 +317,7 @@ caller's scope.
Variable suicide is when you (temporarily or permanently) lose the
value of a variable. It is caused by scoping through my() and local()
-interacting with either closures or aliased foreach() interator
+interacting with either closures or aliased foreach() iterator
variables and subroutine arguments. It used to be easy to
inadvertently lose a variable's value this way, but now it's much
harder. Take this code:
@@ -333,7 +348,7 @@ reference to an existing or anonymous variable or function:
func( \$some_scalar );
- func( \$some_array );
+ func( \@some_array );
func( [ 1 .. 10 ] );
func( \%some_hash );
@@ -344,23 +359,44 @@ reference to an existing or anonymous variable or function:
=item Passing Filehandles
-To create filehandles you can pass to subroutines, you can use C<*FH>
-or C<\*FH> notation ("typeglobs" - see L<perldata> for more information),
-or create filehandles dynamically using the old FileHandle or the new
-IO::File modules, both part of the standard Perl distribution.
+To pass filehandles to subroutines, use the C<*FH> or C<\*FH> notations.
+These are "typeglobs" - see L<perldata/"Typeglobs and Filehandles">
+and especially L<perlsub/"Pass by Reference"> for more information.
+
+Here's an excerpt:
+
+If you're passing around filehandles, you could usually just use the bare
+typeglob, like *STDOUT, but typeglobs references would be better because
+they'll still work properly under C<use strict 'refs'>. For example:
- use Fcntl;
- use IO::File;
- my $fh = new IO::File $filename, O_WRONLY|O_APPEND;
- or die "Can't append to $filename: $!";
- func($fh);
+ splutter(\*STDOUT);
+ sub splutter {
+ my $fh = shift;
+ print $fh "her um well a hmmm\n";
+ }
+
+ $rec = get_rec(\*STDIN);
+ sub get_rec {
+ my $fh = shift;
+ return scalar <$fh>;
+ }
+
+If you're planning on generating new filehandles, you could do this:
+
+ sub openit {
+ my $name = shift;
+ local *FH;
+ return open (FH, $path) ? *FH : undef;
+ }
+ $fh = openit('< /etc/motd');
+ print <$fh>;
=item Passing Regexps
To pass regexps around, you'll need to either use one of the highly
experimental regular expression modules from CPAN (Nick Ing-Simmons's
Regexp or Ilya Zakharevich's Devel::Regexp), pass around strings
-and use an exception-trapping eval, or else be be very, very clever.
+and use an exception-trapping eval, or else be very, very clever.
Here's an example of how to pass in a string to be regexp compared:
sub compare($$) {
@@ -400,7 +436,7 @@ To pass an object method into a subroutine, you can do this:
}
}
-or you can use a closure to bundle up the object and its method call
+Or you can use a closure to bundle up the object and its method call
and arguments:
my $whatnot = sub { $some_obj->obfuscate(@args) };
@@ -452,6 +488,8 @@ could conceivably have several packages in that same file all
accessing the same private variable, but another file with the same
package couldn't get to it.
+See L<perlsub/"Persistent Private Variables"> for details.
+
=head2 What's the difference between dynamic and lexical (static) scoping? Between local() and my()?
C<local($x)> saves away the old value of the global variable C<$x>,
@@ -495,7 +533,8 @@ In summary, local() doesn't make what you think of as private, local
variables. It gives a global variable a temporary value. my() is
what you're looking for if you want private variables.
-See also L<perlsub>, which explains this all in more detail.
+See L<perlsub/"Private Variables via my()"> and L<perlsub/"Temporary
+Values via local()"> for excruciating details.
=head2 How can I access a dynamic variable while a similarly named lexical is in scope?
@@ -528,16 +567,16 @@ However, dynamic variables (aka global, local, or package variables)
are effectively shallowly bound. Consider this just one more reason
not to use them. See the answer to L<"What's a closure?">.
-=head2 Why doesn't "local($foo) = <FILE>;" work right?
+=head2 Why doesn't "my($foo) = E<lt>FILEE<gt>;" work right?
-C<local()> gives list context to the right hand side of C<=>. The
-E<lt>FHE<gt> read operation, like so many of Perl's functions and
-operators, can tell which context it was called in and behaves
-appropriately. In general, the scalar() function can help. This
-function does nothing to the data itself (contrary to popular myth)
-but rather tells its argument to behave in whatever its scalar fashion
-is. If that function doesn't have a defined scalar behavior, this of
-course doesn't help you (such as with sort()).
+C<my()> and C<local()> give list context to the right hand side
+of C<=>. The E<lt>FHE<gt> read operation, like so many of Perl's
+functions and operators, can tell which context it was called in and
+behaves appropriately. In general, the scalar() function can help.
+This function does nothing to the data itself (contrary to popular myth)
+but rather tells its argument to behave in whatever its scalar fashion is.
+If that function doesn't have a defined scalar behavior, this of course
+doesn't help you (such as with sort()).
To enforce scalar context in this particular case, however, you need
merely omit the parentheses:
@@ -576,7 +615,7 @@ the function doesn't get an empty @_, it gets yours! While not
strictly speaking a bug (it's documented that way in L<perlsub>), it
would be hard to consider this a feature in most cases.
-When you call your function as C<&foo()>, then you do get a new @_,
+When you call your function as C<&foo()>, then you I<do> get a new @_,
but prototyping is still circumvented.
Normally, you want to call a function using C<foo()>. You may only
@@ -595,12 +634,21 @@ regexp matching, overloaded comparisons, ...). Larry couldn't decide
how best to do this, so he left it out, even though it's been on the
wish list since perl1.
-Here's a simple example of a switch based on pattern matching. We'll
-do a multi-way conditional based on the type of reference stored in
-$whatchamacallit:
+The general answer is to write a construct like this:
- SWITCH:
- for (ref $whatchamacallit) {
+ for ($variable_to_test) {
+ if (/pat1/) { } # do something
+ elsif (/pat2/) { } # do something else
+ elsif (/pat3/) { } # do something else
+ else { } # default
+ }
+
+Here's a simple example of a switch based on pattern matching, this
+time lined up in a way to make it look more like a switch statement.
+We'll do a multi-way conditional based on the type of reference stored
+in $whatchamacallit:
+
+ SWITCH: for (ref $whatchamacallit) {
/^$/ && die "not a reference";
@@ -630,6 +678,41 @@ $whatchamacallit:
}
+See C<perlsyn/"Basic BLOCKs and Switch Statements"> for many other
+examples in this style.
+
+Sometimes you should change the positions of the constant and the variable.
+For example, let's say you wanted to test which of many answers you were
+given, but in a case-insensitive way that also allows abbreviations.
+You can use the following technique if the strings all start with
+different characters, or if you want to arrange the matches so that
+one takes precedence over another, as C<"SEND"> has precedence over
+C<"STOP"> here:
+
+ chomp($answer = <>);
+ if ("SEND" =~ /^\Q$answer/i) { print "Action is send\n" }
+ elsif ("STOP" =~ /^\Q$answer/i) { print "Action is stop\n" }
+ elsif ("ABORT" =~ /^\Q$answer/i) { print "Action is abort\n" }
+ elsif ("LIST" =~ /^\Q$answer/i) { print "Action is list\n" }
+ elsif ("EDIT" =~ /^\Q$answer/i) { print "Action is edit\n" }
+
+A totally different approach is to create a hash of function references.
+
+ my %commands = (
+ "happy" => \&joy,
+ "sad", => \&sullen,
+ "done" => sub { die "See ya!" },
+ "mad" => \&angry,
+ );
+
+ print "How are you? ";
+ chomp($string = <STDIN>);
+ if ($commands{$string}) {
+ $commands{$string}->();
+ } else {
+ print "No such command: $string\n";
+ }
+
=head2 How can I catch accesses to undefined variables/functions/methods?
The AUTOLOAD method, discussed in L<perlsub/"Autoloading"> and
@@ -642,7 +725,7 @@ C<__WARN__> like this:
$SIG{__WARN__} = sub {
- for ( $_[0] ) {
+ for ( $_[0] ) { # voici un switch statement
/Use of uninitialized value/ && do {
# promote warning to a fatal
@@ -669,22 +752,25 @@ before Perl has seen that such a package exists. It's wisest to make
sure your packages are all defined before you start using them, which
will be taken care of if you use the C<use> statement instead of
C<require>. If not, make sure to use arrow notation (eg,
-C<Guru->find("Samy")>) instead. Object notation is explained in
+C<Guru-E<gt>find("Samy")>) instead. Object notation is explained in
L<perlobj>.
+Make sure to read about creating modules in L<perlmod> and
+the perils of indirect objects in L<perlobj/"WARNING">.
+
=head2 How can I find out my current package?
If you're just a random program, you can do this to find
out what the currently compiled package is:
- my $packname = ref bless [];
+ my $packname = __PACKAGE__;
But if you're a method and you want to print an error message
that includes the kind of object you were called on (which is
not necessarily the same as the one in which you were compiled):
sub amethod {
- my $self = shift;
+ my $self = shift;
my $class = ref($self) || $self;
warn "called me from a $class object";
}
@@ -711,7 +797,50 @@ Use embedded POD to discard it:
=cut
+This can't go just anywhere. You have to put a pod directive where
+the parser is expecting a new statement, not just in the middle
+of an expression or some other arbitrary yacc grammar production.
+
+=head2 How do I clear a package?
+
+Use this code, provided by Mark-Jason Dominus:
+
+ sub scrub_package {
+ no strict 'refs';
+ my $pack = shift;
+ die "Shouldn't delete main package"
+ if $pack eq "" || $pack eq "main";
+ my $stash = *{$pack . '::'}{HASH};
+ my $name;
+ foreach $name (keys %$stash) {
+ my $fullname = $pack . '::' . $name;
+ # Get rid of everything with that name.
+ undef $$fullname;
+ undef @$fullname;
+ undef %$fullname;
+ undef &$fullname;
+ undef *$fullname;
+ }
+ }
+
+Or, if you're using a recent release of Perl, you can
+just use the Symbol::delete_package() function instead.
+
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997 Tom Christiansen and Nathan Torkington.
-All rights reserved. See L<perlfaq> for distribution information.
+Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
+All rights reserved.
+
+When included as part of the Standard Version of Perl, or as part of
+its complete documentation whether printed or otherwise, this work
+may be distributed only under the terms of Perl's Artistic Licence.
+Any distribution of this file or derivatives thereof I<outside>
+of that package require that special arrangements be made with
+copyright holder.
+
+Irrespective of its distribution, all code examples in this file
+are hereby placed into the public domain. You are permitted and
+encouraged to use this code in your own programs for fun
+or for profit as you see fit. A simple comment in the code giving
+credit would be courteous but is not required.
+
diff --git a/gnu/usr.bin/perl/pod/perlfaq8.pod b/gnu/usr.bin/perl/pod/perlfaq8.pod
index f4d3c12f6f7..9ef41af63af 100644
--- a/gnu/usr.bin/perl/pod/perlfaq8.pod
+++ b/gnu/usr.bin/perl/pod/perlfaq8.pod
@@ -1,6 +1,6 @@
=head1 NAME
-perlfaq8 - System Interaction ($Revision: 1.21 $, $Date: 1997/04/24 22:44:19 $)
+perlfaq8 - System Interaction ($Revision: 1.36 $, $Date: 1999/01/08 05:36:34 $)
=head1 DESCRIPTION
@@ -15,7 +15,7 @@ contain more detailed information on the vagaries of your perl.
=head2 How do I find out which operating system I'm running under?
-The $^O variable ($OSTYPE if you use English) contains the operating
+The $^O variable ($OSNAME if you use English) contains the operating
system that your perl binary was built for.
=head2 How come exec() doesn't return?
@@ -52,6 +52,162 @@ How you access/control keyboards, screens, and pointing devices
=back
+Some of these specific cases are shown below.
+
+=head2 How do I print something out in color?
+
+In general, you don't, because you don't know whether
+the recipient has a color-aware display device. If you
+know that they have an ANSI terminal that understands
+color, you can use the Term::ANSIColor module from CPAN:
+
+ use Term::ANSIColor;
+ print color("red"), "Stop!\n", color("reset");
+ print color("green"), "Go!\n", color("reset");
+
+Or like this:
+
+ use Term::ANSIColor qw(:constants);
+ print RED, "Stop!\n", RESET;
+ print GREEN, "Go!\n", RESET;
+
+=head2 How do I read just one key without waiting for a return key?
+
+Controlling input buffering is a remarkably system-dependent matter.
+If most systems, you can just use the B<stty> command as shown in
+L<perlfunc/getc>, but as you see, that's already getting you into
+portability snags.
+
+ open(TTY, "+</dev/tty") or die "no tty: $!";
+ system "stty cbreak </dev/tty >/dev/tty 2>&1";
+ $key = getc(TTY); # perhaps this works
+ # OR ELSE
+ sysread(TTY, $key, 1); # probably this does
+ system "stty -cbreak </dev/tty >/dev/tty 2>&1";
+
+The Term::ReadKey module from CPAN offers an easy-to-use interface that
+should be more efficient than shelling out to B<stty> for each key.
+It even includes limited support for Windows.
+
+ use Term::ReadKey;
+ ReadMode('cbreak');
+ $key = ReadKey(0);
+ ReadMode('normal');
+
+However, that requires that you have a working C compiler and can use it
+to build and install a CPAN module. Here's a solution using
+the standard POSIX module, which is already on your systems (assuming
+your system supports POSIX).
+
+ use HotKey;
+ $key = readkey();
+
+And here's the HotKey module, which hides the somewhat mystifying calls
+to manipulate the POSIX termios structures.
+
+ # HotKey.pm
+ package HotKey;
+
+ @ISA = qw(Exporter);
+ @EXPORT = qw(cbreak cooked readkey);
+
+ use strict;
+ use POSIX qw(:termios_h);
+ my ($term, $oterm, $echo, $noecho, $fd_stdin);
+
+ $fd_stdin = fileno(STDIN);
+ $term = POSIX::Termios->new();
+ $term->getattr($fd_stdin);
+ $oterm = $term->getlflag();
+
+ $echo = ECHO | ECHOK | ICANON;
+ $noecho = $oterm & ~$echo;
+
+ sub cbreak {
+ $term->setlflag($noecho); # ok, so i don't want echo either
+ $term->setcc(VTIME, 1);
+ $term->setattr($fd_stdin, TCSANOW);
+ }
+
+ sub cooked {
+ $term->setlflag($oterm);
+ $term->setcc(VTIME, 0);
+ $term->setattr($fd_stdin, TCSANOW);
+ }
+
+ sub readkey {
+ my $key = '';
+ cbreak();
+ sysread(STDIN, $key, 1);
+ cooked();
+ return $key;
+ }
+
+ END { cooked() }
+
+ 1;
+
+=head2 How do I check whether input is ready on the keyboard?
+
+The easiest way to do this is to read a key in nonblocking mode with the
+Term::ReadKey module from CPAN, passing it an argument of -1 to indicate
+not to block:
+
+ use Term::ReadKey;
+
+ ReadMode('cbreak');
+
+ if (defined ($char = ReadKey(-1)) ) {
+ # input was waiting and it was $char
+ } else {
+ # no input was waiting
+ }
+
+ ReadMode('normal'); # restore normal tty settings
+
+=head2 How do I clear the screen?
+
+If you only have to so infrequently, use C<system>:
+
+ system("clear");
+
+If you have to do this a lot, save the clear string
+so you can print it 100 times without calling a program
+100 times:
+
+ $clear_string = `clear`;
+ print $clear_string;
+
+If you're planning on doing other screen manipulations, like cursor
+positions, etc, you might wish to use Term::Cap module:
+
+ use Term::Cap;
+ $terminal = Term::Cap->Tgetent( {OSPEED => 9600} );
+ $clear_string = $terminal->Tputs('cl');
+
+=head2 How do I get the screen size?
+
+If you have Term::ReadKey module installed from CPAN,
+you can use it to fetch the width and height in characters
+and in pixels:
+
+ use Term::ReadKey;
+ ($wchar, $hchar, $wpixels, $hpixels) = GetTerminalSize();
+
+This is more portable than the raw C<ioctl>, but not as
+illustrative:
+
+ require 'sys/ioctl.ph';
+ die "no TIOCGWINSZ " unless defined &TIOCGWINSZ;
+ open(TTY, "+</dev/tty") or die "No tty: $!";
+ unless (ioctl(TTY, &TIOCGWINSZ, $winsize='')) {
+ die sprintf "$0: ioctl TIOCGWINSZ (%08x: $!)\n", &TIOCGWINSZ;
+ }
+ ($row, $col, $xpixel, $ypixel) = unpack('S4', $winsize);
+ print "(row,col) = ($row,$col)";
+ print " (xpixel,ypixel) = ($xpixel,$ypixel)" if $xpixel || $ypixel;
+ print "\n";
+
=head2 How do I ask the user for a password?
(This question has nothing to do with the web. See a different
@@ -66,6 +222,11 @@ to the B<stty> program, with varying degrees of portability.
You can also do this for most systems using the Term::ReadKey module
from CPAN, which is easier to use and in theory more portable.
+ use Term::ReadKey;
+
+ ReadMode('noecho');
+ $password = ReadLine(0);
+
=head2 How do I read and write the serial port?
This depends on which operating system your program is running on. In
@@ -112,18 +273,9 @@ next.
=item flushing output
If you expect characters to get to your device when you print() them,
-you'll want to autoflush that filehandle, as in the older
-
- use FileHandle;
- DEV->autoflush(1);
-
-and the newer
-
- use IO::Handle;
- DEV->autoflush(1);
-
-You can use select() and the C<$|> variable to control autoflushing
-(see L<perlvar/$|> and L<perlfunc/select>):
+you'll want to autoflush that filehandle. You can use select()
+and the C<$|> variable to control autoflushing (see L<perlvar/$|>
+and L<perlfunc/select>):
$oldh = select(DEV);
$| = 1;
@@ -133,6 +285,12 @@ You'll also see code that does this without a temporary variable, as in
select((select(DEV), $| = 1)[0]);
+Or if you don't mind pulling in a few thousand lines
+of code just because you're afraid of a little $| variable:
+
+ use IO::Handle;
+ DEV->autoflush(1);
+
As mentioned in the previous item, this still doesn't work when using
socket I/O between Unix and Macintosh. You'll need to hardcode your
line terminators, in that case.
@@ -148,15 +306,37 @@ L<perlfunc/"select">.
=back
+While trying to read from his caller-id box, the notorious Jamie Zawinski
+<jwz@netscape.com>, after much gnashing of teeth and fighting with sysread,
+sysopen, POSIX's tcgetattr business, and various other functions that
+go bump in the night, finally came up with this:
+
+ sub open_modem {
+ use IPC::Open2;
+ my $stty = `/bin/stty -g`;
+ open2( \*MODEM_IN, \*MODEM_OUT, "cu -l$modem_device -s2400 2>&1");
+ # starting cu hoses /dev/tty's stty settings, even when it has
+ # been opened on a pipe...
+ system("/bin/stty $stty");
+ $_ = <MODEM_IN>;
+ chop;
+ if ( !m/^Connected/ ) {
+ print STDERR "$0: cu printed `$_' instead of `Connected'\n";
+ }
+ }
+
=head2 How do I decode encrypted password files?
You spend lots and lots of money on dedicated hardware, but this is
bound to get you talked about.
Seriously, you can't if they are Unix password files - the Unix
-password system employs one-way encryption. Programs like Crack can
-forcibly (and intelligently) try to guess passwords, but don't (can't)
-guarantee quick success.
+password system employs one-way encryption. It's more like hashing than
+encryption. The best you can check is whether something else hashes to
+the same string. You can't turn a hash back into the original string.
+Programs like Crack
+can forcibly (and intelligently) try to guess passwords, but don't
+(can't) guarantee quick success.
If you're worried about users selecting bad passwords, you should
proactively check when they try to change their password (by modifying
@@ -174,7 +354,7 @@ on a Unix-like system:
=over 4
-=item STDIN, STDOUT and STDERR are shared
+=item STDIN, STDOUT, and STDERR are shared
Both the main process and the backgrounded one (the "child" process)
share the same STDIN, STDOUT and STDERR filehandles. If both try to
@@ -204,9 +384,10 @@ Zombies are not an issue with C<system("prog &")>.
=head2 How do I trap control characters/signals?
-You don't actually "trap" a control character. Instead, that
-character generates a signal, which you then trap. Signals are
-documented in L<perlipc/"Signals"> and chapter 6 of the Camel.
+You don't actually "trap" a control character. Instead, that character
+generates a signal which is sent to your terminal's currently
+foregrounded process group, which you then trap in your process.
+Signals are documented in L<perlipc/"Signals"> and chapter 6 of the Camel.
Be warned that very few C libraries are re-entrant. Therefore, if you
attempt to print() in a handler that got invoked during another stdio
@@ -235,10 +416,11 @@ blocking flock() in L<perlipc/"Signals"> or chapter 6 of the Camel.
=head2 How do I modify the shadow password file on a Unix system?
-If perl was installed correctly, the getpw*() functions described in
-L<perlfunc> provide (read-only) access to the shadow password file.
-To change the file, make a new shadow password file (the format varies
-from system to system - see L<passwd(5)> for specifics) and use
+If perl was installed correctly, and your shadow library was written
+properly, the getpw*() functions described in L<perlfunc> should in
+theory provide (read-only) access to entries in the shadow password
+file. To change the file, make a new shadow password file (the format
+varies from system to system - see L<passwd(5)> for specifics) and use
pwd_mkdb(8) to install it (see L<pwd_mkdb(5)> for more details).
=head2 How do I set the time and date?
@@ -254,7 +436,7 @@ probably get away with setting an environment variable:
$ENV{TZ} = "MST7MDT"; # unixish
$ENV{'SYS$TIMEZONE_DIFFERENTIAL'}="-5" # vms
- system "trn comp.lang.perl";
+ system "trn comp.lang.perl.misc";
=head2 How can I sleep() or alarm() for under a second?
@@ -269,9 +451,9 @@ http://www.perl.com/CPAN/doc/misc/ancient/tutorial/eg/itimers.pl .
In general, you may not be able to. The Time::HiRes module (available
from CPAN) provides this functionality for some systems.
-In general, you may not be able to. But if you system supports both the
-syscall() function in Perl as well as a system call like gettimeofday(2),
-then you may be able to do something like this:
+If your system supports both the syscall() function in Perl as well as
+a system call like gettimeofday(2), then you may be able to do
+something like this:
require 'sys/syscall.ph';
@@ -279,7 +461,7 @@ then you may be able to do something like this:
$done = $start = pack($TIMEVAL_T, ());
- syscall( &SYS_gettimeofday, $start, 0)) != -1
+ syscall( &SYS_gettimeofday, $start, 0) != -1
or die "gettimeofday: $!";
##########################
@@ -303,9 +485,17 @@ then you may be able to do something like this:
Release 5 of Perl added the END block, which can be used to simulate
atexit(). Each package's END block is called when the program or
-thread ends (see L<perlmod> manpage for more details). It isn't
-called when untrapped signals kill the program, though, so if you use
-END blocks you should also use
+thread ends (see L<perlmod> manpage for more details).
+
+For example, you can use this to make sure your filter program
+managed to finish its output without filling up the disk:
+
+ END {
+ close(STDOUT) || die "stdout close failed: $!";
+ }
+
+The END block isn't called when untrapped signals kill the program, though, so if
+you use END blocks you should also use
use sigtrap qw(die normal-signals);
@@ -375,15 +565,21 @@ scripts inherently insecure. Perl gives you a number of options
=head2 How can I open a pipe both to and from a command?
The IPC::Open2 module (part of the standard perl distribution) is an
-easy-to-use approach that internally uses pipe(), fork(), and exec()
-to do the job. Make sure you read the deadlock warnings in its
-documentation, though (see L<IPC::Open2>).
+easy-to-use approach that internally uses pipe(), fork(), and exec() to do
+the job. Make sure you read the deadlock warnings in its documentation,
+though (see L<IPC::Open2>). See L<perlipc/"Bidirectional Communication
+with Another Process"> and L<perlipc/"Bidirectional Communication with
+Yourself">
+
+You may also use the IPC::Open3 module (part of the standard perl
+distribution), but be warned that it has a different order of
+arguments from IPC::Open2 (see L<IPC::Open3>).
=head2 Why can't I get the output of a command with system()?
You're confusing the purpose of system() and backticks (``). system()
runs a command and returns exit status information (as a 16 bit value:
-the low 8 bits are the signal the process died from, if any, and
+the low 7 bits are the signal the process died from, if any, and
the high 8 bits are the actual exit value). Backticks (``) run a
command and return what it sent to STDOUT.
@@ -434,26 +630,69 @@ Note that you I<must> use Bourne shell (sh(1)) redirection syntax in
backticks, not csh(1)! Details on why Perl's system() and backtick
and pipe opens all use the Bourne shell are in
http://www.perl.com/CPAN/doc/FMTEYEWTK/versus/csh.whynot .
+To capture a command's STDERR and STDOUT together:
-You may also use the IPC::Open3 module (part of the standard perl
-distribution), but be warned that it has a different order of
-arguments from IPC::Open2 (see L<IPC::Open3>).
+ $output = `cmd 2>&1`; # either with backticks
+ $pid = open(PH, "cmd 2>&1 |"); # or with an open pipe
+ while (<PH>) { } # plus a read
+
+To capture a command's STDOUT but discard its STDERR:
+
+ $output = `cmd 2>/dev/null`; # either with backticks
+ $pid = open(PH, "cmd 2>/dev/null |"); # or with an open pipe
+ while (<PH>) { } # plus a read
+
+To capture a command's STDERR but discard its STDOUT:
+
+ $output = `cmd 2>&1 1>/dev/null`; # either with backticks
+ $pid = open(PH, "cmd 2>&1 1>/dev/null |"); # or with an open pipe
+ while (<PH>) { } # plus a read
+
+To exchange a command's STDOUT and STDERR in order to capture the STDERR
+but leave its STDOUT to come out our old STDERR:
+
+ $output = `cmd 3>&1 1>&2 2>&3 3>&-`; # either with backticks
+ $pid = open(PH, "cmd 3>&1 1>&2 2>&3 3>&-|");# or with an open pipe
+ while (<PH>) { } # plus a read
+
+To read both a command's STDOUT and its STDERR separately, it's easiest
+and safest to redirect them separately to files, and then read from those
+files when the program is done:
+
+ system("program args 1>/tmp/program.stdout 2>/tmp/program.stderr");
+
+Ordering is important in all these examples. That's because the shell
+processes file descriptor redirections in strictly left to right order.
+
+ system("prog args 1>tmpfile 2>&1");
+ system("prog args 2>&1 1>tmpfile");
+
+The first command sends both standard out and standard error to the
+temporary file. The second command sends only the old standard output
+there, and the old standard error shows up on the old standard out.
=head2 Why doesn't open() return an error when a pipe open fails?
-It does, but probably not how you expect it to. On systems that
-follow the standard fork()/exec() paradigm (eg, Unix), it works like
-this: open() causes a fork(). In the parent, open() returns with the
-process ID of the child. The child exec()s the command to be piped
-to/from. The parent can't know whether the exec() was successful or
-not - all it can return is whether the fork() succeeded or not. To
-find out if the command succeeded, you have to catch SIGCHLD and
-wait() to get the exit status. You should also catch SIGPIPE if
-you're writing to the child -- you may not have found out the exec()
+Because the pipe open takes place in two steps: first Perl calls
+fork() to start a new process, then this new process calls exec() to
+run the program you really wanted to open. The first step reports
+success or failure to your process, so open() can only tell you
+whether the fork() succeeded or not.
+
+To find out if the exec() step succeeded, you have to catch SIGCHLD
+and wait() to get the exit status. You should also catch SIGPIPE if
+you're writing to the child--you may not have found out the exec()
failed by the time you write. This is documented in L<perlipc>.
+In some cases, even this won't work. If the second argument to a
+piped open() contains shell metacharacters, perl fork()s, then exec()s
+a shell to decode the metacharacters and eventually run the desired
+program. Now when you call wait(), you only learn whether or not the
+I<shell> could be successfully started. Best to avoid shell
+metacharacters.
+
On systems that follow the spawn() paradigm, open() I<might> do what
-you expect - unless perl uses a shell to start your command. In this
+you expect--unless perl uses a shell to start your command. In this
case the fork()/exec() description still applies.
=head2 What's wrong with using backticks in a void context?
@@ -487,7 +726,7 @@ In most cases, this could and probably should be written as
or die "cat program failed!";
Which will get the output quickly (as its generated, instead of only
-at the end ) and also check the return value.
+at the end) and also check the return value.
system() also provides direct control over whether shell wildcard
processing may take place, whereas backticks do not.
@@ -513,6 +752,8 @@ You have to do this:
Just as with system(), no shell escapes happen when you exec() a list.
+There are more examples of this L<perlipc/"Safe Pipe Opens">.
+
=head2 Why can't my script read from STDIN after I gave it EOF (^D on Unix, ^Z on MS-DOS)?
Because some stdio's set error and eof flags that need clearing. The
@@ -582,9 +823,10 @@ approach will suffice:
=head2 How can I write expect in Perl?
Once upon a time, there was a library called chat2.pl (part of the
-standard perl distribution), which never really got finished. These
-days, your best bet is to look at the Comm.pl library available from
-CPAN.
+standard perl distribution), which never really got finished. If you
+find it somewhere, I<don't use it>. These days, your best bet is to
+look at the Expect module available from CPAN, which also requires two
+other modules from CPAN, IO::Pty and IO::Stty.
=head2 Is there a way to hide perl's command line from programs such as "ps"?
@@ -612,11 +854,7 @@ different process from the shell it was started from. Changes to a
process are not reflected in its parent, only in its own children
created after the change. There is shell magic that may allow you to
fake it by eval()ing the script's output in your shell; check out the
-comp.unix.questions FAQ for details.
-
-=item VMS
-
-Change to %ENV persist after Perl exits, but directory changes do not.
+comp.unix.questions FAQ for details.
=back
@@ -637,8 +875,9 @@ module for other solutions.
=item *
-Open /dev/tty and use the the TIOCNOTTY ioctl on it. See L<tty(4)>
-for details.
+Open /dev/tty and use the TIOCNOTTY ioctl on it. See L<tty(4)>
+for details. Or better yet, you can just use the POSIX::setsid()
+function, so you don't have to worry about process groups.
=item *
@@ -657,6 +896,9 @@ Background yourself like this:
=back
+The Proc::Daemon module, available from CPAN, provides a function to
+perform these actions for you.
+
=head2 How do I make my program run with sh and csh?
See the F<eg/nih> script (part of the perl source distribution).
@@ -675,7 +917,7 @@ the current process group of your controlling terminal as follows:
use POSIX qw/getpgrp tcgetpgrp/;
open(TTY, "/dev/tty") or die $!;
- $tpgrp = tcgetpgrp(TTY);
+ $tpgrp = tcgetpgrp(fileno(*TTY));
$pgrp = getpgrp();
if ($tpgrp == $pgrp) {
print "foreground\n";
@@ -705,12 +947,17 @@ in L<perlfunc/fork>.
There are a number of excellent interfaces to SQL databases. See the
DBD::* modules available from
http://www.perl.com/CPAN/modules/dbperl/DBD .
+A lot of information on this can be found at
+http://www.hermetica.com/technologia/perl/DBI/index.html .
=head2 How do I make a system() exit on control-C?
You can't. You need to imitate the system() call (see L<perlipc> for
sample code) and then have a signal handler for the INT signal that
-passes the signal on to the subprocess.
+passes the signal on to the subprocess. Or you can check for it:
+
+ $rc = system($cmd);
+ if ($rc & 127) { die "signal death" }
=head2 How do I open a file without blocking?
@@ -758,8 +1005,31 @@ If your version of perl is compiled without dynamic loading, then you
just need to replace step 3 (B<make>) with B<make perl> and you will
get a new F<perl> binary with your extension linked in.
-See L<ExtUtils::MakeMaker> for more details on building extensions,
-the question "How do I keep my own module/library directory?"
+See L<ExtUtils::MakeMaker> for more details on building extensions.
+See also the next question.
+
+=head2 What's the difference between require and use?
+
+Perl offers several different ways to include code from one file into
+another. Here are the deltas between the various inclusion constructs:
+
+ 1) do $file is like eval `cat $file`, except the former:
+ 1.1: searches @INC and updates %INC.
+ 1.2: bequeaths an *unrelated* lexical scope on the eval'ed code.
+
+ 2) require $file is like do $file, except the former:
+ 2.1: checks for redundant loading, skipping already loaded files.
+ 2.2: raises an exception on failure to find, compile, or execute $file.
+
+ 3) require Module is like require "Module.pm", except the former:
+ 3.1: translates each "::" into your system's directory separator.
+ 3.2: primes the parser to disambiguate class Module as an indirect object.
+
+ 4) use Module is like require Module, except the former:
+ 4.1: loads the module at compile time, not run-time.
+ 4.2: imports symbols and semantics from that package to the current one.
+
+In general, you usually want C<use> and a proper Perl module.
=head2 How do I keep my own module/library directory?
@@ -773,12 +1043,19 @@ scripts that use the modules/libraries (see L<perlrun>) or say
use lib '/u/mydir/perl';
+This is almost the same as:
+
+ BEGIN {
+ unshift(@INC, '/u/mydir/perl');
+ }
+
+except that the lib module checks for machine-dependent subdirectories.
See Perl's L<lib> for more information.
=head2 How do I add the directory my program lives in to the module/library search path?
use FindBin;
- use lib "$FindBin:Bin";
+ use lib "$FindBin::Bin";
use your_own_modules;
=head2 How do I add a directory to my include path at runtime?
@@ -787,7 +1064,7 @@ Here are the suggested ways of modifying your include path:
the PERLLIB environment variable
the PERL5LIB environment variable
- the perl -Idir commpand line flag
+ the perl -Idir command line flag
the use lib pragma, as in
use lib "$ENV{HOME}/myown_perllib";
@@ -795,57 +1072,27 @@ The latter is particularly useful because it knows about machine
dependent architectures. The lib.pm pragmatic module was first
included with the 5.002 release of Perl.
-=head1 How do I get one key from the terminal at a time, under POSIX?
-
- #!/usr/bin/perl -w
- use strict;
- $| = 1;
- for (1..4) {
- my $got;
- print "gimme: ";
- $got = getone();
- print "--> $got\n";
- }
- exit;
-
- BEGIN {
- use POSIX qw(:termios_h);
-
- my ($term, $oterm, $echo, $noecho, $fd_stdin);
-
- $fd_stdin = fileno(STDIN);
+=head2 What is socket.ph and where do I get it?
- $term = POSIX::Termios->new();
- $term->getattr($fd_stdin);
- $oterm = $term->getlflag();
+It's a perl4-style file defining values for system networking
+constants. Sometimes it is built using h2ph when Perl is installed,
+but other times it is not. Modern programs C<use Socket;> instead.
- $echo = ECHO | ECHOK | ICANON;
- $noecho = $oterm & ~$echo;
-
- sub cbreak {
- $term->setlflag($noecho);
- $term->setcc(VTIME, 1);
- $term->setattr($fd_stdin, TCSANOW);
- }
+=head1 AUTHOR AND COPYRIGHT
- sub cooked {
- $term->setlflag($oterm);
- $term->setcc(VTIME, 0);
- $term->setattr($fd_stdin, TCSANOW);
- }
+Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
+All rights reserved.
- sub getone {
- my $key = '';
- cbreak();
- sysread(STDIN, $key, 1);
- cooked();
- return $key;
- }
+When included as part of the Standard Version of Perl, or as part of
+its complete documentation whether printed or otherwise, this work
+may be distributed only under the terms of Perl's Artistic Licence.
+Any distribution of this file or derivatives thereof I<outside>
+of that package require that special arrangements be made with
+copyright holder.
- }
- END { cooked() }
-
-=head1 AUTHOR AND COPYRIGHT
+Irrespective of its distribution, all code examples in this file
+are hereby placed into the public domain. You are permitted and
+encouraged to use this code in your own programs for fun
+or for profit as you see fit. A simple comment in the code giving
+credit would be courteous but is not required.
-Copyright (c) 1997 Tom Christiansen and Nathan Torkington.
-All rights reserved. See L<perlfaq> for distribution information.
diff --git a/gnu/usr.bin/perl/pod/perlfaq9.pod b/gnu/usr.bin/perl/pod/perlfaq9.pod
index aa942c2da05..65360643609 100644
--- a/gnu/usr.bin/perl/pod/perlfaq9.pod
+++ b/gnu/usr.bin/perl/pod/perlfaq9.pod
@@ -1,37 +1,83 @@
=head1 NAME
-perlfaq9 - Networking ($Revision: 1.17 $, $Date: 1997/04/24 22:44:29 $)
+perlfaq9 - Networking ($Revision: 1.24 $, $Date: 1999/01/08 05:39:48 $)
=head1 DESCRIPTION
This section deals with questions related to networking, the internet,
and a few on the web.
-=head2 My CGI script runs from the command line but not the browser. Can you help me fix it?
+=head2 My CGI script runs from the command line but not the browser. (500 Server Error)
-Sure, but you probably can't afford our contracting rates :-)
+If you can demonstrate that you've read the following FAQs and that
+your problem isn't something simple that can be easily answered, you'll
+probably receive a courteous and useful reply to your question if you
+post it on comp.infosystems.www.authoring.cgi (if it's something to do
+with HTTP, HTML, or the CGI protocols). Questions that appear to be Perl
+questions but are really CGI ones that are posted to comp.lang.perl.misc
+may not be so well received.
-Seriously, if you can demonstrate that you've read the following FAQs
-and that your problem isn't something simple that can be easily
-answered, you'll probably receive a courteous and useful reply to your
-question if you post it on comp.infosystems.www.authoring.cgi (if it's
-something to do with HTTP, HTML, or the CGI protocols). Questions that
-appear to be Perl questions but are really CGI ones that are posted to
-comp.lang.perl.misc may not be so well received.
+The useful FAQs and related documents are:
-The useful FAQs are:
+ CGI FAQ
+ http://www.webthing.com/tutorials/cgifaq.html
- http://www.perl.com/perl/faq/idiots-guide.html
- http://www3.pair.com/webthing/docs/cgi/faqs/cgifaq.shtml
- http://www.perl.com/perl/faq/perl-cgi-faq.html
- http://www-genome.wi.mit.edu/WWW/faqs/www-security-faq.html
- http://www.boutell.com/faq/
+ Web FAQ
+ http://www.boutell.com/faq/
+
+ WWW Security FAQ
+ http://www.w3.org/Security/Faq/
+
+ HTTP Spec
+ http://www.w3.org/pub/WWW/Protocols/HTTP/
+
+ HTML Spec
+ http://www.w3.org/TR/REC-html40/
+ http://www.w3.org/pub/WWW/MarkUp/
+
+ CGI Spec
+ http://www.w3.org/CGI/
+
+ CGI Security FAQ
+ http://www.go2net.com/people/paulp/cgi-security/safe-cgi.txt
+
+=head2 How can I get better error messages from a CGI program?
+
+Use the CGI::Carp module. It replaces C<warn> and C<die>, plus the
+normal Carp modules C<carp>, C<croak>, and C<confess> functions with
+more verbose and safer versions. It still sends them to the normal
+server error log.
+
+ use CGI::Carp;
+ warn "This is a complaint";
+ die "But this one is serious";
+
+The following use of CGI::Carp also redirects errors to a file of your choice,
+placed in a BEGIN block to catch compile-time warnings as well:
+
+ BEGIN {
+ use CGI::Carp qw(carpout);
+ open(LOG, ">>/var/local/cgi-logs/mycgi-log")
+ or die "Unable to append to mycgi-log: $!\n";
+ carpout(*LOG);
+ }
+
+You can even arrange for fatal errors to go back to the client browser,
+which is nice for your own debugging, but might confuse the end user.
+
+ use CGI::Carp qw(fatalsToBrowser);
+ die "Bad error here";
+
+Even if the error happens before you get the HTTP header out, the module
+will try to take care of this to avoid the dreaded server 500 errors.
+Normal warnings still go out to the server error log (or wherever
+you've sent them with C<carpout>) with the application name and date
+stamp prepended.
=head2 How do I remove HTML from a string?
The most correct way (albeit not the fastest) is to use HTML::Parse
-from CPAN (part of the libwww-perl distribution, which is a must-have
-module for all web hackers).
+from CPAN (part of the HTML-Tree package on CPAN).
Many folks attempt a simple-minded regular expression approach, like
C<s/E<lt>.*?E<gt>//g>, but that fails in many cases because the tags
@@ -49,6 +95,29 @@ program in
http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/striphtml.gz
.
+Here are some tricky cases that you should think about when picking
+a solution:
+
+ <IMG SRC = "foo.gif" ALT = "A > B">
+
+ <IMG SRC = "foo.gif"
+ ALT = "A > B">
+
+ <!-- <A comment> -->
+
+ <script>if (a<b && a>c)</script>
+
+ <# Just data #>
+
+ <![INCLUDE CDATA [ >>>>>>>>>>>> ]]>
+
+If HTML comments include other tags, those solutions would also break
+on text like this:
+
+ <!-- This section commented out.
+ <B>You can't see me!</B>
+ -->
+
=head2 How do I extract URLs?
A quick but imperfect approach is
@@ -93,11 +162,16 @@ on your system, is this:
The libwww-perl (LWP) modules from CPAN provide a more powerful way to
do this. They work through proxies, and don't require lynx:
- # print HTML from a URL
+ # simplest version
+ use LWP::Simple;
+ $content = get($URL);
+
+ # or print HTML from a URL
use LWP::Simple;
getprint "http://www.sn.no/libwww-perl/";
- # print ASCII from HTML from a URL
+ # or print ASCII from HTML from a URL
+ # also need HTML-Tree package from CPAN
use LWP::Simple;
use HTML::Parse;
use HTML::FormatText;
@@ -108,7 +182,30 @@ do this. They work through proxies, and don't require lynx:
$ascii = HTML::FormatText->new->format(parse_html($html));
print $ascii;
-=head2 how do I decode or create those %-encodings on the web?
+=head2 How do I automate an HTML form submission?
+
+If you're submitting values using the GET method, create a URL and encode
+the form using the C<query_form> method:
+
+ use LWP::Simple;
+ use URI::URL;
+
+ my $url = url('http://www.perl.com/cgi-bin/cpan_mod');
+ $url->query_form(module => 'DB_File', readme => 1);
+ $content = get($url);
+
+If you're using the POST method, create your own user agent and encode
+the content appropriately.
+
+ use HTTP::Request::Common qw(POST);
+ use LWP::UserAgent;
+
+ $ua = LWP::UserAgent->new();
+ my $req = POST 'http://www.perl.com/cgi-bin/cpan_mod',
+ [ module => 'DB_File', readme => 1 ];
+ $content = $ua->request($req)->as_string;
+
+=head2 How do I decode or create those %-encodings on the web?
Here's an example of decoding:
@@ -116,7 +213,7 @@ Here's an example of decoding:
$string =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge;
Encoding is a bit harder, because you can't just blindly change
-all the non-alphanumunder character (C<\W>) into their hex escapes.
+all the non-alphanumeric characters (C<\W>) into their hex escapes.
It's important that characters with special meaning like C</> and C<?>
I<not> be translated. Probably the easiest way to get this right is
to avoid reinventing the wheel and just use the URI::Escape module,
@@ -135,6 +232,14 @@ both:
Note that relative URLs in these headers can cause strange effects
because of "optimizations" that servers do.
+ $url = "http://www.perl.com/CPAN/";
+ print "Location: $url\n\n";
+ exit;
+
+To be correct to the spec, each of those C<"\n">
+should really each be C<"\015\012">, but unless you're
+stuck on MacOS, you probably won't notice.
+
=head2 How do I put a password on my web pages?
That depends. You'll need to read the documentation for your web
@@ -166,7 +271,7 @@ C<eval> or C<system> calls. In addition to tainting, never use the
single-argument form of system() or exec(). Instead, supply the
command and arguments as a list, which prevents shell globbing.
-=head2 How do I parse an email header?
+=head2 How do I parse a mail header?
For a quick-and-dirty solution, try this solution derived
from page 222 of the 2nd edition of "Programming Perl":
@@ -182,44 +287,82 @@ the Mail::Header module from CPAN (part of the MailTools package).
=head2 How do I decode a CGI form?
-A lot of people are tempted to code this up themselves, so you've
-probably all seen a lot of code involving C<$ENV{CONTENT_LENGTH}> and
-C<$ENV{QUERY_STRING}>. It's true that this can work, but there are
-also a lot of versions of this floating around that are quite simply
-broken!
-
-Please do not be tempted to reinvent the wheel. Instead, use the
-CGI.pm or CGI_Lite.pm (available from CPAN), or if you're trapped in
-the module-free land of perl1 .. perl4, you might look into cgi-lib.pl
-(available from http://www.bio.cam.ac.uk/web/form.html).
-
-=head2 How do I check a valid email address?
-
-You can't.
-
-Without sending mail to the address and seeing whether it bounces (and
-even then you face the halting problem), you cannot determine whether
-an email address is valid. Even if you apply the email header
-standard, you can have problems, because there are deliverable
-addresses that aren't RFC-822 (the mail header standard) compliant,
-and addresses that aren't deliverable which are compliant.
-
-Many are tempted to try to eliminate many frequently-invalid email
-addresses with a simple regexp, such as
-C</^[\w.-]+\@([\w.-]\.)+\w+$/>. However, this also throws out many
-valid ones, and says nothing about potential deliverability, so is not
-suggested. Instead, see
+You use a standard module, probably CGI.pm. Under no circumstances
+should you attempt to do so by hand!
+
+You'll see a lot of CGI programs that blindly read from STDIN the number
+of bytes equal to CONTENT_LENGTH for POSTs, or grab QUERY_STRING for
+decoding GETs. These programs are very poorly written. They only work
+sometimes. They typically forget to check the return value of the read()
+system call, which is a cardinal sin. They don't handle HEAD requests.
+They don't handle multipart forms used for file uploads. They don't deal
+with GET/POST combinations where query fields are in more than one place.
+They don't deal with keywords in the query string.
+
+In short, they're bad hacks. Resist them at all costs. Please do not be
+tempted to reinvent the wheel. Instead, use the CGI.pm or CGI_Lite.pm
+(available from CPAN), or if you're trapped in the module-free land
+of perl1 .. perl4, you might look into cgi-lib.pl (available from
+http://cgi-lib.stanford.edu/cgi-lib/ ).
+
+Make sure you know whether to use a GET or a POST in your form.
+GETs should only be used for something that doesn't update the server.
+Otherwise you can get mangled databases and repeated feedback mail
+messages. The fancy word for this is ``idempotency''. This simply
+means that there should be no difference between making a GET request
+for a particular URL once or multiple times. This is because the
+HTTP protocol definition says that a GET request may be cached by the
+browser, or server, or an intervening proxy. POST requests cannot be
+cached, because each request is independent and matters. Typically,
+POST requests change or depend on state on the server (query or update
+a database, send mail, or purchase a computer).
+
+=head2 How do I check a valid mail address?
+
+You can't, at least, not in real time. Bummer, eh?
+
+Without sending mail to the address and seeing whether there's a human
+on the other hand to answer you, you cannot determine whether a mail
+address is valid. Even if you apply the mail header standard, you
+can have problems, because there are deliverable addresses that aren't
+RFC-822 (the mail header standard) compliant, and addresses that aren't
+deliverable which are compliant.
+
+Many are tempted to try to eliminate many frequently-invalid
+mail addresses with a simple regexp, such as
+C</^[\w.-]+\@([\w.-]\.)+\w+$/>. It's a very bad idea. However,
+this also throws out many valid ones, and says nothing about
+potential deliverability, so is not suggested. Instead, see
http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/ckaddr.gz ,
which actually checks against the full RFC spec (except for nested
-comments), looks for addresses you may not wish to accept email to
+comments), looks for addresses you may not wish to accept mail to
(say, Bill Clinton or your postmaster), and then makes sure that the
-hostname given can be looked up in DNS. It's not fast, but it works.
+hostname given can be looked up in the DNS MX records. It's not fast,
+but it works for what it tries to do.
+
+Our best advice for verifying a person's mail address is to have them
+enter their address twice, just as you normally do to change a password.
+This usually weeds out typos. If both versions match, send
+mail to that address with a personal message that looks somewhat like:
+
+ Dear someuser@host.com,
+
+ Please confirm the mail address you gave us Wed May 6 09:38:41
+ MDT 1998 by replying to this message. Include the string
+ "Rumpelstiltskin" in that reply, but spelled in reverse; that is,
+ start with "Nik...". Once this is done, your confirmed address will
+ be entered into our records.
+
+If you get the message back and they've followed your directions,
+you can be reasonably assured that it's real.
-Here's an alternative strategy used by many CGI script authors: Check
-the email address with a simple regexp (such as the one above). If
-the regexp matched the address, accept the address. If the regexp
-didn't match the address, request confirmation from the user that the
-email address they entered was correct.
+A related strategy that's less open to forgery is to give them a PIN
+(personal ID number). Record the address and PIN (best that it be a
+random one) for later processing. In the mail you send, ask them to
+include the PIN in their reply. But if it bounces, or the message is
+included via a ``vacation'' script, it'll be there anyway. So it's
+best to ask them to mail back a slight alteration of the PIN, such as
+with the characters reversed, one added or subtracted to each digit, etc.
=head2 How do I decode a MIME/BASE64 string?
@@ -237,7 +380,7 @@ format after minor transliterations:
$len = pack("c", 32 + 0.75*length); # compute length byte
print unpack("u", $len . $_); # uudecode and print
-=head2 How do I return the user's email address?
+=head2 How do I return the user's mail address?
On systems that support getpwuid, the $E<lt> variable and the
Sys::Hostname module (which is part of the standard perl distribution),
@@ -246,9 +389,9 @@ you can probably try using something like this:
use Sys::Hostname;
$address = sprintf('%s@%s', getpwuid($<), hostname);
-Company policies on email address can mean that this generates addresses
-that the company's email system will not accept, so you should ask for
-users' email addresses when this matters. Furthermore, not all systems
+Company policies on mail address can mean that this generates addresses
+that the company's mail system will not accept, so you should ask for
+users' mail addresses when this matters. Furthermore, not all systems
on which Perl runs are so forthcoming with this information as is Unix.
The Mail::Util module from CPAN (part of the MailTools package) provides a
@@ -257,13 +400,51 @@ It makes a more intelligent guess than the code above, using information
given when the module was installed, but it could still be incorrect.
Again, the best way is often just to ask the user.
-=head2 How do I send/read mail?
+=head2 How do I send mail?
-Sending mail: the Mail::Mailer module from CPAN (part of the MailTools
-package) is UNIX-centric, while Mail::Internet uses Net::SMTP which is
-not UNIX-centric. Reading mail: use the Mail::Folder module from CPAN
-(part of the MailFolder package) or the Mail::Internet module from
-CPAN (also part of the MailTools package).
+Use the C<sendmail> program directly:
+
+ open(SENDMAIL, "|/usr/lib/sendmail -oi -t -odq")
+ or die "Can't fork for sendmail: $!\n";
+ print SENDMAIL <<"EOF";
+ From: User Originating Mail <me\@host>
+ To: Final Destination <you\@otherhost>
+ Subject: A relevant subject line
+
+ Body of the message goes here after the blank line
+ in as many lines as you like.
+ EOF
+ close(SENDMAIL) or warn "sendmail didn't close nicely";
+
+The B<-oi> option prevents sendmail from interpreting a line consisting
+of a single dot as "end of message". The B<-t> option says to use the
+headers to decide who to send the message to, and B<-odq> says to put
+the message into the queue. This last option means your message won't
+be immediately delivered, so leave it out if you want immediate
+delivery.
+
+Or use the CPAN module Mail::Mailer:
+
+ use Mail::Mailer;
+
+ $mailer = Mail::Mailer->new();
+ $mailer->open({ From => $from_address,
+ To => $to_address,
+ Subject => $subject,
+ })
+ or die "Can't open: $!\n";
+ print $mailer $body;
+ $mailer->close();
+
+The Mail::Internet module uses Net::SMTP which is less Unix-centric than
+Mail::Mailer, but less reliable. Avoid raw SMTP commands. There
+are many reasons to use a mail transport agent like sendmail. These
+include queueing, MX records, and security.
+
+=head2 How do I read mail?
+
+Use the Mail::Folder module from CPAN (part of the MailFolder package) or
+the Mail::Internet module from CPAN (also part of the MailTools package).
# sending mail
use Mail::Internet;
@@ -282,11 +463,39 @@ CPAN (also part of the MailTools package).
# send it
$mail->smtpsend or die;
+Often a module is overkill, though. Here's a mail sorter.
+
+ #!/usr/bin/perl
+ # bysub1 - simple sort by subject
+ my(@msgs, @sub);
+ my $msgno = -1;
+ $/ = ''; # paragraph reads
+ while (<>) {
+ if (/^From/m) {
+ /^Subject:\s*(?:Re:\s*)*(.*)/mi;
+ $sub[++$msgno] = lc($1) || '';
+ }
+ $msgs[$msgno] .= $_;
+ }
+ for my $i (sort { $sub[$a] cmp $sub[$b] || $a <=> $b } (0 .. $#msgs)) {
+ print $msgs[$i];
+ }
+
+Or more succinctly,
+
+ #!/usr/bin/perl -n00
+ # bysub2 - awkish sort-by-subject
+ BEGIN { $msgno = -1 }
+ $sub[++$msgno] = (/^Subject:\s*(?:Re:\s*)*(.*)/mi)[0] if /^From/m;
+ $msg[$msgno] .= $_;
+ END { print @msg[ sort { $sub[$a] cmp $sub[$b] || $a <=> $b } (0 .. $#msg) ] }
+
=head2 How do I find out my hostname/domainname/IP address?
-A lot of code has historically cavalierly called the C<`hostname`>
-program. While sometimes expedient, this isn't very portable. It's
-one of those tradeoffs of convenience versus portability.
+The normal way to find your own hostname is to call the C<`hostname`>
+program. While sometimes expedient, this has some problems, such as
+not knowing whether you've got the canonical name or not. It's one of
+those tradeoffs of convenience versus portability.
The Sys::Hostname module (part of the standard perl distribution) will
give you the hostname after which you can find out the IP address
@@ -295,7 +504,7 @@ give you the hostname after which you can find out the IP address
use Socket;
use Sys::Hostname;
my $host = hostname();
- my $addr = inet_ntoa(scalar(gethostbyname($name)) || 'localhost');
+ my $addr = inet_ntoa(scalar gethostbyname($host || 'localhost'));
Probably the simplest way to learn your DNS domain name is to grok
it out of /etc/resolv.conf, at least under Unix. Of course, this
@@ -322,10 +531,24 @@ available from CPAN) is more complex but can put as well as fetch.
A DCE::RPC module is being developed (but is not yet available), and
will be released as part of the DCE-Perl package (available from
-CPAN). No ONC::RPC module is known.
+CPAN). The rpcgen suite, available from CPAN/authors/id/JAKE/, is
+an RPC stub generator and includes an RPC::ONC module.
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997 Tom Christiansen and Nathan Torkington.
-All rights reserved. See L<perlfaq> for distribution information.
+Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
+All rights reserved.
+
+When included as part of the Standard Version of Perl, or as part of
+its complete documentation whether printed or otherwise, this work
+may be distributed only under the terms of Perl's Artistic Licence.
+Any distribution of this file or derivatives thereof I<outside>
+of that package require that special arrangements be made with
+copyright holder.
+
+Irrespective of its distribution, all code examples in this file
+are hereby placed into the public domain. You are permitted and
+encouraged to use this code in your own programs for fun
+or for profit as you see fit. A simple comment in the code giving
+credit would be courteous but is not required.
diff --git a/gnu/usr.bin/perl/pod/perlform.pod b/gnu/usr.bin/perl/pod/perlform.pod
index 7e540b8ff69..b2c87fa9b07 100644
--- a/gnu/usr.bin/perl/pod/perlform.pod
+++ b/gnu/usr.bin/perl/pod/perlform.pod
@@ -20,8 +20,8 @@ apart from all the other "types" in Perl. This means that if you have a
function named "Foo", it is not the same thing as having a format named
"Foo". However, the default name for the format associated with a given
filehandle is the same as the name of the filehandle. Thus, the default
-format for STDOUT is name "STDOUT", and the default format for filehandle
-TEMP is name "TEMP". They just look the same. They aren't.
+format for STDOUT is named "STDOUT", and the default format for filehandle
+TEMP is named "TEMP". They just look the same. They aren't.
Output record formats are declared as follows:
@@ -233,11 +233,11 @@ of the page, however wide it is." You have to specify where it goes.
The truly desperate can generate their own format on the fly, based
on the current number of columns, and then eval() it:
- $format = "format STDOUT = \n";
- . '^' . '<' x $cols . "\n";
- . '$entry' . "\n";
- . "\t^" . "<" x ($cols-8) . "~~\n";
- . '$entry' . "\n";
+ $format = "format STDOUT = \n"
+ . '^' . '<' x $cols . "\n"
+ . '$entry' . "\n"
+ . "\t^" . "<" x ($cols-8) . "~~\n"
+ . '$entry' . "\n"
. ".\n";
print $format if $Debugging;
eval $format;
@@ -295,7 +295,7 @@ For example:
print "Wow, I just stored `$^A' in the accumulator!\n";
-Or to make an swrite() subroutine which is to write() what sprintf()
+Or to make an swrite() subroutine, which is to write() what sprintf()
is to printf(), do this:
use Carp;
@@ -315,18 +315,18 @@ is to printf(), do this:
=head1 WARNINGS
-The lone dot that ends a format can also prematurely end an email
+The lone dot that ends a format can also prematurely end a mail
message passing through a misconfigured Internet mailer (and based on
experience, such misconfiguration is the rule, not the exception). So
-when sending format code through email, you should indent it so that
+when sending format code through mail, you should indent it so that
the format-ending dot is not on the left margin; this will prevent
-email cutoff.
+SMTP cutoff.
Lexical variables (declared with "my") are not visible within a
format unless the format is declared within the scope of the lexical
variable. (They weren't visible at all before version 5.001.)
-Formats are the only part of Perl which unconditionally use information
+Formats are the only part of Perl that unconditionally use information
from a program's locale; if a program's environment specifies an
LC_NUMERIC locale, it is always used to specify the decimal point
character in formatted output. Perl ignores all other aspects of locale
@@ -335,3 +335,12 @@ cannot be controlled by C<use locale> because the pragma is tied to the
block structure of the program, and, for historical reasons, formats
exist outside that block structure. See L<perllocale> for further
discussion of locale handling.
+
+Inside of an expression, the whitespace characters \n, \t and \f are
+considered to be equivalent to a single space. Thus, you could think
+of this filter being applied to each value in the format:
+
+ $value =~ tr/\n\t\f/ /;
+
+The remaining whitespace character, \r, forces the printing of a new
+line if allowed by the picture line.
diff --git a/gnu/usr.bin/perl/pod/perlfunc.pod b/gnu/usr.bin/perl/pod/perlfunc.pod
index aa1e82eac83..5fb78635bda 100644
--- a/gnu/usr.bin/perl/pod/perlfunc.pod
+++ b/gnu/usr.bin/perl/pod/perlfunc.pod
@@ -12,11 +12,12 @@ operators take more than one argument, while unary operators can never
take more than one argument. Thus, a comma terminates the argument of
a unary operator, but merely separates the arguments of a list
operator. A unary operator generally provides a scalar context to its
-argument, while a list operator may provide either scalar and list
+argument, while a list operator may provide either scalar or list
contexts for its arguments. If it does both, the scalar arguments will
be first, and the list argument will follow. (Note that there can ever
-be only one list argument.) For instance, splice() has three scalar
-arguments followed by a list.
+be only one such list argument.) For instance, splice() has three scalar
+arguments followed by a list, whereas gethostbyname() has four scalar
+arguments.
In the syntax descriptions that follow, list operators that expect a
list (and provide list context for the elements of the list) are shown
@@ -47,31 +48,46 @@ example, the third line above produces:
print (...) interpreted as function at - line 1.
Useless use of integer addition in void context at - line 1.
+A few functions take no arguments at all, and therefore work as neither
+unary nor list operators. These include such functions as C<time>
+and C<endpwent>. For example, C<time+86_400> always means
+C<time() + 86_400>.
+
For functions that can be used in either a scalar or list context,
nonabortive failure is generally indicated in a scalar context by
returning the undefined value, and in a list context by returning the
null list.
-Remember the following rule:
-
-=over 8
-
-=item I<THERE IS NO GENERAL RULE FOR CONVERTING A LIST INTO A SCALAR!>
-
-=back
-
+Remember the following important rule: There is B<no rule> that relates
+the behavior of an expression in list context to its behavior in scalar
+context, or vice versa. It might do two totally different things.
Each operator and function decides which sort of value it would be most
-appropriate to return in a scalar context. Some operators return the
-length of the list that would have been returned in a list context. Some
+appropriate to return in scalar context. Some operators return the
+length of the list that would have been returned in list context. Some
operators return the first value in the list. Some operators return the
last value in the list. Some operators return a count of successful
operations. In general, they do what you want, unless you want
consistency.
+An named array in scalar context is quite different from what would at
+first glance appear to be a list in scalar context. You can't get a list
+like C<(1,2,3)> into being in scalar context, because the compiler knows
+the context at compile time. It would generate the scalar comma operator
+there, not the list construction version of the comma. That means it
+was never a list to start with.
+
+In general, functions in Perl that serve as wrappers for system calls
+of the same name (like chown(2), fork(2), closedir(2), etc.) all return
+true when they succeed and C<undef> otherwise, as is usually mentioned
+in the descriptions below. This is different from the C interfaces,
+which return C<-1> on failure. Exceptions to this rule are C<wait()>,
+C<waitpid()>, and C<syscall()>. System calls also set the special C<$!>
+variable on failure. Other functions do not, except accidentally.
+
=head2 Perl Functions by Category
Here are Perl's functions (including things that look like
-functions, like some of the keywords and named operators)
+functions, like some keywords and named operators)
arranged by category. Some functions appear in more
than one place.
@@ -79,139 +95,173 @@ than one place.
=item Functions for SCALARs or strings
-chomp, chop, chr, crypt, hex, index, lc, lcfirst, length,
-oct, ord, pack, q/STRING/, qq/STRING/, reverse, rindex,
-sprintf, substr, tr///, uc, ucfirst, y///
+C<chomp>, C<chop>, C<chr>, C<crypt>, C<hex>, C<index>, C<lc>, C<lcfirst>,
+C<length>, C<oct>, C<ord>, C<pack>, C<q/STRING/>, C<qq/STRING/>, C<reverse>,
+C<rindex>, C<sprintf>, C<substr>, C<tr///>, C<uc>, C<ucfirst>, C<y///>
=item Regular expressions and pattern matching
-m//, pos, quotemeta, s///, split, study
+C<m//>, C<pos>, C<quotemeta>, C<s///>, C<split>, C<study>, C<qr//>
=item Numeric functions
-abs, atan2, cos, exp, hex, int, log, oct, rand, sin, sqrt,
-srand
+C<abs>, C<atan2>, C<cos>, C<exp>, C<hex>, C<int>, C<log>, C<oct>, C<rand>,
+C<sin>, C<sqrt>, C<srand>
=item Functions for real @ARRAYs
-pop, push, shift, splice, unshift
+C<pop>, C<push>, C<shift>, C<splice>, C<unshift>
=item Functions for list data
-grep, join, map, qw/STRING/, reverse, sort, unpack
+C<grep>, C<join>, C<map>, C<qw/STRING/>, C<reverse>, C<sort>, C<unpack>
=item Functions for real %HASHes
-delete, each, exists, keys, values
+C<delete>, C<each>, C<exists>, C<keys>, C<values>
=item Input and output functions
-binmode, close, closedir, dbmclose, dbmopen, die, eof,
-fileno, flock, format, getc, print, printf, read, readdir,
-rewinddir, seek, seekdir, select, syscall, sysread, sysseek,
-syswrite, tell, telldir, truncate, warn, write
+C<binmode>, C<close>, C<closedir>, C<dbmclose>, C<dbmopen>, C<die>, C<eof>,
+C<fileno>, C<flock>, C<format>, C<getc>, C<print>, C<printf>, C<read>,
+C<readdir>, C<rewinddir>, C<seek>, C<seekdir>, C<select>, C<syscall>,
+C<sysread>, C<sysseek>, C<syswrite>, C<tell>, C<telldir>, C<truncate>,
+C<warn>, C<write>
=item Functions for fixed length data or records
-pack, read, syscall, sysread, syswrite, unpack, vec
+C<pack>, C<read>, C<syscall>, C<sysread>, C<syswrite>, C<unpack>, C<vec>
=item Functions for filehandles, files, or directories
-I<-X>, chdir, chmod, chown, chroot, fcntl, glob, ioctl, link,
-lstat, mkdir, open, opendir, readlink, rename, rmdir,
-stat, symlink, umask, unlink, utime
+C<-I<X>>, C<chdir>, C<chmod>, C<chown>, C<chroot>, C<fcntl>, C<glob>,
+C<ioctl>, C<link>, C<lstat>, C<mkdir>, C<open>, C<opendir>,
+C<readlink>, C<rename>, C<rmdir>, C<stat>, C<symlink>, C<umask>,
+C<unlink>, C<utime>
=item Keywords related to the control flow of your perl program
-caller, continue, die, do, dump, eval, exit, goto, last,
-next, redo, return, sub, wantarray
+C<caller>, C<continue>, C<die>, C<do>, C<dump>, C<eval>, C<exit>,
+C<goto>, C<last>, C<next>, C<redo>, C<return>, C<sub>, C<wantarray>
=item Keywords related to scoping
-caller, import, local, my, package, use
+C<caller>, C<import>, C<local>, C<my>, C<package>, C<use>
=item Miscellaneous functions
-defined, dump, eval, formline, local, my, reset, scalar,
-undef, wantarray
+C<defined>, C<dump>, C<eval>, C<formline>, C<local>, C<my>, C<reset>,
+C<scalar>, C<undef>, C<wantarray>
=item Functions for processes and process groups
-alarm, exec, fork, getpgrp, getppid, getpriority, kill,
-pipe, qx/STRING/, setpgrp, setpriority, sleep, system,
-times, wait, waitpid
+C<alarm>, C<exec>, C<fork>, C<getpgrp>, C<getppid>, C<getpriority>, C<kill>,
+C<pipe>, C<qx/STRING/>, C<setpgrp>, C<setpriority>, C<sleep>, C<system>,
+C<times>, C<wait>, C<waitpid>
=item Keywords related to perl modules
-do, import, no, package, require, use
+C<do>, C<import>, C<no>, C<package>, C<require>, C<use>
=item Keywords related to classes and object-orientedness
-bless, dbmclose, dbmopen, package, ref, tie, tied, untie, use
+C<bless>, C<dbmclose>, C<dbmopen>, C<package>, C<ref>, C<tie>, C<tied>,
+C<untie>, C<use>
=item Low-level socket functions
-accept, bind, connect, getpeername, getsockname,
-getsockopt, listen, recv, send, setsockopt, shutdown,
-socket, socketpair
+C<accept>, C<bind>, C<connect>, C<getpeername>, C<getsockname>,
+C<getsockopt>, C<listen>, C<recv>, C<send>, C<setsockopt>, C<shutdown>,
+C<socket>, C<socketpair>
=item System V interprocess communication functions
-msgctl, msgget, msgrcv, msgsnd, semctl, semget, semop,
-shmctl, shmget, shmread, shmwrite
+C<msgctl>, C<msgget>, C<msgrcv>, C<msgsnd>, C<semctl>, C<semget>, C<semop>,
+C<shmctl>, C<shmget>, C<shmread>, C<shmwrite>
=item Fetching user and group info
-endgrent, endhostent, endnetent, endpwent, getgrent,
-getgrgid, getgrnam, getlogin, getpwent, getpwnam,
-getpwuid, setgrent, setpwent
+C<endgrent>, C<endhostent>, C<endnetent>, C<endpwent>, C<getgrent>,
+C<getgrgid>, C<getgrnam>, C<getlogin>, C<getpwent>, C<getpwnam>,
+C<getpwuid>, C<setgrent>, C<setpwent>
=item Fetching network info
-endprotoent, endservent, gethostbyaddr, gethostbyname,
-gethostent, getnetbyaddr, getnetbyname, getnetent,
-getprotobyname, getprotobynumber, getprotoent,
-getservbyname, getservbyport, getservent, sethostent,
-setnetent, setprotoent, setservent
+C<endprotoent>, C<endservent>, C<gethostbyaddr>, C<gethostbyname>,
+C<gethostent>, C<getnetbyaddr>, C<getnetbyname>, C<getnetent>,
+C<getprotobyname>, C<getprotobynumber>, C<getprotoent>,
+C<getservbyname>, C<getservbyport>, C<getservent>, C<sethostent>,
+C<setnetent>, C<setprotoent>, C<setservent>
=item Time-related functions
-gmtime, localtime, time, times
+C<gmtime>, C<localtime>, C<time>, C<times>
=item Functions new in perl5
-abs, bless, chomp, chr, exists, formline, glob, import, lc,
-lcfirst, map, my, no, prototype, qx, qw, readline, readpipe,
-ref, sub*, sysopen, tie, tied, uc, ucfirst, untie, use
+C<abs>, C<bless>, C<chomp>, C<chr>, C<exists>, C<formline>, C<glob>,
+C<import>, C<lc>, C<lcfirst>, C<map>, C<my>, C<no>, C<prototype>, C<qx>,
+C<qw>, C<readline>, C<readpipe>, C<ref>, C<sub*>, C<sysopen>, C<tie>,
+C<tied>, C<uc>, C<ucfirst>, C<untie>, C<use>
* - C<sub> was a keyword in perl4, but in perl5 it is an
-operator which can be used in expressions.
+operator, which can be used in expressions.
=item Functions obsoleted in perl5
-dbmclose, dbmopen
+C<dbmclose>, C<dbmopen>
=back
+=head2 Portability
+
+Perl was born in Unix and can therefore access all common Unix
+system calls. In non-Unix environments, the functionality of some
+Unix system calls may not be available, or details of the available
+functionality may differ slightly. The Perl functions affected
+by this are:
+
+C<-X>, C<binmode>, C<chmod>, C<chown>, C<chroot>, C<crypt>,
+C<dbmclose>, C<dbmopen>, C<dump>, C<endgrent>, C<endhostent>,
+C<endnetent>, C<endprotoent>, C<endpwent>, C<endservent>, C<exec>,
+C<fcntl>, C<flock>, C<fork>, C<getgrent>, C<getgrgid>, C<gethostent>,
+C<getlogin>, C<getnetbyaddr>, C<getnetbyname>, C<getnetent>,
+C<getppid>, C<getprgp>, C<getpriority>, C<getprotobynumber>,
+C<getprotoent>, C<getpwent>, C<getpwnam>, C<getpwuid>,
+C<getservbyport>, C<getservent>, C<getsockopt>, C<glob>, C<ioctl>,
+C<kill>, C<link>, C<lstat>, C<msgctl>, C<msgget>, C<msgrcv>,
+C<msgsnd>, C<open>, C<pipe>, C<readlink>, C<rename>, C<select>, C<semctl>,
+C<semget>, C<semop>, C<setgrent>, C<sethostent>, C<setnetent>,
+C<setpgrp>, C<setpriority>, C<setprotoent>, C<setpwent>,
+C<setservent>, C<setsockopt>, C<shmctl>, C<shmget>, C<shmread>,
+C<shmwrite>, C<socket>, C<socketpair>, C<stat>, C<symlink>, C<syscall>,
+C<sysopen>, C<system>, C<times>, C<truncate>, C<umask>, C<unlink>,
+C<utime>, C<wait>, C<waitpid>
+
+For more information about the portability of these functions, see
+L<perlport> and other available platform-specific documentation.
+
=head2 Alphabetical Listing of Perl Functions
=over 8
-=item -X FILEHANDLE
+=item I<-X> FILEHANDLE
-=item -X EXPR
+=item I<-X> EXPR
-=item -X
+=item I<-X>
A file test, where X is one of the letters listed below. This unary
operator takes one argument, either a filename or a filehandle, and
tests the associated file to see if something is true about it. If the
-argument is omitted, tests $_, except for C<-t>, which tests STDIN.
+argument is omitted, tests C<$_>, except for C<-t>, which tests STDIN.
Unless otherwise documented, it returns C<1> for TRUE and C<''> for FALSE, or
the undefined value if the file doesn't exist. Despite the funny
names, precedence is the same as any other named unary operator, and
the argument may be parenthesized like any other unary operator. The
operator may be any of:
+X<-r>X<-w>X<-x>X<-o>X<-R>X<-W>X<-X>X<-O>X<-e>X<-z>X<-s>X<-f>X<-d>X<-l>X<-p>
+X<-S>X<-b>X<-c>X<-t>X<-u>X<-g>X<-k>X<-T>X<-B>X<-M>X<-A>X<-C>
-r File is readable by effective uid/gid.
-w File is writable by effective uid/gid.
@@ -230,7 +280,7 @@ operator may be any of:
-f File is a plain file.
-d File is a directory.
-l File is a symbolic link.
- -p File is a named pipe (FIFO).
+ -p File is a named pipe (FIFO), or Filehandle is a pipe.
-S File is a socket.
-b File is a block special file.
-c File is a character special file.
@@ -247,30 +297,35 @@ operator may be any of:
-A Same for access time.
-C Same for inode change time.
-The interpretation of the file permission operators C<-r>, C<-R>, C<-w>,
-C<-W>, C<-x>, and C<-X> is based solely on the mode of the file and the
-uids and gids of the user. There may be other reasons you can't actually
-read, write or execute the file. Also note that, for the superuser,
-C<-r>, C<-R>, C<-w>, and C<-W> always return 1, and C<-x> and C<-X> return
-1 if any execute bit is set in the mode. Scripts run by the superuser may
-thus need to do a stat() to determine the actual mode of the
-file, or temporarily set the uid to something else.
-
Example:
while (<>) {
chop;
next unless -f $_; # ignore specials
- ...
+ #...
}
+The interpretation of the file permission operators C<-r>, C<-R>,
+C<-w>, C<-W>, C<-x>, and C<-X> is by default based solely on the mode
+of the file and the uids and gids of the user. There may be other
+reasons you can't actually read, write, or execute the file. Such
+reasons may be for example network filesystem access controls, ACLs
+(access control lists), read-only filesystems, and unrecognized
+executable formats.
+
+Also note that, for the superuser on the local filesystems, the C<-r>,
+C<-R>, C<-w>, and C<-W> tests always return 1, and C<-x> and C<-X> return 1
+if any execute bit is set in the mode. Scripts run by the superuser
+may thus need to do a stat() to determine the actual mode of the file,
+or temporarily set their effective uid to something else.
+
Note that C<-s/a/b/> does not do a negated substitution. Saying
C<-exp($foo)> still works as expected, however--only single letters
following a minus are interpreted as file tests.
The C<-T> and C<-B> switches work as follows. The first block or so of the
file is examined for odd characters such as strange control codes or
-characters with the high bit set. If too many odd characters (E<gt>30%)
+characters with the high bit set. If too many strange characters (E<gt>30%)
are found, it's a C<-B> file, otherwise it's a C<-T> file. Also, any file
containing null in the first block is considered a binary file. If C<-T>
or C<-B> is used on a filehandle, the current stdio buffer is examined
@@ -279,7 +334,7 @@ file, or a file at EOF when testing a filehandle. Because you have to
read a file to do the C<-T> test, on most occasions you want to use a C<-f>
against the file first, as in C<next unless -f $file && -T $file>.
-If any of the file tests (or either the stat() or lstat() operators) are given
+If any of the file tests (or either the C<stat()> or C<lstat()> operators) are given
the special filehandle consisting of a solitary underline, then the stat
structure of the previous file test (or stat operator) is used, saving
a system call. (This doesn't work with C<-t>, and you need to remember
@@ -303,13 +358,13 @@ symbolic link, not the real file.) Example:
=item abs
Returns the absolute value of its argument.
-If VALUE is omitted, uses $_.
+If VALUE is omitted, uses C<$_>.
=item accept NEWSOCKET,GENERICSOCKET
Accepts an incoming socket connect, just as the accept(2) system call
does. Returns the packed address if it succeeded, FALSE otherwise.
-See example in L<perlipc/"Sockets: Client/Server Communication">.
+See the example in L<perlipc/"Sockets: Client/Server Communication">.
=item alarm SECONDS
@@ -317,32 +372,37 @@ See example in L<perlipc/"Sockets: Client/Server Communication">.
Arranges to have a SIGALRM delivered to this process after the
specified number of seconds have elapsed. If SECONDS is not specified,
-the value stored in $_ is used. (On some machines,
+the value stored in C<$_> is used. (On some machines,
unfortunately, the elapsed time may be up to one second less than you
specified because of how seconds are counted.) Only one timer may be
counting at once. Each call disables the previous timer, and an
-argument of 0 may be supplied to cancel the previous timer without
+argument of C<0> may be supplied to cancel the previous timer without
starting a new one. The returned value is the amount of time remaining
on the previous timer.
For delays of finer granularity than one second, you may use Perl's
-syscall() interface to access setitimer(2) if your system supports it,
-or else see L</select()>. It is usually a mistake to intermix alarm()
-and sleep() calls.
+four-arugment version of select() leaving the first three arguments
+undefined, or you might be able to use the C<syscall()> interface to
+access setitimer(2) if your system supports it. The Time::HiRes module
+from CPAN may also prove useful.
-If you want to use alarm() to time out a system call you need to use an
-eval/die pair. You can't rely on the alarm causing the system call to
-fail with $! set to EINTR because Perl sets up signal handlers to
-restart system calls on some systems. Using eval/die always works.
+It is usually a mistake to intermix C<alarm()>
+and C<sleep()> calls.
+
+If you want to use C<alarm()> to time out a system call you need to use an
+C<eval()>/C<die()> pair. You can't rely on the alarm causing the system call to
+fail with C<$!> set to C<EINTR> because Perl sets up signal handlers to
+restart system calls on some systems. Using C<eval()>/C<die()> always works,
+modulo the caveats given in L<perlipc/"Signals">.
eval {
- local $SIG{ALRM} = sub { die "alarm\n" }; # NB \n required
+ local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
alarm $timeout;
$nread = sysread SOCKET, $buffer, $size;
alarm 0;
};
- die if $@ && $@ ne "alarm\n"; # propagate errors
if ($@) {
+ die unless $@ eq "alarm\n"; # propagate unexpected errors
# timed out
}
else {
@@ -353,7 +413,7 @@ restart system calls on some systems. Using eval/die always works.
Returns the arctangent of Y/X in the range -PI to PI.
-For the tangent operation, you may use the POSIX::tan()
+For the tangent operation, you may use the C<POSIX::tan()>
function, or use the familiar relation:
sub tan { sin($_[0]) / cos($_[0]) }
@@ -368,37 +428,51 @@ L<perlipc/"Sockets: Client/Server Communication">.
=item binmode FILEHANDLE
Arranges for the file to be read or written in "binary" mode in operating
-systems that distinguish between binary and text files. Files that are
-not in binary mode have CR LF sequences translated to LF on input and LF
-translated to CR LF on output. Binmode has no effect under Unix; in MS-DOS
-and similarly archaic systems, it may be imperative--otherwise your
-MS-DOS-damaged C library may mangle your file. The key distinction between
-systems that need binmode and those that don't is their text file
-formats. Systems like Unix and Plan9 that delimit lines with a single
-character, and that encode that character in C as '\n', do not need
-C<binmode>. The rest need it. If FILEHANDLE is an expression, the value
-is taken as the name of the filehandle.
+systems that distinguish between binary and text files. Files that
+are not in binary mode have CR LF sequences translated to LF on input
+and LF translated to CR LF on output. Binmode has no effect under
+many sytems, but in MS-DOS and similarly archaic systems, it may be
+imperative--otherwise your MS-DOS-damaged C library may mangle your file.
+The key distinction between systems that need C<binmode()> and those
+that don't is their text file formats. Systems like Unix, MacOS, and
+Plan9 that delimit lines with a single character, and that encode that
+character in C as C<"\n">, do not need C<binmode()>. The rest may need it.
+If FILEHANDLE is an expression, the value is taken as the name of the
+filehandle.
+
+If the system does care about it, using it when you shouldn't is just as
+perilous as failing to use it when you should. Fortunately for most of
+us, you can't go wrong using binmode() on systems that don't care about
+it, though.
=item bless REF,CLASSNAME
=item bless REF
-This function tells the thingy referenced by REF that it is now
-an object in the CLASSNAME package--or the current package if no CLASSNAME
-is specified, which is often the case. It returns the reference for
-convenience, because a bless() is often the last thing in a constructor.
-Always use the two-argument version if the function doing the blessing
-might be inherited by a derived class. See L<perlobj> for more about the
-blessing (and blessings) of objects.
+This function tells the thingy referenced by REF that it is now an object
+in the CLASSNAME package. If CLASSNAME is omitted, the current package
+is used. Because a C<bless()> is often the last thing in a constructor.
+it returns the reference for convenience. Always use the two-argument
+version if the function doing the blessing might be inherited by a
+derived class. See L<perltoot> and L<perlobj> for more about the blessing
+(and blessings) of objects.
+
+Consider always blessing objects in CLASSNAMEs that are mixed case.
+Namespaces with all lowercase names are considered reserved for
+Perl pragmata. Builtin types have all uppercase names, so to prevent
+confusion, you may wish to avoid such package names as well. Make sure
+that CLASSNAME is a true value.
+
+See L<perlmod/"Perl Modules">.
=item caller EXPR
=item caller
-Returns the context of the current subroutine call. In a scalar context,
+Returns the context of the current subroutine call. In scalar context,
returns the caller's package name if there is a caller, that is, if
-we're in a subroutine or eval() or require(), and the undefined value
-otherwise. In a list context, returns
+we're in a subroutine or C<eval()> or C<require()>, and the undefined value
+otherwise. In list context, returns
($package, $filename, $line) = caller;
@@ -409,24 +483,30 @@ to go back before the current one.
($package, $filename, $line, $subroutine,
$hasargs, $wantarray, $evaltext, $is_require) = caller($i);
-Here $subroutine may be C<"(eval)"> if the frame is not a subroutine
-call, but an C<eval>. In such a case additional elements $evaltext and
-$is_require are set: $is_require is true if the frame is created by a
-C<require> or C<use> statement, $evaltext contains the text of the
+Here C<$subroutine> may be C<"(eval)"> if the frame is not a subroutine
+call, but an C<eval()>. In such a case additional elements C<$evaltext> and
+C<$is_require> are set: C<$is_require> is true if the frame is created by a
+C<require> or C<use> statement, C<$evaltext> contains the text of the
C<eval EXPR> statement. In particular, for a C<eval BLOCK> statement,
-$filename is C<"(eval)">, but $evaltext is undefined. (Note also that
+C<$filename> is C<"(eval)">, but C<$evaltext> is undefined. (Note also that
each C<use> statement creates a C<require> frame inside an C<eval EXPR>)
frame.
Furthermore, when called from within the DB package, caller returns more
-detailed information: it sets the list variable @DB::args to be the
+detailed information: it sets the list variable C<@DB::args> to be the
arguments with which the subroutine was invoked.
+Be aware that the optimizer might have optimized call frames away before
+C<caller()> had a chance to get the information. That means that C<caller(N)>
+might not return information about the call frame you expect it do, for
+C<N E<gt> 1>. In particular, C<@DB::args> might have information from the
+previous time C<caller()> was called.
+
=item chdir EXPR
-Changes the working directory to EXPR, if possible. If EXPR is
-omitted, changes to home directory. Returns TRUE upon success, FALSE
-otherwise. See example under die().
+Changes the working directory to EXPR, if possible. If EXPR is omitted,
+changes to the user's home directory. Returns TRUE upon success,
+FALSE otherwise. See the example under C<die()>.
=item chmod LIST
@@ -438,7 +518,8 @@ successfully changed. See also L</oct>, if all you have is a string.
$cnt = chmod 0755, 'foo', 'bar';
chmod 0755, @executables;
- $mode = '0644'; chmod $mode, 'foo'; # !!! sets mode to --w----r-T
+ $mode = '0644'; chmod $mode, 'foo'; # !!! sets mode to
+ # --w----r-T
$mode = '0644'; chmod oct($mode), 'foo'; # this is better
$mode = 0644; chmod $mode, 'foo'; # this is best
@@ -448,19 +529,19 @@ successfully changed. See also L</oct>, if all you have is a string.
=item chomp
-This is a slightly safer version of L</chop>. It removes any
-line ending that corresponds to the current value of C<$/> (also known as
+This safer version of L</chop> removes any trailing string
+that corresponds to the current value of C<$/> (also known as
$INPUT_RECORD_SEPARATOR in the C<English> module). It returns the total
number of characters removed from all its arguments. It's often used to
remove the newline from the end of an input record when you're worried
-that the final record may be missing its newline. When in paragraph mode
-(C<$/ = "">), it removes all trailing newlines from the string. If
-VARIABLE is omitted, it chomps $_. Example:
+that the final record may be missing its newline. When in paragraph
+mode (C<$/ = "">), it removes all trailing newlines from the string.
+If VARIABLE is omitted, it chomps C<$_>. Example:
while (<>) {
chomp; # avoid \n on last field
@array = split(/:/);
- ...
+ # ...
}
You can actually chomp anything that's an lvalue, including an assignment:
@@ -480,13 +561,13 @@ characters removed is returned.
Chops off the last character of a string and returns the character
chopped. It's used primarily to remove the newline from the end of an
input record, but is much more efficient than C<s/\n//> because it neither
-scans nor copies the string. If VARIABLE is omitted, chops $_.
+scans nor copies the string. If VARIABLE is omitted, chops C<$_>.
Example:
while (<>) {
chop; # avoid \n on last field
@array = split(/:/);
- ...
+ #...
}
You can actually chop anything that's an lvalue, including an assignment:
@@ -495,9 +576,9 @@ You can actually chop anything that's an lvalue, including an assignment:
chop($answer = <STDIN>);
If you chop a list, each element is chopped. Only the value of the
-last chop is returned.
+last C<chop()> is returned.
-Note that chop returns the last character. To return all but the last
+Note that C<chop()> returns the last character. To return all but the last
character, use C<substr($string, 0, -1)>.
=item chown LIST
@@ -513,13 +594,13 @@ Here's an example that looks up nonnumeric uids in the passwd file:
print "User: ";
chop($user = <STDIN>);
- print "Files: "
+ print "Files: ";
chop($pattern = <STDIN>);
($login,$pass,$uid,$gid) = getpwnam($user)
or die "$user not in passwd file";
- @ary = <${pattern}>; # expand filenames
+ @ary = glob($pattern); # expand filenames
chown $uid, $gid, @ary;
On most systems, you are not allowed to change the ownership of the
@@ -532,55 +613,64 @@ restrictions may be relaxed, but this is not a portable assumption.
=item chr
Returns the character represented by that NUMBER in the character set.
-For example, C<chr(65)> is "A" in ASCII. For the reverse, use L</ord>.
+For example, C<chr(65)> is C<"A"> in ASCII. For the reverse, use L</ord>.
-If NUMBER is omitted, uses $_.
+If NUMBER is omitted, uses C<$_>.
=item chroot FILENAME
=item chroot
-This function works as the system call by the same name: it makes the
+This function works like the system call by the same name: it makes the
named directory the new root directory for all further pathnames that
-begin with a "/" by your process and all of its children. (It doesn't
+begin with a C<"/"> by your process and all its children. (It doesn't
change your current working directory, which is unaffected.) For security
reasons, this call is restricted to the superuser. If FILENAME is
-omitted, does chroot to $_.
+omitted, does a C<chroot()> to C<$_>.
=item close FILEHANDLE
+=item close
+
Closes the file or pipe associated with the file handle, returning TRUE
only if stdio successfully flushes buffers and closes the system file
-descriptor.
+descriptor. Closes the currently selected filehandle if the argument
+is omitted.
You don't have to close FILEHANDLE if you are immediately going to do
-another open() on it, because open() will close it for you. (See
-open().) However, an explicit close on an input file resets the line
-counter ($.), while the implicit close done by open() does not.
+another C<open()> on it, because C<open()> will close it for you. (See
+C<open()>.) However, an explicit C<close()> on an input file resets the line
+counter (C<$.>), while the implicit close done by C<open()> does not.
-If the file handle came from a piped open C<close> will additionally
+If the file handle came from a piped open C<close()> will additionally
return FALSE if one of the other system calls involved fails or if the
program exits with non-zero status. (If the only problem was that the
-program exited non-zero $! will be set to 0.) Also, closing a pipe will
-wait for the process executing on the pipe to complete, in case you
-want to look at the output of the pipe afterwards. Closing a pipe
-explicitly also puts the exit status value of the command into C<$?>.
+program exited non-zero C<$!> will be set to C<0>.) Closing a pipe
+also waits for the process executing on the pipe to complete, in case you
+want to look at the output of the pipe afterwards, and
+implicitly puts the exit status value of that command into C<$?>.
+
Example:
open(OUTPUT, '|sort >foo') # pipe to sort
or die "Can't start sort: $!";
- ... # print stuff to output
+ #... # print stuff to output
close OUTPUT # wait for sort to finish
or warn $! ? "Error closing sort pipe: $!"
: "Exit status $? from sort";
open(INPUT, 'foo') # get sort's results
or die "Can't open 'foo' for input: $!";
-FILEHANDLE may be an expression whose value gives the real filehandle name.
+FILEHANDLE may be an expression whose value can be used as an indirect
+filehandle, usually the real filehandle name.
=item closedir DIRHANDLE
-Closes a directory opened by opendir().
+Closes a directory opened by C<opendir()> and returns the success of that
+system call.
+
+DIRHANDLE may be an expression whose value can be used as an indirect
+dirhandle, usually the real dirhandle name.
=item connect SOCKET,NAME
@@ -599,12 +689,31 @@ it can be used to increment a loop variable, even when the loop has been
continued via the C<next> statement (which is similar to the C C<continue>
statement).
+C<last>, C<next>, or C<redo> may appear within a C<continue>
+block. C<last> and C<redo> will behave as if they had been executed within
+the main block. So will C<next>, but since it will execute a C<continue>
+block, it may be more entertaining.
+
+ while (EXPR) {
+ ### redo always comes here
+ do_something;
+ } continue {
+ ### next always comes here
+ do_something_else;
+ # then back the top to re-check EXPR
+ }
+ ### last always comes here
+
+Omitting the C<continue> section is semantically equivalent to using an
+empty one, logically enough. In that case, C<next> goes directly back
+to check the condition at the top of the loop.
+
=item cos EXPR
-Returns the cosine of EXPR (expressed in radians). If EXPR is omitted
-takes cosine of $_.
+Returns the cosine of EXPR (expressed in radians). If EXPR is omitted,
+takes cosine of C<$_>.
-For the inverse cosine operation, you may use the POSIX::acos()
+For the inverse cosine operation, you may use the C<POSIX::acos()>
function, or use this relation:
sub acos { atan2( sqrt(1 - $_[0] * $_[0]), $_[0] ) }
@@ -617,24 +726,30 @@ extirpated as a potential munition). This can prove useful for checking
the password file for lousy passwords, amongst other things. Only the
guys wearing white hats should do this.
-Note that crypt is intended to be a one-way function, much like breaking
+Note that C<crypt()> is intended to be a one-way function, much like breaking
eggs to make an omelette. There is no (known) corresponding decrypt
function. As a result, this function isn't all that useful for
cryptography. (For that, see your nearby CPAN mirror.)
+When verifying an existing encrypted string you should use the encrypted
+text as the salt (like C<crypt($plain, $crypted) eq $crypted>). This
+allows your code to work with the standard C<crypt()> and with more
+exotic implementations. When choosing a new salt create a random two
+character string whose characters come from the set C<[./0-9A-Za-z]>
+(like C<join '', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]>).
+
Here's an example that makes sure that whoever runs this program knows
their own password:
$pwd = (getpwuid($<))[1];
- $salt = substr($pwd, 0, 2);
system "stty -echo";
print "Password: ";
- chop($word = <STDIN>);
+ chomp($word = <STDIN>);
print "\n";
system "stty echo";
- if (crypt($word, $salt) ne $pwd) {
+ if (crypt($word, $pwd) ne $pwd) {
die "Sorry...\n";
} else {
print "ok\n";
@@ -645,32 +760,32 @@ for it is unwise.
=item dbmclose HASH
-[This function has been superseded by the untie() function.]
+[This function has been largely superseded by the C<untie()> function.]
Breaks the binding between a DBM file and a hash.
=item dbmopen HASH,DBNAME,MODE
-[This function has been superseded by the tie() function.]
+[This function has been largely superseded by the C<tie()> function.]
-This binds a dbm(3), ndbm(3), sdbm(3), gdbm(), or Berkeley DB file to a
-hash. HASH is the name of the hash. (Unlike normal open, the first
+This binds a dbm(3), ndbm(3), sdbm(3), gdbm(3), or Berkeley DB file to a
+hash. HASH is the name of the hash. (Unlike normal C<open()>, the first
argument is I<NOT> a filehandle, even though it looks like one). DBNAME
is the name of the database (without the F<.dir> or F<.pag> extension if
any). If the database does not exist, it is created with protection
-specified by MODE (as modified by the umask()). If your system supports
-only the older DBM functions, you may perform only one dbmopen() in your
+specified by MODE (as modified by the C<umask()>). If your system supports
+only the older DBM functions, you may perform only one C<dbmopen()> in your
program. In older versions of Perl, if your system had neither DBM nor
-ndbm, calling dbmopen() produced a fatal error; it now falls back to
+ndbm, calling C<dbmopen()> produced a fatal error; it now falls back to
sdbm(3).
If you don't have write access to the DBM file, you can only read hash
variables, not set them. If you want to test whether you can write,
-either use file tests or try setting a dummy hash entry inside an eval(),
+either use file tests or try setting a dummy hash entry inside an C<eval()>,
which will trap the error.
-Note that functions such as keys() and values() may return huge array
-values when used on large DBM files. You may prefer to use the each()
+Note that functions such as C<keys()> and C<values()> may return huge lists
+when used on large DBM files. You may prefer to use the C<each()>
function to iterate over large DBM files. Example:
# print out history file offsets
@@ -684,6 +799,13 @@ See also L<AnyDBM_File> for a more general description of the pros and
cons of the various dbm approaches, as well as L<DB_File> for a particularly
rich implementation.
+You can control which DBM library you use by loading that library
+before you call dbmopen():
+
+ use DB_File;
+ dbmopen(%NS_Hist, "$ENV{HOME}/.netscape/history.db")
+ or die "Can't open netscape history file: $!";
+
=item defined EXPR
=item defined
@@ -696,16 +818,16 @@ Many operations return C<undef> to indicate failure, end of file,
system error, uninitialized variable, and other exceptional
conditions. This function allows you to distinguish C<undef> from
other values. (A simple Boolean test will not distinguish among
-C<undef>, zero, the empty string, and "0", which are all equally
+C<undef>, zero, the empty string, and C<"0">, which are all equally
false.) Note that since C<undef> is a valid scalar, its presence
-doesn't I<necessarily> indicate an exceptional condition: pop()
+doesn't I<necessarily> indicate an exceptional condition: C<pop()>
returns C<undef> when its argument is an empty array, I<or> when the
element to return happens to be C<undef>.
-You may also use defined() to check whether a subroutine exists. On
-the other hand, use of defined() upon aggregates (hashes and arrays)
-is not guaranteed to produce intuitive results, and should probably be
-avoided.
+You may also use C<defined()> to check whether a subroutine exists, by
+saying C<defined &func> without parentheses. On the other hand, use
+of C<defined()> upon aggregates (hashes and arrays) is not guaranteed to
+produce intuitive results, and should probably be avoided.
When used on a hash element, it tells you whether the value is defined,
not whether the key exists in the hash. Use L</exists> for the latter
@@ -720,22 +842,22 @@ Examples:
sub foo { defined &$bar ? &$bar(@_) : die "No bar"; }
$debugging = 0 unless defined $debugging;
-Note: Many folks tend to overuse defined(), and then are surprised to
-discover that the number 0 and "" (the zero-length string) are, in fact,
+Note: Many folks tend to overuse C<defined()>, and then are surprised to
+discover that the number C<0> and C<""> (the zero-length string) are, in fact,
defined values. For example, if you say
"ab" =~ /a(.*)b/;
-the pattern match succeeds, and $1 is defined, despite the fact that it
+The pattern match succeeds, and C<$1> is defined, despite the fact that it
matched "nothing". But it didn't really match nothing--rather, it
-matched something that happened to be 0 characters long. This is all
+matched something that happened to be zero characters long. This is all
very above-board and honest. When a function returns an undefined value,
it's an admission that it couldn't give you an honest answer. So you
-should use defined() only when you're questioning the integrity of what
-you're trying to do. At other times, a simple comparison to 0 or "" is
+should use C<defined()> only when you're questioning the integrity of what
+you're trying to do. At other times, a simple comparison to C<0> or C<""> is
what you want.
-Currently, using defined() on an entire array or hash reports whether
+Currently, using C<defined()> on an entire array or hash reports whether
memory for that aggregate has ever been allocated. So an array you set
to the empty list appears undefined initially, and one that once was full
and that you then set to the empty list still appears defined. You
@@ -744,12 +866,13 @@ should instead use a simple test for size:
if (@an_array) { print "has array elements\n" }
if (%a_hash) { print "has hash members\n" }
-Using undef() on these, however, does clear their memory and then report
-them as not defined anymore, but you shoudln't do that unless you don't
+Using C<undef()> on these, however, does clear their memory and then report
+them as not defined anymore, but you shouldn't do that unless you don't
plan to use them again, because it saves time when you load them up
-again to have memory already ready to be filled.
+again to have memory already ready to be filled. The normal way to
+free up space used by an aggregate is to assign the empty list.
-This counterintuitive behaviour of defined() on aggregates may be
+This counterintuitive behavior of C<defined()> on aggregates may be
changed, fixed, or broken in a future release of Perl.
See also L</undef>, L</exists>, L</ref>.
@@ -760,7 +883,7 @@ Deletes the specified key(s) and their associated values from a hash.
For each key, returns the deleted value associated with that key, or
the undefined value if there was no such key. Deleting from C<$ENV{}>
modifies the environment. Deleting from a hash tied to a DBM file
-deletes the entry from the DBM file. (But deleting from a tie()d hash
+deletes the entry from the DBM file. (But deleting from a C<tie()>d hash
doesn't necessarily return anything.)
The following deletes all the values of a hash:
@@ -773,21 +896,26 @@ And so does this:
delete @HASH{keys %HASH}
-(But both of these are slower than the undef() command.) Note that the
-EXPR can be arbitrarily complicated as long as the final operation is a
-hash element lookup or hash slice:
+But both of these are slower than just assigning the empty list
+or undefining it:
+
+ %hash = (); # completely empty %hash
+ undef %hash; # forget %hash every existed
+
+Note that the EXPR can be arbitrarily complicated as long as the final
+operation is a hash element lookup or hash slice:
delete $ref->[$x][$y]{$key};
delete @{$ref->[$x][$y]}{$key1, $key2, @morekeys};
=item die LIST
-Outside of an eval(), prints the value of LIST to C<STDERR> and exits with
-the current value of C<$!> (errno). If C<$!> is 0, exits with the value of
+Outside an C<eval()>, prints the value of LIST to C<STDERR> and exits with
+the current value of C<$!> (errno). If C<$!> is C<0>, exits with the value of
C<($? E<gt>E<gt> 8)> (backtick `command` status). If C<($? E<gt>E<gt> 8)>
-is 0, exits with 255. Inside an eval(), the error message is stuffed into
-C<$@>, and the eval() is terminated with the undefined value; this makes
-die() the way to raise an exception.
+is C<0>, exits with C<255>. Inside an C<eval(),> the error message is stuffed into
+C<$@> and the C<eval()> is terminated with the undefined value. This makes
+C<die()> the way to raise an exception.
Equivalent examples:
@@ -796,8 +924,13 @@ Equivalent examples:
If the value of EXPR does not end in a newline, the current script line
number and input line number (if any) are also printed, and a newline
-is supplied. Hint: sometimes appending ", stopped" to your message
-will cause it to make better sense when the string "at foo line 123" is
+is supplied. Note that the "input line number" (also known as "chunk")
+is subject to whatever notion of "line" happens to be currently in
+effect, and is also available as the special variable C<$.>.
+See L<perlvar/"$/"> and L<perlvar/"$.">.
+
+Hint: sometimes appending C<", stopped"> to your message
+will cause it to make better sense when the string C<"at foo line 123"> is
appended. Suppose you are running script "canasta".
die "/etc/games is no good";
@@ -808,30 +941,53 @@ produce, respectively
/etc/games is no good at canasta line 123.
/etc/games is no good, stopped at canasta line 123.
-See also exit() and warn().
+See also exit(), warn(), and the Carp module.
-If LIST is empty and $@ already contains a value (typically from a
-previous eval) that value is reused after appending "\t...propagated".
+If LIST is empty and C<$@> already contains a value (typically from a
+previous eval) that value is reused after appending C<"\t...propagated">.
This is useful for propagating exceptions:
eval { ... };
die unless $@ =~ /Expected exception/;
-If $@ is empty then the string "Died" is used.
+If C<$@> is empty then the string C<"Died"> is used.
+
+die() can also be called with a reference argument. If this happens to be
+trapped within an eval(), $@ contains the reference. This behavior permits
+a more elaborate exception handling implementation using objects that
+maintain arbitary state about the nature of the exception. Such a scheme
+is sometimes preferable to matching particular string values of $@ using
+regular expressions. Here's an example:
+
+ eval { ... ; die Some::Module::Exception->new( FOO => "bar" ) };
+ if ($@) {
+ if (ref($@) && UNIVERSAL::isa($@,"Some::Module::Exception")) {
+ # handle Some::Module::Exception
+ }
+ else {
+ # handle all other possible exceptions
+ }
+ }
-You can arrange for a callback to be called just before the die() does
+Since perl will stringify uncaught exception messages before displaying
+them, you may want to overload stringification operations on such custom
+exception objects. See L<overload> for details about that.
+
+You can arrange for a callback to be run just before the C<die()> does
its deed, by setting the C<$SIG{__DIE__}> hook. The associated handler
will be called with the error text and can change the error message, if
-it sees fit, by calling die() again. See L<perlvar/$SIG{expr}> for details on
+it sees fit, by calling C<die()> again. See L<perlvar/$SIG{expr}> for details on
setting C<%SIG> entries, and L<"eval BLOCK"> for some examples.
-Note that the C<$SIG{__DIE__}> hook is called even inside eval()ed
-blocks/strings. If one wants the hook to do nothing in such
+Note that the C<$SIG{__DIE__}> hook is currently called even inside
+eval()ed blocks/strings! If one wants the hook to do nothing in such
situations, put
die @_ if $^S;
-as the first line of the handler (see L<perlvar/$^S>).
+as the first line of the handler (see L<perlvar/$^S>). Because this
+promotes action at a distance, this counterintuitive behavior may be fixed
+in a future release.
=item do BLOCK
@@ -840,6 +996,10 @@ sequence of commands indicated by BLOCK. When modified by a loop
modifier, executes the BLOCK once before testing the loop condition.
(On other statements the loop modifiers test the conditional first.)
+C<do BLOCK> does I<not> count as a loop, so the loop control statements
+C<next>, C<last>, or C<redo> cannot be used to leave or restart the block.
+See L<perlsyn> for alternative strategies.
+
=item do SUBROUTINE(LIST)
A deprecated form of subroutine call. See L<perlsub>.
@@ -856,26 +1016,49 @@ is just like
scalar eval `cat stat.pl`;
-except that it's more efficient, more concise, keeps track of the
-current filename for error messages, and searches all the B<-I>
-libraries if the file isn't in the current directory (see also the @INC
-array in L<perlvar/Predefined Names>). It's the same, however, in that it does
-reparse the file every time you call it, so you probably don't want to
-do this inside a loop.
+except that it's more efficient and concise, keeps track of the current
+filename for error messages, searches the @INC libraries, and updates
+C<%INC> if the file is found. See L<perlvar/Predefined Names> for these
+variables. It also differs in that code evaluated with C<do FILENAME>
+cannot see lexicals in the enclosing scope; C<eval STRING> does. It's the
+same, however, in that it does reparse the file every time you call it,
+so you probably don't want to do this inside a loop.
+
+If C<do> cannot read the file, it returns undef and sets C<$!> to the
+error. If C<do> can read the file but cannot compile it, it
+returns undef and sets an error message in C<$@>. If the file is
+successfully compiled, C<do> returns the value of the last expression
+evaluated.
Note that inclusion of library modules is better done with the
-use() and require() operators, which also do error checking
+C<use()> and C<require()> operators, which also do automatic error checking
and raise an exception if there's a problem.
+You might like to use C<do> to read in a program configuration
+file. Manual error checking can be done this way:
+
+ # read in config files: system first, then user
+ for $file ("/share/prog/defaults.rc",
+ "$ENV{HOME}/.someprogrc")
+ {
+ unless ($return = do $file) {
+ warn "couldn't parse $file: $@" if $@;
+ warn "couldn't do $file: $!" unless defined $return;
+ warn "couldn't run $file" unless $return;
+ }
+ }
+
=item dump LABEL
+=item dump
+
This causes an immediate core dump. Primarily this is so that you can
use the B<undump> program to turn your core dump into an executable binary
after having initialized all your variables at the beginning of the
program. When the new binary is executed it will begin by executing a
C<goto LABEL> (with all the restrictions that C<goto> suffers). Think of
-it as a goto with an intervening core dump and reincarnation. If LABEL
-is omitted, restarts the program from the top. WARNING: any files
+it as a goto with an intervening core dump and reincarnation. If C<LABEL>
+is omitted, restarts the program from the top. WARNING: Any files
opened at the time of the dump will NOT be open any more when the
program is reincarnated, with possible resulting confusion on the part
of Perl. See also B<-u> option in L<perlrun>.
@@ -900,21 +1083,29 @@ Example:
QUICKSTART:
Getopt('f');
+This operator is largely obsolete, partly because it's very hard to
+convert a core file into an executable, and because the real perl-to-C
+compiler has superseded it.
+
=item each HASH
-When called in a list context, returns a 2-element array consisting of the
+When called in list context, returns a 2-element list consisting of the
key and value for the next element of a hash, so that you can iterate over
-it. When called in a scalar context, returns the key for only the next
-element in the hash. (Note: Keys may be "0" or "", which are logically
+it. When called in scalar context, returns the key for only the "next"
+element in the hash. (Note: Keys may be C<"0"> or C<"">, which are logically
false; you may wish to avoid constructs like C<while ($k = each %foo) {}>
for this reason.)
-Entries are returned in an apparently random order. When the hash is
-entirely read, a null array is returned in list context (which when
-assigned produces a FALSE (0) value), and C<undef> is returned in a
-scalar context. The next call to each() after that will start iterating
-again. There is a single iterator for each hash, shared by all each(),
-keys(), and values() function calls in the program; it can be reset by
+Entries are returned in an apparently random order. The actual random
+order is subject to change in future versions of perl, but it is guaranteed
+to be in the same order as either the C<keys()> or C<values()> function
+would produce on the same (unmodified) hash.
+
+When the hash is entirely read, a null array is returned in list context
+(which when assigned produces a FALSE (C<0>) value), and C<undef> in
+scalar context. The next call to C<each()> after that will start iterating
+again. There is a single iterator for each hash, shared by all C<each()>,
+C<keys()>, and C<values()> function calls in the program; it can be reset by
reading all the elements from the hash, or by evaluating C<keys HASH> or
C<values HASH>. If you add or delete elements of a hash while you're
iterating over it, you may get entries skipped or duplicated, so don't.
@@ -926,7 +1117,7 @@ only in a different order:
print "$key=$value\n";
}
-See also keys() and values().
+See also C<keys()>, C<values()> and C<sort()>.
=item eof FILEHANDLE
@@ -936,61 +1127,80 @@ See also keys() and values().
Returns 1 if the next read on FILEHANDLE will return end of file, or if
FILEHANDLE is not open. FILEHANDLE may be an expression whose value
-gives the real filehandle name. (Note that this function actually
-reads a character and then ungetc()s it, so it is not very useful in an
+gives the real filehandle. (Note that this function actually
+reads a character and then C<ungetc()>s it, so isn't very useful in an
interactive context.) Do not read from a terminal file (or call
C<eof(FILEHANDLE)> on it) after end-of-file is reached. Filetypes such
as terminals may lose the end-of-file condition if you do.
An C<eof> without an argument uses the last file read as argument.
-Empty parentheses () may be used to indicate the pseudo file formed of
-the files listed on the command line, i.e., C<eof()> is reasonable to
-use inside a C<while (E<lt>E<gt>)> loop to detect the end of only the
-last file. Use C<eof(ARGV)> or eof without the parentheses to test
-I<EACH> file in a while (E<lt>E<gt>) loop. Examples:
+Using C<eof()> with empty parentheses is very different. It indicates
+the pseudo file formed of the files listed on the command line, i.e.,
+C<eof()> is reasonable to use inside a C<while (E<lt>E<gt>)> loop to
+detect the end of only the last file. Use C<eof(ARGV)> or eof without the
+parentheses to test I<EACH> file in a while (E<lt>E<gt>) loop. Examples:
# reset line numbering on each input file
while (<>) {
+ next if /^\s*#/; # skip comments
print "$.\t$_";
- close(ARGV) if (eof); # Not eof().
+ } continue {
+ close ARGV if eof; # Not eof()!
}
# insert dashes just before last line of last file
while (<>) {
- if (eof()) {
+ if (eof()) { # check for end of current file
print "--------------\n";
- close(ARGV); # close or break; is needed if we
+ close(ARGV); # close or last; is needed if we
# are reading from the terminal
}
print;
}
Practical hint: you almost never need to use C<eof> in Perl, because the
-input operators return undef when they run out of data.
+input operators return false values when they run out of data, or if there
+was an error.
=item eval EXPR
=item eval BLOCK
-EXPR is parsed and executed as if it were a little Perl program. It
-is executed in the context of the current Perl program, so that any
+In the first form, the return value of EXPR is parsed and executed as if it
+were a little Perl program. The value of the expression (which is itself
+determined within scalar context) is first parsed, and if there weren't any
+errors, executed in the context of the current Perl program, so that any
variable settings or subroutine and format definitions remain afterwards.
-The value returned is the value of the last expression evaluated, or a
-return statement may be used, just as with subroutines. The last
-expression is evaluated in scalar or array context, depending on the
-context of the eval.
-
-If there is a syntax error or runtime error, or a die() statement is
-executed, an undefined value is returned by eval(), and C<$@> is set to the
+Note that the value is parsed every time the eval executes. If EXPR is
+omitted, evaluates C<$_>. This form is typically used to delay parsing
+and subsequent execution of the text of EXPR until run time.
+
+In the second form, the code within the BLOCK is parsed only once--at the
+same time the code surrounding the eval itself was parsed--and executed
+within the context of the current Perl program. This form is typically
+used to trap exceptions more efficiently than the first (see below), while
+also providing the benefit of checking the code within BLOCK at compile
+time.
+
+The final semicolon, if any, may be omitted from the value of EXPR or within
+the BLOCK.
+
+In both forms, the value returned is the value of the last expression
+evaluated inside the mini-program; a return statement may be also used, just
+as with subroutines. The expression providing the return value is evaluated
+in void, scalar, or list context, depending on the context of the eval itself.
+See L</wantarray> for more on how the evaluation context can be determined.
+
+If there is a syntax error or runtime error, or a C<die()> statement is
+executed, an undefined value is returned by C<eval()>, and C<$@> is set to the
error message. If there was no error, C<$@> is guaranteed to be a null
-string. If EXPR is omitted, evaluates C<$_>. The final semicolon, if
-any, may be omitted from the expression. Beware that using eval()
-neither silences perl from printing warnings to STDERR, nor does it
-stuff the text of warning messages into C<$@>. To do either of those,
-you have to use the C<$SIG{__WARN__}> facility. See warn() and L<perlvar>.
-
-Note that, because eval() traps otherwise-fatal errors, it is useful for
-determining whether a particular feature (such as socket() or symlink())
+string. Beware that using C<eval()> neither silences perl from printing
+warnings to STDERR, nor does it stuff the text of warning messages into C<$@>.
+To do either of those, you have to use the C<$SIG{__WARN__}> facility. See
+L</warn> and L<perlvar>.
+
+Note that, because C<eval()> traps otherwise-fatal errors, it is useful for
+determining whether a particular feature (such as C<socket()> or C<symlink()>)
is implemented. It is also Perl's exception trapping mechanism, where
the die operator is used to raise exceptions.
@@ -1006,30 +1216,36 @@ Examples:
eval '$answer = $a / $b'; warn $@ if $@;
# a compile-time error
- eval { $answer = };
+ eval { $answer = }; # WRONG
# a run-time error
eval '$answer ='; # sets $@
-When using the eval{} form as an exception trap in libraries, you may
-wish not to trigger any C<__DIE__> hooks that user code may have
-installed. You can use the C<local $SIG{__DIE__}> construct for this
-purpose, as shown in this example:
+Due to the current arguably broken state of C<__DIE__> hooks, when using
+the C<eval{}> form as an exception trap in libraries, you may wish not
+to trigger any C<__DIE__> hooks that user code may have installed.
+You can use the C<local $SIG{__DIE__}> construct for this purpose,
+as shown in this example:
# a very private exception trap for divide-by-zero
- eval { local $SIG{'__DIE__'}; $answer = $a / $b; }; warn $@ if $@;
+ eval { local $SIG{'__DIE__'}; $answer = $a / $b; };
+ warn $@ if $@;
This is especially significant, given that C<__DIE__> hooks can call
-die() again, which has the effect of changing their error messages:
+C<die()> again, which has the effect of changing their error messages:
# __DIE__ hooks may modify error messages
{
- local $SIG{'__DIE__'} = sub { (my $x = $_[0]) =~ s/foo/bar/g; die $x };
- eval { die "foo foofs here" };
- print $@ if $@; # prints "bar barfs here"
+ local $SIG{'__DIE__'} =
+ sub { (my $x = $_[0]) =~ s/foo/bar/g; die $x };
+ eval { die "foo lives here" };
+ print $@ if $@; # prints "bar lives here"
}
-With an eval(), you should be especially careful to remember what's
+Because this promotes action at a distance, this counterintuive behavior
+may be fixed in a future release.
+
+With an C<eval()>, you should be especially careful to remember what's
being looked at when:
eval $x; # CASE 1
@@ -1038,13 +1254,13 @@ being looked at when:
eval '$x'; # CASE 3
eval { $x }; # CASE 4
- eval "\$$x++" # CASE 5
+ eval "\$$x++"; # CASE 5
$$x++; # CASE 6
Cases 1 and 2 above behave identically: they run the code contained in
-the variable $x. (Although case 2 has misleading double quotes making
+the variable C<$x>. (Although case 2 has misleading double quotes making
the reader wonder what else might be happening (nothing is).) Cases 3
-and 4 likewise behave in the same way: they run the code '$x', which
+and 4 likewise behave in the same way: they run the code C<'$x'>, which
does nothing but return the value of C<$x>. (Case 4 is preferred for
purely visual reasons, but it also has the advantage of compiling at
compile-time instead of at run-time.) Case 5 is a place where
@@ -1052,23 +1268,37 @@ normally you I<WOULD> like to use double quotes, except that in this
particular situation, you can just use symbolic references instead, as
in case 6.
+C<eval BLOCK> does I<not> count as a loop, so the loop control statements
+C<next>, C<last>, or C<redo> cannot be used to leave or restart the block.
+
=item exec LIST
-The exec() function executes a system command I<AND NEVER RETURNS> -
-use system() instead of exec() if you want it to return. It fails and
+=item exec PROGRAM LIST
+
+The C<exec()> function executes a system command I<AND NEVER RETURNS> -
+use C<system()> instead of C<exec()> if you want it to return. It fails and
returns FALSE only if the command does not exist I<and> it is executed
directly instead of via your system's command shell (see below).
-If there is more than one argument in LIST, or if LIST is an array with
-more than one value, calls execvp(3) with the arguments in LIST. If
-there is only one scalar argument, the argument is checked for shell
-metacharacters, and if there are any, the entire argument is passed to
-the system's command shell for parsing (this is C</bin/sh -c> on Unix
-platforms, but varies on other platforms). If there are no shell
-metacharacters in the argument, it is split into words and passed
-directly to execvp(), which is more efficient. Note: exec() and
-system() do not flush your output buffer, so you may need to set C<$|>
-to avoid lost output. Examples:
+Since it's a common mistake to use C<exec()> instead of C<system()>, Perl
+warns you if there is a following statement which isn't C<die()>, C<warn()>,
+or C<exit()> (if C<-w> is set - but you always do that). If you
+I<really> want to follow an C<exec()> with some other statement, you
+can use one of these styles to avoid the warning:
+
+ exec ('foo') or print STDERR "couldn't exec foo: $!";
+ { exec ('foo') }; print STDERR "couldn't exec foo: $!";
+
+If there is more than one argument in LIST, or if LIST is an array
+with more than one value, calls execvp(3) with the arguments in LIST.
+If there is only one scalar argument or an array with one element in it,
+the argument is checked for shell metacharacters, and if there are any,
+the entire argument is passed to the system's command shell for parsing
+(this is C</bin/sh -c> on Unix platforms, but varies on other platforms).
+If there are no shell metacharacters in the argument, it is split into
+words and passed directly to C<execvp()>, which is more efficient. Note:
+C<exec()> and C<system()> do not flush your output buffer, so you may need to
+set C<$|> to avoid lost output. Examples:
exec '/bin/echo', 'Your arguments are: ', @ARGV;
exec "sort $outfile | uniq";
@@ -1091,14 +1321,33 @@ When the arguments get executed via the system shell, results will
be subject to its quirks and capabilities. See L<perlop/"`STRING`">
for details.
+Using an indirect object with C<exec()> or C<system()> is also more secure.
+This usage forces interpretation of the arguments as a multivalued list,
+even if the list had just one argument. That way you're safe from the
+shell expanding wildcards or splitting up words with whitespace in them.
+
+ @args = ( "echo surprise" );
+
+ exec @args; # subject to shell escapes
+ # if @args == 1
+ exec { $args[0] } @args; # safe even with one-arg list
+
+The first version, the one without the indirect object, ran the I<echo>
+program, passing it C<"surprise"> an argument. The second version
+didn't--it tried to run a program literally called I<"echo surprise">,
+didn't find it, and set C<$?> to a non-zero value indicating failure.
+
+Note that C<exec()> will not call your C<END> blocks, nor will it call
+any C<DESTROY> methods in your objects.
+
=item exists EXPR
Returns TRUE if the specified hash key exists in its hash array, even
if the corresponding value is undefined.
- print "Exists\n" if exists $array{$key};
- print "Defined\n" if defined $array{$key};
- print "True\n" if $array{$key};
+ print "Exists\n" if exists $array{$key};
+ print "Defined\n" if defined $array{$key};
+ print "True\n" if $array{$key};
A hash element can be TRUE only if it's defined, and defined if
it exists, but the reverse doesn't necessarily hold true.
@@ -1106,32 +1355,53 @@ it exists, but the reverse doesn't necessarily hold true.
Note that the EXPR can be arbitrarily complicated as long as the final
operation is a hash key lookup:
- if (exists $ref->[$x][$y]{$key}) { ... }
+ if (exists $ref->{A}->{B}->{$key}) { }
+ if (exists $hash{A}{B}{$key}) { }
+
+Although the last element will not spring into existence just because
+its existence was tested, intervening ones will. Thus C<$ref-E<gt>{"A"}>
+and C<$ref-E<gt>{"A"}-E<gt>{"B"}> will spring into existence due to the
+existence test for a $key element. This happens anywhere the arrow
+operator is used, including even
+
+ undef $ref;
+ if (exists $ref->{"Some key"}) { }
+ print $ref; # prints HASH(0x80d3d5c)
+
+This surprising autovivification in what does not at first--or even
+second--glance appear to be an lvalue context may be fixed in a future
+release.
=item exit EXPR
-Evaluates EXPR and exits immediately with that value. (Actually, it
-calls any defined C<END> routines first, but the C<END> routines may not
-abort the exit. Likewise any object destructors that need to be called
-are called before exit.) Example:
+Evaluates EXPR and exits immediately with that value. Example:
$ans = <STDIN>;
exit 0 if $ans =~ /^[Xx]/;
-See also die(). If EXPR is omitted, exits with 0 status. The only
-universally portable values for EXPR are 0 for success and 1 for error;
-all other values are subject to unpredictable interpretation depending
-on the environment in which the Perl program is running.
+See also C<die()>. If EXPR is omitted, exits with C<0> status. The only
+universally recognized values for EXPR are C<0> for success and C<1>
+for error; other values are subject to interpretation depending on the
+environment in which the Perl program is running. For example, exiting
+69 (EX_UNAVAILABLE) from a I<sendmail> incoming-mail filter will cause
+the mailer to return the item undelivered, but that's not true everywhere.
+
+Don't use C<exit()> to abort a subroutine if there's any chance that
+someone might want to trap whatever error happened. Use C<die()> instead,
+which can be trapped by an C<eval()>.
-You shouldn't use exit() to abort a subroutine if there's any chance that
-someone might want to trap whatever error happened. Use die() instead,
-which can be trapped by an eval().
+The exit() function does not always exit immediately. It calls any
+defined C<END> routines first, but these C<END> routines may not
+themselves abort the exit. Likewise any object destructors that need to
+be called are called before the real exit. If this is a problem, you
+can call C<POSIX:_exit($status)> to avoid END and destructor processing.
+See L<perlsub> for details.
=item exp EXPR
=item exp
-Returns I<e> (the natural logarithm base) to the power of EXPR.
+Returns I<e> (the natural logarithm base) to the power of EXPR.
If EXPR is omitted, gives C<exp($_)>.
=item fcntl FILEHANDLE,FUNCTION,SCALAR
@@ -1140,27 +1410,58 @@ Implements the fcntl(2) function. You'll probably have to say
use Fcntl;
-first to get the correct function definitions. Argument processing and
-value return works just like ioctl() below. Note that fcntl() will produce
-a fatal error if used on a machine that doesn't implement fcntl(2).
+first to get the correct constant definitions. Argument processing and
+value return works just like C<ioctl()> below.
For example:
use Fcntl;
- fcntl($filehandle, F_GETLK, $packed_return_buffer);
+ fcntl($filehandle, F_GETFL, $packed_return_buffer)
+ or die "can't fcntl F_GETFL: $!";
+
+You don't have to check for C<defined()> on the return from C<fnctl()>.
+Like C<ioctl()>, it maps a C<0> return from the system call into "C<0>
+but true" in Perl. This string is true in boolean context and C<0>
+in numeric context. It is also exempt from the normal B<-w> warnings
+on improper numeric conversions.
+
+Note that C<fcntl()> will produce a fatal error if used on a machine that
+doesn't implement fcntl(2). See the Fcntl module or your fcntl(2)
+manpage to learn what functions are available on your system.
=item fileno FILEHANDLE
-Returns the file descriptor for a filehandle. This is useful for
-constructing bitmaps for select(). If FILEHANDLE is an expression, the
-value is taken as the name of the filehandle.
+Returns the file descriptor for a filehandle, or undefined if the
+filehandle is not open. This is mainly useful for constructing
+bitmaps for C<select()> and low-level POSIX tty-handling operations.
+If FILEHANDLE is an expression, the value is taken as an indirect
+filehandle, generally its name.
+
+You can use this to find out whether two handles refer to the
+same underlying descriptor:
+
+ if (fileno(THIS) == fileno(THAT)) {
+ print "THIS and THAT are dups\n";
+ }
=item flock FILEHANDLE,OPERATION
-Calls flock(2), or an emulation of it, on FILEHANDLE. Returns TRUE for
-success, FALSE on failure. Produces a fatal error if used on a machine
-that doesn't implement flock(2), fcntl(2) locking, or lockf(3). flock()
-is Perl's portable file locking interface, although it locks only entire
-files, not records.
+Calls flock(2), or an emulation of it, on FILEHANDLE. Returns TRUE
+for success, FALSE on failure. Produces a fatal error if used on a
+machine that doesn't implement flock(2), fcntl(2) locking, or lockf(3).
+C<flock()> is Perl's portable file locking interface, although it locks
+only entire files, not records.
+
+Two potentially non-obvious but traditional C<flock> semantics are
+that it waits indefinitely until the lock is granted, and that its locks
+B<merely advisory>. Such discretionary locks are more flexible, but offer
+fewer guarantees. This means that files locked with C<flock()> may be
+modified by programs that do not also use C<flock()>. See L<perlport>,
+your port's specific documentation, or your system-specific local manpages
+for details. It's best to assume traditional behavior if you're writing
+portable programs. (But if you're not, you should as always feel perfectly
+free to write for your own system's idiosyncrasies (sometimes called
+"features"). Slavish adherence to portability concerns shouldn't get
+in the way of your getting your job done.)
OPERATION is one of LOCK_SH, LOCK_EX, or LOCK_UN, possibly combined with
LOCK_NB. These constants are traditionally valued 1, 2, 8 and 4, but
@@ -1168,20 +1469,20 @@ you can use the symbolic names if import them from the Fcntl module,
either individually, or as a group using the ':flock' tag. LOCK_SH
requests a shared lock, LOCK_EX requests an exclusive lock, and LOCK_UN
releases a previously requested lock. If LOCK_NB is added to LOCK_SH or
-LOCK_EX then flock() will return immediately rather than blocking
+LOCK_EX then C<flock()> will return immediately rather than blocking
waiting for the lock (check the return status to see if you got it).
-To avoid the possibility of mis-coordination, Perl flushes FILEHANDLE
-before (un)locking it.
+To avoid the possibility of miscoordination, Perl now flushes FILEHANDLE
+before locking or unlocking it.
Note that the emulation built with lockf(3) doesn't provide shared
locks, and it requires that FILEHANDLE be open with write intent. These
-are the semantics that lockf(3) implements. Most (all?) systems
+are the semantics that lockf(3) implements. Most if not all systems
implement lockf(3) in terms of fcntl(2) locking, though, so the
differing semantics shouldn't bite too many people.
-Note also that some versions of flock() cannot lock things over the
-network; you would need to use the more system-specific fcntl() for
+Note also that some versions of C<flock()> cannot lock things over the
+network; you would need to use the more system-specific C<fcntl()> for
that. If you like you can force Perl to ignore your system's flock(2)
function, and so provide its own fcntl(2)-based emulation, by passing
the switch C<-Ud_flock> to the F<Configure> program when you configure
@@ -1209,47 +1510,41 @@ Here's a mailbox appender for BSD systems.
print MBOX $msg,"\n\n";
unlock();
+On systems that support a real flock(), locks are inherited across fork()
+calls, whereas those that must resort to the more capricious fcntl()
+function lose the locks, making it harder to write servers.
+
See also L<DB_File> for other flock() examples.
=item fork
-Does a fork(2) system call. Returns the child pid to the parent process
-and 0 to the child process, or C<undef> if the fork is unsuccessful.
-Note: unflushed buffers remain unflushed in both processes, which means
-you may need to set C<$|> ($AUTOFLUSH in English) or call the autoflush()
-method of IO::Handle to avoid duplicate output.
-
-If you fork() without ever waiting on your children, you will accumulate
-zombies:
-
- $SIG{CHLD} = sub { wait };
+Does a fork(2) system call to create a new process running the
+same program at the same point. It returns the child pid to the
+parent process, C<0> to the child process, or C<undef> if the fork is
+unsuccessful. File descriptors (and sometimes locks on those descriptors)
+are shared, while everything else is copied. On most systems supporting
+fork(), great care has gone into making it extremely efficient (for
+example, using copy-on-write technology on data pages), making it the
+dominant paradigm for multitasking over the last few decades.
-There's also the double-fork trick (error checking on
-fork() returns omitted);
-
- unless ($pid = fork) {
- unless (fork) {
- exec "what you really wanna do";
- die "no exec";
- # ... or ...
- ## (some_perl_code_here)
- exit 0;
- }
- exit 0;
- }
- waitpid($pid,0);
+Note: unflushed buffers remain unflushed in both processes, which means
+you may need to set C<$|> ($AUTOFLUSH in English) or call the C<autoflush()>
+method of C<IO::Handle> to avoid duplicate output.
-See also L<perlipc> for more examples of forking and reaping
-moribund children.
+If you C<fork()> without ever waiting on your children, you will
+accumulate zombies. On some systems, you can avoid this by setting
+C<$SIG{CHLD}> to C<"IGNORE">. See also L<perlipc> for more examples of
+forking and reaping moribund children.
Note that if your forked child inherits system file descriptors like
STDIN and STDOUT that are actually connected by a pipe or socket, even
-if you exit, the remote server (such as, say, httpd or rsh) won't think
-you're done. You should reopen those to /dev/null if it's any issue.
+if you exit, then the remote server (such as, say, a CGI script or a
+backgrounded job launced from a remote shell) won't think you're done.
+You should reopen those to F</dev/null> if it's any issue.
=item format
-Declare a picture format with use by the write() function. For
+Declare a picture format for use by the C<write()> function. For
example:
format Something =
@@ -1264,17 +1559,16 @@ example:
See L<perlform> for many details and examples.
-
=item formline PICTURE,LIST
-This is an internal function used by C<format>s, though you may call it
+This is an internal function used by C<format>s, though you may call it,
too. It formats (see L<perlform>) a list of values according to the
contents of PICTURE, placing the output into the format output
-accumulator, C<$^A> (or $ACCUMULATOR in English).
-Eventually, when a write() is done, the contents of
+accumulator, C<$^A> (or C<$ACCUMULATOR> in English).
+Eventually, when a C<write()> is done, the contents of
C<$^A> are written to some filehandle, but you could also read C<$^A>
-yourself and then set C<$^A> back to "". Note that a format typically
-does one formline() per line of form, but the formline() function itself
+yourself and then set C<$^A> back to C<"">. Note that a format typically
+does one C<formline()> per line of form, but the C<formline()> function itself
doesn't care how many newlines are embedded in the PICTURE. This means
that the C<~> and C<~~> tokens will treat the entire PICTURE as a single line.
You may therefore need to use multiple formlines to implement a single
@@ -1282,16 +1576,18 @@ record format, just like the format compiler.
Be careful if you put double quotes around the picture, because an "C<@>"
character may be taken to mean the beginning of an array name.
-formline() always returns TRUE. See L<perlform> for other examples.
+C<formline()> always returns TRUE. See L<perlform> for other examples.
=item getc FILEHANDLE
=item getc
Returns the next character from the input file attached to FILEHANDLE,
-or a null string at end of file. If FILEHANDLE is omitted, reads from STDIN.
-This is not particularly efficient. It cannot be used to get unbuffered
-single-characters, however. For that, try something more like:
+or the undefined value at end of file, or if there was an error.
+If FILEHANDLE is omitted, reads from STDIN. This is not particularly
+efficient. However, it cannot be used by itself to fetch single
+characters without waiting for the user to hit enter. For that, try
+something more like:
if ($BSD_STYLE) {
system "stty cbreak </dev/tty >/dev/tty 2>&1";
@@ -1313,20 +1609,21 @@ single-characters, however. For that, try something more like:
Determination of whether $BSD_STYLE should be set
is left as an exercise to the reader.
-The POSIX::getattr() function can do this more portably on systems
-alleging POSIX compliance.
-See also the C<Term::ReadKey> module from your nearest CPAN site;
-details on CPAN can be found on L<perlmod/CPAN>.
+The C<POSIX::getattr()> function can do this more portably on
+systems purporting POSIX compliance. See also the C<Term::ReadKey>
+module from your nearest CPAN site; details on CPAN can be found on
+L<perlmodlib/CPAN>.
=item getlogin
-Returns the current login from F</etc/utmp>, if any. If null, use
-getpwuid().
+Implements the C library function of the same name, which on most
+systems returns the current login from F</etc/utmp>, if any. If null,
+use C<getpwuid()>.
$login = getlogin || getpwuid($<) || "Kilroy";
-Do not consider getlogin() for authentication: it is not as
-secure as getpwuid().
+Do not consider C<getlogin()> for authentication: it is not as
+secure as C<getpwuid()>.
=item getpeername SOCKET
@@ -1341,11 +1638,11 @@ Returns the packed sockaddr address of other end of the SOCKET connection.
=item getpgrp PID
Returns the current process group for the specified PID. Use
-a PID of 0 to get the current process group for the
+a PID of C<0> to get the current process group for the
current process. Will raise an exception if used on a machine that
doesn't implement getpgrp(2). If PID is omitted, returns process
-group of current process. Note that the POSIX version of getpgrp()
-does not accept a PID argument, so only PID==0 is truly portable.
+group of current process. Note that the POSIX version of C<getpgrp()>
+does not accept a PID argument, so only C<PID==0> is truly portable.
=item getppid
@@ -1418,11 +1715,11 @@ machine that doesn't implement getpriority(2).
=item endservent
These routines perform the same functions as their counterparts in the
-system library. Within a list context, the return values from the
+system library. In list context, the return values from the
various get routines are as follows:
($name,$passwd,$uid,$gid,
- $quota,$comment,$gcos,$dir,$shell) = getpw*
+ $quota,$comment,$gcos,$dir,$shell,$expire) = getpw*
($name,$passwd,$gid,$members) = getgr*
($name,$aliases,$addrtype,$length,@addrs) = gethost*
($name,$aliases,$addrtype,$net) = getnet*
@@ -1431,30 +1728,74 @@ various get routines are as follows:
(If the entry doesn't exist you get a null list.)
-Within a scalar context, you get the name, unless the function was a
+In scalar context, you get the name, unless the function was a
lookup by name, in which case you get the other thing, whatever it is.
(If the entry doesn't exist you get the undefined value.) For example:
- $uid = getpwnam
- $name = getpwuid
- $name = getpwent
- $gid = getgrnam
- $name = getgrgid
- $name = getgrent
- etc.
-
-The $members value returned by I<getgr*()> is a space separated list of
+ $uid = getpwnam($name);
+ $name = getpwuid($num);
+ $name = getpwent();
+ $gid = getgrnam($name);
+ $name = getgrgid($num;
+ $name = getgrent();
+ #etc.
+
+In I<getpw*()> the fields C<$quota>, C<$comment>, and C<$expire> are
+special cases in the sense that in many systems they are unsupported.
+If the C<$quota> is unsupported, it is an empty scalar. If it is
+supported, it usually encodes the disk quota. If the C<$comment>
+field is unsupported, it is an empty scalar. If it is supported it
+usually encodes some administrative comment about the user. In some
+systems the $quota field may be C<$change> or C<$age>, fields that have
+to do with password aging. In some systems the C<$comment> field may
+be C<$class>. The C<$expire> field, if present, encodes the expiration
+period of the account or the password. For the availability and the
+exact meaning of these fields in your system, please consult your
+getpwnam(3) documentation and your F<pwd.h> file. You can also find
+out from within Perl what your C<$quota> and C<$comment> fields mean
+and whether you have the C<$expire> field by using the C<Config> module
+and the values C<d_pwquota>, C<d_pwage>, C<d_pwchange>, C<d_pwcomment>,
+and C<d_pwexpire>. Shadow password files are only supported if your
+vendor has implemented them in the intuitive fashion that calling the
+regular C library routines gets the shadow versions if you're running
+under privilege. Those that incorrectly implement a separate library
+call are not supported.
+
+The C<$members> value returned by I<getgr*()> is a space separated list of
the login names of the members of the group.
For the I<gethost*()> functions, if the C<h_errno> variable is supported in
C, it will be returned to you via C<$?> if the function call fails. The
-@addrs value returned by a successful call is a list of the raw
+C<@addrs> value returned by a successful call is a list of the raw
addresses returned by the corresponding system library call. In the
Internet domain, each address is four bytes long and you can unpack it
by saying something like:
($a,$b,$c,$d) = unpack('C4',$addr[0]);
+The Socket library makes this slightly easier:
+
+ use Socket;
+ $iaddr = inet_aton("127.1"); # or whatever address
+ $name = gethostbyaddr($iaddr, AF_INET);
+
+ # or going the other way
+ $straddr = inet_ntoa($iaddr");
+
+If you get tired of remembering which element of the return list contains
+which return value, by-name interfaces are also provided in modules:
+C<File::stat>, C<Net::hostent>, C<Net::netent>, C<Net::protoent>, C<Net::servent>,
+C<Time::gmtime>, C<Time::localtime>, and C<User::grent>. These override the
+normal built-in, replacing them with versions that return objects with
+the appropriate names for each field. For example:
+
+ use File::stat;
+ use User::pwent;
+ $is_his = (stat($filename)->uid == pwent($whoever)->uid);
+
+Even though it looks like they're the same method calls (uid),
+they aren't, because a C<File::stat> object is different from a C<User::pwent> object.
+
=item getsockname SOCKET
Returns the packed sockaddr address of this end of the SOCKET connection.
@@ -1465,17 +1806,17 @@ Returns the packed sockaddr address of this end of the SOCKET connection.
=item getsockopt SOCKET,LEVEL,OPTNAME
-Returns the socket option requested, or undefined if there is an error.
+Returns the socket option requested, or undef if there is an error.
=item glob EXPR
=item glob
-Returns the value of EXPR with filename expansions such as a shell would
-do. This is the internal function implementing the C<E<lt>*.cE<gt>>
-operator, but you can use it directly. If EXPR is omitted, $_ is used.
-The C<E<lt>*.cE<gt>> operator is discussed in more detail in
-L<perlop/"I/O Operators">.
+Returns the value of EXPR with filename expansions such as the
+standard Unix shell F</bin/csh> would do. This is the internal function
+implementing the C<E<lt>*.cE<gt>> operator, but you can use it directly.
+If EXPR is omitted, C<$_> is used. The C<E<lt>*.cE<gt>> operator is
+discussed in more detail in L<perlop/"I/O Operators">.
=item gmtime EXPR
@@ -1488,60 +1829,76 @@ Typically used as follows:
gmtime(time);
All array elements are numeric, and come straight out of a struct tm.
-In particular this means that $mon has the range 0..11 and $wday has
-the range 0..6 with sunday as day 0. Also, $year is the number of
-years since 1900, I<not> simply the last two digits of the year.
+In particular this means that C<$mon> has the range C<0..11> and C<$wday>
+has the range C<0..6> with sunday as day C<0>. Also, C<$year> is the
+number of years since 1900, that is, C<$year> is C<123> in year 2023,
+I<not> simply the last two digits of the year. If you assume it is,
+then you create non-Y2K-compliant programs--and you wouldn't want to do
+that, would you?
If EXPR is omitted, does C<gmtime(time())>.
-In a scalar context, returns the ctime(3) value:
+In scalar context, returns the ctime(3) value:
$now_string = gmtime; # e.g., "Thu Oct 13 04:54:34 1994"
-Also see the timegm() function provided by the Time::Local module,
+Also see the C<timegm()> function provided by the C<Time::Local> module,
and the strftime(3) function available via the POSIX module.
+This scalar value is B<not> locale dependent (see L<perllocale>), but
+is instead a Perl builtin. Also see the C<Time::Local> module, and the
+strftime(3) and mktime(3) functions available via the POSIX module. To
+get somewhat similar but locale dependent date strings, set up your
+locale environment variables appropriately (please see L<perllocale>)
+and try for example:
+
+ use POSIX qw(strftime);
+ $now_string = strftime "%a %b %e %H:%M:%S %Y", gmtime;
+
+Note that the C<%a> and C<%b> escapes, which represent the short forms
+of the day of the week and the month of the year, may not necessarily
+be three characters wide in all locales.
+
=item goto LABEL
=item goto EXPR
=item goto &NAME
-The goto-LABEL form finds the statement labeled with LABEL and resumes
+The C<goto-LABEL> form finds the statement labeled with LABEL and resumes
execution there. It may not be used to go into any construct that
-requires initialization, such as a subroutine or a foreach loop. It
+requires initialization, such as a subroutine or a C<foreach> loop. It
also can't be used to go into a construct that is optimized away,
-or to get out of a block or subroutine given to sort().
+or to get out of a block or subroutine given to C<sort()>.
It can be used to go almost anywhere else within the dynamic scope,
including out of subroutines, but it's usually better to use some other
-construct such as last or die. The author of Perl has never felt the
-need to use this form of goto (in Perl, that is--C is another matter).
+construct such as C<last> or C<die()>. The author of Perl has never felt the
+need to use this form of C<goto> (in Perl, that is--C is another matter).
-The goto-EXPR form expects a label name, whose scope will be resolved
-dynamically. This allows for computed gotos per FORTRAN, but isn't
+The C<goto-EXPR> form expects a label name, whose scope will be resolved
+dynamically. This allows for computed C<goto>s per FORTRAN, but isn't
necessarily recommended if you're optimizing for maintainability:
goto ("FOO", "BAR", "GLARCH")[$i];
-The goto-&NAME form is highly magical, and substitutes a call to the
+The C<goto-&NAME> form is highly magical, and substitutes a call to the
named subroutine for the currently running subroutine. This is used by
-AUTOLOAD subroutines that wish to load another subroutine and then
+C<AUTOLOAD> subroutines that wish to load another subroutine and then
pretend that the other subroutine had been called in the first place
-(except that any modifications to @_ in the current subroutine are
-propagated to the other subroutine.) After the goto, not even caller()
+(except that any modifications to C<@_> in the current subroutine are
+propagated to the other subroutine.) After the C<goto>, not even C<caller()>
will be able to tell that this routine was called first.
=item grep BLOCK LIST
=item grep EXPR,LIST
-This is similar in spirit to, but not the same as, grep(1)
-and its relatives. In particular, it is not limited to using
-regular expressions.
+This is similar in spirit to, but not the same as, grep(1) and its
+relatives. In particular, it is not limited to using regular expressions.
Evaluates the BLOCK or EXPR for each element of LIST (locally setting
-$_ to each element) and returns the list value consisting of those
-elements for which the expression evaluated to TRUE. In a scalar
+C<$_> to each element) and returns the list value consisting of those
+elements for which the expression evaluated to TRUE. In scalar
context, returns the number of times the expression was TRUE.
@foo = grep(!/^#/, @bar); # weed out comments
@@ -1550,68 +1907,78 @@ or equivalently,
@foo = grep {!/^#/} @bar; # weed out comments
-Note that, because $_ is a reference into the list value, it can be used
-to modify the elements of the array. While this is useful and
-supported, it can cause bizarre results if the LIST is not a named
-array. Similarly, grep returns aliases into the original list,
-much like the way that L<Foreach Loops>'s index variable aliases the list
-elements. That is, modifying an element of a list returned by grep
-(for example, in a C<foreach>, C<map> or another C<grep>)
-actually modifies the element in the original list.
+Note that, because C<$_> is a reference into the list value, it can
+be used to modify the elements of the array. While this is useful and
+supported, it can cause bizarre results if the LIST is not a named array.
+Similarly, grep returns aliases into the original list, much as a for
+loop's index variable aliases the list elements. That is, modifying an
+element of a list returned by grep (for example, in a C<foreach>, C<map()>
+or another C<grep()>) actually modifies the element in the original list.
+This is usually something to be avoided when writing clear code.
See also L</map> for an array composed of the results of the BLOCK or EXPR.
+
=item hex EXPR
=item hex
-Interprets EXPR as a hex string and returns the corresponding
-value. (To convert strings that might start with either 0 or 0x
-see L</oct>.) If EXPR is omitted, uses $_.
+Interprets EXPR as a hex string and returns the corresponding value.
+(To convert strings that might start with either 0, 0x, or 0b, see
+L</oct>.) If EXPR is omitted, uses C<$_>.
print hex '0xAf'; # prints '175'
print hex 'aF'; # same
=item import
-There is no builtin import() function. It is merely an ordinary
+There is no builtin C<import()> function. It is just an ordinary
method (subroutine) defined (or inherited) by modules that wish to export
-names to another module. The use() function calls the import() method
+names to another module. The C<use()> function calls the C<import()> method
for the package used. See also L</use()>, L<perlmod>, and L<Exporter>.
=item index STR,SUBSTR,POSITION
=item index STR,SUBSTR
-Returns the position of the first occurrence of SUBSTR in STR at or after
-POSITION. If POSITION is omitted, starts searching from the beginning of
-the string. The return value is based at 0 (or whatever you've set the C<$[>
-variable to--but don't do that). If the substring is not found, returns
-one less than the base, ordinarily -1.
+The index function searches for one string within another, but without
+the wildcard-like behavior of a full regular-expression pattern match.
+It returns the position of the first occurrence of SUBSTR in STR at
+or after POSITION. If POSITION is omitted, starts searching from the
+beginning of the string. The return value is based at C<0> (or whatever
+you've set the C<$[> variable to--but don't do that). If the substring
+is not found, returns one less than the base, ordinarily C<-1>.
=item int EXPR
=item int
-Returns the integer portion of EXPR. If EXPR is omitted, uses $_.
+Returns the integer portion of EXPR. If EXPR is omitted, uses C<$_>.
+You should not use this function for rounding: one because it truncates
+towards C<0>, and two because machine representations of floating point
+numbers can sometimes produce counterintuitive results. For example,
+C<int(-6.725/0.025)> produces -268 rather than the correct -269; that's
+because it's really more like -268.99999999999994315658 instead. Usually,
+the C<sprintf()>, C<printf()>, or the C<POSIX::floor> and C<POSIX::ceil>
+functions will serve you better than will int().
=item ioctl FILEHANDLE,FUNCTION,SCALAR
-Implements the ioctl(2) function. You'll probably have to say
+Implements the ioctl(2) function. You'll probably first have to say
require "ioctl.ph"; # probably in /usr/local/lib/perl/ioctl.ph
-first to get the correct function definitions. If F<ioctl.ph> doesn't
+to get the correct function definitions. If F<ioctl.ph> doesn't
exist or doesn't have the correct definitions you'll have to roll your
own, based on your C header files such as F<E<lt>sys/ioctl.hE<gt>>.
-(There is a Perl script called B<h2ph> that comes with the Perl kit which
+(There is a Perl script called B<h2ph> that comes with the Perl kit that
may help you in this, but it's nontrivial.) SCALAR will be read and/or
written depending on the FUNCTION--a pointer to the string value of SCALAR
-will be passed as the third argument of the actual ioctl call. (If SCALAR
+will be passed as the third argument of the actual C<ioctl()> call. (If SCALAR
has no string value but does have a numeric value, that value will be
passed rather than a pointer to the string value. To guarantee this to be
-TRUE, add a 0 to the scalar before using it.) The pack() and unpack()
+TRUE, add a C<0> to the scalar before using it.) The C<pack()> and C<unpack()>
functions are useful for manipulating the values of structures used by
-ioctl(). The following example sets the erase character to DEL.
+C<ioctl()>. The following example sets the erase character to DEL.
require 'ioctl.ph';
$getp = &TIOCGETP;
@@ -1625,7 +1992,7 @@ ioctl(). The following example sets the erase character to DEL.
|| die "Can't ioctl: $!";
}
-The return value of ioctl (and fcntl) is as follows:
+The return value of C<ioctl()> (and C<fcntl()>) is as follows:
if OS returns: then Perl returns:
-1 undefined value
@@ -1636,26 +2003,30 @@ Thus Perl returns TRUE on success and FALSE on failure, yet you can
still easily determine the actual value returned by the operating
system:
- ($retval = ioctl(...)) || ($retval = -1);
+ $retval = ioctl(...) || -1;
printf "System returned %d\n", $retval;
+The special string "C<0> but true" is exempt from B<-w> complaints
+about improper numeric conversions.
+
=item join EXPR,LIST
-Joins the separate strings of LIST into a single string with
-fields separated by the value of EXPR, and returns the string.
-Example:
+Joins the separate strings of LIST into a single string with fields
+separated by the value of EXPR, and returns that new string. Example:
- $_ = join(':', $login,$passwd,$uid,$gid,$gcos,$home,$shell);
+ $rec = join(':', $login,$passwd,$uid,$gid,$gcos,$home,$shell);
-See L<perlfunc/split>.
+See L</split>.
=item keys HASH
-Returns a normal array consisting of all the keys of the named hash. (In
-a scalar context, returns the number of keys.) The keys are returned in
-an apparently random order, but it is the same order as either the
-values() or each() function produces (given that the hash has not been
-modified). As a side effect, it resets HASH's iterator.
+Returns a list consisting of all the keys of the named hash. (In a
+scalar context, returns the number of keys.) The keys are returned in
+an apparently random order. The actual random order is subject to
+change in future versions of perl, but it is guaranteed to be the same
+order as either the C<values()> or C<each()> function produces (given
+that the hash has not been modified). As a side effect, it resets
+HASH's iterator.
Here is yet another way to print your environment:
@@ -1671,27 +2042,30 @@ or how about sorted by key:
print $key, '=', $ENV{$key}, "\n";
}
-To sort an array by value, you'll need to use a C<sort> function.
+To sort a hash by value, you'll need to use a C<sort()> function.
Here's a descending numeric sort of a hash by its values:
- foreach $key (sort { $hash{$b} <=> $hash{$a} } keys %hash)) {
+ foreach $key (sort { $hash{$b} <=> $hash{$a} } keys %hash) {
printf "%4d %s\n", $hash{$key}, $key;
}
-As an lvalue C<keys> allows you to increase the number of hash buckets
+As an lvalue C<keys()> allows you to increase the number of hash buckets
allocated for the given hash. This can gain you a measure of efficiency if
you know the hash is going to get big. (This is similar to pre-extending
an array by assigning a larger number to $#array.) If you say
keys %hash = 200;
-then C<%hash> will have at least 200 buckets allocated for it. These
+then C<%hash> will have at least 200 buckets allocated for it--256 of them,
+in fact, since it rounds up to the next power of two. These
buckets will be retained even if you do C<%hash = ()>, use C<undef
%hash> if you want to free the storage while C<%hash> is still in scope.
You can't shrink the number of buckets allocated for the hash using
-C<keys> in this way (but you needn't worry about doing this by accident,
+C<keys()> in this way (but you needn't worry about doing this by accident,
as trying has no effect).
+See also C<each()>, C<values()> and C<sort()>.
+
=item kill LIST
Sends a signal to a list of processes. The first element of
@@ -1718,57 +2092,66 @@ C<continue> block, if any, is not executed:
LINE: while (<STDIN>) {
last LINE if /^$/; # exit when done with header
- ...
+ #...
}
+C<last> cannot be used to exit a block which returns a value such as
+C<eval {}>, C<sub {}> or C<do {}>, and should not be used to exit
+a grep() or map() operation.
+
+See also L</continue> for an illustration of how C<last>, C<next>, and
+C<redo> work.
+
=item lc EXPR
=item lc
Returns an lowercased version of EXPR. This is the internal function
-implementing the \L escape in double-quoted strings.
+implementing the C<\L> escape in double-quoted strings.
Respects current LC_CTYPE locale if C<use locale> in force. See L<perllocale>.
-If EXPR is omitted, uses $_.
+If EXPR is omitted, uses C<$_>.
=item lcfirst EXPR
=item lcfirst
Returns the value of EXPR with the first character lowercased. This is
-the internal function implementing the \l escape in double-quoted strings.
+the internal function implementing the C<\l> escape in double-quoted strings.
Respects current LC_CTYPE locale if C<use locale> in force. See L<perllocale>.
-If EXPR is omitted, uses $_.
+If EXPR is omitted, uses C<$_>.
=item length EXPR
=item length
Returns the length in characters of the value of EXPR. If EXPR is
-omitted, returns length of $_.
+omitted, returns length of C<$_>. Note that this cannot be used on
+an entire array or hash to find out how many elements these have.
+For that, use C<scalar @array> and C<scalar keys %hash> respectively.
=item link OLDFILE,NEWFILE
-Creates a new filename linked to the old filename. Returns 1 for
-success, 0 otherwise.
+Creates a new filename linked to the old filename. Returns TRUE for
+success, FALSE otherwise.
=item listen SOCKET,QUEUESIZE
Does the same thing that the listen system call does. Returns TRUE if
-it succeeded, FALSE otherwise. See example in L<perlipc/"Sockets: Client/Server Communication">.
+it succeeded, FALSE otherwise. See the example in L<perlipc/"Sockets: Client/Server Communication">.
=item local EXPR
-A local modifies the listed variables to be local to the enclosing block,
-subroutine, C<eval{}>, or C<do>. If more than one value is listed, the
-list must be placed in parentheses. See L<perlsub/"Temporary Values via
-local()"> for details, including issues with tied arrays and hashes.
-
-But you really probably want to be using my() instead, because local() isn't
-what most people think of as "local"). See L<perlsub/"Private Variables
+You really probably want to be using C<my()> instead, because C<local()> isn't
+what most people think of as "local". See L<perlsub/"Private Variables
via my()"> for details.
+A local modifies the listed variables to be local to the enclosing
+block, file, or eval. If more than one value is listed, the list must
+be placed in parentheses. See L<perlsub/"Temporary Values via local()">
+for details, including issues with tied arrays and hashes.
+
=item localtime EXPR
Converts a time as returned by the time function to a 9-element array
@@ -1780,27 +2163,47 @@ follows:
localtime(time);
All array elements are numeric, and come straight out of a struct tm.
-In particular this means that $mon has the range 0..11 and $wday has
-the range 0..6 with sunday as day 0. Also, $year is the number of
-years since 1900, that is, $year is 123 in year 2023.
+In particular this means that C<$mon> has the range C<0..11> and C<$wday>
+has the range C<0..6> with sunday as day C<0>. Also, C<$year> is the
+number of years since 1900, that is, C<$year> is C<123> in year 2023,
+and I<not> simply the last two digits of the year. If you assume it is,
+then you create non-Y2K-compliant programs--and you wouldn't want to do
+that, would you?
If EXPR is omitted, uses the current time (C<localtime(time)>).
-In a scalar context, returns the ctime(3) value:
+In scalar context, returns the ctime(3) value:
$now_string = localtime; # e.g., "Thu Oct 13 04:54:34 1994"
-This scalar value is B<not> locale dependent, see L<perllocale>,
-but instead a Perl builtin.
-Also see the Time::Local module, and the strftime(3) and mktime(3)
-function available via the POSIX module.
+This scalar value is B<not> locale dependent, see L<perllocale>, but
+instead a Perl builtin. Also see the C<Time::Local> module, and the
+strftime(3) and mktime(3) function available via the POSIX module. To
+get somewhat similar but locale dependent date strings, set up your
+locale environment variables appropriately (please see L<perllocale>)
+and try for example:
+
+ use POSIX qw(strftime);
+ $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;
+
+Note that the C<%a> and C<%b>, the short forms of the day of the week
+and the month of the year, may not necessarily be three characters wide.
=item log EXPR
=item log
-Returns logarithm (base I<e>) of EXPR. If EXPR is omitted, returns log
-of $_.
+Returns the natural logarithm (base I<e>) of EXPR. If EXPR is omitted,
+returns log of C<$_>. To get the log of another base, use basic algebra:
+The base-N log of a number is is equal to the natural log of that number
+divided by the natural log of N. For example:
+
+ sub log10 {
+ my $n = shift;
+ return log($n)/log(10);
+ }
+
+See also L</exp> for the inverse operation.
=item lstat FILEHANDLE
@@ -1808,11 +2211,12 @@ of $_.
=item lstat
-Does the same thing as the stat() function, but stats a symbolic link
-instead of the file the symbolic link points to. If symbolic links are
-unimplemented on your system, a normal stat() is done.
+Does the same thing as the C<stat()> function (including setting the
+special C<_> filehandle) but stats a symbolic link instead of the file
+the symbolic link points to. If symbolic links are unimplemented on
+your system, a normal C<stat()> is done.
-If EXPR is omitted, stats $_.
+If EXPR is omitted, stats C<$_>.
=item m//
@@ -1822,11 +2226,13 @@ The match operator. See L<perlop>.
=item map EXPR,LIST
-Evaluates the BLOCK or EXPR for each element of LIST (locally setting $_ to each
+Evaluates the BLOCK or EXPR for each element of LIST (locally setting C<$_> to each
element) and returns the list value composed of the results of each such
evaluation. Evaluates BLOCK or EXPR in a list context, so each element of LIST
may produce zero, one, or more elements in the returned value.
+In scalar context, returns the total number of elements so generated.
+
@chars = map(chr, @nums);
translates a list of numbers to the corresponding characters. And
@@ -1840,50 +2246,65 @@ is just a funny way to write
$hash{getkey($_)} = $_;
}
-Note that, because $_ is a reference into the list value, it can be used
-to modify the elements of the array. While this is useful and
-supported, it can cause bizarre results if the LIST is not a named
-array. See also L</grep> for an array composed of those items of the
-original list for which the BLOCK or EXPR evaluates to true.
+Note that, because C<$_> is a reference into the list value, it can
+be used to modify the elements of the array. While this is useful and
+supported, it can cause bizarre results if the LIST is not a named array.
+Using a regular C<foreach> loop for this purpose would be clearer in
+most cases. See also L</grep> for an array composed of those items of
+the original list for which the BLOCK or EXPR evaluates to true.
=item mkdir FILENAME,MODE
-Creates the directory specified by FILENAME, with permissions specified
-by MODE (as modified by umask). If it succeeds it returns 1, otherwise
-it returns 0 and sets C<$!> (errno).
+Creates the directory specified by FILENAME, with permissions
+specified by MODE (as modified by C<umask>). If it succeeds it
+returns TRUE, otherwise it returns FALSE and sets C<$!> (errno).
+
+In general, it is better to create directories with permissive MODEs,
+and let the user modify that with their C<umask>, than it is to supply
+a restrictive MODE and give the user no way to be more permissive.
+The exceptions to this rule are when the file or directory should be
+kept private (mail files, for instance). The perlfunc(1) entry on
+C<umask> discusses the choice of MODE in more detail.
=item msgctl ID,CMD,ARG
-Calls the System V IPC function msgctl(2). If CMD is &IPC_STAT, then ARG
-must be a variable which will hold the returned msqid_ds structure.
-Returns like ioctl: the undefined value for error, "0 but true" for
-zero, or the actual return value otherwise.
+Calls the System V IPC function msgctl(2). You'll probably have to say
+
+ use IPC::SysV;
+
+first to get the correct constant definitions. If CMD is C<IPC_STAT>,
+then ARG must be a variable which will hold the returned C<msqid_ds>
+structure. Returns like C<ioctl()>: the undefined value for error, "C<0> but
+true" for zero, or the actual return value otherwise. See also
+C<IPC::SysV> and C<IPC::Semaphore::Msg> documentation.
=item msgget KEY,FLAGS
-Calls the System V IPC function msgget(2). Returns the message queue id,
-or the undefined value if there is an error.
+Calls the System V IPC function msgget(2). Returns the message queue
+id, or the undefined value if there is an error. See also C<IPC::SysV>
+and C<IPC::SysV::Msg> documentation.
=item msgsnd ID,MSG,FLAGS
Calls the System V IPC function msgsnd to send the message MSG to the
message queue ID. MSG must begin with the long integer message type,
which may be created with C<pack("l", $type)>. Returns TRUE if
-successful, or FALSE if there is an error.
+successful, or FALSE if there is an error. See also C<IPC::SysV>
+and C<IPC::SysV::Msg> documentation.
=item msgrcv ID,VAR,SIZE,TYPE,FLAGS
Calls the System V IPC function msgrcv to receive a message from
message queue ID into variable VAR with a maximum message size of
-SIZE. Note that if a message is received, the message type will be the
-first thing in VAR, and the maximum length of VAR is SIZE plus the size
-of the message type. Returns TRUE if successful, or FALSE if there is
-an error.
+SIZE. Note that if a message is received, the message type will be
+the first thing in VAR, and the maximum length of VAR is SIZE plus the
+size of the message type. Returns TRUE if successful, or FALSE if
+there is an error. See also C<IPC::SysV> and C<IPC::SysV::Msg> documentation.
=item my EXPR
-A "my" declares the listed variables to be local (lexically) to the
-enclosing block, subroutine, C<eval>, or C<do/require/use>'d file. If
+A C<my()> declares the listed variables to be local (lexically) to the
+enclosing block, file, or C<eval()>. If
more than one value is listed, the list must be placed in parentheses. See
L<perlsub/"Private Variables via my()"> for details.
@@ -1896,30 +2317,38 @@ the next iteration of the loop:
LINE: while (<STDIN>) {
next LINE if /^#/; # discard comments
- ...
+ #...
}
Note that if there were a C<continue> block on the above, it would get
executed even on discarded lines. If the LABEL is omitted, the command
refers to the innermost enclosing loop.
+C<next> cannot be used to exit a block which returns a value such as
+C<eval {}>, C<sub {}> or C<do {}>, and should not be used to exit
+a grep() or map() operation.
+
+See also L</continue> for an illustration of how C<last>, C<next>, and
+C<redo> work.
+
=item no Module LIST
-See the "use" function, which "no" is the opposite of.
+See the L</use> function, which C<no> is the opposite of.
=item oct EXPR
=item oct
Interprets EXPR as an octal string and returns the corresponding
-value. (If EXPR happens to start off with 0x, interprets it as
-a hex string instead.) The following will handle decimal, octal, and
+value. (If EXPR happens to start off with C<0x>, interprets it as a
+hex string. If EXPR starts off with C<0b>, it is interpreted as a
+binary string.) The following will handle decimal, binary, octal, and
hex in the standard Perl or C notation:
$val = oct($val) if $val =~ /^0/;
-If EXPR is omitted, uses $_. This function is commonly used when
-a string such as "644" needs to be converted into a file mode, for
+If EXPR is omitted, uses C<$_>. This function is commonly used when
+a string such as C<644> needs to be converted into a file mode, for
example. (Although perl will automatically convert strings into
numbers as needed, this automatic conversion assumes base 10.)
@@ -1931,46 +2360,53 @@ Opens the file whose filename is given by EXPR, and associates it with
FILEHANDLE. If FILEHANDLE is an expression, its value is used as the
name of the real filehandle wanted. If EXPR is omitted, the scalar
variable of the same name as the FILEHANDLE contains the filename.
-(Note that lexical variables--those declared with C<my>--will not work
-for this purpose; so if you're using C<my>, specify EXPR in your call
-to open.)
-
-If the filename begins with '<' or nothing, the file is opened for input.
-If the filename begins with '>', the file is truncated and opened for
-output. If the filename begins with '>>', the file is opened for
-appending. You can put a '+' in front of the '>' or '<' to indicate that
-you want both read and write access to the file; thus '+<' is almost
-always preferred for read/write updates--the '+>' mode would clobber the
-file first. The prefix and the filename may be separated with spaces.
-These various prefixes correspond to the fopen(3) modes of 'r', 'r+', 'w',
-'w+', 'a', and 'a+'.
-
-If the filename begins with "|", the filename is interpreted as a command
-to which output is to be piped, and if the filename ends with a "|", the
-filename is interpreted See L<perlipc/"Using open() for IPC"> for more
-examples of this. as command which pipes input to us. (You may not have
-a raw open() to a command that pipes both in I<and> out, but see
-L<IPC::Open2>, L<IPC::Open3>, and L<perlipc/"Bidirectional Communication">
-for alternatives.)
-
-Opening '-' opens STDIN and opening 'E<gt>-' opens STDOUT. Open returns
-nonzero upon success, the undefined value otherwise. If the open
+(Note that lexical variables--those declared with C<my()>--will not work
+for this purpose; so if you're using C<my()>, specify EXPR in your call
+to open.) See L<perlopentut> for a kinder, gentler explanation of opening
+files.
+
+If the filename begins with C<'E<lt>'> or nothing, the file is opened for input.
+If the filename begins with C<'E<gt>'>, the file is truncated and opened for
+output, being created if necessary. If the filename begins with C<'E<gt>E<gt>'>,
+the file is opened for appending, again being created if necessary.
+You can put a C<'+'> in front of the C<'E<gt>'> or C<'E<lt>'> to indicate that
+you want both read and write access to the file; thus C<'+E<lt>'> is almost
+always preferred for read/write updates--the C<'+E<gt>'> mode would clobber the
+file first. You can't usually use either read-write mode for updating
+textfiles, since they have variable length records. See the B<-i>
+switch in L<perlrun> for a better approach. The file is created with
+permissions of C<0666> modified by the process' C<umask> value.
+
+The prefix and the filename may be separated with spaces.
+These various prefixes correspond to the fopen(3) modes of C<'r'>, C<'r+'>, C<'w'>,
+C<'w+'>, C<'a'>, and C<'a+'>.
+
+If the filename begins with C<'|'>, the filename is interpreted as a
+command to which output is to be piped, and if the filename ends with a
+C<'|'>, the filename is interpreted as a command which pipes output to
+us. See L<perlipc/"Using open() for IPC">
+for more examples of this. (You are not allowed to C<open()> to a command
+that pipes both in I<and> out, but see L<IPC::Open2>, L<IPC::Open3>,
+and L<perlipc/"Bidirectional Communication"> for alternatives.)
+
+Opening C<'-'> opens STDIN and opening C<'E<gt>-'> opens STDOUT. Open returns
+nonzero upon success, the undefined value otherwise. If the C<open()>
involved a pipe, the return value happens to be the pid of the
subprocess.
If you're unfortunate enough to be running Perl on a system that
distinguishes between text files and binary files (modern operating
systems don't care), then you should check out L</binmode> for tips for
-dealing with this. The key distinction between systems that need binmode
-and those that don't is their text file formats. Systems like Unix and
-Plan9 that delimit lines with a single character, and that encode that
-character in C as '\n', do not need C<binmode>. The rest need it.
+dealing with this. The key distinction between systems that need C<binmode()>
+and those that don't is their text file formats. Systems like Unix, MacOS, and
+Plan9, which delimit lines with a single character, and which encode that
+character in C as C<"\n">, do not need C<binmode()>. The rest need it.
When opening a file, it's usually a bad idea to continue normal execution
-if the request failed, so C<open> is frequently used in connection with
-C<die>. Even if C<die> won't do what you want (say, in a CGI script,
+if the request failed, so C<open()> is frequently used in connection with
+C<die()>. Even if C<die()> won't do what you want (say, in a CGI script,
where you want to make a nicely formatted error message (but there are
-modules which can help with that problem)) you should always check
+modules that can help with that problem)) you should always check
the return value from opening a file. The infrequent exception is when
working with an unopened filehandle is actually what you want to do.
@@ -1999,27 +2435,28 @@ Examples:
}
sub process {
- local($filename, $input) = @_;
+ my($filename, $input) = @_;
$input++; # this is a string increment
unless (open($input, $filename)) {
print STDERR "Can't open $filename: $!\n";
return;
}
+ local $_;
while (<$input>) { # note use of indirection
if (/^#include "(.*)"/) {
process($1, $input);
next;
}
- ... # whatever
+ #... # whatever
}
}
You may also, in the Bourne shell tradition, specify an EXPR beginning
-with "E<gt>&", in which case the rest of the string is interpreted as the
-name of a filehandle (or file descriptor, if numeric) which is to be
-duped and opened. You may use & after E<gt>, E<gt>E<gt>, E<lt>, +E<gt>,
-+E<gt>E<gt>, and +E<lt>. The
+with C<'E<gt>&'>, in which case the rest of the string is interpreted as the
+name of a filehandle (or file descriptor, if numeric) to be
+duped and opened. You may use C<&> after C<E<gt>>, C<E<gt>E<gt>>, C<E<lt>>, C<+E<gt>>,
+C<+E<gt>E<gt>>, and C<+E<lt>>. The
mode you specify should match the mode of the original filehandle.
(Duping a filehandle does not take into account any existing contents of
stdio buffers.)
@@ -2027,8 +2464,8 @@ Here is a script that saves, redirects, and restores STDOUT and
STDERR:
#!/usr/bin/perl
- open(SAVEOUT, ">&STDOUT");
- open(SAVEERR, ">&STDERR");
+ open(OLDOUT, ">&STDOUT");
+ open(OLDERR, ">&STDERR");
open(STDOUT, ">foo.out") || die "Can't redirect stdout";
open(STDERR, ">&STDOUT") || die "Can't dup stdout";
@@ -2042,22 +2479,21 @@ STDERR:
close(STDOUT);
close(STDERR);
- open(STDOUT, ">&SAVEOUT");
- open(STDERR, ">&SAVEERR");
+ open(STDOUT, ">&OLDOUT");
+ open(STDERR, ">&OLDERR");
print STDOUT "stdout 2\n";
print STDERR "stderr 2\n";
-
-If you specify "E<lt>&=N", where N is a number, then Perl will do an
-equivalent of C's fdopen() of that file descriptor; this is more
+If you specify C<'E<lt>&=N'>, where C<N> is a number, then Perl will do an
+equivalent of C's C<fdopen()> of that file descriptor; this is more
parsimonious of file descriptors. For example:
open(FILEHANDLE, "<&=$fd")
-If you open a pipe on the command "-", i.e., either "|-" or "-|", then
+If you open a pipe on the command C<'-'>, i.e., either C<'|-'> or C<'-|'>, then
there is an implicit fork done, and the return value of open is the pid
-of the child within the parent process, and 0 within the child
+of the child within the parent process, and C<0> within the child
process. (Use C<defined($pid)> to determine whether the open was successful.)
The filehandle behaves normally for the parent, but i/o to that
filehandle is piped from/to the STDOUT/STDIN of the child process.
@@ -2076,21 +2512,49 @@ The following pairs are more or less equivalent:
See L<perlipc/"Safe Pipe Opens"> for more examples of this.
-NOTE: On any operation which may do a fork, unflushed buffers remain
+NOTE: On any operation that may do a fork, any unflushed buffers remain
unflushed in both processes, which means you may need to set C<$|> to
-avoid duplicate output.
+avoid duplicate output. On systems that support a close-on-exec flag on
+files, the flag will be set for the newly opened file descriptor as
+determined by the value of $^F. See L<perlvar/$^F>.
Closing any piped filehandle causes the parent process to wait for the
child to finish, and returns the status value in C<$?>.
-Using the constructor from the IO::Handle package (or one of its
-subclasses, such as IO::File or IO::Socket),
-you can generate anonymous filehandles which have the scope of whatever
-variables hold references to them, and automatically close whenever
-and however you leave that scope:
+The filename passed to open will have leading and trailing
+whitespace deleted, and the normal redirection characters
+honored. This property, known as "magic open",
+can often be used to good effect. A user could specify a filename of
+F<"rsh cat file |">, or you could change certain filenames as needed:
+
+ $filename =~ s/(.*\.gz)\s*$/gzip -dc < $1|/;
+ open(FH, $filename) or die "Can't open $filename: $!";
+
+However, to open a file with arbitrary weird characters in it, it's
+necessary to protect any leading and trailing whitespace:
+
+ $file =~ s#^(\s)#./$1#;
+ open(FOO, "< $file\0");
+
+If you want a "real" C C<open()> (see L<open(2)> on your system), then you
+should use the C<sysopen()> function, which involves no such magic. This is
+another way to protect your filenames from interpretation. For example:
+
+ use IO::Handle;
+ sysopen(HANDLE, $path, O_RDWR|O_CREAT|O_EXCL)
+ or die "sysopen $path: $!";
+ $oldfh = select(HANDLE); $| = 1; select($oldfh);
+ print HANDLE "stuff $$\n");
+ seek(HANDLE, 0, 0);
+ print "File contains: ", <HANDLE>;
+
+Using the constructor from the C<IO::Handle> package (or one of its
+subclasses, such as C<IO::File> or C<IO::Socket>), you can generate anonymous
+filehandles that have the scope of whatever variables hold references to
+them, and automatically close whenever and however you leave that scope:
use IO::File;
- ...
+ #...
sub read_myfile_munged {
my $ALL = shift;
my $handle = new IO::File;
@@ -2102,32 +2566,12 @@ and however you leave that scope:
$first; # Or here.
}
-The filename that is passed to open will have leading and trailing
-whitespace deleted. To open a file with arbitrary weird
-characters in it, it's necessary to protect any leading and trailing
-whitespace thusly:
-
- $file =~ s#^(\s)#./$1#;
- open(FOO, "< $file\0");
-
-If you want a "real" C open() (see L<open(2)> on your system), then
-you should use the sysopen() function. This is another way to
-protect your filenames from interpretation. For example:
-
- use IO::Handle;
- sysopen(HANDLE, $path, O_RDWR|O_CREAT|O_EXCL, 0700)
- or die "sysopen $path: $!";
- HANDLE->autoflush(1);
- HANDLE->print("stuff $$\n");
- seek(HANDLE, 0, 0);
- print "File contains: ", <HANDLE>;
-
-See L</seek()> for some details about mixing reading and writing.
+See L</seek> for some details about mixing reading and writing.
=item opendir DIRHANDLE,EXPR
-Opens a directory named EXPR for processing by readdir(), telldir(),
-seekdir(), rewinddir(), and closedir(). Returns TRUE if successful.
+Opens a directory named EXPR for processing by C<readdir()>, C<telldir()>,
+C<seekdir()>, C<rewinddir()>, and C<closedir()>. Returns TRUE if successful.
DIRHANDLEs have their own namespace separate from FILEHANDLEs.
=item ord EXPR
@@ -2135,7 +2579,7 @@ DIRHANDLEs have their own namespace separate from FILEHANDLEs.
=item ord
Returns the numeric ascii value of the first character of EXPR. If
-EXPR is omitted, uses $_. For the reverse, see L</chr>.
+EXPR is omitted, uses C<$_>. For the reverse, see L</chr>.
=item pack TEMPLATE,LIST
@@ -2144,8 +2588,10 @@ returning the string containing the structure. The TEMPLATE is a
sequence of characters that give the order and type of values, as
follows:
+ a A string with arbitrary binary data, will be null padded.
A An ascii string, will be space padded.
- a An ascii string, will be null padded.
+ Z A null terminated (asciz) string, will be null padded.
+
b A bit string (ascending bit order, like vec()).
B A bit string (descending bit order).
h A hex string (low nybble first).
@@ -2161,9 +2607,10 @@ follows:
i A signed integer value.
I An unsigned integer value.
- (This 'integer' is _at_least_ 32 bits wide. Its exact size
- depends on what a local C compiler calls 'int', and may
- even be larger than the 'long' described in the next item.)
+ (This 'integer' is _at least_ 32 bits wide. Its exact
+ size depends on what a local C compiler calls 'int',
+ and may even be larger than the 'long' described in
+ the next item.)
l A signed long value.
L An unsigned long value.
@@ -2177,6 +2624,12 @@ follows:
(These 'shorts' and 'longs' are _exactly_ 16 bits and
_exactly_ 32 bits, respectively.)
+ q A signed quad (64-bit) value.
+ Q An unsigned quad value.
+ (Available only if your system supports 64-bit integer values
+ _and_ if Perl has been compiled to support those.
+ Causes a fatal error otherwise.)
+
f A single-precision float in the native format.
d A double-precision float in the native format.
@@ -2186,44 +2639,115 @@ follows:
u A uuencoded string.
w A BER compressed integer. Its bytes represent an unsigned
- integer in base 128, most significant digit first, with as few
- digits as possible. Bit eight (the high bit) is set on each
- byte except the last.
+ integer in base 128, most significant digit first, with as
+ few digits as possible. Bit eight (the high bit) is set
+ on each byte except the last.
x A null byte.
X Back up a byte.
@ Null fill to absolute position.
-Each letter may optionally be followed by a number which gives a repeat
-count. With all types except "a", "A", "b", "B", "h", "H", and "P" the
-pack function will gobble up that many values from the LIST. A * for the
-repeat count means to use however many items are left. The "a" and "A"
-types gobble just one value, but pack it as a string of length count,
-padding with nulls or spaces as necessary. (When unpacking, "A" strips
-trailing spaces and nulls, but "a" does not.) Likewise, the "b" and "B"
-fields pack a string that many bits long. The "h" and "H" fields pack a
-string that many nybbles long. The "p" type packs a pointer to a null-
-terminated string. You are responsible for ensuring the string is not a
-temporary value (which can potentially get deallocated before you get
-around to using the packed result). The "P" packs a pointer to a structure
-of the size indicated by the length. A NULL pointer is created if the
-corresponding value for "p" or "P" is C<undef>.
-Real numbers (floats and doubles) are
-in the native machine format only; due to the multiplicity of floating
-formats around, and the lack of a standard "network" representation, no
-facility for interchange has been made. This means that packed floating
-point data written on one machine may not be readable on another - even if
-both use IEEE floating point arithmetic (as the endian-ness of the memory
-representation is not part of the IEEE spec). Note that Perl uses doubles
-internally for all numeric calculation, and converting from double into
-float and thence back to double again will lose precision (i.e.,
-C<unpack("f", pack("f", $foo)>) will not in general equal $foo).
+The following rules apply:
+
+=over 8
+
+=item *
+
+Each letter may optionally be followed by a number giving a repeat
+count. With all types except C<"a">, C<"A">, C<"Z">, C<"b">, C<"B">, C<"h">,
+C<"H">, and C<"P"> the pack function will gobble up that many values from
+the LIST. A C<*> for the repeat count means to use however many items are
+left.
+
+=item *
+
+The C<"a">, C<"A">, and C<"Z"> types gobble just one value, but pack it as a
+string of length count, padding with nulls or spaces as necessary. When
+unpacking, C<"A"> strips trailing spaces and nulls, C<"Z"> strips everything
+after the first null, and C<"a"> returns data verbatim.
+
+=item *
+
+Likewise, the C<"b"> and C<"B"> fields pack a string that many bits long.
+
+=item *
+
+The C<"h"> and C<"H"> fields pack a string that many nybbles long.
+
+=item *
+
+The C<"p"> type packs a pointer to a null-terminated string. You are
+responsible for ensuring the string is not a temporary value (which can
+potentially get deallocated before you get around to using the packed result).
+The C<"P"> type packs a pointer to a structure of the size indicated by the
+length. A NULL pointer is created if the corresponding value for C<"p"> or
+C<"P"> is C<undef>.
+
+=item *
+
+The integer formats C<"s">, C<"S">, C<"i">, C<"I">, C<"l">, and C<"L">
+are inherently non-portable between processors and operating systems
+because they obey the native byteorder and endianness. For example a
+4-byte integer 0x87654321 (2271560481 decimal) be ordered natively
+(arranged in and handled by the CPU registers) into bytes as
+
+ 0x12 0x34 0x56 0x78 # little-endian
+ 0x78 0x56 0x34 0x12 # big-endian
+
+Basically, the Intel, Alpha, and VAX CPUs and little-endian, while
+everybody else, for example Motorola m68k/88k, PPC, Sparc, HP PA,
+Power, and Cray are big-endian. MIPS can be either: Digital used it
+in little-endian mode, SGI uses it in big-endian mode.
+
+The names `big-endian' and `little-endian' are joking references to
+the classic "Gulliver's Travels" (via the paper "On Holy Wars and a
+Plea for Peace" by Danny Cohen, USC/ISI IEN 137, April 1, 1980) and
+the egg-eating habits of the lilliputs.
+
+Some systems may even have weird byte orders such as
+
+ 0x56 0x78 0x12 0x34
+ 0x34 0x12 0x78 0x56
+
+You can see your system's preference with
+
+ print join(" ", map { sprintf "%#02x", $_ }
+ unpack("C*",pack("L",0x12345678))), "\n";
+
+The byteorder on the platform where Perl was built is also available
+via L<Config>:
+
+ use Config;
+ print $Config{byteorder}, "\n";
+
+Byteorders C<'1234'> and C<'12345678'> are little-endian, C<'4321'>
+and C<'87654321'> are big-endian.
+
+If you want portable packed integers use the formats C<"n">, C<"N">,
+C<"v">, and C<"V">, their byte endianness and size is known.
+
+=item *
+
+Real numbers (floats and doubles) are in the native machine format only;
+due to the multiplicity of floating formats around, and the lack of a
+standard "network" representation, no facility for interchange has been
+made. This means that packed floating point data written on one machine
+may not be readable on another - even if both use IEEE floating point
+arithmetic (as the endian-ness of the memory representation is not part
+of the IEEE spec).
+
+Note that Perl uses doubles internally for all numeric calculation, and
+converting from double into float and thence back to double again will
+lose precision (i.e., C<unpack("f", pack("f", $foo)>) will not in general
+equal C<$foo>).
+
+=back
Examples:
- $foo = pack("cccc",65,66,67,68);
+ $foo = pack("CCCC",65,66,67,68);
# foo eq "ABCD"
- $foo = pack("c4",65,66,67,68);
+ $foo = pack("C4",65,66,67,68);
# same thing
$foo = pack("ccxxcc",65,66,67,68);
@@ -2245,27 +2769,42 @@ Examples:
$foo = pack("i9pl", gmtime);
# a real struct tm (on my system anyway)
+ $utmp_template = "Z8 Z8 Z16 L";
+ $utmp = pack($utmp_template, @utmp1);
+ # a struct utmp (BSDish)
+
+ @utmp2 = unpack($utmp_template, $utmp);
+ # "@utmp1" eq "@utmp2"
+
sub bintodec {
unpack("N", pack("B32", substr("0" x 32 . shift, -32)));
}
-The same template may generally also be used in the unpack function.
+The same template may generally also be used in unpack().
+
+=item package
=item package NAMESPACE
Declares the compilation unit as being in the given namespace. The scope
-of the package declaration is from the declaration itself through the end of
-the enclosing block (the same scope as the local() operator). All further
-unqualified dynamic identifiers will be in this namespace. A package
-statement affects only dynamic variables--including those you've used
-local() on--but I<not> lexical variables created with my(). Typically it
-would be the first declaration in a file to be included by the C<require>
-or C<use> operator. You can switch into a package in more than one place;
-it influences merely which symbol table is used by the compiler for the
-rest of that block. You can refer to variables and filehandles in other
-packages by prefixing the identifier with the package name and a double
-colon: C<$Package::Variable>. If the package name is null, the C<main>
-package as assumed. That is, C<$::sail> is equivalent to C<$main::sail>.
+of the package declaration is from the declaration itself through the end
+of the enclosing block, file, or eval (the same as the C<my()> operator).
+All further unqualified dynamic identifiers will be in this namespace.
+A package statement affects only dynamic variables--including those
+you've used C<local()> on--but I<not> lexical variables, which are created
+with C<my()>. Typically it would be the first declaration in a file to
+be included by the C<require> or C<use> operator. You can switch into a
+package in more than one place; it merely influences which symbol table
+is used by the compiler for the rest of that block. You can refer to
+variables and filehandles in other packages by prefixing the identifier
+with the package name and a double colon: C<$Package::Variable>.
+If the package name is null, the C<main> package as assumed. That is,
+C<$::sail> is equivalent to C<$main::sail> (as well as to C<$main'sail>,
+still seen in older code).
+
+If NAMESPACE is omitted, then there is no current package, and all
+identifiers must be fully qualified or lexicals. This is stricter
+than C<use strict>, since it also extends to function names.
See L<perlmod/"Packages"> for more information about packages, modules,
and classes. See L<perlsub> for other scoping issues.
@@ -2281,26 +2820,29 @@ after each command, depending on the application.
See L<IPC::Open2>, L<IPC::Open3>, and L<perlipc/"Bidirectional Communication">
for examples of such things.
+On systems that support a close-on-exec flag on files, the flag will be set
+for the newly opened file descriptors as determined by the value of $^F.
+See L<perlvar/$^F>.
+
=item pop ARRAY
=item pop
Pops and returns the last value of the array, shortening the array by
-1. Has a similar effect to
+one element. Has a similar effect to
$tmp = $ARRAY[$#ARRAY--];
If there are no elements in the array, returns the undefined value.
-If ARRAY is omitted, pops the
-@ARGV array in the main program, and the @_ array in subroutines, just
-like shift().
+If ARRAY is omitted, pops the C<@ARGV> array in the main program, and
+the C<@_> array in subroutines, just like C<shift()>.
=item pos SCALAR
=item pos
Returns the offset of where the last C<m//g> search left off for the variable
-is in question ($_ is used when the variable is not specified). May be
+is in question (C<$_> is used when the variable is not specified). May be
modified to change that offset. Such modification will also influence
the C<\G> zero-width assertion in regular expressions. See L<perlre> and
L<perlop>.
@@ -2313,20 +2855,20 @@ L<perlop>.
Prints a string or a comma-separated list of strings. Returns TRUE
if successful. FILEHANDLE may be a scalar variable name, in which case
-the variable contains the name of or a reference to the filehandle, thus introducing one
-level of indirection. (NOTE: If FILEHANDLE is a variable and the next
-token is a term, it may be misinterpreted as an operator unless you
-interpose a + or put parentheses around the arguments.) If FILEHANDLE is
-omitted, prints by default to standard output (or to the last selected
-output channel--see L</select>). If LIST is also omitted, prints $_ to
-STDOUT. To set the default output channel to something other than
-STDOUT use the select operation. Note that, because print takes a
-LIST, anything in the LIST is evaluated in a list context, and any
-subroutine that you call will have one or more of its expressions
-evaluated in a list context. Also be careful not to follow the print
-keyword with a left parenthesis unless you want the corresponding right
-parenthesis to terminate the arguments to the print--interpose a + or
-put parentheses around all the arguments.
+the variable contains the name of or a reference to the filehandle, thus
+introducing one level of indirection. (NOTE: If FILEHANDLE is a variable
+and the next token is a term, it may be misinterpreted as an operator
+unless you interpose a C<+> or put parentheses around the arguments.)
+If FILEHANDLE is omitted, prints by default to standard output (or to the
+last selected output channel--see L</select>). If LIST is also omitted,
+prints C<$_> to the currently selected output channel. To set the default
+output channel to something other than STDOUT use the select operation.
+Note that, because print takes a LIST, anything in the LIST is evaluated
+in list context, and any subroutine that you call will have one or
+more of its expressions evaluated in list context. Also be careful
+not to follow the print keyword with a left parenthesis unless you want
+the corresponding right parenthesis to terminate the arguments to the
+print--interpose a C<+> or put parentheses around all the arguments.
Note that if you're storing FILEHANDLES in an array or other expression,
you will have to use a block returning its value instead:
@@ -2338,13 +2880,14 @@ you will have to use a block returning its value instead:
=item printf FORMAT, LIST
-Equivalent to C<print FILEHANDLE sprintf(FORMAT, LIST)>. The first argument
-of the list will be interpreted as the printf format. If C<use locale> is
+Equivalent to C<print FILEHANDLE sprintf(FORMAT, LIST)>, except that C<$\>
+(the output record separator) is not appended. The first argument
+of the list will be interpreted as the C<printf()> format. If C<use locale> is
in effect, the character used for the decimal point in formatted real numbers
is affected by the LC_NUMERIC locale. See L<perllocale>.
-Don't fall into the trap of using a printf() when a simple
-print() would do. The print() is more efficient, and less
+Don't fall into the trap of using a C<printf()> when a simple
+C<print()> would do. The C<print()> is more efficient and less
error prone.
=item prototype FUNCTION
@@ -2353,6 +2896,13 @@ Returns the prototype of a function as a string (or C<undef> if the
function has no prototype). FUNCTION is a reference to, or the name of,
the function whose prototype you want to retrieve.
+If FUNCTION is a string starting with C<CORE::>, the rest is taken as a
+name for Perl builtin. If the builtin is not I<overridable> (such as
+C<qw//>) or its arguments cannot be expressed by a prototype (such as
+C<system()>) returns C<undef> because the builtin does not really behave
+like a Perl function. Otherwise, the string describing the equivalent
+prototype is returned.
+
=item push ARRAY,LIST
Treats ARRAY as a stack, and pushes the values of LIST
@@ -2369,11 +2919,13 @@ but is more efficient. Returns the new number of elements in the array.
=item qq/STRING/
+=item qr/STRING/
+
=item qx/STRING/
=item qw/STRING/
-Generalized quotes. See L<perlop>.
+Generalized quotes. See L<perlop/"Regexp Quote-Like Operators">.
=item quotemeta EXPR
@@ -2384,18 +2936,18 @@ characters backslashed. (That is, all characters not matching
C</[A-Za-z_0-9]/> will be preceded by a backslash in the
returned string, regardless of any locale settings.)
This is the internal function implementing
-the \Q escape in double-quoted strings.
+the C<\Q> escape in double-quoted strings.
-If EXPR is omitted, uses $_.
+If EXPR is omitted, uses C<$_>.
=item rand EXPR
=item rand
-Returns a random fractional number greater than or equal to 0 and less
+Returns a random fractional number greater than or equal to C<0> and less
than the value of EXPR. (EXPR should be positive.) If EXPR is
-omitted, the value 1 is used. Automatically calls srand() unless
-srand() has already been called. See also srand().
+omitted, the value C<1> is used. Automatically calls C<srand()> unless
+C<srand()> has already been called. See also C<srand()>.
(Note: If your rand function consistently returns numbers that are too
large or too small, then your version of Perl was probably compiled
@@ -2406,23 +2958,23 @@ with the wrong number of RANDBITS.)
=item read FILEHANDLE,SCALAR,LENGTH
Attempts to read LENGTH bytes of data into variable SCALAR from the
-specified FILEHANDLE. Returns the number of bytes actually read, or
-undef if there was an error. SCALAR will be grown or shrunk to the
-length actually read. An OFFSET may be specified to place the read
-data at some other place than the beginning of the string. This call
-is actually implemented in terms of stdio's fread call. To get a true
-read system call, see sysread().
+specified FILEHANDLE. Returns the number of bytes actually read,
+C<0> at end of file, or undef if there was an error. SCALAR will be grown
+or shrunk to the length actually read. An OFFSET may be specified to
+place the read data at some other place than the beginning of the
+string. This call is actually implemented in terms of stdio's fread(3)
+call. To get a true read(2) system call, see C<sysread()>.
=item readdir DIRHANDLE
-Returns the next directory entry for a directory opened by opendir().
-If used in a list context, returns all the rest of the entries in the
+Returns the next directory entry for a directory opened by C<opendir()>.
+If used in list context, returns all the rest of the entries in the
directory. If there are no more entries, returns an undefined value in
-a scalar context or a null list in a list context.
+scalar context or a null list in list context.
-If you're planning to filetest the return values out of a readdir(), you'd
+If you're planning to filetest the return values out of a C<readdir()>, you'd
better prepend the directory in question. Otherwise, because we didn't
-chdir() there, it would have been testing the wrong file.
+C<chdir()> there, it would have been testing the wrong file.
opendir(DIR, $some_dir) || die "can't opendir $some_dir: $!";
@dots = grep { /^\./ && -f "$some_dir/$_" } readdir(DIR);
@@ -2430,14 +2982,24 @@ chdir() there, it would have been testing the wrong file.
=item readline EXPR
-Reads from the file handle EXPR. In scalar context, a single line
-is read and returned. In list context, reads until end-of-file is
-reached and returns a list of lines (however you've defined lines
-with $/ or $INPUT_RECORD_SEPARATOR).
+Reads from the filehandle whose typeglob is contained in EXPR. In scalar
+context, each call reads and returns the next line, until end-of-file is
+reached, whereupon the subsequent call returns undef. In list context,
+reads until end-of-file is reached and returns a list of lines. Note that
+the notion of "line" used here is however you may have defined it
+with C<$/> or C<$INPUT_RECORD_SEPARATOR>). See L<perlvar/"$/">.
+
+When C<$/> is set to C<undef>, when readline() is in scalar
+context (i.e. file slurp mode), and when an empty file is read, it
+returns C<''> the first time, followed by C<undef> subsequently.
+
This is the internal function implementing the C<E<lt>EXPRE<gt>>
operator, but you can use it directly. The C<E<lt>EXPRE<gt>>
operator is discussed in more detail in L<perlop/"I/O Operators">.
+ $line = <STDIN>;
+ $line = readline(*STDIN); # same thing
+
=item readlink EXPR
=item readlink
@@ -2445,24 +3007,24 @@ operator is discussed in more detail in L<perlop/"I/O Operators">.
Returns the value of a symbolic link, if symbolic links are
implemented. If not, gives a fatal error. If there is some system
error, returns the undefined value and sets C<$!> (errno). If EXPR is
-omitted, uses $_.
+omitted, uses C<$_>.
=item readpipe EXPR
-EXPR is interpolated and then executed as a system command.
+EXPR is executed as a system command.
The collected standard output of the command is returned.
In scalar context, it comes back as a single (potentially
multi-line) string. In list context, returns a list of lines
-(however you've defined lines with $/ or $INPUT_RECORD_SEPARATOR).
+(however you've defined lines with C<$/> or C<$INPUT_RECORD_SEPARATOR>).
This is the internal function implementing the C<qx/EXPR/>
operator, but you can use it directly. The C<qx/EXPR/>
operator is discussed in more detail in L<perlop/"I/O Operators">.
-=item recv SOCKET,SCALAR,LEN,FLAGS
+=item recv SOCKET,SCALAR,LENGTH,FLAGS
Receives a message on a socket. Attempts to receive LENGTH bytes of
data into variable SCALAR from the specified SOCKET filehandle.
-Actually does a C recvfrom(), so that it can returns the address of the
+Actually does a C C<recvfrom()>, so that it can return the address of the
sender. Returns the undefined value if there's an error. SCALAR will
be grown or shrunk to the length actually read. Takes the same flags
as the system call of the same name.
@@ -2487,7 +3049,7 @@ themselves about what was just input:
$front = $_;
while (<STDIN>) {
if (/}/) { # end of comment?
- s|^|$front{|;
+ s|^|$front\{|;
redo LINE;
}
}
@@ -2495,12 +3057,19 @@ themselves about what was just input:
print;
}
+C<redo> cannot be used to retry a block which returns a value such as
+C<eval {}>, C<sub {}> or C<do {}>, and should not be used to exit
+a grep() or map() operation.
+
+See also L</continue> for an illustration of how C<last>, C<next>, and
+C<redo> work.
+
=item ref EXPR
=item ref
Returns a TRUE value if EXPR is a reference, FALSE otherwise. If EXPR
-is not specified, $_ will be used. The value returned depends on the
+is not specified, C<$_> will be used. The value returned depends on the
type of thing the reference is a reference to.
Builtin types include:
@@ -2512,39 +3081,47 @@ Builtin types include:
GLOB
If the referenced object has been blessed into a package, then that package
-name is returned instead. You can think of ref() as a typeof() operator.
+name is returned instead. You can think of C<ref()> as a C<typeof()> operator.
if (ref($r) eq "HASH") {
print "r is a reference to a hash.\n";
}
- if (!ref ($r) {
+ unless (ref($r)) {
print "r is not a reference at all.\n";
}
+ if (UNIVERSAL::isa($r, "HASH")) { # for subclassing
+ print "r is a reference to something that isa hash.\n";
+ }
See also L<perlref>.
=item rename OLDNAME,NEWNAME
-Changes the name of a file. Returns 1 for success, 0 otherwise. Will
-not work across file system boundaries.
+Changes the name of a file. Returns C<1> for success, C<0> otherwise.
+Behavior of this function varies wildly depending on your system
+implementation. For example, it will usually not work across file system
+boundaries, even though the system I<mv> command sometimes compensates
+for this. Other restrictions include whether it works on directories,
+open files, or pre-existing files. Check L<perlport> and either the
+rename(2) manpage or equivalent system documentation for details.
=item require EXPR
=item require
-Demands some semantics specified by EXPR, or by $_ if EXPR is not
+Demands some semantics specified by EXPR, or by C<$_> if EXPR is not
supplied. If EXPR is numeric, demands that the current version of Perl
(C<$]> or $PERL_VERSION) be equal or greater than EXPR.
Otherwise, demands that a library file be included if it hasn't already
been included. The file is included via the do-FILE mechanism, which is
-essentially just a variety of eval(). Has semantics similar to the following
+essentially just a variety of C<eval()>. Has semantics similar to the following
subroutine:
sub require {
- local($filename) = @_;
+ my($filename) = @_;
return 1 if $INC{$filename};
- local($realfilename,$result);
+ my($realfilename,$result);
ITER: {
foreach $prefix (@INC) {
$realfilename = "$prefix/$filename";
@@ -2558,13 +3135,13 @@ subroutine:
die $@ if $@;
die "$filename did not return true value" unless $result;
$INC{$filename} = $realfilename;
- $result;
+ return $result;
}
Note that the file will not be included twice under the same specified
name. The file must return TRUE as the last statement to indicate
successful execution of any initialization code, so it's customary to
-end such a file with "1;" unless you're sure it'll return TRUE
+end such a file with "C<1;>" unless you're sure it'll return TRUE
otherwise. But it's better just to put the "C<1;>", in case you add more
statements.
@@ -2573,75 +3150,95 @@ replaces "F<::>" with "F</>" in the filename for you,
to make it easy to load standard modules. This form of loading of
modules does not risk altering your namespace.
-For a yet-more-powerful import facility, see L</use> and
-L<perlmod>.
+In other words, if you try this:
+
+ require Foo::Bar; # a splendid bareword
+
+The require function will actually look for the "F<Foo/Bar.pm>" file in the
+directories specified in the C<@INC> array.
+
+But if you try this:
+
+ $class = 'Foo::Bar';
+ require $class; # $class is not a bareword
+ #or
+ require "Foo::Bar"; # not a bareword because of the ""
+
+The require function will look for the "F<Foo::Bar>" file in the @INC array and
+will complain about not finding "F<Foo::Bar>" there. In this case you can do:
+
+ eval "require $class";
+
+For a yet-more-powerful import facility, see L</use> and L<perlmod>.
=item reset EXPR
=item reset
Generally used in a C<continue> block at the end of a loop to clear
-variables and reset ?? searches so that they work again. The
+variables and reset C<??> searches so that they work again. The
expression is interpreted as a list of single characters (hyphens
allowed for ranges). All variables and arrays beginning with one of
those letters are reset to their pristine state. If the expression is
-omitted, one-match searches (?pattern?) are reset to match again. Resets
+omitted, one-match searches (C<?pattern?>) are reset to match again. Resets
only variables or searches in the current package. Always returns
1. Examples:
reset 'X'; # reset all X variables
reset 'a-z'; # reset lower case variables
- reset; # just reset ?? searches
+ reset; # just reset ?one-time? searches
-Resetting "A-Z" is not recommended because you'll wipe out your
-ARGV and ENV arrays. Resets only package variables--lexical variables
-are unaffected, but they clean themselves up on scope exit anyway,
-so you'll probably want to use them instead. See L</my>.
+Resetting C<"A-Z"> is not recommended because you'll wipe out your
+C<@ARGV> and C<@INC> arrays and your C<%ENV> hash. Resets only package
+variables--lexical variables are unaffected, but they clean themselves
+up on scope exit anyway, so you'll probably want to use them instead.
+See L</my>.
=item return EXPR
=item return
-Returns from a subroutine, eval(), or do FILE with the value of the
-given EXPR. Evaluation of EXPR may be in a list, scalar, or void
+Returns from a subroutine, C<eval()>, or C<do FILE> with the value
+given in EXPR. Evaluation of EXPR may be in list, scalar, or void
context, depending on how the return value will be used, and the context
-may vary from one execution to the next (see wantarray()). If no EXPR
-is given, returns an empty list in a list context, an undefined value in
-a scalar context, or nothing in a void context.
+may vary from one execution to the next (see C<wantarray()>). If no EXPR
+is given, returns an empty list in list context, the undefined value in
+scalar context, and (of course) nothing at all in a void context.
-(Note that in the absence of a return, a subroutine, eval, or do FILE
-will automatically return the value of the last expression evaluated.)
+(Note that in the absence of a explicit C<return>, a subroutine, eval,
+or do FILE will automatically return the value of the last expression
+evaluated.)
=item reverse LIST
-In a list context, returns a list value consisting of the elements
-of LIST in the opposite order. In a scalar context, concatenates the
-elements of LIST, and returns a string value consisting of those bytes,
-but in the opposite order.
+In list context, returns a list value consisting of the elements
+of LIST in the opposite order. In scalar context, concatenates the
+elements of LIST and returns a string value with all characters
+in the opposite order.
print reverse <>; # line tac, last line first
undef $/; # for efficiency of <>
- print scalar reverse <>; # byte tac, last line tsrif
+ print scalar reverse <>; # character tac, last line tsrif
This operator is also handy for inverting a hash, although there are some
caveats. If a value is duplicated in the original hash, only one of those
can be represented as a key in the inverted hash. Also, this has to
unwind one hash and build a whole new one, which may take some time
-on a large hash.
+on a large hash, such as from a DBM file.
%by_name = reverse %by_address; # Invert the hash
=item rewinddir DIRHANDLE
Sets the current position to the beginning of the directory for the
-readdir() routine on DIRHANDLE.
+C<readdir()> routine on DIRHANDLE.
=item rindex STR,SUBSTR,POSITION
=item rindex STR,SUBSTR
-Works just like index except that it returns the position of the LAST
+Works just like index() except that it returns the position of the LAST
occurrence of SUBSTR in STR. If POSITION is specified, returns the
last occurrence at or before that position.
@@ -2649,9 +3246,9 @@ last occurrence at or before that position.
=item rmdir
-Deletes the directory specified by FILENAME if it is empty. If it
-succeeds it returns 1, otherwise it returns 0 and sets C<$!> (errno). If
-FILENAME is omitted, uses $_.
+Deletes the directory specified by FILENAME if that directory is empty. If it
+succeeds it returns TRUE, otherwise it returns FALSE and sets C<$!> (errno). If
+FILENAME is omitted, uses C<$_>.
=item s///
@@ -2659,41 +3256,57 @@ The substitution operator. See L<perlop>.
=item scalar EXPR
-Forces EXPR to be interpreted in a scalar context and returns the value
+Forces EXPR to be interpreted in scalar context and returns the value
of EXPR.
@counts = ( scalar @a, scalar @b, scalar @c );
There is no equivalent operator to force an expression to
-be interpolated in a list context because it's in practice never
+be interpolated in list context because in practice, this is never
needed. If you really wanted to do so, however, you could use
the construction C<@{[ (some expression) ]}>, but usually a simple
C<(some expression)> suffices.
+Since C<scalar> is a unary operator, if you accidentally use for EXPR a
+parenthesized list, this behaves as a scalar comma expression, evaluating
+all but the last element in void context and returning the final element
+evaluated in scalar context. This is seldom what you want.
+
+The following single statement:
+
+ print uc(scalar(&foo,$bar)),$baz;
+
+is the moral equivalent of these two:
+
+ &foo;
+ print(uc($bar),$baz);
+
+See L<perlop> for more details on unary operators and the comma operator.
+
=item seek FILEHANDLE,POSITION,WHENCE
-Sets FILEHANDLE's position, just like the fseek() call of stdio.
+Sets FILEHANDLE's position, just like the C<fseek()> call of C<stdio()>.
FILEHANDLE may be an expression whose value gives the name of the
-filehandle. The values for WHENCE are 0 to set the new position to
-POSITION, 1 to set it to the current position plus POSITION, and 2 to
+filehandle. The values for WHENCE are C<0> to set the new position to
+POSITION, C<1> to set it to the current position plus POSITION, and C<2> to
set it to EOF plus POSITION (typically negative). For WHENCE you may
-use the constants SEEK_SET, SEEK_CUR, and SEEK_END from either the
-IO::Seekable or the POSIX module. Returns 1 upon success, 0 otherwise.
+use the constants C<SEEK_SET>, C<SEEK_CUR>, and C<SEEK_END> from either the
+C<IO::Seekable> or the POSIX module. Returns C<1> upon success, C<0> otherwise.
-If you want to position file for sysread() or syswrite(), don't use
-seek() -- buffering makes its effect on the file's system position
-unpredictable and non-portable. Use sysseek() instead.
+If you want to position file for C<sysread()> or C<syswrite()>, don't use
+C<seek()> -- buffering makes its effect on the file's system position
+unpredictable and non-portable. Use C<sysseek()> instead.
-On some systems you have to do a seek whenever you switch between reading
-and writing. Amongst other things, this may have the effect of calling
-stdio's clearerr(3). A WHENCE of 1 (SEEK_CUR) is useful for not moving
-the file position:
+Due to the rules and rigors of ANSI C, on some systems you have to do a
+seek whenever you switch between reading and writing. Amongst other
+things, this may have the effect of calling stdio's clearerr(3).
+A WHENCE of C<1> (C<SEEK_CUR>) is useful for not moving the file position:
seek(TEST,0,1);
This is also useful for applications emulating C<tail -f>. Once you hit
EOF on your read, and then sleep for a while, you might have to stick in a
-seek() to reset things. The seek() doesn't change the current position,
+seek() to reset things. The C<seek()> doesn't change the current position,
but it I<does> clear the end-of-file condition on the handle, so that the
next C<E<lt>FILEE<gt>> makes Perl try again to read something. We hope.
@@ -2701,7 +3314,8 @@ If that doesn't work (some stdios are particularly cantankerous), then
you may need something more like this:
for (;;) {
- for ($curpos = tell(FILE); $_ = <FILE>; $curpos = tell(FILE)) {
+ for ($curpos = tell(FILE); $_ = <FILE>;
+ $curpos = tell(FILE)) {
# search for some stuff and put it into files
}
sleep($for_a_while);
@@ -2710,8 +3324,8 @@ you may need something more like this:
=item seekdir DIRHANDLE,POS
-Sets the current position for the readdir() routine on DIRHANDLE. POS
-must be a value returned by telldir(). Has the same caveats about
+Sets the current position for the C<readdir()> routine on DIRHANDLE. POS
+must be a value returned by C<telldir()>. Has the same caveats about
possible directory compaction as the corresponding system library
routine.
@@ -2721,7 +3335,7 @@ routine.
Returns the currently selected filehandle. Sets the current default
filehandle for output, if FILEHANDLE is supplied. This has two
-effects: first, a C<write> or a C<print> without a filehandle will
+effects: first, a C<write()> or a C<print()> without a filehandle will
default to this FILEHANDLE. Second, references to variables related to
output will refer to this output channel. For example, if you have to
set the top of form format for more than one output channel, you might
@@ -2746,7 +3360,7 @@ methods, preferring to write the last example as:
=item select RBITS,WBITS,EBITS,TIMEOUT
This calls the select(2) system call with the bit masks specified, which
-can be constructed using fileno() and vec(), along these lines:
+can be constructed using C<fileno()> and C<vec()>, along these lines:
$rin = $win = $ein = '';
vec($rin,fileno(STDIN),1) = 1;
@@ -2757,8 +3371,8 @@ If you want to select on many filehandles you might wish to write a
subroutine:
sub fhbits {
- local(@fhlist) = split(' ',$_[0]);
- local($bits);
+ my(@fhlist) = split(' ',$_[0]);
+ my($bits);
for (@fhlist) {
vec($bits,fileno($_),1) = 1;
}
@@ -2775,33 +3389,39 @@ or to block until something becomes ready just do this
$nfound = select($rout=$rin, $wout=$win, $eout=$ein, undef);
-Most systems do not bother to return anything useful in $timeleft, so
-calling select() in a scalar context just returns $nfound.
+Most systems do not bother to return anything useful in C<$timeleft>, so
+calling select() in scalar context just returns C<$nfound>.
Any of the bit masks can also be undef. The timeout, if specified, is
in seconds, which may be fractional. Note: not all implementations are
-capable of returning the $timeleft. If not, they always return
-$timeleft equal to the supplied $timeout.
+capable of returning theC<$timeleft>. If not, they always return
+C<$timeleft> equal to the supplied C<$timeout>.
You can effect a sleep of 250 milliseconds this way:
select(undef, undef, undef, 0.25);
-B<WARNING>: Do not attempt to mix buffered I/O (like read() or E<lt>FHE<gt>)
-with select(). You have to use sysread() instead.
+B<WARNING>: One should not attempt to mix buffered I/O (like C<read()>
+or E<lt>FHE<gt>) with C<select()>, except as permitted by POSIX, and even
+then only on POSIX systems. You have to use C<sysread()> instead.
=item semctl ID,SEMNUM,CMD,ARG
-Calls the System V IPC function semctl. If CMD is &IPC_STAT or
-&GETALL, then ARG must be a variable which will hold the returned
-semid_ds structure or semaphore value array. Returns like ioctl: the
-undefined value for error, "0 but true" for zero, or the actual return
-value otherwise.
+Calls the System V IPC function C<semctl()>. You'll probably have to say
+
+ use IPC::SysV;
+
+first to get the correct constant definitions. If CMD is IPC_STAT or
+GETALL, then ARG must be a variable which will hold the returned
+semid_ds structure or semaphore value array. Returns like C<ioctl()>: the
+undefined value for error, "C<0> but true" for zero, or the actual return
+value otherwise. See also C<IPC::SysV> and C<IPC::Semaphore> documentation.
=item semget KEY,NSEMS,FLAGS
Calls the System V IPC function semget. Returns the semaphore id, or
-the undefined value if there is an error.
+the undefined value if there is an error. See also C<IPC::SysV> and
+C<IPC::SysV::Semaphore> documentation.
=item semop KEY,OPSTRING
@@ -2811,12 +3431,13 @@ semop structures. Each semop structure can be generated with
C<pack("sss", $semnum, $semop, $semflag)>. The number of semaphore
operations is implied by the length of OPSTRING. Returns TRUE if
successful, or FALSE if there is an error. As an example, the
-following code waits on semaphore $semnum of semaphore id $semid:
+following code waits on semaphore C<$semnum> of semaphore id C<$semid>:
$semop = pack("sss", $semnum, -1, 0);
die "Semaphore trouble: $!\n" unless semop($semid, $semop);
-To signal the semaphore, replace "-1" with "1".
+To signal the semaphore, replace C<-1> with C<1>. See also C<IPC::SysV>
+and C<IPC::SysV::Semaphore> documentation.
=item send SOCKET,MSG,FLAGS,TO
@@ -2824,18 +3445,18 @@ To signal the semaphore, replace "-1" with "1".
Sends a message on a socket. Takes the same flags as the system call
of the same name. On unconnected sockets you must specify a
-destination to send TO, in which case it does a C sendto(). Returns
+destination to send TO, in which case it does a C C<sendto()>. Returns
the number of characters sent, or the undefined value if there is an
-error.
+error. The C system call sendmsg(2) is currently unimplemented.
See L<perlipc/"UDP: Message Passing"> for examples.
=item setpgrp PID,PGRP
-Sets the current process group for the specified PID, 0 for the current
+Sets the current process group for the specified PID, C<0> for the current
process. Will produce a fatal error if used on a machine that doesn't
implement setpgrp(2). If the arguments are omitted, it defaults to
-0,0. Note that the POSIX version of setpgrp() does not accept any
-arguments, so only setpgrp 0,0 is portable.
+C<0,0>. Note that the POSIX version of C<setpgrp()> does not accept any
+arguments, so only C<setpgrp(0,0)> is portable. See also C<POSIX::setsid()>.
=item setpriority WHICH,WHO,PRIORITY
@@ -2846,7 +3467,7 @@ that doesn't implement setpriority(2).
=item setsockopt SOCKET,LEVEL,OPTNAME,OPTVAL
Sets the socket option requested. Returns undefined if there is an
-error. OPTVAL may be specified as undef if you don't want to pass an
+error. OPTVAL may be specified as C<undef> if you don't want to pass an
argument.
=item shift ARRAY
@@ -2856,22 +3477,30 @@ argument.
Shifts the first value of the array off and returns it, shortening the
array by 1 and moving everything down. If there are no elements in the
array, returns the undefined value. If ARRAY is omitted, shifts the
-@ARGV array in the main program, and the @_ array in subroutines.
-(This is determined lexically.) See also unshift(), push(), and pop().
-Shift() and unshift() do the same thing to the left end of an array
-that pop() and push() do to the right end.
+C<@_> array within the lexical scope of subroutines and formats, and the
+C<@ARGV> array at file scopes or within the lexical scopes established by
+the C<eval ''>, C<BEGIN {}>, C<END {}>, and C<INIT {}> constructs.
+See also C<unshift()>, C<push()>, and C<pop()>. C<Shift()> and C<unshift()> do the
+same thing to the left end of an array that C<pop()> and C<push()> do to the
+right end.
=item shmctl ID,CMD,ARG
-Calls the System V IPC function shmctl. If CMD is &IPC_STAT, then ARG
-must be a variable which will hold the returned shmid_ds structure.
-Returns like ioctl: the undefined value for error, "0 but true" for
-zero, or the actual return value otherwise.
+Calls the System V IPC function shmctl. You'll probably have to say
+
+ use IPC::SysV;
+
+first to get the correct constant definitions. If CMD is C<IPC_STAT>,
+then ARG must be a variable which will hold the returned C<shmid_ds>
+structure. Returns like ioctl: the undefined value for error, "C<0> but
+true" for zero, or the actual return value otherwise.
+See also C<IPC::SysV> documentation.
=item shmget KEY,SIZE,FLAGS
Calls the System V IPC function shmget. Returns the shared memory
segment id, or the undefined value if there is an error.
+See also C<IPC::SysV> documentation.
=item shmread ID,VAR,POS,SIZE
@@ -2879,24 +3508,36 @@ segment id, or the undefined value if there is an error.
Reads or writes the System V shared memory segment ID starting at
position POS for size SIZE by attaching to it, copying in/out, and
-detaching from it. When reading, VAR must be a variable which will
+detaching from it. When reading, VAR must be a variable that will
hold the data read. When writing, if STRING is too long, only SIZE
bytes are used; if STRING is too short, nulls are written to fill out
SIZE bytes. Return TRUE if successful, or FALSE if there is an error.
+See also C<IPC::SysV> documentation and the C<IPC::Shareable> module
+from CPAN.
=item shutdown SOCKET,HOW
Shuts down a socket connection in the manner indicated by HOW, which
has the same interpretation as in the system call of the same name.
+ shutdown(SOCKET, 0); # I/we have stopped reading data
+ shutdown(SOCKET, 1); # I/we have stopped writing data
+ shutdown(SOCKET, 2); # I/we have stopped using this socket
+
+This is useful with sockets when you want to tell the other
+side you're done writing but not done reading, or vice versa.
+It's also a more insistent form of close because it also
+disables the filedescriptor in any forked copies in other
+processes.
+
=item sin EXPR
=item sin
Returns the sine of EXPR (expressed in radians). If EXPR is omitted,
-returns sine of $_.
+returns sine of C<$_>.
-For the inverse sine operation, you may use the POSIX::asin()
+For the inverse sine operation, you may use the C<POSIX::asin()>
function, or use this relation:
sub asin { atan2($_[0], sqrt(1 - $_[0] * $_[0])) }
@@ -2906,26 +3547,29 @@ function, or use this relation:
=item sleep
Causes the script to sleep for EXPR seconds, or forever if no EXPR.
-May be interrupted by sending the process a SIGALRM. Returns the
-number of seconds actually slept. You probably cannot mix alarm() and
-sleep() calls, because sleep() is often implemented using alarm().
+May be interrupted if the process receives a signal such as C<SIGALRM>.
+Returns the number of seconds actually slept. You probably cannot
+mix C<alarm()> and C<sleep()> calls, because C<sleep()> is often implemented
+using C<alarm()>.
On some older systems, it may sleep up to a full second less than what
you requested, depending on how it counts seconds. Most modern systems
-always sleep the full amount.
+always sleep the full amount. They may appear to sleep longer than that,
+however, because your process might not be scheduled right away in a
+busy multitasking system.
For delays of finer granularity than one second, you may use Perl's
-syscall() interface to access setitimer(2) if your system supports it,
-or else see L</select()> below.
+C<syscall()> interface to access setitimer(2) if your system supports it,
+or else see L</select> above.
-See also the POSIX module's sigpause() function.
+See also the POSIX module's C<sigpause()> function.
=item socket SOCKET,DOMAIN,TYPE,PROTOCOL
Opens a socket of the specified kind and attaches it to filehandle
SOCKET. DOMAIN, TYPE, and PROTOCOL are specified the same as for the
-system call of the same name. You should "use Socket;" first to get
-the proper definitions imported. See the example in L<perlipc/"Sockets: Client/Server Communication">.
+system call of the same name. You should "C<use Socket;>" first to get
+the proper definitions imported. See the examples in L<perlipc/"Sockets: Client/Server Communication">.
=item socketpair SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL
@@ -2934,6 +3578,16 @@ specified type. DOMAIN, TYPE, and PROTOCOL are specified the same as
for the system call of the same name. If unimplemented, yields a fatal
error. Returns TRUE if successful.
+Some systems defined C<pipe()> in terms of C<socketpair()>, in which a call
+to C<pipe(Rdr, Wtr)> is essentially:
+
+ use Socket;
+ socketpair(Rdr, Wtr, AF_UNIX, SOCK_STREAM, PF_UNSPEC);
+ shutdown(Rdr, 1); # no more writing for reader
+ shutdown(Wtr, 0); # no more reading for writer
+
+See L<perlipc> for an example of socketpair use.
+
=item sort SUBNAME LIST
=item sort BLOCK LIST
@@ -2941,24 +3595,25 @@ error. Returns TRUE if successful.
=item sort LIST
Sorts the LIST and returns the sorted list value. If SUBNAME or BLOCK
-is omitted, sorts in standard string comparison order. If SUBNAME is
+is omitted, C<sort()>s in standard string comparison order. If SUBNAME is
specified, it gives the name of a subroutine that returns an integer
-less than, equal to, or greater than 0, depending on how the elements
+less than, equal to, or greater than C<0>, depending on how the elements
of the array are to be ordered. (The C<E<lt>=E<gt>> and C<cmp>
operators are extremely useful in such routines.) SUBNAME may be a
-scalar variable name, in which case the value provides the name of the
-subroutine to use. In place of a SUBNAME, you can provide a BLOCK as
-an anonymous, in-line sort subroutine.
+scalar variable name (unsubscripted), in which case the value provides
+the name of (or a reference to) the actual subroutine to use. In place
+of a SUBNAME, you can provide a BLOCK as an anonymous, in-line sort
+subroutine.
In the interests of efficiency the normal calling code for subroutines is
bypassed, with the following effects: the subroutine may not be a
recursive subroutine, and the two elements to be compared are passed into
-the subroutine not via @_ but as the package global variables $a and
-$b (see example below). They are passed by reference, so don't
-modify $a and $b. And don't try to declare them as lexicals either.
+the subroutine not via C<@_> but as the package global variables C<$a> and
+C<$b> (see example below). They are passed by reference, so don't
+modify C<$a> and C<$b>. And don't try to declare them as lexicals either.
You also cannot exit out of the sort block or subroutine using any of the
-loop control operators described in L<perlsyn> or with goto().
+loop control operators described in L<perlsyn> or with C<goto()>.
When C<use locale> is in effect, C<sort LIST> sorts LIST according to the
current collation locale. See L<perllocale>.
@@ -3036,8 +3691,8 @@ Examples:
$a->[2] cmp $b->[2]
} map { [$_, /=(\d+)/, uc($_)] } @old;
-If you're using strict, you I<MUST NOT> declare $a
-and $b as lexicals. They are package globals. That means
+If you're using strict, you I<MUST NOT> declare C<$a>
+and C<$b> as lexicals. They are package globals. That means
if you're in the C<main> package, it's
@articles = sort {$main::b <=> $main::a} @files;
@@ -3051,11 +3706,9 @@ but if you're in the C<FooPack> package, it's
@articles = sort {$FooPack::b <=> $FooPack::a} @files;
The comparison function is required to behave. If it returns
-inconsistent results (sometimes saying $x[1] is less than $x[2] and
-sometimes saying the opposite, for example) the Perl interpreter will
-probably crash and dump core. This is entirely due to and dependent
-upon your system's qsort(3) library routine; this routine often avoids
-sanity checks in the interest of speed.
+inconsistent results (sometimes saying C<$x[1]> is less than C<$x[2]> and
+sometimes saying the opposite, for example) the results are not
+well-defined.
=item splice ARRAY,OFFSET,LENGTH,LIST
@@ -3064,22 +3717,26 @@ sanity checks in the interest of speed.
=item splice ARRAY,OFFSET
Removes the elements designated by OFFSET and LENGTH from an array, and
-replaces them with the elements of LIST, if any. Returns the elements
-removed from the array. The array grows or shrinks as necessary. If
-LENGTH is omitted, removes everything from OFFSET onward. The
-following equivalences hold (assuming C<$[ == 0>):
-
- push(@a,$x,$y) splice(@a,$#a+1,0,$x,$y)
+replaces them with the elements of LIST, if any. In list context,
+returns the elements removed from the array. In scalar context,
+returns the last element removed, or C<undef> if no elements are
+removed. The array grows or shrinks as necessary.
+If OFFSET is negative then it start that far from the end of the array.
+If LENGTH is omitted, removes everything from OFFSET onward.
+If LENGTH is negative, leave that many elements off the end of the array.
+The following equivalences hold (assuming C<$[ == 0>):
+
+ push(@a,$x,$y) splice(@a,@a,0,$x,$y)
pop(@a) splice(@a,-1)
shift(@a) splice(@a,0,1)
unshift(@a,$x,$y) splice(@a,0,0,$x,$y)
- $a[$x] = $y splice(@a,$x,1,$y);
+ $a[$x] = $y splice(@a,$x,1,$y)
Example, assuming array lengths are passed before arrays:
sub aeq { # compare two list values
- local(@a) = splice(@_,0,shift);
- local(@b) = splice(@_,0,shift);
+ my(@a) = splice(@_,0,shift);
+ my(@b) = splice(@_,0,shift);
return 0 unless @a == @b; # same len?
while (@a) {
return 0 if pop(@a) ne pop(@b);
@@ -3096,22 +3753,24 @@ Example, assuming array lengths are passed before arrays:
=item split
-Splits a string into an array of strings, and returns it.
+Splits a string into an array of strings, and returns it. By default,
+empty leading fields are preserved, and empty trailing ones are deleted.
-If not in a list context, returns the number of fields found and splits into
-the @_ array. (In a list context, you can force the split into @_ by
-using C<??> as the pattern delimiters, but it still returns the array
-value.) The use of implicit split to @_ is deprecated, however.
+If not in list context, returns the number of fields found and splits into
+the C<@_> array. (In list context, you can force the split into C<@_> by
+using C<??> as the pattern delimiters, but it still returns the list
+value.) The use of implicit split to C<@_> is deprecated, however, because
+it clobbers your subroutine arguments.
-If EXPR is omitted, splits the $_ string. If PATTERN is also omitted,
+If EXPR is omitted, splits the C<$_> string. If PATTERN is also omitted,
splits on whitespace (after skipping any leading whitespace). Anything
matching PATTERN is taken to be a delimiter separating the fields. (Note
that the delimiter may be longer than one character.)
-If LIMIT is specified and is not negative, splits into no more than
-that many fields (though it may split into fewer). If LIMIT is
-unspecified, trailing null fields are stripped (which potential users
-of pop() would do well to remember). If LIMIT is negative, it is
+If LIMIT is specified and positive, splits into no more than that
+many fields (though it may split into fewer). If LIMIT is unspecified
+or zero, trailing null fields are stripped (which potential users
+of C<pop()> would do well to remember). If LIMIT is negative, it is
treated as if an arbitrarily large LIMIT had been specified.
A pattern matching the null string (not to be confused with
@@ -3142,7 +3801,7 @@ produces the list value
(1, '-', 10, ',', 20)
-If you had the entire header of a normal Unix email message in $header,
+If you had the entire header of a normal Unix email message in C<$header>,
you could split it up into fields and their values this way:
$header =~ s/\n\s+/ /g; # fix continuation lines
@@ -3153,38 +3812,38 @@ patterns that vary at runtime. (To do runtime compilation only once,
use C</$variable/o>.)
As a special case, specifying a PATTERN of space (C<' '>) will split on
-white space just as split with no arguments does. Thus, split(' ') can
+white space just as C<split()> with no arguments does. Thus, C<split(' ')> can
be used to emulate B<awk>'s default behavior, whereas C<split(/ /)>
will give you as many null initial fields as there are leading spaces.
-A split on /\s+/ is like a split(' ') except that any leading
-whitespace produces a null first field. A split with no arguments
+A C<split()> on C</\s+/> is like a C<split(' ')> except that any leading
+whitespace produces a null first field. A C<split()> with no arguments
really does a C<split(' ', $_)> internally.
Example:
- open(passwd, '/etc/passwd');
- while (<passwd>) {
- ($login, $passwd, $uid, $gid, $gcos,
- $home, $shell) = split(/:/);
- ...
+ open(PASSWD, '/etc/passwd');
+ while (<PASSWD>) {
+ ($login, $passwd, $uid, $gid,
+ $gcos, $home, $shell) = split(/:/);
+ #...
}
-(Note that $shell above will still have a newline on it. See L</chop>,
+(Note that C<$shell> above will still have a newline on it. See L</chop>,
L</chomp>, and L</join>.)
=item sprintf FORMAT, LIST
-Returns a string formatted by the usual printf conventions of the
-C library function sprintf(). See L<sprintf(3)> or L<printf(3)>
+Returns a string formatted by the usual C<printf()> conventions of the
+C library function C<sprintf()>. See L<sprintf(3)> or L<printf(3)>
on your system for an explanation of the general principles.
-Perl does all of its own sprintf() formatting -- it emulates the C
-function sprintf(), but it doesn't use it (except for floating-point
+Perl does its own C<sprintf()> formatting -- it emulates the C
+function C<sprintf()>, but it doesn't use it (except for floating-point
numbers, and even then only the standard modifiers are allowed). As a
-result, any non-standard extensions in your local sprintf() are not
+result, any non-standard extensions in your local C<sprintf()> are not
available from Perl.
-Perl's sprintf() permits the following universally-known conversions:
+Perl's C<sprintf()> permits the following universally-known conversions:
%% a percent sign
%c a character with the given number
@@ -3222,10 +3881,11 @@ and the conversion letter:
+ prefix positive number with a plus sign
- left-justify within the field
0 use zeros, not spaces, to right-justify
- # prefix octal with "0", hex with "0x"
+ # prefix non-zero octal with "0", non-zero hex with "0x"
number minimum field width
- .number "precision": digits after decimal point for floating-point,
- max length for string, minimum length for integer
+ .number "precision": digits after decimal point for
+ floating-point, max length for string, minimum length
+ for integer
l interpret integer as C type "long" or "unsigned long"
h interpret integer as C type "short" or "unsigned short"
@@ -3233,11 +3893,11 @@ There is also one Perl-specific flag:
V interpret integer as Perl's standard integer type
-Where a number would appear in the flags, an asterisk ("*") may be
+Where a number would appear in the flags, an asterisk ("C<*>") may be
used instead, in which case Perl uses the next item in the parameter
list as the given number (that is, as the field width or precision).
-If a field width obtained through "*" is negative, it has the same
-effect as the '-' flag: left-justification.
+If a field width obtained through "C<*>" is negative, it has the same
+effect as the "C<->" flag: left-justification.
If C<use locale> is in effect, the character used for the decimal
point in formatted real numbers is affected by the LC_NUMERIC locale.
@@ -3248,24 +3908,29 @@ See L<perllocale>.
=item sqrt
Return the square root of EXPR. If EXPR is omitted, returns square
-root of $_.
+root of C<$_>. Only works on non-negative operands, unless you've
+loaded the standard Math::Complex module.
+
+ use Math::Complex;
+ print sqrt(-2); # prints 1.4142135623731i
=item srand EXPR
=item srand
-Sets the random number seed for the C<rand> operator. If EXPR is
-omitted, uses a semi-random value based on the current time and process
+Sets the random number seed for the C<rand()> operator. If EXPR is
+omitted, uses a semi-random value supplied by the kernel (if it supports
+the F</dev/urandom> device) or based on the current time and process
ID, among other things. In versions of Perl prior to 5.004 the default
-seed was just the current time(). This isn't a particularly good seed,
+seed was just the current C<time()>. This isn't a particularly good seed,
so many old programs supply their own seed value (often C<time ^ $$> or
-C<time ^ ($$ + ($$ << 15))>), but that isn't necessary any more.
+C<time ^ ($$ + ($$ E<lt>E<lt> 15))>), but that isn't necessary any more.
-In fact, it's usually not necessary to call srand() at all, because if
+In fact, it's usually not necessary to call C<srand()> at all, because if
it is not called explicitly, it is called implicitly at the first use of
-the C<rand> operator. However, this was not the case in version of Perl
+the C<rand()> operator. However, this was not the case in version of Perl
before 5.004, so if your script will run under older Perl versions, it
-should call srand().
+should call C<srand()>.
Note that you need something much more random than the default seed for
cryptographic purposes. Checksumming the compressed output of one or more
@@ -3274,14 +3939,14 @@ example:
srand (time ^ $$ ^ unpack "%L*", `ps axww | gzip`);
-If you're particularly concerned with this, see the Math::TrulyRandom
+If you're particularly concerned with this, see the C<Math::TrulyRandom>
module in CPAN.
-Do I<not> call srand() multiple times in your program unless you know
+Do I<not> call C<srand()> multiple times in your program unless you know
exactly what you're doing and why you're doing it. The point of the
-function is to "seed" the rand() function so that rand() can produce
+function is to "seed" the C<rand()> function so that C<rand()> can produce
a different sequence each time you run your program. Just do it once at the
-top of your program, or you I<won't> get random numbers out of rand()!
+top of your program, or you I<won't> get random numbers out of C<rand()>!
Frequently called programs (like CGI scripts) that simply use
@@ -3299,11 +3964,10 @@ one-third of the time. So don't do that.
=item stat
-Returns a 13-element array giving the status info for a file, either the
-file opened via FILEHANDLE, or named by EXPR. If EXPR is omitted, it
-stats $_. Returns a null list if the stat fails. Typically used as
-follows:
-
+Returns a 13-element list giving the status info for a file, either
+the file opened via FILEHANDLE, or named by EXPR. If EXPR is omitted,
+it stats C<$_>. Returns a null list if the stat fails. Typically used
+as follows:
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks)
@@ -3338,6 +4002,26 @@ last stat or filetest are returned. Example:
(This works on machines only for which the device number is negative under NFS.)
+Because the mode contains both the file type and its permissions, you
+should mask off the file type portion and (s)printf using a C<"%o">
+if you want to see the real permissions.
+
+ $mode = (stat($filename))[2];
+ printf "Permissions are %04o\n", $mode & 07777;
+
+
+In scalar context, C<stat()> returns a boolean value indicating success
+or failure, and, if successful, sets the information associated with
+the special filehandle C<_>.
+
+The File::stat module provides a convenient, by-name access mechanism:
+
+ use File::stat;
+ $sb = stat($filename);
+ printf "File is %s, size is %s, perm %04o, mtime %s\n",
+ $filename, $sb->size, $sb->mode & 07777,
+ scalar localtime $sb->mtime;
+
=item study SCALAR
=item study
@@ -3350,36 +4034,36 @@ frequencies in the string to be searched -- you probably want to compare
run times with and without it to see which runs faster. Those loops
which scan for many short constant strings (including the constant
parts of more complex patterns) will benefit most. You may have only
-one study active at a time -- if you study a different scalar the first
-is "unstudied". (The way study works is this: a linked list of every
+one C<study()> active at a time -- if you study a different scalar the first
+is "unstudied". (The way C<study()> works is this: a linked list of every
character in the string to be searched is made, so we know, for
-example, where all the 'k' characters are. From each search string,
+example, where all the C<'k'> characters are. From each search string,
the rarest character is selected, based on some static frequency tables
constructed from some C programs and English text. Only those places
that contain this "rarest" character are examined.)
-For example, here is a loop which inserts index producing entries
+For example, here is a loop that inserts index producing entries
before any line containing a certain pattern:
while (<>) {
study;
- print ".IX foo\n" if /\bfoo\b/;
- print ".IX bar\n" if /\bbar\b/;
- print ".IX blurfl\n" if /\bblurfl\b/;
- ...
+ print ".IX foo\n" if /\bfoo\b/;
+ print ".IX bar\n" if /\bbar\b/;
+ print ".IX blurfl\n" if /\bblurfl\b/;
+ # ...
print;
}
-In searching for /\bfoo\b/, only those locations in $_ that contain "f"
-will be looked at, because "f" is rarer than "o". In general, this is
+In searching for C</\bfoo\b/>, only those locations in C<$_> that contain C<"f">
+will be looked at, because C<"f"> is rarer than C<"o">. In general, this is
a big win except in pathological cases. The only question is whether
it saves you more time than it took to build the linked list in the
first place.
Note that if you have to look for strings that you don't know till
-runtime, you can build an entire loop as a string and eval that to
+runtime, you can build an entire loop as a string and C<eval()> that to
avoid recompiling all your patterns all the time. Together with
-undefining $/ to input entire files as one record, this can be very
+undefining C<$/> to input entire files as one record, this can be very
fast, often faster than specialized programs like fgrep(1). The following
scans a list of files (C<@files>) for a list of words (C<@words>), and prints
out the names of those files that contain a match:
@@ -3409,36 +4093,42 @@ a NAME, it's an anonymous function declaration, and does actually return a
value: the CODE ref of the closure you just created. See L<perlsub> and
L<perlref> for details.
+=item substr EXPR,OFFSET,LEN,REPLACEMENT
+
=item substr EXPR,OFFSET,LEN
=item substr EXPR,OFFSET
Extracts a substring out of EXPR and returns it. First character is at
-offset 0, or whatever you've set C<$[> to (but don't do that).
+offset C<0>, or whatever you've set C<$[> to (but don't do that).
If OFFSET is negative (or more precisely, less than C<$[>), starts
that far from the end of the string. If LEN is omitted, returns
everything to the end of the string. If LEN is negative, leaves that
many characters off the end of the string.
-If you specify a substring which is partly outside the string, the part
+If you specify a substring that is partly outside the string, the part
within the string is returned. If the substring is totally outside
the string a warning is produced.
-You can use the substr() function
-as an lvalue, in which case EXPR must be an lvalue. If you assign
-something shorter than LEN, the string will shrink, and if you assign
-something longer than LEN, the string will grow to accommodate it. To
-keep the string the same length you may need to pad or chop your value
-using sprintf().
+You can use the substr() function as an lvalue, in which case EXPR
+must itself be an lvalue. If you assign something shorter than LEN,
+the string will shrink, and if you assign something longer than LEN,
+the string will grow to accommodate it. To keep the string the same
+length you may need to pad or chop your value using C<sprintf()>.
+
+An alternative to using substr() as an lvalue is to specify the
+replacement string as the 4th argument. This allows you to replace
+parts of the EXPR and return what was there before in one operation,
+just as you can with splice().
=item symlink OLDFILE,NEWFILE
Creates a new filename symbolically linked to the old filename.
-Returns 1 for success, 0 otherwise. On systems that don't support
+Returns C<1> for success, C<0> otherwise. On systems that don't support
symbolic links, produces a fatal error at run time. To check for that,
use eval:
- $symlink_exists = (eval {symlink("","")};, $@ eq '');
+ $symlink_exists = eval { symlink("",""); 1 };
=item syscall LIST
@@ -3448,27 +4138,31 @@ unimplemented, produces a fatal error. The arguments are interpreted
as follows: if a given argument is numeric, the argument is passed as
an int. If not, the pointer to the string value is passed. You are
responsible to make sure a string is pre-extended long enough to
-receive any result that might be written into a string. If your
+receive any result that might be written into a string. You can't use a
+string literal (or other read-only string) as an argument to C<syscall()>
+because Perl has to assume that any string pointer might be written
+through. If your
integer arguments are not literals and have never been interpreted in a
-numeric context, you may need to add 0 to them to force them to look
-like numbers.
+numeric context, you may need to add C<0> to them to force them to look
+like numbers. This emulates the C<syswrite()> function (or vice versa):
require 'syscall.ph'; # may need to run h2ph
- syscall(&SYS_write, fileno(STDOUT), "hi there\n", 9);
+ $s = "hi there\n";
+ syscall(&SYS_write, fileno(STDOUT), $s, length $s);
Note that Perl supports passing of up to only 14 arguments to your system call,
which in practice should usually suffice.
Syscall returns whatever value returned by the system call it calls.
-If the system call fails, syscall returns -1 and sets C<$!> (errno).
-Note that some system calls can legitimately return -1. The proper
+If the system call fails, C<syscall()> returns C<-1> and sets C<$!> (errno).
+Note that some system calls can legitimately return C<-1>. The proper
way to handle such calls is to assign C<$!=0;> before the call and
-check the value of <$!> if syscall returns -1.
+check the value of C<$!> if syscall returns C<-1>.
There's a problem with C<syscall(&SYS_pipe)>: it returns the file
number of the read end of the pipe it creates. There is no way
to retrieve the file number of the other end. You can avoid this
-problem by using C<pipe> instead.
+problem by using C<pipe()> instead.
=item sysopen FILEHANDLE,FILENAME,MODE
@@ -3477,119 +4171,131 @@ problem by using C<pipe> instead.
Opens the file whose filename is given by FILENAME, and associates it
with FILEHANDLE. If FILEHANDLE is an expression, its value is used as
the name of the real filehandle wanted. This function calls the
-underlying operating system's C<open> function with the parameters
+underlying operating system's C<open()> function with the parameters
FILENAME, MODE, PERMS.
The possible values and flag bits of the MODE parameter are
system-dependent; they are available via the standard module C<Fcntl>.
-However, for historical reasons, some values are universal: zero means
-read-only, one means write-only, and two means read/write.
-
-If the file named by FILENAME does not exist and the C<open> call
-creates it (typically because MODE includes the O_CREAT flag), then
-the value of PERMS specifies the permissions of the newly created
-file. If PERMS is omitted, the default value is 0666, which allows
-read and write for all. This default is reasonable: see C<umask>.
-
-The IO::File module provides a more object-oriented approach, if you're
-into that kind of thing.
+For historical reasons, some values work on almost every system
+supported by perl: zero means read-only, one means write-only, and two
+means read/write. We know that these values do I<not> work under
+OS/390 & VM/ESA Unix and on the Macintosh; you probably don't want to
+use them in new code.
+
+If the file named by FILENAME does not exist and the C<open()> call creates
+it (typically because MODE includes the C<O_CREAT> flag), then the value of
+PERMS specifies the permissions of the newly created file. If you omit
+the PERMS argument to C<sysopen()>, Perl uses the octal value C<0666>.
+These permission values need to be in octal, and are modified by your
+process's current C<umask>.
+
+You should seldom if ever use C<0644> as argument to C<sysopen()>, because
+that takes away the user's option to have a more permissive umask.
+Better to omit it. See the perlfunc(1) entry on C<umask> for more
+on this.
+
+See L<perlopentut> for a kinder, gentler explanation of opening files.
=item sysread FILEHANDLE,SCALAR,LENGTH,OFFSET
=item sysread FILEHANDLE,SCALAR,LENGTH
Attempts to read LENGTH bytes of data into variable SCALAR from the
-specified FILEHANDLE, using the system call read(2). It bypasses
-stdio, so mixing this with other kinds of reads, print(), write(),
-seek(), or tell() can cause confusion because stdio usually buffers
-data. Returns the number of bytes actually read, or undef if there
-was an error. SCALAR will be grown or shrunk so that the last byte
-actually read is the last byte of the scalar after the read.
+specified FILEHANDLE, using the system call read(2). It bypasses stdio,
+so mixing this with other kinds of reads, C<print()>, C<write()>,
+C<seek()>, C<tell()>, or C<eof()> can cause confusion because stdio
+usually buffers data. Returns the number of bytes actually read, C<0>
+at end of file, or undef if there was an error. SCALAR will be grown or
+shrunk so that the last byte actually read is the last byte of the
+scalar after the read.
An OFFSET may be specified to place the read data at some place in the
string other than the beginning. A negative OFFSET specifies
placement at that many bytes counting backwards from the end of the
string. A positive OFFSET greater than the length of SCALAR results
-in the string being padded to the required size with "\0" bytes before
+in the string being padded to the required size with C<"\0"> bytes before
the result of the read is appended.
+There is no syseof() function, which is ok, since eof() doesn't work
+very well on device files (like ttys) anyway. Use sysread() and check
+for a return value for 0 to decide whether you're done.
+
=item sysseek FILEHANDLE,POSITION,WHENCE
Sets FILEHANDLE's system position using the system call lseek(2). It
-bypasses stdio, so mixing this with reads (other than sysread()),
-print(), write(), seek(), or tell() may cause confusion. FILEHANDLE may
-be an expression whose value gives the name of the filehandle. The
-values for WHENCE are 0 to set the new position to POSITION, 1 to set
-the it to the current position plus POSITION, and 2 to set it to EOF
-plus POSITION (typically negative). For WHENCE, you may use the
-constants SEEK_SET, SEEK_CUR, and SEEK_END from either the IO::Seekable
-or the POSIX module.
+bypasses stdio, so mixing this with reads (other than C<sysread()>),
+C<print()>, C<write()>, C<seek()>, C<tell()>, or C<eof()> may cause
+confusion. FILEHANDLE may be an expression whose value gives the name
+of the filehandle. The values for WHENCE are C<0> to set the new
+position to POSITION, C<1> to set the it to the current position plus
+POSITION, and C<2> to set it to EOF plus POSITION (typically negative).
+For WHENCE, you may use the constants C<SEEK_SET>, C<SEEK_CUR>, and
+C<SEEK_END> from either the C<IO::Seekable> or the POSIX module.
Returns the new position, or the undefined value on failure. A position
-of zero is returned as the string "0 but true"; thus sysseek() returns
+of zero is returned as the string "C<0> but true"; thus C<sysseek()> returns
TRUE on success and FALSE on failure, yet you can still easily determine
the new position.
=item system LIST
-Does exactly the same thing as "exec LIST" except that a fork is done
+=item system PROGRAM LIST
+
+Does exactly the same thing as "C<exec LIST>", except that a fork is done
first, and the parent process waits for the child process to complete.
Note that argument processing varies depending on the number of
-arguments. The return value is the exit status of the program as
-returned by the wait() call. To get the actual exit value divide by
+arguments. If there is more than one argument in LIST, or if LIST is
+an array with more than one value, starts the program given by the
+first element of the list with arguments given by the rest of the list.
+If there is only one scalar argument, the argument is
+checked for shell metacharacters, and if there are any, the entire
+argument is passed to the system's command shell for parsing (this is
+C</bin/sh -c> on Unix platforms, but varies on other platforms). If
+there are no shell metacharacters in the argument, it is split into
+words and passed directly to C<execvp()>, which is more efficient.
+
+The return value is the exit status of the program as
+returned by the C<wait()> call. To get the actual exit value divide by
256. See also L</exec>. This is I<NOT> what you want to use to capture
the output from a command, for that you should use merely backticks or
-qx//, as described in L<perlop/"`STRING`">.
+C<qx//>, as described in L<perlop/"`STRING`">.
+
+Like C<exec()>, C<system()> allows you to lie to a program about its name if
+you use the "C<system PROGRAM LIST>" syntax. Again, see L</exec>.
-Because system() and backticks block SIGINT and SIGQUIT, killing the
+Because C<system()> and backticks block C<SIGINT> and C<SIGQUIT>, killing the
program they're running doesn't actually interrupt your program.
@args = ("command", "arg1", "arg2");
system(@args) == 0
or die "system @args failed: $?"
-Here's a more elaborate example of analysing the return value from
-system() on a Unix system to check for all possibilities, including for
-signals and core dumps.
+You can check all the failure possibilities by inspecting
+C<$?> like this:
- $rc = 0xffff & system @args;
- printf "system(%s) returned %#04x: ", "@args", $rc;
- if ($rc == 0) {
- print "ran with normal exit\n";
- }
- elsif ($rc == 0xff00) {
- print "command failed: $!\n";
- }
- elsif ($rc > 0x80) {
- $rc >>= 8;
- print "ran with non-zero exit status $rc\n";
- }
- else {
- print "ran with ";
- if ($rc & 0x80) {
- $rc &= ~0x80;
- print "core dump from ";
- }
- print "signal $rc\n"
- }
- $ok = ($rc != 0);
+ $exit_value = $? >> 8;
+ $signal_num = $? & 127;
+ $dumped_core = $? & 128;
-When the arguments get executed via the system shell, results will
-be subject to its quirks and capabilities. See L<perlop/"`STRING`">
-for details.
+When the arguments get executed via the system shell, results
+and return codes will be subject to its quirks and capabilities.
+See L<perlop/"`STRING`"> and L</exec> for details.
=item syswrite FILEHANDLE,SCALAR,LENGTH,OFFSET
=item syswrite FILEHANDLE,SCALAR,LENGTH
+=item syswrite FILEHANDLE,SCALAR
+
Attempts to write LENGTH bytes of data from variable SCALAR to the
-specified FILEHANDLE, using the system call write(2). It bypasses
-stdio, so mixing this with reads (other than sysread()), print(),
-write(), seek(), or tell() may cause confusion because stdio usually
-buffers data. Returns the number of bytes actually written, or undef
-if there was an error. If the LENGTH is greater than the available
-data in the SCALAR after the OFFSET, only as much data as is available
-will be written.
+specified FILEHANDLE, using the system call write(2). If LENGTH is
+not specified, writes whole SCALAR. It bypasses
+stdio, so mixing this with reads (other than C<sysread())>, C<print()>,
+C<write()>, C<seek()>, C<tell()>, or C<eof()> may cause confusion
+because stdio usually buffers data. Returns the number of bytes
+actually written, or C<undef> if there was an error. If the LENGTH is
+greater than the available data in the SCALAR after the OFFSET, only as
+much data as is available will be written.
An OFFSET may be specified to write the data from some part of the
string other than the beginning. A negative OFFSET specifies writing
@@ -3602,12 +4308,14 @@ case the SCALAR is empty you can use OFFSET but only zero offset.
Returns the current position for FILEHANDLE. FILEHANDLE may be an
expression whose value gives the name of the actual filehandle. If
-FILEHANDLE is omitted, assumes the file last read.
+FILEHANDLE is omitted, assumes the file last read.
+
+There is no C<systell()> function. Use C<sysseek(FH, 0, 1)> for that.
=item telldir DIRHANDLE
-Returns the current position of the readdir() routines on DIRHANDLE.
-Value may be given to seekdir() to access a particular location in a
+Returns the current position of the C<readdir()> routines on DIRHANDLE.
+Value may be given to C<seekdir()> to access a particular location in a
directory. Has the same caveats about possible directory compaction as
the corresponding system library routine.
@@ -3616,16 +4324,16 @@ the corresponding system library routine.
This function binds a variable to a package class that will provide the
implementation for the variable. VARIABLE is the name of the variable
to be enchanted. CLASSNAME is the name of a class implementing objects
-of correct type. Any additional arguments are passed to the "new"
-method of the class (meaning TIESCALAR, TIEARRAY, or TIEHASH).
-Typically these are arguments such as might be passed to the dbm_open()
-function of C. The object returned by the "new" method is also
-returned by the tie() function, which would be useful if you want to
-access other methods in CLASSNAME.
+of correct type. Any additional arguments are passed to the "C<new()>"
+method of the class (meaning C<TIESCALAR>, C<TIEHANDLE>, C<TIEARRAY>,
+or C<TIEHASH>). Typically these are arguments such as might be passed
+to the C<dbm_open()> function of C. The object returned by the "C<new()>"
+method is also returned by the C<tie()> function, which would be useful
+if you want to access other methods in CLASSNAME.
-Note that functions such as keys() and values() may return huge array
-values when used on large objects, like DBM files. You may prefer to
-use the each() function to iterate over such. Example:
+Note that functions such as C<keys()> and C<values()> may return huge lists
+when used on large objects, like DBM files. You may prefer to use the
+C<each()> function to iterate over such. Example:
# print out history file offsets
use NDBM_File;
@@ -3638,37 +4346,63 @@ use the each() function to iterate over such. Example:
A class implementing a hash should have the following methods:
TIEHASH classname, LIST
- DESTROY this
FETCH this, key
STORE this, key, value
DELETE this, key
+ CLEAR this
EXISTS this, key
FIRSTKEY this
NEXTKEY this, lastkey
+ DESTROY this
A class implementing an ordinary array should have the following methods:
TIEARRAY classname, LIST
- DESTROY this
FETCH this, key
STORE this, key, value
- [others TBD]
+ FETCHSIZE this
+ STORESIZE this, count
+ CLEAR this
+ PUSH this, LIST
+ POP this
+ SHIFT this
+ UNSHIFT this, LIST
+ SPLICE this, offset, length, LIST
+ EXTEND this, count
+ DESTROY this
+
+A class implementing a file handle should have the following methods:
+
+ TIEHANDLE classname, LIST
+ READ this, scalar, length, offset
+ READLINE this
+ GETC this
+ WRITE this, scalar, length, offset
+ PRINT this, LIST
+ PRINTF this, format, LIST
+ CLOSE this
+ DESTROY this
A class implementing a scalar should have the following methods:
TIESCALAR classname, LIST
- DESTROY this
FETCH this,
STORE this, value
+ DESTROY this
-Unlike dbmopen(), the tie() function will not use or require a module
+Not all methods indicated above need be implemented. See L<perltie>,
+L<Tie::Hash>, L<Tie::Array>, L<Tie::Scalar>, and L<Tie::Handle>.
+
+Unlike C<dbmopen()>, the C<tie()> function will not use or require a module
for you--you need to do that explicitly yourself. See L<DB_File>
-or the F<Config> module for interesting tie() implementations.
+or the F<Config> module for interesting C<tie()> implementations.
+
+For further details see L<perltie>, L<"tied VARIABLE">.
=item tied VARIABLE
Returns a reference to the object underlying VARIABLE (the same value
-that was originally returned by the tie() call which bound the variable
+that was originally returned by the C<tie()> call that bound the variable
to a package.) Returns the undefined value if VARIABLE isn't tied to a
package.
@@ -3677,18 +4411,18 @@ package.
Returns the number of non-leap seconds since whatever time the system
considers to be the epoch (that's 00:00:00, January 1, 1904 for MacOS,
and 00:00:00 UTC, January 1, 1970 for most other systems).
-Suitable for feeding to gmtime() and localtime().
+Suitable for feeding to C<gmtime()> and C<localtime()>.
=item times
-Returns a four-element array giving the user and system times, in
+Returns a four-element list giving the user and system times, in
seconds, for this process and the children of this process.
($user,$system,$cuser,$csystem) = times;
=item tr///
-The translation operator. Same as y///. See L<perlop>.
+The transliteration operator. Same as C<y///>. See L<perlop>.
=item truncate FILEHANDLE,LENGTH
@@ -3696,59 +4430,93 @@ The translation operator. Same as y///. See L<perlop>.
Truncates the file opened on FILEHANDLE, or named by EXPR, to the
specified length. Produces a fatal error if truncate isn't implemented
-on your system.
+on your system. Returns TRUE if successful, the undefined value
+otherwise.
=item uc EXPR
=item uc
Returns an uppercased version of EXPR. This is the internal function
-implementing the \U escape in double-quoted strings.
+implementing the C<\U> escape in double-quoted strings.
Respects current LC_CTYPE locale if C<use locale> in force. See L<perllocale>.
+(It does not attempt to do titlecase mapping on initial letters. See C<ucfirst()> for that.)
-If EXPR is omitted, uses $_.
+If EXPR is omitted, uses C<$_>.
=item ucfirst EXPR
=item ucfirst
-Returns the value of EXPR with the first character uppercased. This is
-the internal function implementing the \u escape in double-quoted strings.
+Returns the value of EXPR with the first character in uppercase. This is
+the internal function implementing the C<\u> escape in double-quoted strings.
Respects current LC_CTYPE locale if C<use locale> in force. See L<perllocale>.
-If EXPR is omitted, uses $_.
+If EXPR is omitted, uses C<$_>.
=item umask EXPR
=item umask
Sets the umask for the process to EXPR and returns the previous value.
-If EXPR is omitted, merely returns the current umask. Remember that a
-umask is a number, usually given in octal; it is I<not> a string of octal
-digits. See also L</oct>, if all you have is a string.
+If EXPR is omitted, merely returns the current umask.
+
+The Unix permission C<rwxr-x---> is represented as three sets of three
+bits, or three octal digits: C<0750> (the leading 0 indicates octal
+and isn't one of the digits). The C<umask> value is such a number
+representing disabled permissions bits. The permission (or "mode")
+values you pass C<mkdir> or C<sysopen> are modified by your umask, so
+even if you tell C<sysopen> to create a file with permissions C<0777>,
+if your umask is C<0022> then the file will actually be created with
+permissions C<0755>. If your C<umask> were C<0027> (group can't
+write; others can't read, write, or execute), then passing
+C<sysopen()> C<0666> would create a file with mode C<0640> (C<0666 &~
+027> is C<0640>).
+
+Here's some advice: supply a creation mode of C<0666> for regular
+files (in C<sysopen()>) and one of C<0777> for directories (in
+C<mkdir()>) and executable files. This gives users the freedom of
+choice: if they want protected files, they might choose process umasks
+of C<022>, C<027>, or even the particularly antisocial mask of C<077>.
+Programs should rarely if ever make policy decisions better left to
+the user. The exception to this is when writing files that should be
+kept private: mail files, web browser cookies, I<.rhosts> files, and
+so on.
+
+If umask(2) is not implemented on your system and you are trying to
+restrict access for I<yourself> (i.e., (EXPR & 0700) > 0), produces a
+fatal error at run time. If umask(2) is not implemented and you are
+not trying to restrict access for yourself, returns C<undef>.
+
+Remember that a umask is a number, usually given in octal; it is I<not> a
+string of octal digits. See also L</oct>, if all you have is a string.
=item undef EXPR
=item undef
Undefines the value of EXPR, which must be an lvalue. Use only on a
-scalar value, an entire array, an entire hash, or a subroutine name (using
-"&"). (Using undef() will probably not do what you expect on most
-predefined variables or DBM list values, so don't do that.) Always
-returns the undefined value. You can omit the EXPR, in which case
-nothing is undefined, but you still get an undefined value that you
-could, for instance, return from a subroutine, assign to a variable or
-pass as a parameter. Examples:
+scalar value, an array (using "C<@>"), a hash (using "C<%>"), a subroutine
+(using "C<&>"), or a typeglob (using "<*>"). (Saying C<undef $hash{$key}>
+will probably not do what you expect on most predefined variables or
+DBM list values, so don't do that; see L<delete>.) Always returns the
+undefined value. You can omit the EXPR, in which case nothing is
+undefined, but you still get an undefined value that you could, for
+instance, return from a subroutine, assign to a variable or pass as a
+parameter. Examples:
undef $foo;
- undef $bar{'blurfl'}; # Compare to: delete $bar{'blurfl'};
+ undef $bar{'blurfl'}; # Compare to: delete $bar{'blurfl'};
undef @ary;
undef %hash;
undef &mysub;
+ undef *xyz; # destroys $xyz, @xyz, %xyz, &xyz, etc.
return (wantarray ? (undef, $errmsg) : undef) if $they_blew_it;
select undef, undef, undef, 0.25;
($a, $b, undef, $c) = &foo; # Ignore third value returned
+Note that this is a unary operator, not a list operator.
+
=item unlink LIST
=item unlink
@@ -3760,23 +4528,23 @@ deleted.
unlink @goners;
unlink <*.bak>;
-Note: unlink will not delete directories unless you are superuser and
+Note: C<unlink()> will not delete directories unless you are superuser and
the B<-U> flag is supplied to Perl. Even if these conditions are
met, be warned that unlinking a directory can inflict damage on your
-filesystem. Use rmdir instead.
+filesystem. Use C<rmdir()> instead.
-If LIST is omitted, uses $_.
+If LIST is omitted, uses C<$_>.
=item unpack TEMPLATE,EXPR
-Unpack does the reverse of pack: it takes a string representing a
+C<Unpack()> does the reverse of C<pack()>: it takes a string representing a
structure and expands it out into a list value, returning the array
-value. (In a scalar context, it returns merely the first value
-produced.) The TEMPLATE has the same format as in the pack function.
+value. (In scalar context, it returns merely the first value
+produced.) The TEMPLATE has the same format as in the C<pack()> function.
Here's a subroutine that does substring:
sub substr {
- local($what,$where,$howmuch) = @_;
+ my($what,$where,$howmuch) = @_;
unpack("x$where a$howmuch", $what);
}
@@ -3790,28 +4558,30 @@ themselves. Default is a 16-bit checksum. For example, the following
computes the same number as the System V sum program:
while (<>) {
- $checksum += unpack("%16C*", $_);
+ $checksum += unpack("%32C*", $_);
}
- $checksum %= 65536;
+ $checksum %= 65535;
The following efficiently counts the number of set bits in a bit vector:
$setbits = unpack("%32b*", $selectmask);
+See L</pack> for more examples.
+
=item untie VARIABLE
-Breaks the binding between a variable and a package. (See tie().)
+Breaks the binding between a variable and a package. (See C<tie()>.)
=item unshift ARRAY,LIST
-Does the opposite of a C<shift>. Or the opposite of a C<push>,
+Does the opposite of a C<shift()>. Or the opposite of a C<push()>,
depending on how you look at it. Prepends list to the front of the
array, and returns the new number of elements in the array.
unshift(ARGV, '-e') unless $ARGV[0] =~ /^-/;
Note the LIST is prepended whole, not one element at a time, so the
-prepended elements stay in the same order. Use reverse to do the
+prepended elements stay in the same order. Use C<reverse()> to do the
reverse.
=item use Module LIST
@@ -3834,18 +4604,18 @@ If the first argument to C<use> is a number, it is treated as a version
number instead of a module name. If the version of the Perl interpreter
is less than VERSION, then an error message is printed and Perl exits
immediately. This is often useful if you need to check the current
-Perl version before C<use>ing library modules which have changed in
+Perl version before C<use>ing library modules that have changed in
incompatible ways from older versions of Perl. (We try not to do
this more than we have to.)
-The BEGIN forces the require and import to happen at compile time. The
-require makes sure the module is loaded into memory if it hasn't been
-yet. The import is not a builtin--it's just an ordinary static method
-call into the "Module" package to tell the module to import the list of
+The C<BEGIN> forces the C<require> and C<import()> to happen at compile time. The
+C<require> makes sure the module is loaded into memory if it hasn't been
+yet. The C<import()> is not a builtin--it's just an ordinary static method
+call into the "C<Module>" package to tell the module to import the list of
features back into the current package. The module can implement its
-import method any way it likes, though most modules just choose to
-derive their import method via inheritance from the Exporter class that
-is defined in the Exporter module. See L<Exporter>. If no import
+C<import()> method any way it likes, though most modules just choose to
+derive their C<import()> method via inheritance from the C<Exporter> class that
+is defined in the C<Exporter> module. See L<Exporter>. If no C<import()>
method can be found then the error is currently silently ignored. This
may change to a fatal error in a future version.
@@ -3855,13 +4625,13 @@ If you don't want your namespace altered, explicitly supply an empty list:
That is exactly equivalent to
- BEGIN { require Module; }
+ BEGIN { require Module }
If the VERSION argument is present between Module and LIST, then the
C<use> will call the VERSION method in class Module with the given
version as an argument. The default VERSION method, inherited from
the Universal class, croaks if the given version is larger than the
-value of the variable $Module::VERSION. (Note that there is not a
+value of the variable C<$Module::VERSION>. (Note that there is not a
comma after VERSION!)
Because this is a wide-open interface, pragmas (compiler directives)
@@ -3873,17 +4643,18 @@ are also implemented this way. Currently implemented pragmas are:
use strict qw(subs vars refs);
use subs qw(afunc blurfl);
-These pseudo-modules import semantics into the current block scope, unlike
-ordinary modules, which import symbols into the current package (which are
-effective through the end of the file).
+Some of these these pseudo-modules import semantics into the current
+block scope (like C<strict> or C<integer>, unlike ordinary modules,
+which import symbols into the current package (which are effective
+through the end of the file).
-There's a corresponding "no" command that unimports meanings imported
-by use, i.e., it calls C<unimport Module LIST> instead of C<import>.
+There's a corresponding "C<no>" command that unimports meanings imported
+by C<use>, i.e., it calls C<unimport Module LIST> instead of C<import()>.
no integer;
no strict 'refs';
-If no unimport method can be found the call fails with a fatal error.
+If no C<unimport()> method can be found the call fails with a fatal error.
See L<perlmod> for a list of standard modules and pragmas.
@@ -3893,7 +4664,8 @@ Changes the access and modification times on each file of a list of
files. The first two elements of the list must be the NUMERICAL access
and modification times, in that order. Returns the number of files
successfully changed. The inode modification time of each file is set
-to the current time. Example of a "touch" command:
+to the current time. This code has the same effect as the "C<touch>"
+command if the files already exist:
#!/usr/bin/perl
$now = time;
@@ -3901,56 +4673,94 @@ to the current time. Example of a "touch" command:
=item values HASH
-Returns a normal array consisting of all the values of the named hash.
-(In a scalar context, returns the number of values.) The values are
-returned in an apparently random order, but it is the same order as either
-the keys() or each() function would produce on the same hash. As a side
-effect, it resets HASH's iterator. See also keys(), each(), and sort().
+Returns a list consisting of all the values of the named hash. (In a
+scalar context, returns the number of values.) The values are
+returned in an apparently random order. The actual random order is
+subject to change in future versions of perl, but it is guaranteed to
+be the same order as either the C<keys()> or C<each()> function would
+produce on the same (unmodified) hash.
+
+Note that you cannot modify the values of a hash this way, because the
+returned list is just a copy. You need to use a hash slice for that,
+since it's lvaluable in a way that values() is not.
+
+ for (values %hash) { s/foo/bar/g } # FAILS!
+ for (@hash{keys %hash}) { s/foo/bar/g } # ok
+
+As a side effect, calling values() resets the HASH's internal iterator.
+See also C<keys()>, C<each()>, and C<sort()>.
=item vec EXPR,OFFSET,BITS
Treats the string in EXPR as a vector of unsigned integers, and
returns the value of the bit field specified by OFFSET. BITS specifies
the number of bits that are reserved for each entry in the bit
-vector. This must be a power of two from 1 to 32. vec() may also be
+vector. This must be a power of two from 1 to 32. C<vec()> may also be
assigned to, in which case parentheses are needed to give the expression
the correct precedence as in
vec($image, $max_x * $x + $y, 8) = 3;
-Vectors created with vec() can also be manipulated with the logical
-operators |, &, and ^, which will assume a bit vector operation is
-desired when both operands are strings.
+Vectors created with C<vec()> can also be manipulated with the logical
+operators C<|>, C<&>, and C<^>, which will assume a bit vector operation is
+desired when both operands are strings. See L<perlop/"Bitwise String Operators">.
+
+The following code will build up an ASCII string saying C<'PerlPerlPerl'>.
+The comments show the string after each step. Note that this code works
+in the same way on big-endian or little-endian machines.
+
+ my $foo = '';
+ vec($foo, 0, 32) = 0x5065726C; # 'Perl'
+ vec($foo, 2, 16) = 0x5065; # 'PerlPe'
+ vec($foo, 3, 16) = 0x726C; # 'PerlPerl'
+ vec($foo, 8, 8) = 0x50; # 'PerlPerlP'
+ vec($foo, 9, 8) = 0x65; # 'PerlPerlPe'
+ vec($foo, 20, 4) = 2; # 'PerlPerlPe' . "\x02"
+ vec($foo, 21, 4) = 7; # 'PerlPerlPer'
+ # 'r' is "\x72"
+ vec($foo, 45, 2) = 3; # 'PerlPerlPer' . "\x0c"
+ vec($foo, 93, 1) = 1; # 'PerlPerlPer' . "\x2c"
+ vec($foo, 94, 1) = 1; # 'PerlPerlPerl'
+ # 'l' is "\x6c"
To transform a bit vector into a string or array of 0's and 1's, use these:
$bits = unpack("b*", $vector);
@bits = split(//, unpack("b*", $vector));
-If you know the exact length in bits, it can be used in place of the *.
+If you know the exact length in bits, it can be used in place of the C<*>.
=item wait
-Waits for a child process to terminate and returns the pid of the
-deceased process, or -1 if there are no child processes. The status is
-returned in C<$?>.
+Behaves like the wait(2) system call on your system: it waits for a child
+process to terminate and returns the pid of the deceased process, or
+C<-1> if there are no child processes. The status is rketurned in C<$?>.
+Note that a return value of C<-1> could mean that child processes are
+being automatically reaped, as described in L<perlipc>.
=item waitpid PID,FLAGS
-Waits for a particular child process to terminate and returns the pid
-of the deceased process, or -1 if there is no such child process. The
-status is returned in C<$?>. If you say
+Waits for a particular child process to terminate and returns the pid of
+the deceased process, or C<-1> if there is no such child process. On some
+systems, a value of 0 indicates that there are processes still running.
+The status is returned in C<$?>. If you say
use POSIX ":sys_wait_h";
- ...
- waitpid(-1,&WNOHANG);
-
-then you can do a non-blocking wait for any process. Non-blocking wait
-is available on machines supporting either the waitpid(2) or
-wait4(2) system calls. However, waiting for a particular pid with
-FLAGS of 0 is implemented everywhere. (Perl emulates the system call
-by remembering the status values of processes that have exited but have
-not been harvested by the Perl script yet.)
+ #...
+ do {
+ $kid = waitpid(-1,&WNOHANG);
+ } until $kid == -1;
+
+then you can do a non-blocking wait for all pending zombie processes.
+Non-blocking wait is available on machines supporting either the
+waitpid(2) or wait4(2) system calls. However, waiting for a particular
+pid with FLAGS of C<0> is implemented everywhere. (Perl emulates the
+system call by remembering the status values of processes that have
+exited but have not been harvested by the Perl script yet.)
+
+Note that on some systems, a return value of C<-1> could mean that child
+processes are being automatically reaped. See L<perlipc> for details,
+and for other examples.
=item wantarray
@@ -3965,21 +4775,28 @@ for no value (void context).
=item warn LIST
-Produces a message on STDERR just like die(), but doesn't exit or throw
+Produces a message on STDERR just like C<die()>, but doesn't exit or throw
an exception.
+If LIST is empty and C<$@> already contains a value (typically from a
+previous eval) that value is used after appending C<"\t...caught">
+to C<$@>. This is useful for staying almost, but not entirely similar to
+C<die()>.
+
+If C<$@> is empty then the string C<"Warning: Something's wrong"> is used.
+
No message is printed if there is a C<$SIG{__WARN__}> handler
installed. It is the handler's responsibility to deal with the message
-as it sees fit (like, for instance, converting it into a die()). Most
+as it sees fit (like, for instance, converting it into a C<die()>). Most
handlers must therefore make arrangements to actually display the
-warnings that they are not prepared to deal with, by calling warn()
+warnings that they are not prepared to deal with, by calling C<warn()>
again in the handler. Note that this is quite safe and will not
produce an endless loop, since C<__WARN__> hooks are not called from
inside one.
You will find this behavior is slightly different from that of
C<$SIG{__DIE__}> handlers (which don't suppress the error text, but can
-instead call die() again to change it).
+instead call C<die()> again to change it).
Using a C<__WARN__> handler provides a powerful way to silence all
warnings (even the so-called mandatory ones). An example:
@@ -3996,7 +4813,8 @@ warnings (even the so-called mandatory ones). An example:
warn "\$foo is alive and $foo!"; # does show up
See L<perlvar> for details on setting C<%SIG> entries, and for more
-examples.
+examples. See the Carp module for other kinds of warnings using its
+carp() and cluck() functions.
=item write FILEHANDLE
@@ -4004,10 +4822,10 @@ examples.
=item write
-Writes a formatted record (possibly multi-line) to the specified file,
+Writes a formatted record (possibly multi-line) to the specified FILEHANDLE,
using the format associated with that file. By default the format for
a file is the one having the same name as the filehandle, but the
-format for the current output channel (see the select() function) may be set
+format for the current output channel (see the C<select()> function) may be set
explicitly by assigning the name of the format to the C<$~> variable.
Top of form processing is handled automatically: if there is
@@ -4018,18 +4836,18 @@ By default the top-of-page format is the name of the filehandle with
"_TOP" appended, but it may be dynamically set to the format of your
choice by assigning the name to the C<$^> variable while the filehandle is
selected. The number of lines remaining on the current page is in
-variable C<$->, which can be set to 0 to force a new page.
+variable C<$->, which can be set to C<0> to force a new page.
If FILEHANDLE is unspecified, output goes to the current default output
channel, which starts out as STDOUT but may be changed by the
-C<select> operator. If the FILEHANDLE is an EXPR, then the expression
+C<select()> operator. If the FILEHANDLE is an EXPR, then the expression
is evaluated and the resulting string is used to look up the name of
the FILEHANDLE at run time. For more on formats, see L<perlform>.
-Note that write is I<NOT> the opposite of read. Unfortunately.
+Note that write is I<NOT> the opposite of C<read()>. Unfortunately.
=item y///
-The translation operator. Same as tr///. See L<perlop>.
+The transliteration operator. Same as C<tr///>. See L<perlop>.
=back
diff --git a/gnu/usr.bin/perl/pod/perlguts.pod b/gnu/usr.bin/perl/pod/perlguts.pod
index 20a11ac45cc..90bb71689e0 100644
--- a/gnu/usr.bin/perl/pod/perlguts.pod
+++ b/gnu/usr.bin/perl/pod/perlguts.pod
@@ -34,33 +34,50 @@ An SV can be created and loaded with one command. There are four types of
values that can be loaded: an integer value (IV), a double (NV), a string,
(PV), and another scalar (SV).
-The five routines are:
+The six routines are:
SV* newSViv(IV);
SV* newSVnv(double);
SV* newSVpv(char*, int);
+ SV* newSVpvn(char*, int);
SV* newSVpvf(const char*, ...);
SV* newSVsv(SV*);
-To change the value of an *already-existing* SV, there are six routines:
+To change the value of an *already-existing* SV, there are seven routines:
void sv_setiv(SV*, IV);
+ void sv_setuv(SV*, UV);
void sv_setnv(SV*, double);
- void sv_setpv(SV*, char*);
- void sv_setpvn(SV*, char*, int)
+ void sv_setpv(SV*, const char*);
+ void sv_setpvn(SV*, const char*, int)
void sv_setpvf(SV*, const char*, ...);
+ void sv_setpvfn(SV*, const char*, STRLEN, va_list *, SV **, I32, bool);
void sv_setsv(SV*, SV*);
Notice that you can choose to specify the length of the string to be
-assigned by using C<sv_setpvn> or C<newSVpv>, or you may allow Perl to
-calculate the length by using C<sv_setpv> or by specifying 0 as the second
-argument to C<newSVpv>. Be warned, though, that Perl will determine the
-string's length by using C<strlen>, which depends on the string terminating
-with a NUL character. The arguments of C<sv_setpvf> are processed like
-C<sprintf>, and the formatted output becomes the value.
-
-All SVs that will contain strings should, but need not, be terminated
-with a NUL character. If it is not NUL-terminated there is a risk of
+assigned by using C<sv_setpvn>, C<newSVpvn>, or C<newSVpv>, or you may
+allow Perl to calculate the length by using C<sv_setpv> or by specifying
+0 as the second argument to C<newSVpv>. Be warned, though, that Perl will
+determine the string's length by using C<strlen>, which depends on the
+string terminating with a NUL character.
+
+The arguments of C<sv_setpvf> are processed like C<sprintf>, and the
+formatted output becomes the value.
+
+C<sv_setpvfn> is an analogue of C<vsprintf>, but it allows you to specify
+either a pointer to a variable argument list or the address and length of
+an array of SVs. The last argument points to a boolean; on return, if that
+boolean is true, then locale-specific information has been used to format
+the string, and the string's contents are therefore untrustworthy (see
+L<perlsec>). This pointer may be NULL if that information is not
+important. Note that this function requires you to specify the length of
+the format.
+
+The C<sv_set*()> functions are not generic enough to operate on values
+that have "magic". See L<Magic Virtual Tables> later in this document.
+
+All SVs that contain strings should be terminated with a NUL character.
+If it is not NUL-terminated there is a risk of
core dumps and corruptions from code which passes the string to C
functions or system calls which expect a NUL-terminated string.
Perl's own functions typically add a trailing NUL for this reason.
@@ -78,9 +95,20 @@ or string.
In the C<SvPV> macro, the length of the string returned is placed into the
variable C<len> (this is a macro, so you do I<not> use C<&len>). If you do not
-care what the length of the data is, use the global variable C<na>. Remember,
-however, that Perl allows arbitrary strings of data that may both contain
-NULs and might not be terminated by a NUL.
+care what the length of the data is, use the global variable C<PL_na> or a
+local variable of type C<STRLEN>. However using C<PL_na> can be quite
+inefficient because C<PL_na> must be accessed in thread-local storage in
+threaded Perl. In any case, remember that Perl allows arbitrary strings of
+data that may both contain NULs and might not be terminated by a NUL.
+
+Also remember that C doesn't allow you to safely say C<foo(SvPV(s, len),
+len);>. It might work with your compiler, but it won't work for everyone.
+Break this sort of statement up into separate assignments:
+
+ STRLEN len;
+ char * ptr;
+ ptr = SvPV(len);
+ foo(ptr, len);
If you want to know if the scalar value is TRUE, you can use:
@@ -121,16 +149,22 @@ If you want to append something to the end of string stored in an C<SV*>,
you can use the following functions:
void sv_catpv(SV*, char*);
- void sv_catpvn(SV*, char*, int);
+ void sv_catpvn(SV*, char*, STRLEN);
void sv_catpvf(SV*, const char*, ...);
+ void sv_catpvfn(SV*, const char*, STRLEN, va_list *, SV **, I32, bool);
void sv_catsv(SV*, SV*);
The first function calculates the length of the string to be appended by
using C<strlen>. In the second, you specify the length of the string
yourself. The third function processes its arguments like C<sprintf> and
-appends the formatted output. The fourth function extends the string
-stored in the first SV with the string stored in the second SV. It also
-forces the second SV to be interpreted as a string.
+appends the formatted output. The fourth function works like C<vsprintf>.
+You can specify the address and length of an array of SVs instead of the
+va_list argument. The fifth function extends the string stored in the first
+SV with the string stored in the second SV. It also forces the second SV
+to be interpreted as a string.
+
+The C<sv_cat*()> functions are not generic enough to operate on values that
+have "magic". See L<Magic Virtual Tables> later in this document.
If you know the name of a scalar variable, you can get a pointer to its SV
by using the following:
@@ -144,14 +178,14 @@ you can call:
SvOK(SV*)
-The scalar C<undef> value is stored in an SV instance called C<sv_undef>. Its
+The scalar C<undef> value is stored in an SV instance called C<PL_sv_undef>. Its
address can be used whenever an C<SV*> is needed.
-There are also the two values C<sv_yes> and C<sv_no>, which contain Boolean
-TRUE and FALSE values, respectively. Like C<sv_undef>, their addresses can
+There are also the two values C<PL_sv_yes> and C<PL_sv_no>, which contain Boolean
+TRUE and FALSE values, respectively. Like C<PL_sv_undef>, their addresses can
be used whenever an C<SV*> is needed.
-Do not be fooled into thinking that C<(SV *) 0> is the same as C<&sv_undef>.
+Do not be fooled into thinking that C<(SV *) 0> is the same as C<&PL_sv_undef>.
Take this code:
SV* sv = (SV*) 0;
@@ -163,7 +197,7 @@ Take this code:
This code tries to return a new SV (which contains the value 42) if it should
return a real value, or undef otherwise. Instead it has returned a NULL
pointer which, somewhere down the line, will cause a segmentation violation,
-bus error, or just weird results. Change the zero to C<&sv_undef> in the first
+bus error, or just weird results. Change the zero to C<&PL_sv_undef> in the first
line and all will be well.
To free an SV that you've created, call C<SvREFCNT_dec(SV*)>. Normally this
@@ -239,9 +273,9 @@ return value.
The C<av_clear> function deletes all the elements in the AV* array, but
does not actually delete the array itself. The C<av_undef> function will
delete all the elements in the array plus the array itself. The
-C<av_extend> function extends the array so that it contains C<key>
-elements. If C<key> is less than the current length of the array, then
-nothing is done.
+C<av_extend> function extends the array so that it contains at least C<key+1>
+elements. If C<key+1> is less than the currently allocated length of the array,
+then nothing is done.
If you know the name of an array variable, you can get a pointer to its AV
by using the following:
@@ -327,11 +361,9 @@ This returns NULL if the variable does not exist.
The hash algorithm is defined in the C<PERL_HASH(hash, key, klen)> macro:
- i = klen;
hash = 0;
- s = key;
- while (i--)
- hash = hash * 33 + *s++;
+ while (klen--)
+ hash = (hash * 33) + *key++;
See L<Understanding the Magic of Tied Hashes and Arrays> for more
information on how to use the hash access functions on tied hashes.
@@ -465,10 +497,27 @@ reference is rv. SV is blessed if C<classname> is non-null.
Copies string into an SV whose reference is C<rv>. Set length to 0 to let
Perl calculate the string length. SV is blessed if C<classname> is non-null.
- SV* sv_setref_pvn(SV* rv, char* classname, PV iv, int length);
+ SV* sv_setref_pvn(SV* rv, char* classname, PV iv, STRLEN length);
+
+Tests whether the SV is blessed into the specified class. It does not
+check inheritance relationships.
+
+ int sv_isa(SV* sv, char* name);
+
+Tests whether the SV is a reference to a blessed object.
+
+ int sv_isobject(SV* sv);
+
+Tests whether the SV is derived from the specified class. SV can be either
+a reference to a blessed object or a string containing a class name. This
+is the function implementing the C<UNIVERSAL::isa> functionality.
- int sv_isa(SV* sv, char* name);
- int sv_isobject(SV* sv);
+ bool sv_derived_from(SV* sv, char* name);
+
+To check if you've got an object derived from a specific class you have
+to write:
+
+ if (sv_isobject(sv) && sv_derived_from(sv, class)) { ... }
=head2 Creating New Variables
@@ -574,15 +623,14 @@ including (but not limited to) the following:
Scalar Value
Array Value
Hash Value
- File Handle
- Directory Handle
+ I/O Handle
Format
Subroutine
-There is a single stash called "defstash" that holds the items that exist
+There is a single stash called "PL_defstash" that holds the items that exist
in the "main" package. To get at the items in other packages, append the
string "::" to the package name. The items in the "Foo" package are in
-the stash "Foo::" in defstash. The items in the "Bar::Baz" package are
+the stash "Foo::" in PL_defstash. The items in the "Bar::Baz" package are
in the stash "Baz::" in "Bar::"'s stash.
To get the stash pointer for a particular package, use the function:
@@ -822,7 +870,20 @@ C<mg_ptr> field points to a C<ufuncs> structure:
When the SV is read from or written to, the C<uf_val> or C<uf_set>
function will be called with C<uf_index> as the first arg and a
-pointer to the SV as the second.
+pointer to the SV as the second. A simple example of how to add 'U'
+magic is shown below. Note that the ufuncs structure is copied by
+sv_magic, so you can safely allocate it on the stack.
+
+ void
+ Umagic(sv)
+ SV *sv;
+ PREINIT:
+ struct ufuncs uf;
+ CODE:
+ uf.uf_val = &my_get_fn;
+ uf.uf_set = &my_set_fn;
+ uf.uf_index = 0;
+ sv_magic(sv, 0, 'U', (char*)&uf, sizeof(uf));
Note that because multiple extensions may be using '~' or 'U' magic,
it is important for extensions to take extra care to avoid conflict.
@@ -831,6 +892,18 @@ as the extension is sufficient. For '~' magic, it may also be
appropriate to add an I32 'signature' at the top of the private data
area and check that.
+Also note that the C<sv_set*()> and C<sv_cat*()> functions described
+earlier do B<not> invoke 'set' magic on their targets. This must
+be done by the user either by calling the C<SvSETMAGIC()> macro after
+calling these functions, or by using one of the C<sv_set*_mg()> or
+C<sv_cat*_mg()> functions. Similarly, generic C code must call the
+C<SvGETMAGIC()> macro to invoke any 'get' magic if they use an SV
+obtained from external sources in functions that don't handle magic.
+L<API LISTING> later in this document identifies such functions.
+For example, calls to the C<sv_cat*()> functions typically need to be
+followed by C<SvSETMAGIC()>, but they don't need a prior C<SvGETMAGIC()>
+since their implementation handles 'get' magic.
+
=head2 Finding Magic
MAGIC* mg_find(SV*, int type); /* Finds the magic pointer of that type */
@@ -856,6 +929,33 @@ in later releases, and are bracketed with [MAYCHANGE] below. If
you find yourself actually applying such information in this section, be
aware that the behavior may change in the future, umm, without warning.
+The perl tie function associates a variable with an object that implements
+the various GET, SET etc methods. To perform the equivalent of the perl
+tie function from an XSUB, you must mimic this behaviour. The code below
+carries out the necessary steps - firstly it creates a new hash, and then
+creates a second hash which it blesses into the class which will implement
+the tie methods. Lastly it ties the two hashes together, and returns a
+reference to the new tied hash. Note that the code below does NOT call the
+TIEHASH method in the MyTie class -
+see L<Calling Perl Routines from within C Programs> for details on how
+to do this.
+
+ SV*
+ mytie()
+ PREINIT:
+ HV *hash;
+ HV *stash;
+ SV *tie;
+ CODE:
+ hash = newHV();
+ tie = newRV_noinc((SV*)newHV());
+ stash = gv_stashpv("MyTie", TRUE);
+ sv_bless(tie, stash);
+ hv_magic(hash, tie, 'P');
+ RETVAL = newRV_noinc(hash);
+ OUTPUT:
+ RETVAL
+
The C<av_store> function, when given a tied array argument, merely
copies the magic of the array onto the value to be "stored", using
C<mg_copy>. It may also return NULL, indicating that the value did not
@@ -931,13 +1031,13 @@ There is a way to achieve a similar task from C via Perl API: create a
I<pseudo-block>, and arrange for some changes to be automatically
undone at the end of it, either explicit, or via a non-local exit (via
die()). A I<block>-like construct is created by a pair of
-C<ENTER>/C<LEAVE> macros (see L<perlcall/EXAMPLE/"Returning a
-Scalar">). Such a construct may be created specially for some
-important localized task, or an existing one (like boundaries of
-enclosing Perl subroutine/block, or an existing pair for freeing TMPs)
-may be used. (In the second case the overhead of additional
-localization must be almost negligible.) Note that any XSUB is
-automatically enclosed in an C<ENTER>/C<LEAVE> pair.
+C<ENTER>/C<LEAVE> macros (see L<perlcall/"Returning a Scalar">).
+Such a construct may be created specially for some important localized
+task, or an existing one (like boundaries of enclosing Perl
+subroutine/block, or an existing pair for freeing TMPs) may be
+used. (In the second case the overhead of additional localization must
+be almost negligible.) Note that any XSUB is automatically enclosed in
+an C<ENTER>/C<LEAVE> pair.
Inside such a I<pseudo-block> the following service is available:
@@ -990,7 +1090,7 @@ string pointed to by C<key> is Safefree()ed. If one has a I<key> in
short-lived storage, the corresponding string may be reallocated like
this:
- SAVEDELETE(defstash, savepv(tmpbuf), strlen(tmpbuf));
+ SAVEDELETE(PL_defstash, savepv(tmpbuf), strlen(tmpbuf));
=item C<SAVEDESTRUCTOR(f,p)>
@@ -1070,10 +1170,10 @@ two, the local time zone's standard and summer time abbreviations.
To handle this situation, the PPCODE directive is used and the stack is
extended using the macro:
- EXTEND(sp, num);
+ EXTEND(SP, num);
-where C<sp> is the stack pointer, and C<num> is the number of elements the
-stack should be extended by.
+where C<SP> is the macro that represents the local copy of the stack pointer,
+and C<num> is the number of elements the stack should be extended by.
Now that there is room on the stack, values can be pushed on it using the
macros to push IVs, doubles, strings, and SV pointers respectively:
@@ -1126,6 +1226,7 @@ must manipulate the Perl stack. These include the following macros and
functions:
dSP
+ SP
PUSHMARK()
PUTBACK
SPAGAIN
@@ -1141,7 +1242,12 @@ consult L<perlcall>.
=head2 Memory Allocation
-It is suggested that you use the version of malloc that is distributed
+All memory meant to be used with the Perl API functions should be manipulated
+using the macros described in this section. The macros provide the necessary
+transparency between differences in the actual malloc implementation that is
+used within perl.
+
+It is suggested that you enable the version of malloc that is distributed
with Perl. It keeps pools of various sizes of unallocated memory in
order to satisfy allocation requests more quickly. However, on some
platforms, it may cause spurious malloc or free errors.
@@ -1274,7 +1380,7 @@ This is converted to a tree similar to this one:
/ \
$b $c
-(but slightly more complicated). This tree reflect the way Perl
+(but slightly more complicated). This tree reflects the way Perl
parsed your code, but has nothing to do with the execution order.
There is an additional "thread" going through the nodes of the tree
which shows the order of execution of the nodes. In our simplified
@@ -1347,7 +1453,7 @@ and corresponding check routines is described in F<opcode.pl> (do not
forget to run C<make regen_headers> if you modify this file).
A check routine is called when the node is fully constructed except
-for the execution-order thread. Since at this time there is no
+for the execution-order thread. Since at this time there are no
back-links to the currently constructed node, one can do most any
operation to the top-level node, including freeing it and/or creating
new nodes above/below it.
@@ -1374,7 +1480,7 @@ created.
=head2 Compile pass 2: context propagation
When a context for a part of compile tree is known, it is propagated
-down through the tree. Aat this time the context can have 5 values
+down through the tree. At this time the context can have 5 values
(instead of 2 for runtime context): void, boolean, scalar, list, and
lvalue. In contrast with the pass 1 this pass is processed from top
to bottom: a node's context determines the context for its children.
@@ -1390,7 +1496,7 @@ of free()ing (i.e. their type is changed to OP_NULL).
After the compile tree for a subroutine (or for an C<eval> or a file)
is created, an additional pass over the code is performed. This pass
is neither top-down or bottom-up, but in the execution order (with
-additional compilications for conditionals). These optimizations are
+additional complications for conditionals). These optimizations are
done in the subroutine peep(). Optimizations performed at this stage
are subject to the same restrictions as in the pass 2.
@@ -1400,25 +1506,31 @@ This is a listing of functions, macros, flags, and variables that may be
useful to extension writers or that may be found while reading other
extensions.
-=over 8
+Note that all Perl API global variables must be referenced with the C<PL_>
+prefix. Some macros are provided for compatibility with the older,
+unadorned names, but this support will be removed in a future release.
-=item AvFILL
+It is strongly recommended that all Perl API functions that don't begin
+with C<perl> be referenced with an explicit C<Perl_> prefix.
-Same as C<av_len>.
+The sort order of the listing is case insensitive, with any
+occurrences of '_' ignored for the purpose of sorting.
+
+=over 8
=item av_clear
Clears an array, making it empty. Does not free the memory used by the
array itself.
- void av_clear _((AV* ar));
+ void av_clear (AV* ar)
=item av_extend
Pre-extend an array. The C<key> is the index to which the array should be
extended.
- void av_extend _((AV* ar, I32 key));
+ void av_extend (AV* ar, I32 key)
=item av_fetch
@@ -1429,13 +1541,17 @@ that the return value is non-null before dereferencing it to a C<SV*>.
See L<Understanding the Magic of Tied Hashes and Arrays> for more
information on how to use this function on tied arrays.
- SV** av_fetch _((AV* ar, I32 key, I32 lval));
+ SV** av_fetch (AV* ar, I32 key, I32 lval)
+
+=item AvFILL
+
+Same as C<av_len()>. Deprecated, use C<av_len()> instead.
=item av_len
Returns the highest index in the array. Returns -1 if the array is empty.
- I32 av_len _((AV* ar));
+ I32 av_len (AV* ar)
=item av_make
@@ -1443,27 +1559,27 @@ Creates a new AV and populates it with a list of SVs. The SVs are copied
into the array, so they may be freed after the call to av_make. The new AV
will have a reference count of 1.
- AV* av_make _((I32 size, SV** svp));
+ AV* av_make (I32 size, SV** svp)
=item av_pop
-Pops an SV off the end of the array. Returns C<&sv_undef> if the array is
+Pops an SV off the end of the array. Returns C<&PL_sv_undef> if the array is
empty.
- SV* av_pop _((AV* ar));
+ SV* av_pop (AV* ar)
=item av_push
Pushes an SV onto the end of the array. The array will grow automatically
to accommodate the addition.
- void av_push _((AV* ar, SV* val));
+ void av_push (AV* ar, SV* val)
=item av_shift
Shifts an SV off the beginning of the array.
- SV* av_shift _((AV* ar));
+ SV* av_shift (AV* ar)
=item av_store
@@ -1477,13 +1593,13 @@ before the call, and decrementing it if the function returned NULL.
See L<Understanding the Magic of Tied Hashes and Arrays> for more
information on how to use this function on tied arrays.
- SV** av_store _((AV* ar, I32 key, SV* val));
+ SV** av_store (AV* ar, I32 key, SV* val)
=item av_undef
Undefines the array. Frees the memory used by the array itself.
- void av_undef _((AV* ar));
+ void av_undef (AV* ar)
=item av_unshift
@@ -1491,7 +1607,7 @@ Unshift the given number of C<undef> values onto the beginning of the
array. The array will grow automatically to accommodate the addition.
You must then use C<av_store> to assign values to these new elements.
- void av_unshift _((AV* ar, I32 num));
+ void av_unshift (AV* ar, I32 num)
=item CLASS
@@ -1505,7 +1621,7 @@ The XSUB-writer's interface to the C C<memcpy> function. The C<s> is the
source, C<d> is the destination, C<n> is the number of items, and C<t> is
the type. May fail on overlapping copies. See also C<Move>.
- (void) Copy( s, d, n, t );
+ void Copy( s, d, n, t )
=item croak
@@ -1516,29 +1632,29 @@ function the same way you use the C C<printf> function. See C<warn>.
Returns the stash of the CV.
- HV * CvSTASH( SV* sv )
+ HV* CvSTASH( SV* sv )
-=item DBsingle
+=item 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<DBsub>.
+variable which corresponds to Perl's $DB::single variable. See C<PL_DBsub>.
-=item DBsub
+=item 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<DBsingle>.
+variable which corresponds to Perl's $DB::sub variable. See C<PL_DBsingle>.
The sub name can be found by
- SvPV( GvSV( DBsub ), na )
+ SvPV( GvSV( PL_DBsub ), len )
-=item DBtrace
+=item 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<DBsingle>.
+variable. See C<PL_DBsingle>.
=item dMARK
@@ -1549,13 +1665,14 @@ C<dORIGMARK>.
Saves the original stack mark for the XSUB. See C<ORIGMARK>.
-=item dowarn
+=item PL_dowarn
The C variable which corresponds to Perl's $^W warning variable.
=item dSP
-Declares a stack pointer variable, C<sp>, for the XSUB. See C<SP>.
+Declares a local copy of perl's stack pointer for the XSUB, available via
+the C<SP> macro. See C<SP>.
=item dXSARGS
@@ -1568,6 +1685,13 @@ to indicate the number of items on the stack.
Sets up the C<ix> variable for an XSUB which has aliases. This is usually
handled automatically by C<xsubpp>.
+=item do_binmode
+
+Switches filehandle to binmode. C<iotype> is what C<IoTYPE(io)> would
+contain.
+
+ do_binmode(fp, iotype, TRUE);
+
=item ENTER
Opening bracket on a callback. See C<LEAVE> and L<perlcall>.
@@ -1578,7 +1702,23 @@ Opening bracket on a callback. See C<LEAVE> and L<perlcall>.
Used to extend the argument stack for an XSUB's return values.
- EXTEND( sp, int x );
+ EXTEND( sp, int x )
+
+=item fbm_compile
+
+Analyses the string in order to make fast searches on it using fbm_instr() --
+the Boyer-Moore algorithm.
+
+ void fbm_compile(SV* sv, U32 flags)
+
+=item fbm_instr
+
+Returns the location of the SV in the string delimited by C<str> and
+C<strend>. It returns C<Nullch> if the string can't be found. The
+C<sv> does not have to be fbm_compiled, but the search will not be as
+fast then.
+
+ char* fbm_instr(char *str, char *strend, SV *sv, U32 flags)
=item FREETMPS
@@ -1619,15 +1759,11 @@ Indicates that no arguments are being sent to a callback. See L<perlcall>.
Used to indicate scalar context. See C<GIMME_V>, C<GIMME>, and L<perlcall>.
-=item G_VOID
-
-Used to indicate void context. See C<GIMME_V> and L<perlcall>.
-
=item gv_fetchmeth
Returns the glob with the given C<name> and a defined subroutine or
C<NULL>. The glob lives in the given C<stash>, or in the stashes
-accessable via @ISA and @<UNIVERSAL>.
+accessible via @ISA and @UNIVERSAL.
The argument C<level> should be either 0 or -1. If C<level==0>, as a
side-effect creates a glob with the given C<name> in the given
@@ -1642,14 +1778,14 @@ which is not visible to Perl code. So when calling C<perl_call_sv>,
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<GvCV> macro.
- GV* gv_fetchmeth _((HV* stash, char* name, STRLEN len, I32 level));
+ GV* gv_fetchmeth (HV* stash, char* name, STRLEN len, I32 level)
=item gv_fetchmethod
=item gv_fetchmethod_autoload
Returns the glob which contains the subroutine to call to invoke the
-method on the C<stash>. In fact in the presense of autoloading this may
+method on the C<stash>. In fact in the presence of autoloading this may
be the glob for "AUTOLOAD". In this case the corresponding variable
$AUTOLOAD is already setup.
@@ -1671,9 +1807,12 @@ C<level==0>. C<name> should be writable if contains C<':'> or C<'\''>.
The warning against passing the GV returned by C<gv_fetchmeth> to
C<perl_call_sv> apply equally to these functions.
- GV* gv_fetchmethod _((HV* stash, char* name));
- GV* gv_fetchmethod_autoload _((HV* stash, char* name,
- I32 autoload));
+ GV* gv_fetchmethod (HV* stash, char* name)
+ GV* gv_fetchmethod_autoload (HV* stash, char* name, I32 autoload)
+
+=item G_VOID
+
+Used to indicate void context. See C<GIMME_V> and L<perlcall>.
=item gv_stashpv
@@ -1681,13 +1820,13 @@ Returns a pointer to the stash for a specified package. If C<create> is set
then the package will be created if it does not already exist. If C<create>
is not set and the package does not exist then NULL is returned.
- HV* gv_stashpv _((char* name, I32 create));
+ HV* gv_stashpv (char* name, I32 create)
=item gv_stashsv
Returns a pointer to the stash for a specified package. See C<gv_stashpv>.
- HV* gv_stashsv _((SV* sv, I32 create));
+ HV* gv_stashsv (SV* sv, I32 create)
=item GvSV
@@ -1701,9 +1840,9 @@ C<char*> pointer is to be expected. (For information only--not to be used).
=item HeHASH
-Returns the computed hash (type C<U32>) stored in the hash entry.
+Returns the computed hash stored in the hash entry.
- HeHASH(HE* he)
+ U32 HeHASH(HE* he)
=item HeKEY
@@ -1712,7 +1851,7 @@ The pointer may be either C<char*> or C<SV*>, depending on the value of
C<HeKLEN()>. Can be assigned to. The C<HePV()> or C<HeSVKEY()> macros
are usually preferable for finding the value of a key.
- HeKEY(HE* he)
+ char* HeKEY(HE* he)
=item HeKLEN
@@ -1721,7 +1860,7 @@ holds an C<SV*> key. Otherwise, holds the actual length of the key.
Can be assigned to. The C<HePV()> macro is usually preferable for finding
key lengths.
- HeKLEN(HE* he)
+ int HeKLEN(HE* he)
=item HePV
@@ -1729,13 +1868,14 @@ Returns the key slot of the hash entry as a C<char*> value, doing any
necessary dereferencing of possibly C<SV*> keys. The length of
the string is placed in C<len> (this is a macro, so do I<not> use
C<&len>). If you do not care about what the length of the key is,
-you may use the global variable C<na>. Remember though, that hash
+you may use the global variable C<PL_na>, though this is rather less
+efficient than using a local variable. Remember though, that hash
keys in perl are free to contain embedded nulls, so using C<strlen()>
or similar is not a good way to find the length of hash keys.
This is very similar to the C<SvPV()> macro described elsewhere in
this document.
- HePV(HE* he, STRLEN len)
+ char* HePV(HE* he, STRLEN len)
=item HeSVKEY
@@ -1768,16 +1908,7 @@ Returns the value slot (type C<SV*>) stored in the hash entry.
Clears a hash, making it empty.
- void hv_clear _((HV* tb));
-
-=item hv_delayfree_ent
-
-Releases a hash entry, such as while iterating though the hash, but
-delays actual freeing of key and value until the end of the current
-statement (or thereabouts) with C<sv_2mortal>. See C<hv_iternext>
-and C<hv_free_ent>.
-
- void hv_delayfree_ent _((HV* hv, HE* entry));
+ void hv_clear (HV* tb)
=item hv_delete
@@ -1786,7 +1917,7 @@ and returned to the caller. The C<klen> is the length of the key. The
C<flags> value will normally be zero; if set to G_DISCARD then NULL will be
returned.
- SV* hv_delete _((HV* tb, char* key, U32 klen, I32 flags));
+ SV* hv_delete (HV* tb, char* key, U32 klen, I32 flags)
=item hv_delete_ent
@@ -1795,21 +1926,21 @@ and returned to the caller. The C<flags> value will normally be zero; if set
to G_DISCARD then NULL will be returned. C<hash> can be a valid precomputed
hash value, or 0 to ask for it to be computed.
- SV* hv_delete_ent _((HV* tb, SV* key, I32 flags, U32 hash));
+ SV* hv_delete_ent (HV* tb, SV* key, I32 flags, U32 hash)
=item hv_exists
Returns a boolean indicating whether the specified hash key exists. The
C<klen> is the length of the key.
- bool hv_exists _((HV* tb, char* key, U32 klen));
+ bool hv_exists (HV* tb, char* key, U32 klen)
=item hv_exists_ent
Returns a boolean indicating whether the specified hash key exists. C<hash>
can be a valid precomputed hash value, or 0 to ask for it to be computed.
- bool hv_exists_ent _((HV* tb, SV* key, U32 hash));
+ bool hv_exists_ent (HV* tb, SV* key, U32 hash)
=item hv_fetch
@@ -1821,7 +1952,7 @@ dereferencing it to a C<SV*>.
See L<Understanding the Magic of Tied Hashes and Arrays> for more
information on how to use this function on tied hashes.
- SV** hv_fetch _((HV* tb, char* key, U32 klen, I32 lval));
+ SV** hv_fetch (HV* tb, char* key, U32 klen, I32 lval)
=item hv_fetch_ent
@@ -1836,32 +1967,28 @@ structure if you need to store it somewhere.
See L<Understanding the Magic of Tied Hashes and Arrays> for more
information on how to use this function on tied hashes.
- HE* hv_fetch_ent _((HV* tb, SV* key, I32 lval, U32 hash));
-
-=item hv_free_ent
-
-Releases a hash entry, such as while iterating though the hash. See
-C<hv_iternext> and C<hv_delayfree_ent>.
-
- void hv_free_ent _((HV* hv, HE* entry));
+ HE* hv_fetch_ent (HV* tb, SV* key, I32 lval, U32 hash)
=item hv_iterinit
Prepares a starting point to traverse a hash table.
- I32 hv_iterinit _((HV* tb));
+ I32 hv_iterinit (HV* tb)
-Note that hv_iterinit I<currently> returns the number of I<buckets> in
-the hash and I<not> the number of keys (as indicated in the Advanced
-Perl Programming book). This may change in future. Use the HvKEYS(hv)
-macro to find the number of keys in a hash.
+Returns the number of keys in the hash (i.e. the same as C<HvKEYS(tb)>).
+The return value is currently only meaningful for hashes without tie
+magic.
+
+NOTE: Before version 5.004_65, C<hv_iterinit> used to return the number
+of hash buckets that happen to be in use. If you still need that
+esoteric value, you can get it through the macro C<HvFILL(tb)>.
=item hv_iterkey
Returns the key from the current position of the hash iterator. See
C<hv_iterinit>.
- char* hv_iterkey _((HE* entry, I32* retlen));
+ char* hv_iterkey (HE* entry, I32* retlen)
=item hv_iterkeysv
@@ -1869,39 +1996,39 @@ Returns the key as an C<SV*> from the current position of the hash
iterator. The return value will always be a mortal copy of the
key. Also see C<hv_iterinit>.
- SV* hv_iterkeysv _((HE* entry));
+ SV* hv_iterkeysv (HE* entry)
=item hv_iternext
Returns entries from a hash iterator. See C<hv_iterinit>.
- HE* hv_iternext _((HV* tb));
+ HE* hv_iternext (HV* tb)
=item hv_iternextsv
Performs an C<hv_iternext>, C<hv_iterkey>, and C<hv_iterval> in one
operation.
- SV * hv_iternextsv _((HV* hv, char** key, I32* retlen));
+ SV* hv_iternextsv (HV* hv, char** key, I32* retlen)
=item hv_iterval
Returns the value from the current position of the hash iterator. See
C<hv_iterkey>.
- SV* hv_iterval _((HV* tb, HE* entry));
+ SV* hv_iterval (HV* tb, HE* entry)
=item hv_magic
Adds magic to a hash. See C<sv_magic>.
- void hv_magic _((HV* hv, GV* gv, int how));
+ void hv_magic (HV* hv, GV* gv, int how)
=item HvNAME
Returns the package name of a stash. See C<SvSTASH>, C<CvSTASH>.
- char *HvNAME (HV* stash)
+ char* HvNAME (HV* stash)
=item hv_store
@@ -1917,7 +2044,7 @@ before the call, and decrementing it if the function returned NULL.
See L<Understanding the Magic of Tied Hashes and Arrays> for more
information on how to use this function on tied hashes.
- SV** hv_store _((HV* tb, char* key, U32 klen, SV* val, U32 hash));
+ SV** hv_store (HV* tb, char* key, U32 klen, SV* val, U32 hash)
=item hv_store_ent
@@ -1934,51 +2061,51 @@ it if the function returned NULL.
See L<Understanding the Magic of Tied Hashes and Arrays> for more
information on how to use this function on tied hashes.
- HE* hv_store_ent _((HV* tb, SV* key, SV* val, U32 hash));
+ HE* hv_store_ent (HV* tb, SV* key, SV* val, U32 hash)
=item hv_undef
Undefines the hash.
- void hv_undef _((HV* tb));
+ void hv_undef (HV* tb)
=item isALNUM
Returns a boolean indicating whether the C C<char> is an ascii alphanumeric
character or digit.
- int isALNUM (char c)
+ int isALNUM (char c)
=item isALPHA
Returns a boolean indicating whether the C C<char> is an ascii alphabetic
character.
- int isALPHA (char c)
+ int isALPHA (char c)
=item isDIGIT
Returns a boolean indicating whether the C C<char> is an ascii digit.
- int isDIGIT (char c)
+ int isDIGIT (char c)
=item isLOWER
Returns a boolean indicating whether the C C<char> is a lowercase character.
- int isLOWER (char c)
+ int isLOWER (char c)
=item isSPACE
Returns a boolean indicating whether the C C<char> is whitespace.
- int isSPACE (char c)
+ int isSPACE (char c)
=item isUPPER
Returns a boolean indicating whether the C C<char> is an uppercase character.
- int isUPPER (char c)
+ int isUPPER (char c)
=item items
@@ -1996,6 +2123,13 @@ Closing bracket on a callback. See C<ENTER> and L<perlcall>.
LEAVE;
+=item looks_like_number
+
+Test if an the content of an SV looks like a number (or is a number).
+
+ int looks_like_number(SV*)
+
+
=item MARK
Stack marker variable for the XSUB. See C<dMARK>.
@@ -2004,49 +2138,57 @@ Stack marker variable for the XSUB. See C<dMARK>.
Clear something magical that the SV represents. See C<sv_magic>.
- int mg_clear _((SV* sv));
+ int mg_clear (SV* sv)
=item mg_copy
Copies the magic from one SV to another. See C<sv_magic>.
- int mg_copy _((SV *, SV *, char *, STRLEN));
+ int mg_copy (SV *, SV *, char *, STRLEN)
=item mg_find
Finds the magic pointer for type matching the SV. See C<sv_magic>.
- MAGIC* mg_find _((SV* sv, int type));
+ MAGIC* mg_find (SV* sv, int type)
=item mg_free
Free any magic storage used by the SV. See C<sv_magic>.
- int mg_free _((SV* sv));
+ int mg_free (SV* sv)
=item mg_get
Do magic after a value is retrieved from the SV. See C<sv_magic>.
- int mg_get _((SV* sv));
+ int mg_get (SV* sv)
=item mg_len
Report on the SV's length. See C<sv_magic>.
- U32 mg_len _((SV* sv));
+ U32 mg_len (SV* sv)
=item mg_magical
Turns on the magical status of an SV. See C<sv_magic>.
- void mg_magical _((SV* sv));
+ void mg_magical (SV* sv)
=item mg_set
Do magic after a value is assigned to the SV. See C<sv_magic>.
- int mg_set _((SV* sv));
+ int mg_set (SV* sv)
+
+=item modglobal
+
+C<modglobal> is a general purpose, interpreter global HV for use by
+extensions that need to keep information on a per-interpreter basis.
+In a pinch, it can also be used as a symbol table for extensions
+to share data among each other. It is a good idea to use keys
+prefixed by the package name of the extension that owns the data.
=item Move
@@ -2054,50 +2196,51 @@ The XSUB-writer's interface to the C C<memmove> function. The C<s> is the
source, C<d> is the destination, C<n> is the number of items, and C<t> is
the type. Can do overlapping moves. See also C<Copy>.
- (void) Move( s, d, n, t );
+ void Move( s, d, n, t )
-=item na
+=item PL_na
-A variable which may be used with C<SvPV> to tell Perl to calculate the
-string length.
+A convenience variable which is typically used with C<SvPV> when one doesn't
+care about the length of the string. It is usually more efficient to
+declare a local variable and use that instead.
=item New
The XSUB-writer's interface to the C C<malloc> function.
- void * New( x, void *ptr, int size, type )
+ void* New( x, void *ptr, int size, type )
-=item Newc
+=item newAV
-The XSUB-writer's interface to the C C<malloc> function, with cast.
+Creates a new AV. The reference count is set to 1.
- void * Newc( x, void *ptr, int size, type, cast )
+ AV* newAV (void)
-=item Newz
+=item Newc
-The XSUB-writer's interface to the C C<malloc> function. The allocated
-memory is zeroed with C<memzero>.
+The XSUB-writer's interface to the C C<malloc> function, with cast.
- void * Newz( x, void *ptr, int size, type )
+ void* Newc( x, void *ptr, int size, type, cast )
-=item newAV
+=item newCONSTSUB
-Creates a new AV. The reference count is set to 1.
+Creates a constant sub equivalent to Perl C<sub FOO () { 123 }>
+which is eligible for inlining at compile-time.
- AV* newAV _((void));
+ void newCONSTSUB(HV* stash, char* name, SV* sv)
=item newHV
Creates a new HV. The reference count is set to 1.
- HV* newHV _((void));
+ HV* newHV (void)
=item newRV_inc
Creates an RV wrapper for an SV. The reference count for the original SV is
incremented.
- SV* newRV_inc _((SV* ref));
+ SV* newRV_inc (SV* ref)
For historical reasons, "newRV" is a synonym for "newRV_inc".
@@ -2106,36 +2249,54 @@ For historical reasons, "newRV" is a synonym for "newRV_inc".
Creates an RV wrapper for an SV. The reference count for the original
SV is B<not> incremented.
- SV* newRV_noinc _((SV* ref));
+ SV* newRV_noinc (SV* ref)
-=item newSV
+=item NEWSV
-Creates a new SV. The C<len> parameter indicates the number of bytes of
-preallocated string space the SV should have. The reference count for the
-new SV is set to 1.
+Creates a new SV. A non-zero C<len> 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. C<id> is an integer id between 0 and 1299 (used to identify
+leaks).
- SV* newSV _((STRLEN len));
+ SV* NEWSV (int id, STRLEN len)
=item newSViv
Creates a new SV and copies an integer into it. The reference count for the
SV is set to 1.
- SV* newSViv _((IV i));
+ SV* newSViv (IV i)
=item newSVnv
Creates a new SV and copies a double into it. The reference count for the
SV is set to 1.
- SV* newSVnv _((NV i));
+ SV* newSVnv (NV i)
=item newSVpv
Creates a new SV and copies a string into it. The reference count for the
SV is set to 1. If C<len> is zero then Perl will compute the length.
- SV* newSVpv _((char* s, STRLEN len));
+ SV* newSVpv (char* s, STRLEN len)
+
+=item newSVpvf
+
+Creates a new SV an initialize it with the string formatted like
+C<sprintf>.
+
+ SV* newSVpvf(const char* pat, ...);
+
+=item newSVpvn
+
+Creates a new SV and copies a string into it. The reference count for the
+SV is set to 1. If C<len> is zero then Perl will create a zero length
+string.
+
+ SV* newSVpvn (char* s, STRLEN len)
=item newSVrv
@@ -2144,13 +2305,13 @@ it will be upgraded to one. If C<classname> is non-null then the new SV will
be blessed in the specified package. The new SV is returned and its
reference count is 1.
- SV* newSVrv _((SV* rv, char* classname));
+ SV* newSVrv (SV* rv, char* classname)
=item newSVsv
Creates a new SV which is an exact duplicate of the original SV.
- SV* newSVsv _((SV* old));
+ SV* newSVsv (SV* old)
=item newXS
@@ -2161,6 +2322,13 @@ Used by C<xsubpp> to hook up XSUBs as Perl subs.
Used by C<xsubpp> to hook up XSUBs as Perl subs. Adds Perl prototypes to
the subs.
+=item Newz
+
+The XSUB-writer's interface to the C C<malloc> function. The allocated
+memory is zeroed with C<memzero>.
+
+ void* Newz( x, void *ptr, int size, type )
+
=item Nullav
Null AV pointer.
@@ -2193,27 +2361,27 @@ Allocates a new Perl interpreter. See L<perlembed>.
Performs a callback to the specified Perl sub. See L<perlcall>.
- I32 perl_call_argv _((char* subname, I32 flags, char** argv));
+ I32 perl_call_argv (char* subname, I32 flags, char** argv)
=item perl_call_method
Performs a callback to the specified Perl method. The blessed object must
be on the stack. See L<perlcall>.
- I32 perl_call_method _((char* methname, I32 flags));
+ I32 perl_call_method (char* methname, I32 flags)
=item perl_call_pv
Performs a callback to the specified Perl sub. See L<perlcall>.
- I32 perl_call_pv _((char* subname, I32 flags));
+ I32 perl_call_pv (char* subname, I32 flags)
=item perl_call_sv
Performs a callback to the Perl sub whose name is in the SV. See
L<perlcall>.
- I32 perl_call_sv _((SV* sv, I32 flags));
+ I32 perl_call_sv (SV* sv, I32 flags)
=item perl_construct
@@ -2227,13 +2395,13 @@ Shuts down a Perl interpreter. See L<perlembed>.
Tells Perl to C<eval> the string in the SV.
- I32 perl_eval_sv _((SV* sv, I32 flags));
+ I32 perl_eval_sv (SV* sv, I32 flags)
=item perl_eval_pv
Tells Perl to C<eval> the given string and return an SV* result.
- SV* perl_eval_pv _((char* p, I32 croak_on_error));
+ SV* perl_eval_pv (char* p, I32 croak_on_error)
=item perl_free
@@ -2245,7 +2413,7 @@ Returns the AV of the specified Perl array. If C<create> is set and the
Perl variable does not exist then it will be created. If C<create> is not
set and the variable does not exist then NULL is returned.
- AV* perl_get_av _((char* name, I32 create));
+ AV* perl_get_av (char* name, I32 create)
=item perl_get_cv
@@ -2253,7 +2421,7 @@ Returns the CV of the specified Perl sub. If C<create> is set and the Perl
variable does not exist then it will be created. If C<create> is not
set and the variable does not exist then NULL is returned.
- CV* perl_get_cv _((char* name, I32 create));
+ CV* perl_get_cv (char* name, I32 create)
=item perl_get_hv
@@ -2261,7 +2429,7 @@ Returns the HV of the specified Perl hash. If C<create> is set and the Perl
variable does not exist then it will be created. If C<create> is not
set and the variable does not exist then NULL is returned.
- HV* perl_get_hv _((char* name, I32 create));
+ HV* perl_get_hv (char* name, I32 create)
=item perl_get_sv
@@ -2269,7 +2437,7 @@ Returns the SV of the specified Perl scalar. If C<create> is set and the
Perl variable does not exist then it will be created. If C<create> is not
set and the variable does not exist then NULL is returned.
- SV* perl_get_sv _((char* name, I32 create));
+ SV* perl_get_sv (char* name, I32 create)
=item perl_parse
@@ -2279,7 +2447,7 @@ Tells a Perl interpreter to parse a Perl script. See L<perlembed>.
Tells Perl to C<require> a module.
- void perl_require_pv _((char* pv));
+ void perl_require_pv (char* pv)
=item perl_run
@@ -2289,31 +2457,31 @@ Tells a Perl interpreter to run. See L<perlembed>.
Pops an integer off the stack.
- int POPi();
+ int POPi()
=item POPl
Pops a long off the stack.
- long POPl();
+ long POPl()
=item POPp
Pops a string off the stack.
- char * POPp();
+ char* POPp()
=item POPn
Pops a double off the stack.
- double POPn();
+ double POPn()
=item POPs
Pops an SV off the stack.
- SV* POPs();
+ SV* POPs()
=item PUSHMARK
@@ -2324,30 +2492,39 @@ Opening bracket for arguments on a callback. See C<PUTBACK> and L<perlcall>.
=item PUSHi
Push an integer onto the stack. The stack must have room for this element.
-See C<XPUSHi>.
+Handles 'set' magic. See C<XPUSHi>.
- PUSHi(int d)
+ void PUSHi(int d)
=item PUSHn
Push a double onto the stack. The stack must have room for this element.
-See C<XPUSHn>.
+Handles 'set' magic. See C<XPUSHn>.
- PUSHn(double d)
+ void PUSHn(double d)
=item PUSHp
Push a string onto the stack. The stack must have room for this element.
-The C<len> indicates the length of the string. See C<XPUSHp>.
+The C<len> indicates the length of the string. Handles 'set' magic. See
+C<XPUSHp>.
- PUSHp(char *c, int len )
+ void PUSHp(char *c, int len )
=item PUSHs
-Push an SV onto the stack. The stack must have room for this element. See
-C<XPUSHs>.
+Push an SV onto the stack. The stack must have room for this element. Does
+not handle 'set' magic. See C<XPUSHs>.
+
+ void PUSHs(sv)
+
+=item PUSHu
+
+Push an unsigned integer onto the stack. The stack must have room for
+this element. See C<XPUSHu>.
+
+ void PUSHu(unsigned int d)
- PUSHs(sv)
=item PUTBACK
@@ -2360,13 +2537,13 @@ See C<PUSHMARK> and L<perlcall> for other uses.
The XSUB-writer's interface to the C C<realloc> function.
- void * Renew( void *ptr, int size, type )
+ void* Renew( void *ptr, int size, type )
=item Renewc
The XSUB-writer's interface to the C C<realloc> function, with cast.
- void * Renewc( void *ptr, int size, type, cast )
+ void* Renewc( void *ptr, int size, type, cast )
=item RETVAL
@@ -2390,14 +2567,14 @@ The XSUB-writer's interface to the C C<realloc> function.
Copy a string to a safe spot. This does not use an SV.
- char* savepv _((char* sv));
+ char* savepv (char* sv)
=item savepvn
Copy a string to a safe spot. The C<len> indicates number of bytes to
copy. This does not use an SV.
- char* savepvn _((char* sv, I32 len));
+ char* savepvn (char* sv, I32 len)
=item SAVETMPS
@@ -2421,68 +2598,68 @@ Refetch the stack pointer. Used after a callback. See L<perlcall>.
Used to access elements on the XSUB's stack.
- SV* ST(int x)
+ SV* ST(int x)
=item strEQ
Test two strings to see if they are equal. Returns true or false.
- int strEQ( char *s1, char *s2 )
+ int strEQ( char *s1, char *s2 )
=item strGE
Test two strings to see if the first, C<s1>, is greater than or equal to the
second, C<s2>. Returns true or false.
- int strGE( char *s1, char *s2 )
+ int strGE( char *s1, char *s2 )
=item strGT
Test two strings to see if the first, C<s1>, is greater than the second,
C<s2>. Returns true or false.
- int strGT( char *s1, char *s2 )
+ int strGT( char *s1, char *s2 )
=item strLE
Test two strings to see if the first, C<s1>, is less than or equal to the
second, C<s2>. Returns true or false.
- int strLE( char *s1, char *s2 )
+ int strLE( char *s1, char *s2 )
=item strLT
Test two strings to see if the first, C<s1>, is less than the second,
C<s2>. Returns true or false.
- int strLT( char *s1, char *s2 )
+ int strLT( char *s1, char *s2 )
=item strNE
Test two strings to see if they are different. Returns true or false.
- int strNE( char *s1, char *s2 )
+ int strNE( char *s1, char *s2 )
=item strnEQ
Test two strings to see if they are equal. The C<len> parameter indicates
the number of bytes to compare. Returns true or false.
- int strnEQ( char *s1, char *s2 )
+ int strnEQ( char *s1, char *s2 )
=item strnNE
Test two strings to see if they are different. The C<len> parameter
indicates the number of bytes to compare. Returns true or false.
- int strnNE( char *s1, char *s2, int len )
+ int strnNE( char *s1, char *s2, int len )
=item sv_2mortal
Marks an SV as mortal. The SV will be destroyed when the current context
ends.
- SV* sv_2mortal _((SV* sv));
+ SV* sv_2mortal (SV* sv)
=item sv_bless
@@ -2490,34 +2667,71 @@ Blesses an SV into a specified package. The SV must be an RV. The package
must be designated by its stash (see C<gv_stashpv()>). The reference count
of the SV is unaffected.
- SV* sv_bless _((SV* sv, HV* stash));
+ SV* sv_bless (SV* sv, HV* stash)
=item sv_catpv
Concatenates the string onto the end of the string which is in the SV.
+Handles 'get' magic, but not 'set' magic. See C<sv_catpv_mg>.
+
+ void sv_catpv (SV* sv, char* ptr)
+
+=item sv_catpv_mg
+
+Like C<sv_catpv>, but also handles 'set' magic.
- void sv_catpv _((SV* sv, char* ptr));
+ void sv_catpv_mg (SV* sv, const char* ptr)
=item sv_catpvn
Concatenates the string onto the end of the string which is in the SV. The
-C<len> indicates number of bytes to copy.
+C<len> indicates number of bytes to copy. Handles 'get' magic, but not
+'set' magic. See C<sv_catpvn_mg>.
- void sv_catpvn _((SV* sv, char* ptr, STRLEN len));
+ void sv_catpvn (SV* sv, char* ptr, STRLEN len)
+
+=item sv_catpvn_mg
+
+Like C<sv_catpvn>, but also handles 'set' magic.
+
+ void sv_catpvn_mg (SV* sv, char* ptr, STRLEN len)
=item sv_catpvf
Processes its arguments like C<sprintf> and appends the formatted output
-to an SV.
+to an SV. Handles 'get' magic, but not 'set' magic. C<SvSETMAGIC()> must
+typically be called after calling this function to handle 'set' magic.
+
+ void sv_catpvf (SV* sv, const char* pat, ...)
- void sv_catpvf _((SV* sv, const char* pat, ...));
+=item sv_catpvf_mg
+
+Like C<sv_catpvf>, but also handles 'set' magic.
+
+ void sv_catpvf_mg (SV* sv, const char* pat, ...)
=item sv_catsv
Concatenates the string from SV C<ssv> onto the end of the string in SV
-C<dsv>.
+C<dsv>. Handles 'get' magic, but not 'set' magic. See C<sv_catsv_mg>.
+
+ void sv_catsv (SV* dsv, SV* ssv)
+
+=item sv_catsv_mg
+
+Like C<sv_catsv>, but also handles 'set' magic.
+
+ void sv_catsv_mg (SV* dsv, SV* ssv)
+
+=item sv_chop
+
+Efficient removal of characters from the beginning of the string
+buffer. SvPOK(sv) must be true and the C<ptr> must be a pointer to
+somewhere inside the string buffer. The C<ptr> becomes the first
+character of the adjusted string.
+
+ void sv_chop(SV* sv, char *ptr)
- void sv_catsv _((SV* dsv, SV* ssv));
=item sv_cmp
@@ -2525,46 +2739,63 @@ Compares the strings in two SVs. Returns -1, 0, or 1 indicating whether the
string in C<sv1> is less than, equal to, or greater than the string in
C<sv2>.
- I32 sv_cmp _((SV* sv1, SV* sv2));
+ I32 sv_cmp (SV* sv1, SV* sv2)
=item SvCUR
Returns the length of the string which is in the SV. See C<SvLEN>.
- int SvCUR (SV* sv)
+ int SvCUR (SV* sv)
=item SvCUR_set
Set the length of the string which is in the SV. See C<SvCUR>.
- SvCUR_set (SV* sv, int val )
+ void SvCUR_set (SV* sv, int val)
=item sv_dec
Auto-decrement of the value in the SV.
- void sv_dec _((SV* sv));
+ void sv_dec (SV* sv)
+
+=item sv_derived_from
+
+Returns a boolean indicating whether the SV is derived from the specified
+class. This is the function that implements C<UNIVERSAL::isa>. It works
+for class names as well as for objects.
+
+ bool sv_derived_from _((SV* sv, char* name));
=item SvEND
Returns a pointer to the last character in the string which is in the SV.
See C<SvCUR>. Access the character as
- *SvEND(sv)
+ char* SvEND(sv)
=item sv_eq
Returns a boolean indicating whether the strings in the two SVs are
identical.
- I32 sv_eq _((SV* sv1, SV* sv2));
+ I32 sv_eq (SV* sv1, SV* sv2)
+
+=item SvGETMAGIC
+
+Invokes C<mg_get> on an SV if it has 'get' magic. This macro evaluates
+its argument more than once.
+
+ void SvGETMAGIC(SV *sv)
=item SvGROW
-Expands the character buffer in the SV. Calls C<sv_grow> to perform the
-expansion if necessary. Returns a pointer to the character buffer.
+Expands the character buffer in the SV so that it has room for the
+indicated number of bytes (remember to reserve space for an extra
+trailing NUL character). Calls C<sv_grow> to perform the expansion if
+necessary. Returns a pointer to the character buffer.
- char * SvGROW( SV* sv, int len )
+ char* SvGROW(SV* sv, STRLEN len)
=item sv_grow
@@ -2576,52 +2807,54 @@ Use C<SvGROW>.
Auto-increment of the value in the SV.
- void sv_inc _((SV* sv));
+ void sv_inc (SV* sv)
+
+=item sv_insert
+
+Inserts a string at the specified offset/length within the SV.
+Similar to the Perl substr() function.
+
+ void sv_insert(SV *sv, STRLEN offset, STRLEN len,
+ char *str, STRLEN strlen)
=item SvIOK
Returns a boolean indicating whether the SV contains an integer.
- int SvIOK (SV* SV)
+ int SvIOK (SV* SV)
=item SvIOK_off
Unsets the IV status of an SV.
- SvIOK_off (SV* sv)
+ void SvIOK_off (SV* sv)
=item SvIOK_on
Tells an SV that it is an integer.
- SvIOK_on (SV* sv)
+ void SvIOK_on (SV* sv)
=item SvIOK_only
Tells an SV that it is an integer and disables all other OK bits.
- SvIOK_on (SV* sv)
+ void SvIOK_only (SV* sv)
=item SvIOKp
Returns a boolean indicating whether the SV contains an integer. Checks the
B<private> setting. Use C<SvIOK>.
- int SvIOKp (SV* SV)
+ int SvIOKp (SV* SV)
=item sv_isa
Returns a boolean indicating whether the SV is blessed into the specified
-class. This does not know how to check for subtype, so it doesn't work in
+class. This does not check for subtypes; use C<sv_derived_from> to verify
an inheritance relationship.
- int sv_isa _((SV* sv, char* name));
-
-=item SvIV
-
-Returns the integer which is in the SV.
-
- int SvIV (SV* sv)
+ int sv_isa (SV* sv, char* name)
=item sv_isobject
@@ -2629,265 +2862,310 @@ Returns a boolean indicating whether the SV is an RV pointing to a blessed
object. If the SV is not an RV, or if the object is not blessed, then this
will return false.
- int sv_isobject _((SV* sv));
+ int sv_isobject (SV* sv)
+
+=item SvIV
+
+Coerces the given SV to an integer and returns it.
+
+ int SvIV (SV* sv)
=item SvIVX
-Returns the integer which is stored in the SV.
+Returns the integer which is stored in the SV, assuming SvIOK is true.
- int SvIVX (SV* sv);
+ int SvIVX (SV* sv)
=item SvLEN
Returns the size of the string buffer in the SV. See C<SvCUR>.
- int SvLEN (SV* sv)
+ int SvLEN (SV* sv)
=item sv_len
Returns the length of the string in the SV. Use C<SvCUR>.
- STRLEN sv_len _((SV* sv));
+ STRLEN sv_len (SV* sv)
=item sv_magic
Adds magic to an SV.
- void sv_magic _((SV* sv, SV* obj, int how, char* name, I32 namlen));
+ void sv_magic (SV* sv, SV* obj, int how, char* name, I32 namlen)
=item sv_mortalcopy
Creates a new SV which is a copy of the original SV. The new SV is marked
as mortal.
- SV* sv_mortalcopy _((SV* oldsv));
-
-=item SvOK
-
-Returns a boolean indicating whether the value is an SV.
-
- int SvOK (SV* sv)
+ SV* sv_mortalcopy (SV* oldsv)
=item sv_newmortal
Creates a new SV which is mortal. The reference count of the SV is set to 1.
- SV* sv_newmortal _((void));
-
-=item sv_no
-
-This is the C<false> SV. See C<sv_yes>. Always refer to this as C<&sv_no>.
+ SV* sv_newmortal (void)
=item SvNIOK
Returns a boolean indicating whether the SV contains a number, integer or
double.
- int SvNIOK (SV* SV)
+ int SvNIOK (SV* SV)
=item SvNIOK_off
Unsets the NV/IV status of an SV.
- SvNIOK_off (SV* sv)
+ void SvNIOK_off (SV* sv)
=item SvNIOKp
Returns a boolean indicating whether the SV contains a number, integer or
double. Checks the B<private> setting. Use C<SvNIOK>.
- int SvNIOKp (SV* SV)
+ int SvNIOKp (SV* SV)
+
+=item PL_sv_no
+
+This is the C<false> SV. See C<PL_sv_yes>. Always refer to this as C<&PL_sv_no>.
=item SvNOK
Returns a boolean indicating whether the SV contains a double.
- int SvNOK (SV* SV)
+ int SvNOK (SV* SV)
=item SvNOK_off
Unsets the NV status of an SV.
- SvNOK_off (SV* sv)
+ void SvNOK_off (SV* sv)
=item SvNOK_on
Tells an SV that it is a double.
- SvNOK_on (SV* sv)
+ void SvNOK_on (SV* sv)
=item SvNOK_only
Tells an SV that it is a double and disables all other OK bits.
- SvNOK_on (SV* sv)
+ void SvNOK_only (SV* sv)
=item SvNOKp
Returns a boolean indicating whether the SV contains a double. Checks the
B<private> setting. Use C<SvNOK>.
- int SvNOKp (SV* SV)
+ int SvNOKp (SV* SV)
=item SvNV
-Returns the double which is stored in the SV.
+Coerce the given SV to a double and return it.
- double SvNV (SV* sv);
+ double SvNV (SV* sv)
=item SvNVX
-Returns the double which is stored in the SV.
+Returns the double which is stored in the SV, assuming SvNOK is true.
- double SvNVX (SV* sv);
+ double SvNVX (SV* sv)
+
+=item SvOK
+
+Returns a boolean indicating whether the value is an SV.
+
+ int SvOK (SV* sv)
+
+=item SvOOK
+
+Returns a boolean indicating whether the SvIVX is a valid offset value
+for the SvPVX. This hack is used internally to speed up removal of
+characters from the beginning of a SvPV. When SvOOK is true, then the
+start of the allocated string buffer is really (SvPVX - SvIVX).
+
+ int SvOOK(SV* sv)
=item SvPOK
Returns a boolean indicating whether the SV contains a character string.
- int SvPOK (SV* SV)
+ int SvPOK (SV* SV)
=item SvPOK_off
Unsets the PV status of an SV.
- SvPOK_off (SV* sv)
+ void SvPOK_off (SV* sv)
=item SvPOK_on
Tells an SV that it is a string.
- SvPOK_on (SV* sv)
+ void SvPOK_on (SV* sv)
=item SvPOK_only
Tells an SV that it is a string and disables all other OK bits.
- SvPOK_on (SV* sv)
+ void SvPOK_only (SV* sv)
=item SvPOKp
Returns a boolean indicating whether the SV contains a character string.
Checks the B<private> setting. Use C<SvPOK>.
- int SvPOKp (SV* SV)
+ int SvPOKp (SV* SV)
=item SvPV
Returns a pointer to the string in the SV, or a stringified form of the SV
-if the SV does not contain a string. If C<len> is C<na> then Perl will
-handle the length on its own.
+if the SV does not contain a string. Handles 'get' magic.
- char * SvPV (SV* sv, int len )
+ char* SvPV (SV* sv, STRLEN len)
+
+=item SvPV_force
+
+Like <SvPV> but will force the SV into becoming a string (SvPOK). You
+want force if you are going to update the SvPVX directly.
+
+ char* SvPV_force(SV* sv, STRLEN len)
=item SvPVX
Returns a pointer to the string in the SV. The SV must contain a string.
- char * SvPVX (SV* sv)
+ char* SvPVX (SV* sv)
=item SvREFCNT
Returns the value of the object's reference count.
- int SvREFCNT (SV* sv);
+ int SvREFCNT (SV* sv)
=item SvREFCNT_dec
Decrements the reference count of the given SV.
- void SvREFCNT_dec (SV* sv)
+ void SvREFCNT_dec (SV* sv)
=item SvREFCNT_inc
Increments the reference count of the given SV.
- void SvREFCNT_inc (SV* sv)
+ void SvREFCNT_inc (SV* sv)
=item SvROK
Tests if the SV is an RV.
- int SvROK (SV* sv)
+ int SvROK (SV* sv)
=item SvROK_off
Unsets the RV status of an SV.
- SvROK_off (SV* sv)
+ void SvROK_off (SV* sv)
=item SvROK_on
Tells an SV that it is an RV.
- SvROK_on (SV* sv)
+ void SvROK_on (SV* sv)
=item SvRV
Dereferences an RV to return the SV.
- SV* SvRV (SV* sv);
+ SV* SvRV (SV* sv)
-=item SvTAINT
+=item SvSETMAGIC
-Taints an SV if tainting is enabled
+Invokes C<mg_set> on an SV if it has 'set' magic. This macro evaluates
+its argument more than once.
- SvTAINT (SV* sv);
+ void SvSETMAGIC( SV *sv )
-=item SvTAINTED
+=item sv_setiv
-Checks to see if an SV is tainted. Returns TRUE if it is, FALSE if not.
+Copies an integer into the given SV. Does not handle 'set' magic.
+See C<sv_setiv_mg>.
- SvTAINTED (SV* sv);
+ void sv_setiv (SV* sv, IV num)
-=item SvTAINTED_off
+=item sv_setiv_mg
-Untaints an SV. Be I<very> careful with this routine, as it short-circuits
-some of Perl's fundamental security features. XS module authors should
-not use this function unless they fully understand all the implications
-of unconditionally untainting the value. Untainting should be done in
-the standard perl fashion, via a carefully crafted regexp, rather than
-directly untainting variables.
+Like C<sv_setiv>, but also handles 'set' magic.
- SvTAINTED_off (SV* sv);
+ void sv_setiv_mg (SV* sv, IV num)
-=item SvTAINTED_on
+=item sv_setnv
-Marks an SV as tainted.
+Copies a double into the given SV. Does not handle 'set' magic.
+See C<sv_setnv_mg>.
- SvTAINTED_on (SV* sv);
+ void sv_setnv (SV* sv, double num)
-=item sv_setiv
+=item sv_setnv_mg
-Copies an integer into the given SV.
+Like C<sv_setnv>, but also handles 'set' magic.
- void sv_setiv _((SV* sv, IV num));
+ void sv_setnv_mg (SV* sv, double num)
-=item sv_setnv
+=item sv_setpv
-Copies a double into the given SV.
+Copies a string into an SV. The string must be null-terminated.
+Does not handle 'set' magic. See C<sv_setpv_mg>.
- void sv_setnv _((SV* sv, double num));
+ void sv_setpv (SV* sv, const char* ptr)
-=item sv_setpv
+=item sv_setpv_mg
-Copies a string into an SV. The string must be null-terminated.
+Like C<sv_setpv>, but also handles 'set' magic.
+
+ void sv_setpv_mg (SV* sv, const char* ptr)
+
+=item sv_setpviv
+
+Copies an integer into the given SV, also updating its string value.
+Does not handle 'set' magic. See C<sv_setpviv_mg>.
- void sv_setpv _((SV* sv, char* ptr));
+ void sv_setpviv (SV* sv, IV num)
+
+=item sv_setpviv_mg
+
+Like C<sv_setpviv>, but also handles 'set' magic.
+
+ void sv_setpviv_mg (SV* sv, IV num)
=item sv_setpvn
Copies a string into an SV. The C<len> parameter indicates the number of
-bytes to be copied.
+bytes to be copied. Does not handle 'set' magic. See C<sv_setpvn_mg>.
+
+ void sv_setpvn (SV* sv, const char* ptr, STRLEN len)
- void sv_setpvn _((SV* sv, char* ptr, STRLEN len));
+=item sv_setpvn_mg
+
+Like C<sv_setpvn>, but also handles 'set' magic.
+
+ void sv_setpvn_mg (SV* sv, const char* ptr, STRLEN len)
=item sv_setpvf
Processes its arguments like C<sprintf> and sets an SV to the formatted
-output.
+output. Does not handle 'set' magic. See C<sv_setpvf_mg>.
+
+ void sv_setpvf (SV* sv, const char* pat, ...)
+
+=item sv_setpvf_mg
- void sv_setpvf _((SV* sv, const char* pat, ...));
+Like C<sv_setpvf>, but also handles 'set' magic.
+
+ void sv_setpvf_mg (SV* sv, const char* pat, ...)
=item sv_setref_iv
@@ -2897,7 +3175,7 @@ the new SV. The C<classname> argument indicates the package for the
blessing. Set C<classname> to C<Nullch> to avoid the blessing. The new SV
will be returned and will have a reference count of 1.
- SV* sv_setref_iv _((SV *rv, char *classname, IV iv));
+ SV* sv_setref_iv (SV *rv, char *classname, IV iv)
=item sv_setref_nv
@@ -2907,18 +3185,18 @@ the new SV. The C<classname> argument indicates the package for the
blessing. Set C<classname> to C<Nullch> to avoid the blessing. The new SV
will be returned and will have a reference count of 1.
- SV* sv_setref_nv _((SV *rv, char *classname, double nv));
+ SV* sv_setref_nv (SV *rv, char *classname, double nv)
=item sv_setref_pv
Copies a pointer into a new SV, optionally blessing the SV. The C<rv>
argument will be upgraded to an RV. That RV will be modified to point to
-the new SV. If the C<pv> argument is NULL then C<sv_undef> will be placed
+the new SV. If the C<pv> argument is NULL then C<PL_sv_undef> will be placed
into the SV. The C<classname> argument indicates the package for the
blessing. Set C<classname> to C<Nullch> to avoid the blessing. The new SV
will be returned and will have a reference count of 1.
- SV* sv_setref_pv _((SV *rv, char *classname, void* pv));
+ SV* sv_setref_pv (SV *rv, char *classname, void* pv)
Do not use with integral Perl types such as HV, AV, SV, CV, because those
objects will become corrupted by the pointer copy process.
@@ -2934,22 +3212,85 @@ argument indicates the package for the blessing. Set C<classname> to
C<Nullch> to avoid the blessing. The new SV will be returned and will have
a reference count of 1.
- SV* sv_setref_pvn _((SV *rv, char *classname, char* pv, I32 n));
+ SV* sv_setref_pvn (SV *rv, char *classname, char* pv, I32 n)
Note that C<sv_setref_pv> copies the pointer while this copies the string.
+=item SvSetSV
+
+Calls C<sv_setsv> if dsv is not the same as ssv. May evaluate arguments
+more than once.
+
+ void SvSetSV (SV* dsv, SV* ssv)
+
+=item SvSetSV_nosteal
+
+Calls a non-destructive version of C<sv_setsv> if dsv is not the same as ssv.
+May evaluate arguments more than once.
+
+ void SvSetSV_nosteal (SV* dsv, SV* ssv)
+
=item sv_setsv
Copies the contents of the source SV C<ssv> into the destination SV C<dsv>.
-The source SV may be destroyed if it is mortal.
+The source SV may be destroyed if it is mortal. Does not handle 'set' magic.
+See the macro forms C<SvSetSV>, C<SvSetSV_nosteal> and C<sv_setsv_mg>.
+
+ void sv_setsv (SV* dsv, SV* ssv)
+
+=item sv_setsv_mg
+
+Like C<sv_setsv>, but also handles 'set' magic.
+
+ void sv_setsv_mg (SV* dsv, SV* ssv)
- void sv_setsv _((SV* dsv, SV* ssv));
+=item sv_setuv
+
+Copies an unsigned integer into the given SV. Does not handle 'set' magic.
+See C<sv_setuv_mg>.
+
+ void sv_setuv (SV* sv, UV num)
+
+=item sv_setuv_mg
+
+Like C<sv_setuv>, but also handles 'set' magic.
+
+ void sv_setuv_mg (SV* sv, UV num)
=item SvSTASH
Returns the stash of the SV.
- HV * SvSTASH (SV* sv)
+ HV* SvSTASH (SV* sv)
+
+=item SvTAINT
+
+Taints an SV if tainting is enabled
+
+ void SvTAINT (SV* sv)
+
+=item SvTAINTED
+
+Checks to see if an SV is tainted. Returns TRUE if it is, FALSE if not.
+
+ int SvTAINTED (SV* sv)
+
+=item SvTAINTED_off
+
+Untaints an SV. Be I<very> careful with this routine, as it short-circuits
+some of Perl's fundamental security features. XS module authors should
+not use this function unless they fully understand all the implications
+of unconditionally untainting the value. Untainting should be done in
+the standard perl fashion, via a carefully crafted regexp, rather than
+directly untainting variables.
+
+ void SvTAINTED_off (SV* sv)
+
+=item SvTAINTED_on
+
+Marks an SV as tainted.
+
+ void SvTAINTED_on (SV* sv)
=item SVt_IV
@@ -2982,9 +3323,9 @@ Double type flag for scalars. See C<svtype>.
=item SvTRUE
Returns a boolean indicating whether Perl would evaluate the SV as true or
-false, defined or undefined.
+false, defined or undefined. Does not handle 'get' magic.
- int SvTRUE (SV* sv)
+ int SvTRUE (SV* sv)
=item SvTYPE
@@ -2997,28 +3338,28 @@ Returns the type of the SV. See C<svtype>.
An enum of flags for Perl types. These are found in the file B<sv.h> in the
C<svtype> enum. Test these flags with the C<SvTYPE> macro.
-=item SvUPGRADE
+=item PL_sv_undef
-Used to upgrade an SV to a more complex form. Uses C<sv_upgrade> to perform
-the upgrade if necessary. See C<svtype>.
+This is the C<undef> SV. Always refer to this as C<&PL_sv_undef>.
- bool SvUPGRADE _((SV* sv, svtype mt));
+=item sv_unref
-=item sv_upgrade
+Unsets the RV status of the SV, and decrements the reference count of
+whatever was being referenced by the RV. This can almost be thought of
+as a reversal of C<newSVrv>. See C<SvROK_off>.
-Upgrade an SV to a more complex form. Use C<SvUPGRADE>. See C<svtype>.
+ void sv_unref (SV* sv)
-=item sv_undef
+=item SvUPGRADE
-This is the C<undef> SV. Always refer to this as C<&sv_undef>.
+Used to upgrade an SV to a more complex form. Uses C<sv_upgrade> to perform
+the upgrade if necessary. See C<svtype>.
-=item sv_unref
+ bool SvUPGRADE (SV* sv, svtype mt)
-Unsets the RV status of the SV, and decrements the reference count of
-whatever was being referenced by the RV. This can almost be thought of
-as a reversal of C<newSVrv>. See C<SvROK_off>.
+=item sv_upgrade
- void sv_unref _((SV* sv));
+Upgrade an SV to a more complex form. Use C<SvUPGRADE>. See C<svtype>.
=item sv_usepvn
@@ -3027,13 +3368,51 @@ stored inside the SV but sv_usepvn allows the SV to use an outside string.
The C<ptr> should point to memory that was allocated by C<malloc>. The
string length, C<len>, must be supplied. This function will realloc the
memory pointed to by C<ptr>, so that pointer should not be freed or used by
-the programmer after giving it to sv_usepvn.
+the programmer after giving it to sv_usepvn. Does not handle 'set' magic.
+See C<sv_usepvn_mg>.
+
+ void sv_usepvn (SV* sv, char* ptr, STRLEN len)
+
+=item sv_usepvn_mg
+
+Like C<sv_usepvn>, but also handles 'set' magic.
+
+ void sv_usepvn_mg (SV* sv, char* ptr, STRLEN len)
- void sv_usepvn _((SV* sv, char* ptr, STRLEN len));
+=item sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
-=item sv_yes
+Processes its arguments like C<vsprintf> and appends the formatted output
+to an SV. Uses an array of SVs if the C style variable argument list is
+missing (NULL). Indicates if locale information has been used for formatting.
-This is the C<true> SV. See C<sv_no>. Always refer to this as C<&sv_yes>.
+ void sv_catpvfn _((SV* sv, const char* pat, STRLEN patlen,
+ va_list *args, SV **svargs, I32 svmax,
+ bool *used_locale));
+
+=item sv_vsetpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
+
+Works like C<vcatpvfn> but copies the text into the SV instead of
+appending it.
+
+ void sv_setpvfn _((SV* sv, const char* pat, STRLEN patlen,
+ va_list *args, SV **svargs, I32 svmax,
+ bool *used_locale));
+
+=item SvUV
+
+Coerces the given SV to an unsigned integer and returns it.
+
+ UV SvUV(SV* sv)
+
+=item SvUVX
+
+Returns the unsigned integer which is stored in the SV, assuming SvIOK is true.
+
+ UV SvUVX(SV* sv)
+
+=item PL_sv_yes
+
+This is the C<true> SV. See C<PL_sv_no>. Always refer to this as C<&PL_sv_yes>.
=item THIS
@@ -3045,13 +3424,13 @@ L<perlxs/"Using XS With C++">.
Converts the specified character to lowercase.
- int toLOWER (char c)
+ int toLOWER (char c)
=item toUPPER
Converts the specified character to uppercase.
- int toUPPER (char c)
+ int toUPPER (char c)
=item warn
@@ -3060,31 +3439,37 @@ function the same way you use the C C<printf> function. See C<croak()>.
=item XPUSHi
-Push an integer onto the stack, extending the stack if necessary. See
-C<PUSHi>.
+Push an integer onto the stack, extending the stack if necessary. Handles
+'set' magic. See C<PUSHi>.
XPUSHi(int d)
=item XPUSHn
-Push a double onto the stack, extending the stack if necessary. See
-C<PUSHn>.
+Push a double onto the stack, extending the stack if necessary. Handles 'set'
+magic. See C<PUSHn>.
XPUSHn(double d)
=item XPUSHp
Push a string onto the stack, extending the stack if necessary. The C<len>
-indicates the length of the string. See C<PUSHp>.
+indicates the length of the string. Handles 'set' magic. See C<PUSHp>.
XPUSHp(char *c, int len)
=item XPUSHs
-Push an SV onto the stack, extending the stack if necessary. See C<PUSHs>.
+Push an SV onto the stack, extending the stack if necessary. Does not
+handle 'set' magic. See C<PUSHs>.
XPUSHs(sv)
+=item XPUSHu
+
+Push an unsigned integer onto the stack, extending the stack if
+necessary. See C<PUSHu>.
+
=item XS
Macro to declare an XSUB and its C parameter list. This is handled by
@@ -3095,7 +3480,7 @@ C<xsubpp>.
Return from XSUB, indicating number of items on the stack. This is usually
handled by C<xsubpp>.
- XSRETURN(int x);
+ XSRETURN(int x)
=item XSRETURN_EMPTY
@@ -3107,11 +3492,11 @@ Return an empty list from an XSUB immediately.
Return an integer from an XSUB immediately. Uses C<XST_mIV>.
- XSRETURN_IV(IV v);
+ XSRETURN_IV(IV v)
=item XSRETURN_NO
-Return C<&sv_no> from an XSUB immediately. Uses C<XST_mNO>.
+Return C<&PL_sv_no> from an XSUB immediately. Uses C<XST_mNO>.
XSRETURN_NO;
@@ -3119,23 +3504,23 @@ Return C<&sv_no> from an XSUB immediately. Uses C<XST_mNO>.
Return an double from an XSUB immediately. Uses C<XST_mNV>.
- XSRETURN_NV(NV v);
+ XSRETURN_NV(NV v)
=item XSRETURN_PV
Return a copy of a string from an XSUB immediately. Uses C<XST_mPV>.
- XSRETURN_PV(char *v);
+ XSRETURN_PV(char *v)
=item XSRETURN_UNDEF
-Return C<&sv_undef> from an XSUB immediately. Uses C<XST_mUNDEF>.
+Return C<&PL_sv_undef> from an XSUB immediately. Uses C<XST_mUNDEF>.
XSRETURN_UNDEF;
=item XSRETURN_YES
-Return C<&sv_yes> from an XSUB immediately. Uses C<XST_mYES>.
+Return C<&PL_sv_yes> from an XSUB immediately. Uses C<XST_mYES>.
XSRETURN_YES;
@@ -3144,39 +3529,39 @@ Return C<&sv_yes> from an XSUB immediately. Uses C<XST_mYES>.
Place an integer into the specified position C<i> on the stack. The value is
stored in a new mortal SV.
- XST_mIV( int i, IV v );
+ XST_mIV( int i, IV v )
=item XST_mNV
Place a double into the specified position C<i> on the stack. The value is
stored in a new mortal SV.
- XST_mNV( int i, NV v );
+ XST_mNV( int i, NV v )
=item XST_mNO
-Place C<&sv_no> into the specified position C<i> on the stack.
+Place C<&PL_sv_no> into the specified position C<i> on the stack.
- XST_mNO( int i );
+ XST_mNO( int i )
=item XST_mPV
Place a copy of a string into the specified position C<i> on the stack. The
value is stored in a new mortal SV.
- XST_mPV( int i, char *v );
+ XST_mPV( int i, char *v )
=item XST_mUNDEF
-Place C<&sv_undef> into the specified position C<i> on the stack.
+Place C<&PL_sv_undef> into the specified position C<i> on the stack.
- XST_mUNDEF( int i );
+ XST_mUNDEF( int i )
=item XST_mYES
-Place C<&sv_yes> into the specified position C<i> on the stack.
+Place C<&PL_sv_yes> into the specified position C<i> on the stack.
- XST_mYES( int i );
+ XST_mYES( int i )
=item XS_VERSION
@@ -3194,21 +3579,18 @@ C<xsubpp>. See L<perlxs/"The VERSIONCHECK: Keyword">.
The XSUB-writer's interface to the C C<memzero> function. The C<d> is the
destination, C<n> is the number of items, and C<t> is the type.
- (void) Zero( d, n, t );
+ void Zero( d, n, t )
=back
-=head1 EDITOR
+=head1 AUTHORS
-Jeff Okamoto <F<okamoto@corp.hp.com>>
+Until May 1997, this document was maintained by Jeff Okamoto
+<okamoto@corp.hp.com>. It is now maintained as part of Perl itself.
With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
-Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer, and
-Stephen McCamant.
-
-API Listing by Dean Roehrich <F<roehrich@cray.com>>.
-
-=head1 DATE
+Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer,
+Stephen McCamant, and Gurusamy Sarathy.
-Version 31.8: 1997/5/17
+API Listing originally by Dean Roehrich <roehrich@cray.com>.
diff --git a/gnu/usr.bin/perl/pod/perlipc.pod b/gnu/usr.bin/perl/pod/perlipc.pod
index 030463c7a01..2f99d10e232 100644
--- a/gnu/usr.bin/perl/pod/perlipc.pod
+++ b/gnu/usr.bin/perl/pod/perlipc.pod
@@ -56,7 +56,17 @@ So to check whether signal 17 and SIGALRM were the same, do just this:
You may also choose to assign the strings C<'IGNORE'> or C<'DEFAULT'> as
the handler, in which case Perl will try to discard the signal or do the
-default thing. Some signals can be neither trapped nor ignored, such as
+default thing.
+
+On most UNIX platforms, the C<CHLD> (sometimes also known as C<CLD>) signal
+has special behavior with respect to a value of C<'IGNORE'>.
+Setting C<$SIG{CHLD}> to C<'IGNORE'> on such a platform has the effect of
+not creating zombie processes when the parent process fails to C<wait()>
+on its child processes (i.e. child processes are automatically reaped).
+Calling C<wait()> with C<$SIG{CHLD}> set to C<'IGNORE'> usually returns
+C<-1> on such platforms.
+
+Some signals can be neither trapped nor ignored, such as
the KILL and STOP (but not the TSTP) signals. One strategy for
temporarily ignoring signals is to use a local() statement, which will be
automatically restored once your block is exited. (Remember that local()
@@ -163,7 +173,7 @@ systems, mkfifo(1). These may not be in your normal path.
if ( system('mknod', $path, 'p')
&& system('mkfifo', $path) )
{
- die "mk{nod,fifo} $path failed;
+ die "mk{nod,fifo} $path failed";
}
@@ -196,6 +206,33 @@ to find out whether anyone (or anything) has accidentally removed our fifo.
sleep 2; # to avoid dup signals
}
+=head2 WARNING
+
+By installing Perl code to deal with signals, you're exposing yourself
+to danger from two things. First, few system library functions are
+re-entrant. If the signal interrupts while Perl is executing one function
+(like malloc(3) or printf(3)), and your signal handler then calls the
+same function again, you could get unpredictable behavior--often, a
+core dump. Second, Perl isn't itself re-entrant at the lowest levels.
+If the signal interrupts Perl while Perl is changing its own internal
+data structures, similarly unpredictable behaviour may result.
+
+There are two things you can do, knowing this: be paranoid or be
+pragmatic. The paranoid approach is to do as little as possible in your
+signal handler. Set an existing integer variable that already has a
+value, and return. This doesn't help you if you're in a slow system call,
+which will just restart. That means you have to C<die> to longjump(3) out
+of the handler. Even this is a little cavalier for the true paranoiac,
+who avoids C<die> in a handler because the system I<is> out to get you.
+The pragmatic approach is to say ``I know the risks, but prefer the
+convenience'', and to do anything you want in your signal handler,
+prepared to clean up core dumps now and again.
+
+To forbid signal handlers altogether would bars you from
+many interesting programs, including virtually everything in this manpage,
+since you could no longer even write SIGCHLD handlers. Their dodginess
+is expected to be addresses in the 5.005 release.
+
=head1 Using open() for IPC
@@ -224,7 +261,7 @@ If one can be sure that a particular program is a Perl script that is
expecting filenames in @ARGV, the clever programmer can write something
like this:
- $ program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile
+ % program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile
and irrespective of which shell it's called from, the Perl program will
read from the file F<f1>, the process F<cmd1>, standard input (F<tmpfile>
@@ -254,18 +291,27 @@ while readers of bogus commands return just a quick end of file, writers
to bogus command will trigger a signal they'd better be prepared to
handle. Consider:
- open(FH, "|bogus");
- print FH "bang\n";
- close FH;
+ open(FH, "|bogus") or die "can't fork: $!";
+ print FH "bang\n" or die "can't write: $!";
+ close FH or die "can't close: $!";
+
+That won't blow up until the close, and it will blow up with a SIGPIPE.
+To catch it, you could use this:
+
+ $SIG{PIPE} = 'IGNORE';
+ open(FH, "|bogus") or die "can't fork: $!";
+ print FH "bang\n" or die "can't write: $!";
+ close FH or die "can't close: status=$?";
=head2 Filehandles
-Both the main process and the child process share the same STDIN,
-STDOUT and STDERR filehandles. If both processes try to access them
-at once, strange things can happen. You may want to close or reopen
-the filehandles for the child. You can get around this by opening
-your pipe with open(), but on some systems this means that the child
-process cannot outlive the parent.
+Both the main process and any child processes it forks share the same
+STDIN, STDOUT, and STDERR filehandles. If both processes try to access
+them at once, strange things can happen. You'll certainly want to any
+stdio flush output buffers before forking. You may also want to close
+or reopen the filehandles for the child. You can get around this by
+opening your pipe with open(), but on some systems this means that the
+child process cannot outlive the parent.
=head2 Background Processes
@@ -281,33 +327,33 @@ details).
=head2 Complete Dissociation of Child from Parent
In some cases (starting server processes, for instance) you'll want to
-complete dissociate the child process from the parent. The following
-process is reported to work on most Unixish systems. Non-Unix users
-should check their Your_OS::Process module for other solutions.
-
-=over 4
-
-=item *
-
-Open /dev/tty and use the TIOCNOTTY ioctl on it. See L<tty(4)>
-for details.
-
-=item *
-
-Change directory to /
-
-=item *
-
-Reopen STDIN, STDOUT, and STDERR so they're not connected to the old
-tty.
-
-=item *
-
-Background yourself like this:
+completely dissociate the child process from the parent. This is
+often called daemonization. A well behaved daemon will also chdir()
+to the root directory (so it doesn't prevent unmounting the filesystem
+containing the directory from which it was launched) and redirect its
+standard file descriptors from and to F</dev/null> (so that random
+output doesn't wind up on the user's terminal).
+
+ use POSIX 'setsid';
+
+ sub daemonize {
+ chdir '/' or die "Can't chdir to /: $!";
+ open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
+ open STDOUT, '>/dev/null'
+ or die "Can't write to /dev/null: $!";
+ defined(my $pid = fork) or die "Can't fork: $!";
+ exit if $pid;
+ setsid or die "Can't start a new session: $!";
+ open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
+ }
- fork && exit;
+The fork() has to come before the setsid() to ensure that you aren't a
+process group leader (the setsid() will fail if you are). If your
+system doesn't have the setsid() function, open F</dev/tty> and use the
+C<TIOCNOTTY> ioctl() on it instead. See L<tty(4)> for details.
-=back
+Non-Unix users should check their Your_OS::Process module for other
+solutions.
=head2 Safe Pipe Opens
@@ -416,7 +462,7 @@ awkward select() loop and wouldn't allow you to use normal Perl input
operations.
If you look at its source, you'll see that open2() uses low-level
-primitives like Unix pipe() and exec() to create all the connections.
+primitives like Unix pipe() and exec() calls to create all the connections.
While it might have been slightly more efficient by using socketpair(), it
would have then been even less portable than it already is. The open2()
and open3() functions are unlikely to work anywhere except on a Unix
@@ -426,7 +472,7 @@ Here's an example of using open2():
use FileHandle;
use IPC::Open2;
- $pid = open2( \*Reader, \*Writer, "cat -u -n" );
+ $pid = open2(*Reader, *Writer, "cat -u -n" );
Writer->autoflush(); # default here, actually
print Writer "stuff\n";
$got = <Reader>;
@@ -457,6 +503,80 @@ and interact() functions. Find the library (and we hope its
successor F<IPC::Chat>) at your nearest CPAN archive as detailed
in the SEE ALSO section below.
+The newer Expect.pm module from CPAN also addresses this kind of thing.
+This module requires two other modules from CPAN: IO::Pty and IO::Stty.
+It sets up a pseudo-terminal to interact with programs that insist on
+using talking to the terminal device driver. If your system is
+amongst those supported, this may be your best bet.
+
+=head2 Bidirectional Communication with Yourself
+
+If you want, you may make low-level pipe() and fork()
+to stitch this together by hand. This example only
+talks to itself, but you could reopen the appropriate
+handles to STDIN and STDOUT and call other processes.
+
+ #!/usr/bin/perl -w
+ # pipe1 - bidirectional communication using two pipe pairs
+ # designed for the socketpair-challenged
+ use IO::Handle; # thousands of lines just for autoflush :-(
+ pipe(PARENT_RDR, CHILD_WTR); # XXX: failure?
+ pipe(CHILD_RDR, PARENT_WTR); # XXX: failure?
+ CHILD_WTR->autoflush(1);
+ PARENT_WTR->autoflush(1);
+
+ if ($pid = fork) {
+ close PARENT_RDR; close PARENT_WTR;
+ print CHILD_WTR "Parent Pid $$ is sending this\n";
+ chomp($line = <CHILD_RDR>);
+ print "Parent Pid $$ just read this: `$line'\n";
+ close CHILD_RDR; close CHILD_WTR;
+ waitpid($pid,0);
+ } else {
+ die "cannot fork: $!" unless defined $pid;
+ close CHILD_RDR; close CHILD_WTR;
+ chomp($line = <PARENT_RDR>);
+ print "Child Pid $$ just read this: `$line'\n";
+ print PARENT_WTR "Child Pid $$ is sending this\n";
+ close PARENT_RDR; close PARENT_WTR;
+ exit;
+ }
+
+But you don't actually have to make two pipe calls. If you
+have the socketpair() system call, it will do this all for you.
+
+ #!/usr/bin/perl -w
+ # pipe2 - bidirectional communication using socketpair
+ # "the best ones always go both ways"
+
+ use Socket;
+ use IO::Handle; # thousands of lines just for autoflush :-(
+ # We say AF_UNIX because although *_LOCAL is the
+ # POSIX 1003.1g form of the constant, many machines
+ # still don't have it.
+ socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
+ or die "socketpair: $!";
+
+ CHILD->autoflush(1);
+ PARENT->autoflush(1);
+
+ if ($pid = fork) {
+ close PARENT;
+ print CHILD "Parent Pid $$ is sending this\n";
+ chomp($line = <CHILD>);
+ print "Parent Pid $$ just read this: `$line'\n";
+ close CHILD;
+ waitpid($pid,0);
+ } else {
+ die "cannot fork: $!" unless defined $pid;
+ close CHILD;
+ chomp($line = <PARENT>);
+ print "Child Pid $$ just read this: `$line'\n";
+ print PARENT "Child Pid $$ is sending this\n";
+ close PARENT;
+ exit;
+ }
+
=head1 Sockets: Client/Server Communication
While not limited to Unix-derived operating systems (e.g., WinSock on PCs
@@ -487,6 +607,17 @@ knows the other has finished when a "\n" is received) or multi-line
messages and responses that end with a period on an empty line
("\n.\n" terminates a message/response).
+=head2 Internet Line Terminators
+
+The Internet line terminator is "\015\012". Under ASCII variants of
+Unix, that could usually be written as "\r\n", but under other systems,
+"\r\n" might at times be "\015\015\012", "\012\012\015", or something
+completely different. The standards specify writing "\015\012" to be
+conformant (be strict in what you provide), but they also recommend
+accepting a lone "\012" on input (but be lenient in what you require).
+We haven't always been very good about that in the code in this manpage,
+but unless you're on a Mac, you'll probably be ok.
+
=head2 Internet TCP Clients and Servers
Use Internet-domain sockets when you want to do client-server
@@ -495,7 +626,6 @@ communication that might extend to machines outside of your own system.
Here's a sample TCP client using Internet-domain sockets:
#!/usr/bin/perl -w
- require 5.002;
use strict;
use Socket;
my ($remote,$port, $iaddr, $paddr, $proto, $line);
@@ -525,11 +655,11 @@ or firewall machine), you should fill this in with your real address
instead.
#!/usr/bin/perl -Tw
- require 5.002;
use strict;
BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
use Socket;
use Carp;
+ $EOL = "\015\012";
sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
@@ -558,7 +688,7 @@ instead.
at port $port";
print Client "Hello there, $name, it's now ",
- scalar localtime, "\n";
+ scalar localtime, $EOL;
}
And here's a multithreaded version. It's multithreaded in that
@@ -567,11 +697,11 @@ handle the client request so that the master server can quickly
go back to service a new client.
#!/usr/bin/perl -Tw
- require 5.002;
use strict;
BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
use Socket;
use Carp;
+ $EOL = "\015\012";
sub spawn; # forward declaration
sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
@@ -612,8 +742,8 @@ go back to service a new client.
at port $port";
spawn sub {
- print "Hello there, $name, it's now ", scalar localtime, "\n";
- exec '/usr/games/fortune'
+ print "Hello there, $name, it's now ", scalar localtime, $EOL;
+ exec '/usr/games/fortune' # XXX: `wrong' line terminators
or confess "can't exec fortune: $!";
};
@@ -661,7 +791,6 @@ service on a number of different machines and shows how far their clocks
differ from the system on which it's being run:
#!/usr/bin/perl -w
- require 5.002;
use strict;
use Socket;
@@ -698,7 +827,7 @@ want to. Unix-domain sockets are local to the current host, and are often
used internally to implement pipes. Unlike Internet domain sockets, Unix
domain sockets can show up in the file system with an ls(1) listing.
- $ ls -l /dev/log
+ % ls -l /dev/log
srw-rw-rw- 1 root 0 Oct 31 07:23 /dev/log
You can test for these with Perl's B<-S> file test:
@@ -710,7 +839,6 @@ You can test for these with Perl's B<-S> file test:
Here's a sample Unix-domain client:
#!/usr/bin/perl -w
- require 5.002;
use Socket;
use strict;
my ($rendezvous, $line);
@@ -723,15 +851,17 @@ Here's a sample Unix-domain client:
}
exit;
-And here's a corresponding server.
+And here's a corresponding server. You don't have to worry about silly
+network terminators here because Unix domain sockets are guaranteed
+to be on the localhost, and thus everything works right.
#!/usr/bin/perl -Tw
- require 5.002;
use strict;
use Socket;
use Carp;
BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
+ sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
my $NAME = '/tmp/catsock';
my $uaddr = sockaddr_un($NAME);
@@ -744,8 +874,17 @@ And here's a corresponding server.
logmsg "server started on $NAME";
+ my $waitedpid;
+
+ sub REAPER {
+ $waitedpid = wait;
+ $SIG{CHLD} = \&REAPER; # loathe sysV
+ logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
+ }
+
$SIG{CHLD} = \&REAPER;
+
for ( $waitedpid = 0;
accept(Client,Server) || $waitedpid;
$waitedpid = 0, close Client)
@@ -866,6 +1005,8 @@ something to the server before fetching the server's response.
use IO::Socket;
unless (@ARGV > 1) { die "usage: $0 host document ..." }
$host = shift(@ARGV);
+ $EOL = "\015\012";
+ $BLANK = $EOL x 2;
foreach $document ( @ARGV ) {
$remote = IO::Socket::INET->new( Proto => "tcp",
PeerAddr => $host,
@@ -873,7 +1014,7 @@ something to the server before fetching the server's response.
);
unless ($remote) { die "cannot connect to http daemon on $host" }
$remote->autoflush(1);
- print $remote "GET $document HTTP/1.0\n\n";
+ print $remote "GET $document HTTP/1.0" . $BLANK;
while ( <$remote> ) { print }
close $remote;
}
@@ -900,7 +1041,7 @@ such a request.
Here's an example of running that program, which we'll call I<webget>:
- shell_prompt$ webget www.perl.com /guanaco.html
+ % webget www.perl.com /guanaco.html
HTTP/1.1 404 File Not Found
Date: Thu, 08 May 1997 18:02:32 GMT
Server: Apache/1.2b6
@@ -935,9 +1076,8 @@ simultaneously copies everything from standard input to the socket.
To accomplish the same thing using just one process would be I<much>
harder, because it's easier to code two processes to do one thing than it
is to code one process to do two things. (This keep-it-simple principle
-is one of the cornerstones of the Unix philosophy, and good software
-engineering as well, which is probably why it's spread to other systems
-as well.)
+a cornerstones of the Unix philosophy, and good software engineering as
+well, which is probably why it's spread to other systems.)
Here's the code:
@@ -981,9 +1121,6 @@ The C<kill> function in the parent's C<if> block is there to send a
signal to our child process (current running in the C<else> block)
as soon as the remote server has closed its end of the connection.
-The C<kill> at the end of the parent's block is there to eliminate the
-child process as soon as the server we connect to closes its end.
-
If the remote server sends data a byte at time, and you need that
data immediately without waiting for a newline (which might not happen),
you may wish to replace the C<while> loop in the parent with the
@@ -1000,7 +1137,7 @@ well.
=head1 TCP Servers with IO::Socket
-Setting up server is little bit more involved than running a client.
+As always, setting up a server is little bit more involved than running a client.
The model is that the server creates a special kind of socket that
does nothing but listen on a particular port for incoming connections.
It does this by calling the C<IO::Socket::INET-E<gt>new()> method with
@@ -1054,7 +1191,7 @@ you'll have to use the C<sysread> variant of the interactive client above.
This server accepts one of five different commands, sending output
back to the client. Note that unlike most network servers, this one
only handles one incoming client at a time. Multithreaded servers are
-covered in Chapter 6 of the Camel or in the perlipc(1) manpage.
+covered in Chapter 6 of the Camel.
Here's the code. We'll
@@ -1114,7 +1251,6 @@ with TCP, you'd have to use a different socket handle for each host.
#!/usr/bin/perl -w
use strict;
- require 5.002;
use Socket;
use Sys::Hostname;
@@ -1167,29 +1303,33 @@ you weren't wanting it to.
Here's a small example showing shared memory usage.
- $IPC_PRIVATE = 0;
- $IPC_RMID = 0;
+ use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRWXU S_IRWXG S_IRWXO);
+
$size = 2000;
- $key = shmget($IPC_PRIVATE, $size , 0777 );
- die unless defined $key;
+ $key = shmget(IPC_PRIVATE, $size, S_IRWXU|S_IRWXG|S_IRWXO) || die "$!";
+ print "shm key $key\n";
$message = "Message #1";
- shmwrite($key, $message, 0, 60 ) || die "$!";
- shmread($key,$buff,0,60) || die "$!";
+ shmwrite($key, $message, 0, 60) || die "$!";
+ print "wrote: '$message'\n";
+ shmread($key, $buff, 0, 60) || die "$!";
+ print "read : '$buff'\n";
- print $buff,"\n";
+ # the buffer of shmread is zero-character end-padded.
+ substr($buff, index($buff, "\0")) = '';
+ print "un" unless $buff eq $message;
+ print "swell\n";
- print "deleting $key\n";
- shmctl($key ,$IPC_RMID, 0) || die "$!";
+ print "deleting shm $key\n";
+ shmctl($key, IPC_RMID, 0) || die "$!";
Here's an example of a semaphore:
+ use IPC::SysV qw(IPC_CREAT);
+
$IPC_KEY = 1234;
- $IPC_RMID = 0;
- $IPC_CREATE = 0001000;
- $key = semget($IPC_KEY, $nsems , 0666 | $IPC_CREATE );
- die if !defined($key);
- print "$key\n";
+ $key = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!";
+ print "shm key $key\n";
Put this code in a separate file to be run in more than one process.
Call the file F<take>:
@@ -1236,28 +1376,20 @@ Call this file F<give>:
semop($key,$opstring) || die "$!";
The SysV IPC code above was written long ago, and it's definitely
-clunky looking. It should at the very least be made to C<use strict>
-and C<require "sys/ipc.ph">. Better yet, check out the IPC::SysV modules
-on CPAN.
+clunky looking. For a more modern look, see the IPC::SysV module
+which is included with Perl starting from Perl 5.005.
=head1 NOTES
-If you are running under version 5.000 (dubious) or 5.001, you can still
-use most of the examples in this document. You may have to remove the
-C<use strict> and some of the my() statements for 5.000, and for both
-you'll have to load in version 1.2 or older of the F<Socket.pm> module, which
-is included in I<perl5.002>.
-
-Most of these routines quietly but politely return C<undef> when they fail
-instead of causing your program to die right then and there due to an
-uncaught exception. (Actually, some of the new I<Socket> conversion
-functions croak() on bad arguments.) It is therefore essential
-that you should check the return values of these functions. Always begin
-your socket programs this way for optimal success, and don't forget to add
-B<-T> taint checking flag to the pound-bang line for servers:
+Most of these routines quietly but politely return C<undef> when they
+fail instead of causing your program to die right then and there due to
+an uncaught exception. (Actually, some of the new I<Socket> conversion
+functions croak() on bad arguments.) It is therefore essential to
+check return values from these functions. Always begin your socket
+programs this way for optimal success, and don't forget to add B<-T>
+taint checking flag to the #! line for servers:
- #!/usr/bin/perl -w
- require 5.002;
+ #!/usr/bin/perl -Tw
use strict;
use sigtrap;
use Socket;
@@ -1271,14 +1403,14 @@ signals and to stick with simple TCP and UDP socket operations; e.g., don't
try to pass open file descriptors over a local UDP datagram socket if you
want your code to stand a chance of being portable.
-Because few vendors provide C libraries that are safely re-entrant,
-the prudent programmer will do little else within a handler beyond
-setting a numeric variable that already exists; or, if locked into
-a slow (restarting) system call, using die() to raise an exception
-and longjmp(3) out. In fact, even these may in some cases cause a
-core dump. It's probably best to avoid signals except where they are
-absolutely inevitable. This perilous problems will be addressed in a
-future release of Perl.
+As mentioned in the signals section, because few vendors provide C
+libraries that are safely re-entrant, the prudent programmer will do
+little else within a handler beyond setting a numeric variable that
+already exists; or, if locked into a slow (restarting) system call,
+using die() to raise an exception and longjmp(3) out. In fact, even
+these may in some cases cause a core dump. It's probably best to avoid
+signals except where they are absolutely inevitable. This
+will be addressed in a future release of Perl.
=head1 AUTHOR
@@ -1290,10 +1422,10 @@ version and suggestions from the Perl Porters.
There's a lot more to networking than this, but this should get you
started.
-For intrepid programmers, the classic textbook I<Unix Network Programming>
-by Richard Stevens (published by Addison-Wesley). Note that most books
-on networking address networking from the perspective of a C programmer;
-translation to Perl is left as an exercise for the reader.
+For intrepid programmers, the indispensable textbook is I<Unix Network
+Programming> by W. Richard Stevens (published by Addison-Wesley). Note
+that most books on networking address networking from the perspective of
+a C programmer; translation to Perl is left as an exercise for the reader.
The IO::Socket(3) manpage describes the object library, and the Socket(3)
manpage describes the low-level interface to sockets. Besides the obvious
diff --git a/gnu/usr.bin/perl/pod/perllocale.pod b/gnu/usr.bin/perl/pod/perllocale.pod
index e1bf5f070df..08b50e0d128 100644
--- a/gnu/usr.bin/perl/pod/perllocale.pod
+++ b/gnu/usr.bin/perl/pod/perllocale.pod
@@ -4,17 +4,18 @@ perllocale - Perl locale handling (internationalization and localization)
=head1 DESCRIPTION
-Perl supports language-specific notions of data such as "is this a
-letter", "what is the uppercase equivalent of this letter", and "which
-of these letters comes first". These are important issues, especially
-for languages other than English - but also for English: it would be
-very naE<iuml>ve to think that C<A-Za-z> defines all the "letters". Perl
-is also aware that some character other than '.' may be preferred as a
-decimal point, and that output date representations may be
-language-specific. The process of making an application take account of
-its users' preferences in such matters is called B<internationalization>
-(often abbreviated as B<i18n>); telling such an application about a
-particular set of preferences is known as B<localization> (B<l10n>).
+Perl supports language-specific notions of data such as "is this
+a letter", "what is the uppercase equivalent of this letter", and
+"which of these letters comes first". These are important issues,
+especially for languages other than English--but also for English: it
+would be naE<iuml>ve to imagine that C<A-Za-z> defines all the "letters"
+needed to write in English. Perl is also aware that some character other
+than '.' may be preferred as a decimal point, and that output date
+representations may be language-specific. The process of making an
+application take account of its users' preferences in such matters is
+called B<internationalization> (often abbreviated as B<i18n>); telling
+such an application about a particular set of preferences is known as
+B<localization> (B<l10n>).
Perl can understand language-specific data via the standardized (ISO C,
XPG4, POSIX 1.c) method called "the locale system". The locale system is
@@ -22,13 +23,13 @@ controlled per application using one pragma, one function call, and
several environment variables.
B<NOTE>: This feature is new in Perl 5.004, and does not apply unless an
-application specifically requests it - see L<Backward compatibility>.
+application specifically requests it--see L<Backward compatibility>.
The one exception is that write() now B<always> uses the current locale
- see L<"NOTES">.
=head1 PREPARING TO USE LOCALES
-If Perl applications are to be able to understand and present your data
+If Perl applications are to understand and present your data
correctly according a locale of your choice, B<all> of the following
must be true:
@@ -42,15 +43,15 @@ its C library.
=item *
-B<Definitions for the locales which you use must be installed>. You, or
+B<Definitions for locales that you use must be installed>. You, or
your system administrator, must make sure that this is the case. The
available locales, the location in which they are kept, and the manner
-in which they are installed, vary from system to system. Some systems
-provide only a few, hard-wired, locales, and do not allow more to be
-added; others allow you to add "canned" locales provided by the system
-supplier; still others allow you or the system administrator to define
+in which they are installed all vary from system to system. Some systems
+provide only a few, hard-wired locales and do not allow more to be
+added. Others allow you to add "canned" locales provided by the system
+supplier. Still others allow you or the system administrator to define
and add arbitrary locales. (You may have to ask your supplier to
-provide canned locales which are not delivered with your operating
+provide canned locales that are not delivered with your operating
system.) Read your system documentation for further illumination.
=item *
@@ -71,8 +72,8 @@ appropriate, and B<at least one> of the following must be true:
=item *
B<The locale-determining environment variables (see L<"ENVIRONMENT">)
-must be correctly set up>, either by yourself, or by the person who set
-up your system account, at the time the application is started.
+must be correctly set up> at the time the application is started, either
+by yourself or by whoever set up your system account.
=item *
@@ -94,16 +95,16 @@ pragma tells Perl to use the current locale for some operations:
B<The comparison operators> (C<lt>, C<le>, C<cmp>, C<ge>, and C<gt>) and
the POSIX string collation functions strcoll() and strxfrm() use
-C<LC_COLLATE>. sort() is also affected if it is used without an
-explicit comparison function because it uses C<cmp> by default.
+C<LC_COLLATE>. sort() is also affected if used without an
+explicit comparison function, because it uses C<cmp> by default.
-B<Note:> C<eq> and C<ne> are unaffected by the locale: they always
+B<Note:> C<eq> and C<ne> are unaffected by locale: they always
perform a byte-by-byte comparison of their scalar operands. What's
more, if C<cmp> finds that its operands are equal according to the
collation sequence specified by the current locale, it goes on to
perform a byte-by-byte comparison, and only returns I<0> (equal) if the
operands are bit-for-bit identical. If you really want to know whether
-two strings - which C<eq> and C<cmp> may consider different - are equal
+two strings--which C<eq> and C<cmp> may consider different--are equal
as far as collation in the locale is concerned, see the discussion in
L<Category LC_COLLATE: Collation>.
@@ -126,10 +127,10 @@ B<The POSIX date formatting function> (strftime()) uses C<LC_TIME>.
C<LC_COLLATE>, C<LC_CTYPE>, and so on, are discussed further in L<LOCALE
CATEGORIES>.
-The default behavior returns with S<C<no locale>> or on reaching the
-end of the enclosing block.
+The default behavior is restored with the S<C<no locale>> pragma, or
+upon reaching the end of block enclosing C<use locale>.
-Note that the string result of any operation that uses locale
+The string result of any operation that uses locale
information is tainted, as it is possible for a locale to be
untrustworthy. See L<"SECURITY">.
@@ -168,31 +169,41 @@ combination of language, country or territory, and codeset. Read on for
hints on the naming of locales: not all systems name locales as in the
example.
-If no second argument is provided, the function returns a string naming
-the current locale for the category. You can use this value as the
-second argument in a subsequent call to setlocale(). If a second
-argument is given and it corresponds to a valid locale, the locale for
-the category is set to that value, and the function returns the
-now-current locale value. You can use this in a subsequent call to
-setlocale(). (In some implementations, the return value may sometimes
-differ from the value you gave as the second argument - think of it as
-an alias for the value that you gave.)
+If no second argument is provided and the category is something else
+than LC_ALL, the function returns a string naming the current locale
+for the category. You can use this value as the second argument in a
+subsequent call to setlocale().
+
+If no second argument is provided and the category is LC_ALL, the
+result is implementation-dependent. It may be a string of
+concatenated locales names (separator also implementation-dependent)
+or a single locale name. Please consult your L<setlocale(3)> for
+details.
+
+If a second argument is given and it corresponds to a valid locale,
+the locale for the category is set to that value, and the function
+returns the now-current locale value. You can then use this in yet
+another call to setlocale(). (In some implementations, the return
+value may sometimes differ from the value you gave as the second
+argument--think of it as an alias for the value you gave.)
As the example shows, if the second argument is an empty string, the
category's locale is returned to the default specified by the
corresponding environment variables. Generally, this results in a
-return to the default which was in force when Perl started up: changes
+return to the default that was in force when Perl started up: changes
to the environment made by the application after startup may or may not
-be noticed, depending on the implementation of your system's C library.
+be noticed, depending on your system's C library.
If the second argument does not correspond to a valid locale, the locale
for the category is not changed, and the function returns I<undef>.
For further information about the categories, consult L<setlocale(3)>.
-For the locales available in your system, also consult L<setlocale(3)>
-and see whether it leads you to the list of the available locales
-(search for the I<SEE ALSO> section). If that fails, try the following
-command lines:
+
+=head2 Finding locales
+
+For locales available in your system, consult also L<setlocale(3)> to
+see whether it leads to the list of available locales (search for the
+I<SEE ALSO> section). If that fails, try the following command lines:
locale -a
@@ -204,39 +215,158 @@ command lines:
ls /usr/lib/nls
+ ls /usr/share/locale
+
and see whether they list something resembling these
en_US.ISO8859-1 de_DE.ISO8859-1 ru_RU.ISO8859-5
+ en_US.iso88591 de_DE.iso88591 ru_RU.iso88595
en_US de_DE ru_RU
en de ru
english german russian
english.iso88591 german.iso88591 russian.iso88595
+ english.roman8 russian.koi8r
Sadly, even though the calling interface for setlocale() has been
-standardized, the names of the locales and the directories where
-the configuration is, have not. The basic form of the name is
-I<language_country/territory>B<.>I<codeset>, but the
-latter parts are not always present.
+standardized, names of locales and the directories where the
+configuration resides have not been. The basic form of the name is
+I<language_territory>B<.>I<codeset>, but the latter parts after
+I<language> are not always present. The I<language> and I<country>
+are usually from the standards B<ISO 3166> and B<ISO 639>, the
+two-letter abbreviations for the countries and the languages of the
+world, respectively. The I<codeset> part often mentions some B<ISO
+8859> character set, the Latin codesets. For example, C<ISO 8859-1>
+is the so-called "Western European codeset" that can be used to encode
+most Western European languages adequately. Again, there are several
+ways to write even the name of that one standard. Lamentably.
Two special locales are worth particular mention: "C" and "POSIX".
Currently these are effectively the same locale: the difference is
-mainly that the first one is defined by the C standard and the second by
-the POSIX standard. What they define is the B<default locale> in which
+mainly that the first one is defined by the C standard, the second by
+the POSIX standard. They define the B<default locale> in which
every program starts in the absence of locale information in its
-environment. (The default default locale, if you will.) Its language
+environment. (The I<default> default locale, if you will.) Its language
is (American) English and its character codeset ASCII.
B<NOTE>: Not all systems have the "POSIX" locale (not all systems are
POSIX-conformant), so use "C" when you need explicitly to specify this
default locale.
+=head2 LOCALE PROBLEMS
+
+You may encounter the following warning message at Perl startup:
+
+ perl: warning: Setting locale failed.
+ perl: warning: Please check that your locale settings:
+ LC_ALL = "En_US",
+ LANG = (unset)
+ are supported and installed on your system.
+ perl: warning: Falling back to the standard locale ("C").
+
+This means that your locale settings had LC_ALL set to "En_US" and
+LANG exists but has no value. Perl tried to believe you but could not.
+Instead, Perl gave up and fell back to the "C" locale, the default locale
+that is supposed to work no matter what. This usually means your locale
+settings were wrong, they mention locales your system has never heard
+of, or the locale installation in your system has problems (for example,
+some system files are broken or missing). There are quick and temporary
+fixes to these problems, as well as more thorough and lasting fixes.
+
+=head2 Temporarily fixing locale problems
+
+The two quickest fixes are either to render Perl silent about any
+locale inconsistencies or to run Perl under the default locale "C".
+
+Perl's moaning about locale problems can be silenced by setting the
+environment variable PERL_BADLANG to a zero value, for example "0".
+This method really just sweeps the problem under the carpet: you tell
+Perl to shut up even when Perl sees that something is wrong. Do not
+be surprised if later something locale-dependent misbehaves.
+
+Perl can be run under the "C" locale by setting the environment
+variable LC_ALL to "C". This method is perhaps a bit more civilized
+than the PERL_BADLANG approach, but setting LC_ALL (or
+other locale variables) may affect other programs as well, not just
+Perl. In particular, external programs run from within Perl will see
+these changes. If you make the new settings permanent (read on), all
+programs you run see the changes. See L<ENVIRONMENT> for for
+the full list of relevant environment variables and L<USING LOCALES>
+for their effects in Perl. Effects in other programs are
+easily deducible. For example, the variable LC_COLLATE may well affect
+your B<sort> program (or whatever the program that arranges `records'
+alphabetically in your system is called).
+
+You can test out changing these variables temporarily, and if the
+new settings seem to help, put those settings into your shell startup
+files. Consult your local documentation for the exact details. For in
+Bourne-like shells (B<sh>, B<ksh>, B<bash>, B<zsh>):
+
+ LC_ALL=en_US.ISO8859-1
+ export LC_ALL
+
+This assumes that we saw the locale "en_US.ISO8859-1" using the commands
+discussed above. We decided to try that instead of the above faulty
+locale "En_US"--and in Cshish shells (B<csh>, B<tcsh>)
+
+ setenv LC_ALL en_US.ISO8859-1
+
+If you do not know what shell you have, consult your local
+helpdesk or the equivalent.
+
+=head2 Permanently fixing locale problems
+
+The slower but superior fixes are when you may be able to yourself
+fix the misconfiguration of your own environment variables. The
+mis(sing)configuration of the whole system's locales usually requires
+the help of your friendly system administrator.
+
+First, see earlier in this document about L<Finding locales>. That tells
+how to find which locales are really supported--and more importantly,
+installed--on your system. In our example error message, environment
+variables affecting the locale are listed in the order of decreasing
+importance (and unset variables do not matter). Therefore, having
+LC_ALL set to "En_US" must have been the bad choice, as shown by the
+error message. First try fixing locale settings listed first.
+
+Second, if using the listed commands you see something B<exactly>
+(prefix matches do not count and case usually counts) like "En_US"
+without the quotes, then you should be okay because you are using a
+locale name that should be installed and available in your system.
+In this case, see L<Permanently fixing system locale configuration>.
+
+=head2 Permanently fixing your locale configuration
+
+This is when you see something like:
+
+ perl: warning: Please check that your locale settings:
+ LC_ALL = "En_US",
+ LANG = (unset)
+ are supported and installed on your system.
+
+but then cannot see that "En_US" listed by the above-mentioned
+commands. You may see things like "en_US.ISO8859-1", but that isn't
+the same. In this case, try running under a locale
+that you can list and which somehow matches what you tried. The
+rules for matching locale names are a bit vague because
+standardization is weak in this area. See again the L<Finding
+locales> about general rules.
+
+=head2 Fixing system locale configuration
+
+Contact a system administrator (preferably your own) and report the exact
+error message you get, and ask them to read this same documentation you
+are now reading. They should be able to check whether there is something
+wrong with the locale configuration of the system. The L<Finding locales>
+section is unfortunately a bit vague about the exact commands and places
+because these things are not that standardized.
+
=head2 The localeconv function
The POSIX::localeconv() function allows you to get particulars of the
locale-dependent numeric formatting information specified by the current
C<LC_NUMERIC> and C<LC_MONETARY> locales. (If you just want the name of
the current locale for a particular category, use POSIX::setlocale()
-with a single parameter - see L<The setlocale function>.)
+with a single parameter--see L<The setlocale function>.)
use POSIX qw(locale_h);
@@ -249,16 +379,16 @@ with a single parameter - see L<The setlocale function>.)
}
localeconv() takes no arguments, and returns B<a reference to> a hash.
-The keys of this hash are formatting variable names such as
-C<decimal_point> and C<thousands_sep>; the values are the corresponding
-values. See L<POSIX (3)/localeconv> for a longer example, which lists
-all the categories an implementation might be expected to provide; some
-provide more and others fewer, however. Note that you don't need C<use
-locale>: as a function with the job of querying the locale, localeconv()
-always observes the current locale.
+The keys of this hash are variable names for formatting, such as
+C<decimal_point> and C<thousands_sep>. The values are the
+corresponding, er, values. See L<POSIX (3)/localeconv> for a longer
+example listing the categories an implementation might be expected to
+provide; some provide more and others fewer. You don't need an
+explicit C<use locale>, because localeconv() always observes the
+current locale.
-Here's a simple-minded example program which rewrites its command line
-parameters as integers formatted correctly in the current locale:
+Here's a simple-minded example program that rewrites its command-line
+parameters as integers correctly formatted in the current locale:
# See comments in previous example
require 5.004;
@@ -270,33 +400,57 @@ parameters as integers formatted correctly in the current locale:
# Apply defaults if values are missing
$thousands_sep = ',' unless $thousands_sep;
- $grouping = 3 unless $grouping;
+
+ # grouping and mon_grouping are packed lists
+ # of small integers (characters) telling the
+ # grouping (thousand_seps and mon_thousand_seps
+ # being the group dividers) of numbers and
+ # monetary quantities. The integers' meanings:
+ # 255 means no more grouping, 0 means repeat
+ # the previous grouping, 1-254 means use that
+ # as the current grouping. Grouping goes from
+ # right to left (low to high digits). In the
+ # below we cheat slightly by never using anything
+ # else than the first grouping (whatever that is).
+ if ($grouping) {
+ @grouping = unpack("C*", $grouping);
+ } else {
+ @grouping = (3);
+ }
# Format command line params for current locale
for (@ARGV) {
$_ = int; # Chop non-integer part
1 while
- s/(\d)(\d{$grouping}($|$thousands_sep))/$1$thousands_sep$2/;
+ s/(\d)(\d{$grouping[0]}($|$thousands_sep))/$1$thousands_sep$2/;
print "$_";
}
print "\n";
=head1 LOCALE CATEGORIES
-The subsections which follow describe basic locale categories. As well
-as these, there are some combination categories which allow the
-manipulation of more than one basic category at a time. See
-L<"ENVIRONMENT"> for a discussion of these.
+The following subsections describe basic locale categories. Beyond these,
+some combination categories allow manipulation of more than one
+basic category at a time. See L<"ENVIRONMENT"> for a discussion of these.
=head2 Category LC_COLLATE: Collation
-When in the scope of S<C<use locale>>, Perl looks to the C<LC_COLLATE>
-environment variable to determine the application's notions on the
-collation (ordering) of characters. ('b' follows 'a' in Latin
-alphabets, but where do 'E<aacute>' and 'E<aring>' belong?)
+In the scope of S<C<use locale>>, Perl looks to the C<LC_COLLATE>
+environment variable to determine the application's notions on collation
+(ordering) of characters. For example, 'b' follows 'a' in Latin
+alphabets, but where do 'E<aacute>' and 'E<aring>' belong? And while
+'color' follows 'chocolate' in English, what about in Spanish?
-Here is a code snippet that will tell you what are the alphanumeric
-characters in the current locale, in the locale order:
+The following collations all make sense and you may meet any of them
+if you "use locale".
+
+ A B C D E a b c d e
+ A a B b C c D d D e
+ a A b B c C d D e E
+ a b c d e A B C D E
+
+Here is a code snippet to tell what alphanumeric
+characters are in the current locale, in that locale's order:
use locale;
print +(sort grep /\w/, map { chr() } 0..255), "\n";
@@ -314,7 +468,7 @@ first example is useful for natural text.
As noted in L<USING LOCALES>, C<cmp> compares according to the current
collation locale when C<use locale> is in effect, but falls back to a
-byte-by-byte comparison for strings which the locale says are equal. You
+byte-by-byte comparison for strings that the locale says are equal. You
can use POSIX::strcoll() if you don't want this fall-back:
use POSIX qw(strcoll);
@@ -322,10 +476,10 @@ can use POSIX::strcoll() if you don't want this fall-back:
!strcoll("space and case ignored", "SpaceAndCaseIgnored");
$equal_in_locale will be true if the collation locale specifies a
-dictionary-like ordering which ignores space characters completely, and
+dictionary-like ordering that ignores space characters completely and
which folds case.
-If you have a single string which you want to check for "equality in
+If you have a single string that you want to check for "equality in
locale" against several others, you might think you could gain a little
efficiency by using POSIX::strxfrm() in conjunction with C<eq>:
@@ -341,66 +495,65 @@ efficiency by using POSIX::strxfrm() in conjunction with C<eq>:
strxfrm() takes a string and maps it into a transformed string for use
in byte-by-byte comparisons against other transformed strings during
collation. "Under the hood", locale-affected Perl comparison operators
-call strxfrm() for both their operands, then do a byte-by-byte
-comparison of the transformed strings. By calling strxfrm() explicitly,
+call strxfrm() for both operands, then do a byte-by-byte
+comparison of the transformed strings. By calling strxfrm() explicitly
and using a non locale-affected comparison, the example attempts to save
-a couple of transformations. In fact, it doesn't save anything: Perl
+a couple of transformations. But in fact, it doesn't save anything: Perl
magic (see L<perlguts/Magic Variables>) creates the transformed version of a
-string the first time it's needed in a comparison, then keeps it around
+string the first time it's needed in a comparison, then keeps this version around
in case it's needed again. An example rewritten the easy way with
C<cmp> runs just about as fast. It also copes with null characters
embedded in strings; if you call strxfrm() directly, it treats the first
-null it finds as a terminator. And don't expect the transformed strings
-it produces to be portable across systems - or even from one revision
+null it finds as a terminator. don't expect the transformed strings
+it produces to be portable across systems--or even from one revision
of your operating system to the next. In short, don't call strxfrm()
directly: let Perl do it for you.
-Note: C<use locale> isn't shown in some of these examples, as it isn't
+Note: C<use locale> isn't shown in some of these examples because it isn't
needed: strcoll() and strxfrm() exist only to generate locale-dependent
results, and so always obey the current C<LC_COLLATE> locale.
=head2 Category LC_CTYPE: Character Types
-When in the scope of S<C<use locale>>, Perl obeys the C<LC_CTYPE> locale
+In the scope of S<C<use locale>>, Perl obeys the C<LC_CTYPE> locale
setting. This controls the application's notion of which characters are
alphabetic. This affects Perl's C<\w> regular expression metanotation,
-which stands for alphanumeric characters - that is, alphabetic and
+which stands for alphanumeric characters--that is, alphabetic and
numeric characters. (Consult L<perlre> for more information about
regular expressions.) Thanks to C<LC_CTYPE>, depending on your locale
setting, characters like 'E<aelig>', 'E<eth>', 'E<szlig>', and
'E<oslash>' may be understood as C<\w> characters.
-The C<LC_CTYPE> locale also provides the map used in translating
+The C<LC_CTYPE> locale also provides the map used in transliterating
characters between lower and uppercase. This affects the case-mapping
-functions - lc(), lcfirst, uc() and ucfirst(); case-mapping
-interpolation with C<\l>, C<\L>, C<\u> or <\U> in double-quoted strings
-and in C<s///> substitutions; and case-independent regular expression
+functions--lc(), lcfirst, uc(), and ucfirst(); case-mapping
+interpolation with C<\l>, C<\L>, C<\u>, or C<\U> in double-quoted strings
+and C<s///> substitutions; and case-independent regular expression
pattern matching using the C<i> modifier.
-Finally, C<LC_CTYPE> affects the POSIX character-class test functions -
-isalpha(), islower() and so on. For example, if you move from the "C"
-locale to a 7-bit Scandinavian one, you may find - possibly to your
-surprise - that "|" moves from the ispunct() class to isalpha().
+Finally, C<LC_CTYPE> affects the POSIX character-class test
+functions--isalpha(), islower(), and so on. For example, if you move
+from the "C" locale to a 7-bit Scandinavian one, you may find--possibly
+to your surprise--that "|" moves from the ispunct() class to isalpha().
B<Note:> A broken or malicious C<LC_CTYPE> locale definition may result
in clearly ineligible characters being considered to be alphanumeric by
-your application. For strict matching of (unaccented) letters and
-digits - for example, in command strings - locale-aware applications
+your application. For strict matching of (mundane) letters and
+digits--for example, in command strings--locale-aware applications
should use C<\w> inside a C<no locale> block. See L<"SECURITY">.
=head2 Category LC_NUMERIC: Numeric Formatting
-When in the scope of S<C<use locale>>, Perl obeys the C<LC_NUMERIC>
-locale information, which controls application's idea of how numbers
-should be formatted for human readability by the printf(), sprintf(),
-and write() functions. String to numeric conversion by the
-POSIX::strtod() function is also affected. In most implementations the
-only effect is to change the character used for the decimal point -
-perhaps from '.' to ',': these functions aren't aware of such niceties
-as thousands separation and so on. (See L<The localeconv function> if
-you care about these things.)
-
-Note that output produced by print() is B<never> affected by the
+In the scope of S<C<use locale>>, Perl obeys the C<LC_NUMERIC> locale
+information, which controls an application's idea of how numbers should
+be formatted for human readability by the printf(), sprintf(), and
+write() functions. String-to-numeric conversion by the POSIX::strtod()
+function is also affected. In most implementations the only effect is to
+change the character used for the decimal point--perhaps from '.' to ','.
+These functions aren't aware of such niceties as thousands separation and
+so on. (See L<The localeconv function> if you care about these things.)
+
+Output produced by print() is B<never> affected by the
current locale: it is independent of whether C<use locale> or C<no
locale> is in effect, and corresponds to what you'd get from printf()
in the "C" locale. The same is true for Perl's internal conversions
@@ -422,23 +575,23 @@ between numeric and string formats:
=head2 Category LC_MONETARY: Formatting of monetary amounts
-The C standard defines the C<LC_MONETARY> category, but no function that
-is affected by its contents. (Those with experience of standards
+The C standard defines the C<LC_MONETARY> category, but no function
+that is affected by its contents. (Those with experience of standards
committees will recognize that the working group decided to punt on the
issue.) Consequently, Perl takes no notice of it. If you really want
-to use C<LC_MONETARY>, you can query its contents - see L<The localeconv
-function> - and use the information that it returns in your
-application's own formatting of currency amounts. However, you may well
-find that the information, though voluminous and complex, does not quite
-meet your requirements: currency formatting is a hard nut to crack.
+to use C<LC_MONETARY>, you can query its contents--see L<The localeconv
+function>--and use the information that it returns in your application's
+own formatting of currency amounts. However, you may well find that
+the information, voluminous and complex though it may be, still does not
+quite meet your requirements: currency formatting is a hard nut to crack.
=head2 LC_TIME
-The output produced by POSIX::strftime(), which builds a formatted
+Output produced by POSIX::strftime(), which builds a formatted
human-readable date/time string, is affected by the current C<LC_TIME>
locale. Thus, in a French locale, the output produced by the C<%B>
format element (full month name) for the first month of the year would
-be "janvier". Here's how to get a list of the long month names in the
+be "janvier". Here's how to get a list of long month names in the
current locale:
use POSIX qw(strftime);
@@ -447,24 +600,24 @@ current locale:
strftime("%B", 0, 0, 0, 1, $_, 96);
}
-Note: C<use locale> isn't needed in this example: as a function which
+Note: C<use locale> isn't needed in this example: as a function that
exists only to generate locale-dependent results, strftime() always
obeys the current C<LC_TIME> locale.
=head2 Other categories
-The remaining locale category, C<LC_MESSAGES> (possibly supplemented by
-others in particular implementations) is not currently used by Perl -
-except possibly to affect the behavior of library functions called by
-extensions which are not part of the standard Perl distribution.
+The remaining locale category, C<LC_MESSAGES> (possibly supplemented
+by others in particular implementations) is not currently used by
+Perl--except possibly to affect the behavior of library functions called
+by extensions outside the standard Perl distribution.
=head1 SECURITY
-While the main discussion of Perl security issues can be found in
+Although the main discussion of Perl security issues can be found in
L<perlsec>, a discussion of Perl's locale handling would be incomplete
if it did not draw your attention to locale-dependent security issues.
-Locales - particularly on systems which allow unprivileged users to
-build their own locales - are untrustworthy. A malicious (or just plain
+Locales--particularly on systems that allow unprivileged users to
+build their own locales--are untrustworthy. A malicious (or just plain
broken) locale can make a locale-aware application give unexpected
results. Here are a few possibilities:
@@ -473,7 +626,7 @@ results. Here are a few possibilities:
=item *
Regular expression checks for safe file names or mail addresses using
-C<\w> may be spoofed by an C<LC_CTYPE> locale which claims that
+C<\w> may be spoofed by an C<LC_CTYPE> locale that claims that
characters such as "E<gt>" and "|" are alphanumeric.
=item *
@@ -497,32 +650,32 @@ A sneaky C<LC_COLLATE> locale could result in the names of students with
=item *
-An application which takes the trouble to use the information in
+An application that takes the trouble to use information in
C<LC_MONETARY> may format debits as if they were credits and vice versa
-if that locale has been subverted. Or it make may make payments in US
+if that locale has been subverted. Or it might make payments in US
dollars instead of Hong Kong dollars.
=item *
The date and day names in dates formatted by strftime() could be
manipulated to advantage by a malicious user able to subvert the
-C<LC_DATE> locale. ("Look - it says I wasn't in the building on
+C<LC_DATE> locale. ("Look--it says I wasn't in the building on
Sunday.")
=back
Such dangers are not peculiar to the locale system: any aspect of an
-application's environment which may maliciously be modified presents
+application's environment which may be modified maliciously presents
similar challenges. Similarly, they are not specific to Perl: any
-programming language which allows you to write programs which take
+programming language that allows you to write programs that take
account of their environment exposes you to these issues.
-Perl cannot protect you from all of the possibilities shown in the
-examples - there is no substitute for your own vigilance - but, when
+Perl cannot protect you from all possibilities shown in the
+examples--there is no substitute for your own vigilance--but, when
C<use locale> is in effect, Perl uses the tainting mechanism (see
-L<perlsec>) to mark string results which become locale-dependent, and
+L<perlsec>) to mark string results that become locale-dependent, and
which may be untrustworthy in consequence. Here is a summary of the
-tainting behavior of operators and functions which may be affected by
+tainting behavior of operators and functions that may be affected by
the locale:
=over 4
@@ -531,7 +684,7 @@ the locale:
Scalar true/false (or less/equal/greater) result is never tainted.
-=item B<Case-mapping interpolation> (with C<\l>, C<\L>, C<\u> or <\U>)
+=item B<Case-mapping interpolation> (with C<\l>, C<\L>, C<\u> or C<\U>)
Result string containing interpolated material is tainted if
C<use locale> is in effect.
@@ -540,11 +693,11 @@ C<use locale> is in effect.
Scalar true/false result never tainted.
-Subpatterns, either delivered as an array-context result, or as $1 etc.
+Subpatterns, either delivered as a list-context result or as $1 etc.
are tainted if C<use locale> is in effect, and the subpattern regular
expression contains C<\w> (to match an alphanumeric character), C<\W>
(non-alphanumeric character), C<\s> (white-space character), or C<\S>
-(non white-space character). The matched pattern variable, $&, $`
+(non white-space character). The matched-pattern variable, $&, $`
(pre-match), $' (post-match), and $+ (last match) are also tainted if
C<use locale> is in effect and the regular expression contains C<\w>,
C<\W>, C<\s>, or C<\S>.
@@ -552,14 +705,14 @@ C<\W>, C<\s>, or C<\S>.
=item B<Substitution operator> (C<s///>):
Has the same behavior as the match operator. Also, the left
-operand of C<=~> becomes tainted when C<use locale> in effect,
-if it is modified as a result of a substitution based on a regular
+operand of C<=~> becomes tainted when C<use locale> in effect
+if modified as a result of a substitution based on a regular
expression match involving C<\w>, C<\W>, C<\s>, or C<\S>; or of
-case-mapping with C<\l>, C<\L>,C<\u> or <\U>.
+case-mapping with C<\l>, C<\L>,C<\u> or C<\U>.
=item B<In-memory formatting function> (sprintf()):
-Result is tainted if "use locale" is in effect.
+Result is tainted if C<use locale> is in effect.
=item B<Output formatting functions> (printf() and write()):
@@ -597,8 +750,8 @@ when taint checks are enabled.
or warn "Open of $untainted_output_file failed: $!\n";
The program can be made to run by "laundering" the tainted value through
-a regular expression: the second example - which still ignores locale
-information - runs, creating the file named on its command line
+a regular expression: the second example--which still ignores locale
+information--runs, creating the file named on its command line
if it can.
#/usr/local/bin/perl -T
@@ -610,7 +763,7 @@ if it can.
open(F, ">$untainted_output_file")
or warn "Open of $untainted_output_file failed: $!\n";
-Compare this with a very similar program which is locale-aware:
+Compare this with a similar but locale-aware program:
#/usr/local/bin/perl -T
@@ -623,7 +776,7 @@ Compare this with a very similar program which is locale-aware:
or warn "Open of $localized_output_file failed: $!\n";
This third program fails to run because $& is tainted: it is the result
-of a match involving C<\w> when C<use locale> is in effect.
+of a match involving C<\w> while C<use locale> is in effect.
=head1 ENVIRONMENT
@@ -633,10 +786,11 @@ of a match involving C<\w> when C<use locale> is in effect.
A string that can suppress Perl's warning about failed locale settings
at startup. Failure can occur if the locale support in the operating
-system is lacking (broken) is some way - or if you mistyped the name of
-a locale when you set up your environment. If this environment variable
-is absent, or has a value which does not evaluate to integer zero - that
-is "0" or "" - Perl will complain about locale setting failures.
+system is lacking (broken) in some way--or if you mistyped the name of
+a locale when you set up your environment. If this environment
+variable is absent, or has a value that does not evaluate to integer
+zero--that is, "0" or ""-- Perl will complain about locale setting
+failures.
B<NOTE>: PERL_BADLANG only gives you a way to hide the warning message.
The message tells about some problem in your system's locale support,
@@ -652,9 +806,23 @@ for controlling an application's opinion on data.
=item LC_ALL
-C<LC_ALL> is the "override-all" locale environment variable. If it is
+C<LC_ALL> is the "override-all" locale environment variable. If
set, it overrides all the rest of the locale environment variables.
+=item LANGUAGE
+
+B<NOTE>: C<LANGUAGE> is a GNU extension, it affects you only if you
+are using the GNU libc. This is the case if you are using e.g. Linux.
+If you are using "commercial" UNIXes you are most probably I<not>
+using GNU libc and you can ignore C<LANGUAGE>.
+
+However, in the case you are using C<LANGUAGE>: it affects the
+language of informational, warning, and error messages output by
+commands (in other words, it's like C<LC_MESSAGES>) but it has higher
+priority than L<LC_ALL>. Moreover, it's not a single value but
+instead a "path" (":"-separated list) of I<languages> (not locales).
+See the GNU C<gettext> library documentation for more information.
+
=item LC_CTYPE
In the absence of C<LC_ALL>, C<LC_CTYPE> chooses the character type
@@ -698,23 +866,22 @@ category-specific C<LC_...>.
=head2 Backward compatibility
Versions of Perl prior to 5.004 B<mostly> ignored locale information,
-generally behaving as if something similar to the C<"C"> locale (see
-L<The setlocale function>) was always in force, even if the program
-environment suggested otherwise. By default, Perl still behaves this
-way so as to maintain backward compatibility. If you want a Perl
-application to pay attention to locale information, you B<must> use
-the S<C<use locale>> pragma (see L<The use locale Pragma>) to
-instruct it to do so.
+generally behaving as if something similar to the C<"C"> locale were
+always in force, even if the program environment suggested otherwise
+(see L<The setlocale function>). By default, Perl still behaves this
+way for backward compatibility. If you want a Perl application to pay
+attention to locale information, you B<must> use the S<C<use locale>>
+pragma (see L<The use locale pragma>) to instruct it to do so.
Versions of Perl from 5.002 to 5.003 did use the C<LC_CTYPE>
-information if that was available, that is, C<\w> did understand what
-are the letters according to the locale environment variables.
+information if available; that is, C<\w> did understand what
+were the letters according to the locale environment variables.
The problem was that the user had no control over the feature:
if the C library supported locales, Perl used them.
=head2 I18N:Collate obsolete
-In versions of Perl prior to 5.004 per-locale collation was possible
+In versions of Perl prior to 5.004, per-locale collation was possible
using the C<I18N::Collate> library module. This module is now mildly
obsolete and should be avoided in new applications. The C<LC_COLLATE>
functionality is now integrated into the Perl core language: One can
@@ -735,7 +902,7 @@ system's implementation of the locale system than by Perl.
=head2 write() and LC_NUMERIC
-Formats are the only part of Perl which unconditionally use information
+Formats are the only part of Perl that unconditionally use information
from a program's locale; if a program's environment specifies an
LC_NUMERIC locale, it is always used to specify the decimal point
character in formatted output. Formatted output cannot be controlled by
@@ -748,7 +915,7 @@ structure.
There is a large collection of locale definitions at
C<ftp://dkuug.dk/i18n/WG15-collection>. You should be aware that it is
unsupported, and is not claimed to be fit for any purpose. If your
-system allows the installation of arbitrary locales, you may find the
+system allows installation of arbitrary locales, you may find the
definitions useful as they are, or as a basis for the development of
your own locales.
@@ -774,27 +941,53 @@ standard we've got. This may be construed as a bug.
=head2 Broken systems
-In certain system environments the operating system's locale support
+In certain systems, the operating system's locale support
is broken and cannot be fixed or used by Perl. Such deficiencies can
and will result in mysterious hangs and/or Perl core dumps when the
C<use locale> is in effect. When confronted with such a system,
please report in excruciating detail to <F<perlbug@perl.com>>, and
-complain to your vendor: maybe some bug fixes exist for these problems
+complain to your vendor: bug fixes may exist for these problems
in your operating system. Sometimes such bug fixes are called an
operating system upgrade.
=head1 SEE ALSO
-L<POSIX (3)/isalnum>, L<POSIX (3)/isalpha>, L<POSIX (3)/isdigit>,
-L<POSIX (3)/isgraph>, L<POSIX (3)/islower>, L<POSIX (3)/isprint>,
-L<POSIX (3)/ispunct>, L<POSIX (3)/isspace>, L<POSIX (3)/isupper>,
-L<POSIX (3)/isxdigit>, L<POSIX (3)/localeconv>, L<POSIX (3)/setlocale>,
-L<POSIX (3)/strcoll>, L<POSIX (3)/strftime>, L<POSIX (3)/strtod>,
+L<POSIX (3)/isalnum>
+
+L<POSIX (3)/isalpha>
+
+L<POSIX (3)/isdigit>
+
+L<POSIX (3)/isgraph>
+
+L<POSIX (3)/islower>
+
+L<POSIX (3)/isprint>,
+
+L<POSIX (3)/ispunct>
+
+L<POSIX (3)/isspace>
+
+L<POSIX (3)/isupper>,
+
+L<POSIX (3)/isxdigit>
+
+L<POSIX (3)/localeconv>
+
+L<POSIX (3)/setlocale>,
+
+L<POSIX (3)/strcoll>
+
+L<POSIX (3)/strftime>
+
+L<POSIX (3)/strtod>,
+
L<POSIX (3)/strxfrm>
=head1 HISTORY
Jarkko Hietaniemi's original F<perli18n.pod> heavily hacked by Dominic
-Dunlop, assisted by the perl5-porters.
+Dunlop, assisted by the perl5-porters. Prose worked over a bit by
+Tom Christiansen.
-Last update: Wed Jan 22 11:04:58 EST 1997
+Last update: Thu Jun 11 08:44:13 MDT 1998
diff --git a/gnu/usr.bin/perl/pod/perllol.pod b/gnu/usr.bin/perl/pod/perllol.pod
index 1de3b1ad749..56f08c20908 100644
--- a/gnu/usr.bin/perl/pod/perllol.pod
+++ b/gnu/usr.bin/perl/pod/perllol.pod
@@ -26,7 +26,7 @@ a declaration of the array:
bart
Now you should be very careful that the outer bracket type
-is a round one, that is, parentheses. That's because you're assigning to
+is a round one, that is, a parenthesis. That's because you're assigning to
an @list, so you need parentheses. If you wanted there I<not> to be an @LoL,
but rather just a reference to it, you could do something more like this:
@@ -34,7 +34,7 @@ but rather just a reference to it, you could do something more like this:
$ref_to_LoL = [
[ "fred", "barney", "pebbles", "bambam", "dino", ],
[ "homer", "bart", "marge", "maggie", ],
- [ "george", "jane", "alroy", "judy", ],
+ [ "george", "jane", "elroy", "judy", ],
];
print $ref_to_LoL->[2][2];
@@ -144,17 +144,7 @@ you'd have to do something like this:
push @$ref_to_LoL, [ split ];
}
-Actually, if you were using strict, you'd have to declare not only
-$ref_to_LoL as you had to declare @LoL, but you'd I<also> having to
-initialize it to a reference to an empty list. (This was a bug in
-perl version 5.001m that's been fixed for the 5.002 release.)
-
- my $ref_to_LoL = [];
- while (<>) {
- push @$ref_to_LoL, [ split ];
- }
-
-Ok, now you can add new rows. What about adding new columns? If you're
+Now you can add new rows. What about adding new columns? If you're
dealing with just matrices, it's often easiest to use simple assignment:
for $x (1 .. 10) {
@@ -310,4 +300,4 @@ perldata(1), perlref(1), perldsc(1)
Tom Christiansen <F<tchrist@perl.com>>
-Last udpate: Sat Oct 7 19:35:26 MDT 1995
+Last update: Thu Jun 4 16:16:23 MDT 1998
diff --git a/gnu/usr.bin/perl/pod/perlmod.pod b/gnu/usr.bin/perl/pod/perlmod.pod
index 4d0ad2d449d..48ebf237112 100644
--- a/gnu/usr.bin/perl/pod/perlmod.pod
+++ b/gnu/usr.bin/perl/pod/perlmod.pod
@@ -7,28 +7,35 @@ perlmod - Perl modules (packages and symbol tables)
=head2 Packages
Perl provides a mechanism for alternative namespaces to protect packages
-from stomping on each other's variables. In fact, apart from certain
-magical variables, there's really no such thing as a global variable
-in Perl. The package statement declares the compilation unit as
+from stomping on each other's variables. In fact, there's really no such
+thing as a global variable in Perl (although some identifiers default
+to the main package instead of the current one). The package statement
+declares the compilation unit as
being in the given namespace. The scope of the package declaration
is from the declaration itself through the end of the enclosing block,
C<eval>, C<sub>, or end of file, whichever comes first (the same scope
as the my() and local() operators). All further unqualified dynamic
-identifiers will be in this namespace. A package statement affects
-only dynamic variables--including those you've used local() on--but
+identifiers will be in this namespace. A package statement only affects
+dynamic variables--including those you've used local() on--but
I<not> lexical variables created with my(). Typically it would be
the first declaration in a file to be included by the C<require> or
C<use> operator. You can switch into a package in more than one place;
-it influences merely which symbol table is used by the compiler for the
+it merely influences which symbol table is used by the compiler for the
rest of that block. You can refer to variables and filehandles in other
packages by prefixing the identifier with the package name and a double
colon: C<$Package::Variable>. If the package name is null, the C<main>
package is assumed. That is, C<$::sail> is equivalent to C<$main::sail>.
-(The old package delimiter was a single quote, but double colon
-is now the preferred delimiter, in part because it's more readable
-to humans, and in part because it's more readable to B<emacs> macros.
-It also makes C++ programmers feel like they know what's going on.)
+The old package delimiter was a single quote, but double colon is now the
+preferred delimiter, in part because it's more readable to humans, and
+in part because it's more readable to B<emacs> macros. It also makes C++
+programmers feel like they know what's going on--as opposed to using the
+single quote as separator, which was there to make Ada programmers feel
+like they knew what's going on. Because the old-fashioned syntax is still
+supported for backwards compatibility, if you try to use a string like
+C<"This is $owner's house">, you'll be accessing C<$owner::s>; that is,
+the $s variable in package C<owner>, which is probably not what you meant.
+Use braces to disambiguate, as in C<"This is ${owner}'s house">.
Packages may be nested inside other packages: C<$OUTER::INNER::var>. This
implies nothing about the order of name lookups, however. All symbols
@@ -39,13 +46,13 @@ It would treat package C<INNER> as a totally separate global package.
Only identifiers starting with letters (or underscore) are stored in a
package's symbol table. All other symbols are kept in package C<main>,
-including all of the punctuation variables like $_. In addition, the
-identifiers STDIN, STDOUT, STDERR, ARGV, ARGVOUT, ENV, INC, and SIG are
-forced to be in package C<main>, even when used for other purposes than
-their builtin one. Note also that, if you have a package called C<m>,
-C<s>, or C<y>, then you can't use the qualified form of an identifier
-because it will be interpreted instead as a pattern match, a substitution,
-or a translation.
+including all of the punctuation variables like $_. In addition, when
+unqualified, the identifiers STDIN, STDOUT, STDERR, ARGV, ARGVOUT, ENV,
+INC, and SIG are forced to be in package C<main>, even when used for other
+purposes than their builtin one. Note also that, if you have a package
+called C<m>, C<s>, or C<y>, then you can't use the qualified form of an
+identifier because it will be interpreted instead as a pattern match,
+a substitution, or a transliteration.
(Variables beginning with underscore used to be forced into package
main, but we decided it was more useful for package writers to be able
@@ -85,62 +92,29 @@ table lookups at compile time:
local $main::{foo} = $main::{bar};
You can use this to print out all the variables in a package, for
-instance. Here is F<dumpvar.pl> from the Perl library:
-
- package dumpvar;
- sub main::dumpvar {
- ($package) = @_;
- local(*stab) = eval("*${package}::");
- while (($key,$val) = each(%stab)) {
- local(*entry) = $val;
- if (defined $entry) {
- print "\$$key = '$entry'\n";
- }
-
- if (defined @entry) {
- print "\@$key = (\n";
- foreach $num ($[ .. $#entry) {
- print " $num\t'",$entry[$num],"'\n";
- }
- print ")\n";
- }
-
- if ($key ne "${package}::" && defined %entry) {
- print "\%$key = (\n";
- foreach $key (sort keys(%entry)) {
- print " $key\t'",$entry{$key},"'\n";
- }
- print ")\n";
- }
- }
- }
-
-Note that even though the subroutine is compiled in package C<dumpvar>,
-the name of the subroutine is qualified so that its name is inserted into
-package C<main>. While popular many years ago, this is now considered
-very poor style; in general, you should be writing modules and using the
-normal export mechanism instead of hammering someone else's namespace,
-even main's.
+instance. The standard F<dumpvar.pl> library and the CPAN module
+Devel::Symdump make use of this.
Assignment to a typeglob performs an aliasing operation, i.e.,
*dick = *richard;
-causes variables, subroutines, and file handles accessible via the
-identifier C<richard> to also be accessible via the identifier C<dick>. If
-you want to alias only a particular variable or subroutine, you can
-assign a reference instead:
+causes variables, subroutines, formats, and file and directory handles
+accessible via the identifier C<richard> also to be accessible via the
+identifier C<dick>. If you want to alias only a particular variable or
+subroutine, you can assign a reference instead:
*dick = \$richard;
-makes $richard and $dick the same variable, but leaves
+Which makes $richard and $dick the same variable, but leaves
@richard and @dick as separate arrays. Tricky, eh?
This mechanism may be used to pass and return cheap references
into or from subroutines if you won't want to copy the whole
-thing.
+thing. It only works when assigning to dynamic variables, not
+lexicals.
- %some_hash = ();
+ %some_hash = (); # can't be my()
*some_hash = fn( \%another_hash );
sub fn {
local *hashsym = shift;
@@ -161,14 +135,15 @@ Another use of symbol tables is for making "constant" scalars.
*PI = \3.14159265358979;
Now you cannot alter $PI, which is probably a good thing all in all.
-This isn't the same as a constant subroutine (one prototyped to
-take no arguments and to return a constant expression), which is
-subject to optimization at compile-time. This isn't. See L<perlsub>
-for details on these.
+This isn't the same as a constant subroutine, which is subject to
+optimization at compile-time. This isn't. A constant subroutine is one
+prototyped to take no arguments and to return a constant expression.
+See L<perlsub> for details on these. The C<use constant> pragma is a
+convenient shorthand for these.
You can say C<*foo{PACKAGE}> and C<*foo{NAME}> to find out what name and
package the *foo symbol table entry comes from. This may be useful
-in a subroutine which is passed typeglobs as arguments
+in a subroutine that gets passed typeglobs as arguments:
sub identify_typeglob {
my $glob = shift;
@@ -200,27 +175,32 @@ files in time to be visible to the rest of the file. Once a C<BEGIN>
has run, it is immediately undefined and any code it used is returned to
Perl's memory pool. This means you can't ever explicitly call a C<BEGIN>.
-An C<END> subroutine is executed as late as possible, that is, when the
-interpreter is being exited, even if it is exiting as a result of a
-die() function. (But not if it's is being blown out of the water by a
-signal--you have to trap that yourself (if you can).) You may have
-multiple C<END> blocks within a file--they will execute in reverse
-order of definition; that is: last in, first out (LIFO).
+An C<END> subroutine is executed as late as possible, that is, when
+the interpreter is being exited, even if it is exiting as a result of
+a die() function. (But not if it's polymorphing into another program
+via C<exec>, or being blown out of the water by a signal--you have to
+trap that yourself (if you can).) You may have multiple C<END> blocks
+within a file--they will execute in reverse order of definition; that is:
+last in, first out (LIFO).
-Inside an C<END> subroutine C<$?> contains the value that the script is
+Inside an C<END> subroutine, C<$?> contains the value that the script is
going to pass to C<exit()>. You can modify C<$?> to change the exit
value of the script. Beware of changing C<$?> by accident (e.g. by
running something via C<system>).
-Note that when you use the B<-n> and B<-p> switches to Perl, C<BEGIN>
-and C<END> work just as they do in B<awk>, as a degenerate case.
+Note that when you use the B<-n> and B<-p> switches to Perl, C<BEGIN> and
+C<END> work just as they do in B<awk>, as a degenerate case. As currently
+implemented (and subject to change, since its inconvenient at best),
+both C<BEGIN> I<and> C<END> blocks are run when you use the B<-c> switch
+for a compile-only syntax check, although your main code is not.
=head2 Perl Classes
There is no special class syntax in Perl, but a package may function
-as a class if it provides subroutines that function as methods. Such a
-package may also derive some of its methods from another class package
-by listing the other package name in its @ISA array.
+as a class if it provides subroutines to act as methods. Such a
+package may also derive some of its methods from another class (package)
+by listing the other package name in its global @ISA array (which
+must be a package global, not a lexical).
For more on this, see L<perltoot> and L<perlobj>.
@@ -263,7 +243,7 @@ a file called Some/Module.pm and start with this template:
# non-exported package globals go here
use vars qw(@more $stuff);
- # initalize package globals, first exported ones
+ # initialize package globals, first exported ones
$Var1 = '';
%Hashit = ();
@@ -310,11 +290,11 @@ or
This is exactly equivalent to
- BEGIN { require "Module.pm"; import Module; }
+ BEGIN { require Module; import Module; }
or
- BEGIN { require "Module.pm"; import Module LIST; }
+ BEGIN { require Module; import Module LIST; }
As a special case
@@ -322,7 +302,7 @@ As a special case
is exactly equivalent to
- BEGIN { require "Module.pm"; }
+ BEGIN { require Module; }
All Perl module files have the extension F<.pm>. C<use> assumes this so
that you don't have to spell out "F<Module.pm>" in quotes. This also
@@ -331,6 +311,19 @@ Module names are also capitalized unless they're functioning as pragmas,
"Pragmas" are in effect compiler directives, and are sometimes called
"pragmatic modules" (or even "pragmata" if you're a classicist).
+The two statements:
+
+ require SomeModule;
+ require "SomeModule.pm";
+
+differ from each other in two ways. In the first case, any double
+colons in the module name, such as C<Some::Module>, are translated
+into your system's directory separator, usually "/". The second
+case does not, and would have to be specified literally. The other difference
+is that seeing the first C<require> clues in the compiler that uses of
+indirect object notation involving "SomeModule", as in C<$ob = purge SomeModule>,
+are method calls, not function calls. (Yes, this really can make a difference.)
+
Because the C<use> statement implies a C<BEGIN> block, the importation
of semantics happens at the moment the C<use> statement is compiled,
before the rest of the file is compiled. This is how it is able
@@ -348,7 +341,11 @@ instead of C<use>. With require you can get into this problem:
require Cwd; # make Cwd:: accessible
$here = getcwd(); # oops! no main::getcwd()
-In general C<use Module ();> is recommended over C<require Module;>.
+In general, C<use Module ()> is recommended over C<require Module>,
+because it determines module availability at compile time, not in the
+middle of your program's execution. An exception would be if two modules
+each tried to C<use> each other, and each also called a function from
+that other module. In that case, it's easy to use C<require>s instead.
Perl packages may be nested inside other package names, so we can have
package names containing C<::>. But if we used that package name
diff --git a/gnu/usr.bin/perl/pod/perlmodlib.pod b/gnu/usr.bin/perl/pod/perlmodlib.pod
index cfb281dcc7b..d6c6b328ca8 100644
--- a/gnu/usr.bin/perl/pod/perlmodlib.pod
+++ b/gnu/usr.bin/perl/pod/perlmodlib.pod
@@ -21,7 +21,7 @@ bulletproof.
They work somewhat like pragmas in that they tend to affect the compilation of
your program, and thus will usually work well only when used within a
-C<use>, or C<no>. Most of these are locally scoped, so an inner BLOCK
+C<use>, or C<no>. Most of these are lexically scoped, so an inner BLOCK
may countermand any of these by saying:
no integer;
@@ -79,6 +79,10 @@ restrict named opcodes when compiling or running Perl code
overload basic Perl operations
+=item re
+
+alter behaviour of regular expressions
+
=item sigtrap
enable simple signal handling
@@ -225,6 +229,10 @@ write linker options files for dynamic extension
add blib/* directories to @INC
+=item Fatal
+
+make errors in builtins or Perl functions fatal
+
=item Fcntl
load the C Fcntl.h defines
@@ -253,6 +261,14 @@ traverse a file tree
create or remove a series of directories
+=item File::Spec
+
+portably perform operations on file names
+
+=item File::Spec::Functions
+
+function call interface to File::Spec module
+
=item File::stat
by-name interface to Perl's builtin stat() functions
@@ -267,7 +283,7 @@ supply object methods for filehandles
=item FindBin
-locate directory of original perl script
+locate directory of original Perl script
=item GDBM_File
@@ -364,7 +380,7 @@ by-name interface to Perl's builtin getserv*() functions
=item Opcode
-disable named opcodes when compiling or running perl code
+disable named opcodes when compiling or running Perl code
=item Pod::Text
@@ -396,7 +412,7 @@ load functions only on demand
=item Shell
-run shell commands transparently within perl
+run shell commands transparently within Perl
=item Socket
@@ -428,7 +444,7 @@ interface to various C<readline> packages
=item Test::Harness
-run perl standard test scripts with statistics
+run Perl standard test scripts with statistics
=item Text::Abbrev
@@ -499,7 +515,7 @@ by-name interface to Perl's builtin getpw*() functions
To find out I<all> the modules installed on your system, including
those without documentation or outside the standard release, do this:
- find `perl -e 'print "@INC"'` -name '*.pm' -print
+ % find `perl -e 'print "@INC"'` -name '*.pm' -print
They should all have their own documentation installed and accessible via
your system man(1) command. If that fails, try the I<perldoc> program.
@@ -600,84 +616,133 @@ You should try to choose one close to you:
=item *
Africa
- South Africa ftp://ftp.is.co.za/programming/perl/CPAN/
+ South Africa ftp://ftp.is.co.za/programming/perl/CPAN/
+ ftp://ftpza.co.za/pub/mirrors/cpan/
=item *
Asia
- Hong Kong ftp://ftp.hkstar.com/pub/CPAN/
- Japan ftp://ftp.jaist.ac.jp/pub/lang/perl/CPAN/
- ftp://ftp.lab.kdd.co.jp/lang/perl/CPAN/
- South Korea ftp://ftp.nuri.net/pub/CPAN/
- Taiwan ftp://dongpo.math.ncu.edu.tw/perl/CPAN/
- ftp://ftp.wownet.net/pub2/PERL/
+ Armenia ftp://sunsite.aua.am/pub/CPAN/
+ China ftp://freesoft.cei.gov.cn/pub/languages/perl/CPAN/
+ Hong Kong ftp://ftp.hkstar.com/pub/CPAN/
+ Israel ftp://bioinfo.weizmann.ac.il/pub/software/perl/CPAN/
+ Japan ftp://ftp.dti.ad.jp/pub/lang/CPAN/
+ ftp://ftp.jaist.ac.jp/pub/lang/perl/CPAN/
+ ftp://ftp.lab.kdd.co.jp/lang/perl/CPAN/
+ ftp://ftp.meisei-u.ac.jp/pub/CPAN/
+ ftp://mirror.nucba.ac.jp/mirror/Perl/
+ Singapore ftp://ftp.nus.edu.sg/pub/unix/perl/CPAN/
+ South Korea ftp://ftp.bora.net/pub/CPAN/
+ ftp://ftp.nuri.net/pub/CPAN/
+ Taiwan ftp://ftp.wownet.net/pub2/PERL/
+ ftp://ftp1.sinica.edu.tw/pub1/perl/CPAN/
+ Thailand ftp://ftp.cs.riubon.ac.th/pub/mirrors/CPAN/
+ ftp://ftp.nectec.or.th/pub/mirrors/CPAN/
=item *
Australasia
- Australia ftp://ftp.netinfo.com.au/pub/perl/CPAN/
- New Zealand ftp://ftp.tekotago.ac.nz/pub/perl/CPAN/
+ Australia ftp://cpan.topend.com.au/pub/CPAN/
+ ftp://ftp.labyrinth.net.au/pub/perl/CPAN/
+ ftp://ftp.sage-au.org.au/pub/compilers/perl/CPAN/
+ ftp://mirror.aarnet.edu.au/pub/perl/CPAN/
+ New Zealand ftp://ftp.auckland.ac.nz/pub/perl/CPAN/
+ ftp://sunsite.net.nz/pub/languages/perl/CPAN/
+
+=item *
+Central America
+
+ Costa Rica ftp://ftp.ucr.ac.cr/pub/Unix/CPAN/
=item *
Europe
- Austria ftp://ftp.tuwien.ac.at/pub/languages/perl/CPAN/
- Belgium ftp://ftp.kulnet.kuleuven.ac.be/pub/mirror/CPAN/
- Czech Republic ftp://sunsite.mff.cuni.cz/Languages/Perl/CPAN/
- Denmark ftp://sunsite.auc.dk/pub/languages/perl/CPAN/
- Finland ftp://ftp.funet.fi/pub/languages/perl/CPAN/
- France ftp://ftp.ibp.fr/pub/perl/CPAN/
- ftp://ftp.pasteur.fr/pub/computing/unix/perl/CPAN/
- Germany ftp://ftp.gmd.de/packages/CPAN/
- ftp://ftp.leo.org/pub/comp/programming/languages/perl/CPAN/
- ftp://ftp.mpi-sb.mpg.de/pub/perl/CPAN/
- ftp://ftp.rz.ruhr-uni-bochum.de/pub/CPAN/
- ftp://ftp.uni-erlangen.de/pub/source/Perl/CPAN/
- ftp://ftp.uni-hamburg.de/pub/soft/lang/perl/CPAN/
- Greece ftp://ftp.ntua.gr/pub/lang/perl/
- Hungary ftp://ftp.kfki.hu/pub/packages/perl/CPAN/
- Italy ftp://cis.utovrm.it/CPAN/
- the Netherlands ftp://ftp.cs.ruu.nl/pub/PERL/CPAN/
- ftp://ftp.EU.net/packages/cpan/
- Norway ftp://ftp.uit.no/pub/languages/perl/cpan/
- Poland ftp://ftp.pk.edu.pl/pub/lang/perl/CPAN/
- ftp://sunsite.icm.edu.pl/pub/CPAN/
- Portugal ftp://ftp.ci.uminho.pt/pub/lang/perl/
- ftp://ftp.telepac.pt/pub/CPAN/
- Russia ftp://ftp.sai.msu.su/pub/lang/perl/CPAN/
- Slovenia ftp://ftp.arnes.si/software/perl/CPAN/
- Spain ftp://ftp.etse.urv.es/pub/mirror/perl/
- ftp://ftp.rediris.es/mirror/CPAN/
- Sweden ftp://ftp.sunet.se/pub/lang/perl/CPAN/
- UK ftp://ftp.demon.co.uk/pub/mirrors/perl/CPAN/
- ftp://sunsite.doc.ic.ac.uk/packages/CPAN/
- ftp://unix.hensa.ac.uk/mirrors/perl-CPAN/
+ Austria ftp://ftp.tuwien.ac.at/pub/languages/perl/CPAN/
+ Belgium ftp://ftp.kulnet.kuleuven.ac.be/pub/mirror/CPAN/
+ Bulgaria ftp://ftp.ntrl.net/pub/mirrors/CPAN/
+ Croatia ftp://ftp.linux.hr/pub/CPAN/
+ Czech Republic ftp://ftp.fi.muni.cz/pub/perl/
+ ftp://sunsite.mff.cuni.cz/Languages/Perl/CPAN/
+ Denmark ftp://sunsite.auc.dk/pub/languages/perl/CPAN/
+ Estonia ftp://ftp.ut.ee/pub/languages/perl/CPAN/
+ Finland ftp://ftp.funet.fi/pub/languages/perl/CPAN/
+ France ftp://ftp.lip6.fr/pub/perl/CPAN/
+ ftp://ftp.oleane.net/pub/mirrors/CPAN/
+ ftp://ftp.pasteur.fr/pub/computing/CPAN/
+ Germany ftp://ftp.archive.de.uu.net/pub/CPAN/
+ ftp://ftp.gmd.de/packages/CPAN/
+ ftp://ftp.gwdg.de/pub/languages/perl/CPAN/
+ ftp://ftp.leo.org/pub/comp/programming/languages/script/perl/CPAN/
+ ftp://ftp.mpi-sb.mpg.de/pub/perl/CPAN/
+ ftp://ftp.rz.ruhr-uni-bochum.de/pub/CPAN/
+ ftp://ftp.uni-erlangen.de/pub/source/CPAN/
+ ftp://ftp.uni-hamburg.de/pub/soft/lang/perl/CPAN/
+ Greece ftp://ftp.ntua.gr/pub/lang/perl/
+ Hungary ftp://ftp.kfki.hu/pub/packages/perl/CPAN/
+ Ireland ftp://sunsite.compapp.dcu.ie/pub/perl/
+ Italy ftp://cis.uniRoma2.it/CPAN/
+ ftp://ftp.flashnet.it/pub/CPAN/
+ ftp://ftp.unipi.it/pub/mirror/perl/CPAN/
+ Netherlands ftp://ftp.cs.uu.nl/mirror/CPAN/
+ ftp://ftp.nluug.nl/pub/languages/perl/CPAN/
+ Norway ftp://ftp.uit.no/pub/languages/perl/cpan/
+ ftp://sunsite.uio.no/pub/languages/perl/CPAN/
+ Poland ftp://ftp.man.szczecin.pl/pub/perl/CPAN/
+ ftp://ftp.man.torun.pl/pub/doc/CPAN/
+ ftp://ftp.pk.edu.pl/pub/lang/perl/CPAN/
+ ftp://sunsite.icm.edu.pl/pub/CPAN/
+ Portugal ftp://ftp.ci.uminho.pt/pub/mirrors/cpan/
+ ftp://ftp.ua.pt/pub/CPAN/
+ Romania ftp://ftp.dntis.ro/pub/mirrors/perl-cpan/
+ ftp://ftp.dnttm.ro/pub/CPAN/
+ Russia ftp://cpan.npi.msu.su/CPAN/
+ ftp://ftp.sai.msu.su/pub/lang/perl/CPAN/
+ Slovakia ftp://ftp.entry.sk/pub/languages/perl/CPAN/
+ Slovenia ftp://ftp.arnes.si/software/perl/CPAN/
+ Spain ftp://ftp.etse.urv.es/pub/perl/
+ ftp://ftp.rediris.es/mirror/CPAN/
+ Sweden ftp://ftp.sunet.se/pub/lang/perl/CPAN/
+ Switzerland ftp://sunsite.cnlab-switch.ch/mirror/CPAN/
+ Turkey ftp://sunsite.bilkent.edu.tr/pub/languages/CPAN/
+ United Kingdom ftp://ftp.demon.co.uk/pub/mirrors/perl/CPAN/
+ ftp://ftp.flirble.org/pub/languages/perl/CPAN/
+ ftp://ftp.plig.org/pub/CPAN/
+ ftp://sunsite.doc.ic.ac.uk/packages/CPAN/
+ ftp://unix.hensa.ac.uk/mirrors/perl-CPAN/
=item *
North America
- Ontario ftp://ftp.utilis.com/public/CPAN/
- ftp://enterprise.ic.gc.ca/pub/perl/CPAN/
- Manitoba ftp://theory.uwinnipeg.ca/pub/CPAN/
- California ftp://ftp.digital.com/pub/plan/perl/CPAN/
- ftp://ftp.cdrom.com/pub/perl/CPAN/
- Colorado ftp://ftp.cs.colorado.edu/pub/perl/CPAN/
- Florida ftp://ftp.cis.ufl.edu/pub/perl/CPAN/
- Illinois ftp://uiarchive.uiuc.edu/pub/lang/perl/CPAN/
- Massachusetts ftp://ftp.iguide.com/pub/mirrors/packages/perl/CPAN/
- New York ftp://ftp.rge.com/pub/languages/perl/
- North Carolina ftp://ftp.duke.edu/pub/perl/
- Oklahoma ftp://ftp.ou.edu/mirrors/CPAN/
- Oregon http://www.perl.org/CPAN/
- ftp://ftp.orst.edu/pub/packages/CPAN/
- Pennsylvania ftp://ftp.epix.net/pub/languages/perl/
- Texas ftp://ftp.sedl.org/pub/mirrors/CPAN/
- ftp://ftp.metronet.com/pub/perl/
+ Alberta ftp://sunsite.ualberta.ca/pub/Mirror/CPAN/
+ California ftp://ftp.cdrom.com/pub/perl/CPAN/
+ ftp://ftp.digital.com/pub/plan/perl/CPAN/
+ Colorado ftp://ftp.cs.colorado.edu/pub/perl/CPAN/
+ Florida ftp://ftp.cise.ufl.edu/pub/perl/CPAN/
+ Illinois ftp://uiarchive.uiuc.edu/pub/lang/perl/CPAN/
+ Indiana ftp://csociety-ftp.ecn.purdue.edu/pub/CPAN/
+ ftp://ftp.uwsg.indiana.edu/pub/perl/CPAN/
+ Manitoba ftp://theory.uwinnipeg.ca/pub/CPAN/
+ Massachusetts ftp://ftp.ccs.neu.edu/net/mirrors/ftp.funet.fi/pub/languages/perl/CPAN/
+ ftp://ftp.iguide.com/pub/mirrors/packages/perl/CPAN/
+ Mexico D.F. ftp://ftp.msg.com.mx/pub/CPAN/
+ New York ftp://ftp.rge.com/pub/languages/perl/
+ North Carolina ftp://ftp.duke.edu/pub/perl/
+ Oklahoma ftp://ftp.ou.edu/mirrors/CPAN/
+ Ontario ftp://ftp.crc.ca/pub/packages/perl/CPAN/
+ Oregon ftp://ftp.orst.edu/pub/packages/CPAN/
+ Pennsylvania ftp://ftp.epix.net/pub/languages/perl/
+ Texas ftp://ftp.sedl.org/pub/mirrors/CPAN/
+ Utah ftp://mirror.xmission.com/CPAN/
+ Virginia ftp://ftp.perl.org/pub/perl/CPAN/
+ ftp://ruff.cs.jmu.edu/pub/CPAN/
+ Washington ftp://ftp.spu.edu/pub/CPAN/
=item *
South America
- Chile ftp://sunsite.dcc.uchile.cl/pub/Lang/perl/CPAN/
+ Brazil ftp://cpan.if.usp.br/pub/mirror/CPAN/
+ Chile ftp://ftp.ing.puc.cl/pub/unix/perl/CPAN/
+ ftp://sunsite.dcc.uchile.cl/pub/Lang/perl/CPAN/
=back
@@ -758,7 +823,7 @@ Avoid C<$r-E<gt>Class::func()> where using C<@ISA=qw(... Class ...)> and
C<$r-E<gt>func()> would work (see L<perlbot> for more details).
Use autosplit so little used or newly added functions won't be a
-burden to programs which don't use them. Add test functions to
+burden to programs that don't use them. Add test functions to
the module after __END__ either using AutoSplit or by saying:
eval join('',<main::DATA>) || die $@ unless caller();
@@ -775,12 +840,12 @@ information in objects.
Always use B<-w>. Try to C<use strict;> (or C<use strict qw(...);>).
Remember that you can add C<no strict qw(...);> to individual blocks
-of code which need less strictness. Always use B<-w>. Always use B<-w>!
+of code that need less strictness. Always use B<-w>. Always use B<-w>!
Follow the guidelines in the perlstyle(1) manual.
=item Some simple style guidelines
-The perlstyle manual supplied with perl has many helpful points.
+The perlstyle manual supplied with Perl has many helpful points.
Coding style is a matter of personal taste. Many people evolve their
style over several years as they learn what helps them write and
@@ -800,7 +865,7 @@ use mixed case with no underscores (need to be short and portable).
You may find it helpful to use letter case to indicate the scope
or nature of a variable. For example:
- $ALL_CAPS_HERE constants only (beware clashes with perl vars)
+ $ALL_CAPS_HERE constants only (beware clashes with Perl vars)
$Some_Caps_Here package-wide global/static
$no_caps_here function scope my() or local() variables
@@ -930,7 +995,7 @@ GPL and The Artistic Licence (see the files README, Copying, and
Artistic). Larry has good reasons for NOT just using the GNU GPL.
My personal recommendation, out of respect for Larry, Perl, and the
-perl community at large is to state something simply like:
+Perl community at large is to state something simply like:
Copyright (c) 1995 Your Name. All rights reserved.
This program is free software; you can redistribute it and/or
@@ -965,7 +1030,7 @@ If possible you should place the module into a major ftp archive and
include details of its location in your announcement.
Some notes about ftp archives: Please use a long descriptive file
-name which includes the version number. Most incoming directories
+name that includes the version number. Most incoming directories
will not be readable/listable, i.e., you won't be able to see your
file after uploading it. Remember to send your email notification
message as soon as possible after uploading else your file may get
@@ -994,8 +1059,8 @@ Please remember to send me an updated entry for the Module list!
=item Take care when changing a released module.
-Always strive to remain compatible with previous released versions
-(see 2.2 above) Otherwise try to add a mechanism to revert to the
+Always strive to remain compatible with previous released versions.
+Otherwise try to add a mechanism to revert to the
old behaviour if people rely on it. Document incompatible changes.
=back
@@ -1015,7 +1080,7 @@ there is no need to convert a .pl file into a Module for just that.
=item Consider the implications.
-All the perl applications which make use of the script will need to
+All Perl applications that make use of the script will need to
be changed (slightly) if the script is converted into a module. Is
it worth it unless you plan to make other changes at the same time?
@@ -1058,7 +1123,7 @@ Don't delete the original .pl file till the new .pm one works!
=item Complete applications rarely belong in the Perl Module Library.
-=item Many applications contain some perl code which could be reused.
+=item Many applications contain some Perl code that could be reused.
Help save the world! Share your code in a form that makes it easy
to reuse.
@@ -1072,9 +1137,9 @@ to reuse.
fragment of code built on top of the reusable modules. In these cases
the application could invoked as:
- perl -e 'use Module::Name; method(@ARGV)' ...
+ % perl -e 'use Module::Name; method(@ARGV)' ...
or
- perl -mModule::Name ... (in perl5.002 or higher)
+ % perl -mModule::Name ... (in perl5.002 or higher)
=back
diff --git a/gnu/usr.bin/perl/pod/perlobj.pod b/gnu/usr.bin/perl/pod/perlobj.pod
index 7428334ee2f..a997ae0de36 100644
--- a/gnu/usr.bin/perl/pod/perlobj.pod
+++ b/gnu/usr.bin/perl/pod/perlobj.pod
@@ -44,12 +44,28 @@ constructor:
package Critter;
sub new { bless {} }
-The C<{}> constructs a reference to an anonymous hash containing no
-key/value pairs. The bless() takes that reference and tells the object
-it references that it's now a Critter, and returns the reference.
-This is for convenience, because the referenced object itself knows that
-it has been blessed, and the reference to it could have been returned
-directly, like this:
+That word C<new> isn't special. You could have written
+a construct this way, too:
+
+ package Critter;
+ sub spawn { bless {} }
+
+In fact, this might even be preferable, because the C++ programmers won't
+be tricked into thinking that C<new> works in Perl as it does in C++.
+It doesn't. We recommend that you name your constructors whatever
+makes sense in the context of the problem you're solving. For example,
+constructors in the Tk extension to Perl are named after the widgets
+they create.
+
+One thing that's different about Perl constructors compared with those in
+C++ is that in Perl, they have to allocate their own memory. (The other
+things is that they don't automatically call overridden base-class
+constructors.) The C<{}> allocates an anonymous hash containing no
+key/value pairs, and returns it The bless() takes that reference and
+tells the object it references that it's now a Critter, and returns
+the reference. This is for convenience, because the referenced object
+itself knows that it has been blessed, and the reference to it could
+have been returned directly, like this:
sub new {
my $self = {};
@@ -61,21 +77,21 @@ In fact, you often see such a thing in more complicated constructors
that wish to call methods in the class as part of the construction:
sub new {
- my $self = {}
+ my $self = {};
bless $self;
$self->initialize();
return $self;
}
If you care about inheritance (and you should; see
-L<perlmod/"Modules: Creation, Use, and Abuse">),
+L<perlmodlib/"Modules: Creation, Use, and Abuse">),
then you want to use the two-arg form of bless
so that your constructors may be inherited:
sub new {
my $class = shift;
my $self = {};
- bless $self, $class
+ bless $self, $class;
$self->initialize();
return $self;
}
@@ -89,7 +105,7 @@ object into:
my $this = shift;
my $class = ref($this) || $this;
my $self = {};
- bless $self, $class
+ bless $self, $class;
$self->initialize();
return $self;
}
@@ -103,7 +119,8 @@ A constructor may re-bless a referenced object currently belonging to
another class, but then the new class is responsible for all cleanup
later. The previous blessing is forgotten, as an object may belong
to only one class at a time. (Although of course it's free to
-inherit methods from many classes.)
+inherit methods from many classes.) If you find yourself having to
+do this, the parent class is probably misbehaving, though.
A clarification: Perl objects are blessed. References are not. Objects
know which package they belong to. References do not. The bless()
@@ -124,7 +141,7 @@ Unlike say C++, Perl doesn't provide any special syntax for class
definitions. You use a package as a class by putting method
definitions into the class.
-There is a special array within each package called @ISA which says
+There is a special array within each package called @ISA, which says
where else to look for a method if you can't find it in the current
package. This is how Perl implements inheritance. Each element of the
@ISA array is just the name of another package that happens to be a
@@ -132,33 +149,44 @@ class package. The classes are searched (depth first) for missing
methods in the order that they occur in @ISA. The classes accessible
through @ISA are known as base classes of the current class.
+All classes implicitly inherit from class C<UNIVERSAL> as their
+last base class. Several commonly used methods are automatically
+supplied in the UNIVERSAL class; see L<"Default UNIVERSAL methods"> for
+more details.
+
If a missing method is found in one of the base classes, it is cached
in the current class for efficiency. Changing @ISA or defining new
subroutines invalidates the cache and causes Perl to do the lookup again.
-If a method isn't found, but an AUTOLOAD routine is found, then
-that is called on behalf of the missing method.
-
-If neither a method nor an AUTOLOAD routine is found in @ISA, then one
-last try is made for the method (or an AUTOLOAD routine) in a class
-called UNIVERSAL. (Several commonly used methods are automatically
-supplied in the UNIVERSAL class; see L<"Default UNIVERSAL methods"> for
-more details.) If that doesn't work, Perl finally gives up and
-complains.
-
-Perl classes do only method inheritance. Data inheritance is left
-up to the class itself. By and large, this is not a problem in Perl,
-because most classes model the attributes of their object using
-an anonymous hash, which serves as its own little namespace to be
-carved up by the various classes that might want to do something
-with the object.
+If neither the current class, its named base classes, nor the UNIVERSAL
+class contains the requested method, these three places are searched
+all over again, this time looking for a method named AUTOLOAD(). If an
+AUTOLOAD is found, this method is called on behalf of the missing method,
+setting the package global $AUTOLOAD to be the fully qualified name of
+the method that was intended to be called.
+
+If none of that works, Perl finally gives up and complains.
+
+Perl classes do method inheritance only. Data inheritance is left up
+to the class itself. By and large, this is not a problem in Perl,
+because most classes model the attributes of their object using an
+anonymous hash, which serves as its own little namespace to be carved up
+by the various classes that might want to do something with the object.
+The only problem with this is that you can't sure that you aren't using
+a piece of the hash that isn't already used. A reasonable workaround
+is to prepend your fieldname in the hash with the package name.
+
+ sub bump {
+ my $self = shift;
+ $self->{ __PACKAGE__ . ".count"}++;
+ }
=head2 A Method is Simply a Subroutine
Unlike say C++, Perl doesn't provide any special syntax for method
definition. (It does provide a little syntax for method invocation
though. More on that later.) A method expects its first argument
-to be the object or package it is being invoked on. There are just two
+to be the object (reference) or package (string) it is being invoked on. There are just two
types of methods, which we'll call class and instance.
(Sometimes you'll hear these called static and virtual, in honor of
the two C++ method types they most closely resemble.)
@@ -223,7 +251,7 @@ or in one statement,
There are times when one syntax is more readable, and times when the
other syntax is more readable. The indirect object syntax is less
cluttered, but it has the same ambiguity as ordinary list operators.
-Indirect object method calls are parsed using the same rule as list
+Indirect object method calls are usually parsed using the same rule as list
operators: "If it looks like a function, it is a function". (Presuming
for the moment that you think two words in a row can look like a
function name. C++ programmers seem to think so with some regularity,
@@ -240,7 +268,20 @@ would be equivalent to
Critter->new('Bam' x 2), 1.4, 45
-which is unlikely to do what you want.
+which is unlikely to do what you want. Confusingly, however, this
+rule applies only when the indirect object is a bareword package name,
+not when it's a scalar, a BLOCK, or a C<Package::> qualified package name.
+In those cases, the arguments are parsed in the same way as an
+indirect object list operator like print, so
+
+ new Critter:: ('Bam' x 2), 1.4, 45
+
+is the same as
+
+ Critter::->new(('Bam' x 2), 1.4, 45)
+
+For more reasons why the indirect object syntax is ambiguous, see
+L<"WARNING"> below.
There are times when you wish to specify which class's method to use.
In this case, you can call your method as an ordinary subroutine
@@ -291,7 +332,7 @@ allows the ability to check what a reference points to. Example
use UNIVERSAL qw(isa);
if(isa($ref, 'ARRAY')) {
- ...
+ #...
}
=item can(METHOD)
@@ -331,29 +372,68 @@ automatically destroyed. (This may even be after you exit, if you've
stored references in global variables.) If you want to capture control
just before the object is freed, you may define a DESTROY method in
your class. It will automatically be called at the appropriate moment,
-and you can do any extra cleanup you need to do.
-
-Perl doesn't do nested destruction for you. If your constructor
-re-blessed a reference from one of your base classes, your DESTROY may
-need to call DESTROY for any base classes that need it. But this applies
-to only re-blessed objects--an object reference that is merely
-I<CONTAINED> in the current object will be freed and destroyed
-automatically when the current object is freed.
+and you can do any extra cleanup you need to do. Perl passes a reference
+to the object under destruction as the first (and only) argument. Beware
+that the reference is a read-only value, and cannot be modified by
+manipulating C<$_[0]> within the destructor. The object itself (i.e.
+the thingy the reference points to, namely C<${$_[0]}>, C<@{$_[0]}>,
+C<%{$_[0]}> etc.) is not similarly constrained.
+
+If you arrange to re-bless the reference before the destructor returns,
+perl will again call the DESTROY method for the re-blessed object after
+the current one returns. This can be used for clean delegation of
+object destruction, or for ensuring that destructors in the base classes
+of your choosing get called. Explicitly calling DESTROY is also possible,
+but is usually never needed.
+
+Do not confuse the foregoing with how objects I<CONTAINED> in the current
+one are destroyed. Such objects will be freed and destroyed automatically
+when the current object is freed, provided no other references to them exist
+elsewhere.
=head2 WARNING
-An indirect object is limited to a name, a scalar variable, or a block,
-because it would have to do too much lookahead otherwise, just like any
-other postfix dereference in the language. The left side of -E<gt> is not so
-limited, because it's an infix operator, not a postfix operator.
+While indirect object syntax may well be appealing to English speakers and
+to C++ programmers, be not seduced! It suffers from two grave problems.
+
+The first problem is that an indirect object is limited to a name,
+a scalar variable, or a block, because it would have to do too much
+lookahead otherwise, just like any other postfix dereference in the
+language. (These are the same quirky rules as are used for the filehandle
+slot in functions like C<print> and C<printf>.) This can lead to horribly
+confusing precedence problems, as in these next two lines:
+
+ move $obj->{FIELD}; # probably wrong!
+ move $ary[$i]; # probably wrong!
+
+Those actually parse as the very surprising:
-That means that in the following, A and B are equivalent to each other, and
-C and D are equivalent, but A/B and C/D are different:
+ $obj->move->{FIELD}; # Well, lookee here
+ $ary->move->[$i]; # Didn't expect this one, eh?
- A: method $obref->{"fieldname"}
- B: (method $obref)->{"fieldname"}
- C: $obref->{"fieldname"}->method()
- D: method {$obref->{"fieldname"}}
+Rather than what you might have expected:
+
+ $obj->{FIELD}->move(); # You should be so lucky.
+ $ary[$i]->move; # Yeah, sure.
+
+The left side of ``-E<gt>'' is not so limited, because it's an infix operator,
+not a postfix operator.
+
+As if that weren't bad enough, think about this: Perl must guess I<at
+compile time> whether C<name> and C<move> above are functions or methods.
+Usually Perl gets it right, but when it doesn't it, you get a function
+call compiled as a method, or vice versa. This can introduce subtle
+bugs that are hard to unravel. For example, calling a method C<new>
+in indirect notation--as C++ programmers are so wont to do--can
+be miscompiled into a subroutine call if there's already a C<new>
+function in scope. You'd end up calling the current package's C<new>
+as a subroutine, rather than the desired class's method. The compiler
+tries to cheat by remembering bareword C<require>s, but the grief if it
+messes up just isn't worth the years of debugging it would likely take
+you to to track such subtle bugs down.
+
+The infix arrow notation using ``C<-E<gt>>'' doesn't suffer from either
+of these disturbing ambiguities, so we recommend you use it exclusively.
=head2 Summary
@@ -460,6 +540,11 @@ C<-DDEBUGGING> was enabled during perl build time.
A more complete garbage collection strategy will be implemented
at a future date.
+In the meantime, the best solution is to create a non-recursive container
+class that holds a pointer to the self-referential data structure.
+Define a DESTROY method for the containing object's class that manually
+breaks the circularities in the self-referential structure.
+
=head1 SEE ALSO
A kinder, gentler tutorial on object-oriented programming in Perl can
diff --git a/gnu/usr.bin/perl/pod/perlop.pod b/gnu/usr.bin/perl/pod/perlop.pod
index 17728df9d3e..9f6d9650259 100644
--- a/gnu/usr.bin/perl/pod/perlop.pod
+++ b/gnu/usr.bin/perl/pod/perlop.pod
@@ -38,11 +38,13 @@ operate on scalar values only, not array values.
In the following sections, these operators are covered in precedence order.
+Many operators can be overloaded for objects. See L<overload>.
+
=head1 DESCRIPTION
=head2 Terms and List Operators (Leftward)
-A TERM has the highest precedence in Perl. They includes variables,
+A TERM has the highest precedence in Perl. They include variables,
quote and quote-like operators, any expression in parentheses,
and any function whose arguments are parenthesized. Actually, there
aren't really functions in this sense, just list operators and unary
@@ -114,7 +116,7 @@ The auto-increment operator has a little extra builtin magic to it. If
you increment a variable that is numeric, or that has ever been used in
a numeric context, you get a normal increment. If, however, the
variable has been used in only string contexts since it was set, and
-has a value that is not null and matches the pattern
+has a value that is not the empty string and matches the pattern
C</^[a-zA-Z]*[0-9]*$/>, the increment is done as a string, preserving each
character within its range, with carry:
@@ -144,8 +146,9 @@ starts with a plus or minus, a string starting with the opposite sign
is returned. One effect of these rules is that C<-bareword> is equivalent
to C<"-bareword">.
-Unary "~" performs bitwise negation, i.e., 1's complement.
-(See also L<Integer Arithmetic>.)
+Unary "~" performs bitwise negation, i.e., 1's complement. For example,
+C<0666 &~ 027> is 0640. (See also L<Integer Arithmetic> and L<Bitwise
+String Operators>.)
Unary "+" has no effect whatsoever, even on strings. It is useful
syntactically for separating a function name from a parenthesized expression
@@ -162,11 +165,11 @@ thing from interpretation.
Binary "=~" binds a scalar expression to a pattern match. Certain operations
search or modify the string $_ by default. This operator makes that kind
of operation work on some other string. The right argument is a search
-pattern, substitution, or translation. The left argument is what is
-supposed to be searched, substituted, or translated instead of the default
+pattern, substitution, or transliteration. The left argument is what is
+supposed to be searched, substituted, or transliterated instead of the default
$_. The return value indicates the success of the operation. (If the
right argument is an expression rather than a search pattern,
-substitution, or translation, it is interpreted as a search pattern at run
+substitution, or transliteration, it is interpreted as a search pattern at run
time. This can be is less efficient than an explicit search, because the
pattern must be compiled every time the expression is evaluated.
@@ -184,11 +187,15 @@ operands C<$a> and C<$b>: If C<$b> is positive, then C<$a % $b> is
C<$a> minus the largest multiple of C<$b> that is not greater than
C<$a>. If C<$b> is negative, then C<$a % $b> is C<$a> minus the
smallest multiple of C<$b> that is not less than C<$a> (i.e. the
-result will be less than or equal to zero).
+result will be less than or equal to zero).
+Note than when C<use integer> is in scope, "%" give you direct access
+to the modulus operator as implemented by your C compiler. This
+operator is not as well defined for negative operands, but it will
+execute faster.
-Binary "x" is the repetition operator. In a scalar context, it
+Binary "x" is the repetition operator. In scalar context, it
returns a string consisting of the left operand repeated the number of
-times specified by the right operand. In a list context, if the left
+times specified by the right operand. In list context, if the left
operand is a list in parentheses, it repeats the list.
print '-' x 80; # print row of dashes
@@ -300,15 +307,15 @@ by the current locale if C<use locale> is in effect. See L<perllocale>.
=head2 Bitwise And
Binary "&" returns its operators ANDed together bit by bit.
-(See also L<Integer Arithmetic>.)
+(See also L<Integer Arithmetic> and L<Bitwise String Operators>.)
=head2 Bitwise Or and Exclusive Or
Binary "|" returns its operators ORed together bit by bit.
-(See also L<Integer Arithmetic>.)
+(See also L<Integer Arithmetic> and L<Bitwise String Operators>.)
Binary "^" returns its operators XORed together bit by bit.
-(See also L<Integer Arithmetic>.)
+(See also L<Integer Arithmetic> and L<Bitwise String Operators>.)
=head2 C-style Logical And
@@ -331,11 +338,18 @@ way to find out the home directory (assuming it's not "0") might be:
$home = $ENV{'HOME'} || $ENV{'LOGDIR'} ||
(getpwuid($<))[7] || die "You're homeless!\n";
-As more readable alternatives to C<&&> and C<||>, Perl provides "and" and
-"or" operators (see below). The short-circuit behavior is identical. The
-precedence of "and" and "or" is much lower, however, so that you can
-safely use them after a list operator without the need for
-parentheses:
+In particular, this means that you shouldn't use this
+for selecting between two aggregates for assignment:
+
+ @a = @b || @c; # this is wrong
+ @a = scalar(@b) || @c; # really meant this
+ @a = @b ? @b : @c; # this works fine, though
+
+As more readable alternatives to C<&&> and C<||> when used for
+control flow, Perl provides C<and> and C<or> operators (see below).
+The short-circuit behavior is identical. The precedence of "and" and
+"or" is much lower, however, so that you can safely use them after a
+list operator without the need for parentheses:
unlink "alpha", "beta", "gamma"
or gripe(), next LINE;
@@ -345,21 +359,24 @@ With the C-style operators that would have been written like this:
unlink("alpha", "beta", "gamma")
|| (gripe(), next LINE);
-=head2 Range Operator
+Use "or" for assignment is unlikely to do what you want; see below.
+
+=head2 Range Operators
Binary ".." is the range operator, which is really two different
-operators depending on the context. In a list context, it returns an
+operators depending on the context. In list context, it returns an
array of values counting (by ones) from the left value to the right
-value. This is useful for writing C<for (1..10)> loops and for doing
-slice operations on arrays. Be aware that under the current implementation,
-a temporary array is created, so you'll burn a lot of memory if you
-write something like this:
+value. This is useful for writing C<foreach (1..10)> loops and for
+doing slice operations on arrays. In the current implementation, no
+temporary array is created when the range operator is used as the
+expression in C<foreach> loops, but older versions of Perl might burn
+a lot of memory when you write something like this:
for (1 .. 1_000_000) {
# code
}
-In a scalar context, ".." returns a boolean value. The operator is
+In scalar context, ".." returns a boolean value. The operator is
bistable, like a flip-flop, and emulates the line-range (comma) operator
of B<sed>, B<awk>, and various editors. Each ".." operator maintains its
own boolean state. It is false as long as its left operand is false.
@@ -373,13 +390,13 @@ If you don't want it to test the right operand till the next evaluation
operand is not evaluated while the operator is in the "false" state, and
the left operand is not evaluated while the operator is in the "true"
state. The precedence is a little lower than || and &&. The value
-returned is either the null string for false, or a sequence number
+returned is either the empty string for false, or a sequence number
(beginning with 1) for true. The sequence number is reset for each range
encountered. The final sequence number in a range has the string "E0"
appended to it, which doesn't affect its numeric value, but gives you
something to search for if you want to exclude the endpoint. You can
exclude the beginning point by waiting for the sequence number to be
-greater than 1. If either operand of scalar ".." is a numeric literal,
+greater than 1. If either operand of scalar ".." is a constant expression,
that operand is implicitly compared to the C<$.> variable, the current
line number. Examples:
@@ -389,13 +406,22 @@ As a scalar operator:
next line if (1 .. /^$/); # skip header lines
s/^/> / if (/^$/ .. eof()); # quote body
+ # parse mail messages
+ while (<>) {
+ $in_header = 1 .. /^$/;
+ $in_body = /^$/ .. eof();
+ # do something based on those
+ } continue {
+ close ARGV if eof; # reset $. each file
+ }
+
As a list operator:
for (101 .. 200) { print; } # print $_ 100 times
@foo = @foo[0 .. $#foo]; # an expensive no-op
@foo = @foo[$#foo-4 .. $#foo]; # slice last 5 items
-The range operator (in a list context) makes use of the magical
+The range operator (in list context) makes use of the magical
auto-increment algorithm if the operands are strings. You
can say
@@ -438,6 +464,19 @@ legal lvalues (meaning that you can assign to them):
This is not necessarily guaranteed to contribute to the readability of your program.
+Because this operator produces an assignable result, using assignments
+without parentheses will get you in trouble. For example, this:
+
+ $a % 2 ? $a += 10 : $a += 2
+
+Really means this:
+
+ (($a % 2) ? ($a += 10) : $a) += 2
+
+Rather than this:
+
+ ($a % 2) ? ($a += 10) : ($a += 2)
+
=head2 Assignment Operators
"=" is the ordinary assignment operator.
@@ -480,11 +519,11 @@ is equivalent to
=head2 Comma Operator
-Binary "," is the comma operator. In a scalar context it evaluates
+Binary "," is the comma operator. In scalar context it evaluates
its left argument, throws that value away, then evaluates its right
argument and returns that value. This is just like C's comma operator.
-In a list context, it's just the list argument separator, and inserts
+In list context, it's just the list argument separator, and inserts
both its arguments into the list.
The =E<gt> digraph is mostly just a synonym for the comma operator. It's useful for
@@ -519,9 +558,27 @@ expression is evaluated only if the left expression is true.
=head2 Logical or and Exclusive Or
Binary "or" returns the logical disjunction of the two surrounding
-expressions. It's equivalent to || except for the very low
-precedence. This means that it short-circuits: i.e., the right
-expression is evaluated only if the left expression is false.
+expressions. It's equivalent to || except for the very low precedence.
+This makes it useful for control flow
+
+ print FH $data or die "Can't write to FH: $!";
+
+This means that it short-circuits: i.e., the right expression is evaluated
+only if the left expression is false. Due to its precedence, you should
+probably avoid using this for assignment, only for control flow.
+
+ $a = $b or $c; # bug: this is wrong
+ ($a = $b) or $c; # really means this
+ $a = $b || $c; # better written this way
+
+However, when it's a list context assignment and you're trying to use
+"||" for control flow, you probably need "or" so that the assignment
+takes higher precedence.
+
+ @info = stat($file) || die; # oops, scalar sense of stat!
+ @info = stat($file) or die; # better, now @info gets its due
+
+Then again, you could always use parentheses.
Binary "xor" returns the exclusive-OR of the two surrounding expressions.
It cannot short circuit, of course.
@@ -558,46 +615,68 @@ any pair of delimiters you choose. Non-bracketing delimiters use
the same character fore and aft, but the 4 sorts of brackets
(round, angle, square, curly) will all nest.
- Customary Generic Meaning Interpolates
- '' q{} Literal no
- "" qq{} Literal yes
- `` qx{} Command yes
- qw{} Word list no
- // m{} Pattern match yes
- s{}{} Substitution yes
- tr{}{} Translation no
+ Customary Generic Meaning Interpolates
+ '' q{} Literal no
+ "" qq{} Literal yes
+ `` qx{} Command yes (unless '' is delimiter)
+ qw{} Word list no
+ // m{} Pattern match yes (unless '' is delimiter)
+ qr{} Pattern yes (unless '' is delimiter)
+ s{}{} Substitution yes (unless '' is delimiter)
+ tr{}{} Transliteration no (but see below)
Note that there can be whitespace between the operator and the quoting
characters, except when C<#> is being used as the quoting character.
-C<q#foo#> is parsed as being the string C<foo>, which C<q #foo#> is the
+C<q#foo#> is parsed as being the string C<foo>, while C<q #foo#> is the
operator C<q> followed by a comment. Its argument will be taken from the
next line. This allows you to write:
s {foo} # Replace foo
{bar} # with bar.
-For constructs that do interpolation, variables beginning with "C<$>" or "C<@>"
-are interpolated, as are the following sequences:
+For constructs that do interpolation, variables beginning with "C<$>"
+or "C<@>" are interpolated, as are the following sequences. Within
+a transliteration, the first ten of these sequences may be used.
\t tab (HT, TAB)
- \n newline (LF, NL)
+ \n newline (NL)
\r return (CR)
\f form feed (FF)
\b backspace (BS)
\a alarm (bell) (BEL)
\e escape (ESC)
- \033 octal char
- \x1b hex char
+ \033 octal char (ESC)
+ \x1b hex char (ESC)
\c[ control char
+
\l lowercase next char
\u uppercase next char
\L lowercase till \E
\U uppercase till \E
\E end case modification
- \Q quote regexp metacharacters till \E
+ \Q quote non-word characters till \E
If C<use locale> is in effect, the case map used by C<\l>, C<\L>, C<\u>
-and <\U> is taken from the current locale. See L<perllocale>.
+and C<\U> is taken from the current locale. See L<perllocale>.
+
+All systems use the virtual C<"\n"> to represent a line terminator,
+called a "newline". There is no such thing as an unvarying, physical
+newline character. It is an illusion that the operating system,
+device drivers, C libraries, and Perl all conspire to preserve. Not all
+systems read C<"\r"> as ASCII CR and C<"\n"> as ASCII LF. For example,
+on a Mac, these are reversed, and on systems without line terminator,
+printing C<"\n"> may emit no actual data. In general, use C<"\n"> when
+you mean a "newline" for your system, but use the literal ASCII when you
+need an exact character. For example, most networking protocols expect
+and prefer a CR+LF (C<"\012\015"> or C<"\cJ\cM">) for line terminators,
+and although they often accept just C<"\012">, they seldom tolerate just
+C<"\015">. If you get in the habit of using C<"\n"> for networking,
+you may be burned some day.
+
+You cannot include a literal C<$> or C<@> within a C<\Q> sequence.
+An unescaped C<$> or C<@> interpolates the corresponding variable,
+while escaping will cause the literal string C<\$> to be inserted.
+You'll need to write something like C<m/\Quser\E\@\Qhost/>.
Patterns are subject to an additional level of interpretation as a
regular expression. This is done as a second pass, after variables are
@@ -615,6 +694,18 @@ evaluation of variables when used within double quotes.
Here are the quote-like operators that apply to pattern
matching and related activities.
+Most of this section is related to use of regular expressions from Perl.
+Such a use may be considered from two points of view: Perl handles a
+a string and a "pattern" to RE (regular expression) engine to match,
+RE engine finds (or does not find) the match, and Perl uses the findings
+of RE engine for its operation, possibly asking the engine for other matches.
+
+RE engine has no idea what Perl is going to do with what it finds,
+similarly, the rest of Perl has no idea what a particular regular expression
+means to RE engine. This creates a clean separation, and in this section
+we discuss matching from Perl point of view only. The other point of
+view may be found in L<perlre>.
+
=over 8
=item ?PATTERN?
@@ -625,6 +716,14 @@ optimization when you want to see only the first occurrence of
something in each file of a set of files, for instance. Only C<??>
patterns local to the current package are reset.
+ while (<>) {
+ if (?^$?) {
+ # blank line between header and body
+ }
+ } continue {
+ reset if eof; # clear ?? status for next file
+ }
+
This usage is vaguely deprecated, and may be removed in some future
version of Perl.
@@ -632,13 +731,13 @@ version of Perl.
=item /PATTERN/cgimosx
-Searches a string for a pattern match, and in a scalar context returns
+Searches a string for a pattern match, and in scalar context returns
true (1) or false (''). If no string is specified via the C<=~> or
C<!~> operator, the $_ string is searched. (The string specified with
C<=~> need not be an lvalue--it may be the result of an expression
evaluation, but remember the C<=~> binds rather tightly.) See also
L<perlre>.
-See L<perllocale> for discussion of additional considerations which apply
+See L<perllocale> for discussion of additional considerations that apply
when C<use locale> is in effect.
Options are:
@@ -652,30 +751,34 @@ Options are:
x Use extended regular expressions.
If "/" is the delimiter then the initial C<m> is optional. With the C<m>
-you can use any pair of non-alphanumeric, non-whitespace characters as
-delimiters. This is particularly useful for matching Unix path names
-that contain "/", to avoid LTS (leaning toothpick syndrome). If "?" is
+you can use any pair of non-alphanumeric, non-whitespace characters
+as delimiters. This is particularly useful for matching Unix path names
+that contain "/", to avoid LTS (leaning toothpick syndrome). If "?" is
the delimiter, then the match-only-once rule of C<?PATTERN?> applies.
+If "'" is the delimiter, no variable interpolation is performed on the
+PATTERN.
PATTERN may contain variables, which will be interpolated (and the
-pattern recompiled) every time the pattern search is evaluated. (Note
-that C<$)> and C<$|> might not be interpolated because they look like
-end-of-string tests.) If you want such a pattern to be compiled only
-once, add a C</o> after the trailing delimiter. This avoids expensive
-run-time recompilations, and is useful when the value you are
-interpolating won't change over the life of the script. However, mentioning
-C</o> constitutes a promise that you won't change the variables in the pattern.
-If you change them, Perl won't even notice.
-
-If the PATTERN evaluates to a null string, the last
-successfully executed regular expression is used instead.
-
-If used in a context that requires a list value, a pattern match returns a
+pattern recompiled) every time the pattern search is evaluated, except
+for when the delimiter is a single quote. (Note that C<$)> and C<$|>
+might not be interpolated because they look like end-of-string tests.)
+If you want such a pattern to be compiled only once, add a C</o> after
+the trailing delimiter. This avoids expensive run-time recompilations,
+and is useful when the value you are interpolating won't change over
+the life of the script. However, mentioning C</o> constitutes a promise
+that you won't change the variables in the pattern. If you change them,
+Perl won't even notice.
+
+If the PATTERN evaluates to the empty string, the last
+I<successfully> matched regular expression is used instead.
+
+If the C</g> option is not used, C<m//> in a list context returns a
list consisting of the subexpressions matched by the parentheses in the
-pattern, i.e., (C<$1>, $2, $3...). (Note that here $1 etc. are also set, and
-that this differs from Perl 4's behavior.) If the match fails, a null
-array is returned. If the match succeeds, but there were no parentheses,
-a list value of (1) is returned.
+pattern, i.e., (C<$1>, C<$2>, C<$3>...). (Note that here C<$1> etc. are
+also set, and that this differs from Perl 4's behavior.) When there are
+no parentheses in the pattern, the return value is the list C<(1)> for
+success. With or without parentheses, an empty list is returned upon
+failure.
Examples:
@@ -701,20 +804,18 @@ the pattern matched.
The C</g> modifier specifies global pattern matching--that is, matching
as many times as possible within the string. How it behaves depends on
-the context. In a list context, it returns a list of all the
+the context. In list context, it returns a list of all the
substrings matched by all the parentheses in the regular expression.
If there are no parentheses, it returns a list of all the matched
strings, as if there were parentheses around the whole pattern.
-In a scalar context, C<m//g> iterates through the string, returning TRUE
-each time it matches, and FALSE when it eventually runs out of matches.
-(In other words, it remembers where it left off last time and restarts
-the search at that point. You can actually find the current match
-position of a string or set it using the pos() function; see
-L<perlfunc/pos>.) A failed match normally resets the search position to
-the beginning of the string, but you can avoid that by adding the C</c>
-modifier (e.g. C<m//gc>). Modifying the target string also resets the
-search position.
+In scalar context, each execution of C<m//g> finds the next match,
+returning TRUE if it matches, and FALSE if there is no further match.
+The position after the last match can be read or set using the pos()
+function; see L<perlfunc/pos>. A failed match normally resets the
+search position to the beginning of the string, but you can avoid that
+by adding the C</c> modifier (e.g. C<m//gc>). Modifying the target
+string also resets the search position.
You can intermix C<m//g> matches with C<m/\G.../g>, where C<\G> is a
zero-width assertion that matches the exact position where the previous
@@ -728,10 +829,12 @@ Examples:
($one,$five,$fifteen) = (`uptime` =~ /(\d+\.\d+)/g);
# scalar context
- $/ = ""; $* = 1; # $* deprecated in modern perls
- while (defined($paragraph = <>)) {
- while ($paragraph =~ /[a-z]['")]*[.!?]+['")]*\s/g) {
- $sentences++;
+ {
+ local $/ = "";
+ while (defined($paragraph = <>)) {
+ while ($paragraph =~ /[a-z]['")]*[.!?]+['")]*\s/g) {
+ $sentences++;
+ }
}
}
print "$sentences\n";
@@ -806,21 +909,113 @@ A double-quoted, interpolated string.
if /(tcl|rexx|python)/; # :-)
$baz = "\n"; # a one-character string
+=item qr/PATTERN/imosx
+
+Quote-as-a-regular-expression operator. I<STRING> is interpolated the
+same way as I<PATTERN> in C<m/PATTERN/>. If "'" is used as the
+delimiter, no variable interpolation is done. Returns a Perl value
+which may be used instead of the corresponding C</STRING/imosx> expression.
+
+For example,
+
+ $rex = qr/my.STRING/is;
+ s/$rex/foo/;
+
+is equivalent to
+
+ s/my.STRING/foo/is;
+
+The result may be used as a subpattern in a match:
+
+ $re = qr/$pattern/;
+ $string =~ /foo${re}bar/; # can be interpolated in other patterns
+ $string =~ $re; # or used standalone
+ $string =~ /$re/; # or this way
+
+Since Perl may compile the pattern at the moment of execution of qr()
+operator, using qr() may have speed advantages in I<some> situations,
+notably if the result of qr() is used standalone:
+
+ sub match {
+ my $patterns = shift;
+ my @compiled = map qr/$_/i, @$patterns;
+ grep {
+ my $success = 0;
+ foreach my $pat @compiled {
+ $success = 1, last if /$pat/;
+ }
+ $success;
+ } @_;
+ }
+
+Precompilation of the pattern into an internal representation at the
+moment of qr() avoids a need to recompile the pattern every time a
+match C</$pat/> is attempted. (Note that Perl has many other
+internal optimizations, but none would be triggered in the above
+example if we did not use qr() operator.)
+
+Options are:
+
+ i Do case-insensitive pattern matching.
+ m Treat string as multiple lines.
+ o Compile pattern only once.
+ s Treat string as single line.
+ x Use extended regular expressions.
+
+See L<perlre> for additional information on valid syntax for STRING, and
+for a detailed look at the semantics of regular expressions.
+
=item qx/STRING/
=item `STRING`
-A string which is interpolated and then executed as a system command.
-The collected standard output of the command is returned. In scalar
-context, it comes back as a single (potentially multi-line) string.
-In list context, returns a list of lines (however you've defined lines
-with $/ or $INPUT_RECORD_SEPARATOR).
+A string which is (possibly) interpolated and then executed as a system
+command with C</bin/sh> or its equivalent. Shell wildcards, pipes,
+and redirections will be honored. The collected standard output of the
+command is returned; standard error is unaffected. In scalar context,
+it comes back as a single (potentially multi-line) string. In list
+context, returns a list of lines (however you've defined lines with $/
+or $INPUT_RECORD_SEPARATOR).
+
+Because backticks do not affect standard error, use shell file descriptor
+syntax (assuming the shell supports this) if you care to address this.
+To capture a command's STDERR and STDOUT together:
+
+ $output = `cmd 2>&1`;
+
+To capture a command's STDOUT but discard its STDERR:
+
+ $output = `cmd 2>/dev/null`;
+
+To capture a command's STDERR but discard its STDOUT (ordering is
+important here):
+
+ $output = `cmd 2>&1 1>/dev/null`;
+
+To exchange a command's STDOUT and STDERR in order to capture the STDERR
+but leave its STDOUT to come out the old STDERR:
+
+ $output = `cmd 3>&1 1>&2 2>&3 3>&-`;
+
+To read both a command's STDOUT and its STDERR separately, it's easiest
+and safest to redirect them separately to files, and then read from those
+files when the program is done:
+
+ system("program args 1>/tmp/program.stdout 2>/tmp/program.stderr");
+
+Using single-quote as a delimiter protects the command from Perl's
+double-quote interpolation, passing it on to the shell instead:
- $today = qx{ date };
+ $perl_info = qx(ps $$); # that's Perl's $$
+ $shell_info = qx'ps $$'; # that's the new shell's $$
+
+Note that how the string gets evaluated is entirely subject to the command
+interpreter on your system. On most platforms, you will have to protect
+shell metacharacters if you want them treated literally. This is in
+practice difficult to do, as it's unclear how to escape which characters.
+See L<perlsec> for a clean and safe example of a manual fork() and exec()
+to emulate backticks safely.
-Note that how the string gets evaluated is entirely subject to the
-command interpreter on your system. On most platforms, you will have
-to protect shell metacharacters if you want them treated literally.
On some platforms (notably DOS-like ones), the shell may not be
capable of dealing with multiline commands, so putting newlines in
the string may not get you what you want. You may be able to evaluate
@@ -833,8 +1028,14 @@ of the command line. You must ensure your strings don't exceed this
limit after any necessary interpolations. See the platform-specific
release notes for more details about your particular environment.
-Also realize that using this operator frequently leads to unportable
-programs.
+Using this operator can lead to programs that are difficult to port,
+because the shell commands called vary between systems, and may in
+fact not be present at all. As one example, the C<type> command under
+the POSIX shell is very different from the C<type> command under DOS.
+That doesn't mean you should go out of your way to avoid backticks
+when they're the right way to get something done. Perl was made to be
+a glue language, and one of the things it glues together is commands.
+Just understand what you're getting yourself into.
See L<"I/O Operators"> for more discussion.
@@ -845,13 +1046,22 @@ whitespace as the word delimiters. It is exactly equivalent to
split(' ', q/STRING/);
+This equivalency means that if used in scalar context, you'll get split's
+(unfortunate) scalar context behavior, complete with mysterious warnings.
+However do not rely on this as in a future release it could be changed to
+be exactly equivalent to the list
+
+ ('foo', 'bar', 'baz')
+
+Which in a scalar context would result in C<'baz'>.
+
Some frequently seen examples:
use POSIX qw( setlocale localeconv )
@EXPORT = qw( foo bar baz );
A common mistake is to try to separate the words with comma or to put
-comments into a multi-line qw-string. For this reason the C<-w>
+comments into a multi-line C<qw>-string. For this reason the C<-w>
switch produce warnings if the STRING contains the "," or the "#"
character.
@@ -863,18 +1073,18 @@ made. Otherwise it returns false (specifically, the empty string).
If no string is specified via the C<=~> or C<!~> operator, the C<$_>
variable is searched and modified. (The string specified with C<=~> must
-be a scalar variable, an array element, a hash element, or an assignment
+be scalar variable, an array element, a hash element, or an assignment
to one of those, i.e., an lvalue.)
-If the delimiter chosen is single quote, no variable interpolation is
+If the delimiter chosen is a single quote, no variable interpolation is
done on either the PATTERN or the REPLACEMENT. Otherwise, if the
PATTERN contains a $ that looks like a variable rather than an
end-of-string test, the variable will be interpolated into the pattern
at run-time. If you want the pattern compiled only once the first time
the variable is interpolated, use the C</o> option. If the pattern
-evaluates to a null string, the last successfully executed regular
+evaluates to the empty string, the last successfully executed regular
expression is used instead. See L<perlre> for further explanation on these.
-See L<perllocale> for discussion of additional considerations which apply
+See L<perllocale> for discussion of additional considerations that apply
when C<use locale> is in effect.
Options are:
@@ -895,7 +1105,7 @@ text is not evaluated as a command. If the
PATTERN is delimited by bracketing quotes, the REPLACEMENT has its own
pair of quotes, which may or may not be bracketing quotes, e.g.,
C<s(foo)(bar)> or C<sE<lt>fooE<gt>/bar/>. A C</e> will cause the
-replacement portion to be interpreter as a full-fledged Perl expression
+replacement portion to be interpreted as a full-fledged Perl expression
and eval()ed right then and there. It is, however, syntax checked at
compile-time.
@@ -907,9 +1117,9 @@ Examples:
s/Login: $foo/Login: $bar/; # run-time pattern
- ($foo = $bar) =~ s/this/that/;
+ ($foo = $bar) =~ s/this/that/; # copy first, then change
- $count = ($paragraph =~ s/Mister\b/Mr./g);
+ $count = ($paragraph =~ s/Mister\b/Mr./g); # get change-count
$_ = 'abc123xyz';
s/\d+/$&*2/e; # yields 'abc246xyz'
@@ -920,18 +1130,27 @@ Examples:
s/%(.)/$percent{$1} || $&/ge; # expr now, so /e
s/^=(\w+)/&pod($1)/ge; # use function call
+ # expand variables in $_, but dynamics only, using
+ # symbolic dereferencing
+ s/\$(\w+)/${$1}/g;
+
# /e's can even nest; this will expand
- # simple embedded variables in $_
+ # any embedded scalar variable (including lexicals) in $_
s/(\$\w+)/$1/eeg;
- # Delete C comments.
+ # Delete (most) C comments.
$program =~ s {
/\* # Match the opening delimiter.
.*? # Match a minimal number of characters.
\*/ # Match the closing delimiter.
} []gsx;
- s/^\s*(.*?)\s*$/$1/; # trim white space
+ s/^\s*(.*?)\s*$/$1/; # trim white space in $_, expensively
+
+ for ($variable) { # trim white space in $variable, cheap
+ s/^\s+//;
+ s/\s+$//;
+ }
s/([^ ]*) *([^ ]*)/$2 $1/; # reverse 1st two fields
@@ -954,16 +1173,26 @@ to occur. Here are two common cases:
=item y/SEARCHLIST/REPLACEMENTLIST/cds
-Translates all occurrences of the characters found in the search list
+Transliterates all occurrences of the characters found in the search list
with the corresponding character in the replacement list. It returns
the number of characters replaced or deleted. If no string is
-specified via the =~ or !~ operator, the $_ string is translated. (The
+specified via the =~ or !~ operator, the $_ string is transliterated. (The
string specified with =~ must be a scalar variable, an array element, a
hash element, or an assignment to one of those, i.e., an lvalue.)
+
+A character range may be specified with a hyphen, so C<tr/A-J/0-9/>
+does the same replacement as C<tr/ACEGIBDFHJ/0246813579/>.
For B<sed> devotees, C<y> is provided as a synonym for C<tr>. If the
SEARCHLIST is delimited by bracketing quotes, the REPLACEMENTLIST has
its own pair of quotes, which may or may not be bracketing quotes,
-e.g., C<tr[A-Z][a-z]> or C<tr(+-*/)/ABCD/>.
+e.g., C<tr[A-Z][a-z]> or C<tr(+\-*/)/ABCD/>.
+
+Note also that the whole range idea is rather unportable between
+character sets--and even within character sets they may cause results
+you probably didn't expect. A sound principle is to use only ranges
+that begin from and end at either alphabets of equal case (a-e, A-E),
+or digits (0-4). Anything else is unsafe. If in doubt, spell out the
+character sets in full.
Options:
@@ -977,13 +1206,13 @@ by SEARCHLIST not found in REPLACEMENTLIST are deleted. (Note
that this is slightly more flexible than the behavior of some B<tr>
programs, which delete anything they find in the SEARCHLIST, period.)
If the C</s> modifier is specified, sequences of characters that were
-translated to the same character are squashed down to a single instance of the
+transliterated to the same character are squashed down to a single instance of the
character.
If the C</d> modifier is used, the REPLACEMENTLIST is always interpreted
exactly as specified. Otherwise, if the REPLACEMENTLIST is shorter
than the SEARCHLIST, the final character is replicated till it is long
-enough. If the REPLACEMENTLIST is null, the SEARCHLIST is replicated.
+enough. If the REPLACEMENTLIST is empty, the SEARCHLIST is replicated.
This latter is useful for counting characters in a class or for
squashing character sequences in a class.
@@ -1006,13 +1235,13 @@ Examples:
tr [\200-\377]
[\000-\177]; # delete 8th bit
-If multiple translations are given for a character, only the first one is used:
+If multiple transliterations are given for a character, only the first one is used:
tr/AAA/XYZ/
-will translate any A to X.
+will transliterate any A to X.
-Note that because the translation table is built at compile time, neither
+Note that because the transliteration table is built at compile time, neither
the SEARCHLIST nor the REPLACEMENTLIST are subjected to double quote
interpolation. That means that if you want to use variables, you must use
an eval():
@@ -1024,14 +1253,250 @@ an eval():
=back
+=head2 Gory details of parsing quoted constructs
+
+When presented with something which may have several different
+interpretations, Perl uses the principle B<DWIM> (expanded to Do What I Mean
+- not what I wrote) to pick up the most probable interpretation of the
+source. This strategy is so successful that Perl users usually do not
+suspect ambivalence of what they write. However, time to time Perl's ideas
+differ from what the author meant.
+
+The target of this section is to clarify the Perl's way of interpreting
+quoted constructs. The most frequent reason one may have to want to know the
+details discussed in this section is hairy regular expressions. However, the
+first steps of parsing are the same for all Perl quoting operators, so here
+they are discussed together.
+
+The most important detail of Perl parsing rules is the first one
+discussed below; when processing a quoted construct, Perl I<first>
+finds the end of the construct, then it interprets the contents of the
+construct. If you understand this rule, you may skip the rest of this
+section on the first reading. The other rules would
+contradict user's expectations much less frequently than the first one.
+
+Some of the passes discussed below are performed concurrently, but as
+far as results are the same, we consider them one-by-one. For different
+quoting constructs Perl performs different number of passes, from
+one to five, but they are always performed in the same order.
+
+=over
+
+=item Finding the end
+
+First pass is finding the end of the quoted construct, be it
+a multichar delimiter
+C<"\nEOF\n"> of C<<<EOF> construct, C</> which terminates C<qq/> construct,
+C<]> which terminates C<qq[> construct, or C<E<gt>> which terminates a
+fileglob started with C<<>.
+
+When searching for one-char non-matching delimiter, such as C</>, combinations
+C<\\> and C<\/> are skipped. When searching for one-char matching delimiter,
+such as C<]>, combinations C<\\>, C<\]> and C<\[> are skipped, and
+nested C<[>, C<]> are skipped as well. When searching for multichar delimiter
+no skipping is performed.
+
+For constructs with 3-part delimiters (C<s///> etc.) the search is
+repeated once more.
+
+During this search no attention is paid to the semantic of the construct,
+thus:
+
+ "$hash{"$foo/$bar"}"
+
+or:
+
+ m/
+ bar # NOT a comment, this slash / terminated m//!
+ /x
+
+do not form legal quoted expressions, the quoted part ends on the first C<">
+and C</>, and the rest happens to be a syntax error. Note that since the slash
+which terminated C<m//> was followed by a C<SPACE>, the above is not C<m//x>,
+but rather C<m//> with no 'x' switch. So the embedded C<#> is interpreted
+as a literal C<#>.
+
+=item Removal of backslashes before delimiters
+
+During the second pass the text between the starting delimiter and
+the ending delimiter is copied to a safe location, and the C<\> is
+removed from combinations consisting of C<\> and delimiter(s) (both starting
+and ending delimiter if they differ).
+
+The removal does not happen for multi-char delimiters.
+
+Note that the combination C<\\> is left as it was!
+
+Starting from this step no information about the delimiter(s) is used in the
+parsing.
+
+=item Interpolation
+
+Next step is interpolation in the obtained delimiter-independent text.
+There are four different cases.
+
+=over
+
+=item C<<<'EOF'>, C<m''>, C<s'''>, C<tr///>, C<y///>
+
+No interpolation is performed.
+
+=item C<''>, C<q//>
+
+The only interpolation is removal of C<\> from pairs C<\\>.
+
+=item C<"">, C<``>, C<qq//>, C<qx//>, C<<file*globE<gt>>
+
+C<\Q>, C<\U>, C<\u>, C<\L>, C<\l> (possibly paired with C<\E>) are converted
+to corresponding Perl constructs, thus C<"$foo\Qbaz$bar"> is converted to :
+
+ $foo . (quotemeta("baz" . $bar));
+
+Other combinations of C<\> with following chars are substituted with
+appropriate expansions.
+
+Let it be stressed that I<whatever is between C<\Q> and C<\E>> is interpolated
+in the usual way. Say, C<"\Q\\E"> has no C<\E> inside: it has C<\Q>, C<\\>,
+and C<E>, thus the result is the same as for C<"\\\\E">. Generally speaking,
+having backslashes between C<\Q> and C<\E> may lead to counterintuitive
+results. So, C<"\Q\t\E"> is converted to:
+
+ quotemeta("\t")
+
+which is the same as C<"\\\t"> (since TAB is not alphanumerical). Note also
+that:
+
+ $str = '\t';
+ return "\Q$str";
+
+may be closer to the conjectural I<intention> of the writer of C<"\Q\t\E">.
+
+Interpolated scalars and arrays are internally converted to the C<join> and
+C<.> Perl operations, thus C<"$foo >>> '@arr'"> becomes:
+
+ $foo . " >>> '" . (join $", @arr) . "'";
+
+All the operations in the above are performed simultaneously left-to-right.
+
+Since the result of "\Q STRING \E" has all the metacharacters quoted
+there is no way to insert a literal C<$> or C<@> inside a C<\Q\E> pair: if
+protected by C<\> C<$> will be quoted to became "\\\$", if not, it is
+interpreted as starting an interpolated scalar.
+
+Note also that the interpolating code needs to make a decision on where the
+interpolated scalar ends. For instance, whether C<"a $b -E<gt> {c}"> means:
+
+ "a " . $b . " -> {c}";
+
+or:
+
+ "a " . $b -> {c};
+
+I<Most of the time> the decision is to take the longest possible text which
+does not include spaces between components and contains matching
+braces/brackets. Since the outcome may be determined by I<voting> based
+on heuristic estimators, the result I<is not strictly predictable>, but
+is usually correct for the ambiguous cases.
+
+=item C<?RE?>, C</RE/>, C<m/RE/>, C<s/RE/foo/>,
+
+Processing of C<\Q>, C<\U>, C<\u>, C<\L>, C<\l> and interpolation happens
+(almost) as with C<qq//> constructs, but I<the substitution of C<\> followed by
+RE-special chars (including C<\>) is not performed>! Moreover,
+inside C<(?{BLOCK})>, C<(?# comment )>, and C<#>-comment of
+C<//x>-regular expressions no processing is performed at all.
+This is the first step where presence of the C<//x> switch is relevant.
+
+Interpolation has several quirks: C<$|>, C<$(> and C<$)> are not interpolated, and
+constructs C<$var[SOMETHING]> are I<voted> (by several different estimators)
+to be an array element or C<$var> followed by a RE alternative. This is
+the place where the notation C<${arr[$bar]}> comes handy: C</${arr[0-9]}/>
+is interpreted as an array element C<-9>, not as a regular expression from
+variable C<$arr> followed by a digit, which is the interpretation of
+C</$arr[0-9]/>. Since voting among different estimators may be performed,
+the result I<is not predictable>.
+
+It is on this step that C<\1> is converted to C<$1> in the replacement
+text of C<s///>.
+
+Note that absence of processing of C<\\> creates specific restrictions on the
+post-processed text: if the delimiter is C</>, one cannot get the combination
+C<\/> into the result of this step: C</> will finish the regular expression,
+C<\/> will be stripped to C</> on the previous step, and C<\\/> will be left
+as is. Since C</> is equivalent to C<\/> inside a regular expression, this
+does not matter unless the delimiter is a special character for the RE engine,
+as in C<s*foo*bar*>, C<m[foo]>, or C<?foo?>, or an alphanumeric char, as in:
+
+ m m ^ a \s* b mmx;
+
+In the above RE, which is intentionally obfuscated for illustration, the
+delimiter is C<m>, the modifier is C<mx>, and after backslash-removal the
+RE is the same as for C<m/ ^ a s* b /mx>).
+
+=back
+
+This step is the last one for all the constructs except regular expressions,
+which are processed further.
+
+=item Interpolation of regular expressions
+
+All the previous steps were performed during the compilation of Perl code,
+this one happens in run time (though it may be optimized to be calculated
+at compile time if appropriate). After all the preprocessing performed
+above (and possibly after evaluation if catenation, joining, up/down-casing
+and C<quotemeta()>ing are involved) the resulting I<string> is passed to RE
+engine for compilation.
+
+Whatever happens in the RE engine is better be discussed in L<perlre>,
+but for the sake of continuity let us do it here.
+
+This is another step where presence of the C<//x> switch is relevant.
+The RE engine scans the string left-to-right, and converts it to a finite
+automaton.
+
+Backslashed chars are either substituted by corresponding literal
+strings (as with C<\{>), or generate special nodes of the finite automaton
+(as with C<\b>). Characters which are special to the RE engine (such as
+C<|>) generate corresponding nodes or groups of nodes. C<(?#...)>
+comments are ignored. All the rest is either converted to literal strings
+to match, or is ignored (as is whitespace and C<#>-style comments if
+C<//x> is present).
+
+Note that the parsing of the construct C<[...]> is performed using
+rather different rules than for the rest of the regular expression.
+The terminator of this construct is found using the same rules as for
+finding a terminator of a C<{}>-delimited construct, the only exception
+being that C<]> immediately following C<[> is considered as if preceded
+by a backslash. Similarly, the terminator of C<(?{...})> is found using
+the same rules as for finding a terminator of a C<{}>-delimited construct.
+
+It is possible to inspect both the string given to RE engine, and the
+resulting finite automaton. See arguments C<debug>/C<debugcolor>
+of C<use L<re>> directive, and/or B<-Dr> option of Perl in
+L<perlrun/Switches>.
+
+=item Optimization of regular expressions
+
+This step is listed for completeness only. Since it does not change
+semantics, details of this step are not documented and are subject
+to change. This step is performed over the finite automaton generated
+during the previous pass.
+
+However, in older versions of Perl C<L<split>> used to silently
+optimize C</^/> to mean C</^/m>. This behaviour, though present
+in current versions of Perl, may be deprecated in future.
+
+=back
+
=head2 I/O Operators
There are several I/O operators you should know about.
-A string is enclosed by backticks (grave accents) first undergoes
+
+A string enclosed by backticks (grave accents) first undergoes
variable substitution just like a double quoted string. It is then
interpreted as a command, and the output of that command is the value
-of the pseudo-literal, like in a shell. In a scalar context, a single
-string consisting of all the output is returned. In a list context,
+of the pseudo-literal, like in a shell. In scalar context, a single
+string consisting of all the output is returned. In list context,
a list of values is returned, one for each line of output. (You can
set C<$/> to use a different line terminator.) The command is executed
each time the pseudo-literal is evaluated. The status value of the
@@ -1044,39 +1509,64 @@ The generalized form of backticks is C<qx//>. (Because backticks
always undergo shell expansion as well, see L<perlsec> for
security concerns.)
-Evaluating a filehandle in angle brackets yields the next line from
-that file (newline, if any, included), or C<undef> at end of file.
-Ordinarily you must assign that value to a variable, but there is one
+In a scalar context, evaluating a filehandle in angle brackets yields the
+next line from that file (newline, if any, included), or C<undef> at
+end-of-file. When C<$/> is set to C<undef> (i.e. file slurp mode),
+and the file is empty, it returns C<''> the first time, followed by
+C<undef> subsequently.
+
+Ordinarily you must assign the returned value to a variable, but there is one
situation where an automatic assignment happens. I<If and ONLY if> the
input symbol is the only thing inside the conditional of a C<while> or
C<for(;;)> loop, the value is automatically assigned to the variable
-C<$_>. The assigned value is then tested to see if it is defined.
-(This may seem like an odd thing to you, but you'll use the construct
-in almost every Perl script you write.) Anyway, the following lines
-are equivalent to each other:
+C<$_>. In these loop constructs, the assigned value (whether assignment
+is automatic or explicit) is then tested to see if it is defined.
+The defined test avoids problems where line has a string value
+that would be treated as false by perl e.g. "" or "0" with no trailing
+newline. (This may seem like an odd thing to you, but you'll use the
+construct in almost every Perl script you write.) Anyway, the following
+lines are equivalent to each other:
while (defined($_ = <STDIN>)) { print; }
+ while ($_ = <STDIN>) { print; }
while (<STDIN>) { print; }
for (;<STDIN>;) { print; }
print while defined($_ = <STDIN>);
+ print while ($_ = <STDIN>);
print while <STDIN>;
+and this also behaves similarly, but avoids the use of $_ :
+
+ while (my $line = <STDIN>) { print $line }
+
+If you really mean such values to terminate the loop they should be
+tested for explicitly:
+
+ while (($_ = <STDIN>) ne '0') { ... }
+ while (<STDIN>) { last unless $_; ... }
+
+In other boolean contexts, C<E<lt>I<filehandle>E<gt>> without explicit C<defined>
+test or comparison will solicit a warning if C<-w> is in effect.
+
The filehandles STDIN, STDOUT, and STDERR are predefined. (The
filehandles C<stdin>, C<stdout>, and C<stderr> will also work except in
packages, where they would be interpreted as local identifiers rather
than global.) Additional filehandles may be created with the open()
-function. See L<perlfunc/open()> for details on this.
+function. See L<perlfunc/open> for details on this.
If a E<lt>FILEHANDLEE<gt> is used in a context that is looking for a list, a
list consisting of all the input lines is returned, one line per list
element. It's easy to make a I<LARGE> data space this way, so use with
care.
+E<lt>FILEHANDLEE<gt> may also be spelt readline(FILEHANDLE). See
+L<perlfunc/readline>.
+
The null filehandle E<lt>E<gt> is special and can be used to emulate the
behavior of B<sed> and B<awk>. Input from E<lt>E<gt> comes either from
standard input, or from each file listed on the command line. Here's
how it works: the first time E<lt>E<gt> is evaluated, the @ARGV array is
-checked, and if it is null, C<$ARGV[0]> is set to "-", which when opened
+checked, and if it is empty, C<$ARGV[0]> is set to "-", which when opened
gives you standard input. The @ARGV array is then processed as a list
of filenames. The loop
@@ -1103,10 +1593,19 @@ doesn't work because it treats E<lt>ARGVE<gt> as non-magical.)
You can modify @ARGV before the first E<lt>E<gt> as long as the array ends up
containing the list of filenames you really want. Line numbers (C<$.>)
continue as if the input were one big happy file. (But see example
-under eof() for how to reset line numbers on each file.)
+under C<eof> for how to reset line numbers on each file.)
-If you want to set @ARGV to your own list of files, go right ahead. If
-you want to pass switches into your script, you can use one of the
+If you want to set @ARGV to your own list of files, go right ahead.
+This sets @ARGV to all plain text files if no @ARGV was given:
+
+ @ARGV = grep { -f && -T } glob('*') unless @ARGV;
+
+You can even set them to pipe commands. For example, this automatically
+filters compressed arguments through B<gzip>:
+
+ @ARGV = map { /\.(gz|Z)$/ ? "gzip -dc < $_ |" : $_ } @ARGV;
+
+If you want to pass switches into your script, you can use one of the
Getopts modules or put a loop on the front like this:
while ($_ = $ARGV[0], /^-/) {
@@ -1114,34 +1613,41 @@ Getopts modules or put a loop on the front like this:
last if /^--$/;
if (/^-D(.*)/) { $debug = $1 }
if (/^-v/) { $verbose++ }
- ... # other switches
+ # ... # other switches
}
+
while (<>) {
- ... # code for each line
+ # ... # code for each line
}
-The E<lt>E<gt> symbol will return FALSE only once. If you call it again after
-this it will assume you are processing another @ARGV list, and if you
-haven't set @ARGV, will input from STDIN.
+The E<lt>E<gt> symbol will return C<undef> for end-of-file only once.
+If you call it again after this it will assume you are processing another
+@ARGV list, and if you haven't set @ARGV, will input from STDIN.
If the string inside the angle brackets is a reference to a scalar
variable (e.g., E<lt>$fooE<gt>), then that variable contains the name of the
-filehandle to input from, or a reference to the same. For example:
+filehandle to input from, or its typeglob, or a reference to the same. For example:
$fh = \*STDIN;
$line = <$fh>;
-If the string inside angle brackets is not a filehandle or a scalar
-variable containing a filehandle name or reference, then it is interpreted
-as a filename pattern to be globbed, and either a list of filenames or the
-next filename in the list is returned, depending on context. One level of
-$ interpretation is done first, but you can't say C<E<lt>$fooE<gt>>
-because that's an indirect filehandle as explained in the previous
-paragraph. (In older versions of Perl, programmers would insert curly
-brackets to force interpretation as a filename glob: C<E<lt>${foo}E<gt>>.
-These days, it's considered cleaner to call the internal function directly
-as C<glob($foo)>, which is probably the right way to have done it in the
-first place.) Example:
+If what's within the angle brackets is neither a filehandle nor a simple
+scalar variable containing a filehandle name, typeglob, or typeglob
+reference, it is interpreted as a filename pattern to be globbed, and
+either a list of filenames or the next filename in the list is returned,
+depending on context. This distinction is determined on syntactic
+grounds alone. That means C<E<lt>$xE<gt>> is always a readline from
+an indirect handle, but C<E<lt>$hash{key}E<gt>> is always a glob.
+That's because $x is a simple scalar variable, but C<$hash{key}> is
+not--it's a hash element.
+
+One level of double-quote interpretation is done first, but you can't
+say C<E<lt>$fooE<gt>> because that's an indirect filehandle as explained
+in the previous paragraph. (In older versions of Perl, programmers
+would insert curly brackets to force interpretation as a filename glob:
+C<E<lt>${foo}E<gt>>. These days, it's considered cleaner to call the
+internal function directly as C<glob($foo)>, which is probably the right
+way to have done it in the first place.) Example:
while (<*.c>) {
chmod 0644, $_;
@@ -1169,10 +1675,13 @@ long" errors (unless you've installed tcsh(1L) as F</bin/csh>).
A glob evaluates its (embedded) argument only when it is starting a new
list. All values must be read before it will start over. In a list
context this isn't important, because you automatically get them all
-anyway. In a scalar context, however, the operator returns the next value
-each time it is called, or a FALSE value if you've just run out. Again,
-FALSE is returned only once. So if you're expecting a single value from
-a glob, it is much better to say
+anyway. In scalar context, however, the operator returns the next value
+each time it is called, or a C<undef> value if you've just run out. As
+for filehandles an automatic C<defined> is generated when the glob
+occurs in the test part of a C<while> or C<for> - because legal glob returns
+(e.g. a file called F<0>) would otherwise terminate the loop.
+Again, C<undef> is returned only once. So if you're expecting a single value
+from a glob, it is much better to say
($file) = <blurch*>;
@@ -1193,7 +1702,7 @@ to become confused with the indirect filehandle notation.
=head2 Constant Folding
Like C, Perl does a certain amount of expression evaluation at
-compile time, whenever it determines that all of the arguments to an
+compile time, whenever it determines that all arguments to an
operator are static and have no side effects. In particular, string
concatenation happens at compile time between literals that don't do
variable substitution. Backslash interpretation also happens at
@@ -1206,13 +1715,45 @@ and this all reduces to one string internally. Likewise, if
you say
foreach $file (@filenames) {
- if (-s $file > 5 + 100 * 2**16) { ... }
+ if (-s $file > 5 + 100 * 2**16) { }
}
the compiler will precompute the number that
expression represents so that the interpreter
won't have to.
+=head2 Bitwise String Operators
+
+Bitstrings of any size may be manipulated by the bitwise operators
+(C<~ | & ^>).
+
+If the operands to a binary bitwise op are strings of different sizes,
+B<|> and B<^> ops will act as if the shorter operand had additional
+zero bits on the right, while the B<&> op will act as if the longer
+operand were truncated to the length of the shorter. Note that the
+granularity for such extension or truncation is one or more I<bytes>.
+
+ # ASCII-based examples
+ print "j p \n" ^ " a h"; # prints "JAPH\n"
+ print "JA" | " ph\n"; # prints "japh\n"
+ print "japh\nJunk" & '_____'; # prints "JAPH\n";
+ print 'p N$' ^ " E<H\n"; # prints "Perl\n";
+
+If you are intending to manipulate bitstrings, you should be certain that
+you're supplying bitstrings: If an operand is a number, that will imply
+a B<numeric> bitwise operation. You may explicitly show which type of
+operation you intend by using C<""> or C<0+>, as in the examples below.
+
+ $foo = 150 | 105 ; # yields 255 (0x96 | 0x69 is 0xFF)
+ $foo = '150' | 105 ; # yields 255
+ $foo = 150 | '105'; # yields 255
+ $foo = '150' | '105'; # yields string '155' (under ASCII)
+
+ $baz = 0+$foo & 0+$bar; # both ops explicitly numeric
+ $biz = "$foo" ^ "$bar"; # both ops explicitly stringy
+
+See L<perlfunc/vec> for information on how to manipulate individual bits
+in a bit vector.
=head2 Integer Arithmetic
@@ -1230,11 +1771,12 @@ countermand this by saying
which lasts until the end of that BLOCK.
The bitwise operators ("&", "|", "^", "~", "<<", and ">>") always
-produce integral results. However, C<use integer> still has meaning
+produce integral results. (But see also L<Bitwise String Operators>.)
+However, C<use integer> still has meaning
for them. By default, their results are interpreted as unsigned
integers. However, if C<use integer> is in effect, their results are
interpreted as signed integers. For example, C<~0> usually evaluates
-to a large integral value. However, C<use integer; ~0> is -1.
+to a large integral value. However, C<use integer; ~0> is -1 on twos-complement machines.
=head2 Floating-point Arithmetic
@@ -1243,6 +1785,27 @@ similar ways to provide rounding or truncation at a certain number of
decimal places. For rounding to a certain number of digits, sprintf()
or printf() is usually the easiest route.
+Floating-point numbers are only approximations to what a mathematician
+would call real numbers. There are infinitely more reals than floats,
+so some corners must be cut. For example:
+
+ printf "%.20g\n", 123456789123456789;
+ # produces 123456789123456784
+
+Testing for exact equality of floating-point equality or inequality is
+not a good idea. Here's a (relatively expensive) work-around to compare
+whether two floating-point numbers are equal to a particular number of
+decimal places. See Knuth, volume II, for a more robust treatment of
+this topic.
+
+ sub fp_equal {
+ my ($X, $Y, $POINTS) = @_;
+ my ($tX, $tY);
+ $tX = sprintf("%.${POINTS}g", $X);
+ $tY = sprintf("%.${POINTS}g", $Y);
+ return $tX eq $tY;
+ }
+
The POSIX module (part of the standard perl distribution) implements
ceil(), floor(), and a number of other mathematical and trigonometric
functions. The Math::Complex module (part of the standard perl
@@ -1255,3 +1818,17 @@ the rounding method used should be specified precisely. In these
cases, it probably pays not to trust whichever system rounding is
being used by Perl, but to instead implement the rounding function you
need yourself.
+
+=head2 Bigger Numbers
+
+The standard Math::BigInt and Math::BigFloat modules provide
+variable precision arithmetic and overloaded operators.
+At the cost of some space and considerable speed, they
+avoid the normal pitfalls associated with limited-precision
+representations.
+
+ use Math::BigInt;
+ $x = Math::BigInt->new('123456789123456789');
+ print $x * $x;
+
+ # prints +15241578780673678515622620750190521
diff --git a/gnu/usr.bin/perl/pod/perlpod.pod b/gnu/usr.bin/perl/pod/perlpod.pod
index 6a578caec35..7fa8290f1d7 100644
--- a/gnu/usr.bin/perl/pod/perlpod.pod
+++ b/gnu/usr.bin/perl/pod/perlpod.pod
@@ -7,10 +7,12 @@ perlpod - plain old documentation
A pod-to-whatever translator reads a pod file paragraph by paragraph,
and translates it to the appropriate output format. There are
three kinds of paragraphs:
+L<verbatim|/"Verbatim Paragraph">,
+L<command|/"Command Paragraph">, and
+L<ordinary text|/"Ordinary Block of Text">.
-=over 4
-=item *
+=head2 Verbatim Paragraph
A verbatim paragraph, distinguished by being indented (that is,
it starts with space or tab). It should be reproduced exactly,
@@ -18,9 +20,10 @@ with tabs assumed to be on 8-column boundaries. There are no
special formatting escapes, so you can't italicize or anything
like that. A \ means \, and nothing else.
-=item *
-A command. All command paragraphs start with "=", followed by an
+=head2 Command Paragraph
+
+All command paragraphs start with "=", followed by an
identifier, followed by arbitrary text that the command can
use however it pleases. Currently recognized commands are
@@ -35,13 +38,29 @@ use however it pleases. Currently recognized commands are
=begin X
=end X
+=over 4
+
+=item =pod
+
+=item =cut
+
The "=pod" directive does nothing beyond telling the compiler to lay
off parsing code through the next "=cut". It's useful for adding
another paragraph to the doc if you're mixing up code and pod a lot.
+=item =head1
+
+=item =head2
+
Head1 and head2 produce first and second level headings, with the text in
the same paragraph as the "=headn" directive forming the heading description.
+=item =over
+
+=item =back
+
+=item =item
+
Item, over, and back require a little more explanation: "=over" starts a
section specifically for the generation of a list using "=item" commands. At
the end of your list, use "=back" to end it. You will probably want to give
@@ -56,6 +75,13 @@ or use "=item 1.", "=item 2.", etc., to produce numbered lists, or use
or numbers. If you start with bullets or numbers, stick with them, as many
formatters use the first "=item" type to decide how to format the list.
+
+=item =for
+
+=item =begin
+
+=item =end
+
For, begin, and end let you include sections that are not interpreted
as pod text, but passed directly to particular formatters. A formatter
that can utilize that format will use the section, otherwise it will be
@@ -123,9 +149,13 @@ Some examples of lists include:
=back
-=item *
-An ordinary block of text. It will be filled, and maybe even
+=back
+
+
+=head2 Ordinary Block of Text
+
+It will be filled, and maybe even
justified. Certain interior sequences are recognized both
here and in commands:
@@ -140,19 +170,31 @@ here and in commands:
L<"sec"> section in this manual page
(the quotes are optional)
L</"sec"> ditto
+ same as above but only 'text' is used for output.
+ (Text can not contain the characters '/' and '|',
+ and should contain matched '<' or '>')
+ L<text|name>
+ L<text|name/ident>
+ L<text|name/"sec">
+ L<text|"sec">
+ L<text|/"sec">
+
F<file> Used for filenames
X<index> An index entry
Z<> A zero-width character
E<escape> A named character (very similar to HTML escapes)
E<lt> A literal <
E<gt> A literal >
+ E<sol> A literal /
+ E<verbar> A literal |
(these are optional except in other interior
sequences and when preceded by a capital letter)
E<n> Character number n (probably in ASCII)
E<html> Some non-numeric HTML entity, such
as E<Agrave>
-=back
+
+=head2 The Intent
That's it. The intent is simplicity, not power. I wanted paragraphs
to look like paragraphs (block format), so that they stand out
@@ -179,9 +221,10 @@ Note that I'm not at all claiming this to be sufficient for producing a
book. I'm just trying to make an idiot-proof common source for nroff,
TeX, and other markup languages, as used for online documentation.
Translators exist for B<pod2man> (that's for nroff(1) and troff(1)),
-B<pod2html>, B<pod2latex>, and B<pod2fm>.
+B<pod2text>, B<pod2html>, B<pod2latex>, and B<pod2fm>.
-=head1 Embedding Pods in Perl Modules
+
+=head2 Embedding Pods in Perl Modules
You can embed pod documentation in your Perl scripts. Start your
documentation with a "=head1" command at the beginning, and end it
@@ -201,7 +244,8 @@ directive.
If you had not had that empty line there, then the translators wouldn't
have seen it.
-=head1 Common Pod Pitfalls
+
+=head2 Common Pod Pitfalls
=over 4
@@ -219,6 +263,10 @@ B<pod2man> for details). Thus, you shouldn't write things like C<the
LE<lt>fooE<gt> manpage>, if you want the translated document to read
sensibly.
+If you don need or want total control of the text used for a
+link in the output use the form LE<lt>show this text|fooE<gt>
+instead.
+
=item *
The script F<pod/checkpods.PL> in the Perl source distribution
diff --git a/gnu/usr.bin/perl/pod/perlre.pod b/gnu/usr.bin/perl/pod/perlre.pod
index 14892a88460..d4c1deee88f 100644
--- a/gnu/usr.bin/perl/pod/perlre.pod
+++ b/gnu/usr.bin/perl/pod/perlre.pod
@@ -6,13 +6,14 @@ perlre - Perl regular expressions
This page describes the syntax of regular expressions in Perl. For a
description of how to I<use> regular expressions in matching
-operations, plus various examples of the same, see C<m//> and C<s///> in
-L<perlop>.
+operations, plus various examples of the same, see discussion
+of C<m//>, C<s///>, C<qr//> and C<??> in L<perlop/"Regexp Quote-Like Operators">.
The matching operations can have various modifiers. The modifiers
-which relate to the interpretation of the regular expression inside
-are listed below. For the modifiers that alter the behaviour of the
-operation, see L<perlop/"m//"> and L<perlop/"s//">.
+that relate to the interpretation of the regular expression inside
+are listed below. For the modifiers that alter the way a regular expression
+is used by Perl, see L<perlop/"Regexp Quote-Like Operators"> and
+L<perlop/"Gory details of parsing quoted constructs">.
=over 4
@@ -34,6 +35,13 @@ line anywhere within the string,
Treat string as single line. That is, change "." to match any character
whatsoever, even a newline, which it normally would not match.
+The C</s> and C</m> modifiers both override the C<$*> setting. That is, no matter
+what C<$*> contains, C</s> without C</m> will force "^" to match only at the
+beginning of the string and "$" to match only at the end (or just before a
+newline at the end) of the string. Together, as /ms, they let the "." match
+any character whatsoever, while yet allowing "^" and "$" to match,
+respectively, just after and just before newlines within the string.
+
=item x
Extend your pattern's legibility by permitting whitespace and comments.
@@ -51,15 +59,19 @@ backslashed nor within a character class. You can use this to break up
your regular expression into (slightly) more readable parts. The C<#>
character is also treated as a metacharacter introducing a comment,
just as in ordinary Perl code. This also means that if you want real
-whitespace or C<#> characters in the pattern that you'll have to either
+whitespace or C<#> characters in the pattern (outside of a character
+class, where they are unaffected by C</x>), that you'll either have to
escape them or encode them using octal or hex escapes. Taken together,
these features go a long way towards making Perl's regular expressions
-more readable. See the C comment deletion code in L<perlop>.
+more readable. Note that you have to be careful not to include the
+pattern delimiter in the comment--perl has no way of knowing you did
+not intend to close the pattern early. See the C-comment deletion code
+in L<perlop>.
=head2 Regular Expressions
The patterns used in pattern matching are regular expressions such as
-those supplied in the Version 8 regexp routines. (In fact, the
+those supplied in the Version 8 regex routines. (In fact, the
routines are derived (distantly) from Henry Spencer's freely
redistributable reimplementation of the V8 routines.)
See L<Version 8 Regular Expressions> for details.
@@ -104,7 +116,11 @@ The following standard quantifiers are recognized:
(If a curly bracket occurs in any other context, it is treated
as a regular character.) The "*" modifier is equivalent to C<{0,}>, the "+"
modifier to C<{1,}>, and the "?" modifier to C<{0,1}>. n and m are limited
-to integral values less than 65536.
+to integral values less than a preset limit defined when perl is built.
+This is usually 32766 on the most common platforms. The actual limit can
+be seen in the error message generated by code such as this:
+
+ $_ **= $_ , / {$_} / for 2 .. 42;
By default, a quantified subpattern is "greedy", that is, it will match as
many times as possible (given a particular starting location) while still
@@ -136,10 +152,15 @@ also work:
\L lowercase till \E (think vi)
\U uppercase till \E (think vi)
\E end case modification (think vi)
- \Q quote (disable) regexp metacharacters till \E
+ \Q quote (disable) pattern metacharacters till \E
If C<use locale> is in effect, the case map used by C<\l>, C<\L>, C<\u>
-and <\U> is taken from the current locale. See L<perllocale>.
+and C<\U> is taken from the current locale. See L<perllocale>.
+
+You cannot include a literal C<$> or C<@> within a C<\Q> sequence.
+An unescaped C<$> or C<@> interpolates the corresponding variable,
+while escaping will cause the literal string C<\$> to be matched.
+You'll need to write something like C<m/\Quser\E\@\Qhost/>.
In addition, Perl defines the following:
@@ -150,7 +171,7 @@ In addition, Perl defines the following:
\d Match a digit character
\D Match a non-digit character
-Note that C<\w> matches a single alphanumeric character, not a whole
+A C<\w> matches a single alphanumeric character, not a whole
word. To match a word you'd need to say C<\w+>. If C<use locale> is in
effect, the list of alphabetic characters generated by C<\w> is taken
from the current locale. See L<perllocale>. You may use C<\w>, C<\W>,
@@ -161,8 +182,9 @@ Perl defines the following zero-width assertions:
\b Match a word boundary
\B Match a non-(word boundary)
- \A Match at only beginning of string
- \Z Match at only end of string (or before newline at the end)
+ \A Match only at beginning of string
+ \Z Match only at end of string, or before newline at the end
+ \z Match only at end of string
\G Match only where previous m//g left off (works only with /g)
A word boundary (C<\b>) is defined as a spot between two characters that
@@ -170,15 +192,15 @@ has a C<\w> on one side of it and a C<\W> on the other side of it (in
either order), counting the imaginary characters off the beginning and
end of the string as matching a C<\W>. (Within character classes C<\b>
represents backspace rather than a word boundary.) The C<\A> and C<\Z> are
-just like "^" and "$" except that they won't match multiple times when the
+just like "^" and "$", except that they won't match multiple times when the
C</m> modifier is used, while "^" and "$" will match at every internal line
boundary. To match the actual end of the string, not ignoring newline,
-you can use C<\Z(?!\n)>. The C<\G> assertion can be used to chain global
+you can use C<\z>. The C<\G> assertion can be used to chain global
matches (using C<m//g>), as described in
L<perlop/"Regexp Quote-Like Operators">.
It is also useful when writing C<lex>-like scanners, when you have several
-regexps which you want to match against consequent substrings of your
+patterns that you want to match against consequent substrings of your
string, see the previous reference.
The actual location where C<\G> will match can also be influenced
by using C<pos()> as an lvalue. See L<perlfunc/pos>.
@@ -218,27 +240,27 @@ Once perl sees that you need one of C<$&>, C<$`> or C<$'> anywhere in
the program, it has to provide them on each and every pattern match.
This can slow your program down. The same mechanism that handles
these provides for the use of $1, $2, etc., so you pay the same price
-for each regexp that contains capturing parentheses. But if you never
-use $&, etc., in your script, then regexps I<without> capturing
+for each pattern that contains capturing parentheses. But if you never
+use $&, etc., in your script, then patterns I<without> capturing
parentheses won't be penalized. So avoid $&, $', and $` if you can,
but if you can't (and some algorithms really appreciate them), once
you've used them once, use them at will, because you've already paid
-the price.
+the price. As of 5.005, $& is not so costly as the other two.
-You will note that all backslashed metacharacters in Perl are
+Backslashed metacharacters in Perl are
alphanumeric, such as C<\b>, C<\w>, C<\n>. Unlike some other regular
expression languages, there are no backslashed symbols that aren't
alphanumeric. So anything that looks like \\, \(, \), \E<lt>, \E<gt>,
\{, or \} is always interpreted as a literal character, not a
metacharacter. This was once used in a common idiom to disable or
quote the special meanings of regular expression metacharacters in a
-string that you want to use for a pattern. Simply quote all the
+string that you want to use for a pattern. Simply quote all
non-alphanumeric characters:
$pattern =~ s/(\W)/\\$1/g;
Now it is much more common to see either the quotemeta() function or
-the \Q escape sequence used to disable the metacharacters special
+the C<\Q> escape sequence used to disable all metacharacters' special
meanings like this:
/$unquoted\Q$quoted\E$unquoted/
@@ -251,46 +273,218 @@ function of the extension. Several extensions are already supported:
=over 10
-=item (?#text)
+=item C<(?#text)>
A comment. The text is ignored. If the C</x> switch is used to enable
-whitespace formatting, a simple C<#> will suffice.
+whitespace formatting, a simple C<#> will suffice. Note that perl closes
+the comment as soon as it sees a C<)>, so there is no way to put a literal
+C<)> in the comment.
+
+=item C<(?:pattern)>
-=item (?:regexp)
+=item C<(?imsx-imsx:pattern)>
-This groups things like "()" but doesn't make backreferences like "()" does. So
+This is for clustering, not capturing; it groups subexpressions like
+"()", but doesn't make backreferences as "()" does. So
- split(/\b(?:a|b|c)\b/)
+ @fields = split(/\b(?:a|b|c)\b/)
is like
- split(/\b(a|b|c)\b/)
+ @fields = split(/\b(a|b|c)\b/)
but doesn't spit out extra fields.
-=item (?=regexp)
+The letters between C<?> and C<:> act as flags modifiers, see
+L<C<(?imsx-imsx)>>. In particular,
+
+ /(?s-i:more.*than).*million/i
+
+is equivalent to more verbose
+
+ /(?:(?s-i)more.*than).*million/i
+
+=item C<(?=pattern)>
A zero-width positive lookahead assertion. For example, C</\w+(?=\t)/>
matches a word followed by a tab, without including the tab in C<$&>.
-=item (?!regexp)
+=item C<(?!pattern)>
A zero-width negative lookahead assertion. For example C</foo(?!bar)/>
matches any occurrence of "foo" that isn't followed by "bar". Note
however that lookahead and lookbehind are NOT the same thing. You cannot
-use this for lookbehind: C</(?!foo)bar/> will not find an occurrence of
-"bar" that is preceded by something which is not "foo". That's because
-the C<(?!foo)> is just saying that the next thing cannot be "foo"--and
-it's not, it's a "bar", so "foobar" will match. You would have to do
-something like C</(?!foo)...bar/> for that. We say "like" because there's
-the case of your "bar" not having three characters before it. You could
-cover that this way: C</(?:(?!foo)...|^..?)bar/>. Sometimes it's still
-easier just to say:
+use this for lookbehind.
- if (/foo/ && $` =~ /bar$/)
-
-
-=item (?imsx)
+If you are looking for a "bar" that isn't preceded by a "foo", C</(?!foo)bar/>
+will not do what you want. That's because the C<(?!foo)> is just saying that
+the next thing cannot be "foo"--and it's not, it's a "bar", so "foobar" will
+match. You would have to do something like C</(?!foo)...bar/> for that. We
+say "like" because there's the case of your "bar" not having three characters
+before it. You could cover that this way: C</(?:(?!foo)...|^.{0,2})bar/>.
+Sometimes it's still easier just to say:
+
+ if (/bar/ && $` !~ /foo$/)
+
+For lookbehind see below.
+
+=item C<(?E<lt>=pattern)>
+
+A zero-width positive lookbehind assertion. For example, C</(?E<lt>=\t)\w+/>
+matches a word following a tab, without including the tab in C<$&>.
+Works only for fixed-width lookbehind.
+
+=item C<(?<!pattern)>
+
+A zero-width negative lookbehind assertion. For example C</(?<!bar)foo/>
+matches any occurrence of "foo" that isn't following "bar".
+Works only for fixed-width lookbehind.
+
+=item C<(?{ code })>
+
+Experimental "evaluate any Perl code" zero-width assertion. Always
+succeeds. C<code> is not interpolated. Currently the rules to
+determine where the C<code> ends are somewhat convoluted.
+
+The C<code> is properly scoped in the following sense: if the assertion
+is backtracked (compare L<"Backtracking">), all the changes introduced after
+C<local>isation are undone, so
+
+ $_ = 'a' x 8;
+ m<
+ (?{ $cnt = 0 }) # Initialize $cnt.
+ (
+ a
+ (?{
+ local $cnt = $cnt + 1; # Update $cnt, backtracking-safe.
+ })
+ )*
+ aaaa
+ (?{ $res = $cnt }) # On success copy to non-localized
+ # location.
+ >x;
+
+will set C<$res = 4>. Note that after the match $cnt returns to the globally
+introduced value 0, since the scopes which restrict C<local> statements
+are unwound.
+
+This assertion may be used as L<C<(?(condition)yes-pattern|no-pattern)>>
+switch. If I<not> used in this way, the result of evaluation of C<code>
+is put into variable $^R. This happens immediately, so $^R can be used from
+other C<(?{ code })> assertions inside the same regular expression.
+
+The above assignment to $^R is properly localized, thus the old value of $^R
+is restored if the assertion is backtracked (compare L<"Backtracking">).
+
+Due to security concerns, this construction is not allowed if the regular
+expression involves run-time interpolation of variables, unless
+C<use re 'eval'> pragma is used (see L<re>), or the variables contain
+results of qr() operator (see L<perlop/"qr/STRING/imosx">).
+
+This restriction is due to the wide-spread (questionable) practice of
+using the construct
+
+ $re = <>;
+ chomp $re;
+ $string =~ /$re/;
+
+without tainting. While this code is frowned upon from security point
+of view, when C<(?{})> was introduced, it was considered bad to add
+I<new> security holes to existing scripts.
+
+B<NOTE:> Use of the above insecure snippet without also enabling taint mode
+is to be severely frowned upon. C<use re 'eval'> does not disable tainting
+checks, thus to allow $re in the above snippet to contain C<(?{})>
+I<with tainting enabled>, one needs both C<use re 'eval'> and untaint
+the $re.
+
+=item C<(?E<gt>pattern)>
+
+An "independent" subexpression. Matches the substring that a
+I<standalone> C<pattern> would match if anchored at the given position,
+B<and only this substring>.
+
+Say, C<^(?E<gt>a*)ab> will never match, since C<(?E<gt>a*)> (anchored
+at the beginning of string, as above) will match I<all> characters
+C<a> at the beginning of string, leaving no C<a> for C<ab> to match.
+In contrast, C<a*ab> will match the same as C<a+b>, since the match of
+the subgroup C<a*> is influenced by the following group C<ab> (see
+L<"Backtracking">). In particular, C<a*> inside C<a*ab> will match
+fewer characters than a standalone C<a*>, since this makes the tail match.
+
+An effect similar to C<(?E<gt>pattern)> may be achieved by
+
+ (?=(pattern))\1
+
+since the lookahead is in I<"logical"> context, thus matches the same
+substring as a standalone C<a+>. The following C<\1> eats the matched
+string, thus making a zero-length assertion into an analogue of
+C<(?E<gt>...)>. (The difference between these two constructs is that the
+second one uses a catching group, thus shifting ordinals of
+backreferences in the rest of a regular expression.)
+
+This construct is useful for optimizations of "eternal"
+matches, because it will not backtrack (see L<"Backtracking">).
+
+ m{ \(
+ (
+ [^()]+
+ |
+ \( [^()]* \)
+ )+
+ \)
+ }x
+
+That will efficiently match a nonempty group with matching
+two-or-less-level-deep parentheses. However, if there is no such group,
+it will take virtually forever on a long string. That's because there are
+so many different ways to split a long string into several substrings.
+This is what C<(.+)+> is doing, and C<(.+)+> is similar to a subpattern
+of the above pattern. Consider that the above pattern detects no-match
+on C<((()aaaaaaaaaaaaaaaaaa> in several seconds, but that each extra
+letter doubles this time. This exponential performance will make it
+appear that your program has hung.
+
+However, a tiny modification of this pattern
+
+ m{ \(
+ (
+ (?> [^()]+ )
+ |
+ \( [^()]* \)
+ )+
+ \)
+ }x
+
+which uses C<(?E<gt>...)> matches exactly when the one above does (verifying
+this yourself would be a productive exercise), but finishes in a fourth
+the time when used on a similar string with 1000000 C<a>s. Be aware,
+however, that this pattern currently triggers a warning message under
+B<-w> saying it C<"matches the null string many times">):
+
+On simple groups, such as the pattern C<(?E<gt> [^()]+ )>, a comparable
+effect may be achieved by negative lookahead, as in C<[^()]+ (?! [^()] )>.
+This was only 4 times slower on a string with 1000000 C<a>s.
+
+=item C<(?(condition)yes-pattern|no-pattern)>
+
+=item C<(?(condition)yes-pattern)>
+
+Conditional expression. C<(condition)> should be either an integer in
+parentheses (which is valid if the corresponding pair of parentheses
+matched), or lookahead/lookbehind/evaluate zero-width assertion.
+
+Say,
+
+ m{ ( \( )?
+ [^()]+
+ (?(1) \) )
+ }x
+
+matches a chunk of non-parentheses, possibly included in parentheses
+themselves.
+
+=item C<(?imsx-imsx)>
One or more embedded pattern-match modifiers. This is particularly
useful for patterns that are specified in a table somewhere, some of
@@ -299,26 +493,36 @@ insensitive ones need to include merely C<(?i)> at the front of the
pattern. For example:
$pattern = "foobar";
- if ( /$pattern/i )
+ if ( /$pattern/i ) { }
# more flexible:
$pattern = "(?i)foobar";
- if ( /$pattern/ )
+ if ( /$pattern/ ) { }
+
+Letters after C<-> switch modifiers off.
+
+These modifiers are localized inside an enclosing group (if any). Say,
+
+ ( (?i) blah ) \s+ \1
+
+(assuming C<x> modifier, and no C<i> modifier outside of this group)
+will match a repeated (I<including the case>!) word C<blah> in any
+case.
=back
-The specific choice of question mark for this and the new minimal
-matching construct was because 1) question mark is pretty rare in older
-regular expressions, and 2) whenever you see one, you should stop
-and "question" exactly what is going on. That's psychology...
+A question mark was chosen for this and for the new minimal-matching
+construct because 1) question mark is pretty rare in older regular
+expressions, and 2) whenever you see one, you should stop and "question"
+exactly what is going on. That's psychology...
=head2 Backtracking
-A fundamental feature of regular expression matching involves the notion
-called I<backtracking>. which is used (when needed) by all regular
-expression quantifiers, namely C<*>, C<*?>, C<+>, C<+?>, C<{n,m}>, and
-C<{n,m}?>.
+A fundamental feature of regular expression matching involves the
+notion called I<backtracking>, which is currently used (when needed)
+by all regular expression quantifiers, namely C<*>, C<*?>, C<+>,
+C<+?>, C<{n,m}>, and C<{n,m}?>.
For a regular expression to match, the I<entire> regular expression must
match, not just part of it. So if the beginning of a pattern containing a
@@ -417,16 +621,17 @@ As you see, this can be a bit tricky. It's important to realize that a
regular expression is merely a set of assertions that gives a definition
of success. There may be 0, 1, or several different ways that the
definition might succeed against a particular string. And if there are
-multiple ways it might succeed, you need to understand backtracking to know which variety of success you will achieve.
+multiple ways it might succeed, you need to understand backtracking to
+know which variety of success you will achieve.
When using lookahead assertions and negations, this can all get even
tricker. Imagine you'd like to find a sequence of non-digits not
followed by "123". You might try to write that as
- $_ = "ABC123";
- if ( /^\D*(?!123)/ ) { # Wrong!
- print "Yup, no 123 in $_\n";
- }
+ $_ = "ABC123";
+ if ( /^\D*(?!123)/ ) { # Wrong!
+ print "Yup, no 123 in $_\n";
+ }
But that isn't going to match; at least, not the way you're hoping. It
claims that there is no 123 in the string. Here's a clearer picture of
@@ -456,14 +661,13 @@ non-digits, you have something that's not 123?" If the pattern matcher had
let C<\D*> expand to "ABC", this would have caused the whole pattern to
fail.
The search engine will initially match C<\D*> with "ABC". Then it will
-try to match C<(?!123> with "123" which, of course, fails. But because
+try to match C<(?!123> with "123", which of course fails. But because
a quantifier (C<\D*>) has been used in the regular expression, the
search engine can backtrack and retry the match differently
in the hope of matching the complete regular expression.
-Well now,
-the pattern really, I<really> wants to succeed, so it uses the
-standard regexp back-off-and-retry and lets C<\D*> expand to just "AB" this
+The pattern really, I<really> wants to succeed, so it uses the
+standard pattern back-off-and-retry and lets C<\D*> expand to just "AB" this
time. Now there's indeed something following "AB" that is not
"123". It's in fact "C123", which suffices.
@@ -479,7 +683,7 @@ you'd expect; that is, case 5 will fail, but case 6 succeeds:
6: got ABC
-In other words, the two zero-width assertions next to each other work like
+In other words, the two zero-width assertions next to each other work as though
they're ANDed together, just as you'd use any builtin assertions: C</^$/>
matches only if you're at the beginning of the line AND the end of the
line simultaneously. The deeper underlying truth is that juxtaposition in
@@ -498,30 +702,45 @@ time to run
And if you used C<*>'s instead of limiting it to 0 through 5 matches, then
it would take literally forever--or until you ran out of stack space.
+A powerful tool for optimizing such beasts is "independent" groups,
+which do not backtrace (see L<C<(?E<gt>pattern)>>). Note also that
+zero-length lookahead/lookbehind assertions will not backtrace to make
+the tail match, since they are in "logical" context: only the fact
+whether they match or not is considered relevant. For an example
+where side-effects of a lookahead I<might> have influenced the
+following match, see L<C<(?E<gt>pattern)>>.
+
=head2 Version 8 Regular Expressions
-In case you're not familiar with the "regular" Version 8 regexp
+In case you're not familiar with the "regular" Version 8 regex
routines, here are the pattern-matching rules not described above.
Any single character matches itself, unless it is a I<metacharacter>
with a special meaning described here or above. You can cause
-characters which normally function as metacharacters to be interpreted
+characters that normally function as metacharacters to be interpreted
literally by prefixing them with a "\" (e.g., "\." matches a ".", not any
character; "\\" matches a "\"). A series of characters matches that
series of characters in the target string, so the pattern C<blurfl>
would match "blurfl" in the target string.
You can specify a character class, by enclosing a list of characters
-in C<[]>, which will match any one of the characters in the list. If the
+in C<[]>, which will match any one character from the list. If the
first character after the "[" is "^", the class matches any character not
in the list. Within a list, the "-" character is used to specify a
-range, so that C<a-z> represents all the characters between "a" and "z",
+range, so that C<a-z> represents all characters between "a" and "z",
inclusive. If you want "-" itself to be a member of a class, put it
at the start or end of the list, or escape it with a backslash. (The
following all specify the same class of three characters: C<[-az]>,
C<[az-]>, and C<[a\-z]>. All are different from C<[a-z]>, which
specifies a class containing twenty-six characters.)
+Note also that the whole range idea is rather unportable between
+character sets--and even within character sets they may cause results
+you probably didn't expect. A sound principle is to use only ranges
+that begin from and end at either alphabets of equal case ([a-e],
+[A-E]), or digits ([0-9]). Anything else is unsafe. If in doubt,
+spell out the character sets in full.
+
Characters may be specified using a metacharacter syntax much like that
used in C: "\n" matches a newline, "\t" a tab, "\r" a carriage return,
"\f" a form feed, etc. More generally, \I<nnn>, where I<nnn> is a string
@@ -533,30 +752,39 @@ character except "\n" (unless you use C</s>).
You can specify a series of alternatives for a pattern using "|" to
separate them, so that C<fee|fie|foe> will match any of "fee", "fie",
-or "foe" in the target string (as would C<f(e|i|o)e>). Note that the
+or "foe" in the target string (as would C<f(e|i|o)e>). The
first alternative includes everything from the last pattern delimiter
("(", "[", or the beginning of the pattern) up to the first "|", and
the last alternative contains everything from the last "|" to the next
pattern delimiter. For this reason, it's common practice to include
alternatives in parentheses, to minimize confusion about where they
-start and end. Note however that "|" is interpreted as a literal with
-square brackets, so if you write C<[fee|fie|foe]> you're really only
-matching C<[feio|]>.
+start and end.
+
+Alternatives are tried from left to right, so the first
+alternative found for which the entire expression matches, is the one that
+is chosen. This means that alternatives are not necessarily greedy. For
+example: when matching C<foo|foot> against "barefoot", only the "foo"
+part will match, as that is the first alternative tried, and it successfully
+matches the target string. (This might not seem important, but it is
+important when you are capturing matched text using parentheses.)
+
+Also remember that "|" is interpreted as a literal within square brackets,
+so if you write C<[fee|fie|foe]> you're really only matching C<[feio|]>.
Within a pattern, you may designate subpatterns for later reference by
enclosing them in parentheses, and you may refer back to the I<n>th
subpattern later in the pattern using the metacharacter \I<n>.
Subpatterns are numbered based on the left to right order of their
-opening parenthesis. Note that a backreference matches whatever
+opening parenthesis. A backreference matches whatever
actually matched the subpattern in the string being examined, not the
rules for that subpattern. Therefore, C<(0|0x)\d*\s\1\d*> will
-match "0x1234 0x4321",but not "0x1234 01234", because subpattern 1
+match "0x1234 0x4321", but not "0x1234 01234", because subpattern 1
actually matched "0x", even though the rule C<0|0x> could
potentially match the leading 0 in the second number.
=head2 WARNING on \1 vs $1
-Some people get too used to writing things like
+Some people get too used to writing things like:
$pattern =~ s/(\W)/\\\1/g;
@@ -568,7 +796,7 @@ meaning of C<\1> is kludged in for C<s///>. However, if you get into the habit
of doing that, you get yourself into trouble if you then add an C</e>
modifier.
- s/(\d+)/ \1 + 1 /eg;
+ s/(\d+)/ \1 + 1 /eg; # causes warning under -w
Or if you try to do
@@ -579,6 +807,134 @@ C<${1}000>. Basically, the operation of interpolation should not be confused
with the operation of matching a backreference. Certainly they mean two
different things on the I<left> side of the C<s///>.
+=head2 Repeated patterns matching zero-length substring
+
+WARNING: Difficult material (and prose) ahead. This section needs a rewrite.
+
+Regular expressions provide a terse and powerful programming language. As
+with most other power tools, power comes together with the ability
+to wreak havoc.
+
+A common abuse of this power stems from the ability to make infinite
+loops using regular expressions, with something as innocuous as:
+
+ 'foo' =~ m{ ( o? )* }x;
+
+The C<o?> can match at the beginning of C<'foo'>, and since the position
+in the string is not moved by the match, C<o?> would match again and again
+due to the C<*> modifier. Another common way to create a similar cycle
+is with the looping modifier C<//g>:
+
+ @matches = ( 'foo' =~ m{ o? }xg );
+
+or
+
+ print "match: <$&>\n" while 'foo' =~ m{ o? }xg;
+
+or the loop implied by split().
+
+However, long experience has shown that many programming tasks may
+be significantly simplified by using repeated subexpressions which
+may match zero-length substrings, with a simple example being:
+
+ @chars = split //, $string; # // is not magic in split
+ ($whitewashed = $string) =~ s/()/ /g; # parens avoid magic s// /
+
+Thus Perl allows the C</()/> construct, which I<forcefully breaks
+the infinite loop>. The rules for this are different for lower-level
+loops given by the greedy modifiers C<*+{}>, and for higher-level
+ones like the C</g> modifier or split() operator.
+
+The lower-level loops are I<interrupted> when it is detected that a
+repeated expression did match a zero-length substring, thus
+
+ m{ (?: NON_ZERO_LENGTH | ZERO_LENGTH )* }x;
+
+is made equivalent to
+
+ m{ (?: NON_ZERO_LENGTH )*
+ |
+ (?: ZERO_LENGTH )?
+ }x;
+
+The higher level-loops preserve an additional state between iterations:
+whether the last match was zero-length. To break the loop, the following
+match after a zero-length match is prohibited to have a length of zero.
+This prohibition interacts with backtracking (see L<"Backtracking">),
+and so the I<second best> match is chosen if the I<best> match is of
+zero length.
+
+Say,
+
+ $_ = 'bar';
+ s/\w??/<$&>/g;
+
+results in C<"<><b><><a><><r><>">. At each position of the string the best
+match given by non-greedy C<??> is the zero-length match, and the I<second
+best> match is what is matched by C<\w>. Thus zero-length matches
+alternate with one-character-long matches.
+
+Similarly, for repeated C<m/()/g> the second-best match is the match at the
+position one notch further in the string.
+
+The additional state of being I<matched with zero-length> is associated to
+the matched string, and is reset by each assignment to pos().
+
+=head2 Creating custom RE engines
+
+Overloaded constants (see L<overload>) provide a simple way to extend
+the functionality of the RE engine.
+
+Suppose that we want to enable a new RE escape-sequence C<\Y|> which
+matches at boundary between white-space characters and non-whitespace
+characters. Note that C<(?=\S)(?<!\S)|(?!\S)(?<=\S)> matches exactly
+at these positions, so we want to have each C<\Y|> in the place of the
+more complicated version. We can create a module C<customre> to do
+this:
+
+ package customre;
+ use overload;
+
+ sub import {
+ shift;
+ die "No argument to customre::import allowed" if @_;
+ overload::constant 'qr' => \&convert;
+ }
+
+ sub invalid { die "/$_[0]/: invalid escape '\\$_[1]'"}
+
+ my %rules = ( '\\' => '\\',
+ 'Y|' => qr/(?=\S)(?<!\S)|(?!\S)(?<=\S)/ );
+ sub convert {
+ my $re = shift;
+ $re =~ s{
+ \\ ( \\ | Y . )
+ }
+ { $rules{$1} or invalid($re,$1) }sgex;
+ return $re;
+ }
+
+Now C<use customre> enables the new escape in constant regular
+expressions, i.e., those without any runtime variable interpolations.
+As documented in L<overload>, this conversion will work only over
+literal parts of regular expressions. For C<\Y|$re\Y|> the variable
+part of this regular expression needs to be converted explicitly
+(but only if the special meaning of C<\Y|> should be enabled inside $re):
+
+ use customre;
+ $re = <>;
+ chomp $re;
+ $re = customre::convert $re;
+ /\Y|$re\Y|/;
+
=head2 SEE ALSO
-"Mastering Regular Expressions" (see L<perlbook>) by Jeffrey Friedl.
+L<perlop/"Regexp Quote-Like Operators">.
+
+L<perlop/"Gory details of parsing quoted constructs">.
+
+L<perlfunc/pos>.
+
+L<perllocale>.
+
+I<Mastering Regular Expressions> (see L<perlbook>) by Jeffrey Friedl.
diff --git a/gnu/usr.bin/perl/pod/perlref.pod b/gnu/usr.bin/perl/pod/perlref.pod
index 6aa086088d9..596ff72c1ad 100644
--- a/gnu/usr.bin/perl/pod/perlref.pod
+++ b/gnu/usr.bin/perl/pod/perlref.pod
@@ -2,22 +2,28 @@
perlref - Perl references and nested data structures
+=head1 NOTE
+
+This is complete documentation about all aspects of references.
+For a shorter, tutorial introduction to just the essential features,
+see L<perlreftut>.
+
=head1 DESCRIPTION
Before release 5 of Perl it was difficult to represent complex data
-structures, because all references had to be symbolic, and even that was
-difficult to do when you wanted to refer to a variable rather than a
-symbol table entry. Perl not only makes it easier to use symbolic
-references to variables, but lets you have "hard" references to any piece
-of data. Any scalar may hold a hard reference. Because arrays and hashes
-contain scalars, you can now easily build arrays of arrays, arrays of
-hashes, hashes of arrays, arrays of hashes of functions, and so on.
+structures, because all references had to be symbolic--and even then
+it was difficult to refer to a variable instead of a symbol table entry.
+Perl now not only makes it easier to use symbolic references to variables,
+but also lets you have "hard" references to any piece of data or code.
+Any scalar may hold a hard reference. Because arrays and hashes contain
+scalars, you can now easily build arrays of arrays, arrays of hashes,
+hashes of arrays, arrays of hashes of functions, and so on.
Hard references are smart--they keep track of reference counts for you,
automatically freeing the thing referred to when its reference count goes
-to zero. (Note: The reference counts for values in self-referential or
+to zero. (Note: the reference counts for values in self-referential or
cyclic data structures may not go to zero without a little help; see
-L<perlobj/"Two-Phased Garbage Collection"> for a detailed explanation.
+L<perlobj/"Two-Phased Garbage Collection"> for a detailed explanation.)
If that thing happens to be an object, the object is destructed. See
L<perlobj> for more about objects. (In a sense, everything in Perl is an
object, but we usually reserve the word for references to objects that
@@ -32,7 +38,7 @@ them that; references are confusing enough without useless synonyms.)
In contrast, hard references are more like hard links in a Unix file
system: They are used to access an underlying object without concern for
what its (other) name is. When the word "reference" is used without an
-adjective, like in the following paragraph, it usually is talking about a
+adjective, as in the following paragraph, it is usually talking about a
hard reference.
References are easy to use in Perl. There is just one overriding
@@ -41,7 +47,9 @@ scalar is holding a reference, it always behaves as a simple scalar. It
doesn't magically start being an array or hash or subroutine; you have to
tell it explicitly to do so, by dereferencing it.
-References can be constructed in several ways.
+=head2 Making References
+
+References can be created in several ways.
=over 4
@@ -60,20 +68,20 @@ reference that the backslash returned. Here are some examples:
$coderef = \&handler;
$globref = \*foo;
-It isn't possible to create a true reference to an IO handle (filehandle or
-dirhandle) using the backslash operator. See the explanation of the
-*foo{THING} syntax below. (However, you're apt to find Perl code
-out there using globrefs as though they were IO handles, which is
-grandfathered into continued functioning.)
+It isn't possible to create a true reference to an IO handle (filehandle
+or dirhandle) using the backslash operator. The most you can get is a
+reference to a typeglob, which is actually a complete symbol table entry.
+But see the explanation of the C<*foo{THING}> syntax below. However,
+you can still use type globs and globrefs as though they were IO handles.
=item 2.
-A reference to an anonymous array can be constructed using square
+A reference to an anonymous array can be created using square
brackets:
$arrayref = [1, 2, ['a', 'b', 'c']];
-Here we've constructed a reference to an anonymous array of three elements
+Here we've created a reference to an anonymous array of three elements
whose final element is itself a reference to another anonymous array of three
elements. (The multidimensional syntax described later can be used to
access this. For example, after the above, C<$arrayref-E<gt>[2][1]> would have
@@ -87,11 +95,13 @@ a list of references!
@list = \($a, @b, %c); # same thing!
As a special case, C<\(@foo)> returns a list of references to the contents
-of C<@foo>, not a reference to C<@foo> itself. Likewise for C<%foo>.
+of C<@foo>, not a reference to C<@foo> itself. Likewise for C<%foo>,
+except that the key references are to copies (since the keys are just
+strings rather than full-fledged scalars).
=item 3.
-A reference to an anonymous hash can be constructed using curly
+A reference to an anonymous hash can be created using curly
brackets:
$hashref = {
@@ -99,7 +109,7 @@ brackets:
'Clyde' => 'Bonnie',
};
-Anonymous hash and array constructors can be intermixed freely to
+Anonymous hash and array composers like these can be intermixed freely to
produce as complicated a structure as you want. The multidimensional
syntax described below works for these too. The values above are
literals, but variables and expressions would work just as well, because
@@ -120,9 +130,18 @@ reference to it, you have these options:
sub hashem { +{ @_ } } # ok
sub hashem { return { @_ } } # ok
+On the other hand, if you want the other meaning, you can do this:
+
+ sub showem { { @_ } } # ambiguous (currently ok, but may change)
+ sub showem { {; @_ } } # ok
+ sub showem { { return @_ } } # ok
+
+Note how the leading C<+{> and C<{;> always serve to disambiguate
+the expression to mean either the HASH reference, or the BLOCK.
+
=item 4.
-A reference to an anonymous subroutine can be constructed by using
+A reference to an anonymous subroutine can be created by using
C<sub> without a subname:
$coderef = sub { print "Boink!\n" };
@@ -130,7 +149,7 @@ C<sub> without a subname:
Note the presence of the semicolon. Except for the fact that the code
inside isn't executed immediately, a C<sub {}> is not so much a
declaration as it is an operator, like C<do{}> or C<eval{}>. (However, no
-matter how many times you execute that line (unless you're in an
+matter how many times you execute that particular line (unless you're in an
C<eval("...")>), C<$coderef> will still have a reference to the I<SAME>
anonymous subroutine.)
@@ -174,7 +193,7 @@ newprint() I<despite> the fact that the "my $x" has seemingly gone out of
scope by the time the anonymous subroutine runs. That's what closure
is all about.
-This applies to only lexical variables, by the way. Dynamic variables
+This applies only to lexical variables, by the way. Dynamic variables
continue to work as they have always worked. Closure is not something
that most Perl programmers need trouble themselves about to begin with.
@@ -185,11 +204,23 @@ Perl objects are just references to a special kind of object that happens to kno
which package it's associated with. Constructors are just special
subroutines that know how to create that association. They do so by
starting with an ordinary reference, and it remains an ordinary reference
-even while it's also being an object. Constructors are customarily
-named new(), but don't have to be:
+even while it's also being an object. Constructors are often
+named new() and called indirectly:
$objref = new Doggie (Tail => 'short', Ears => 'long');
+But don't have to be:
+
+ $objref = Doggie->new(Tail => 'short', Ears => 'long');
+
+ use Term::Cap;
+ $terminal = Term::Cap->Tgetent( { OSPEED => 9600 });
+
+ use Tk;
+ $main = MainWindow->new();
+ $menubar = $main->Frame(-relief => "raised",
+ -borderwidth => 2)
+
=item 6.
References of the appropriate type can spring into existence if you
@@ -221,36 +252,34 @@ except in the case of scalars. *foo{SCALAR} returns a reference to an
anonymous scalar if $foo hasn't been used yet. This might change in a
future release.
-The use of *foo{IO} is the best way to pass bareword filehandles into or
-out of subroutines, or to store them in larger data structures.
+*foo{IO} is an alternative to the \*HANDLE mechanism given in
+L<perldata/"Typeglobs and Filehandles"> for passing filehandles
+into or out of subroutines, or storing into larger data structures.
+Its disadvantage is that it won't create a new filehandle for you.
+Its advantage is that you have no risk of clobbering more than you want
+to with a typeglob assignment, although if you assign to a scalar instead
+of a typeglob, you're ok.
+ splutter(*STDOUT);
splutter(*STDOUT{IO});
+
sub splutter {
my $fh = shift;
print $fh "her um well a hmmm\n";
}
+ $rec = get_rec(*STDIN);
$rec = get_rec(*STDIN{IO});
+
sub get_rec {
my $fh = shift;
return scalar <$fh>;
}
-Beware, though, that you can't do this with a routine which is going to
-open the filehandle for you, because *HANDLE{IO} will be undef if HANDLE
-hasn't been used yet. Use \*HANDLE for that sort of thing instead.
-
-Using \*HANDLE (or *HANDLE) is another way to use and store non-bareword
-filehandles (before perl version 5.002 it was the only way). The two
-methods are largely interchangeable, you can do
-
- splutter(\*STDOUT);
- $rec = get_rec(\*STDIN);
-
-with the above subroutine definitions.
-
=back
+=head2 Using References
+
That's it for creating references. By now you're probably dying to
know how to use references to get back to your long-lost data. There
are several basic methods.
@@ -338,6 +367,7 @@ statement, C<$array[$x]> may have been undefined. If so, it's
automatically defined with a hash reference so that we can look up
C<{"foo"}> in it. Likewise C<$array[$x]-E<gt>{"foo"}> will automatically get
defined with an array reference so that we can look up C<[0]> in it.
+This process is called I<autovivification>.
One more thing here. The arrow is optional I<BETWEEN> brackets
subscripts, so you can shrink the above down to
@@ -367,8 +397,8 @@ civility though.
The ref() operator may be used to determine what type of thing the
reference is pointing to. See L<perlfunc>.
-The bless() operator may be used to associate a reference with a package
-functioning as an object class. See L<perlobj>.
+The bless() operator may be used to associate the object a reference
+points to with a package functioning as an object class. See L<perlobj>.
A typeglob may be dereferenced the same way a reference can, because
the dereference syntax always indicates the kind of reference desired.
@@ -421,12 +451,12 @@ block. An inner block may countermand that with
no strict 'refs';
-Only package variables are visible to symbolic references. Lexical
-variables (declared with my()) aren't in a symbol table, and thus are
-invisible to this mechanism. For example:
+Only package variables (globals, even if localized) are visible to
+symbolic references. Lexical variables (declared with my()) aren't in
+a symbol table, and thus are invisible to this mechanism. For example:
- local($value) = 10;
- $ref = \$value;
+ local $value = 10;
+ $ref = "value";
{
my $value = 20;
print $$ref;
@@ -489,6 +519,111 @@ The B<-w> switch will warn you if it interprets a reserved word as a string.
But it will no longer warn you about using lowercase words, because the
string is effectively quoted.
+=head2 Pseudo-hashes: Using an array as a hash
+
+WARNING: This section describes an experimental feature. Details may
+change without notice in future versions.
+
+Beginning with release 5.005 of Perl you can use an array reference
+in some contexts that would normally require a hash reference. This
+allows you to access array elements using symbolic names, as if they
+were fields in a structure.
+
+For this to work, the array must contain extra information. The first
+element of the array has to be a hash reference that maps field names
+to array indices. Here is an example:
+
+ $struct = [{foo => 1, bar => 2}, "FOO", "BAR"];
+
+ $struct->{foo}; # same as $struct->[1], i.e. "FOO"
+ $struct->{bar}; # same as $struct->[2], i.e. "BAR"
+
+ keys %$struct; # will return ("foo", "bar") in some order
+ values %$struct; # will return ("FOO", "BAR") in same some order
+
+ while (my($k,$v) = each %$struct) {
+ print "$k => $v\n";
+ }
+
+Perl will raise an exception if you try to delete keys from a pseudo-hash
+or try to access nonexistent fields. For better performance, Perl can also
+do the translation from field names to array indices at compile time for
+typed object references. See L<fields>.
+
+
+=head2 Function Templates
+
+As explained above, a closure is an anonymous function with access to the
+lexical variables visible when that function was compiled. It retains
+access to those variables even though it doesn't get run until later,
+such as in a signal handler or a Tk callback.
+
+Using a closure as a function template allows us to generate many functions
+that act similarly. Suppose you wanted functions named after the colors
+that generated HTML font changes for the various colors:
+
+ print "Be ", red("careful"), "with that ", green("light");
+
+The red() and green() functions would be very similar. To create these,
+we'll assign a closure to a typeglob of the name of the function we're
+trying to build.
+
+ @colors = qw(red blue green yellow orange purple violet);
+ for my $name (@colors) {
+ no strict 'refs'; # allow symbol table manipulation
+ *$name = *{uc $name} = sub { "<FONT COLOR='$name'>@_</FONT>" };
+ }
+
+Now all those different functions appear to exist independently. You can
+call red(), RED(), blue(), BLUE(), green(), etc. This technique saves on
+both compile time and memory use, and is less error-prone as well, since
+syntax checks happen at compile time. It's critical that any variables in
+the anonymous subroutine be lexicals in order to create a proper closure.
+That's the reasons for the C<my> on the loop iteration variable.
+
+This is one of the only places where giving a prototype to a closure makes
+much sense. If you wanted to impose scalar context on the arguments of
+these functions (probably not a wise idea for this particular example),
+you could have written it this way instead:
+
+ *$name = sub ($) { "<FONT COLOR='$name'>$_[0]</FONT>" };
+
+However, since prototype checking happens at compile time, the assignment
+above happens too late to be of much use. You could address this by
+putting the whole loop of assignments within a BEGIN block, forcing it
+to occur during compilation.
+
+Access to lexicals that change over type--like those in the C<for> loop
+above--only works with closures, not general subroutines. In the general
+case, then, named subroutines do not nest properly, although anonymous
+ones do. If you are accustomed to using nested subroutines in other
+programming languages with their own private variables, you'll have to
+work at it a bit in Perl. The intuitive coding of this kind of thing
+incurs mysterious warnings about ``will not stay shared''. For example,
+this won't work:
+
+ sub outer {
+ my $x = $_[0] + 35;
+ sub inner { return $x * 19 } # WRONG
+ return $x + inner();
+ }
+
+A work-around is the following:
+
+ sub outer {
+ my $x = $_[0] + 35;
+ local *inner = sub { return $x * 19 };
+ return $x + inner();
+ }
+
+Now inner() can only be called from within outer(), because of the
+temporary assignments of the closure (anonymous subroutine). But when
+it does, it has normal access to the lexical variable $x from the scope
+of outer().
+
+This has the interesting effect of creating a function local to another
+function, something not normally supported in Perl.
+
=head1 WARNING
You may not (usefully) use a reference as the key to a hash. It will be
@@ -506,6 +641,8 @@ more like
And then at least you can use the values(), which will be
real refs, instead of the keys(), which won't.
+The standard Tie::RefHash module provides a convenient workaround to this.
+
=head1 SEE ALSO
Besides the obvious documents, source code can be instructive.
@@ -513,5 +650,5 @@ Some rather pathological examples of the use of references can be found
in the F<t/op/ref.t> regression test in the Perl source directory.
See also L<perldsc> and L<perllol> for how to use references to create
-complex data structures, and L<perlobj> for how to use them to create
-objects.
+complex data structures, and L<perltoot>, L<perlobj>, and L<perlbot>
+for how to use them to create objects.
diff --git a/gnu/usr.bin/perl/pod/perlrun.pod b/gnu/usr.bin/perl/pod/perlrun.pod
index a847133bb9a..7cb9aed4c00 100644
--- a/gnu/usr.bin/perl/pod/perlrun.pod
+++ b/gnu/usr.bin/perl/pod/perlrun.pod
@@ -29,7 +29,8 @@ Specified line by line via B<-e> switches on the command line.
=item 2.
Contained in the file specified by the first filename on the command line.
-(Note that systems supporting the #! notation invoke interpreters this way.)
+(Note that systems supporting the #! notation invoke interpreters this
+way. See L<Location of Perl>.)
=item 3.
@@ -72,7 +73,7 @@ The sequences "-*" and "- " are specifically ignored so that you could,
if you were so inclined, say
#!/bin/sh -- # -*- perl -*- -p
- eval 'exec /usr/bin/perl $0 -S ${1+"$@"}'
+ eval 'exec /usr/bin/perl -wS $0 ${1+"$@"}'
if $running_under_some_shell;
to let Perl see the B<-p> switch.
@@ -116,16 +117,33 @@ distribution for more information).
=item Win95/NT
The Win95/NT installation, when using the Activeware port of Perl,
-will modify the Registry to associate the .pl extension with the perl
+will modify the Registry to associate the F<.pl> extension with the perl
interpreter. If you install another port of Perl, including the one
in the Win32 directory of the Perl distribution, then you'll have to
-modify the Registry yourself.
+modify the Registry yourself. Note that this means you can no
+longer tell the difference between an executable Perl program
+and a Perl library file.
=item Macintosh
Macintosh perl scripts will have the appropriate Creator and
Type, so that double-clicking them will invoke the perl application.
+=item VMS
+
+Put
+
+ $ perl -mysw 'f$env("procedure")' 'p1' 'p2' 'p3' 'p4' 'p5' 'p6' 'p7' 'p8' !
+ $ exit++ + ++$status != 0 and $exit = $status = undef;
+
+at the top of your script, where C<-mysw> are any command line switches you
+want to pass to Perl. You can now invoke the script directly, by saying
+C<perl script>, or as a DCL procedure, by saying C<@script> (or implicitly
+via F<DCL$PATH> by just using the name of the script).
+
+This incantation is a bit much to remember, but Perl will display it for
+you if you say C<perl "-V:startperl">.
+
=back
Command-interpreters on non-Unix systems have rather different ideas
@@ -170,6 +188,19 @@ characters as control characters.
There is no general solution to all of this. It's just a mess.
+=head2 Location of Perl
+
+It may seem obvious to say, but Perl is useful only when users can
+easily find it. When possible, it's good for both B</usr/bin/perl> and
+B</usr/local/bin/perl> to be symlinks to the actual binary. If that
+can't be done, system administrators are strongly encouraged to put
+(symlinks to) perl and its accompanying utilities, such as perldoc, into
+a directory typically found along a user's PATH, or in another obvious
+and convenient place.
+
+In this documentation, C<#!/usr/bin/perl> on the first line of the script
+will stand in for whatever method works on your system.
+
=head2 Switches
A single-character switch may be combined with the following switch, if
@@ -252,10 +283,15 @@ equivalent to B<-Dtls>):
512 r Regular expression parsing and execution
1024 x Syntax tree dump
2048 u Tainting checks
- 4096 L Memory leaks (not supported anymore)
+ 4096 L Memory leaks (needs C<-DLEAKTEST> when compiling Perl)
8192 H Hash dump -- usurps values()
16384 X Scratchpad allocation
32768 D Cleaning up
+ 65536 S Thread synchronization
+
+All these flags require C<-DDEBUGGING> when you compile the Perl
+executable. This flag is automatically set if you include C<-g>
+option when C<Configure> asks you about optimizer/debugger flags.
=item B<-e> I<commandline>
@@ -278,12 +314,44 @@ prints a summary of the options.
=item B<-i>[I<extension>]
-specifies that files processed by the C<E<lt>E<gt>> construct are to be edited
-in-place. It does this by renaming the input file, opening the output
-file by the original name, and selecting that output file as the default
-for print() statements. The extension, if supplied, is added to the name
-of the old file to make a backup copy. If no extension is supplied, no
-backup is made. From the shell, saying
+specifies that files processed by the C<E<lt>E<gt>> construct are to be
+edited in-place. It does this by renaming the input file, opening the
+output file by the original name, and selecting that output file as the
+default for print() statements. The extension, if supplied, is used to
+modify the name of the old file to make a backup copy, following these
+rules:
+
+If no extension is supplied, no backup is made and the current file is
+overwritten.
+
+If the extension doesn't contain a C<*> then it is appended to the end
+of the current filename as a suffix.
+
+If the extension does contain one or more C<*> characters, then each C<*>
+is replaced with the current filename. In perl terms you could think of
+this as:
+
+ ($backup = $extension) =~ s/\*/$file_name/g;
+
+This allows you to add a prefix to the backup file, instead of (or in
+addition to) a suffix:
+
+ $ perl -pi'bak_*' -e 's/bar/baz/' fileA # backup to 'bak_fileA'
+
+Or even to place backup copies of the original files into another
+directory (provided the directory already exists):
+
+ $ perl -pi'old/*.bak' -e 's/bar/baz/' fileA # backup to 'old/fileA.bak'
+
+These sets of one-liners are equivalent:
+
+ $ perl -pi -e 's/bar/baz/' fileA # overwrite current file
+ $ perl -pi'*' -e 's/bar/baz/' fileA # overwrite current file
+
+ $ perl -pi'.bak' -e 's/bar/baz/' fileA # backup to 'fileA.bak'
+ $ perl -pi'*.bak' -e 's/bar/baz/' fileA # backup to 'fileA.bak'
+
+From the shell, saying
$ perl -p -i.bak -e "s/foo/bar/; ... "
@@ -295,9 +363,16 @@ is the same as using the script:
which is equivalent to
#!/usr/bin/perl
+ $extension = '.bak';
while (<>) {
if ($ARGV ne $oldargv) {
- rename($ARGV, $ARGV . '.bak');
+ if ($extension !~ /\*/) {
+ $backup = $ARGV . $extension;
+ }
+ else {
+ ($backup = $extension) =~ s/\*/$ARGV/g;
+ }
+ rename($ARGV, $backup);
open(ARGVOUT, ">$ARGV");
select(ARGVOUT);
$oldargv = $ARGV;
@@ -311,12 +386,36 @@ which is equivalent to
except that the B<-i> form doesn't need to compare $ARGV to $oldargv to
know when the filename has changed. It does, however, use ARGVOUT for
-the selected filehandle. Note that STDOUT is restored as the
-default output filehandle after the loop.
+the selected filehandle. Note that STDOUT is restored as the default
+output filehandle after the loop.
+
+As shown above, Perl creates the backup file whether or not any output
+is actually changed. So this is just a fancy way to copy files:
+
+ $ perl -p -i'/some/file/path/*' -e 1 file1 file2 file3...
+ or
+ $ perl -p -i'.bak' -e 1 file1 file2 file3...
+
+You can use C<eof> without parentheses to locate the end of each input
+file, in case you want to append to each file, or reset line numbering
+(see example in L<perlfunc/eof>).
+
+If, for a given file, Perl is unable to create the backup file as
+specified in the extension then it will skip that file and continue on
+with the next one (if it exists).
+
+For a discussion of issues surrounding file permissions and C<-i>, see
+L<perlfaq5/Why does Perl let me delete read-only files? Why does -i clobber protected files? Isn't this a bug in Perl?>.
+
+You cannot use B<-i> to create directories or to strip extensions from
+files.
+
+Perl does not expand C<~>, so don't do that.
-You can use C<eof> without parenthesis to locate the end of each input file,
-in case you want to append to each file, or reset line numbering (see
-example in L<perlfunc/eof>).
+Finally, note that the B<-i> switch does not impede execution when no
+files are given on the command line. In this case, no backup is made
+(the original file cannot, of course, be determined) and processing
+proceeds from STDIN to STDOUT as might be expected.
=item B<-I>I<directory>
@@ -408,7 +507,7 @@ makes it iterate over filename arguments somewhat like B<sed>:
If a file named by an argument cannot be opened for some reason, Perl
warns you about it, and moves on to the next file. Note that the
-lines are printed automatically. An error occuring during printing is
+lines are printed automatically. An error occurring during printing is
treated as fatal. To suppress printing use the B<-n> switch. A B<-p>
overrides a B<-n> switch.
@@ -444,7 +543,7 @@ original name fails, and if the name does not already end in one
of those suffixes. If your Perl was compiled with DEBUGGING turned
on, using the -Dp switch to Perl shows how the search progresses.
-If the file supplied contains directory separators (i.e. it is an
+If the filename supplied contains directory separators (i.e. it is an
absolute or relative pathname), and if the file is not found,
platforms that append file extensions will do so and try to look
for the file with those extensions added, one by one.
@@ -459,7 +558,7 @@ don't support #!. This example works on many platforms that
have a shell compatible with Bourne shell:
#!/usr/bin/perl
- eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
+ eval 'exec /usr/bin/perl -wS $0 ${1+"$@"}'
if $running_under_some_shell;
The system ignores the first line and feeds the script to /bin/sh,
@@ -469,36 +568,40 @@ starts up the Perl interpreter. On some systems $0 doesn't always
contain the full pathname, so the B<-S> tells Perl to search for the
script if necessary. After Perl locates the script, it parses the
lines and ignores them because the variable $running_under_some_shell
-is never true. A better construct than C<$*> would be C<${1+"$@"}>, which
-handles embedded spaces and such in the filenames, but doesn't work if
-the script is being interpreted by csh. To start up sh rather
+is never true. If the script will be interpreted by csh, you will need
+to replace C<${1+"$@"}> with C<$*>, even though that doesn't understand
+embedded spaces (and such) in the argument list. To start up sh rather
than csh, some systems may have to replace the #! line with a line
containing just a colon, which will be politely ignored by Perl. Other
systems can't control that, and need a totally devious construct that
will work under any of csh, sh, or Perl, such as the following:
- eval '(exit $?0)' && eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
- & eval 'exec /usr/bin/perl -S $0 $argv:q'
+ eval '(exit $?0)' && eval 'exec /usr/bin/perl -wS $0 ${1+"$@"}'
+ & eval 'exec /usr/bin/perl -wS $0 $argv:q'
if $running_under_some_shell;
=item B<-T>
-forces "taint" checks to be turned on so you can test them. Ordinarily these checks are
-done only when running setuid or setgid. It's a good idea to turn
-them on explicitly for programs run on another's behalf, such as CGI
-programs. See L<perlsec>.
+forces "taint" checks to be turned on so you can test them. Ordinarily
+these checks are done only when running setuid or setgid. It's a good
+idea to turn them on explicitly for programs run on another's behalf,
+such as CGI programs. See L<perlsec>. Note that (for security reasons)
+this option must be seen by Perl quite early; usually this means it must
+appear early on the command line or in the #! line (for systems which
+support that).
=item B<-u>
causes Perl to dump core after compiling your script. You can then
-take this core dump and turn it into an executable file by using the
+in theory take this core dump and turn it into an executable file by using the
B<undump> program (not supplied). This speeds startup at the expense of
some disk space (which you can minimize by stripping the executable).
(Still, a "hello world" executable comes out to about 200K on my
machine.) If you want to execute a portion of your script before dumping,
use the dump() operator instead. Note: availability of B<undump> is
platform specific and may not be available for a specific port of
-Perl.
+Perl. It has been superseded by the new perl-to-C compiler, which is more
+portable, even though it's still only considered beta.
=item B<-U>
@@ -583,7 +686,8 @@ Command-line options (switches). Switches in this variable are taken
as if they were on every Perl command line. Only the B<-[DIMUdmw]>
switches are allowed. When running taint checks (because the script
was running setuid or setgid, or the B<-T> switch was used), this
-variable is ignored.
+variable is ignored. If PERL5OPT begins with B<-T>, tainting will be
+enabled, and any subsequent options ignored.
=item PERLLIB
@@ -600,18 +704,23 @@ The command used to load the debugger code. The default is:
=item PERL5SHELL (specific to WIN32 port)
May be set to an alternative shell that perl must use internally for
-executing "backtick" commands or system(). Perl doesn't use COMSPEC
-for this purpose because COMSPEC has a high degree of variability
-among users, leading to portability concerns. Besides, perl can use
-a shell that may not be fit for interactive use, and setting COMSPEC
-to such a shell may interfere with the proper functioning of other
-programs (which usually look in COMSPEC to find a shell fit for
-interactive use).
+executing "backtick" commands or system(). Default is C<cmd.exe /x/c>
+on WindowsNT and C<command.com /c> on Windows95. The value is considered
+to be space delimited. Precede any character that needs to be protected
+(like a space or backslash) with a backslash.
+
+Note that Perl doesn't use COMSPEC for this purpose because
+COMSPEC has a high degree of variability among users, leading to
+portability concerns. Besides, perl can use a shell that may not be
+fit for interactive use, and setting COMSPEC to such a shell may
+interfere with the proper functioning of other programs (which usually
+look in COMSPEC to find a shell fit for interactive use).
=item PERL_DEBUG_MSTATS
-Relevant only if your perl executable was built with B<-DDEBUGGING_MSTATS>,
-if set, this causes memory statistics to be dumped after execution. If set
+Relevant only if perl is compiled with the malloc included with the perl
+distribution (that is, if C<perl -V:d_mymalloc> is 'define').
+If set, this causes memory statistics to be dumped after execution. If set
to an integer greater than one, also causes memory statistics to be dumped
after compilation.
diff --git a/gnu/usr.bin/perl/pod/perlsec.pod b/gnu/usr.bin/perl/pod/perlsec.pod
index 73884790b0f..0b22acd9cda 100644
--- a/gnu/usr.bin/perl/pod/perlsec.pod
+++ b/gnu/usr.bin/perl/pod/perlsec.pod
@@ -36,7 +36,9 @@ L<perllocale>), results of certain system calls (readdir, readlink,
the gecos field of getpw* calls), and all file input are marked as
"tainted". Tainted data may not be used directly or indirectly in any
command that invokes a sub-shell, nor in any command that modifies
-files, directories, or processes. Any variable set
+files, directories, or processes. (B<Important exception>: If you pass
+a list of arguments to either C<system> or C<exec>, the elements of
+that list are B<NOT> checked for taintedness.) Any variable set
to a value derived from tainted data will itself be tainted,
even if it is logically impossible for the tainted data
to alter the variable. Because taintedness is associated with each
@@ -86,9 +88,9 @@ For example:
@files = glob('*.c'); # Always insecure (uses csh)
If you try to do something insecure, you will get a fatal error saying
-something like "Insecure dependency" or "Insecure PATH". Note that you
+something like "Insecure dependency" or "Insecure $ENV{PATH}". Note that you
can still write an insecure B<system> or B<exec>, but only by explicitly
-doing something like the last example above.
+doing something like the "considered secure" example above.
=head2 Laundering and Detecting Tainted Data
@@ -173,6 +175,14 @@ guarantee that the executable in question isn't itself going to turn
around and execute some other program that is dependent on your PATH, it
makes sure you set the PATH.
+The PATH isn't the only environment variable which can cause problems.
+Because some shells may use the variables IFS, CDPATH, ENV, and
+BASH_ENV, Perl checks that those are either empty or untainted when
+starting subprocesses. You may wish to add something like this to your
+setid and taint-checking scripts.
+
+ delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; # Make %ENV safer
+
It's also possible to get into trouble with other operations that don't
care whether they use tainted values. Make judicious use of the file
tests in dealing with any user-supplied filenames. When possible, do
@@ -215,15 +225,14 @@ never call the shell at all.
} else {
my @temp = ($EUID, $EGID);
$EUID = $UID;
- $EGID = $GID; # XXX: initgroups() not called
+ $EGID = $GID; # initgroups() also called!
# Make sure privs are really gone
($EUID, $EGID) = @temp;
- die "Can't drop privileges" unless
- $UID == $EUID and
- $GID eq $EGID; # String test
+ die "Can't drop privileges"
+ unless $UID == $EUID && $GID eq $EGID;
$ENV{PATH} = "/bin:/usr/bin";
- exec 'myprog', 'arg1', 'arg2' or
- die "can't exec myprog: $!";
+ exec 'myprog', 'arg1', 'arg2'
+ or die "can't exec myprog: $!";
}
A similar strategy would work for wildcard expansion via C<glob>, although
@@ -310,9 +319,10 @@ First of all, however, you I<can't> take away read permission, because
the source code has to be readable in order to be compiled and
interpreted. (That doesn't mean that a CGI script's source is
readable by people on the web, though.) So you have to leave the
-permissions at the socially friendly 0755 level.
+permissions at the socially friendly 0755 level. This lets
+people on your local system only see your source.
-Some people regard this as a security problem. If your program does
+Some people mistakenly regard this as a security problem. If your program does
insecure things, and relies on people not knowing how to exploit those
insecurities, it is not secure. It is often possible for someone to
determine the insecure things and exploit them without viewing the
@@ -335,3 +345,7 @@ statements like "This is unpublished proprietary software of XYZ Corp.
Your access to it does not give you permission to use it blah blah
blah." You should see a lawyer to be sure your licence's wording will
stand up in court.
+
+=head1 SEE ALSO
+
+L<perlrun> for its description of cleaning up environment variables.
diff --git a/gnu/usr.bin/perl/pod/perlstyle.pod b/gnu/usr.bin/perl/pod/perlstyle.pod
index bfc94a9eaa9..04aab9854a4 100644
--- a/gnu/usr.bin/perl/pod/perlstyle.pod
+++ b/gnu/usr.bin/perl/pod/perlstyle.pod
@@ -16,7 +16,7 @@ The C<use sigtrap> and even C<use diagnostics> pragmas may also prove
useful.
Regarding aesthetics of code lay out, about the only thing Larry
-cares strongly about is that the closing curly brace of
+cares strongly about is that the closing curly bracket of
a multi-line BLOCK should line up with the keyword that started the construct.
Beyond that, he has other preferences that aren't so strong:
@@ -242,7 +242,7 @@ to fit on one line anyway.
Always check the return codes of system calls. Good error messages should
go to STDERR, include which program caused the problem, what the failed
-system call and arguments were, and VERY IMPORTANT) should contain the
+system call and arguments were, and (VERY IMPORTANT) should contain the
standard system error message for what went wrong. Here's a simple but
sufficient example:
@@ -250,7 +250,7 @@ sufficient example:
=item *
-Line up your translations when it makes sense:
+Line up your transliterations when it makes sense:
tr [abc]
[xyz];
diff --git a/gnu/usr.bin/perl/pod/perlsub.pod b/gnu/usr.bin/perl/pod/perlsub.pod
index 16babd2092c..bfab0fe81e3 100644
--- a/gnu/usr.bin/perl/pod/perlsub.pod
+++ b/gnu/usr.bin/perl/pod/perlsub.pod
@@ -14,7 +14,8 @@ To declare subroutines:
To define an anonymous subroutine at runtime:
- $subref = sub BLOCK;
+ $subref = sub BLOCK; # no proto
+ $subref = sub (PROTO) BLOCK; # with proto
To import subroutines:
@@ -24,7 +25,7 @@ To call subroutines:
NAME(LIST); # & is optional with parentheses.
NAME LIST; # Parentheses optional if predeclared/imported.
- &NAME; # Passes current @_ to subroutine.
+ &NAME; # Makes current @_ visible to called subroutine.
=head1 DESCRIPTION
@@ -33,7 +34,7 @@ may be located anywhere in the main program, loaded in from other files
via the C<do>, C<require>, or C<use> keywords, or even generated on the
fly using C<eval> or anonymous subroutines (closures). You can even call
a function indirectly using a variable containing its name or a CODE reference
-to it, as in C<$var = \&function>.
+to it.
The Perl model for function call and return values is simple: all
functions are passed as parameters one single flat list of scalars, and
@@ -45,20 +46,20 @@ contain as many or as few scalar elements as you'd like. (Often a
function without an explicit return statement is called a subroutine, but
there's really no difference from the language's perspective.)
-Any arguments passed to the routine come in as the array @_. Thus if you
+Any arguments passed to the routine come in as the array C<@_>. Thus if you
called a function with two arguments, those would be stored in C<$_[0]>
-and C<$_[1]>. The array @_ is a local array, but its elements are
+and C<$_[1]>. The array C<@_> is a local array, but its elements are
aliases for the actual scalar parameters. In particular, if an element
C<$_[0]> is updated, the corresponding argument is updated (or an error
occurs if it is not updatable). If an argument is an array or hash
element which did not exist when the function was called, that element is
created only when (and if) it is modified or if a reference to it is
taken. (Some earlier versions of Perl created the element whether or not
-it was assigned to.) Note that assigning to the whole array @_ removes
+it was assigned to.) Note that assigning to the whole array C<@_> removes
the aliasing, and does not update any arguments.
The return value of the subroutine is the value of the last expression
-evaluated. Alternatively, a return statement may be used to exit the
+evaluated. Alternatively, a C<return> statement may be used to exit the
subroutine, optionally specifying the returned value, which will be
evaluated in the appropriate context (list, scalar, or void) depending
on the context of the subroutine call. If you specify no return value,
@@ -68,7 +69,7 @@ one or more arrays and/or hashes, these will be flattened together into
one large indistinguishable list.
Perl does not have named formal parameters, but in practice all you do is
-assign to a my() list of these. Any variables you use in the function
+assign to a C<my()> list of these. Any variables you use in the function
that aren't declared private are global variables. For the gory details
on creating private variables, see
L<"Private Variables via my()"> and L<"Temporary Values via local()">.
@@ -118,7 +119,7 @@ Use array assignment to a local list to name your formal arguments:
This also has the effect of turning call-by-reference into call-by-value,
because the assignment copies the values. Otherwise a function is free to
-do in-place modifications of @_ and change its caller's values.
+do in-place modifications of C<@_> and change its caller's values.
upcase_in($v1, $v2); # this changes $v1 and $v2
sub upcase_in {
@@ -131,7 +132,7 @@ argument were actually literal and you tried to change it, you'd take a
upcase_in("frederick");
-It would be much safer if the upcase_in() function
+It would be much safer if the C<upcase_in()> function
were written to return a copy of its parameters instead
of changing them in place:
@@ -144,10 +145,10 @@ of changing them in place:
}
Notice how this (unprototyped) function doesn't care whether it was passed
-real scalars or arrays. Perl will see everything as one big long flat @_
+real scalars or arrays. Perl will see everything as one big long flat C<@_>
parameter list. This is one of the ways where Perl's simple
-argument-passing style shines. The upcase() function would work perfectly
-well without changing the upcase() definition even if we fed it things
+argument-passing style shines. The C<upcase()> function would work perfectly
+well without changing the C<upcase()> definition even if we fed it things
like this:
@newlist = upcase(@list1, @list2);
@@ -158,21 +159,21 @@ Do not, however, be tempted to do this:
(@a, @b) = upcase(@list1, @list2);
Because like its flat incoming parameter list, the return list is also
-flat. So all you have managed to do here is stored everything in @a and
-made @b an empty list. See L</"Pass by Reference"> for alternatives.
+flat. So all you have managed to do here is stored everything in C<@a> and
+made C<@b> an empty list. See L<Pass by Reference> for alternatives.
-A subroutine may be called using the "&" prefix. The "&" is optional
+A subroutine may be called using the "C<&>" prefix. The "C<&>" is optional
in modern Perls, and so are the parentheses if the subroutine has been
-predeclared. (Note, however, that the "&" is I<NOT> optional when
+predeclared. (Note, however, that the "C<&>" is I<NOT> optional when
you're just naming the subroutine, such as when it's used as an
-argument to defined() or undef(). Nor is it optional when you want to
+argument to C<defined()> or C<undef()>. Nor is it optional when you want to
do an indirect subroutine call with a subroutine name or reference
using the C<&$subref()> or C<&{$subref}()> constructs. See L<perlref>
for more on that.)
Subroutines may be called recursively. If a subroutine is called using
-the "&" form, the argument list is optional, and if omitted, no @_ array is
-set up for the subroutine: the @_ array at the time of the call is
+the "C<&>" form, the argument list is optional, and if omitted, no C<@_> array is
+set up for the subroutine: the C<@_> array at the time of the call is
visible to subroutine instead. This is an efficiency mechanism that
new users may wish to avoid.
@@ -185,11 +186,19 @@ new users may wish to avoid.
&foo; # foo() get current args, like foo(@_) !!
foo; # like foo() IFF sub foo predeclared, else "foo"
-Not only does the "&" form make the argument list optional, but it also
+Not only does the "C<&>" form make the argument list optional, but it also
disables any prototype checking on the arguments you do provide. This
is partly for historical reasons, and partly for having a convenient way
to cheat if you know what you're doing. See the section on Prototypes below.
+Function whose names are in all upper case are reserved to the Perl core,
+just as are modules whose names are in all lower case. A function in
+all capitals is a loosely-held convention meaning it will be called
+indirectly by the run-time system itself. Functions that do special,
+pre-defined things are C<BEGIN>, C<END>, C<AUTOLOAD>, and C<DESTROY>--plus all the
+functions mentioned in L<perltie>. The 5.005 release adds C<INIT>
+to this list.
+
=head2 Private Variables via my()
Synopsis:
@@ -199,24 +208,33 @@ Synopsis:
my $foo = "flurp"; # declare $foo lexical, and init it
my @oof = @bar; # declare @oof lexical, and init it
-A "my" declares the listed variables to be confined (lexically) to the
+A "C<my>" declares the listed variables to be confined (lexically) to the
enclosing block, conditional (C<if/unless/elsif/else>), loop
(C<for/foreach/while/until/continue>), subroutine, C<eval>, or
C<do/require/use>'d file. If more than one value is listed, the list
must be placed in parentheses. All listed elements must be legal lvalues.
Only alphanumeric identifiers may be lexically scoped--magical
-builtins like $/ must currently be localized with "local" instead.
+builtins like C<$/> must currently be C<local>ize with "C<local>" instead.
-Unlike dynamic variables created by the "local" statement, lexical
-variables declared with "my" are totally hidden from the outside world,
+Unlike dynamic variables created by the "C<local>" operator, lexical
+variables declared with "C<my>" are totally hidden from the outside world,
including any called subroutines (even if it's the same subroutine called
from itself or elsewhere--every call gets its own copy).
-(An eval(), however, can see the lexical variables of the scope it is
+This doesn't mean that a C<my()> variable declared in a statically
+I<enclosing> lexical scope would be invisible. Only the dynamic scopes
+are cut off. For example, the C<bumpx()> function below has access to the
+lexical C<$x> variable because both the my and the sub occurred at the same
+scope, presumably the file scope.
+
+ my $x = 10;
+ sub bumpx { $x++ }
+
+(An C<eval()>, however, can see the lexical variables of the scope it is
being evaluated in so long as the names aren't hidden by declarations within
-the eval() itself. See L<perlref>.)
+the C<eval()> itself. See L<perlref>.)
-The parameter list to my() may be assigned to if desired, which allows you
+The parameter list to C<my()> may be assigned to if desired, which allows you
to initialize your variables. (If no initializer is given for a
particular variable, it is created with the undefined value.) Commonly
this is used to name the parameters to a subroutine. Examples:
@@ -232,11 +250,11 @@ this is used to name the parameters to a subroutine. Examples:
return $arg;
}
-The "my" is simply a modifier on something you might assign to. So when
-you do assign to the variables in its argument list, the "my" doesn't
-change whether those variables is viewed as a scalar or an array. So
+The "C<my>" is simply a modifier on something you might assign to. So when
+you do assign to the variables in its argument list, the "C<my>" doesn't
+change whether those variables are viewed as a scalar or an array. So
- my ($foo) = <STDIN>;
+ my ($foo) = <STDIN>; # WRONG?
my @FOO = <STDIN>;
both supply a list context to the right-hand side, while
@@ -245,7 +263,7 @@ both supply a list context to the right-hand side, while
supplies a scalar context. But the following declares only one variable:
- my $foo, $bar = 1;
+ my $foo, $bar = 1; # WRONG
That has the same effect as
@@ -257,12 +275,12 @@ the current statement. Thus,
my $x = $x;
-can be used to initialize the new $x with the value of the old $x, and
+can be used to initialize the new $x with the value of the old C<$x>, and
the expression
my $x = 123 and $x == 123
-is false unless the old $x happened to have the value 123.
+is false unless the old C<$x> happened to have the value C<123>.
Lexical scopes of control structures are not bounded precisely by the
braces that delimit their controlled blocks; control expressions are
@@ -274,7 +292,7 @@ part of the scope, too. Thus in the loop
print $line;
}
-the scope of $line extends from its declaration throughout the rest of
+the scope of C<$line> extends from its declaration throughout the rest of
the loop construct (including the C<continue> clause), but not beyond
it. Similarly, in the conditional
@@ -287,7 +305,7 @@ it. Similarly, in the conditional
die "'$answer' is neither 'yes' nor 'no'";
}
-the scope of $answer extends from its declaration throughout the rest
+the scope of C<$answer> extends from its declaration throughout the rest
of the conditional (including C<elsif> and C<else> clauses, if any),
but not beyond it.
@@ -297,15 +315,15 @@ control structures and have no effect on scoping.)
The C<foreach> loop defaults to scoping its index variable dynamically
(in the manner of C<local>; see below). However, if the index
-variable is prefixed with the keyword "my", then it is lexically
+variable is prefixed with the keyword "C<my>", then it is lexically
scoped instead. Thus in the loop
for my $i (1, 2, 3) {
some_function();
}
-the scope of $i extends to the end of the loop, but not beyond it, and
-so the value of $i is unavailable in some_function().
+the scope of C<$i> extends to the end of the loop, but not beyond it, and
+so the value of C<$i> is unavailable in C<some_function()>.
Some users may wish to encourage the use of lexically scoped variables.
As an aid to catching implicit references to package variables,
@@ -316,15 +334,15 @@ if you say
then any variable reference from there to the end of the enclosing
block must either refer to a lexical variable, or must be fully
qualified with the package name. A compilation error results
-otherwise. An inner block may countermand this with S<"no strict 'vars'">.
+otherwise. An inner block may countermand this with S<"C<no strict 'vars'>">.
-A my() has both a compile-time and a run-time effect. At compile time,
+A C<my()> has both a compile-time and a run-time effect. At compile time,
the compiler takes notice of it; the principle usefulness of this is to
-quiet C<use strict 'vars'>. The actual initialization is delayed until
+quiet S<"C<use strict 'vars'>">. The actual initialization is delayed until
run time, so it gets executed appropriately; every time through a loop,
for example.
-Variables declared with "my" are not part of any package and are therefore
+Variables declared with "C<my>" are not part of any package and are therefore
never fully qualified with the package name. In particular, you're not
allowed to try to make a package variable (or other global) lexical:
@@ -332,7 +350,7 @@ allowed to try to make a package variable (or other global) lexical:
my $_; # also illegal (currently)
In fact, a dynamic variable (also known as package or global variables)
-are still accessible using the fully qualified :: notation even while a
+are still accessible using the fully qualified C<::> notation even while a
lexical of the same name is also visible:
package main;
@@ -340,15 +358,15 @@ lexical of the same name is also visible:
my $x = 20;
print "$x and $::x\n";
-That will print out 20 and 10.
+That will print out C<20> and C<10>.
-You may declare "my" variables at the outermost scope of a file to
-hide any such identifiers totally from the outside world. This is similar
+You may declare "C<my>" variables at the outermost scope of a file to hide
+any such identifiers totally from the outside world. This is similar
to C's static variables at the file level. To do this with a subroutine
-requires the use of a closure (anonymous function). If a block (such as
-an eval(), function, or C<package>) wants to create a private subroutine
-that cannot be called from outside that block, it can declare a lexical
-variable containing an anonymous sub reference:
+requires the use of a closure (anonymous function with lexical access).
+If a block (such as an C<eval()>, function, or C<package>) wants to create
+a private subroutine that cannot be called from outside that block,
+it can declare a lexical variable containing an anonymous sub reference:
my $secret_version = '1.001-beta';
my $secret_sub = sub { print $secret_version };
@@ -357,19 +375,34 @@ variable containing an anonymous sub reference:
As long as the reference is never returned by any function within the
module, no outside module can see the subroutine, because its name is not in
any package's symbol table. Remember that it's not I<REALLY> called
-$some_pack::secret_version or anything; it's just $secret_version,
+C<$some_pack::secret_version> or anything; it's just C<$secret_version>,
unqualified and unqualifiable.
This does not work with object methods, however; all object methods have
to be in the symbol table of some package to be found.
-Just because the lexical variable is lexically (also called statically)
-scoped doesn't mean that within a function it works like a C static. It
-normally works more like a C auto. But here's a mechanism for giving a
-function private variables with both lexical scoping and a static
-lifetime. If you do want to create something like C's static variables,
-just enclose the whole function in an extra block, and put the
-static variable outside the function but in the block.
+=head2 Persistent Private Variables
+
+Just because a lexical variable is lexically (also called statically)
+scoped to its enclosing block, C<eval>, or C<do> FILE, this doesn't mean that
+within a function it works like a C static. It normally works more
+like a C auto, but with implicit garbage collection.
+
+Unlike local variables in C or C++, Perl's lexical variables don't
+necessarily get recycled just because their scope has exited.
+If something more permanent is still aware of the lexical, it will
+stick around. So long as something else references a lexical, that
+lexical won't be freed--which is as it should be. You wouldn't want
+memory being free until you were done using it, or kept around once you
+were done. Automatic garbage collection takes care of this for you.
+
+This means that you can pass back or save away references to lexical
+variables, whereas to return a pointer to a C auto is a grave error.
+It also gives us a way to simulate C's function statics. Here's a
+mechanism for giving a function private variables with both lexical
+scoping and a static lifetime. If you do want to create something like
+C's static variables, just enclose the whole function in an extra block,
+and put the static variable outside the function but in the block.
{
my $secret_val = 0;
@@ -382,9 +415,9 @@ static variable outside the function but in the block.
If this function is being sourced in from a separate file
via C<require> or C<use>, then this is probably just fine. If it's
-all in the main program, you'll need to arrange for the my()
+all in the main program, you'll need to arrange for the C<my()>
to be executed early, either by putting the whole block above
-your main program, or more likely, placing merely a BEGIN
+your main program, or more likely, placing merely a C<BEGIN>
sub around it to make sure it gets executed before your program
starts to run:
@@ -395,14 +428,20 @@ starts to run:
}
}
-See L<perlrun> about the BEGIN function.
+See L<perlmod/"Package Constructors and Destructors"> about the C<BEGIN> function.
+
+If declared at the outermost scope, the file scope, then lexicals work
+someone like C's file statics. They are available to all functions in
+that same file declared below them, but are inaccessible from outside of
+the file. This is sometimes used in modules to create private variables
+for the whole module.
=head2 Temporary Values via local()
-B<NOTE>: In general, you should be using "my" instead of "local", because
+B<NOTE>: In general, you should be using "C<my>" instead of "C<local>", because
it's faster and safer. Exceptions to this include the global punctuation
variables, filehandles and formats, and direct manipulation of the Perl
-symbol table itself. Format variables often use "local" though, as do
+symbol table itself. Format variables often use "C<local>" though, as do
other variables whose current value must be visible to called
subroutines.
@@ -419,13 +458,14 @@ Synopsis:
local *merlyn = 'randal'; # SAME THING: promote 'randal' to *randal
local *merlyn = \$randal; # just alias $merlyn, not @merlyn etc
-A local() modifies its listed variables to be local to the enclosing
-block, (or subroutine, C<eval{}>, or C<do>) and I<any called from
-within that block>. A local() just gives temporary values to global
-(meaning package) variables. This is known as dynamic scoping. Lexical
-scoping is done with "my", which works more like C's auto declarations.
+A C<local()> modifies its listed variables to be "local" to the enclosing
+block, C<eval>, or C<do FILE>--and to I<any subroutine called from within that block>.
+A C<local()> just gives temporary values to global (meaning package)
+variables. It does B<not> create a local variable. This is known as
+dynamic scoping. Lexical scoping is done with "C<my>", which works more
+like C's auto declarations.
-If more than one variable is given to local(), they must be placed in
+If more than one variable is given to C<local()>, they must be placed in
parentheses. All listed elements must be legal lvalues. This operator works
by saving the current values of those variables in its argument list on a
hidden stack and restoring them upon exiting the block, subroutine, or
@@ -450,14 +490,14 @@ subroutine. Examples:
}
# old %digits restored here
-Because local() is a run-time command, it gets executed every time
+Because C<local()> is a run-time command, it gets executed every time
through a loop. In releases of Perl previous to 5.0, this used more stack
storage each time until the loop was exited. Perl now reclaims the space
each time through, but it's still more efficient to declare your variables
outside the loop.
-A local is simply a modifier on an lvalue expression. When you assign to
-a localized variable, the local doesn't change whether its list is viewed
+A C<local> is simply a modifier on an lvalue expression. When you assign to
+a C<local>ized variable, the C<local> doesn't change whether its list is viewed
as a scalar or an array. So
local($foo) = <STDIN>;
@@ -504,6 +544,64 @@ like this:
}
[..normal %ENV behavior here..]
+It's also worth taking a moment to explain what happens when you
+C<local>ize a member of a composite type (i.e. an array or hash element).
+In this case, the element is C<local>ized I<by name>. This means that
+when the scope of the C<local()> ends, the saved value will be
+restored to the hash element whose key was named in the C<local()>, or
+the array element whose index was named in the C<local()>. If that
+element was deleted while the C<local()> was in effect (e.g. by a
+C<delete()> from a hash or a C<shift()> of an array), it will spring
+back into existence, possibly extending an array and filling in the
+skipped elements with C<undef>. For instance, if you say
+
+ %hash = ( 'This' => 'is', 'a' => 'test' );
+ @ary = ( 0..5 );
+ {
+ local($ary[5]) = 6;
+ local($hash{'a'}) = 'drill';
+ while (my $e = pop(@ary)) {
+ print "$e . . .\n";
+ last unless $e > 3;
+ }
+ if (@ary) {
+ $hash{'only a'} = 'test';
+ delete $hash{'a'};
+ }
+ }
+ print join(' ', map { "$_ $hash{$_}" } sort keys %hash),".\n";
+ print "The array has ",scalar(@ary)," elements: ",
+ join(', ', map { defined $_ ? $_ : 'undef' } @ary),"\n";
+
+Perl will print
+
+ 6 . . .
+ 4 . . .
+ 3 . . .
+ This is a test only a test.
+ The array has 6 elements: 0, 1, 2, undef, undef, 5
+
+Note also that when you C<local>ize a member of a composite type that
+B<does not exist previously>, the value is treated as though it were
+in an lvalue context, i.e., it is first created and then C<local>ized.
+The consequence of this is that the hash or array is in fact permanently
+modified. For instance, if you say
+
+ %hash = ( 'This' => 'is', 'a' => 'test' );
+ @ary = ( 0..5 );
+ {
+ local($ary[8]) = 0;
+ local($hash{'b'}) = 'whatever';
+ }
+ printf "%%hash has now %d keys, \@ary %d elements.\n",
+ scalar(keys(%hash)), scalar(@ary);
+
+Perl will print
+
+ %hash has now 3 keys, @ary 9 elements.
+
+The above behavior of local() on non-existent members of composite
+types is subject to change in future.
=head2 Passing Symbol Table Entries (typeglobs)
@@ -523,7 +621,7 @@ funny prefix characters on variables and subroutines and such.
When evaluated, the typeglob produces a scalar value that represents
all the objects of that name, including any filehandle, format, or
subroutine. When assigned to, it causes the name mentioned to refer to
-whatever "*" value was assigned to it. Example:
+whatever "C<*>" value was assigned to it. Example:
sub doubleary {
local(*someary) = @_;
@@ -537,8 +635,8 @@ whatever "*" value was assigned to it. Example:
Note that scalars are already passed by reference, so you can modify
scalar arguments without using this mechanism by referring explicitly
to C<$_[0]> etc. You can modify all the elements of an array by passing
-all the elements as scalars, but you have to use the * mechanism (or
-the equivalent reference mechanism) to push, pop, or change the size of
+all the elements as scalars, but you have to use the C<*> mechanism (or
+the equivalent reference mechanism) to C<push>, C<pop>, or change the size of
an array. It will certainly be faster to pass the typeglob (or reference).
Even if you don't want to modify an array, this mechanism is useful for
@@ -547,6 +645,77 @@ mechanism will merge all the array values so that you can't extract out
the individual arrays. For more on typeglobs, see
L<perldata/"Typeglobs and Filehandles">.
+=head2 When to Still Use local()
+
+Despite the existence of C<my()>, there are still three places where the
+C<local()> operator still shines. In fact, in these three places, you
+I<must> use C<local> instead of C<my>.
+
+=over
+
+=item 1. You need to give a global variable a temporary value, especially C<$_>.
+
+The global variables, like C<@ARGV> or the punctuation variables, must be
+C<local>ized with C<local()>. This block reads in F</etc/motd>, and splits
+it up into chunks separated by lines of equal signs, which are placed
+in C<@Fields>.
+
+ {
+ local @ARGV = ("/etc/motd");
+ local $/ = undef;
+ local $_ = <>;
+ @Fields = split /^\s*=+\s*$/;
+ }
+
+It particular, it's important to C<local>ize C<$_> in any routine that assigns
+to it. Look out for implicit assignments in C<while> conditionals.
+
+=item 2. You need to create a local file or directory handle or a local function.
+
+A function that needs a filehandle of its own must use C<local()> uses
+C<local()> on complete typeglob. This can be used to create new symbol
+table entries:
+
+ sub ioqueue {
+ local (*READER, *WRITER); # not my!
+ pipe (READER, WRITER); or die "pipe: $!";
+ return (*READER, *WRITER);
+ }
+ ($head, $tail) = ioqueue();
+
+See the Symbol module for a way to create anonymous symbol table
+entries.
+
+Because assignment of a reference to a typeglob creates an alias, this
+can be used to create what is effectively a local function, or at least,
+a local alias.
+
+ {
+ local *grow = \&shrink; # only until this block exists
+ grow(); # really calls shrink()
+ move(); # if move() grow()s, it shrink()s too
+ }
+ grow(); # get the real grow() again
+
+See L<perlref/"Function Templates"> for more about manipulating
+functions by name in this way.
+
+=item 3. You want to temporarily change just one element of an array or hash.
+
+You can C<local>ize just one element of an aggregate. Usually this
+is done on dynamics:
+
+ {
+ local $SIG{INT} = 'IGNORE';
+ funct(); # uninterruptible
+ }
+ # interruptibility automatically restored here
+
+But it also works on lexically declared aggregates. Prior to 5.005,
+this operation could on occasion misbehave.
+
+=back
+
=head2 Pass by Reference
If you want to pass more than one array or hash into a function--or
@@ -556,7 +725,7 @@ do that, you need to understand references as detailed in L<perlref>.
This section may not make much sense to you otherwise.
Here are a few simple examples. First, let's pass in several
-arrays to a function and have it pop all of then, return a new
+arrays to a function and have it C<pop> all of then, return a new
list of all their former last elements:
@tailings = popmany ( \@a, \@b, \@c, \@d );
@@ -596,9 +765,9 @@ Where people get into trouble is here:
or
(%a, %b) = func(%c, %d);
-That syntax simply won't work. It sets just @a or %a and clears the @b or
-%b. Plus the function didn't get passed into two separate arrays or
-hashes: it got one long list in @_, as always.
+That syntax simply won't work. It sets just C<@a> or C<%a> and clears the C<@b> or
+C<%b>. Plus the function didn't get passed into two separate arrays or
+hashes: it got one long list in C<@_>, as always.
If you can arrange for everyone to deal with this through references, it's
cleaner code, although not so nice to look at. Here's a function that
@@ -630,12 +799,12 @@ It turns out that you can actually do this also:
}
Here we're using the typeglobs to do symbol table aliasing. It's
-a tad subtle, though, and also won't work if you're using my()
-variables, because only globals (well, and local()s) are in the symbol table.
+a tad subtle, though, and also won't work if you're using C<my()>
+variables, because only globals (well, and C<local()>s) are in the symbol table.
If you're passing around filehandles, you could usually just use the bare
-typeglob, like *STDOUT, but typeglobs references would be better because
-they'll still work properly under C<use strict 'refs'>. For example:
+typeglob, like C<*STDOUT>, but typeglobs references would be better because
+they'll still work properly under S<C<use strict 'refs'>>. For example:
splutter(\*STDOUT);
sub splutter {
@@ -649,7 +818,7 @@ they'll still work properly under C<use strict 'refs'>. For example:
return scalar <$fh>;
}
-Another way to do this is using *HANDLE{IO}, see L<perlref> for usage
+Another way to do this is using C<*HANDLE{IO}>, see L<perlref> for usage
and caveats.
If you're planning on generating new filehandles, you could do this:
@@ -661,7 +830,7 @@ If you're planning on generating new filehandles, you could do this:
}
Although that will actually produce a small memory leak. See the bottom
-of L<perlfunc/open()> for a somewhat cleaner way using the IO::Handle
+of L<perlfunc/open()> for a somewhat cleaner way using the C<IO::Handle>
package.
=head2 Prototypes
@@ -670,7 +839,7 @@ As of the 5.002 release of perl, if you declare
sub mypush (\@@)
-then mypush() takes arguments exactly like push() does. The declaration
+then C<mypush()> takes arguments exactly like C<push()> does. The declaration
of the function to be called must be visible at compile time. The prototype
affects only the interpretation of new-style calls to the function, where
new-style is defined as not using the C<&> character. In other words,
@@ -678,7 +847,8 @@ if you call it like a builtin function, then it behaves like a builtin
function. If you call it like an old-fashioned subroutine, then it
behaves like an old-fashioned subroutine. It naturally falls out from
this rule that prototypes have no influence on subroutine references
-like C<\&foo> or on indirect subroutine calls like C<&{$subref}>.
+like C<\&foo> or on indirect subroutine calls like C<&{$subref}> or
+C<$subref-E<gt>()>.
Method calls are not influenced by prototypes either, because the
function to be called is indeterminate at compile time, because it depends
@@ -690,20 +860,20 @@ that parse almost exactly like the corresponding builtins.
Declared as Called as
- sub mylink ($$) mylink $old, $new
- sub myvec ($$$) myvec $var, $offset, 1
- sub myindex ($$;$) myindex &getstring, "substr"
- sub mysyswrite ($$$;$) mysyswrite $buf, 0, length($buf) - $off, $off
- sub myreverse (@) myreverse $a,$b,$c
- sub myjoin ($@) myjoin ":",$a,$b,$c
- sub mypop (\@) mypop @array
- sub mysplice (\@$$@) mysplice @array,@array,0,@pushme
- sub mykeys (\%) mykeys %{$hashref}
- sub myopen (*;$) myopen HANDLE, $name
- sub mypipe (**) mypipe READHANDLE, WRITEHANDLE
- sub mygrep (&@) mygrep { /foo/ } $a,$b,$c
- sub myrand ($) myrand 42
- sub mytime () mytime
+ sub mylink ($$) mylink $old, $new
+ sub myvec ($$$) myvec $var, $offset, 1
+ sub myindex ($$;$) myindex &getstring, "substr"
+ sub mysyswrite ($$$;$) mysyswrite $buf, 0, length($buf) - $off, $off
+ sub myreverse (@) myreverse $a, $b, $c
+ sub myjoin ($@) myjoin ":", $a, $b, $c
+ sub mypop (\@) mypop @array
+ sub mysplice (\@$$@) mysplice @array, @array, 0, @pushme
+ sub mykeys (\%) mykeys %{$hashref}
+ sub myopen (*;$) myopen HANDLE, $name
+ sub mypipe (**) mypipe READHANDLE, WRITEHANDLE
+ sub mygrep (&@) mygrep { /foo/ } $a, $b, $c
+ sub myrand ($) myrand 42
+ sub mytime () mytime
Any backslashed prototype character represents an actual argument
that absolutely must start with that character. The value passed
@@ -712,28 +882,30 @@ actual argument given in the subroutine call, obtained by applying
C<\> to that argument.
Unbackslashed prototype characters have special meanings. Any
-unbackslashed @ or % eats all the rest of the arguments, and forces
-list context. An argument represented by $ forces scalar context. An
-& requires an anonymous subroutine, which, if passed as the first
-argument, does not require the "sub" keyword or a subsequent comma. A
-* does whatever it has to do to turn the argument into a reference to a
-symbol table entry.
+unbackslashed C<@> or C<%> eats all the rest of the arguments, and forces
+list context. An argument represented by C<$> forces scalar context. An
+C<&> requires an anonymous subroutine, which, if passed as the first
+argument, does not require the "C<sub>" keyword or a subsequent comma. A
+C<*> allows the subroutine to accept a bareword, constant, scalar expression,
+typeglob, or a reference to a typeglob in that slot. The value will be
+available to the subroutine either as a simple scalar, or (in the latter
+two cases) as a reference to the typeglob.
A semicolon separates mandatory arguments from optional arguments.
-(It is redundant before @ or %.)
+(It is redundant before C<@> or C<%>.)
Note how the last three examples above are treated specially by the parser.
-mygrep() is parsed as a true list operator, myrand() is parsed as a
-true unary operator with unary precedence the same as rand(), and
-mytime() is truly without arguments, just like time(). That is, if you
+C<mygrep()> is parsed as a true list operator, C<myrand()> is parsed as a
+true unary operator with unary precedence the same as C<rand()>, and
+C<mytime()> is truly without arguments, just like C<time()>. That is, if you
say
mytime +2;
-you'll get mytime() + 2, not mytime(2), which is how it would be parsed
+you'll get C<mytime() + 2>, not C<mytime(2)>, which is how it would be parsed
without the prototype.
-The interesting thing about & is that you can generate new syntax with it:
+The interesting thing about C<&> is that you can generate new syntax with it:
sub try (&@) {
my($try,$catch) = @_;
@@ -751,13 +923,13 @@ The interesting thing about & is that you can generate new syntax with it:
/phooey/ and print "unphooey\n";
};
-That prints "unphooey". (Yes, there are still unresolved
-issues having to do with the visibility of @_. I'm ignoring that
-question for the moment. (But note that if we make @_ lexically
+That prints C<"unphooey">. (Yes, there are still unresolved
+issues having to do with the visibility of C<@_>. I'm ignoring that
+question for the moment. (But note that if we make C<@_> lexically
scoped, those anonymous subroutines can act like closures... (Gee,
is this sounding a little Lispish? (Never mind.))))
-And here's a reimplementation of grep:
+And here's a reimplementation of C<grep>:
sub mygrep (&@) {
my $code = shift;
@@ -793,12 +965,12 @@ returning a list:
func(@foo);
func( split /:/ );
-Then you've just supplied an automatic scalar() in front of their
-argument, which can be more than a bit surprising. The old @foo
+Then you've just supplied an automatic C<scalar()> in front of their
+argument, which can be more than a bit surprising. The old C<@foo>
which used to hold one thing doesn't get passed in. Instead,
-the func() now gets passed in 1, that is, the number of elements
-in @foo. And the split() gets called in a scalar context and
-starts scribbling on your @_ parameter list.
+the C<func()> now gets passed in C<1>, that is, the number of elements
+in C<@foo>. And the C<split()> gets called in a scalar context and
+starts scribbling on your C<@_> parameter list.
This is all very powerful, of course, and should be used only in moderation
to make the world a better place.
@@ -810,10 +982,10 @@ inlining. If the result after optimization and constant folding is
either a constant or a lexically-scoped scalar which has no other
references, then it will be used in place of function calls made
without C<&> or C<do>. Calls made using C<&> or C<do> are never
-inlined. (See constant.pm for an easy way to declare most
+inlined. (See F<constant.pm> for an easy way to declare most
constants.)
-All of the following functions would be inlined.
+The following functions would all be inlined:
sub pi () { 3.14159 } # Not exact, but close.
sub PI () { 4 * atan2 1, 1 } # As good as it gets,
@@ -842,7 +1014,7 @@ All of the following functions would be inlined.
sub N_FACTORIAL () { $prod }
}
-If you redefine a subroutine which was eligible for inlining you'll get
+If you redefine a subroutine that was eligible for inlining, you'll get
a mandatory warning. (You can use this warning to tell whether or not a
particular subroutine is considered constant.) The warning is
considered severe enough not to be optional because previously compiled
@@ -878,36 +1050,86 @@ saying C<CORE::open()> will always refer to the builtin C<open()>, even
if the current package has imported some other subroutine called
C<&open()> from elsewhere.
-Library modules should not in general export builtin names like "open"
-or "chdir" as part of their default @EXPORT list, because these may
+Library modules should not in general export builtin names like "C<open>"
+or "C<chdir>" as part of their default C<@EXPORT> list, because these may
sneak into someone else's namespace and change the semantics unexpectedly.
-Instead, if the module adds the name to the @EXPORT_OK list, then it's
+Instead, if the module adds the name to the C<@EXPORT_OK> list, then it's
possible for a user to import the name explicitly, but not implicitly.
That is, they could say
use Module 'open';
-and it would import the open override, but if they said
+and it would import the C<open> override, but if they said
use Module;
they would get the default imports without the overrides.
-Note that such overriding is restricted to the package that requests
-the import. Some means of "globally" overriding builtins may become
-available in future.
+The foregoing mechanism for overriding builtins is restricted, quite
+deliberately, to the package that requests the import. There is a second
+method that is sometimes applicable when you wish to override a builtin
+everywhere, without regard to namespace boundaries. This is achieved by
+importing a sub into the special namespace C<CORE::GLOBAL::>. Here is an
+example that quite brazenly replaces the C<glob> operator with something
+that understands regular expressions.
+
+ package REGlob;
+ require Exporter;
+ @ISA = 'Exporter';
+ @EXPORT_OK = 'glob';
+
+ sub import {
+ my $pkg = shift;
+ return unless @_;
+ my $sym = shift;
+ my $where = ($sym =~ s/^GLOBAL_// ? 'CORE::GLOBAL' : caller(0));
+ $pkg->export($where, $sym, @_);
+ }
+
+ sub glob {
+ my $pat = shift;
+ my @got;
+ local(*D);
+ if (opendir D, '.') { @got = grep /$pat/, readdir D; closedir D; }
+ @got;
+ }
+ 1;
+
+And here's how it could be (ab)used:
+
+ #use REGlob 'GLOBAL_glob'; # override glob() in ALL namespaces
+ package Foo;
+ use REGlob 'glob'; # override glob() in Foo:: only
+ print for <^[a-z_]+\.pm\$>; # show all pragmatic modules
+
+Note that the initial comment shows a contrived, even dangerous example.
+By overriding C<glob> globally, you would be forcing the new (and
+subversive) behavior for the C<glob> operator for B<every> namespace,
+without the complete cognizance or cooperation of the modules that own
+those namespaces. Naturally, this should be done with extreme caution--if
+it must be done at all.
+
+The C<REGlob> example above does not implement all the support needed to
+cleanly override perl's C<glob> operator. The builtin C<glob> has
+different behaviors depending on whether it appears in a scalar or list
+context, but our C<REGlob> doesn't. Indeed, many perl builtins have such
+context sensitive behaviors, and these must be adequately supported by
+a properly written override. For a fully functional example of overriding
+C<glob>, study the implementation of C<File::DosGlob> in the standard
+library.
+
=head2 Autoloading
If you call a subroutine that is undefined, you would ordinarily get an
immediate fatal error complaining that the subroutine doesn't exist.
(Likewise for subroutines being used as methods, when the method
-doesn't exist in any of the base classes of the class package.) If,
+doesn't exist in any base class of the class package.) If,
however, there is an C<AUTOLOAD> subroutine defined in the package or
packages that were searched for the original subroutine, then that
C<AUTOLOAD> subroutine is called with the arguments that would have been
passed to the original subroutine. The fully qualified name of the
-original subroutine magically appears in the $AUTOLOAD variable in the
+original subroutine magically appears in the C<$AUTOLOAD> variable in the
same package as the C<AUTOLOAD> routine. The name is not passed as an
ordinary argument because, er, well, just because, that's why...
@@ -917,7 +1139,7 @@ form of "goto" that erases the stack frame of the C<AUTOLOAD> routine
without a trace. (See the standard C<AutoLoader> module, for example.)
But an C<AUTOLOAD> routine can also just emulate the routine and never
define it. For example, let's pretend that a function that wasn't defined
-should just call system() with those arguments. All you'd do is this:
+should just call C<system()> with those arguments. All you'd do is this:
sub AUTOLOAD {
my $program = $AUTOLOAD;
@@ -947,7 +1169,6 @@ functions to perl code in L<perlxs>.
=head1 SEE ALSO
-See L<perlref> for more on references. See L<perlxs> if you'd
-like to learn about calling C subroutines from perl. See
-L<perlmod> to learn about bundling up your functions in
-separate files.
+See L<perlref> for more about references and closures. See L<perlxs> if
+you'd like to learn about calling C subroutines from perl. See L<perlmod>
+to learn about bundling up your functions in separate files.
diff --git a/gnu/usr.bin/perl/pod/perlsyn.pod b/gnu/usr.bin/perl/pod/perlsyn.pod
index 9c3f6617bd0..a3bc5ab547a 100644
--- a/gnu/usr.bin/perl/pod/perlsyn.pod
+++ b/gnu/usr.bin/perl/pod/perlsyn.pod
@@ -8,7 +8,7 @@ A Perl script consists of a sequence of declarations and statements.
The only things that need to be declared in Perl are report formats
and subroutines. See the sections below for more information on those
declarations. All uninitialized user-created objects are assumed to
-start with a null or 0 value until they are defined by some explicit
+start with a C<null> or C<0> value until they are defined by some explicit
operation such as assignment. (Though you can get warnings about the
use of undefined values if you like.) The sequence of statements is
executed just once, unlike in B<sed> and B<awk> scripts, where the
@@ -21,19 +21,19 @@ mandatory default like it is in B<sed> and B<awk>.)
=head2 Declarations
-Perl is, for the most part, a free-form language. (The only
-exception to this is format declarations, for obvious reasons.) Comments
-are indicated by the "#" character, and extend to the end of the line. If
-you attempt to use C</* */> C-style comments, it will be interpreted
-either as division or pattern matching, depending on the context, and C++
-C<//> comments just look like a null regular expression, so don't do
-that.
+Perl is, for the most part, a free-form language. (The only exception
+to this is format declarations, for obvious reasons.) Text from a
+C<"#"> character until the end of the line is a comment, and is
+ignored. If you attempt to use C</* */> C-style comments, it will be
+interpreted either as division or pattern matching, depending on the
+context, and C++ C<//> comments just look like a null regular
+expression, so don't do that.
A declaration can be put anywhere a statement can, but has no effect on
the execution of the primary sequence of statements--declarations all
take effect at compile time. Typically all the declarations are put at
the beginning or the end of the script. However, if you're using
-lexically-scoped private variables created with my(), you'll have to make sure
+lexically-scoped private variables created with C<my()>, you'll have to make sure
your format or subroutine definition is within the same block scope
as the my if you expect to be able to access those private variables.
@@ -47,7 +47,7 @@ subroutine without defining it by saying C<sub name>, thus:
Note that it functions as a list operator, not as a unary operator; so
be careful to use C<or> instead of C<||> in this case. However, if
you were to declare the subroutine as C<sub myname ($)>, then
-C<myname> would functonion as a unary operator, so either C<or> or
+C<myname> would function as a unary operator, so either C<or> or
C<||> would work.
Subroutines declarations can also be loaded up with the C<require> statement
@@ -79,24 +79,41 @@ modifiers are:
unless EXPR
while EXPR
until EXPR
+ foreach EXPR
The C<if> and C<unless> modifiers have the expected semantics,
-presuming you're a speaker of English. The C<while> and C<until>
-modifiers also have the usual "while loop" semantics (conditional
-evaluated first), except when applied to a do-BLOCK (or to the
-now-deprecated do-SUBROUTINE statement), in which case the block
-executes once before the conditional is evaluated. This is so that you
-can write loops like:
+presuming you're a speaker of English. The C<foreach> modifier is an
+iterator: For each value in EXPR, it aliases C<$_> to the value and
+executes the statement. The C<while> and C<until> modifiers have the
+usual "C<while> loop" semantics (conditional evaluated first), except
+when applied to a C<do>-BLOCK (or to the now-deprecated C<do>-SUBROUTINE
+statement), in which case the block executes once before the
+conditional is evaluated. This is so that you can write loops like:
do {
$line = <STDIN>;
...
} until $line eq ".\n";
-See L<perlfunc/do>. Note also that the loop control
-statements described later will I<NOT> work in this construct, because
-modifiers don't take loop labels. Sorry. You can always wrap
-another block around it to do that sort of thing.
+See L<perlfunc/do>. Note also that the loop control statements described
+later will I<NOT> work in this construct, because modifiers don't take
+loop labels. Sorry. You can always put another block inside of it
+(for C<next>) or around it (for C<last>) to do that sort of thing.
+For C<next>, just double the braces:
+
+ do {{
+ next if $x == $y;
+ # do something here
+ }} until $x++ > $z;
+
+For C<last>, you have to be more elaborate:
+
+ LOOP: {
+ do {
+ last if $x = $y**2;
+ # do something here
+ } while $x++ <= $z;
+ }
=head2 Compound statements
@@ -137,7 +154,7 @@ C<if> an C<else> goes with. If you use C<unless> in place of C<if>,
the sense of the test is reversed.
The C<while> statement executes the block as long as the expression is
-true (does not evaluate to the null string or 0 or "0"). The LABEL is
+true (does not evaluate to the null string (C<"">) or C<0> or C<"0")>. The LABEL is
optional, and if present, consists of an identifier followed by a colon.
The LABEL identifies the loop for the loop control statements C<next>,
C<last>, and C<redo>. If the LABEL is omitted, the loop control statement
@@ -199,31 +216,34 @@ which is Perl short-hand for the more explicitly written version:
# now process $line
}
-Or here's a simpleminded Pascal comment stripper (warning: assumes no
-{ or } in strings).
+Note that if there were a C<continue> block on the above code, it would get
+executed even on discarded lines. This is often used to reset line counters
+or C<?pat?> one-time matches.
- LINE: while (<STDIN>) {
- while (s|({.*}.*){.*}|$1 |) {}
- s|{.*}| |;
- if (s|{.*| |) {
- $front = $_;
- while (<STDIN>) {
- if (/}/) { # end of comment?
- s|^|$front{|;
- redo LINE;
- }
- }
- }
- print;
+ # inspired by :1,$g/fred/s//WILMA/
+ while (<>) {
+ ?(fred)? && s//WILMA $1 WILMA/;
+ ?(barney)? && s//BETTY $1 BETTY/;
+ ?(homer)? && s//MARGE $1 MARGE/;
+ } continue {
+ print "$ARGV $.: $_";
+ close ARGV if eof(); # reset $.
+ reset if eof(); # reset ?pat?
}
-Note that if there were a C<continue> block on the above code, it would get
-executed even on discarded lines.
-
If the word C<while> is replaced by the word C<until>, the sense of the
test is reversed, but the conditional is still tested before the first
iteration.
+The loop control statements don't work in an C<if> or C<unless>, since
+they aren't loops. You can double the braces to make them such, though.
+
+ if (/pattern/) {{
+ next if /fred/;
+ next if /barney/;
+ # so something here
+ }}
+
The form C<while/if BLOCK BLOCK>, available in Perl 4, is no longer
available. Replace any occurrence of C<if BLOCK> by C<if (do BLOCK)>.
@@ -270,15 +290,23 @@ implicitly local to the loop and regains its former value upon exiting
the loop. If the variable was previously declared with C<my>, it uses
that variable instead of the global one, but it's still localized to
the loop. (Note that a lexically scoped variable can cause problems
-with you have subroutine or format declarations.)
+if you have subroutine or format declarations within the loop which
+refer to it.)
The C<foreach> keyword is actually a synonym for the C<for> keyword, so
-you can use C<foreach> for readability or C<for> for brevity. If VAR is
-omitted, $_ is set to each value. If LIST is an actual array (as opposed
-to an expression returning a list value), you can modify each element of
-the array by modifying VAR inside the loop. That's because the C<foreach>
-loop index variable is an implicit alias for each item in the list that
-you're looping over.
+you can use C<foreach> for readability or C<for> for brevity. (Or because
+the Bourne shell is more familiar to you than I<csh>, so writing C<for>
+comes more naturally.) If VAR is omitted, C<$_> is set to each value.
+If any element of LIST is an lvalue, you can modify it by modifying VAR
+inside the loop. That's because the C<foreach> loop index variable is
+an implicit alias for each item in the list that you're looping over.
+
+If any part of LIST is an array, C<foreach> will get very confused if
+you add or remove elements within the loop body, for example with
+C<splice>. So don't do that.
+
+C<foreach> probably won't do what you expect if VAR is a tied or other
+special variable. Don't do that either.
Examples:
@@ -347,7 +375,7 @@ structures.
$nothing = 1;
}
-There is no official switch statement in Perl, because there are
+There is no official C<switch> statement in Perl, because there are
already several ways to write the equivalent. In addition to the
above, you could write
@@ -371,7 +399,7 @@ or
$nothing = 1;
}
-or formatted so it stands out more as a "proper" switch statement:
+or formatted so it stands out more as a "proper" C<switch> statement:
SWITCH: {
/^abc/ && do {
@@ -411,9 +439,8 @@ or even, horrors,
else
{ $nothing = 1 }
-
-A common idiom for a switch statement is to use C<foreach>'s aliasing to make
-a temporary assignment to $_ for convenient matching:
+A common idiom for a C<switch> statement is to use C<foreach>'s aliasing to make
+a temporary assignment to C<$_> for convenient matching:
SWITCH: for ($where) {
/In Card Names/ && do { push @flags, '-e'; last; };
@@ -426,7 +453,7 @@ Another interesting approach to a switch statement is arrange
for a C<do> block to return the proper value:
$amode = do {
- if ($flag & O_RDONLY) { "r" }
+ if ($flag & O_RDONLY) { "r" } # XXX: isn't this 0?
elsif ($flag & O_WRONLY) { ($flag & O_APPEND) ? "a" : "w" }
elsif ($flag & O_RDWR) {
if ($flag & O_CREAT) { "w+" }
@@ -434,34 +461,66 @@ for a C<do> block to return the proper value:
}
};
+Or
+
+ print do {
+ ($flags & O_WRONLY) ? "write-only" :
+ ($flags & O_RDWR) ? "read-write" :
+ "read-only";
+ };
+
+Or if you are certainly that all the C<&&> clauses are true, you can use
+something like this, which "switches" on the value of the
+C<HTTP_USER_AGENT> envariable.
+
+ #!/usr/bin/perl
+ # pick out jargon file page based on browser
+ $dir = 'http://www.wins.uva.nl/~mes/jargon';
+ for ($ENV{HTTP_USER_AGENT}) {
+ $page = /Mac/ && 'm/Macintrash.html'
+ || /Win(dows )?NT/ && 'e/evilandrude.html'
+ || /Win|MSIE|WebTV/ && 'm/MicroslothWindows.html'
+ || /Linux/ && 'l/Linux.html'
+ || /HP-UX/ && 'h/HP-SUX.html'
+ || /SunOS/ && 's/ScumOS.html'
+ || 'a/AppendixB.html';
+ }
+ print "Location: $dir/$page\015\012\015\012";
+
+That kind of switch statement only works when you know the C<&&> clauses
+will be true. If you don't, the previous C<?:> example should be used.
+
+You might also consider writing a hash instead of synthesizing a C<switch>
+statement.
+
=head2 Goto
Although not for the faint of heart, Perl does support a C<goto> statement.
A loop's LABEL is not actually a valid target for a C<goto>;
-it's just the name of the loop. There are three forms: goto-LABEL,
-goto-EXPR, and goto-&NAME.
+it's just the name of the loop. There are three forms: C<goto>-LABEL,
+C<goto>-EXPR, and C<goto>-&NAME.
-The goto-LABEL form finds the statement labeled with LABEL and resumes
+The C<goto>-LABEL form finds the statement labeled with LABEL and resumes
execution there. It may not be used to go into any construct that
-requires initialization, such as a subroutine or a foreach loop. It
+requires initialization, such as a subroutine or a C<foreach> loop. It
also can't be used to go into a construct that is optimized away. It
can be used to go almost anywhere else within the dynamic scope,
including out of subroutines, but it's usually better to use some other
-construct such as last or die. The author of Perl has never felt the
-need to use this form of goto (in Perl, that is--C is another matter).
+construct such as C<last> or C<die>. The author of Perl has never felt the
+need to use this form of C<goto> (in Perl, that is--C is another matter).
-The goto-EXPR form expects a label name, whose scope will be resolved
-dynamically. This allows for computed gotos per FORTRAN, but isn't
+The C<goto>-EXPR form expects a label name, whose scope will be resolved
+dynamically. This allows for computed C<goto>s per FORTRAN, but isn't
necessarily recommended if you're optimizing for maintainability:
goto ("FOO", "BAR", "GLARCH")[$i];
-The goto-&NAME form is highly magical, and substitutes a call to the
+The C<goto>-&NAME form is highly magical, and substitutes a call to the
named subroutine for the currently running subroutine. This is used by
-AUTOLOAD() subroutines that wish to load another subroutine and then
+C<AUTOLOAD()> subroutines that wish to load another subroutine and then
pretend that the other subroutine had been called in the first place
-(except that any modifications to @_ in the current subroutine are
-propagated to the other subroutine.) After the C<goto>, not even caller()
+(except that any modifications to C<@_> in the current subroutine are
+propagated to the other subroutine.) After the C<goto>, not even C<caller()>
will be able to tell that this routine was called first.
In almost all cases like this, it's usually a far, far better idea to use the
@@ -509,7 +568,7 @@ ignored by both the compiler and the translators.
=cut back
print "got $a\n";
-You probably shouldn't rely upon the warn() being podded out forever.
+You probably shouldn't rely upon the C<warn()> being podded out forever.
Not all pod translators are well-behaved in this regard, and perhaps
the compiler will become pickier.
@@ -518,10 +577,10 @@ of code.
=head2 Plain Old Comments (Not!)
-Much like the C preprocessor, perl can process line directives. Using
-this, one can control perl's idea of filenames and line numbers in
+Much like the C preprocessor, Perl can process line directives. Using
+this, one can control Perl's idea of filenames and line numbers in
error or warning messages (especially for strings that are processed
-with eval()). The syntax for this mechanism is the same as for most
+with C<eval()>). The syntax for this mechanism is the same as for most
C preprocessors: it matches the regular expression
C</^#\s*line\s+(\d+)\s*(?:\s"([^"]*)")?/> with C<$1> being the line
number for the next line, and C<$2> being the optional filename
diff --git a/gnu/usr.bin/perl/pod/perltie.pod b/gnu/usr.bin/perl/pod/perltie.pod
index c6eb7156ce3..665265818d3 100644
--- a/gnu/usr.bin/perl/pod/perltie.pod
+++ b/gnu/usr.bin/perl/pod/perltie.pod
@@ -23,7 +23,7 @@ Now you can.
The tie() function binds a variable to a class (package) that will provide
the implementation for access methods for that variable. Once this magic
has been performed, accessing a tied variable automatically triggers
-method calls in the proper class. All of the complexity of the class is
+method calls in the proper class. The complexity of the class is
hidden behind magic methods calls. The method names are in ALL CAPS,
which is a convention that Perl uses to indicate that they're called
implicitly rather than explicitly--just like the BEGIN() and END()
@@ -180,17 +180,26 @@ TIESCALAR classes are certainly possible.
=head2 Tying Arrays
A class implementing a tied ordinary array should define the following
-methods: TIEARRAY, FETCH, STORE, and perhaps DESTROY.
+methods: TIEARRAY, FETCH, STORE, FETCHSIZE, STORESIZE and perhaps DESTROY.
-B<WARNING>: Tied arrays are I<incomplete>. They are also distinctly lacking
-something for the C<$#ARRAY> access (which is hard, as it's an lvalue), as
-well as the other obvious array functions, like push(), pop(), shift(),
-unshift(), and splice().
+FETCHSIZE and STORESIZE are used to provide C<$#array> and
+equivalent C<scalar(@array)> access.
+
+The methods POP, PUSH, SHIFT, UNSHIFT, SPLICE are required if the perl
+operator with the corresponding (but lowercase) name is to operate on the
+tied array. The B<Tie::Array> class can be used as a base class to implement
+these in terms of the basic five methods above.
+
+In addition EXTEND will be called when perl would have pre-extended
+allocation in a real array.
+
+This means that tied arrays are now I<complete>. The example below needs
+upgrading to illustrate this. (The documentation in B<Tie::Array> is more
+complete.)
For this discussion, we'll implement an array whose indices are fixed at
its creation. If you try to access anything beyond those bounds, you'll
-take an exception. (Well, if you access an individual element; an
-aggregate assignment would be missed.) For example:
+take an exception. For example:
require Bounded_Array;
tie @ary, 'Bounded_Array', 2;
@@ -594,9 +603,9 @@ or have auxiliary state to clean up. Here's a very simple function:
=back
-Note that functions such as keys() and values() may return huge array
-values when used on large objects, like DBM files. You may prefer to
-use the each() function to iterate over such. Example:
+Note that functions such as keys() and values() may return huge lists
+when used on large objects, like DBM files. You may prefer to use the
+each() function to iterate over such. Example:
# print out history file offsets
use NDBM_File;
@@ -611,8 +620,8 @@ use the each() function to iterate over such. Example:
This is partially implemented now.
A class implementing a tied filehandle should define the following
-methods: TIEHANDLE, at least one of PRINT, PRINTF, READLINE, GETC, or READ,
-and possibly DESTROY.
+methods: TIEHANDLE, at least one of PRINT, PRINTF, WRITE, READLINE, GETC,
+READ, and possibly CLOSE and DESTROY.
It is especially useful when perl is embedded in some other program,
where output to STDOUT and STDERR may have to be redirected in some
@@ -632,6 +641,17 @@ hold some internal information.
sub TIEHANDLE { print "<shout>\n"; my $i; bless \$i, shift }
+=item WRITE this, LIST
+
+This method will be called when the handle is written to via the
+C<syswrite> function.
+
+ sub WRITE {
+ $r = shift;
+ my($buf,$len,$offset) = @_;
+ print "WRITE called, \$buf=$buf, \$len=$len, \$offset=$offset";
+ }
+
=item PRINT this, LIST
This method will be triggered every time the tied handle is printed to
@@ -654,15 +674,18 @@ passed to the printf function.
print sprintf($fmt, @_)."\n";
}
-=item READ this LIST
+=item READ this, LIST
This method will be called when the handle is read from via the C<read>
or C<sysread> functions.
sub READ {
- $r = shift;
- my($buf,$len,$offset) = @_;
- print "READ called, \$buf=$buf, \$len=$len, \$offset=$offset";
+ my $self = shift;
+ my $$bufref = \$_[0];
+ my(undef,$len,$offset) = @_;
+ print "READ called, \$buf=$bufref, \$len=$len, \$offset=$offset";
+ # add to $$bufref, set $len to number of characters read
+ $len;
}
=item READLINE this
@@ -670,7 +693,7 @@ or C<sysread> functions.
This method will be called when the handle is read from via <HANDLE>.
The method should return undef when there is no more data.
- sub READLINE { $r = shift; "PRINT called $$r times\n"; }
+ sub READLINE { $r = shift; "READLINE called $$r times\n"; }
=item GETC this
@@ -678,6 +701,13 @@ This method will be called when the C<getc> function is called.
sub GETC { print "Don't GETC, Get Perl"; return "a"; }
+=item CLOSE this
+
+This method will be called when the handle is closed via the C<close>
+function.
+
+ sub CLOSE { print "CLOSE called.\n" }
+
=item DESTROY this
As with the other types of ties, this method will be called when the
diff --git a/gnu/usr.bin/perl/pod/perltoc.pod b/gnu/usr.bin/perl/pod/perltoc.pod
index ce4267e7ce7..f0052c61f43 100644
--- a/gnu/usr.bin/perl/pod/perltoc.pod
+++ b/gnu/usr.bin/perl/pod/perltoc.pod
@@ -38,8 +38,8 @@ expression enhancements, Innumerable Unbundled Modules, Compilability
=item NOTES
-=head2 perlfaq - frequently asked questions about Perl ($Date: 1997/04/24
-22:46:06 $)
+=head2 perlfaq - frequently asked questions about Perl ($Date: 1998/07/20
+23:12:17 $)
=item DESCRIPTION
@@ -66,9 +66,7 @@ authors
=over
-=item Noncommercial Reproduction
-
-=item Commercial Reproduction
+=item Bundled Distributions
=item Disclaimer
@@ -79,8 +77,8 @@ authors
24/April/97, 23/April/97, 25/March/97, 18/March/97, 17/March/97 Version,
Initial Release: 11/March/97
-=head2 perlfaq1 - General Questions About Perl ($Revision: 1.2 $, $Date:
-1997/04/24 22:43:34 $)
+=head2 perlfaq1 - General Questions About Perl ($Revision: 1.3 $, $Date:
+1998/06/14 22:15:25 $)
=item DESCRIPTION
@@ -120,8 +118,8 @@ Scheme, or Tcl?
=item AUTHOR AND COPYRIGHT
-=head2 perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.2 $,
-$Date: 1997/11/30 07:59:32 $)
+=head2 perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.3 $,
+$Date: 1999/04/29 22:52:20 $)
=item DESCRIPTION
@@ -139,7 +137,7 @@ don't work.
=item I grabbed the sources and tried to compile but gdbm/dynamic
loading/malloc/linking/... failed. How do I make it work?
-=item What modules and extensions are available for Perl? What is CPAN?
+=item What modules and extensions are available for Perl? What is CPAN?
What does CPAN/src/... mean?
=item Is there an ISO or ANSI certified version of Perl?
@@ -152,6 +150,10 @@ What does CPAN/src/... mean?
=item Perl Books
+References, Tutorials
+*Learning Perl [2nd edition]
+by Randal L. Schwartz and Tom Christiansen, Task-Oriented, Special Topics
+
=item Perl in Magazines
=item Perl on the Net: FTP and WWW Access
@@ -162,8 +164,6 @@ MacPerl, Perl5-Porters, NTPerl, Perl-Packrats
=item Archives of comp.lang.perl.misc
-=item Perl Training
-
=item Where can I buy a commercial version of Perl?
=item Where do I send bug reports?
@@ -176,8 +176,8 @@ MacPerl, Perl5-Porters, NTPerl, Perl-Packrats
=item AUTHOR AND COPYRIGHT
-=head2 perlfaq3 - Programming Tools ($Revision: 1.2 $, $Date: 1997/04/24
-22:43:42 $)
+=head2 perlfaq3 - Programming Tools ($Revision: 1.3 $, $Date: 1998/07/16
+22:08:49 $)
=item DESCRIPTION
@@ -209,8 +209,6 @@ MacPerl, Perl5-Porters, NTPerl, Perl-Packrats
=item How can I generate simple menus without using CGI or Tk?
-=item Can I dynamically load C routines into Perl?
-
=item What is undump?
=item How can I make my Perl program run faster?
@@ -227,7 +225,7 @@ MacPerl, Perl5-Porters, NTPerl, Perl-Packrats
=item How can I compile my Perl program into byte code or C?
-=item How can I get '#!perl' to work on [MS-DOS,NT,...]?
+=item How can I get C<#!perl> to work on [MS-DOS,NT,...]?
=item Can I write useful perl programs on the command line?
@@ -251,8 +249,8 @@ mean?
=item AUTHOR AND COPYRIGHT
-=head2 perlfaq4 - Data Manipulation ($Revision: 1.2 $, $Date: 1997/04/24
-22:43:57 $)
+=head2 perlfaq4 - Data Manipulation ($Revision: 1.3 $, $Date: 1998/07/16
+22:49:55 $)
=item DESCRIPTION
@@ -286,13 +284,13 @@ Trig functions?
=item How do I find the week-of-the-year/day-of-the-year?
-=item How can I compare two date strings?
+=item How can I compare two dates and find the difference?
=item How can I take a string and turn it into epoch seconds?
=item How can I find the Julian Day?
-=item Does Perl have a year 2000 problem?
+=item Does Perl have a year 2000 problem? Is Perl Y2K compliant?
=back
@@ -354,12 +352,13 @@ the tag
=item How can I extract just the unique elements of an array?
-a) If @in is sorted, and you want @out to be sorted:, b) If you don't know
-whether @in is sorted:, c) Like (b), but @in contains only small integers:,
-d) A way to do (b) without any loops or greps:, e) Like (d), but @in
-contains only small positive integers:
+a) If @in is sorted, and you want @out to be sorted:(this assumes all true
+values in the array), b) If you don't know whether @in is sorted:, c) Like
+(b), but @in contains only small integers:, d) A way to do (b) without any
+loops or greps:, e) Like (d), but @in contains only small positive
+integers:
-=item How can I tell whether an array contains a certain element?
+=item How can I tell whether a list or array contains a certain element?
=item How do I compute the difference of two arrays? How do I compute the
intersection of two arrays?
@@ -445,14 +444,14 @@ array of hashes or arrays?
=item AUTHOR AND COPYRIGHT
-=head2 perlfaq5 - Files and Formats ($Revision: 1.2 $, $Date: 1997/04/24
-22:44:02 $)
+=head2 perlfaq5 - Files and Formats ($Revision: 1.3 $, $Date: 1998/07/05
+15:07:20 $)
=item DESCRIPTION
=over
-=item How do I flush/unbuffer a filehandle? Why must I do this?
+=item How do I flush/unbuffer an output filehandle? Why must I do this?
=item How do I change one line in a file/delete a line in a file/insert a
line in the middle of a file/append to the beginning of a file?
@@ -466,6 +465,8 @@ line in the middle of a file/append to the beginning of a file?
=item How can I make a filehandle local to a subroutine? How do I pass
filehandles between subroutines? How do I make an array of filehandles?
+=item How can I use a filehandle indirectly?
+
=item How can I set up a footer format to be used with write()?
=item How can I write() into a string?
@@ -474,7 +475,7 @@ filehandles between subroutines? How do I make an array of filehandles?
=item How can I translate tildes (~) in a filename?
-=item How come when I open the file read-write it wipes it out?
+=item How come when I open a file read-write it wipes it out?
=item Why do I sometimes get an "Argument list too long" when I use <*>?
@@ -505,10 +506,6 @@ the file. How can I do this?
=item How can I tell if there's a character waiting on a filehandle?
-=item How do I open a file without blocking?
-
-=item How do I create a file only if it doesn't exist?
-
=item How do I do a C<tail -f> in perl?
=item How do I dup() a filehandle in Perl?
@@ -529,7 +526,7 @@ protected files? Isn't this a bug in Perl?
=item AUTHOR AND COPYRIGHT
-=head2 perlfaq6 - Regexps ($Revision: 1.2 $, $Date: 1997/11/30 07:59:32 $)
+=head2 perlfaq6 - Regexps ($Revision: 1.3 $, $Date: 1999/04/29 22:52:20 $)
=item DESCRIPTION
@@ -551,7 +548,7 @@ different lines?
=item How do I substitute case insensitively on the LHS, but preserving
case on the RHS?
-=item How can I make C<\w> match accented characters?
+=item How can I make C<\w> match national character sets?
=item How can I match a locale-smart version of C</[a-zA-Z]/>?
@@ -590,8 +587,8 @@ file?
=item AUTHOR AND COPYRIGHT
-=head2 perlfaq7 - Perl Language Issues ($Revision: 1.2 $, $Date:
-1997/04/24 22:44:14 $)
+=head2 perlfaq7 - Perl Language Issues ($Revision: 1.3 $, $Date:
+1998/06/22 15:20:07 $)
=item DESCRIPTION
@@ -633,7 +630,7 @@ Passing Methods
=item How do I create a static variable?
-=item What's the difference between dynamic and lexical (static) scoping?
+=item What's the difference between dynamic and lexical (static) scoping?
Between local() and my()?
=item How can I access a dynamic variable while a similarly named lexical
@@ -641,7 +638,7 @@ is in scope?
=item What's the difference between deep and shallow binding?
-=item Why doesn't "local($foo) = <FILE>;" work right?
+=item Why doesn't "my($foo) = <FILE>;" work right?
=item How do I redefine a builtin function, operator, or method?
@@ -661,8 +658,8 @@ is in scope?
=item AUTHOR AND COPYRIGHT
-=head2 perlfaq8 - System Interaction ($Revision: 1.2 $, $Date: 1997/04/24
-22:44:19 $)
+=head2 perlfaq8 - System Interaction ($Revision: 1.3 $, $Date: 1998/07/05
+15:07:20 $)
=item DESCRIPTION
@@ -676,6 +673,16 @@ is in scope?
Keyboard, Screen, Mouse
+=item How do I print something out in color?
+
+=item How do I read just one key without waiting for a return key?
+
+=item How do I check whether input is ready on the keyboard?
+
+=item How do I clear the screen?
+
+=item How do I get the screen size?
+
=item How do I ask the user for a password?
=item How do I read and write the serial port?
@@ -686,7 +693,7 @@ lockfiles, open mode, end of line, flushing output, non-blocking input
=item How do I start a process in the background?
-STDIN, STDOUT and STDERR are shared, Signals, Zombies
+STDIN, STDOUT, and STDERR are shared, Signals, Zombies
=item How do I trap control characters/signals?
@@ -737,7 +744,7 @@ does the error message "Protocol not supported" mean?
come the change disappeared when I exited the script? How do I get my
changes to be visible?
-Unix, VMS
+Unix
=item How do I close a process's filehandle without waiting for it to
complete?
@@ -762,6 +769,8 @@ complete?
=item How do I install a CPAN module?
+=item What's the difference between require and use?
+
=item How do I keep my own module/library directory?
=item How do I add the directory my program lives in to the module/library
@@ -771,19 +780,19 @@ search path?
=back
-=item How do I get one key from the terminal at a time, under POSIX?
-
=item AUTHOR AND COPYRIGHT
-=head2 perlfaq9 - Networking ($Revision: 1.2 $, $Date: 1997/04/24 22:44:29
+=head2 perlfaq9 - Networking ($Revision: 1.3 $, $Date: 1998/06/22 18:31:09
$)
=item DESCRIPTION
=over
-=item My CGI script runs from the command line but not the browser. Can
-you help me fix it?
+=item My CGI script runs from the command line but not the browser. (500
+Server Error)
+
+=item How can I get better error messages from a CGI program?
=item How do I remove HTML from a string?
@@ -796,7 +805,9 @@ file on another machine?
=item How do I fetch an HTML file?
-=item how do I decode or create those %-encodings on the web?
+=item How do I automate an HTML form submission?
+
+=item How do I decode or create those %-encodings on the web?
=item How do I redirect to another page?
@@ -807,17 +818,19 @@ file on another machine?
=item How do I make sure users can't enter values into a form that cause my
CGI script to do bad things?
-=item How do I parse an email header?
+=item How do I parse a mail header?
=item How do I decode a CGI form?
-=item How do I check a valid email address?
+=item How do I check a valid mail address?
=item How do I decode a MIME/BASE64 string?
-=item How do I return the user's email address?
+=item How do I return the user's mail address?
-=item How do I send/read mail?
+=item How do I send mail?
+
+=item How do I read mail?
=item How do I find out my hostname/domainname/IP address?
@@ -831,188 +844,172 @@ CGI script to do bad things?
=item AUTHOR AND COPYRIGHT
-=head2 perldelta - what's new for perl5.004
+=head2 perldelta - what's new for perl5.005
=item DESCRIPTION
-=item Supported Environments
+=item About the new versioning system
-=item Core Changes
+=item Incompatible Changes
=over
-=item List assignment to %ENV works
-
-=item "Can't locate Foo.pm in @INC" error now lists @INC
-
-=item Compilation option: Binary compatibility with 5.003
-
-=item $PERL5OPT environment variable
+=item WARNING: This version is not binary compatible with Perl 5.004.
-=item Limitations on B<-M>, B<-m>, and B<-T> options
+=item Default installation structure has changed
-=item More precise warnings
+=item Perl Source Compatibility
-=item Deprecated: Inherited C<AUTOLOAD> for non-methods
+=item C Source Compatibility
-=item Previously deprecated %OVERLOAD is no longer usable
+Core sources now require ANSI C compiler, All Perl global variables must
+now be referenced with an explicit prefix, Enabling threads has source
+compatibility issues
-=item Subroutine arguments created only when they're modified
+=item Binary Compatibility
-=item Group vector changeable with C<$)>
+=item Security fixes may affect compatibility
-=item Fixed parsing of $$<digit>, &$<digit>, etc.
+=item Relaxed new mandatory warnings introduced in 5.004
-=item No resetting of $. on implicit close
+=item Licensing
-=item C<wantarray> may return undef
+=back
-=item Changes to tainting checks
+=item Core Changes
-No glob() or <*>, No spawning if tainted $CDPATH, $ENV, $BASH_ENV, No
-spawning if tainted $TERM doesn't look like a terminal name
+=over
-=item New Opcode module and revised Safe module
+=item Threads
-=item Embedding improvements
+=item Compiler
-=item Internal change: FileHandle class based on IO::* classes
+=item Regular Expressions
-=item Internal change: PerlIO abstraction interface
+Many new and improved optimizations, Many bug fixes, New regular expression
+constructs, New operator for precompiled regular expressions, Other
+improvements, Incompatible changes
-=item New and changed syntax
+=item Improved malloc()
-$coderef->(PARAMS)
+=item Quicksort is internally implemented
-=item New and changed builtin constants
+=item Reliable signals
-__PACKAGE__
+=item Reliable stack pointers
-=item New and changed builtin variables
+=item More generous treatment of carriage returns
-$^E, $^H, $^M
+=item Memory leaks
-=item New and changed builtin functions
+=item Better support for multiple interpreters
-delete on slices, flock, printf and sprintf, keys as an lvalue, my() in
-Control Structures, pack() and unpack(), sysseek(), use VERSION, use Module
-VERSION LIST, prototype(FUNCTION), srand, $_ as Default, C<m//gc> does not
-reset search position on failure, C<m//x> ignores whitespace before ?*+{},
-nested C<sub{}> closures work now, formats work right on changing lexicals
+=item Behavior of local() on array and hash elements is now well-defined
-=item New builtin methods
+=item C<%!> is transparently tied to the L<Errno> module
-isa(CLASS), can(METHOD), VERSION( [NEED] )
+=item Pseudo-hashes are supported
-=item TIEHANDLE now supported
+=item C<EXPR foreach EXPR> is supported
-TIEHANDLE classname, LIST, PRINT this, LIST, PRINTF this, LIST, READ this
-LIST, READLINE this, GETC this, DESTROY this
+=item Keywords can be globally overridden
-=item Malloc enhancements
+=item C<$^E> is meaningful on Win32
--DDEBUGGING_MSTATS, -DPERL_EMERGENCY_SBRK, -DPACK_MALLOC, -DTWO_POT_OPTIMIZE
+=item C<foreach (1..1000000)> optimized
-=item Miscellaneous efficiency enhancements
+=item C<Foo::> can be used as implicitly quoted package name
-=back
+=item C<exists $Foo::{Bar::}> tests existence of a package
-=item Support for More Operating Systems
+=item Better locale support
-=over
+=item Experimental support for 64-bit platforms
-=item Win32
+=item prototype() returns useful results on builtins
-=item Plan 9
+=item Extended support for exception handling
-=item QNX
+=item Re-blessing in DESTROY() supported for chaining DESTROY() methods
-=item AmigaOS
+=item All C<printf> format conversions are handled internally
-=back
+=item New C<INIT> keyword
-=item Pragmata
+=item New C<lock> keyword
-use autouse MODULE => qw(sub1 sub2 sub3), use blib, use blib 'dir', use
-constant NAME => VALUE, use locale, use ops, use vmsish
+=item New C<qr//> operator
-=item Modules
+=item C<our> is now a reserved word
-=over
+=item Tied arrays are now fully supported
-=item Required Updates
+=item Tied handles support is better
-=item Installation directories
+=item 4th argument to substr
-=item Module information summary
+=item Negative LENGTH argument to splice
-=item Fcntl
+=item Magic lvalues are now more magical
-=item IO
+=item E<lt>E<gt> now reads in records
-=item Math::Complex
+=back
-=item Math::Trig
+=item Supported Platforms
-=item DB_File
+=over
-=item Net::Ping
+=item New Platforms
-=item Object-oriented overrides for builtin operators
+=item Changes in existing support
=back
-=item Utility Changes
+=item Modules and Pragmata
=over
-=item pod2html
+=item New Modules
-Sends converted HTML to standard output
+B, Data::Dumper, Errno, File::Spec, ExtUtils::Installed,
+ExtUtils::Packlist, Fatal, IPC::SysV, Test, Tie::Array, Tie::Handle,
+Thread, attrs, fields, re
-=item xsubpp
+=item Changes in existing modules
-C<void> XSUBs now default to returning nothing
+CGI, POSIX, DB_File, MakeMaker, CPAN, Cwd, Benchmark
=back
-=item C Language API Changes
-
-C<gv_fetchmethod> and C<perl_call_sv>, C<perl_eval_pv>, Extended API for
-manipulating hashes
+=item Utility Changes
=item Documentation Changes
-L<perldelta>, L<perlfaq>, L<perllocale>, L<perltoot>, L<perlapio>,
-L<perlmodlib>, L<perldebug>, L<perlsec>
-
=item New Diagnostics
-"my" variable %s masks earlier declaration in same scope, %s argument is
-not a HASH element or slice, Allocation too large: %lx, Allocation too
-large, Applying %s to %s will act on scalar(%s), Attempt to free
-nonexistent shared string, Attempt to use reference as lvalue in substr,
-Can't redefine active sort subroutine %s, Can't use bareword ("%s") as %s
-ref while "strict refs" in use, Cannot resolve method `%s' overloading `%s'
-in package `%s', Constant subroutine %s redefined, Constant subroutine %s
-undefined, Copy method did not return a reference, Died, Exiting
-pseudo-block via %s, Identifier too long, Illegal character %s (carriage
-return), Illegal switch in PERL5OPT: %s, Integer overflow in hex number,
-Integer overflow in octal number, internal error: glob failed, Invalid
-conversion in %s: "%s", Invalid type in pack: '%s', Invalid type in unpack:
-'%s', Name "%s::%s" used only once: possible typo, Null picture in
-formline, Offset outside string, Out of memory!, Out of memory during
-request for %s, panic: frexp, Possible attempt to put comments in qw()
-list, Possible attempt to separate words with commas, Scalar value @%s{%s}
-better written as $%s{%s}, Stub found while resolving method `%s'
-overloading `%s' in package `%s', Too late for "B<-T>" option, untie
-attempted while %d inner references still exist, Unrecognized character %s,
-Unsupported function fork, Use of "$$<digit>" to mean "${$}<digit>" is
-deprecated, Value of %s can be "0"; test with defined(), Variable "%s" may
-be unavailable, Variable "%s" will not stay shared, Warning: something's
-wrong, Ill-formed logical name |%s| in prime_env_iter, Got an error from
-DosAllocMem, Malformed PERLLIB_PREFIX, PERL_SH_DIR too long, Process
-terminated by SIG%s
+Ambiguous call resolved as CORE::%s(), qualify as such or use &, Bad index
+while coercing array into hash, Bareword "%s" refers to nonexistent
+package, Can't call method "%s" on an undefined value, Can't coerce array
+into hash, Can't goto subroutine from an eval-string, Can't localize
+pseudo-hash element, Can't use %%! because Errno.pm is not available,
+Cannot find an opnumber for "%s", Character class syntax [. .] is reserved
+for future extensions, Character class syntax [: :] is reserved for future
+extensions, Character class syntax [= =] is reserved for future extensions,
+%s: Eval-group in insecure regular expression, %s: Eval-group not allowed,
+use re 'eval', %s: Eval-group not allowed at run time, Explicit blessing to
+'' (assuming package main), Illegal hex digit ignored, No such array field,
+No such field "%s" in variable %s of type %s, Out of memory during
+ridiculously large request, Range iterator outside integer range, Recursive
+inheritance detected while looking for method '%s' in package '%s',
+Reference found where even-sized list expected, Undefined value assigned to
+typeglob, Use of reserved word "%s" is deprecated, perl: warning: Setting
+locale failed
+
+=item Obsolete Diagnostics
+
+Can't mktemp(), Can't write to temp file for B<-e>: %s, Cannot open
+temporary file
=item BUGS
@@ -1108,7 +1105,7 @@ terminated by SIG%s
=item C-style Logical Or
-=item Range Operator
+=item Range Operators
=item Conditional Operator
@@ -1132,19 +1129,31 @@ unary &, unary *, (TYPE)
=item Regexp Quote-Like Operators
-?PATTERN?, m/PATTERN/gimosx, /PATTERN/gimosx, q/STRING/, C<'STRING'>,
-qq/STRING/, "STRING", qx/STRING/, `STRING`, qw/STRING/,
+?PATTERN?, m/PATTERN/cgimosx, /PATTERN/cgimosx, q/STRING/, C<'STRING'>,
+qq/STRING/, "STRING", qr/STRING/imosx, qx/STRING/, `STRING`, qw/STRING/,
s/PATTERN/REPLACEMENT/egimosx, tr/SEARCHLIST/REPLACEMENTLIST/cds,
y/SEARCHLIST/REPLACEMENTLIST/cds
+=item Gory details of parsing quoted constructs
+
+Finding the end, Removal of backslashes before delimiters, Interpolation,
+C<<<'EOF'>, C<m''>, C<s'''>, C<tr///>, C<y///>, C<''>, C<q//>, C<"">,
+C<``>, C<qq//>, C<qx//>, C<<file*globE<gt>>, C<?RE?>, C</RE/>, C<m/RE/>,
+C<s/RE/foo/>,, Interpolation of regular expressions, Optimization of
+regular expressions
+
=item I/O Operators
=item Constant Folding
+=item Bitwise String Operators
+
=item Integer Arithmetic
=item Floating-point Arithmetic
+=item Bigger Numbers
+
=back
=head2 perlre - Perl regular expressions
@@ -1157,7 +1166,10 @@ i, m, s, x
=item Regular Expressions
-(?#text), (?:regexp), (?=regexp), (?!regexp), (?imsx)
+C<(?#text)>, C<(?:pattern)>, C<(?imsx-imsx:pattern)>, C<(?=pattern)>,
+C<(?!pattern)>, C<(?E<lt>=pattern)>, C<(?<!pattern)>, C<(?{ code })>,
+C<(?E<gt>pattern)>, C<(?(condition)yes-pattern|no-pattern)>,
+C<(?(condition)yes-pattern)>, C<(?imsx-imsx)>
=item Backtracking
@@ -1165,6 +1177,10 @@ i, m, s, x
=item WARNING on \1 vs $1
+=item Repeated patterns matching zero-length substring
+
+=item Creating custom RE engines
+
=item SEE ALSO
=back
@@ -1181,10 +1197,12 @@ i, m, s, x
OS/2, MS-DOS, Win95/NT, Macintosh
+=item Location of Perl
+
=item Switches
-B<-0>[I<digits>], B<-a>, B<-c>, B<-d>, B<-d:>I<foo>, B<-D>I<number>,
-B<-D>I<list>, B<-e> I<commandline>, B<-F>I<pattern>, B<-h>,
+B<-0>[I<digits>], B<-a>, B<-c>, B<-d>, B<-d:>I<foo>, B<-D>I<letters>,
+B<-D>I<number>, B<-e> I<commandline>, B<-F>I<pattern>, B<-h>,
B<-i>[I<extension>], B<-I>I<directory>, B<-l>[I<octnum>],
B<-m>[B<->]I<module>, B<-M>[B<->]I<module>, B<-M>[B<->]I<'module ...'>,
B<-[mM]>[B<->]I<module=arg[,arg]...>, B<-n>, B<-p>, B<-P>, B<-s>, B<-S>,
@@ -1201,8 +1219,6 @@ HOME, LOGDIR, PATH, PERL5LIB, PERL5OPT, PERLLIB, PERL5DB, PERL5SHELL
=item DESCRIPTION
- I<THERE IS NO GENERAL RULE FOR CONVERTING A LIST INTO A SCALAR!>
-
=over
=item Perl Functions by Category
@@ -1221,48 +1237,49 @@ in perl5
=item Alphabetical Listing of Perl Functions
--I<X> FILEHANDLE, -I<X> EXPR, -I<X>, abs VALUE, abs, accept
+I<-X> FILEHANDLE, I<-X> EXPR, I<-X>, abs VALUE, abs, accept
NEWSOCKET,GENERICSOCKET, alarm SECONDS, alarm, atan2 Y,X, bind SOCKET,NAME,
binmode FILEHANDLE, bless REF,CLASSNAME, bless REF, caller EXPR, caller,
chdir EXPR, chmod LIST, chomp VARIABLE, chomp LIST, chomp, chop VARIABLE,
chop LIST, chop, chown LIST, chr NUMBER, chr, chroot FILENAME, chroot,
-close FILEHANDLE, closedir DIRHANDLE, connect SOCKET,NAME, continue BLOCK,
-cos EXPR, crypt PLAINTEXT,SALT, dbmclose HASH, dbmopen HASH,DBNAME,MODE,
-defined EXPR, defined, delete EXPR, die LIST, do BLOCK, do
-SUBROUTINE(LIST), do EXPR, dump LABEL, each HASH, eof FILEHANDLE, eof (),
-eof, eval EXPR, eval BLOCK, exec LIST, exists EXPR, exit EXPR, exp EXPR,
-exp, fcntl FILEHANDLE,FUNCTION,SCALAR, fileno FILEHANDLE, flock
-FILEHANDLE,OPERATION, fork, format, formline PICTURE,LIST, getc FILEHANDLE,
-getc, getlogin, getpeername SOCKET, getpgrp PID, getppid, getpriority
-WHICH,WHO, getpwnam NAME, getgrnam NAME, gethostbyname NAME, getnetbyname
-NAME, getprotobyname NAME, getpwuid UID, getgrgid GID, getservbyname
-NAME,PROTO, gethostbyaddr ADDR,ADDRTYPE, getnetbyaddr ADDR,ADDRTYPE,
-getprotobynumber NUMBER, getservbyport PORT,PROTO, getpwent, getgrent,
-gethostent, getnetent, getprotoent, getservent, setpwent, setgrent,
-sethostent STAYOPEN, setnetent STAYOPEN, setprotoent STAYOPEN, setservent
-STAYOPEN, endpwent, endgrent, endhostent, endnetent, endprotoent,
-endservent, getsockname SOCKET, getsockopt SOCKET,LEVEL,OPTNAME, glob EXPR,
-glob, gmtime EXPR, goto LABEL, goto EXPR, goto &NAME, grep BLOCK LIST, grep
-EXPR,LIST, hex EXPR, hex, import, index STR,SUBSTR,POSITION, index
-STR,SUBSTR, int EXPR, int, ioctl FILEHANDLE,FUNCTION,SCALAR, join
-EXPR,LIST, keys HASH, kill LIST, last LABEL, last, lc EXPR, lc, lcfirst
-EXPR, lcfirst, length EXPR, length, link OLDFILE,NEWFILE, listen
-SOCKET,QUEUESIZE, local EXPR, localtime EXPR, log EXPR, log, lstat
-FILEHANDLE, lstat EXPR, lstat, m//, map BLOCK LIST, map EXPR,LIST, mkdir
-FILENAME,MODE, msgctl ID,CMD,ARG, msgget KEY,FLAGS, msgsnd ID,MSG,FLAGS,
-msgrcv ID,VAR,SIZE,TYPE,FLAGS, my EXPR, next LABEL, next, no Module LIST,
-oct EXPR, oct, open FILEHANDLE,EXPR, open FILEHANDLE, opendir
-DIRHANDLE,EXPR, ord EXPR, ord, pack TEMPLATE,LIST, package NAMESPACE, pipe
-READHANDLE,WRITEHANDLE, pop ARRAY, pop, pos SCALAR, pos, print FILEHANDLE
-LIST, print LIST, print, printf FILEHANDLE FORMAT, LIST, printf FORMAT,
-LIST, prototype FUNCTION, push ARRAY,LIST, q/STRING/, qq/STRING/,
-qx/STRING/, qw/STRING/, quotemeta EXPR, quotemeta, rand EXPR, rand, read
-FILEHANDLE,SCALAR,LENGTH,OFFSET, read FILEHANDLE,SCALAR,LENGTH, readdir
-DIRHANDLE, readlink EXPR, readlink, recv SOCKET,SCALAR,LEN,FLAGS, redo
-LABEL, redo, ref EXPR, ref, rename OLDNAME,NEWNAME, require EXPR, require,
-reset EXPR, reset, return EXPR, return, reverse LIST, rewinddir DIRHANDLE,
-rindex STR,SUBSTR,POSITION, rindex STR,SUBSTR, rmdir FILENAME, rmdir, s///,
-scalar EXPR, seek FILEHANDLE,POSITION,WHENCE, seekdir DIRHANDLE,POS, select
+close FILEHANDLE, close, closedir DIRHANDLE, connect SOCKET,NAME, continue
+BLOCK, cos EXPR, crypt PLAINTEXT,SALT, dbmclose HASH, dbmopen
+HASH,DBNAME,MODE, defined EXPR, defined, delete EXPR, die LIST, do BLOCK,
+do SUBROUTINE(LIST), do EXPR, dump LABEL, each HASH, eof FILEHANDLE, eof
+(), eof, eval EXPR, eval BLOCK, exec LIST, exec PROGRAM LIST, exists EXPR,
+exit EXPR, exp EXPR, exp, fcntl FILEHANDLE,FUNCTION,SCALAR, fileno
+FILEHANDLE, flock FILEHANDLE,OPERATION, fork, format, formline
+PICTURE,LIST, getc FILEHANDLE, getc, getlogin, getpeername SOCKET, getpgrp
+PID, getppid, getpriority WHICH,WHO, getpwnam NAME, getgrnam NAME,
+gethostbyname NAME, getnetbyname NAME, getprotobyname NAME, getpwuid UID,
+getgrgid GID, getservbyname NAME,PROTO, gethostbyaddr ADDR,ADDRTYPE,
+getnetbyaddr ADDR,ADDRTYPE, getprotobynumber NUMBER, getservbyport
+PORT,PROTO, getpwent, getgrent, gethostent, getnetent, getprotoent,
+getservent, setpwent, setgrent, sethostent STAYOPEN, setnetent STAYOPEN,
+setprotoent STAYOPEN, setservent STAYOPEN, endpwent, endgrent, endhostent,
+endnetent, endprotoent, endservent, getsockname SOCKET, getsockopt
+SOCKET,LEVEL,OPTNAME, glob EXPR, glob, gmtime EXPR, goto LABEL, goto EXPR,
+goto &NAME, grep BLOCK LIST, grep EXPR,LIST, hex EXPR, hex, import, index
+STR,SUBSTR,POSITION, index STR,SUBSTR, int EXPR, int, ioctl
+FILEHANDLE,FUNCTION,SCALAR, join EXPR,LIST, keys HASH, kill LIST, last
+LABEL, last, lc EXPR, lc, lcfirst EXPR, lcfirst, length EXPR, length, link
+OLDFILE,NEWFILE, listen SOCKET,QUEUESIZE, local EXPR, localtime EXPR, log
+EXPR, log, lstat FILEHANDLE, lstat EXPR, lstat, m//, map BLOCK LIST, map
+EXPR,LIST, mkdir FILENAME,MODE, msgctl ID,CMD,ARG, msgget KEY,FLAGS, msgsnd
+ID,MSG,FLAGS, msgrcv ID,VAR,SIZE,TYPE,FLAGS, my EXPR, next LABEL, next, no
+Module LIST, oct EXPR, oct, open FILEHANDLE,EXPR, open FILEHANDLE, opendir
+DIRHANDLE,EXPR, ord EXPR, ord, pack TEMPLATE,LIST, package, package
+NAMESPACE, pipe READHANDLE,WRITEHANDLE, pop ARRAY, pop, pos SCALAR, pos,
+print FILEHANDLE LIST, print LIST, print, printf FILEHANDLE FORMAT, LIST,
+printf FORMAT, LIST, prototype FUNCTION, push ARRAY,LIST, q/STRING/,
+qq/STRING/, qr/STRING/, qx/STRING/, qw/STRING/, quotemeta EXPR, quotemeta,
+rand EXPR, rand, read FILEHANDLE,SCALAR,LENGTH,OFFSET, read
+FILEHANDLE,SCALAR,LENGTH, readdir DIRHANDLE, readline EXPR, readlink EXPR,
+readlink, readpipe EXPR, recv SOCKET,SCALAR,LEN,FLAGS, redo LABEL, redo,
+ref EXPR, ref, rename OLDNAME,NEWNAME, require EXPR, require, reset EXPR,
+reset, return EXPR, return, reverse LIST, rewinddir DIRHANDLE, rindex
+STR,SUBSTR,POSITION, rindex STR,SUBSTR, rmdir FILENAME, rmdir, s///, scalar
+EXPR, seek FILEHANDLE,POSITION,WHENCE, seekdir DIRHANDLE,POS, select
FILEHANDLE, select, select RBITS,WBITS,EBITS,TIMEOUT, semctl
ID,SEMNUM,CMD,ARG, semget KEY,NSEMS,FLAGS, semop KEY,OPSTRING, send
SOCKET,MSG,FLAGS,TO, send SOCKET,MSG,FLAGS, setpgrp PID,PGRP, setpriority
@@ -1275,19 +1292,20 @@ sort LIST, splice ARRAY,OFFSET,LENGTH,LIST, splice ARRAY,OFFSET,LENGTH,
splice ARRAY,OFFSET, split /PATTERN/,EXPR,LIMIT, split /PATTERN/,EXPR,
split /PATTERN/, split, sprintf FORMAT, LIST, sqrt EXPR, sqrt, srand EXPR,
srand, stat FILEHANDLE, stat EXPR, stat, study SCALAR, study, sub BLOCK,
-sub NAME, sub NAME BLOCK, substr EXPR,OFFSET,LEN, substr EXPR,OFFSET,
-symlink OLDFILE,NEWFILE, syscall LIST, sysopen FILEHANDLE,FILENAME,MODE,
-sysopen FILEHANDLE,FILENAME,MODE,PERMS, sysread
-FILEHANDLE,SCALAR,LENGTH,OFFSET, sysread FILEHANDLE,SCALAR,LENGTH, sysseek
-FILEHANDLE,POSITION,WHENCE, system LIST, syswrite
-FILEHANDLE,SCALAR,LENGTH,OFFSET, syswrite FILEHANDLE,SCALAR,LENGTH, tell
-FILEHANDLE, tell, telldir DIRHANDLE, tie VARIABLE,CLASSNAME,LIST, tied
-VARIABLE, time, times, tr///, truncate FILEHANDLE,LENGTH, truncate
-EXPR,LENGTH, uc EXPR, uc, ucfirst EXPR, ucfirst, umask EXPR, umask, undef
-EXPR, undef, unlink LIST, unlink, unpack TEMPLATE,EXPR, untie VARIABLE,
-unshift ARRAY,LIST, use Module LIST, use Module, use Module VERSION LIST,
-use VERSION, utime LIST, values HASH, vec EXPR,OFFSET,BITS, wait, waitpid
-PID,FLAGS, wantarray, warn LIST, write FILEHANDLE, write EXPR, write, y///
+sub NAME, sub NAME BLOCK, substr EXPR,OFFSET,LEN,REPLACEMENT, substr
+EXPR,OFFSET,LEN, substr EXPR,OFFSET, symlink OLDFILE,NEWFILE, syscall LIST,
+sysopen FILEHANDLE,FILENAME,MODE, sysopen FILEHANDLE,FILENAME,MODE,PERMS,
+sysread FILEHANDLE,SCALAR,LENGTH,OFFSET, sysread FILEHANDLE,SCALAR,LENGTH,
+sysseek FILEHANDLE,POSITION,WHENCE, system LIST, system PROGRAM LIST,
+syswrite FILEHANDLE,SCALAR,LENGTH,OFFSET, syswrite
+FILEHANDLE,SCALAR,LENGTH, tell FILEHANDLE, tell, telldir DIRHANDLE, tie
+VARIABLE,CLASSNAME,LIST, tied VARIABLE, time, times, tr///, truncate
+FILEHANDLE,LENGTH, truncate EXPR,LENGTH, uc EXPR, uc, ucfirst EXPR,
+ucfirst, umask EXPR, umask, undef EXPR, undef, unlink LIST, unlink, unpack
+TEMPLATE,EXPR, untie VARIABLE, unshift ARRAY,LIST, use Module LIST, use
+Module, use Module VERSION LIST, use VERSION, utime LIST, values HASH, vec
+EXPR,OFFSET,BITS, wait, waitpid PID,FLAGS, wantarray, warn LIST, write
+FILEHANDLE, write EXPR, write, y///
=back
@@ -1299,7 +1317,7 @@ PID,FLAGS, wantarray, warn LIST, write FILEHANDLE, write EXPR, write, y///
=item Predefined Names
-$ARG, $_, $E<lt>I<digit>E<gt>, $MATCH, $&, $PREMATCH, $`, $POSTMATCH, $',
+$ARG, $_, $E<lt>I<digits>E<gt>, $MATCH, $&, $PREMATCH, $`, $POSTMATCH, $',
$LAST_PAREN_MATCH, $+, $MULTILINE_MATCHING, $*, input_line_number HANDLE
EXPR, $INPUT_LINE_NUMBER, $NR, $, input_record_separator HANDLE EXPR,
$INPUT_RECORD_SEPARATOR, $RS, $/, autoflush HANDLE EXPR, $OUTPUT_AUTOFLUSH,
@@ -1316,9 +1334,12 @@ $CHILD_ERROR, $?, $OS_ERROR, $ERRNO, $!, $EXTENDED_OS_ERROR, $^E,
$EVAL_ERROR, $@, $PROCESS_ID, $PID, $$, $REAL_USER_ID, $UID, $<,
$EFFECTIVE_USER_ID, $EUID, $>, $REAL_GROUP_ID, $GID, $(,
$EFFECTIVE_GROUP_ID, $EGID, $), $PROGRAM_NAME, $0, $[, $PERL_VERSION, $],
-$DEBUGGING, $^D, $SYSTEM_FD_MAX, $^F, $^H, $INPLACE_EDIT, $^I, $OSNAME,
-$^O, $PERLDB, $^P, $BASETIME, $^T, $WARNING, $^W, $EXECUTABLE_NAME, $^X,
-$ARGV, @ARGV, @INC, %INC, $ENV{expr}, $SIG{expr}, $^M
+$DEBUGGING, $^D, $SYSTEM_FD_MAX, $^F, $^H, $INPLACE_EDIT, $^I, $^M,
+$OSNAME, $^O, $PERLDB, $^P, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20, $^R, $^S,
+$BASETIME, $^T, $WARNING, $^W, $EXECUTABLE_NAME, $^X, $ARGV, @ARGV, @INC,
+@_, %INC, %ENV $ENV{expr}, %SIG $SIG{expr}
+
+=item Error Indicators
=back
@@ -1330,12 +1351,20 @@ $ARGV, @ARGV, @INC, %INC, $ENV{expr}, $SIG{expr}, $^M
=over
-=item Private Variables via my()
+=item Private Variables via C<my()>
+
+=item Persistent Private Variables
=item Temporary Values via local()
=item Passing Symbol Table Entries (typeglobs)
+=item When to Still Use local()
+
+1. You need to give a global variable a temporary value, especially C<$_>,
+2. You need to create a local file or directory handle or a local function,
+3. You want to temporarily change just one element of an array or hash
+
=item Pass by Reference
=item Prototypes
@@ -1381,7 +1410,7 @@ $ARGV, @ARGV, @INC, %INC, $ENV{expr}, $SIG{expr}, $^M
=item Pragmatic Modules
use autouse MODULE => qw(sub1 sub2 sub3), blib, diagnostics, integer, less,
-lib, locale, ops, overload, sigtrap, strict, subs, vmsish, vars
+lib, locale, ops, overload, re, sigtrap, strict, subs, vmsish, vars
=item Standard Modules
@@ -1390,16 +1419,16 @@ CPAN::Nox, Carp, Class::Struct, Config, Cwd, DB_File, Devel::SelfStubber,
DirHandle, DynaLoader, English, Env, Exporter, ExtUtils::Embed,
ExtUtils::Install, ExtUtils::Liblist, ExtUtils::MM_OS2, ExtUtils::MM_Unix,
ExtUtils::MM_VMS, ExtUtils::MakeMaker, ExtUtils::Manifest,
-ExtUtils::Mkbootstrap, ExtUtils::Mksymlists, ExtUtils::testlib, Fcntl,
-File::Basename, File::CheckTree, File::Compare, File::Copy, File::Find,
-File::Path, File::stat, FileCache, FileHandle, FindBin, GDBM_File,
-Getopt::Long, Getopt::Std, I18N::Collate, IO, IO::File, IO::Handle,
-IO::Pipe, IO::Seekable, IO::Select, IO::Socket, IPC::Open2, IPC::Open3,
-Math::BigFloat, Math::BigInt, Math::Complex, Math::Trig, NDBM_File,
-Net::Ping, Net::hostent, Net::netent, Net::protoent, Net::servent, Opcode,
-Pod::Text, POSIX, SDBM_File, Safe, Search::Dict, SelectSaver, SelfLoader,
-Shell, Socket, Symbol, Sys::Hostname, Sys::Syslog, Term::Cap,
-Term::Complete, Term::ReadLine, Test::Harness, Text::Abbrev,
+ExtUtils::Mkbootstrap, ExtUtils::Mksymlists, ExtUtils::testlib, Fatal,
+Fcntl, File::Basename, File::CheckTree, File::Compare, File::Copy,
+File::Find, File::Path, File::stat, FileCache, FileHandle, FindBin,
+GDBM_File, Getopt::Long, Getopt::Std, I18N::Collate, IO, IO::File,
+IO::Handle, IO::Pipe, IO::Seekable, IO::Select, IO::Socket, IPC::Open2,
+IPC::Open3, Math::BigFloat, Math::BigInt, Math::Complex, Math::Trig,
+NDBM_File, Net::Ping, Net::hostent, Net::netent, Net::protoent,
+Net::servent, Opcode, Pod::Text, POSIX, SDBM_File, Safe, Search::Dict,
+SelectSaver, SelfLoader, Shell, Socket, Symbol, Sys::Hostname, Sys::Syslog,
+Term::Cap, Term::Complete, Term::ReadLine, Test::Harness, Text::Abbrev,
Text::ParseWords, Text::Soundex, Text::Tabs, Text::Wrap, Tie::Hash,
Tie::RefHash, Tie::Scalar, Tie::SubstrHash, Time::Local, Time::gmtime,
Time::localtime, Time::tm, UNIVERSAL, User::grent, User::pwent
@@ -1453,7 +1482,7 @@ to ::, Converts die(...) to croak(...), Several other minor changes
=item Guidelines for Reusing Application Code
Complete applications rarely belong in the Perl Module Library, Many
-applications contain some perl code which could be reused, Break-out the
+applications contain some Perl code that could be reused, Break-out the
reusable code into one or more separate module files, Take the opportunity
to reconsider and redesign the interfaces, In some cases the 'application'
can then be reduced to a small
@@ -1462,6 +1491,25 @@ can then be reduced to a small
=item NOTE
+=head2 perlmodinstall - Installing CPAN Modules
+
+=item DESCRIPTION
+
+=over
+
+=item PREAMBLE
+
+B<DECOMPRESS> the file, B<UNPACK> the file into a directory, B<BUILD> the
+module (sometimes unnecessary), B<INSTALL> the module
+
+=back
+
+=item HEY
+
+=item AUTHOR
+
+=item COPYRIGHT
+
=head2 perlform - Perl formats
=item DESCRIPTION
@@ -1499,6 +1547,18 @@ localization)
=item The setlocale function
+=item Finding locales
+
+=item LOCALE PROBLEMS
+
+=item Temporarily fixing locale problems
+
+=item Permanently fixing locale problems
+
+=item Permanently fixing your locale configuration
+
+=item Permanently fixing system locale configuration
+
=item The localeconv function
=back
@@ -1524,7 +1584,7 @@ localization)
=item SECURITY
B<Comparison operators> (C<lt>, C<le>, C<ge>, C<gt> and C<cmp>):,
-B<Case-mapping interpolation> (with C<\l>, C<\L>, C<\u> or <\U>),
+B<Case-mapping interpolation> (with C<\l>, C<\L>, C<\u> or C<\U>),
B<Matching operator> (C<m//>):, B<Substitution operator> (C<s///>):,
B<In-memory formatting function> (sprintf()):, B<Output formatting
functions> (printf() and write()):, B<Case-mapping functions> (lc(),
@@ -1577,10 +1637,18 @@ LC_TIME, LANG
=over
+=item Making References
+
+=item Using References
+
=item Symbolic references
=item Not-so-symbolic references
+=item Pseudo-hashes: Using an array as a hash
+
+=item Function Templates
+
=back
=item WARNING
@@ -1774,6 +1842,8 @@ more elaborate constructs
=item SEE ALSO
+=item AUTHOR AND COPYRIGHT
+
=item COPYRIGHT
=over
@@ -1837,8 +1907,8 @@ this, NEXTKEY this, lastkey, DESTROY this
=item Tying FileHandles
-TIEHANDLE classname, LIST, PRINT this, LIST, PRINTF this, LIST, READ this
-LIST, READLINE this, GETC this, DESTROY this
+TIEHANDLE classname, LIST, WRITE this, LIST, PRINT this, LIST, PRINTF this,
+LIST, READ this, LIST, READLINE this, GETC this, CLOSE this, DESTROY this
=item The C<untie> Gotcha
@@ -1885,6 +1955,12 @@ safe subprocesses, sockets, and semaphores)
=item Named Pipes
+=over
+
+=item WARNING
+
+=back
+
=item Using open() for IPC
=over
@@ -1899,12 +1975,16 @@ safe subprocesses, sockets, and semaphores)
=item Bidirectional Communication with Another Process
+=item Bidirectional Communication with Yourself
+
=back
=item Sockets: Client/Server Communication
=over
+=item Internet Line Terminators
+
=item Internet TCP Clients and Servers
=item Unix-Domain TCP Clients and Servers
@@ -1956,16 +2036,16 @@ h [command], p expr, x expr, V [pkg [vars]], X [vars], T, s [expr], n
subname, -, w [line], f filename, /pattern/, ?pattern?, L, S [[!]pattern],
t, t expr, b [line] [condition], b subname [condition], b postpone subname
[condition], b load filename, b compile subname, d [line], D, a [line]
-command, A, O [opt[=val]] [opt"val"] [opt?].., C<recallCommand>,
-C<ShellBang>, C<pager>, C<tkRunning>, C<signalLevel>, C<warnLevel>,
-C<dieLevel>, C<AutoTrace>, C<LineInfo>, C<inhibit_exit>, C<PrintRet>,
-C<ornaments>, C<frame>, C<maxTraceLen>, C<arrayDepth>, C<hashDepth>,
-C<compactDump>, C<veryCompact>, C<globPrint>, C<DumpDBFiles>,
-C<DumpPackages>, C<quote>, C<HighBit>, C<undefPrint>, C<UsageOnly>, C<TTY>,
-C<noTTY>, C<ReadLine>, C<NonStop>, E<lt> [ command ], E<lt>E<lt> command,
-E<gt> command, E<gt>E<gt> command, { [ command ], {{ command, ! number, !
--number, ! pattern, !! cmd, H -number, q or ^D, R, |dbcmd, ||dbcmd, =
-[alias value], command, m expr, m package
+command, A, W [expr], W, O [opt[=val]] [opt"val"] [opt?]..,
+C<recallCommand>, C<ShellBang>, C<pager>, C<tkRunning>, C<signalLevel>,
+C<warnLevel>, C<dieLevel>, C<AutoTrace>, C<LineInfo>, C<inhibit_exit>,
+C<PrintRet>, C<ornaments>, C<frame>, C<maxTraceLen>, C<arrayDepth>,
+C<hashDepth>, C<compactDump>, C<veryCompact>, C<globPrint>, C<DumpDBFiles>,
+C<DumpPackages>, C<DumpReused>, C<quote>, C<HighBit>, C<undefPrint>,
+C<UsageOnly>, C<TTY>, C<noTTY>, C<ReadLine>, C<NonStop>, E<lt> [ command ],
+E<lt>E<lt> command, E<gt> command, E<gt>E<gt> command, { [ command ], {{
+command, ! number, ! -number, ! pattern, !! cmd, H -number, q or ^D, R,
+|dbcmd, ||dbcmd, command, m expr, m package
=item Debugger input/output
@@ -1987,9 +2067,48 @@ Prompt, Multiline commands, Stack backtrace, Listing, Frame listing
=item Other resources
+=item BUGS
+
=back
-=item BUGS
+=item Debugging Perl memory usage
+
+=over
+
+=item Using C<$ENV{PERL_DEBUG_MSTATS}>
+
+C<buckets SMALLEST(APPROX)..GREATEST(APPROX)>, Free/Used, C<Total sbrk():
+SBRKed/SBRKs:CONTINUOUS>, C<pad: 0>, C<heads: 2192>, C<chain: 0>, C<tail:
+6144>
+
+=item Example of using B<-DL> switch
+
+C<717>, C<002>, C<054>, C<602>, C<702>, C<704>
+
+=item B<-DL> details
+
+C<!!!>, C<!!>, C<!>
+
+=item Limitations of B<-DL> statistic
+
+=back
+
+=item Debugging regular expressions
+
+=over
+
+=item Compile-time output
+
+C<anchored> I<STRING> C<at> I<POS>, C<floating> I<STRING> C<at>
+I<POS1..POS2>, C<matching floating/anchored>, C<minlen>, C<stclass>
+I<TYPE>, C<noscan>, C<isall>, C<GPOS>, C<plus>, C<implicit>, C<with eval>,
+C<anchored(TYPE)>
+
+=item Types of nodes
+
+=item Run-time output
+
+=back
=head2 perldiag - various Perl diagnostics
@@ -2013,6 +2132,8 @@ Prompt, Multiline commands, Stack backtrace, Listing, Frame listing
=back
+=item SEE ALSO
+
=head2 perltrap - Perl traps for the unwary
=item DESCRIPTION
@@ -2044,7 +2165,7 @@ Discontinuance, Discontinuance, Deprecation, Discontinuance
=item Parsing Traps
-Parsing, Parsing, Parsing
+Parsing, Parsing, Parsing, Parsing
=item Numerical Traps
@@ -2052,8 +2173,8 @@ Numerical, Numerical, Numerical
=item General data type traps
-(Arrays), (Arrays), (Hashes), (Globs), (Scalar String), (Constants),
-(Scalars), (Variable Suicide)
+(Arrays), (Arrays), (Hashes), (Globs), (Globs), (Scalar String),
+(Constants), (Scalars), (Variable Suicide)
=item Context Traps - scalar, list contexts
@@ -2068,7 +2189,7 @@ Precedence
Regular Expression, Regular Expression, Regular Expression, Regular
Expression, Regular Expression, Regular Expression, Regular Expression,
-Regular Expression, Regular Expression
+Regular Expression
=item Subroutine, Signal, Sorting Traps
@@ -2089,10 +2210,121 @@ DBM, DBM
=item Unclassified Traps
-Unclassified
+C<require>/C<do> trap using returned value, C<split> on empty string with
+LIMIT specified
+
+=back
+
+=head2 perlport - Writing portable Perl
+
+=item DESCRIPTION
+
+Not all Perl programs have to be portable, The vast majority of Perl B<is>
+portable
+
+=item ISSUES
+
+=over
+
+=item Newlines
+
+=item File Paths
+
+=item System Interaction
+
+=item Interprocess Communication (IPC)
+
+=item External Subroutines (XS)
+
+=item Standard Modules
+
+=item Time and Date
+
+=item System Resources
+
+=item Security
+
+=item Style
+
+=back
+
+=item CPAN TESTERS
+
+Mailing list: cpan-testers@perl.org, Testing results:
+C<http://www.connect.net/gbarr/cpan-test/>
+
+=item PLATFORMS
+
+=over
+
+=item Unix
+
+=item DOS and Derivatives
+
+The djgpp environment for DOS, C<http://www.delorie.com/djgpp/>, The EMX
+environment for DOS, OS/2, etc.
+C<emx@iaehv.nl>,C<http://www.leo.org/pub/comp/os/os2/leo/gnu/emx+gcc/index.html>,
+C<ftp://hobbes.nmsu.edu/pub/os2/dev/emx>. Build instructions
+for Win32, L<perlwin32>, The ActiveState Pages,
+C<http://www.activestate.com/>
+
+=item MacPerl
+
+The MacPerl Pages, C<http://www.ptf.com/macperl/>, The MacPerl mailing
+list, C<mac-perl-request@iis.ee.ethz.ch>
+
+=item VMS
+
+L<perlvms.pod>, vmsperl list, C<vmsperl-request@newman.upenn.edu>, vmsperl
+on the web, C<http://www.sidhe.org/vmsperl/index.html>
+
+=item EBCDIC Platforms
+
+perl-mvs list, AS/400 Perl information at C<http://as400.rochester.ibm.com>
+
+=item Other perls
+
+Atari, Guido Flohr's page C<http://stud.uni-sb.de/~gufl0000/>, HP 300
+MPE/iX C<http://www.cccd.edu/~markb/perlix.html>, Novell Netware
=back
+=item FUNCTION IMPLEMENTATIONS
+
+=over
+
+=item Alphabetical Listing of Perl Functions
+
+-I<X> FILEHANDLE, -I<X> EXPR, -I<X>, binmode FILEHANDLE, chmod LIST, chown
+LIST, chroot FILENAME, chroot, crypt PLAINTEXT,SALT, dbmclose HASH, dbmopen
+HASH,DBNAME,MODE, dump LABEL, exec LIST, fcntl FILEHANDLE,FUNCTION,SCALAR,
+flock FILEHANDLE,OPERATION, fork, getlogin, getpgrp PID, getppid,
+getpriority WHICH,WHO, getpwnam NAME, getgrnam NAME, getnetbyname NAME,
+getpwuid UID, getgrgid GID, getnetbyaddr ADDR,ADDRTYPE, getprotobynumber
+NUMBER, getservbyport PORT,PROTO, getpwent, getgrent, gethostent,
+getnetent, getprotoent, getservent, setpwent, setgrent, sethostent
+STAYOPEN, setnetent STAYOPEN, setprotoent STAYOPEN, setservent STAYOPEN,
+endpwent, endgrent, endhostent, endnetent, endprotoent, endservent,
+getsockopt SOCKET,LEVEL,OPTNAME, glob EXPR, glob, ioctl
+FILEHANDLE,FUNCTION,SCALAR, kill LIST, link OLDFILE,NEWFILE, lstat
+FILEHANDLE, lstat EXPR, lstat, msgctl ID,CMD,ARG, msgget KEY,FLAGS, msgsnd
+ID,MSG,FLAGS, msgrcv ID,VAR,SIZE,TYPE,FLAGS, open FILEHANDLE,EXPR, open
+FILEHANDLE, pipe READHANDLE,WRITEHANDLE, readlink EXPR, readlink, select
+RBITS,WBITS,EBITS,TIMEOUT, semctl ID,SEMNUM,CMD,ARG, semget
+KEY,NSEMS,FLAGS, semop KEY,OPSTRING, setpgrp PID,PGRP, setpriority
+WHICH,WHO,PRIORITY, setsockopt SOCKET,LEVEL,OPTNAME,OPTVAL, shmctl
+ID,CMD,ARG, shmget KEY,SIZE,FLAGS, shmread ID,VAR,POS,SIZE, shmwrite
+ID,STRING,POS,SIZE, socketpair SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL, stat
+FILEHANDLE, stat EXPR, stat, symlink OLDFILE,NEWFILE, syscall LIST, system
+LIST, times, truncate FILEHANDLE,LENGTH, truncate EXPR,LENGTH, umask EXPR,
+umask, utime LIST, wait, waitpid PID,FLAGS
+
+=back
+
+=item AUTHORS / CONTRIBUTORS
+
+=item VERSION
+
=head2 perlstyle - Perl style guide
=item DESCRIPTION
@@ -2101,10 +2333,22 @@ Unclassified
=item DESCRIPTION
+=over
+
+=item Verbatim Paragraph
+
+=item Command Paragraph
+
+=item Ordinary Block of Text
+
+=item The Intent
+
=item Embedding Pods in Perl Modules
=item Common Pod Pitfalls
+=back
+
=item SEE ALSO
=item AUTHOR
@@ -2165,8 +2409,8 @@ B<PerlIO *>, B<PerlIO_stdin()>, B<PerlIO_stdout()>, B<PerlIO_stderr()>,
B<PerlIO_open(path, mode)>, B<PerlIO_fdopen(fd,mode)>,
B<PerlIO_printf(f,fmt,...)>, B<PerlIO_vprintf(f,fmt,a)>,
B<PerlIO_stdoutf(fmt,...)>, B<PerlIO_read(f,buf,count)>,
-B<PerlIO_write(f,buf,count)>, B<PerlIO_close(f)>, B<PerlIO_puts(s,f)>,
-B<PerlIO_putc(c,f)>, B<PerlIO_ungetc(c,f)>, B<PerlIO_getc(f)>,
+B<PerlIO_write(f,buf,count)>, B<PerlIO_close(f)>, B<PerlIO_puts(f,s)>,
+B<PerlIO_putc(f,c)>, B<PerlIO_ungetc(f,c)>, B<PerlIO_getc(f)>,
B<PerlIO_eof(f)>, B<PerlIO_error(f)>, B<PerlIO_fileno(f)>,
B<PerlIO_clearerr(f)>, B<PerlIO_flush(f)>, B<PerlIO_tell(f)>,
B<PerlIO_seek(f,o,w)>, B<PerlIO_getpos(f,p)>, B<PerlIO_setpos(f,p)>,
@@ -2227,6 +2471,8 @@ B<PerlIO_get_base(f)>, B<PerlIO_get_bufsiz(f)>
=item Variable-length Parameter Lists
+=item The C_ARGS: Keyword
+
=item The PPCODE: Keyword
=item Returning Undef And Empty Lists
@@ -2245,6 +2491,10 @@ B<PerlIO_get_base(f)>, B<PerlIO_get_bufsiz(f)>
=item The ALIAS: Keyword
+=item The INTERFACE: Keyword
+
+=item The INTERFACE_MACRO: Keyword
+
=item The INCLUDE: Keyword
=item The CASE: Keyword
@@ -2365,6 +2615,17 @@ B<PerlIO_get_base(f)>, B<PerlIO_get_bufsiz(f)>
=item Understanding the Magic of Tied Hashes and Arrays
+=item Localizing changes
+
+C<SAVEINT(int i)>, C<SAVEIV(IV i)>, C<SAVEI32(I32 i)>, C<SAVELONG(long i)>,
+C<SAVESPTR(s)>, C<SAVEPPTR(p)>, C<SAVEFREESV(SV *sv)>, C<SAVEFREEOP(OP
+*op)>, C<SAVEFREEPV(p)>, C<SAVECLEARSV(SV *sv)>, C<SAVEDELETE(HV *hv, char
+*key, I32 length)>, C<SAVEDESTRUCTOR(f,p)>, C<SAVESTACK_POS()>, C<SV*
+save_scalar(GV *gv)>, C<AV* save_ary(GV *gv)>, C<HV* save_hash(GV *gv)>,
+C<void save_item(SV *item)>, C<void save_list(SV **sarg, I32 maxsarg)>,
+C<SV* save_svref(SV **sptr)>, C<void save_aptr(AV **aptr)>, C<void
+save_hptr(HV **hptr)>
+
=back
=item Subroutines
@@ -2407,48 +2668,55 @@ B<PerlIO_get_base(f)>, B<PerlIO_get_bufsiz(f)>
=item API LISTING
-AvFILL, av_clear, av_extend, av_fetch, av_len, av_make, av_pop, av_push,
+av_clear, av_extend, av_fetch, AvFILL, av_len, av_make, av_pop, av_push,
av_shift, av_store, av_undef, av_unshift, CLASS, Copy, croak, CvSTASH,
-DBsingle, DBsub, DBtrace, dMARK, dORIGMARK, dowarn, dSP, dXSARGS, dXSI32,
-dXSI32, ENTER, EXTEND, FREETMPS, G_ARRAY, G_DISCARD, G_EVAL, GIMME,
-GIMME_V, G_NOARGS, G_SCALAR, G_VOID, gv_fetchmeth, gv_fetchmethod,
-gv_fetchmethod_autoload, gv_stashpv, gv_stashsv, GvSV, HEf_SVKEY, HeHASH,
-HeKEY, HeKLEN, HePV, HeSVKEY, HeSVKEY_force, HeSVKEY_set, HeVAL, hv_clear,
-hv_delayfree_ent, hv_delete, hv_delete_ent, hv_exists, hv_exists_ent,
-hv_fetch, hv_fetch_ent, hv_free_ent, hv_iterinit, hv_iterkey, hv_iterkeysv,
-hv_iternext, hv_iternextsv, hv_iterval, hv_magic, HvNAME, hv_store,
-hv_store_ent, hv_undef, isALNUM, isALPHA, isDIGIT, isLOWER, isSPACE,
-isUPPER, items, ix, LEAVE, MARK, mg_clear, mg_copy, mg_find, mg_free,
-mg_get, mg_len, mg_magical, mg_set, Move, na, New, Newc, Newz, newAV,
-newHV, newRV_inc, newRV_noinc, newSV, newSViv, newSVnv, newSVpv, newSVrv,
-newSVsv, newXS, newXSproto, Nullav, Nullch, Nullcv, Nullhv, Nullsv,
-ORIGMARK, perl_alloc, perl_call_argv, perl_call_method, perl_call_pv,
-perl_call_sv, perl_construct, perl_destruct, perl_eval_sv, perl_eval_pv,
-perl_free, perl_get_av, perl_get_cv, perl_get_hv, perl_get_sv, perl_parse,
+PL_DBsingle, PL_DBsub, PL_DBtrace, dMARK, dORIGMARK, PL_dowarn, dSP,
+dXSARGS, dXSI32, do_binmode, ENTER, EXTEND, fbm_compile, fbm_instr,
+FREETMPS, G_ARRAY, G_DISCARD, G_EVAL, GIMME, GIMME_V, G_NOARGS, G_SCALAR,
+gv_fetchmeth, gv_fetchmethod, gv_fetchmethod_autoload, G_VOID, gv_stashpv,
+gv_stashsv, GvSV, HEf_SVKEY, HeHASH, HeKEY, HeKLEN, HePV, HeSVKEY,
+HeSVKEY_force, HeSVKEY_set, HeVAL, hv_clear, hv_delayfree_ent, hv_delete,
+hv_delete_ent, hv_exists, hv_exists_ent, hv_fetch, hv_fetch_ent,
+hv_free_ent, hv_iterinit, hv_iterkey, hv_iterkeysv, hv_iternext,
+hv_iternextsv, hv_iterval, hv_magic, HvNAME, hv_store, hv_store_ent,
+hv_undef, isALNUM, isALPHA, isDIGIT, isLOWER, isSPACE, isUPPER, items, ix,
+LEAVE, looks_like_number, MARK, mg_clear, mg_copy, mg_find, mg_free,
+mg_get, mg_len, mg_magical, mg_set, Move, PL_na, New, newAV, Newc,
+newCONSTSUB, newHV, newRV_inc, newRV_noinc, NEWSV, newSViv, newSVnv,
+newSVpv, newSVpvf, newSVpvn, newSVrv, newSVsv, newXS, newXSproto, Newz,
+Nullav, Nullch, Nullcv, Nullhv, Nullsv, ORIGMARK, perl_alloc,
+perl_call_argv, perl_call_method, perl_call_pv, perl_call_sv,
+perl_construct, perl_destruct, perl_eval_sv, perl_eval_pv, perl_free,
+perl_get_av, perl_get_cv, perl_get_hv, perl_get_sv, perl_parse,
perl_require_pv, perl_run, POPi, POPl, POPp, POPn, POPs, PUSHMARK, PUSHi,
-PUSHn, PUSHp, PUSHs, PUTBACK, Renew, Renewc, RETVAL, safefree, safemalloc,
-saferealloc, savepv, savepvn, SAVETMPS, SP, SPAGAIN, ST, strEQ, strGE,
-strGT, strLE, strLT, strNE, strnEQ, strnNE, sv_2mortal, sv_bless, sv_catpv,
-sv_catpvn, sv_catpvf, sv_catsv, sv_cmp, sv_cmp, SvCUR, SvCUR_set, sv_dec,
-sv_dec, SvEND, sv_eq, SvGROW, sv_grow, sv_inc, SvIOK, SvIOK_off, SvIOK_on,
-SvIOK_only, SvIOK_only, SvIOKp, sv_isa, SvIV, sv_isobject, SvIVX, SvLEN,
-sv_len, sv_len, sv_magic, sv_mortalcopy, SvOK, sv_newmortal, sv_no, SvNIOK,
-SvNIOK_off, SvNIOKp, SvNOK, SvNOK_off, SvNOK_on, SvNOK_only, SvNOK_only,
-SvNOKp, SvNV, SvNVX, SvPOK, SvPOK_off, SvPOK_on, SvPOK_only, SvPOK_only,
-SvPOKp, SvPV, SvPVX, SvREFCNT, SvREFCNT_dec, SvREFCNT_inc, SvROK,
-SvROK_off, SvROK_on, SvRV, sv_setiv, sv_setnv, sv_setpv, sv_setpvn,
-sv_setpvf, sv_setref_iv, sv_setref_nv, sv_setref_pv, sv_setref_pvn,
-sv_setsv, SvSTASH, SVt_IV, SVt_PV, SVt_PVAV, SVt_PVCV, SVt_PVHV, SVt_PVMG,
-SVt_NV, SvTRUE, SvTYPE, svtype, SvUPGRADE, sv_upgrade, sv_undef, sv_unref,
-sv_usepvn, sv_yes, THIS, toLOWER, toUPPER, warn, XPUSHi, XPUSHn, XPUSHp,
-XPUSHs, XS, XSRETURN, XSRETURN_EMPTY, XSRETURN_IV, XSRETURN_NO,
+PUSHn, PUSHp, PUSHs, PUSHu, PUTBACK, Renew, Renewc, RETVAL, safefree,
+safemalloc, saferealloc, savepv, savepvn, SAVETMPS, SP, SPAGAIN, ST, strEQ,
+strGE, strGT, strLE, strLT, strNE, strnEQ, strnNE, sv_2mortal, sv_bless,
+sv_catpv, sv_catpv_mg, sv_catpvn, sv_catpvn_mg, sv_catpvf, sv_catpvf_mg,
+sv_catsv, sv_catsv_mg, sv_chop, sv_cmp, SvCUR, SvCUR_set, sv_dec,
+sv_derived_from, sv_derived_from, SvEND, sv_eq, SvGETMAGIC, SvGROW,
+sv_grow, sv_inc, sv_insert, SvIOK, SvIOK_off, SvIOK_on, SvIOK_only, SvIOKp,
+sv_isa, sv_isobject, SvIV, SvIVX, SvLEN, sv_len, sv_magic, sv_mortalcopy,
+sv_newmortal, SvNIOK, SvNIOK_off, SvNIOKp, PL_sv_no, SvNOK, SvNOK_off,
+SvNOK_on, SvNOK_only, SvNOKp, SvNV, SvNVX, SvOK, SvOOK, SvPOK, SvPOK_off,
+SvPOK_on, SvPOK_only, SvPOKp, SvPV, SvPV_force, SvPVX, SvREFCNT,
+SvREFCNT_dec, SvREFCNT_inc, SvROK, SvROK_off, SvROK_on, SvRV, SvSETMAGIC,
+sv_setiv, sv_setiv_mg, sv_setnv, sv_setnv_mg, sv_setpv, sv_setpv_mg,
+sv_setpviv, sv_setpviv_mg, sv_setpvn, sv_setpvn_mg, sv_setpvf,
+sv_setpvf_mg, sv_setref_iv, sv_setref_nv, sv_setref_pv, sv_setref_pvn,
+SvSetSV, SvSetSV_nosteal, sv_setsv, sv_setsv_mg, sv_setuv, sv_setuv_mg,
+SvSTASH, SvTAINT, SvTAINTED, SvTAINTED_off, SvTAINTED_on, SVt_IV, SVt_PV,
+SVt_PVAV, SVt_PVCV, SVt_PVHV, SVt_PVMG, SVt_NV, SvTRUE, SvTYPE, svtype,
+PL_sv_undef, sv_unref, SvUPGRADE, sv_upgrade, sv_usepvn, sv_usepvn_mg,
+sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale),
+sv_vsetpvfn(sv, pat, patlen, args, svargs, svmax, used_locale), SvUV,
+SvUVX, PL_sv_yes, THIS, toLOWER, toUPPER, warn, XPUSHi, XPUSHn, XPUSHp,
+XPUSHs, XPUSHu, XS, XSRETURN, XSRETURN_EMPTY, XSRETURN_IV, XSRETURN_NO,
XSRETURN_NV, XSRETURN_PV, XSRETURN_UNDEF, XSRETURN_YES, XST_mIV, XST_mNV,
XST_mNO, XST_mPV, XST_mUNDEF, XST_mYES, XS_VERSION, XS_VERSION_BOOTCHECK,
Zero
-=item EDITOR
-
-=item DATE
+=item AUTHORS
=head2 perlcall - Perl calling conventions from C
@@ -2532,8 +2800,48 @@ callback
=item DATE
+=head2 perlhist - the Perl history records
+
+=item DESCRIPTION
+
+=item INTRODUCTION
+
+=item THE KEEPERS OF THE PUMPKIN
+
+=over
+
+=item PUMPKIN?
+
+=back
+
+=item THE RECORDS
+
+=over
+
+=item SELECTED RELEASE SIZES
+
+=item SELECTED PATCH SIZES
+
+=back
+
+=item THE KEEPERS OF THE RECORDS
+
=head1 PRAGMA DOCUMENTATION
+=head2 attrs - set/get attributes of a subroutine
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+method, locked
+
+=head2 re - Perl pragma to alter regular expression behaviour
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
=head2 autouse - postpone load of modules until a function is used
=item SYNOPSIS
@@ -2542,12 +2850,18 @@ callback
=item WARNING
-=item BUGS
-
=item AUTHOR
=item SEE ALSO
+=head2 base - Establish IS-A relationship with base class at compile time
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item SEE ALSO
+
=head2 blib - Use MakeMaker's uninstalled version of a package
=item SYNOPSIS
@@ -2597,6 +2911,14 @@ diagnostics
=item AUTHOR
+=head2 fields - compile-time class fields
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item SEE ALSO
+
=head2 integer - Perl pragma to compute arithmetic in integer instead of
double
@@ -2637,14 +2959,6 @@ operations
=item DESCRIPTION
-=head2 ops - Perl pragma to restrict unsafe operations when compiling
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-=item SEE ALSO
-
=head2 overload - Package for overloading perl operations
=item SYNOPSIS
@@ -2706,6 +3020,10 @@ I<Concatenation>, I<Comparison operations>, I<Copy operator>
overload::StrVal(arg), overload::Overloaded(arg), overload::Method(obj,op)
+=item Overloading constants
+
+integer, float, binary, q, qr
+
=item IMPLEMENTATION
=item AUTHOR
@@ -2808,10 +3126,336 @@ C<strict refs>, C<strict vars>, C<strict subs>
=item DESCRIPTION
-=item CAVEATS
+$keep, $check, $modtime
+
+=over
+
+=item Multiple packages
+
+=back
=item DIAGNOSTICS
+=head2 B - The Perl Compiler
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item OVERVIEW OF CLASSES
+
+=over
+
+=item SV-RELATED CLASSES
+
+=item B::SV METHODS
+
+REFCNT, FLAGS
+
+=item B::IV METHODS
+
+IV, IVX, needs64bits, packiv
+
+=item B::NV METHODS
+
+NV, NVX
+
+=item B::RV METHODS
+
+RV
+
+=item B::PV METHODS
+
+PV
+
+=item B::PVMG METHODS
+
+MAGIC, SvSTASH
+
+=item B::MAGIC METHODS
+
+MOREMAGIC, PRIVATE, TYPE, FLAGS, OBJ, PTR
+
+=item B::PVLV METHODS
+
+TARGOFF, TARGLEN, TYPE, TARG
+
+=item B::BM METHODS
+
+USEFUL, PREVIOUS, RARE, TABLE
+
+=item B::GV METHODS
+
+NAME, STASH, SV, IO, FORM, AV, HV, EGV, CV, CVGEN, LINE, FILEGV, GvREFCNT,
+FLAGS
+
+=item B::IO METHODS
+
+LINES, PAGE, PAGE_LEN, LINES_LEFT, TOP_NAME, TOP_GV, FMT_NAME, FMT_GV,
+BOTTOM_NAME, BOTTOM_GV, SUBPROCESS, IoTYPE, IoFLAGS
+
+=item B::AV METHODS
+
+FILL, MAX, OFF, ARRAY, AvFLAGS
+
+=item B::CV METHODS
+
+STASH, START, ROOT, GV, FILEGV, DEPTH, PADLIST, OUTSIDE, XSUB, XSUBANY
+
+=item B::HV METHODS
+
+FILL, MAX, KEYS, RITER, NAME, PMROOT, ARRAY
+
+=item OP-RELATED CLASSES
+
+=item B::OP METHODS
+
+next, sibling, ppaddr, desc, targ, type, seq, flags, private
+
+=item B::UNOP METHOD
+
+first
+
+=item B::BINOP METHOD
+
+last
+
+=item B::LOGOP METHOD
+
+other
+
+=item B::CONDOP METHODS
+
+true, false
+
+=item B::LISTOP METHOD
+
+children
+
+=item B::PMOP METHODS
+
+pmreplroot, pmreplstart, pmnext, pmregexp, pmflags, pmpermflags, precomp
+
+=item B::SVOP METHOD
+
+sv
+
+=item B::GVOP METHOD
+
+gv
+
+=item B::PVOP METHOD
+
+pv
+
+=item B::LOOP METHODS
+
+redoop, nextop, lastop
+
+=item B::COP METHODS
+
+label, stash, filegv, cop_seq, arybase, line
+
+=back
+
+=item FUNCTIONS EXPORTED BY C<B>
+
+main_cv, main_root, main_start, comppadlist, sv_undef, sv_yes, sv_no,
+walkoptree(OP, METHOD), walkoptree_debug(DEBUG), walksymtable(SYMREF,
+METHOD, RECURSE), svref_2object(SV), ppname(OPNUM), hash(STR), cast_I32(I),
+minus_c, cstring(STR), class(OBJ), threadsv_names, byteload_fh(FILEHANDLE)
+
+=item AUTHOR
+
+=head2 B::Asmdata - Autogenerated data about Perl ops, used to generate
+bytecode
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item AUTHOR
+
+=head2 B::Assembler - Assemble Perl bytecode
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item AUTHOR
+
+=head2 B::Bblock - Walk basic blocks
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item AUTHOR
+
+=head2 B::Bytecode - Perl compiler's bytecode backend
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item OPTIONS
+
+B<-ofilename>, B<-->, B<-f>, B<-fcompress-nullops>,
+B<-fomit-sequence-numbers>, B<-fbypass-nullops>, B<-fstrip-syntax-tree>,
+B<-On>, B<-D>, B<-Do>, B<-Db>, B<-Da>, B<-DC>, B<-S>, B<-m>
+
+=item BUGS
+
+=item AUTHOR
+
+=head2 B::C - Perl compiler's C backend
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item OPTIONS
+
+B<-ofilename>, B<-v>, B<-->, B<-uPackname>, B<-D>, B<-Do>, B<-Dc>, B<-DA>,
+B<-DC>, B<-DM>, B<-f>, B<-fcog>, B<-fno-cog>, B<-On>
+
+=item EXAMPLES
+
+=item BUGS
+
+=item AUTHOR
+
+=head2 B::CC - Perl compiler's optimized C translation backend
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item OPTIONS
+
+B<-ofilename>, B<-v>, B<-->, B<-uPackname>, B<-mModulename>, B<-D>, B<-Dr>,
+B<-DO>, B<-Ds>, B<-Dp>, B<-Dq>, B<-Dl>, B<-Dt>, B<-f>,
+B<-ffreetmps-each-bblock>, B<-ffreetmps-each-loop>, B<-fomit-taint>, B<-On>
+
+=item EXAMPLES
+
+=item BUGS
+
+=item DIFFERENCES
+
+=over
+
+=item Loops
+
+=item Context of ".."
+
+=item Arithmetic
+
+=item Deprecated features
+
+=back
+
+=item AUTHOR
+
+=head2 B::Debug - Walk Perl syntax tree, printing debug info about ops
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item AUTHOR
+
+=head2 B::Deparse - Perl compiler backend to produce perl code
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item OPTIONS
+
+B<-p>, B<-u>I<PACKAGE>, B<-l>, B<-s>I<LETTERS>, B<C>
+
+=item BUGS
+
+=item AUTHOR
+
+=head2 B::Disassembler - Disassemble Perl bytecode
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item AUTHOR
+
+=head2 B::Lint - Perl lint
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item OPTIONS AND LINT CHECKS
+
+B<context>, B<implicit-read> and B<implicit-write>, B<dollar-underscore>,
+B<private-names>, B<undefined-subs>, B<regexp-variables>, B<all>, B<none>
+
+=item NON LINT-CHECK OPTIONS
+
+B<-u Package>
+
+=item BUGS
+
+=item AUTHOR
+
+=head2 B::O, O - Generic interface to Perl Compiler backends
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item CONVENTIONS
+
+=item IMPLEMENTATION
+
+=item AUTHOR
+
+=head2 B::Showlex - Show lexical variables used in functions or files
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item AUTHOR
+
+=head2 B::Stackobj - Helper module for CC backend
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item AUTHOR
+
+=head2 B::Terse - Walk Perl syntax tree, printing terse info about ops
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item AUTHOR
+
+=head2 B::Xref - Generates cross reference reports for Perl programs
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item OPTIONS
+
+C<-oFILENAME>, C<-r>, C<-D[tO]>
+
+=item BUGS
+
+=item AUTHOR
+
=head2 Benchmark - benchmark running times of code
=item SYNOPSIS
@@ -2828,7 +3472,7 @@ new, debug
timeit(COUNT, CODE), timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] ),
timethese ( COUNT, CODEHASHREF, [ STYLE ] ), timediff ( T1, T2 ), timestr (
-TIMEDIFF, [ STYLE, [ FORMAT ]] )
+TIMEDIFF, [ STYLE, [ FORMAT ] ] )
=item Optional Exports
@@ -2846,29 +3490,25 @@ clearcache ( COUNT ), clearallcache ( ), disablecache ( ), enablecache ( )
=item MODIFICATION HISTORY
-=head2 Bundle::CPAN - A bundle to play with all the other modules on CPAN
-
-=item SYNOPSIS
-
-=item CONTENTS
-
-=item DESCRIPTION
-
-=item AUTHOR
-
=head2 CGI - Simple Common Gateway Interface Class
=item SYNOPSIS
=item ABSTRACT
-=item INSTALLATION
-
=item DESCRIPTION
=over
-=item CREATING A NEW QUERY OBJECT:
+=item PROGRAMMING STYLE
+
+=item CALLING CGI.PM ROUTINES
+
+1. Use another name for the argument, if one is available. Forexample,
+-value is an alias for -values, 2. Change the capitalization, e.g. -Values,
+3. Put quotes around the argument name, e.g. '-values'
+
+=item CREATING A NEW QUERY OBJECT (OBJECT-ORIENTED STYLE):
=item CREATING A NEW QUERY OBJECT FROM AN INPUT FILE
@@ -2888,27 +3528,59 @@ clearcache ( COUNT ), clearallcache ( ), disablecache ( ), enablecache ( )
=item DELETING ALL PARAMETERS:
-=item SAVING THE STATE OF THE FORM TO A FILE:
+=item DIRECT ACCESS TO THE PARAMETER LIST:
-=item CREATING A SELF-REFERENCING URL THAT PRESERVES STATE INFORMATION:
+=item SAVING THE STATE OF THE SCRIPT TO A FILE:
-=item COMPATIBILITY WITH CGI-LIB.PL
+=item USING THE FUNCTION-ORIENTED INTERFACE
-=item CALLING CGI FUNCTIONS THAT TAKE MULTIPLE ARGUMENTS
+B<:cgi>, B<:form>, B<:html2>, B<:html3>, B<:netscape>, B<:html>,
+B<:standard>, B<:all>
-=item CREATING THE HTTP HEADER:
+=item PRAGMAS
-=item GENERATING A REDIRECTION INSTRUCTION
+-any, -compile, -nph, -autoload, -no_debug, -private_tempfiles
-=item CREATING THE HTML HEADER:
+=back
+
+=item GENERATING DYNAMIC DOCUMENTS
+
+=over
+
+=item CREATING A STANDARD HTTP HEADER:
+
+=item GENERATING A REDIRECTION HEADER
+
+=item CREATING THE HTML DOCUMENT HEADER
B<Parameters:>, 4, 5, 6..
=item ENDING THE HTML DOCUMENT:
+=item CREATING A SELF-REFERENCING URL THAT PRESERVES STATE INFORMATION:
+
+=item OBTAINING THE SCRIPT'S URL
+
+B<-absolute>, B<-relative>, B<-full>, B<-path> (B<-path_info>), B<-query>
+(B<-query_string>)
+
=back
-=item CREATING FORMS
+=item CREATING STANDARD HTML ELEMENTS:
+
+=over
+
+=item PROVIDING ARGUMENTS TO HTML SHORTCUTS
+
+=item THE DISTRIBUTIVE PROPERTY OF HTML SHORTCUTS
+
+=item HTML SHORTCUTS AND LIST INTERPOLATION
+
+=item NON-STANDARD HTML SHORTCUTS
+
+=back
+
+=item CREATING FILL-OUT FORMS:
=over
@@ -3000,26 +3672,22 @@ scripts, B<referer()>, B<auth_type ()>, B<server_name ()>, B<virtual_host
()>, B<server_software ()>, B<remote_user ()>, B<user_name ()>,
B<request_method()>
-=item CREATING HTML ELEMENTS
-
-=over
-
-=item PROVIDING ARGUMENTS TO HTML SHORTCUTS
+=item USING NPH SCRIPTS
-=item Generating new HTML tags
+In the B<use> statement, By calling the B<nph()> method:, By using B<-nph>
+parameters in the B<header()> and B<redirect()> statements:
-=back
+=item Server Push
-=item IMPORTING CGI METHOD CALLS INTO YOUR NAME SPACE
+multipart_init()
+multipart_init(-boundary=>$boundary);, multipart_start(), multipart_end()
-B<cgi>, B<form>, B<html2>, B<html3>, B<netscape>, B<shortcuts>,
-B<standard>, B<all>
+=item Avoiding Denial of Service Attacks
-=item USING NPH SCRIPTS
+B<$CGI::POST_MAX>, B<$CGI::DISABLE_UPLOADS>, B<1. On a script-by-script
+basis>, B<2. Globally for all scripts>
-In the B<use> statementSimply add ":nph" to the list of symbols to be
-imported into your script:, By calling the B<nph()> method:, By using
-B<-nph> parameters in the B<header()> and B<redirect()> statements:
+=item COMPATIBILITY WITH CGI-LIB.PL
=item AUTHOR INFORMATION
@@ -3035,7 +3703,8 @@ Christiansen (tchrist@convex.com), Andreas Koenig
(k@franz.ww.TU-Berlin.DE), Tim MacKenzie (Tim.MacKenzie@fulcrum.com.au),
Kevin B. Hendricks (kbhend@dogwood.tyler.wm.edu), Stephen Dahmen
(joyfire@inxpress.net), Ed Jordan (ed@fidalgo.net), David Alan Pisoni
-(david@cnation.com), ...and many many more..
+(david@cnation.com), Doug MacEachern (dougm@opengroup.org), Robin Houston
+(robin@oneworld.org), ...and many many more..
=item A COMPLETE EXAMPLE OF A SIMPLE FORM-BASED SCRIPT
@@ -3068,12 +3737,48 @@ other) error log
=item MAKING PERL ERRORS APPEAR IN THE BROWSER WINDOW
+=over
+
+=item Changing the default message
+
+=back
+
=item CHANGE LOG
=item AUTHORS
=item SEE ALSO
+=head2 CGI::Cookie - Interface to Netscape Cookies
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item USING CGI::Cookie
+
+B<1. expiration date>, B<2. domain>, B<3. path>, B<4. secure flag>
+
+=over
+
+=item Creating New Cookies
+
+=item Sending the Cookie to the Browser
+
+=item Recovering Previous Cookies
+
+=item Manipulating Cookies
+
+B<name()>, B<value()>, B<domain()>, B<path()>, B<expires()>
+
+=back
+
+=item AUTHOR INFORMATION
+
+=item BUGS
+
+=item SEE ALSO
+
=head2 CGI::Fast - CGI Interface for Fast CGI
=item SYNOPSIS
@@ -3104,7 +3809,15 @@ other) error log
=item USING CGI::Push
--last_page, -type, -delay, -cookie, -target, -expires
+-next_page, -last_page, -type, -delay, -cookie, -target, -expires
+
+=over
+
+=item Heterogeneous Pages
+
+=item Changing the Page Delay on the Fly
+
+=back
=item INSTALLING CGI::Push SCRIPTS
@@ -3139,7 +3852,7 @@ object available
Searching for authors, bundles, distribution files and modules, make, test,
install, clean modules or distributions, readme, look module or
-distribution
+distribution, Signals
=item CPAN::Shell
@@ -3147,18 +3860,22 @@ distribution
=item recompile
-=item The 4 Classes: Authors, Bundles, Modules, Distributions
+=item The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
=item ProgrammerE<39>s interface
expand($type,@things), Programming Examples
+=item Methods in the four
+
=item Cache Manager
=item Bundles
=item Prerequisites
+=item Finding packages and VERSION
+
=item Debugging
=item Floppy, Zip, and all that Jazz
@@ -3172,6 +3889,12 @@ E<lt>valueE<gt>, o conf E<lt>list optionE<gt>, o conf E<lt>list optionE<gt>
[shift|pop], o conf E<lt>list optionE<gt> [unshift|push|splice]
E<lt>listE<gt>
+=over
+
+=item CD-ROM support
+
+=back
+
=item SECURITY
=item EXPORT
@@ -3197,12 +3920,18 @@ module
=item SEE ALSO
-=head2 Carp, carp - warn of errors (from perspective of caller)
+=head2 Carp, carp - warn of errors (from perspective of caller)
=item SYNOPSIS
=item DESCRIPTION
+=over
+
+=item Forcing a Stack Trace
+
+=back
+
=head2 Class::Struct - declare struct-like datatypes as Perl classes
=item SYNOPSIS
@@ -3226,27 +3955,13 @@ Example 1, Example 2
=item Author and Modification History
-=head2 Config - access Perl configuration information
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-myconfig(), config_sh(), config_vars(@names)
-
-=item EXAMPLE
-
-=item WARNING
-
-=item NOTE
-
=head2 Cwd, getcwd - get pathname of current working directory
=item SYNOPSIS
=item DESCRIPTION
-=head2 DB_File - Perl5 access to Berkeley DB
+=head2 DB_File - Perl5 access to Berkeley DB version 1.x
=item SYNOPSIS
@@ -3256,6 +3971,8 @@ B<DB_HASH>, B<DB_BTREE>, B<DB_RECNO>
=over
+=item Using DB_File with Berkeley DB version 2
+
=item Interface to Berkeley DB
=item Opening a Berkeley DB Database File
@@ -3344,35 +4061,74 @@ $value, $flags) ;>, B<$status = $X-E<gt>sync([$flags]) ;>
=item AVAILABILITY
+=item COPYRIGHT
+
=item SEE ALSO
=item AUTHOR
-=head2 Devel::SelfStubber - generate stubs for a SelfLoading module
+=head2 Data::Dumper - stringified perl data structures, suitable for both
+printing and C<eval>
=item SYNOPSIS
=item DESCRIPTION
-=head2 DirHandle - supply object methods for directory handles
+=over
-=item SYNOPSIS
+=item Methods
-=item DESCRIPTION
+I<PACKAGE>->new(I<ARRAYREF [>, I<ARRAYREF]>), I<$OBJ>->Dump I<or>
+I<PACKAGE>->Dump(I<ARRAYREF [>, I<ARRAYREF]>), I<$OBJ>->Dumpxs I<or>
+I<PACKAGE>->Dumpxs(I<ARRAYREF [>, I<ARRAYREF]>),
+I<$OBJ>->Seen(I<[HASHREF]>), I<$OBJ>->Values(I<[ARRAYREF]>),
+I<$OBJ>->Names(I<[ARRAYREF]>), I<$OBJ>->Reset
+
+=item Functions
+
+Dumper(I<LIST>), DumperX(I<LIST>)
+
+=item Configuration Variables or Methods
+
+$Data::Dumper::Indent I<or> I<$OBJ>->Indent(I<[NEWVAL]>),
+$Data::Dumper::Purity I<or> I<$OBJ>->Purity(I<[NEWVAL]>),
+$Data::Dumper::Pad I<or> I<$OBJ>->Pad(I<[NEWVAL]>),
+$Data::Dumper::Varname I<or> I<$OBJ>->Varname(I<[NEWVAL]>),
+$Data::Dumper::Useqq I<or> I<$OBJ>->Useqq(I<[NEWVAL]>),
+$Data::Dumper::Terse I<or> I<$OBJ>->Terse(I<[NEWVAL]>),
+$Data::Dumper::Freezer I<or> $I<OBJ>->Freezer(I<[NEWVAL]>),
+$Data::Dumper::Toaster I<or> $I<OBJ>->Toaster(I<[NEWVAL]>),
+$Data::Dumper::Deepcopy I<or> $I<OBJ>->Deepcopy(I<[NEWVAL]>),
+$Data::Dumper::Quotekeys I<or> $I<OBJ>->Quotekeys(I<[NEWVAL]>),
+$Data::Dumper::Bless I<or> $I<OBJ>->Bless(I<[NEWVAL]>)
+
+=item Exports
+
+Dumper
+
+=back
+
+=item EXAMPLES
+
+=item BUGS
+
+=item AUTHOR
+
+=item VERSION
-=head2 DynaLoader - Dynamically load C libraries into Perl code
+=item SEE ALSO
+
+=head2 Devel::SelfStubber - generate stubs for a SelfLoading module
=item SYNOPSIS
=item DESCRIPTION
-@dl_library_path, @dl_resolve_using, @dl_require_symbols, @dl_librefs,
-@dl_modules, dl_error(), $dl_debug, dl_findfile(), dl_expandspec(),
-dl_load_file(), dl_loadflags(), dl_find_symbol(),
-dl_find_symbol_anywhere(), dl_undef_symbols(), dl_install_xsub(),
-bootstrap()
+=head2 DirHandle - supply object methods for directory handles
+
+=item SYNOPSIS
-=item AUTHOR
+=item DESCRIPTION
=head2 English - use nice English (or awk) names for ugly punctuation
variables
@@ -3401,6 +4157,8 @@ variables
=item Specialised Import Lists
+=item Exporting without using Export's import method
+
=item Module Version Checking
=item Managing Unknown Symbols
@@ -3451,6 +4209,23 @@ ccopts(), xsi_header(), xsi_protos(@modules), xsi_body(@modules)
=item DESCRIPTION
+=head2 ExtUtils::Installed - Inventory management of installed modules
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item USAGE
+
+=item FUNCTIONS
+
+new(), modules(), files(), directories(), directory_tree(), validate(),
+packlist(), version()
+
+=item EXAMPLE
+
+=item AUTHOR
+
=head2 ExtUtils::Liblist - determine libraries to use and how to use them
=item SYNOPSIS
@@ -3512,13 +4287,14 @@ extliblist, file_name_is_absolute, find_perl
=item Methods to actually produce chunks of text for the Makefile
-force (o), guess_name, has_link_code, init_dirscan, init_main, init_others,
-install (o), installbin (o), libscan (o), linkext (o), lsdir, macro (o),
-makeaperl (o), makefile (o), manifypods (o), maybe_command,
-maybe_command_in_dirs, needs_linking (o), nicetext, parse_version, pasthru
-(o), path, perl_script, perldepend (o), pm_to_blib, post_constants (o),
-post_initialize (o), postamble (o), prefixify, processPL (o), realclean
-(o), replace_manpage_separator, static (o), static_lib (o), staticmake (o),
+fixin, force (o), guess_name, has_link_code, init_dirscan, init_main,
+init_others, install (o), installbin (o), libscan (o), linkext (o), lsdir,
+macro (o), makeaperl (o), makefile (o), manifypods (o), maybe_command,
+maybe_command_in_dirs, needs_linking (o), nicetext, parse_version,
+parse_abstract, pasthru (o), path, perl_script, perldepend (o), ppd,
+perm_rw (o), perm_rwx (o), pm_to_blib, post_constants (o), post_initialize
+(o), postamble (o), prefixify, processPL (o), realclean (o),
+replace_manpage_separator, static (o), static_lib (o), staticmake (o),
subdir_x (o), subdirs (o), test (o), test_via_harness (o), test_via_script
(o), tool_autosplit (o), tools_other (o), tool_xsubpp (o), top_targets (o),
writedoc, xs_c (o), xs_o (o), perl_archive, export_list
@@ -3603,17 +4379,17 @@ dist_ci (o), dist_core (o), pasthru (o)
=item Using Attributes and Parameters
-C, CONFIG, CONFIGURE, DEFINE, DIR, DISTNAME, DL_FUNCS, DL_VARS,
-EXCLUDE_EXT, EXE_FILES, NO_VC, FIRST_MAKEFILE, FULLPERL, H, INC,
+C, CCFLAGS, CONFIG, CONFIGURE, DEFINE, DIR, DISTNAME, DL_FUNCS, DL_VARS,
+EXCLUDE_EXT, EXE_FILES, NO_VC, FIRST_MAKEFILE, FULLPERL, H, IMPORTS, INC,
INCLUDE_EXT, INSTALLARCHLIB, INSTALLBIN, INSTALLDIRS, INSTALLMAN1DIR,
INSTALLMAN3DIR, INSTALLPRIVLIB, INSTALLSCRIPT, INSTALLSITELIB,
INSTALLSITEARCH, INST_ARCHLIB, INST_BIN, INST_EXE, INST_LIB, INST_MAN1DIR,
INST_MAN3DIR, INST_SCRIPT, LDFROM, LIBPERL_A, LIB, LIBS, LINKTYPE,
MAKEAPERL, MAKEFILE, MAN1PODS, MAN3PODS, MAP_TARGET, MYEXTLIB, NAME,
NEEDS_LINKING, NOECHO, NORECURS, OBJECT, OPTIMIZE, PERL, PERLMAINCC,
-PERL_ARCHLIB, PERL_LIB, PERL_SRC, PL_FILES, PM, PMLIBDIRS, PREFIX,
-PREREQ_PM, SKIP, TYPEMAPS, VERSION, VERSION_FROM, XS, XSOPT, XSPROTOARG,
-XS_VERSION
+PERL_ARCHLIB, PERL_LIB, PERL_SRC, PERM_RW, PERM_RWX, PL_FILES, PM,
+PMLIBDIRS, PREFIX, PREREQ_PM, SKIP, TYPEMAPS, VERSION, VERSION_FROM, XS,
+XSOPT, XSPROTOARG, XS_VERSION
=item Additional lowercase attributes
@@ -3626,10 +4402,12 @@ tool_autosplit
=item Distribution Support
- make distcheck, make skipcheck, make distclean, make manifest,
- make distdir, make tardist, make dist, make uutardist, make
+make distcheck, make skipcheck, make distclean, make manifest,
+make distdir, make tardist, make dist, make uutardist, make
shdist, make zipdist, make ci
+=item Disabling an extension
+
=back
=item SEE ALSO
@@ -3657,14 +4435,6 @@ C<Added to MANIFEST:> I<file>
=item AUTHOR
-=head2 ExtUtils::Miniperl, writemain - write the C code for perlmain.c
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-=item SEE ALSO
-
=head2 ExtUtils::Mkbootstrap - make a bootstrap file for use by DynaLoader
=item SYNOPSIS
@@ -3684,12 +4454,36 @@ NAME, DL_FUNCS, DL_VARS, FILE, FUNCLIST, DLBASE
=item REVISION
+=head2 ExtUtils::Packlist - manage .packlist files
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item USAGE
+
+=item FUNCTIONS
+
+new(), read(), write(), validate(), packlist_file()
+
+=item EXAMPLE
+
+=item AUTHOR
+
=head2 ExtUtils::testlib - add blib/* directories to @INC
=item SYNOPSIS
=item DESCRIPTION
+=head2 Fatal - replace functions with equivalents which succeed or die
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item AUTHOR
+
=head2 Fcntl - load the C Fcntl.h defines
=item SYNOPSIS
@@ -3768,6 +4562,8 @@ rmscopy($from,$to[,$date_flag])
=item DESCRIPTION
+=item BUGS
+
=head2 File::Path - create or remove a series of directories
=item SYNOPSIS
@@ -3778,6 +4574,71 @@ rmscopy($from,$to[,$date_flag])
=item REVISION
+=head2 File::Spec - portably perform operations on file names
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item SEE ALSO
+
+=item AUTHORS
+
+=head2 File::Spec::Mac - File::Spec for MacOS
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item METHODS
+
+canonpath, catdir, catfile, curdir, rootdir, updir, file_name_is_absolute,
+path
+
+=item SEE ALSO
+
+=head2 File::Spec::OS2 - methods for OS/2 file specs
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=head2 File::Spec::Unix - methods used by File::Spec
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item METHODS
+
+canonpath, catdir, catfile, curdir, rootdir, updir, no_upwards,
+file_name_is_absolute, path, join, nativename
+
+=item SEE ALSO
+
+=head2 File::Spec::VMS - methods for VMS file specs
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=over
+
+=item Methods always loaded
+
+catdir, catfile, curdir (override), rootdir (override), updir (override),
+path (override), file_name_is_absolute (override)
+
+=back
+
+=head2 File::Spec::Win32 - methods for Win32 file specs
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+catfile, canonpath
+
=head2 File::stat - by-name interface to Perl's built-in stat() functions
=item SYNOPSIS
@@ -3841,7 +4702,7 @@ options
=item DESCRIPTION
-E<lt>noneE<gt>, !, =s, :s, =i, :i, =f, :f
+!, +, :s, :i, :f
=over
@@ -3853,7 +4714,7 @@ E<lt>noneE<gt>, !, =s, :s, =i, :i, =f, :f
=item Option starters
-=item Return value
+=item Return values and Errors
=back
@@ -3864,14 +4725,18 @@ E<lt>noneE<gt>, !, =s, :s, =i, :i, =f, :f
=item CONFIGURATION OPTIONS
default, auto_abbrev, getopt_compat, require_order, permute, bundling
-(default: reset), bundling_override (default: reset), ignore_case
+(default: reset), bundling_override (default: reset), ignore_case
(default: set), ignore_case_always (default: reset), pass_through (default:
-reset), debug (default: reset)
+reset), prefix, prefix_pattern, debug (default: reset)
=item OTHER USEFUL VARIABLES
$Getopt::Long::VERSION, $Getopt::Long::error
+=item AUTHOR
+
+=item COPYRIGHT AND DISCLAIMER
+
=head2 Getopt::Std, getopt - Process single-character switches with switch
clustering
@@ -3892,7 +4757,7 @@ locale
=item DESCRIPTION
-=head2 IO::File - supply object methods for filehandles
+=head2 IO::lib::IO::File, IO::File - supply object methods for filehandles
=item SYNOPSIS
@@ -3910,7 +4775,8 @@ open( FILENAME [,MODE [,PERMS]] )
=item HISTORY
-=head2 IO::Handle - supply object methods for I/O handles
+=head2 IO::lib::IO::Handle, IO::Handle - supply object methods for I/O
+handles
=item SYNOPSIS
@@ -3934,7 +4800,7 @@ $fh->error, $fh->clearerr, $fh->untaint
=item HISTORY
-=head2 IO::Pipe, IO::pipe - supply object methods for pipes
+=head2 IO::lib::IO::Pipe, IO::pipe - supply object methods for pipes
=item SYNOPSIS
@@ -3954,7 +4820,8 @@ reader ([ARGS]), writer ([ARGS]), handles ()
=item COPYRIGHT
-=head2 IO::Seekable - supply seek based methods for I/O objects
+=head2 IO::lib::IO::Seekable, IO::Seekable - supply seek based methods for
+I/O objects
=item SYNOPSIS
@@ -3964,7 +4831,8 @@ reader ([ARGS]), writer ([ARGS]), handles ()
=item HISTORY
-=head2 IO::Select - OO interface to the select system call
+=head2 IO::lib::IO::Select, IO::Select - OO interface to the select system
+call
=item SYNOPSIS
@@ -3986,7 +4854,8 @@ add ( HANDLES ), remove ( HANDLES ), exists ( HANDLE ), handles, can_read (
=item COPYRIGHT
-=head2 IO::Socket - Object interface to socket communications
+=head2 IO::lib::IO::Socket, IO::Socket - Object interface to socket
+communications
=item SYNOPSIS
@@ -4026,137 +4895,70 @@ hostpath(), peerpath()
=item COPYRIGHT
-=head2 IO::lib::IO::File, IO::File - supply object methods for filehandles
+=head2 IPC::Open2, open2 - open a process for both reading and writing
=item SYNOPSIS
=item DESCRIPTION
-=item CONSTRUCTOR
-
-new ([ ARGS ] ), new_tmpfile
-
-=item METHODS
-
-open( FILENAME [,MODE [,PERMS]] )
+=item WARNING
=item SEE ALSO
-=item HISTORY
-
-=head2 IO::lib::IO::Handle, IO::Handle - supply object methods for I/O
-handles
+=head2 IPC::Open3, open3 - open a process for reading, writing, and error
+handling
=item SYNOPSIS
=item DESCRIPTION
-=item CONSTRUCTOR
-
-new (), new_from_fd ( FD, MODE )
-
-=item METHODS
-
-$fh->fdopen ( FD, MODE ), $fh->opened, $fh->getline, $fh->getlines,
-$fh->ungetc ( ORD ), $fh->write ( BUF, LEN [, OFFSET }\] ), $fh->flush,
-$fh->error, $fh->clearerr, $fh->untaint
-
-=item NOTE
-
-=item SEE ALSO
-
-=item BUGS
+=item WARNING
-=item HISTORY
-
-=head2 IO::lib::IO::Pipe, IO::pipe - supply object methods for pipes
+=head2 IPC::SysV - SysV IPC constants
=item SYNOPSIS
=item DESCRIPTION
-=item CONSTRCUTOR
-
-new ( [READER, WRITER] )
-
-=item METHODS
-
-reader ([ARGS]), writer ([ARGS]), handles ()
+ftok( PATH, ID )
=item SEE ALSO
-=item AUTHOR
+=item AUTHORS
=item COPYRIGHT
-=head2 IO::lib::IO::Seekable, IO::Seekable - supply seek based methods for
-I/O objects
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-=item SEE ALSO
-
-=item HISTORY
-
-=head2 IO::lib::IO::Select, IO::Select - OO interface to the select system
-call
+=head2 IPC::SysV::Msg, IPC::Msg - SysV Msg IPC object class
=item SYNOPSIS
=item DESCRIPTION
-=item CONSTRUCTOR
-
-new ( [ HANDLES ] )
-
=item METHODS
-add ( HANDLES ), remove ( HANDLES ), exists ( HANDLE ), handles, can_read (
-[ TIMEOUT ] ), can_write ( [ TIMEOUT ] ), has_error ( [ TIMEOUT ] ), count
-(), bits(), bits(), select ( READ, WRITE, ERROR [, TIMEOUT ] )
+new ( KEY , FLAGS ), id, rcv ( BUF, LEN [, TYPE [, FLAGS ]] ), remove, set
+( STAT ), set ( NAME => VALUE [, NAME => VALUE ...] ), snd ( TYPE, MSG [,
+FLAGS ] ), stat
-=item EXAMPLE
+=item SEE ALSO
=item AUTHOR
=item COPYRIGHT
-=head2 IO::lib::IO::Socket, IO::Socket - Object interface to socket
-communications
+=head2 IPC::SysV::Semaphore, IPC::Semaphore - SysV Semaphore IPC object
+class
=item SYNOPSIS
=item DESCRIPTION
-=item CONSTRUCTOR
-
-new ( [ARGS] )
-
-=item METHODS
-
-accept([PKG]), timeout([VAL]), sockopt(OPT [, VAL]), sockdomain, socktype,
-protocol
-
-=item SUB-CLASSES
-
-=over
-
-=item IO::Socket::INET
-
-=item METHODS
-
-sockaddr (), sockport (), sockhost (), peeraddr (), peerport (), peerhost
-()
-
-=item IO::Socket::UNIX
-
=item METHODS
-hostpath(), peerpath()
-
-=back
+new ( KEY , NSEMS , FLAGS ), getall, getncnt ( SEM ), getpid ( SEM ),
+getval ( SEM ), getzcnt ( SEM ), id, op ( OPLIST ), remove, set ( STAT ),
+set ( NAME => VALUE [, NAME => VALUE ...] ), setall ( VALUES ), setval ( N
+, VALUE ), stat
=item SEE ALSO
@@ -4164,25 +4966,6 @@ hostpath(), peerpath()
=item COPYRIGHT
-=head2 IPC::Open2, open2 - open a process for both reading and writing
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-=item WARNING
-
-=item SEE ALSO
-
-=head2 IPC::Open3, open3 - open a process for reading, writing, and error
-handling
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-=item WARNING
-
=head2 Math::BigFloat - Arbitrary length float math package
=item SYNOPSIS
@@ -4205,6 +4988,8 @@ Canonical notation, Input, Output
=item EXAMPLES
+=item Autocreating constants
+
=item BUGS
=item AUTHOR
@@ -4224,7 +5009,9 @@ functions
=item USAGE
-=item ERRORS DUE TO DIVISION BY ZERO
+=item ERRORS DUE TO DIVISION BY ZERO OR LOGARITHM OF ZERO
+
+=item ERRORS DUE TO INDIGESTIBLE ARGUMENTS
=item BUGS
@@ -4238,6 +5025,8 @@ functions
=item TRIGONOMETRIC FUNCTIONS
+B<tan>
+
=over
=item ERRORS DUE TO DIVISION BY ZERO
@@ -4246,7 +5035,24 @@ functions
=back
-=item ANGLE CONVERSIONS
+=item PLANE ANGLE CONVERSIONS
+
+=item RADIAL COORDINATE CONVERSIONS
+
+=over
+
+=item COORDINATE SYSTEMS
+
+=item 3-D ANGLE CONVERSIONS
+
+cartesian_to_cylindrical, cartesian_to_spherical, cylindrical_to_cartesian,
+cylindrical_to_spherical, spherical_to_cartesian, spherical_to_cylindrical
+
+=back
+
+=item GREAT CIRCLE DISTANCES
+
+=item EXAMPLES
=item BUGS
@@ -4362,8 +5168,9 @@ opdump (PAT)
=item Predefined Opcode Tags
:base_core, :base_mem, :base_loop, :base_io, :base_orig, :base_math,
-:default, :filesys_read, :sys_db, :browse, :filesys_open, :filesys_write,
-:subprocess, :ownprocess, :others, :still_to_be_decided, :dangerous
+:base_thread, :default, :filesys_read, :sys_db, :browse, :filesys_open,
+:filesys_write, :subprocess, :ownprocess, :others, :still_to_be_decided,
+:dangerous
=item SEE ALSO
@@ -4402,7 +5209,7 @@ Memory, CPU, Snooping, Signals, State Changes
=head2 Opcode::ops, ops - Perl pragma to restrict unsafe operations when
compiling
-=item SYNOPSIS
+=item SYNOPSIS
=item DESCRIPTION
@@ -4535,7 +5342,7 @@ Constants, Macros
=item CREATION
-=head2 Pod::Html, Pod::HTML - module to convert pod files to HTML
+=head2 Pod::Html - module to convert pod files to HTML
=item SYNOPSIS
@@ -4572,35 +5379,6 @@ nonetscape, index, noindex, recurse, norecurse, title, verbose
=item DESCRIPTION
-=head2 Safe - Compile and execute code in restricted compartments
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-a new namespace, an operator mask
-
-=item WARNING
-
-=over
-
-=item RECENT CHANGES
-
-=item Methods in class Safe
-
-permit (OP, ...), permit_only (OP, ...), deny (OP, ...), deny_only (OP,
-...), trap (OP, ...), untrap (OP, ...), share (NAME, ...), share_from
-(PACKAGE, ARRAYREF), varglob (VARNAME), reval (STRING), rdo (FILENAME),
-root (NAMESPACE), mask (MASK)
-
-=item Some Safety Issues
-
-Memory, CPU, Snooping, Signals, State Changes
-
-=item AUTHOR
-
-=back
-
=head2 Search::Dict, look - search for key in dictionary file
=item SYNOPSIS
@@ -4680,7 +5458,8 @@ interface to the UNIX syslog(3) calls
=item DESCRIPTION
openlog $ident, $logopt, $facility, syslog $priority, $format, @args,
-setlogmask $mask_priority, closelog
+setlogmask $mask_priority, setlogsock $sock_type (added in 5.004_02),
+closelog
=item EXAMPLES
@@ -4726,10 +5505,28 @@ C<MinLine>, C<findConsole>, Attribs, C<Features>
=item Additional supported functions
+C<tkRunning>, C<ornaments>, C<newTTY>
+
=item EXPORTS
=item ENVIRONMENT
+=head2 Test - provides a simple framework for writing test scripts
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item TEST TYPES
+
+NORMAL TESTS, SKIPPED TESTS, TODO TESTS
+
+=item ONFAIL
+
+=item SEE ALSO
+
+=item AUTHOR
+
=head2 Test::Harness - run perl standard test scripts with statistics
=item SYNOPSIS
@@ -4751,6 +5548,8 @@ C<All tests successful.\nFiles=%d, Tests=%d, %s>, C<FAILED tests
%d)>, C<Failed 1 test, %.2f%% okay. %s>, C<Failed %d/%d tests, %.2f%% okay.
%s>
+=item ENVIRONMENT
+
=item SEE ALSO
=item AUTHORS
@@ -4765,12 +5564,21 @@ C<All tests successful.\nFiles=%d, Tests=%d, %s>, C<FAILED tests
=item EXAMPLE
-=head2 Text::ParseWords - parse text into an array of tokens
+=head2 Text::ParseWords - parse text into an array of tokens or array of
+arrays
=item SYNOPSIS
=item DESCRIPTION
+=item EXAMPLES
+
+0a simple word, 1multiple spaces are skipped because of our $delim, 2use of
+quotes to include a space in a word, 3use of a backslash to include a space
+in a word, 4use of a backslash to remove the special meaning of a
+double-quote, 5another simple word (note the lack of effect of the
+backslashed double-quote)
+
=item AUTHORS
=head2 Text::Soundex - Implementation of the Soundex Algorithm as Described
@@ -4809,6 +5617,87 @@ unexpand(1)
=item AUTHOR
+=head2 Thread - multithreading
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item FUNCTIONS
+
+new \&start_sub, new \&start_sub, LIST, lock VARIABLE, async BLOCK;,
+Thread->self, Thread->list, cond_wait VARIABLE, cond_signal VARIABLE,
+cond_broadcast VARIABLE
+
+=item METHODS
+
+join, eval, tid
+
+=item LIMITATIONS
+
+=item SEE ALSO
+
+=head2 Thread::Queue - thread-safe queues
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item FUNCTIONS AND METHODS
+
+new, enqueue LIST, dequeue, dequeue_nb, pending
+
+=item SEE ALSO
+
+=head2 Thread::Semaphore - thread-safe semaphores
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item FUNCTIONS AND METHODS
+
+new, new NUMBER, down, down NUMBER, up, up NUMBER
+
+=head2 Thread::Signal - Start a thread which runs signal handlers reliably
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item BUGS
+
+=head2 Thread::Specific - thread-specific keys
+
+=item SYNOPSIS
+
+=head2 Tie::Array - base class for tied arrays
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+TIEARRAY classname, LIST, STORE this, index, value, FETCH this, index,
+FETCHSIZE this, STORESIZE this, count, EXTEND this, count, CLEAR this,
+DESTROY this, PUSH this, LIST, POP this, SHIFT this, UNSHIFT this, LIST,
+SPLICE this, offset, length, LIST
+
+=item CAVEATS
+
+=item AUTHOR
+
+=head2 Tie::Handle - base class definitions for tied handles
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+TIEHANDLE classname, LIST, WRITE this, scalar, length, offset, PRINT this,
+LIST, PRINTF this, format, LIST, READ this, scalar, length, offset,
+READLINE this, GETC this, DESTROY this
+
+=item MORE INFORMATION
+
=head2 Tie::Hash, Tie::StdHash - base class definitions for tied hashes
=item SYNOPSIS
@@ -4897,8 +5786,8 @@ function
=item DESCRIPTION
-isa ( TYPE ), can ( METHOD ), VERSION ( [ REQUIRE ] ), isa ( VAL, TYPE ),
-can ( VAL, METHOD )
+isa ( TYPE ), can ( METHOD ), VERSION ( [ REQUIRE ] ), UNIVERSAL::isa (
+VAL, TYPE ), UNIVERSAL::can ( VAL, METHOD )
=head2 User::grent - by-name interface to Perl's built-in getgr*()
functions
diff --git a/gnu/usr.bin/perl/pod/perltoot.pod b/gnu/usr.bin/perl/pod/perltoot.pod
index 3a35c05b903..c77a971b57f 100644
--- a/gnu/usr.bin/perl/pod/perltoot.pod
+++ b/gnu/usr.bin/perl/pod/perltoot.pod
@@ -315,7 +315,7 @@ be made through methods.
Perl doesn't impose restrictions on who gets to use which methods.
The public-versus-private distinction is by convention, not syntax.
(Well, unless you use the Alias module described below in
-L</"Data Members as Variables">.) Occasionally you'll see method names beginning or ending
+L<Data Members as Variables>.) Occasionally you'll see method names beginning or ending
with an underscore or two. This marking is a convention indicating
that the methods are private to that class alone and sometimes to its
closest acquaintances, its immediate subclasses. But this distinction
@@ -1753,27 +1753,25 @@ L<perltie>,
and
L<overload>.
-=head1 COPYRIGHT
+=head1 AUTHOR AND COPYRIGHT
+
+Copyright (c) 1997, 1998 Tom Christiansen
+All rights reserved.
+
+When included as part of the Standard Version of Perl, or as part of
+its complete documentation whether printed or otherwise, this work
+may be distributed only under the terms of Perl's Artistic License.
+Any distribution of this file or derivatives thereof I<outside>
+of that package require that special arrangements be made with
+copyright holder.
-I I<really> hate to have to say this, but recent unpleasant
-experiences have mandated its inclusion:
-
- Copyright 1996 Tom Christiansen. All Rights Reserved.
-
-This work derives in part from the second edition of I<Programming Perl>.
-Although destined for release as a manpage with the standard Perl
-distribution, it is not public domain (nor is any of Perl and its docset:
-publishers beware). It's expected to someday make its way into a revision
-of the Camel Book. While it is copyright by me with all rights reserved,
-permission is granted to freely distribute verbatim copies of this
-document provided that no modifications outside of formatting be made,
-and that this notice remain intact. You are permitted and encouraged to
-use its code and derivatives thereof in your own source code for fun or
-for profit as you see fit. But so help me, if in six months I find some
-book out there with a hacked-up version of this material in it claiming to
-be written by someone else, I'll tell all the world that you're a jerk.
-Furthermore, your lawyer will meet my lawyer (or O'Reilly's) over lunch
-to arrange for you to receive your just deserts. Count on it.
+Irrespective of its distribution, all code examples in this file
+are hereby placed into the public domain. You are permitted and
+encouraged to use this code in your own programs for fun
+or for profit as you see fit. A simple comment in the code giving
+credit would be courteous but is not required.
+
+=head1 COPYRIGHT
=head2 Acknowledgments
diff --git a/gnu/usr.bin/perl/pod/perltrap.pod b/gnu/usr.bin/perl/pod/perltrap.pod
index 02abc3b03b3..852d8e98263 100644
--- a/gnu/usr.bin/perl/pod/perltrap.pod
+++ b/gnu/usr.bin/perl/pod/perltrap.pod
@@ -451,8 +451,8 @@ Also see precedence traps, for parsing C<$:>.
The second and third arguments of C<splice()> are now evaluated in scalar
context (as the Camel says) rather than list context.
- sub sub1{return(0,2) } # return a 2-elem array
- sub sub2{ return(1,2,3)} # return a 3-elem array
+ sub sub1{return(0,2) } # return a 2-element list
+ sub sub2{ return(1,2,3)} # return a 3-element list
@a1 = ("a","b","c","d","e");
@a2 = splice(@a1,&sub1,&sub2);
print join(' ',@a2),"\n";
@@ -650,6 +650,23 @@ Better parsing in perl 5
# perl4 prints: is zero
# perl5 warns: "Useless use of a constant in void context" if using -w
+=item * Parsing
+
+String interpolation of the C<$#array> construct differs when braces
+are to used around the name.
+
+ @ = (1..3);
+ print "${#a}";
+
+ # perl4 prints: 2
+ # perl5 fails with syntax error
+
+ @ = (1..3);
+ print "$#{a}";
+
+ # perl4 prints: {a}
+ # perl5 prints: 2
+
=back
=head2 Numerical Traps
@@ -757,15 +774,11 @@ variable is localized subsequent to the assignment
# perl4 prints: This is Perl 4
# perl5 prints:
- # Another example
-
- *fred = *barney; # fred is aliased to barney
- @barney = (1, 2, 4);
- # @fred;
- print "@fred"; # should print "1, 2, 4"
+=item * (Globs)
- # perl4 prints: 1 2 4
- # perl5 prints: In string, @fred now must be written as \@fred
+Assigning C<undef> to a glob has no effect in Perl 5. In Perl 4
+it undefines the associated scalar (but may have other side effects
+including SEGVs).
=item * (Scalar String)
@@ -925,6 +938,10 @@ Probably a bug.
Perl4-to-Perl5 traps involving precedence order.
+Perl 4 has almost the same precedence rules as Perl 5 for the operators
+that they both have. Perl 4 however, seems to have had some
+inconsistencies that made the behavior differ from what was documented.
+
=over 5
=item * Precedence
@@ -1000,13 +1017,34 @@ treats C<$::> as main C<package>
=item * Precedence
-concatenation precedence over filetest operator?
+perl4 had buggy precedence for the file test operators vis-a-vis
+the assignment operators. Thus, although the precedence table
+for perl4 leads one to believe C<-e $foo .= "q"> should parse as
+C<((-e $foo) .= "q")>, it actually parses as C<(-e ($foo .= "q"))>.
+In perl5, the precedence is as documented.
-e $foo .= "q"
# perl4 prints: no output
# perl5 prints: Can't modify -e in concatenation
+=item * Precedence
+
+In perl4, keys(), each() and values() were special high-precedence operators
+that operated on a single hash, but in perl5, they are regular named unary
+operators. As documented, named unary operators have lower precedence
+than the arithmetic and concatenation operators C<+ - .>, but the perl4
+variants of these operators actually bind tighter than C<+ - .>.
+Thus, for:
+
+ %foo = 1..10;
+ print keys %foo - 1
+
+ # perl4 prints: 4
+ # perl5 prints: Type of arg 1 to keys must be hash (not subtraction)
+
+The perl4 behavior was probably more useful, if less consistent.
+
=back
=head2 General Regular Expression Traps using s///, etc.
@@ -1140,26 +1178,6 @@ repeatedly, like C</x/> or C<m!x!>.
# perl5 prints: perl5
-=item * Regular Expression
-
-Under perl4 and upto version 5.003, a failed C<m//g> match used to
-reset the internal iterator, so that subsequent C<m//g> match attempts
-began from the beginning of the string. In perl version 5.004 and later,
-failed C<m//g> matches do not reset the iterator position (which can be
-found using the C<pos()> function--see L<perlfunc/pos>).
-
- $test = "foop";
- for (1..3) {
- print $1 while ($test =~ /(o)/g);
- # pos $test = 0; # to get old behavior
- }
-
- # perl4 prints: oooooo
- # perl5.004 prints: oo
-
-You may always reset the iterator yourself as shown in the commented line
-to get the old behavior.
-
=back
=head2 Subroutine, Signal, Sorting Traps
diff --git a/gnu/usr.bin/perl/pod/perlvar.pod b/gnu/usr.bin/perl/pod/perlvar.pod
index 75f4e6d5c2b..8d0ded6b69f 100644
--- a/gnu/usr.bin/perl/pod/perlvar.pod
+++ b/gnu/usr.bin/perl/pod/perlvar.pod
@@ -6,17 +6,26 @@ perlvar - Perl predefined variables
=head2 Predefined Names
-The following names have special meaning to Perl. Most of the
+The following names have special meaning to Perl. Most
punctuation names have reasonable mnemonics, or analogues in one of
-the shells. Nevertheless, if you wish to use the long variable names,
+the shells. Nevertheless, if you wish to use long variable names,
you just need to say
use English;
at the top of your program. This will alias all the short names to the
-long names in the current package. Some of them even have medium names,
+long names in the current package. Some even have medium names,
generally borrowed from B<awk>.
+Due to an unfortunate accident of Perl's implementation, "C<use English>"
+imposes a considerable performance penalty on all regular expression
+matches in a program, regardless of whether they occur in the scope of
+"C<use English>". For that reason, saying "C<use English>" in
+libraries is strongly discouraged. See the Devel::SawAmpersand module
+documentation from CPAN
+(http://www.perl.com/CPAN/modules/by-module/Devel/Devel-SawAmpersand-0.10.readme)
+for more information.
+
To go a step further, those variables that depend on the currently
selected filehandle may instead (and preferably) be set by calling an
object method on the FileHandle object. (Summary lines below for this
@@ -28,7 +37,7 @@ after which you may use either
method HANDLE EXPR
-or
+or more safely,
HANDLE->method(EXPR)
@@ -112,11 +121,11 @@ test. Note that outside of a C<while> test, this will not happen.
=over 8
-=item $E<lt>I<digit>E<gt>
+=item $E<lt>I<digits>E<gt>
Contains the subpattern from the corresponding set of parentheses in
the last pattern matched, not counting patterns matched in nested
-blocks that have been exited already. (Mnemonic: like \digit.)
+blocks that have been exited already. (Mnemonic: like \digits.)
These variables are all read-only.
=item $MATCH
@@ -127,6 +136,10 @@ The string matched by the last successful pattern match (not counting
any matches hidden within a BLOCK or eval() enclosed by the current
BLOCK). (Mnemonic: like & in some editors.) This variable is read-only.
+The use of this variable anywhere in a program imposes a considerable
+performance penalty on all regular expression matches. See the
+Devel::SawAmpersand module from CPAN for more information.
+
=item $PREMATCH
=item $`
@@ -136,6 +149,10 @@ pattern match (not counting any matches hidden within a BLOCK or eval
enclosed by the current BLOCK). (Mnemonic: C<`> often precedes a quoted
string.) This variable is read-only.
+The use of this variable anywhere in a program imposes a considerable
+performance penalty on all regular expression matches. See the
+Devel::SawAmpersand module from CPAN for more information.
+
=item $POSTMATCH
=item $'
@@ -151,6 +168,10 @@ string.) Example:
This variable is read-only.
+The use of this variable anywhere in a program imposes a considerable
+performance penalty on all regular expression matches. See the
+Devel::SawAmpersand module from CPAN for more information.
+
=item $LAST_PAREN_MATCH
=item $+
@@ -176,7 +197,8 @@ is 0. (Mnemonic: * matches multiple things.) Note that this variable
influences the interpretation of only "C<^>" and "C<$>". A literal newline can
be searched for even when C<$* == 0>.
-Use of "C<$*>" is deprecated in modern perls.
+Use of "C<$*>" is deprecated in modern Perls, supplanted by
+the C</s> and C</m> modifiers on pattern matching.
=item input_line_number HANDLE EXPR
@@ -187,7 +209,10 @@ Use of "C<$*>" is deprecated in modern perls.
=item $.
The current input line number for the last file handle from
-which you read (or performed a C<seek> or C<tell> on). An
+which you read (or performed a C<seek> or C<tell> on). The value
+may be different from the actual physical line number in the file,
+depending on what notion of "line" is in effect--see L<$/> on how
+to affect that. An
explicit close on a filehandle resets the line number. Because
"C<E<lt>E<gt>>" never does an explicit close, line numbers increase
across ARGV files (but see examples under eof()). Localizing C<$.> has
@@ -203,7 +228,8 @@ number.)
=item $/
-The input record separator, newline by default. Works like B<awk>'s RS
+The input record separator, newline by default. This is used to
+influence Perl's idea of what a "line" is. Works like B<awk>'s RS
variable, including treating empty lines as delimiters if set to the
null string. (Note: An empty line cannot contain any spaces or tabs.)
You may set it to a multi-character string to match a multi-character
@@ -215,13 +241,36 @@ line. Setting it to C<"\n\n"> will blindly assume that the next input
character belongs to the next paragraph, even if it's a newline.
(Mnemonic: / is used to delimit line boundaries when quoting poetry.)
- undef $/;
- $_ = <FH>; # whole file now here
+ undef $/; # enable "slurp" mode
+ $_ = <FH>; # whole file now here
s/\n[ \t]+/ /g;
Remember: the value of $/ is a string, not a regexp. AWK has to be
better for something :-)
+Setting $/ to a reference to an integer, scalar containing an integer, or
+scalar that's convertable to an integer will attempt to read records
+instead of lines, with the maximum record size being the referenced
+integer. So this:
+
+ $/ = \32768; # or \"32768", or \$var_containing_32768
+ open(FILE, $myfile);
+ $_ = <FILE>;
+
+will read a record of no more than 32768 bytes from FILE. If you're not
+reading from a record-oriented file (or your OS doesn't have
+record-oriented files), then you'll likely get a full chunk of data with
+every read. If a record is larger than the record size you've set, you'll
+get the record back in pieces.
+
+On VMS, record reads are done with the equivalent of C<sysread>, so it's
+best not to mix record and non-record reads on the same file. (This is
+likely not a problem, as any file you'd want to read in record mode is
+probably usable in line mode) Non-VMS systems perform normal I/O, so
+it's safe to mix record and non-record reads of a file.
+
+Also see L<$.>.
+
=item autoflush HANDLE EXPR
=item $OUTPUT_AUTOFLUSH
@@ -406,12 +455,14 @@ L<perlfunc/formline()>.
=item $?
The status returned by the last pipe close, backtick (C<``>) command,
-or system() operator. Note that this is the status word returned by
-the wait() system call (or else is made up to look like it). Thus,
-the exit value of the subprocess is actually (C<$? E<gt>E<gt> 8>), and
-C<$? & 255> gives which signal, if any, the process died from, and
-whether there was a core dump. (Mnemonic: similar to B<sh> and
-B<ksh>.)
+or system() operator. Note that this is the status word returned by the
+wait() system call (or else is made up to look like it). Thus, the exit
+value of the subprocess is actually (C<$? E<gt>E<gt> 8>), and C<$? & 127>
+gives which signal, if any, the process died from, and C<$? & 128> reports
+whether there was a core dump. (Mnemonic: similar to B<sh> and B<ksh>.)
+
+Additionally, if the C<h_errno> variable is supported in C, its value
+is returned via $? if any of the C<gethost*()> functions fail.
Note that if you have installed a signal handler for C<SIGCHLD>, the
value of C<$?> will usually be wrong outside that handler.
@@ -424,6 +475,8 @@ Under VMS, the pragma C<use vmsish 'status'> makes C<$?> reflect the
actual VMS exit status, instead of the default emulation of POSIX
status.
+Also see L<Error Indicators>.
+
=item $OS_ERROR
=item $ERRNO
@@ -432,24 +485,43 @@ status.
If used in a numeric context, yields the current value of errno, with
all the usual caveats. (This means that you shouldn't depend on the
-value of "C<$!>" to be anything in particular unless you've gotten a
+value of C<$!> to be anything in particular unless you've gotten a
specific error return indicating a system error.) If used in a string
context, yields the corresponding system error string. You can assign
-to "C<$!>" to set I<errno> if, for instance, you want "C<$!>" to return the
+to C<$!> to set I<errno> if, for instance, you want C<"$!"> to return the
string for error I<n>, or you want to set the exit value for the die()
operator. (Mnemonic: What just went bang?)
+Also see L<Error Indicators>.
+
=item $EXTENDED_OS_ERROR
=item $^E
-More specific information about the last system error than that provided by
-C<$!>, if available. (If not, it's just C<$!> again.)
-At the moment, this differs from C<$!> under only VMS and OS/2, where it
-provides the VMS status value from the last system error, and OS/2 error
-code of the last call to OS/2 API either via CRT, or directly from perl. The
-caveats mentioned in the description of C<$!> apply here, too.
-(Mnemonic: Extra error explanation.)
+Error information specific to the current operating system. At
+the moment, this differs from C<$!> under only VMS, OS/2, and Win32
+(and for MacPerl). On all other platforms, C<$^E> is always just
+the same as C<$!>.
+
+Under VMS, C<$^E> provides the VMS status value from the last
+system error. This is more specific information about the last
+system error than that provided by C<$!>. This is particularly
+important when C<$!> is set to B<EVMSERR>.
+
+Under OS/2, C<$^E> is set to the error code of the last call to
+OS/2 API either via CRT, or directly from perl.
+
+Under Win32, C<$^E> always returns the last error information
+reported by the Win32 call C<GetLastError()> which describes
+the last error from within the Win32 API. Most Win32-specific
+code will report errors via C<$^E>. ANSI C and UNIX-like calls
+set C<errno> and so most portable Perl code will report errors
+via C<$!>.
+
+Caveats mentioned in the description of C<$!> generally apply to
+C<$^E>, also. (Mnemonic: Extra error explanation.)
+
+Also see L<Error Indicators>.
=item $EVAL_ERROR
@@ -464,6 +536,8 @@ Note that warning messages are not collected in this variable. You can,
however, set up a routine to process warnings by setting C<$SIG{__WARN__}>
as described below.
+Also see L<Error Indicators>.
+
=item $PROCESS_ID
=item $PID
@@ -579,6 +653,15 @@ of perl in the right bracket?) Example:
See also the documentation of C<use VERSION> and C<require VERSION>
for a convenient way to fail if the Perl interpreter is too old.
+=item $COMPILING
+
+=item $^C
+
+The current value of the flag associated with the B<-c> switch. Mainly
+of use with B<-MO=...> to allow code to alter its behaviour when being compiled.
+(For example to automatically AUTOLOADing at compile time rather than normal
+deferred loading.) Setting C<$^C = 1> is similar to calling C<B::minus_c>.
+
=item $DEBUGGING
=item $^D
@@ -596,7 +679,7 @@ descriptors are not. Also, during an open(), system file descriptors are
preserved even if the open() fails. (Ordinary file descriptors are
closed before the open() is attempted.) Note that the close-on-exec
status of a file descriptor will be decided according to the value of
-C<$^F> at the time of the open, not the time of the exec.
+C<$^F> when the open() or pipe() was called, not the time of the exec().
=item $^H
@@ -667,14 +750,20 @@ Start with single-step on.
=back
-Note that some bits may be relevent at compile-time only, some at
+Note that some bits may be relevant at compile-time only, some at
run-time only. This is a new mechanism and the details may change.
+=item $^R
+
+The result of evaluation of the last successful L<perlre/C<(?{ code })>>
+regular expression assertion. (Excluding those used as switches.) May
+be written to.
+
=item $^S
Current state of the interpreter. Undefined if parsing of the current
module/eval is not finished (may happen in $SIG{__DIE__} and
-$SIG{__WARN__} handlers). True if inside an eval, othewise false.
+$SIG{__WARN__} handlers). True if inside an eval, otherwise false.
=item $BASETIME
@@ -735,12 +824,16 @@ specified, and the value is the location of the file actually found.
The C<require> command uses this array to determine whether a given file
has already been included.
-=item %ENV $ENV{expr}
+=item %ENV
+
+=item $ENV{expr}
The hash %ENV contains your current environment. Setting a
value in C<ENV> changes the environment for child processes.
-=item %SIG $SIG{expr}
+=item %SIG
+
+=item $SIG{expr}
The hash %SIG is used to set signal handlers for various
signals. Example:
@@ -758,6 +851,10 @@ signals. Example:
$SIG{'INT'} = 'DEFAULT'; # restore default action
$SIG{'QUIT'} = 'IGNORE'; # ignore SIGQUIT
+Using a value of C<'IGNORE'> usually has the effect of ignoring the
+signal, except for the C<CHLD> signal. See L<perlipc> for more about
+this special case.
+
The %SIG array contains values for only the signals actually set within
the Perl script. Here are some other examples:
@@ -806,7 +903,7 @@ The C<__DIE__> handler is explicitly disabled during the call, so that you
can die from a C<__DIE__> handler. Similarly for C<__WARN__>.
Note that the C<$SIG{__DIE__}> hook is called even inside eval()ed
-blocks/strings. See L<perlfunc/die>, L<perlvar/$^S> for how to
+blocks/strings. See L<perlfunc/die> and L<perlvar/$^S> for how to
circumvent this.
Note that C<__DIE__>/C<__WARN__> handlers are very special in one
@@ -814,7 +911,7 @@ respect: they may be called to report (probable) errors found by the
parser. In such a case the parser may be in inconsistent state, so
any attempt to evaluate Perl code from such a handler will probably
result in a segfault. This means that calls which result/may-result
-in parsing Perl should be used with extreme causion, like this:
+in parsing Perl should be used with extreme caution, like this:
require Carp if defined $^S;
Carp::confess("Something wrong") if defined &Carp::confess;
@@ -830,3 +927,86 @@ See L<perlfunc/die>, L<perlfunc/warn> and L<perlfunc/eval> for
additional info.
=back
+
+=head2 Error Indicators
+
+The variables L<$@>, L<$!>, L<$^E>, and L<$?> contain information about
+different types of error conditions that may appear during execution of
+Perl script. The variables are shown ordered by the "distance" between
+the subsystem which reported the error and the Perl process, and
+correspond to errors detected by the Perl interpreter, C library,
+operating system, or an external program, respectively.
+
+To illustrate the differences between these variables, consider the
+following Perl expression:
+
+ eval '
+ open PIPE, "/cdrom/install |";
+ @res = <PIPE>;
+ close PIPE or die "bad pipe: $?, $!";
+ ';
+
+After execution of this statement all 4 variables may have been set.
+
+$@ is set if the string to be C<eval>-ed did not compile (this may happen if
+C<open> or C<close> were imported with bad prototypes), or if Perl
+code executed during evaluation die()d (either implicitly, say,
+if C<open> was imported from module L<Fatal>, or the C<die> after
+C<close> was triggered). In these cases the value of $@ is the compile
+error, or C<Fatal> error (which will interpolate C<$!>!), or the argument
+to C<die> (which will interpolate C<$!> and C<$?>!).
+
+When the above expression is executed, open(), C<<PIPEE<gt>>, and C<close>
+are translated to C run-time library calls. $! is set if one of these
+calls fails. The value is a symbolic indicator chosen by the C run-time
+library, say C<No such file or directory>.
+
+On some systems the above C library calls are further translated
+to calls to the kernel. The kernel may have set more verbose error
+indicator that one of the handful of standard C errors. In such cases $^E
+contains this verbose error indicator, which may be, say, C<CDROM tray not
+closed>. On systems where C library calls are identical to system calls
+$^E is a duplicate of $!.
+
+Finally, $? may be set to non-C<0> value if the external program
+C</cdrom/install> fails. Upper bits of the particular value may reflect
+specific error conditions encountered by this program (this is
+program-dependent), lower-bits reflect mode of failure (segfault, completion,
+etc.). Note that in contrast to $@, $!, and $^E, which are set only
+if error condition is detected, the variable $? is set on each C<wait> or
+pipe C<close>, overwriting the old value.
+
+For more details, see the individual descriptions at L<$@>, L<$!>, L<$^E>,
+and L<$?>.
+
+
+=head2 Technical Note on the Syntax of Variable Names
+
+Variable names in Perl can have several formats. Usually, they must
+begin with a letter or underscore, in which case they can be
+arbitrarily long (up to an internal limit of 256 characters) and may
+contain letters, digits, underscores, or the special sequence C<::>.
+In this case the part before the last C<::> is taken to be a I<package
+qualifier>; see L<perlmod>.
+
+Perl variable names may also be a sequence of digits or a single
+punctuation or control character. These names are all reserved for
+special uses by Perl; for example, the all-digits names are used to
+hold backreferences after a regular expression match. Perl has a
+special syntax for the single-control-character names: It understands
+C<^X> (caret C<X>) to mean the control-C<X> character. For example,
+the notation C<$^W> (dollar-sign caret C<W>) is the scalar variable
+whose name is the single character control-C<W>. This is better than
+typing a literal control-C<W> into your program.
+
+All Perl variables that begin with digits, control characters, or
+punctuation characters are exempt from the effects of the C<package>
+declaration and are always forced to be in package C<main>. A few
+other names are also exempt:
+
+ ENV STDIN
+ INC STDOUT
+ ARGV STDERR
+ ARGVOUT
+ SIG
+
diff --git a/gnu/usr.bin/perl/pod/perlxs.pod b/gnu/usr.bin/perl/pod/perlxs.pod
index 6629af2dd55..98a983422f1 100644
--- a/gnu/usr.bin/perl/pod/perlxs.pod
+++ b/gnu/usr.bin/perl/pod/perlxs.pod
@@ -25,6 +25,11 @@ linked.
See L<perlxstut> for a tutorial on the whole extension creation process.
+Note: For many extensions, Dave Beazley's SWIG system provides a
+significantly more convenient mechanism for creating the XS glue
+code. See L<http://www.cs.utah.edu/~beazley/SWIG> for more
+information.
+
=head2 On The Road
Many of the examples which follow will concentrate on creating an interface
@@ -176,10 +181,10 @@ directive is used which sets ST(0) explicitly.
Older versions of this document recommended to use C<void> return
value in such cases. It was discovered that this could lead to
-segfaults in cases when XSUB was I<truely> C<void>. This practice is
+segfaults in cases when XSUB was I<truly> C<void>. This practice is
now deprecated, and may be not supported at some future version. Use
the return value C<SV *> in such cases. (Currently C<xsubpp> contains
-some heuristic code which tries to disambiguate between "truely-void"
+some heuristic code which tries to disambiguate between "truly-void"
and "old-practice-declared-as-void" functions. Hence your code is at
mercy of this heuristics unless you use C<SV *> as return value.)
@@ -277,6 +282,17 @@ typemap.
OUTPUT:
timep sv_setnv(ST(1), (double)timep);
+B<xsubpp> emits an automatic C<SvSETMAGIC()> for all parameters in the
+OUTPUT section of the XSUB, except RETVAL. This is the usually desired
+behavior, as it takes care of properly invoking 'set' magic on output
+parameters (needed for hash or array element parameters that must be
+created if they didn't exist). If for some reason, this behavior is
+not desired, the OUTPUT section may contain a C<SETMAGIC: DISABLE> line
+to disable it for the remainder of the parameters in the OUTPUT section.
+Likewise, C<SETMAGIC: ENABLE> can be used to reenable it for the
+remainder of the OUTPUT section. See L<perlguts> for more details
+about 'set' magic.
+
=head2 The CODE: Keyword
This keyword is used in more complicated XSUBs which require
@@ -344,17 +360,19 @@ Function parameters are normally initialized with their
values from the argument stack. The typemaps contain the
code segments which are used to transfer the Perl values to
the C parameters. The programmer, however, is allowed to
-override the typemaps and supply alternate initialization
-code.
+override the typemaps and supply alternate (or additional)
+initialization code.
The following code demonstrates how to supply initialization code for
-function parameters. The initialization code is eval'd by the compiler
-before it is added to the output so anything which should be interpreted
-literally, such as double quotes, must be protected with backslashes.
+function parameters. The initialization code is eval'd within double
+quotes by the compiler before it is added to the output so anything
+which should be interpreted literally [mainly C<$>, C<@>, or C<\\>]
+must be protected with backslashes. The variables C<$var>, C<$arg>,
+and C<$type> can be used as in typemaps.
bool_t
rpcb_gettime(host,timep)
- char *host = (char *)SvPV(ST(0),na);
+ char *host = (char *)SvPV($arg,PL_na);
time_t &timep = 0;
OUTPUT:
timep
@@ -364,6 +382,24 @@ would normally use this when a function parameter must be processed by
another library function before it can be used. Default parameters are
covered in the next section.
+If the initialization begins with C<=>, then it is output on
+the same line where the input variable is declared. If the
+initialization begins with C<;> or C<+>, then it is output after
+all of the input variables have been declared. The C<=> and C<;>
+cases replace the initialization normally supplied from the typemap.
+For the C<+> case, the initialization from the typemap will precede
+the initialization code included after the C<+>. A global
+variable, C<%v>, is available for the truly rare case where
+information from one initialization is needed in another
+initialization.
+
+ bool_t
+ rpcb_gettime(host,timep)
+ time_t &timep ; /*\$v{time}=@{[$v{time}=$arg]}*/
+ char *host + SvOK($v{time}) ? SvPV($arg,PL_na) : NULL;
+ OUTPUT:
+ timep
+
=head2 Default Parameter Values
Default values can be specified for function parameters by
@@ -517,14 +553,41 @@ The XS code, with ellipsis, follows.
time_t timep = NO_INIT
PREINIT:
char *host = "localhost";
+ STRLEN n_a;
CODE:
if( items > 1 )
- host = (char *)SvPV(ST(1), na);
+ host = (char *)SvPV(ST(1), n_a);
RETVAL = rpcb_gettime( host, &timep );
OUTPUT:
timep
RETVAL
+=head2 The C_ARGS: Keyword
+
+The C_ARGS: keyword allows creating of XSUBS which have different
+calling sequence from Perl than from C, without a need to write
+CODE: or CPPCODE: section. The contents of the C_ARGS: paragraph is
+put as the argument to the called C function without any change.
+
+For example, suppose that C function is declared as
+
+ symbolic nth_derivative(int n, symbolic function, int flags);
+
+and that the default flags are kept in a global C variable
+C<default_flags>. Suppose that you want to create an interface which
+is called as
+
+ $second_deriv = $function->nth_derivative(2);
+
+To do this, declare the XSUB as
+
+ symbolic
+ nth_derivative(function, n)
+ symbolic function
+ int n
+ C_ARGS:
+ n, function, default_flags
+
=head2 The PPCODE: Keyword
The PPCODE: keyword is an alternate form of the CODE: keyword and is used
@@ -547,7 +610,7 @@ Perl as a single list.
bool_t status;
PPCODE:
status = rpcb_gettime( host, &timep );
- EXTEND(sp, 2);
+ EXTEND(SP, 2);
PUSHs(sv_2mortal(newSViv(status)));
PUSHs(sv_2mortal(newSViv(timep)));
@@ -562,7 +625,7 @@ directive.
The EXTEND() macro is used to make room on the argument
stack for 2 return values. The PPCODE: directive causes the
-B<xsubpp> compiler to create a stack pointer called C<sp>, and it
+B<xsubpp> compiler to create a stack pointer available as C<SP>, and it
is this pointer which is being used in the EXTEND() macro.
The values are then pushed onto the stack with the PUSHs()
macro.
@@ -572,6 +635,9 @@ the following statement.
($status, $timep) = rpcb_gettime("localhost");
+When handling output parameters with a PPCODE section, be sure to handle
+'set' magic properly. See L<perlguts> for details about 'set' magic.
+
=head2 Returning Undef And Empty Lists
Occasionally the programmer will want to return simply
@@ -584,7 +650,7 @@ of $timep will either be undef or it will be a valid time.
$timep = rpcb_gettime( "localhost" );
-The following XSUB uses the C<SV *> return type as a mneumonic only,
+The following XSUB uses the C<SV *> return type as a mnemonic only,
and uses a CODE: block to indicate to the compiler
that the programmer has supplied all the necessary code. The
sv_newmortal() call will initialize the return value to undef, making that
@@ -616,7 +682,7 @@ return value, should the need arise.
sv_setnv( ST(0), (double)timep);
}
else{
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
}
To return an empty list one must use a PPCODE: block and
@@ -721,9 +787,10 @@ prototypes.
PROTOTYPE: $;$
PREINIT:
char *host = "localhost";
+ STRLEN n_a;
CODE:
if( items > 1 )
- host = (char *)SvPV(ST(1), na);
+ host = (char *)SvPV(ST(1), n_a);
RETVAL = rpcb_gettime( host, &timep );
OUTPUT:
timep
@@ -731,7 +798,7 @@ prototypes.
=head2 The ALIAS: Keyword
-The ALIAS: keyword allows an XSUB to have two more unique Perl names
+The ALIAS: keyword allows an XSUB to have two or more unique Perl names
and to know which of those names was used when it was invoked. The Perl
names may be fully-qualified with package names. Each alias is given an
index. The compiler will setup a variable called C<ix> which contain the
@@ -753,6 +820,77 @@ C<BAR::getit()> for this function.
OUTPUT:
timep
+=head2 The INTERFACE: Keyword
+
+This keyword declares the current XSUB as a keeper of the given
+calling signature. If some text follows this keyword, it is
+considered as a list of functions which have this signature, and
+should be attached to XSUBs.
+
+Say, if you have 4 functions multiply(), divide(), add(), subtract() all
+having the signature
+
+ symbolic f(symbolic, symbolic);
+
+you code them all by using XSUB
+
+ symbolic
+ interface_s_ss(arg1, arg2)
+ symbolic arg1
+ symbolic arg2
+ INTERFACE:
+ multiply divide
+ add subtract
+
+The advantage of this approach comparing to ALIAS: keyword is that one
+can attach an extra function remainder() at runtime by using
+
+ CV *mycv = newXSproto("Symbolic::remainder",
+ XS_Symbolic_interface_s_ss, __FILE__, "$$");
+ XSINTERFACE_FUNC_SET(mycv, remainder);
+
+(This example supposes that there was no INTERFACE_MACRO: section,
+otherwise one needs to use something else instead of
+C<XSINTERFACE_FUNC_SET>.)
+
+=head2 The INTERFACE_MACRO: Keyword
+
+This keyword allows one to define an INTERFACE using a different way
+to extract a function pointer from an XSUB. The text which follows
+this keyword should give the name of macros which would extract/set a
+function pointer. The extractor macro is given return type, C<CV*>,
+and C<XSANY.any_dptr> for this C<CV*>. The setter macro is given cv,
+and the function pointer.
+
+The default value is C<XSINTERFACE_FUNC> and C<XSINTERFACE_FUNC_SET>.
+An INTERFACE keyword with an empty list of functions can be omitted if
+INTERFACE_MACRO keyword is used.
+
+Suppose that in the previous example functions pointers for
+multiply(), divide(), add(), subtract() are kept in a global C array
+C<fp[]> with offsets being C<multiply_off>, C<divide_off>, C<add_off>,
+C<subtract_off>. Then one can use
+
+ #define XSINTERFACE_FUNC_BYOFFSET(ret,cv,f) \
+ ((XSINTERFACE_CVT(ret,))fp[CvXSUBANY(cv).any_i32])
+ #define XSINTERFACE_FUNC_BYOFFSET_set(cv,f) \
+ CvXSUBANY(cv).any_i32 = CAT2( f, _off )
+
+in C section,
+
+ symbolic
+ interface_s_ss(arg1, arg2)
+ symbolic arg1
+ symbolic arg2
+ INTERFACE_MACRO:
+ XSINTERFACE_FUNC_BYOFFSET
+ XSINTERFACE_FUNC_BYOFFSET_set
+ INTERFACE:
+ multiply divide
+ add subtract
+
+in XSUB section.
+
=head2 The INCLUDE: Keyword
This keyword can be used to pull other files into the XS module. The other
@@ -1076,13 +1214,15 @@ getnetconfigent() XSUB and an object created by a normal Perl subroutine.
The typemap is a collection of code fragments which are used by the B<xsubpp>
compiler to map C function parameters and values to Perl values. The
typemap file may consist of three sections labeled C<TYPEMAP>, C<INPUT>, and
-C<OUTPUT>. The INPUT section tells the compiler how to translate Perl values
+C<OUTPUT>. Any unlabelled initial section is assumed to be a C<TYPEMAP>
+section if a name is not explicitly specified. The INPUT section tells
+the compiler how to translate Perl values
into variables of certain C types. The OUTPUT section tells the compiler
how to translate the values from certain C types into values Perl can
understand. The TYPEMAP section tells the compiler which of the INPUT and
OUTPUT code fragments should be used to map a given C type to a Perl value.
-Each of the sections of the typemap must be preceded by one of the TYPEMAP,
-INPUT, or OUTPUT keywords.
+The section labels C<TYPEMAP>, C<INPUT>, or C<OUTPUT> must begin
+in the first column on a line by themselves, and must be in uppercase.
The default typemap in the C<ext> directory of the Perl source contains many
useful types which can be used by Perl extensions. Some extensions define
diff --git a/gnu/usr.bin/perl/pod/perlxstut.pod b/gnu/usr.bin/perl/pod/perlxstut.pod
index 9ebfe82a97d..69a1a25d738 100644
--- a/gnu/usr.bin/perl/pod/perlxstut.pod
+++ b/gnu/usr.bin/perl/pod/perlxstut.pod
@@ -428,7 +428,7 @@ Let's now take a look at a portion of the .c file created for our extension.
} else {
arg = 0.0;
}
- sv_setnv(ST(0), (double)arg); /* XXXXX */
+ sv_setnv(ST(0), (double)arg); /* XXXXX */
}
XSRETURN(1);
}
@@ -465,7 +465,7 @@ include a C source file and a header file. We'll also create a Makefile.PL
in this directory. Then we'll make sure that running make at the Mytest2
level will automatically run this Makefile.PL file and the resulting Makefile.
-In the testlib directory, create a file mylib.h that looks like this:
+In the mylib directory, create a file mylib.h that looks like this:
#define TESTVAL 4
diff --git a/gnu/usr.bin/perl/pod/pod2html.PL b/gnu/usr.bin/perl/pod/pod2html.PL
index de36cd7fc93..366dc163bfc 100644
--- a/gnu/usr.bin/perl/pod/pod2html.PL
+++ b/gnu/usr.bin/perl/pod/pod2html.PL
@@ -2,6 +2,7 @@
use Config;
use File::Basename qw(&basename &dirname);
+use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
@@ -12,6 +13,7 @@ use File::Basename qw(&basename &dirname);
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
@@ -162,7 +164,7 @@ See L<Pod::Html> for a list of known bugs in the translator.
=head1 SEE ALSO
-L<perlpod>, L<Pod::HTML>
+L<perlpod>, L<Pod::Html>
=head1 COPYRIGHT
@@ -178,3 +180,4 @@ pod2html @ARGV;
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;
diff --git a/gnu/usr.bin/perl/pod/pod2latex.PL b/gnu/usr.bin/perl/pod/pod2latex.PL
index 3d0b55b32f9..feed98e923d 100644
--- a/gnu/usr.bin/perl/pod/pod2latex.PL
+++ b/gnu/usr.bin/perl/pod/pod2latex.PL
@@ -2,6 +2,7 @@
use Config;
use File::Basename qw(&basename &dirname);
+use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
@@ -12,6 +13,7 @@ use File::Basename qw(&basename &dirname);
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
@@ -472,6 +474,12 @@ while (<POD>) {
noindex:
;
}
+ elsif ($cmd eq 'pod') {
+ ; # recognise the pod directive, as no op (hs)
+ }
+ elsif ($cmd eq 'pod') {
+ ; # recognise the pod directive, as no op (hs)
+ }
else {
warn "Unrecognized directive: $cmd\n";
}
@@ -676,7 +684,7 @@ BEGIN {
"otilde" => "\\~{o}", # small o, tilde
"Ouml" => '\\"{O}', # capital O, dieresis or umlaut mark
"ouml" => '\\"{o}', # small o, dieresis or umlaut mark
- "szlig" => '\\ss', # small sharp s, German (sz ligature)
+ "szlig" => '\\ss{}', # small sharp s, German (sz ligature)
"THORN" => '\\L', # capital THORN, Icelandic
"thorn" => '\\l',, # small thorn, Icelandic
"Uacute" => "\\'{U}", # capital U, acute accent
@@ -697,3 +705,4 @@ BEGIN {
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;
diff --git a/gnu/usr.bin/perl/pod/pod2man.PL b/gnu/usr.bin/perl/pod/pod2man.PL
index 46f47a8870c..3c55d6e29c6 100644
--- a/gnu/usr.bin/perl/pod/pod2man.PL
+++ b/gnu/usr.bin/perl/pod/pod2man.PL
@@ -2,6 +2,7 @@
use Config;
use File::Basename qw(&basename &dirname);
+use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
@@ -13,6 +14,7 @@ use File::Basename qw(&basename &dirname);
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
@@ -315,9 +317,13 @@ $cutting = 1;
# We try first to get the version number from a local binary, in case we're
# running an installed version of Perl to produce documentation from an
# uninstalled newer version's pod files.
-if ($^O ne 'plan9') {
- ($version,$patch) =
- `\PATH=.:..:\$PATH; perl -v` =~ /version (\d\.\d{3})(?:_(\d{2}))?/;
+if ($^O ne 'plan9' and $^O ne 'dos' and $^O ne 'os2' and $^O ne 'MSWin32') {
+ my $perl = (-x './perl' && -f './perl' ) ?
+ './perl' :
+ ((-x '../perl' && -f '../perl') ?
+ '../perl' :
+ '');
+ ($version,$patch) = `$perl -e 'print $]'` =~ /^(\d\.\d{3})(\d{2})?/ if $perl;
}
# No luck; we'll just go with the running Perl's version
($version,$patch) = $] =~ /^(.{5})(\d{2})?/ unless $version;
@@ -329,6 +335,7 @@ sub makedate {
my $secs = shift;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs);
my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon];
+ $year += 1900;
return "$mday/$mname/$year";
}
@@ -415,8 +422,12 @@ $name =~ s-//+-/-g;
if ($name =~ s-^.*?/lib/[^/]*perl[^/]*/--i
or $name =~ s-^.*?/[^/]*perl[^/]*/lib/--i
or $name =~ s-^.*?/[^/]*perl[^/]*/--i) {
- # Lose ^arch/version/.
- $name =~ s-^[^/]+/\d+\.\d+/--;
+ # Lose ^site(_perl)?/.
+ $name =~ s-^site(_perl)?/--;
+ # Lose ^arch/. (XXX should we use Config? Just for archname?)
+ $name =~ s~^(.*-$^O|$^O-.*)/~~o;
+ # Lose ^version/.
+ $name =~ s-^\d+\.\d+/--;
}
# Translate Getopt/Long to Getopt::Long, etc.
@@ -667,6 +678,9 @@ $indent = 0;
$begun = "";
+# Unrolling [^A-Z>]|[A-Z](?!<) gives: // MRE pp 165.
+my $nonest = '(?:[^A-Z>]*(?:[A-Z](?!<)[^A-Z>]*)*)';
+
while (<>) {
if ($cutting) {
next unless /^=/;
@@ -736,7 +750,7 @@ while (<>) {
# first hide the escapes in case we need to
# intuit something and get it wrong due to fmting
- s/([A-Z]<[^<>]*>)/noremap($1)/ge;
+ 1 while s/([A-Z]<$nonest>)/noremap($1)/ge;
# func() is a reference to a perl function
s{
@@ -793,13 +807,16 @@ while (<>) {
while ($maxnest-- && /[A-Z]</) {
# can't do C font here
- s/([BI])<([^<>]*)>/font($1) . $2 . font('R')/eg;
+ s/([BI])<($nonest)>/font($1) . $2 . font('R')/eg;
# files and filelike refs in italics
- s/F<([^<>]*)>/I<$1>/g;
+ s/F<($nonest)>/I<$1>/g;
# no break -- usually we want C<> for this
- s/S<([^<>]*)>/nobreak($1)/eg;
+ s/S<($nonest)>/nobreak($1)/eg;
+
+ # LREF: a la HREF L<show this text|man/section>
+ s:L<([^|>]+)\|[^>]+>:$1:g;
# LREF: a manpage(3f)
s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g;
@@ -850,7 +867,7 @@ while (<>) {
s/Z<>/\\&/g;
# comes last because not subject to reprocessing
- s/C<([^<>]*)>/noremap("${CFont_embed}${1}\\fR")/eg;
+ s/C<($nonest)>/noremap("${CFont_embed}${1}\\fR")/eg;
}
if (s/^=//) {
@@ -1047,10 +1064,6 @@ sub mkindex {
my ($entry) = @_;
my @entries = split m:\s*/\s*:, $entry;
push @Indices, ".IX Xref " . join ' ', map {qq("$_")} @entries;
- for $entry (@entries) {
- print qq("$entry" );
- }
- print "\n";
return '';
}
@@ -1118,7 +1131,10 @@ sub internal_lrefs {
}
$retstr .= " entr" . ( @items > 1 ? "ies" : "y" )
- . " elsewhere in this document "; # terminal space to avoid words running together (pattern used strips terminal spaces)
+ . " elsewhere in this document";
+ # terminal space to avoid words running together (pattern used
+ # strips terminal spaces)
+ $retstr .= " " if length $trailing_and;
$retstr .= $trailing_and;
return $retstr;
@@ -1202,3 +1218,4 @@ BEGIN {
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;
diff --git a/gnu/usr.bin/perl/pod/pod2text.PL b/gnu/usr.bin/perl/pod/pod2text.PL
index da645b554ee..94516c39978 100644
--- a/gnu/usr.bin/perl/pod/pod2text.PL
+++ b/gnu/usr.bin/perl/pod/pod2text.PL
@@ -2,6 +2,7 @@
use Config;
use File::Basename qw(&basename &dirname);
+use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
@@ -12,6 +13,7 @@ use File::Basename qw(&basename &dirname);
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
@@ -46,3 +48,4 @@ if(@ARGV) {
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;
diff --git a/gnu/usr.bin/perl/pod/roffitall b/gnu/usr.bin/perl/pod/roffitall
index cbd19af4fed..9ab7f29bdeb 100644
--- a/gnu/usr.bin/perl/pod/roffitall
+++ b/gnu/usr.bin/perl/pod/roffitall
@@ -14,8 +14,8 @@ fi
mandir=$installman1dir
libdir=$installman3dir
-test -d $mandir || mandir=/usr/local/man/man1
-test -d $libdir || libdir=/usr/local/man/man3
+test -d $mandir || mandir=/usr/new/man/man1
+test -d $libdir || libdir=/usr/new/man/man3
case "$1" in
-nroff) cmd="nroff -man"; ext='txt';;
@@ -30,40 +30,47 @@ esac
toroff=`
echo \
$mandir/perl.1 \
- $mandir/perldelta.1 \
$mandir/perldata.1 \
$mandir/perlsyn.1 \
$mandir/perlop.1 \
$mandir/perlre.1 \
$mandir/perlrun.1 \
- $mandir/perllocale.1 \
$mandir/perlfunc.1 \
+ $mandir/perlopentut.1 \
$mandir/perlvar.1 \
$mandir/perlsub.1 \
$mandir/perlmod.1 \
$mandir/perlmodlib.1 \
+ $mandir/perlmodinstall.1 \
+ $mandir/perlform.1 \
+ $mandir/perllocale.1 \
$mandir/perlref.1 \
+ $mandir/perlreftut.1 \
$mandir/perldsc.1 \
$mandir/perllol.1 \
+ $mandir/perltoot.1 \
$mandir/perlobj.1 \
$mandir/perltie.1 \
- $mandir/perltoot.1 \
$mandir/perlbot.1 \
+ $mandir/perlipc.1 \
$mandir/perldebug.1 \
$mandir/perldiag.1 \
- $mandir/perlform.1 \
- $mandir/perlipc.1 \
$mandir/perlsec.1 \
$mandir/perltrap.1 \
+ $mandir/perlport.1 \
$mandir/perlstyle.1 \
+ $mandir/perlpod.1 \
+ $mandir/perlbook.1 \
+ $mandir/perlembed.1 \
$mandir/perlapio.1 \
$mandir/perlxs.1 \
$mandir/perlxstut.1 \
$mandir/perlguts.1 \
$mandir/perlcall.1 \
- $mandir/perlembed.1 \
- $mandir/perlpod.1 \
- $mandir/perlbook.1 \
+ $mandir/perlthrtut.1 \
+ $mandir/perlhist.1 \
+ $mandir/perldelta.1 \
+ $mandir/perl5004delta.1 \
$mandir/perlfaq.1 \
$mandir/perlfaq1.1 \
$mandir/perlfaq2.1 \
@@ -75,13 +82,33 @@ toroff=`
$mandir/perlfaq8.1 \
$mandir/perlfaq9.1 \
\
+ $mandir/a2p.1 \
+ $mandir/c2ph.1 \
+ $mandir/h2ph.1 \
+ $mandir/h2xs.1 \
+ $mandir/perlbug.1 \
+ $mandir/perldoc.1 \
+ $mandir/pl2pm.1 \
+ $mandir/pod2html.1 \
+ $mandir/pod2man.1 \
+ $mandir/s2p.1 \
+ $mandir/splain.1 \
+ $mandir/xsubpp.1 \
+ \
+ $libdir/attrs.3 \
+ $libdir/autouse.3 \
+ $libdir/base.3 \
$libdir/blib.3 \
+ $libdir/constant.3 \
$libdir/diagnostics.3 \
+ $libdir/fields.3 \
$libdir/integer.3 \
$libdir/less.3 \
$libdir/lib.3 \
$libdir/locale.3 \
+ $libdir/ops.3 \
$libdir/overload.3 \
+ $libdir/re.3 \
$libdir/sigtrap.3 \
$libdir/strict.3 \
$libdir/subs.3 \
@@ -90,34 +117,82 @@ toroff=`
$libdir/AnyDBM_File.3 \
$libdir/AutoLoader.3 \
$libdir/AutoSplit.3 \
+ $libdir/B.3 \
+ $libdir/B::Asmdata.3 \
+ $libdir/B::Assembler.3 \
+ $libdir/B::Bblock.3 \
+ $libdir/B::Bytecode.3 \
+ $libdir/B::C.3 \
+ $libdir/B::CC.3 \
+ $libdir/B::Debug.3 \
+ $libdir/B::Deparse.3 \
+ $libdir/B::Disassembler.3 \
+ $libdir/B::Lint.3 \
+ $libdir/B::Showlex.3 \
+ $libdir/B::Stackobj.3 \
+ $libdir/B::Terse.3 \
+ $libdir/B::Xref.3 \
$libdir/Benchmark.3 \
$libdir/Carp.3 \
+ $libdir/CGI.3 \
+ $libdir/CGI::Apache.3 \
+ $libdir/CGI::Carp.3 \
+ $libdir/CGI::Cookie.3 \
+ $libdir/CGI::Fast.3 \
+ $libdir/CGI::Push.3 \
+ $libdir/CGI::Switch.3 \
+ $libdir/Class::Struct.3 \
$libdir/Config.3 \
+ $libdir/CPAN.3 \
+ $libdir/CPAN::FirstTime.3 \
+ $libdir/CPAN::Nox.3 \
$libdir/Cwd.3 \
+ $libdir/Data::Dumper.3 \
$libdir/DB_File.3 \
$libdir/Devel::SelfStubber.3 \
+ $libdir/DirHandle.3 \
$libdir/DynaLoader.3 \
+ $libdir/Dumpvalue.3 \
$libdir/English.3 \
$libdir/Env.3 \
+ $libdir/Errno.3 \
$libdir/Exporter.3 \
+ $libdir/ExtUtils::Command.3 \
$libdir/ExtUtils::Embed.3 \
$libdir/ExtUtils::Install.3 \
+ $libdir/ExtUtils::Installed.3 \
$libdir/ExtUtils::Liblist.3 \
$libdir/ExtUtils::MakeMaker.3 \
$libdir/ExtUtils::Manifest.3 \
+ $libdir/ExtUtils::Miniperl.3 \
$libdir/ExtUtils::Mkbootstrap.3 \
$libdir/ExtUtils::Mksymlists.3 \
+ $libdir/ExtUtils::MM_OS2.3 \
+ $libdir/ExtUtils::MM_Unix.3 \
+ $libdir/ExtUtils::MM_VMS.3 \
+ $libdir/ExtUtils::MM_Win32.3 \
+ $libdir/ExtUtils::Packlist.3 \
+ $libdir/ExtUtils::testlib.3 \
+ $libdir/Fatal.3 \
$libdir/Fcntl.3 \
$libdir/File::Basename.3 \
$libdir/File::CheckTree.3 \
- $libdir/File::Copy.3 \
$libdir/File::Compare.3 \
+ $libdir/File::Copy.3 \
+ $libdir/File::DosGlob.3 \
$libdir/File::Find.3 \
$libdir/File::Path.3 \
+ $libdir/File::Spec.3 \
+ $libdir/File::Spec::Mac.3 \
+ $libdir/File::Spec::OS2.3 \
+ $libdir/File::Spec::Unix.3 \
+ $libdir/File::Spec::VMS.3 \
+ $libdir/File::Spec::Win32.3 \
$libdir/File::stat.3 \
$libdir/FileCache.3 \
$libdir/FileHandle.3 \
$libdir/FindBin.3 \
+ $libdir/GDBM_File.3 \
$libdir/Getopt::Long.3 \
$libdir/Getopt::Std.3 \
$libdir/I18N::Collate.3 \
@@ -128,21 +203,28 @@ toroff=`
$libdir/IO::Seekable.3 \
$libdir/IO::Select.3 \
$libdir/IO::Socket.3 \
+ $libdir/IPC::Msg.3 \
$libdir/IPC::Open2.3 \
$libdir/IPC::Open3.3 \
+ $libdir/IPC::Semaphore.3 \
+ $libdir/IPC::SysV.3 \
$libdir/Math::BigFloat.3 \
$libdir/Math::BigInt.3 \
$libdir/Math::Complex.3 \
$libdir/Math::Trig.3 \
- $libdir/Net::Ping.3 \
+ $libdir/NDBM_File.3 \
$libdir/Net::hostent.3 \
$libdir/Net::netent.3 \
+ $libdir/Net::Ping.3 \
$libdir/Net::protoent.3 \
$libdir/Net::servent.3 \
+ $libdir/O.3 \
$libdir/Opcode.3 \
- $libdir/POSIX.3 \
+ $libdir/Pod::Html.3 \
$libdir/Pod::Text.3 \
+ $libdir/POSIX.3 \
$libdir/Safe.3 \
+ $libdir/SDBM_File.3 \
$libdir/Search::Dict.3 \
$libdir/SelectSaver.3 \
$libdir/SelfLoader.3 \
@@ -153,49 +235,54 @@ toroff=`
$libdir/Sys::Syslog.3 \
$libdir/Term::Cap.3 \
$libdir/Term::Complete.3 \
+ $libdir/Term::ReadLine.3 \
+ $libdir/Test.3 \
$libdir/Test::Harness.3 \
$libdir/Text::Abbrev.3 \
$libdir/Text::ParseWords.3 \
$libdir/Text::Soundex.3 \
$libdir/Text::Tabs.3 \
+ $libdir/Text::Wrap.3 \
+ $libdir/Tie::Array.3 \
+ $libdir/Tie::Handle.3 \
$libdir/Tie::Hash.3 \
$libdir/Tie::RefHash.3 \
$libdir/Tie::Scalar.3 \
$libdir/Tie::SubstrHash.3 \
- $libdir/Time::Local.3 \
$libdir/Time::gmtime.3 \
+ $libdir/Time::Local.3 \
$libdir/Time::localtime.3 \
$libdir/Time::tm.3 \
$libdir/UNIVERSAL.3 \
$libdir/User::grent.3 \
$libdir/User::pwent.3 | \
-perl -ne 'map { -r && print "$_ " } split'`
+ perl -ne 'map { -r && print "$_ " } split'`
-# Bypass internal shell buffer limit -- can't use case
-if perl -e '$a = shift; exit($a =~ m|/|)' $toroff; then
+ # Bypass internal shell buffer limit -- can't use case
+ if perl -e '$a = shift; exit($a =~ m|/|)' $toroff; then
echo "$me: empty file list -- did you run install?" >&2
exit 1
-fi
+ fi
-#psroff -t -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.ps 2>$tmp/PerlTOC.raw
-#nroff -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.txt 2>$tmp/PerlTOC.nr.raw
+ #psroff -t -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.ps 2>$tmp/PerlTOC.raw
+ #nroff -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.txt 2>$tmp/PerlTOC.nr.raw
-# First, create the raw data
-run="$cmd -rC1 -rD1 -rF1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw"
-echo "$me: running $run"
-eval $run $toroff
+ # First, create the raw data
+ run="$cmd -rC1 -rD1 -rF1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw"
+ echo "$me: running $run"
+ eval $run $toroff
-#Now create the TOC
-echo "$me: parsing TOC"
-./rofftoc $tmp/PerlTOC.$ext.raw > $tmp/PerlTOC.tmp.man
-run="$cmd $tmp/PerlTOC.tmp.man >$tmp/PerlTOC.$ext"
-echo "$me: running $run"
-eval $run
+ #Now create the TOC
+ echo "$me: parsing TOC"
+ ./rofftoc $tmp/PerlTOC.$ext.raw > $tmp/PerlTOC.tmp.man
+ run="$cmd $tmp/PerlTOC.tmp.man >$tmp/PerlTOC.$ext"
+ echo "$me: running $run"
+ eval $run
-# Finally, recreate the Doc, without the blank page 0
-run="$cmd -rC1 -rD1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw"
-echo "$me: running $run"
-eval $run $toroff
-rm -f $tmp/PerlTOC.tmp.man $tmp/PerlTOC.$ext.raw
-echo "$me: leaving you with $tmp/PerlDoc.$ext and $tmp/PerlTOC.$ext"
+ # Finally, recreate the Doc, without the blank page 0
+ run="$cmd -rC1 -rD1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw"
+ echo "$me: running $run"
+ eval $run $toroff
+ rm -f $tmp/PerlTOC.tmp.man $tmp/PerlTOC.$ext.raw
+ echo "$me: leaving you with $tmp/PerlDoc.$ext and $tmp/PerlTOC.$ext"
diff --git a/gnu/usr.bin/perl/pp.c b/gnu/usr.bin/perl/pp.c
index 3513dda13d8..1f628867b1a 100644
--- a/gnu/usr.bin/perl/pp.c
+++ b/gnu/usr.bin/perl/pp.c
@@ -1,6 +1,6 @@
/* pp.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -46,7 +46,7 @@ typedef unsigned UBW;
* have an integral type (except char) small enough to be represented
* in a double without loss; that is, it has no 32-bit type.
*/
-#if BYTEORDER > 0xFFFF && defined(_CRAY) && !defined(_CRAYMPP)
+#if LONGSIZE > 4 && defined(_CRAY) && !defined(_CRAYMPP)
# define BW_BITS 32
# define BW_MASK ((1 << BW_BITS) - 1)
# define BW_SIGN (1 << (BW_BITS - 1))
@@ -69,7 +69,11 @@ typedef unsigned UBW;
* If they're not right on your machine, then pack() and unpack()
* wouldn't work right anyway; you'll need to apply the Cray hack.
* (I'd like to check them with #if, but you can't use sizeof() in
- * the preprocessor.)
+ * the preprocessor.) --???
+ */
+/*
+ The appropriate SHORTSIZE, INTSIZE, LONGSIZE, and LONGLONGSIZE
+ defines are now in config.h. --Andy Dougherty April 1998
*/
#define SIZE16 2
#define SIZE32 4
@@ -97,19 +101,33 @@ typedef unsigned UBW;
# define CAT32(sv,p) sv_catpvn(sv, (char*)(p), SIZE32)
#endif
+#ifndef PERL_OBJECT
static void doencodes _((SV* sv, char* s, I32 len));
static SV* refto _((SV* sv));
static U32 seed _((void));
-
static bool srand_called = FALSE;
+#endif
+
/* variations on pp_null */
+#ifdef I_UNISTD
+#include <unistd.h>
+#endif
+
+/* XXX I can't imagine anyone who doesn't have this actually _needs_
+ it, since pid_t is an integral type.
+ --AD 2/20/1998
+*/
+#ifdef NEED_GETPID_PROTO
+extern Pid_t getpid (void);
+#endif
+
PP(pp_stub)
{
- dSP;
+ djSP;
if (GIMME_V == G_SCALAR)
- XPUSHs(&sv_undef);
+ XPUSHs(&PL_sv_undef);
RETURN;
}
@@ -122,18 +140,27 @@ PP(pp_scalar)
PP(pp_padav)
{
- dSP; dTARGET;
- if (op->op_private & OPpLVAL_INTRO)
- SAVECLEARSV(curpad[op->op_targ]);
+ djSP; dTARGET;
+ if (PL_op->op_private & OPpLVAL_INTRO)
+ SAVECLEARSV(PL_curpad[PL_op->op_targ]);
EXTEND(SP, 1);
- if (op->op_flags & OPf_REF) {
+ if (PL_op->op_flags & OPf_REF) {
PUSHs(TARG);
RETURN;
}
if (GIMME == G_ARRAY) {
I32 maxarg = AvFILL((AV*)TARG) + 1;
EXTEND(SP, maxarg);
- Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
+ if (SvMAGICAL(TARG)) {
+ U32 i;
+ for (i=0; i < maxarg; i++) {
+ SV **svp = av_fetch((AV*)TARG, i, FALSE);
+ SP[i+1] = (svp) ? *svp : &PL_sv_undef;
+ }
+ }
+ else {
+ Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
+ }
SP += maxarg;
}
else {
@@ -147,13 +174,13 @@ PP(pp_padav)
PP(pp_padhv)
{
- dSP; dTARGET;
+ djSP; dTARGET;
I32 gimme;
XPUSHs(TARG);
- if (op->op_private & OPpLVAL_INTRO)
- SAVECLEARSV(curpad[op->op_targ]);
- if (op->op_flags & OPf_REF)
+ if (PL_op->op_private & OPpLVAL_INTRO)
+ SAVECLEARSV(PL_curpad[PL_op->op_targ]);
+ if (PL_op->op_flags & OPf_REF)
RETURN;
gimme = GIMME_V;
if (gimme == G_ARRAY) {
@@ -180,8 +207,8 @@ PP(pp_padany)
PP(pp_rv2gv)
{
- dSP; dTOPss;
-
+ djSP; dTOPss;
+
if (SvROK(sv)) {
wasref:
sv = SvRV(sv);
@@ -197,6 +224,7 @@ PP(pp_rv2gv)
else {
if (SvTYPE(sv) != SVt_PVGV) {
char *sym;
+ STRLEN n_a;
if (SvGMAGICAL(sv)) {
mg_get(sv);
@@ -204,28 +232,28 @@ PP(pp_rv2gv)
goto wasref;
}
if (!SvOK(sv)) {
- if (op->op_flags & OPf_REF ||
- op->op_private & HINT_STRICT_REFS)
+ if (PL_op->op_flags & OPf_REF ||
+ PL_op->op_private & HINT_STRICT_REFS)
DIE(no_usym, "a symbol");
- if (dowarn)
+ if (PL_dowarn)
warn(warn_uninit);
RETSETUNDEF;
}
- sym = SvPV(sv, na);
- if (op->op_private & HINT_STRICT_REFS)
+ sym = SvPV(sv, n_a);
+ if (PL_op->op_private & HINT_STRICT_REFS)
DIE(no_symref, sym, "a symbol");
sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
}
}
- if (op->op_private & OPpLVAL_INTRO)
- save_gp((GV*)sv, !(op->op_flags & OPf_SPECIAL));
+ if (PL_op->op_private & OPpLVAL_INTRO)
+ save_gp((GV*)sv, !(PL_op->op_flags & OPf_SPECIAL));
SETs(sv);
RETURN;
}
PP(pp_rv2sv)
{
- dSP; dTOPss;
+ djSP; dTOPss;
if (SvROK(sv)) {
wasref:
@@ -240,6 +268,7 @@ PP(pp_rv2sv)
else {
GV *gv = (GV*)sv;
char *sym;
+ STRLEN n_a;
if (SvTYPE(gv) != SVt_PVGV) {
if (SvGMAGICAL(sv)) {
@@ -248,25 +277,25 @@ PP(pp_rv2sv)
goto wasref;
}
if (!SvOK(sv)) {
- if (op->op_flags & OPf_REF ||
- op->op_private & HINT_STRICT_REFS)
+ if (PL_op->op_flags & OPf_REF ||
+ PL_op->op_private & HINT_STRICT_REFS)
DIE(no_usym, "a SCALAR");
- if (dowarn)
+ if (PL_dowarn)
warn(warn_uninit);
RETSETUNDEF;
}
- sym = SvPV(sv, na);
- if (op->op_private & HINT_STRICT_REFS)
+ sym = SvPV(sv, n_a);
+ if (PL_op->op_private & HINT_STRICT_REFS)
DIE(no_symref, sym, "a SCALAR");
gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
}
sv = GvSV(gv);
}
- if (op->op_flags & OPf_MOD) {
- if (op->op_private & OPpLVAL_INTRO)
+ if (PL_op->op_flags & OPf_MOD) {
+ if (PL_op->op_private & OPpLVAL_INTRO)
sv = save_scalar((GV*)TOPs);
- else if (op->op_private & OPpDEREF)
- vivify_ref(sv, op->op_private & OPpDEREF);
+ else if (PL_op->op_private & OPpDEREF)
+ vivify_ref(sv, PL_op->op_private & OPpDEREF);
}
SETs(sv);
RETURN;
@@ -274,7 +303,7 @@ PP(pp_rv2sv)
PP(pp_av2arylen)
{
- dSP;
+ djSP;
AV *av = (AV*)TOPs;
SV *sv = AvARYLEN(av);
if (!sv) {
@@ -288,26 +317,30 @@ PP(pp_av2arylen)
PP(pp_pos)
{
- dSP; dTARGET; dPOPss;
-
- if (op->op_flags & OPf_MOD) {
+ djSP; dTARGET; dPOPss;
+
+ if (PL_op->op_flags & OPf_MOD) {
if (SvTYPE(TARG) < SVt_PVLV) {
sv_upgrade(TARG, SVt_PVLV);
sv_magic(TARG, Nullsv, '.', Nullch, 0);
}
LvTYPE(TARG) = '.';
- LvTARG(TARG) = sv;
+ if (LvTARG(TARG) != sv) {
+ if (LvTARG(TARG))
+ SvREFCNT_dec(LvTARG(TARG));
+ LvTARG(TARG) = SvREFCNT_inc(sv);
+ }
PUSHs(TARG); /* no SvSETMAGIC */
RETURN;
}
else {
- MAGIC* mg;
+ MAGIC* mg;
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
mg = mg_find(sv, 'g');
if (mg && mg->mg_len >= 0) {
- PUSHi(mg->mg_len + curcop->cop_arybase);
+ PUSHi(mg->mg_len + PL_curcop->cop_arybase);
RETURN;
}
}
@@ -317,43 +350,88 @@ PP(pp_pos)
PP(pp_rv2cv)
{
- dSP;
+ djSP;
GV *gv;
HV *stash;
/* We usually try to add a non-existent subroutine in case of AUTOLOAD. */
/* (But not in defined().) */
- CV *cv = sv_2cv(TOPs, &stash, &gv, !(op->op_flags & OPf_SPECIAL));
+ CV *cv = sv_2cv(TOPs, &stash, &gv, !(PL_op->op_flags & OPf_SPECIAL));
if (cv) {
if (CvCLONE(cv))
cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
}
else
- cv = (CV*)&sv_undef;
+ cv = (CV*)&PL_sv_undef;
SETs((SV*)cv);
RETURN;
}
PP(pp_prototype)
{
- dSP;
+ djSP;
CV *cv;
HV *stash;
GV *gv;
SV *ret;
- ret = &sv_undef;
+ ret = &PL_sv_undef;
+ if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
+ char *s = SvPVX(TOPs);
+ if (strnEQ(s, "CORE::", 6)) {
+ int code;
+
+ code = keyword(s + 6, SvCUR(TOPs) - 6);
+ if (code < 0) { /* Overridable. */
+#define MAX_ARGS_OP ((sizeof(I32) - 1) * 2)
+ int i = 0, n = 0, seen_question = 0;
+ I32 oa;
+ char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */
+
+ while (i < MAXO) { /* The slow way. */
+ if (strEQ(s + 6, op_name[i]) || strEQ(s + 6, op_desc[i]))
+ goto found;
+ i++;
+ }
+ goto nonesuch; /* Should not happen... */
+ found:
+ oa = opargs[i] >> OASHIFT;
+ while (oa) {
+ if (oa & OA_OPTIONAL) {
+ seen_question = 1;
+ str[n++] = ';';
+ } else if (seen_question)
+ goto set; /* XXXX system, exec */
+ if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF
+ && (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) {
+ str[n++] = '\\';
+ }
+ /* What to do with R ((un)tie, tied, (sys)read, recv)? */
+ str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)];
+ oa = oa >> 4;
+ }
+ str[n++] = '\0';
+ ret = sv_2mortal(newSVpv(str, n - 1));
+ } else if (code) /* Non-Overridable */
+ goto set;
+ else { /* None such */
+ nonesuch:
+ croak("Cannot find an opnumber for \"%s\"", s+6);
+ }
+ }
+ }
cv = sv_2cv(TOPs, &stash, &gv, FALSE);
if (cv && SvPOK(cv))
ret = sv_2mortal(newSVpv(SvPVX(cv), SvCUR(cv)));
+ set:
SETs(ret);
RETURN;
}
PP(pp_anoncode)
{
- dSP;
- CV* cv = (CV*)curpad[op->op_targ];
+ djSP;
+ CV* cv = (CV*)PL_curpad[PL_op->op_targ];
if (CvCLONE(cv))
cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
EXTEND(SP,1);
@@ -363,17 +441,22 @@ PP(pp_anoncode)
PP(pp_srefgen)
{
- dSP;
+ djSP;
*SP = refto(*SP);
RETURN;
-}
+}
PP(pp_refgen)
{
- dSP; dMARK;
+ djSP; dMARK;
if (GIMME != G_ARRAY) {
- MARK[1] = *SP;
- SP = MARK + 1;
+ if (++MARK <= SP)
+ *MARK = *SP;
+ else
+ *MARK = &PL_sv_undef;
+ *MARK = refto(*MARK);
+ SP = MARK;
+ RETURN;
}
EXTEND_MORTAL(SP - MARK);
while (++MARK <= SP)
@@ -381,9 +464,8 @@ PP(pp_refgen)
RETURN;
}
-static SV*
-refto(sv)
-SV* sv;
+STATIC SV*
+refto(SV *sv)
{
SV* rv;
@@ -391,7 +473,7 @@ SV* sv;
if (LvTARGLEN(sv))
vivify_defelem(sv);
if (!(sv = LvTARG(sv)))
- sv = &sv_undef;
+ sv = &PL_sv_undef;
}
else if (SvPADTMP(sv))
sv = newSVsv(sv);
@@ -408,14 +490,14 @@ SV* sv;
PP(pp_ref)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SV *sv;
char *pv;
sv = POPs;
if (sv && SvGMAGICAL(sv))
- mg_get(sv);
+ mg_get(sv);
if (!sv || !SvROK(sv))
RETPUSHNO;
@@ -428,13 +510,19 @@ PP(pp_ref)
PP(pp_bless)
{
- dSP;
+ djSP;
HV *stash;
if (MAXARG == 1)
- stash = curcop->cop_stash;
- else
- stash = gv_stashsv(POPs, TRUE);
+ stash = PL_curcop->cop_stash;
+ else {
+ SV *ssv = POPs;
+ STRLEN len;
+ char *ptr = SvPV(ssv,len);
+ if (PL_dowarn && len == 0)
+ warn("Explicit blessing to '' (assuming package main)");
+ stash = gv_stashpvn(ptr, len, TRUE);
+ }
(void)sv_bless(TOPs, stash);
RETURN;
@@ -444,40 +532,41 @@ PP(pp_gelem)
{
GV *gv;
SV *sv;
- SV *ref;
+ SV *tmpRef;
char *elem;
- dSP;
+ djSP;
+ STRLEN n_a;
sv = POPs;
- elem = SvPV(sv, na);
+ elem = SvPV(sv, n_a);
gv = (GV*)POPs;
- ref = Nullsv;
+ tmpRef = Nullsv;
sv = Nullsv;
switch (elem ? *elem : '\0')
{
case 'A':
if (strEQ(elem, "ARRAY"))
- ref = (SV*)GvAV(gv);
+ tmpRef = (SV*)GvAV(gv);
break;
case 'C':
if (strEQ(elem, "CODE"))
- ref = (SV*)GvCVu(gv);
+ tmpRef = (SV*)GvCVu(gv);
break;
case 'F':
if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */
- ref = (SV*)GvIOp(gv);
+ tmpRef = (SV*)GvIOp(gv);
break;
case 'G':
if (strEQ(elem, "GLOB"))
- ref = (SV*)gv;
+ tmpRef = (SV*)gv;
break;
case 'H':
if (strEQ(elem, "HASH"))
- ref = (SV*)GvHV(gv);
+ tmpRef = (SV*)GvHV(gv);
break;
case 'I':
if (strEQ(elem, "IO"))
- ref = (SV*)GvIOp(gv);
+ tmpRef = (SV*)GvIOp(gv);
break;
case 'N':
if (strEQ(elem, "NAME"))
@@ -489,15 +578,15 @@ PP(pp_gelem)
break;
case 'S':
if (strEQ(elem, "SCALAR"))
- ref = GvSV(gv);
+ tmpRef = GvSV(gv);
break;
}
- if (ref)
- sv = newRV(ref);
+ if (tmpRef)
+ sv = newRV(tmpRef);
if (sv)
sv_2mortal(sv);
else
- sv = &sv_undef;
+ sv = &PL_sv_undef;
XPUSHs(sv);
RETURN;
}
@@ -506,7 +595,8 @@ PP(pp_gelem)
PP(pp_study)
{
- dSP; dPOPss;
+ djSP; dPOPss;
+ register UNOP *unop = cUNOP;
register unsigned char *s;
register I32 pos;
register I32 ch;
@@ -514,36 +604,36 @@ PP(pp_study)
register I32 *snext;
STRLEN len;
- if (sv == lastscream) {
+ if (sv == PL_lastscream) {
if (SvSCREAM(sv))
RETPUSHYES;
}
else {
- if (lastscream) {
- SvSCREAM_off(lastscream);
- SvREFCNT_dec(lastscream);
+ if (PL_lastscream) {
+ SvSCREAM_off(PL_lastscream);
+ SvREFCNT_dec(PL_lastscream);
}
- lastscream = SvREFCNT_inc(sv);
+ PL_lastscream = SvREFCNT_inc(sv);
}
s = (unsigned char*)(SvPV(sv, len));
pos = len;
if (pos <= 0)
RETPUSHNO;
- if (pos > maxscream) {
- if (maxscream < 0) {
- maxscream = pos + 80;
- New(301, screamfirst, 256, I32);
- New(302, screamnext, maxscream, I32);
+ if (pos > PL_maxscream) {
+ if (PL_maxscream < 0) {
+ PL_maxscream = pos + 80;
+ New(301, PL_screamfirst, 256, I32);
+ New(302, PL_screamnext, PL_maxscream, I32);
}
else {
- maxscream = pos + pos / 4;
- Renew(screamnext, maxscream, I32);
+ PL_maxscream = pos + pos / 4;
+ Renew(PL_screamnext, PL_maxscream, I32);
}
}
- sfirst = screamfirst;
- snext = screamnext;
+ sfirst = PL_screamfirst;
+ snext = PL_screamnext;
if (!sfirst || !snext)
DIE("do_study: out of memory");
@@ -568,17 +658,17 @@ PP(pp_study)
PP(pp_trans)
{
- dSP; dTARG;
+ djSP; dTARG;
SV *sv;
- if (op->op_flags & OPf_STACKED)
+ if (PL_op->op_flags & OPf_STACKED)
sv = POPs;
else {
- sv = GvSV(defgv);
+ sv = DEFSV;
EXTEND(SP,1);
}
TARG = sv_newmortal();
- PUSHi(do_trans(sv, op));
+ PUSHi(do_trans(sv, PL_op));
RETURN;
}
@@ -586,7 +676,7 @@ PP(pp_trans)
PP(pp_schop)
{
- dSP; dTARGET;
+ djSP; dTARGET;
do_chop(TARG, TOPs);
SETTARG;
RETURN;
@@ -594,7 +684,7 @@ PP(pp_schop)
PP(pp_chop)
{
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
while (SP > MARK)
do_chop(TARG, POPs);
PUSHTARG;
@@ -603,16 +693,16 @@ PP(pp_chop)
PP(pp_schomp)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SETi(do_chomp(TOPs));
RETURN;
}
PP(pp_chomp)
{
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
register I32 count = 0;
-
+
while (SP > MARK)
count += do_chomp(POPs);
PUSHi(count);
@@ -621,7 +711,7 @@ PP(pp_chomp)
PP(pp_defined)
{
- dSP;
+ djSP;
register SV* sv;
sv = POPs;
@@ -629,11 +719,11 @@ PP(pp_defined)
RETPUSHNO;
switch (SvTYPE(sv)) {
case SVt_PVAV:
- if (AvMAX(sv) >= 0 || SvGMAGICAL(sv))
+ if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P')))
RETPUSHYES;
break;
case SVt_PVHV:
- if (HvARRAY(sv) || SvGMAGICAL(sv))
+ if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P')))
RETPUSHYES;
break;
case SVt_PVCV:
@@ -651,10 +741,10 @@ PP(pp_defined)
PP(pp_undef)
{
- dSP;
+ djSP;
SV *sv;
- if (!op->op_private) {
+ if (!PL_op->op_private) {
EXTEND(SP, 1);
RETPUSHUNDEF;
}
@@ -664,8 +754,11 @@ PP(pp_undef)
RETPUSHUNDEF;
if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv))
- RETPUSHUNDEF;
+ if (SvREADONLY(sv)) {
+ dTHR;
+ if (PL_curcop != &PL_compiling)
+ croak(no_modify);
+ }
if (SvROK(sv))
sv_unref(sv);
}
@@ -680,7 +773,7 @@ PP(pp_undef)
hv_undef((HV*)sv);
break;
case SVt_PVCV:
- if (cv_const_sv((CV*)sv))
+ if (PL_dowarn && cv_const_sv((CV*)sv))
warn("Constant subroutine %s undefined",
CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
/* FALL THROUGH */
@@ -691,7 +784,17 @@ PP(pp_undef)
break;
case SVt_PVGV:
if (SvFAKE(sv))
- sv_setsv(sv, &sv_undef);
+ SvSetMagicSV(sv, &PL_sv_undef);
+ else {
+ GP *gp;
+ gp_free((GV*)sv);
+ Newz(602, gp, 1, GP);
+ GvGP(sv) = gp_ref(gp);
+ GvSV(sv) = NEWSV(72,0);
+ GvLINE(sv) = PL_curcop->cop_line;
+ GvEGV(sv) = (GV*)sv;
+ GvMULTI_on(sv);
+ }
break;
default:
if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) {
@@ -709,7 +812,7 @@ PP(pp_undef)
PP(pp_predec)
{
- dSP;
+ djSP;
if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
croak(no_modify);
if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
@@ -726,7 +829,7 @@ PP(pp_predec)
PP(pp_postinc)
{
- dSP; dTARGET;
+ djSP; dTARGET;
if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
croak(no_modify);
sv_setsv(TARG, TOPs);
@@ -747,7 +850,7 @@ PP(pp_postinc)
PP(pp_postdec)
{
- dSP; dTARGET;
+ djSP; dTARGET;
if(SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
croak(no_modify);
sv_setsv(TARG, TOPs);
@@ -768,7 +871,7 @@ PP(pp_postdec)
PP(pp_pow)
{
- dSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
{
dPOPTOPnnrl;
SETn( pow( left, right) );
@@ -778,7 +881,7 @@ PP(pp_pow)
PP(pp_multiply)
{
- dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
{
dPOPTOPnnrl;
SETn( left * right );
@@ -788,7 +891,7 @@ PP(pp_multiply)
PP(pp_divide)
{
- dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(div,opASSIGN);
{
dPOPPOPnnrl;
double value;
@@ -816,7 +919,7 @@ PP(pp_divide)
PP(pp_modulo)
{
- dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
UV left;
UV right;
@@ -851,8 +954,8 @@ PP(pp_modulo)
if (right_neg) {
/* XXX may warn: unary minus operator applied to unsigned type */
/* could change -foo to be (~foo)+1 instead */
- if (ans <= -(UV)IV_MAX)
- sv_setiv(TARG, (IV) -ans);
+ if (ans <= ~((UV)IV_MAX)+1)
+ sv_setiv(TARG, ~ans+1);
else
sv_setnv(TARG, -(double)ans);
}
@@ -865,10 +968,10 @@ PP(pp_modulo)
PP(pp_repeat)
{
- dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
{
register I32 count = POPi;
- if (GIMME == G_ARRAY && op->op_private & OPpREPEAT_DOLIST) {
+ if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
dMARK;
I32 items = SP - MARK;
I32 max;
@@ -895,7 +998,7 @@ PP(pp_repeat)
tmpstr = POPs;
if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) {
- if (SvREADONLY(tmpstr) && curcop != &compiling)
+ if (SvREADONLY(tmpstr) && PL_curcop != &PL_compiling)
DIE("Can't x= to readonly value");
if (SvROK(tmpstr))
sv_unref(tmpstr);
@@ -921,7 +1024,7 @@ PP(pp_repeat)
PP(pp_subtract)
{
- dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
{
dPOPTOPnnrl_ul;
SETn( left - right );
@@ -931,10 +1034,10 @@ PP(pp_subtract)
PP(pp_left_shift)
{
- dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
{
IBW shift = POPi;
- if (op->op_private & HINT_INTEGER) {
+ if (PL_op->op_private & HINT_INTEGER) {
IBW i = TOPi;
i = BWi(i) << shift;
SETi(BWi(i));
@@ -950,10 +1053,10 @@ PP(pp_left_shift)
PP(pp_right_shift)
{
- dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
{
IBW shift = POPi;
- if (op->op_private & HINT_INTEGER) {
+ if (PL_op->op_private & HINT_INTEGER) {
IBW i = TOPi;
i = BWi(i) >> shift;
SETi(BWi(i));
@@ -969,7 +1072,7 @@ PP(pp_right_shift)
PP(pp_lt)
{
- dSP; tryAMAGICbinSET(lt,0);
+ djSP; tryAMAGICbinSET(lt,0);
{
dPOPnv;
SETs(boolSV(TOPn < value));
@@ -979,7 +1082,7 @@ PP(pp_lt)
PP(pp_gt)
{
- dSP; tryAMAGICbinSET(gt,0);
+ djSP; tryAMAGICbinSET(gt,0);
{
dPOPnv;
SETs(boolSV(TOPn > value));
@@ -989,7 +1092,7 @@ PP(pp_gt)
PP(pp_le)
{
- dSP; tryAMAGICbinSET(le,0);
+ djSP; tryAMAGICbinSET(le,0);
{
dPOPnv;
SETs(boolSV(TOPn <= value));
@@ -999,7 +1102,7 @@ PP(pp_le)
PP(pp_ge)
{
- dSP; tryAMAGICbinSET(ge,0);
+ djSP; tryAMAGICbinSET(ge,0);
{
dPOPnv;
SETs(boolSV(TOPn >= value));
@@ -1009,7 +1112,7 @@ PP(pp_ge)
PP(pp_ne)
{
- dSP; tryAMAGICbinSET(ne,0);
+ djSP; tryAMAGICbinSET(ne,0);
{
dPOPnv;
SETs(boolSV(TOPn != value));
@@ -1019,7 +1122,7 @@ PP(pp_ne)
PP(pp_ncmp)
{
- dSP; dTARGET; tryAMAGICbin(ncmp,0);
+ djSP; dTARGET; tryAMAGICbin(ncmp,0);
{
dPOPTOPnnrl;
I32 value;
@@ -1031,7 +1134,7 @@ PP(pp_ncmp)
else if (left > right)
value = 1;
else {
- SETs(&sv_undef);
+ SETs(&PL_sv_undef);
RETURN;
}
SETi(value);
@@ -1041,10 +1144,10 @@ PP(pp_ncmp)
PP(pp_slt)
{
- dSP; tryAMAGICbinSET(slt,0);
+ djSP; tryAMAGICbinSET(slt,0);
{
dPOPTOPssrl;
- int cmp = ((op->op_private & OPpLOCALE)
+ int cmp = ((PL_op->op_private & OPpLOCALE)
? sv_cmp_locale(left, right)
: sv_cmp(left, right));
SETs(boolSV(cmp < 0));
@@ -1054,10 +1157,10 @@ PP(pp_slt)
PP(pp_sgt)
{
- dSP; tryAMAGICbinSET(sgt,0);
+ djSP; tryAMAGICbinSET(sgt,0);
{
dPOPTOPssrl;
- int cmp = ((op->op_private & OPpLOCALE)
+ int cmp = ((PL_op->op_private & OPpLOCALE)
? sv_cmp_locale(left, right)
: sv_cmp(left, right));
SETs(boolSV(cmp > 0));
@@ -1067,10 +1170,10 @@ PP(pp_sgt)
PP(pp_sle)
{
- dSP; tryAMAGICbinSET(sle,0);
+ djSP; tryAMAGICbinSET(sle,0);
{
dPOPTOPssrl;
- int cmp = ((op->op_private & OPpLOCALE)
+ int cmp = ((PL_op->op_private & OPpLOCALE)
? sv_cmp_locale(left, right)
: sv_cmp(left, right));
SETs(boolSV(cmp <= 0));
@@ -1080,10 +1183,10 @@ PP(pp_sle)
PP(pp_sge)
{
- dSP; tryAMAGICbinSET(sge,0);
+ djSP; tryAMAGICbinSET(sge,0);
{
dPOPTOPssrl;
- int cmp = ((op->op_private & OPpLOCALE)
+ int cmp = ((PL_op->op_private & OPpLOCALE)
? sv_cmp_locale(left, right)
: sv_cmp(left, right));
SETs(boolSV(cmp >= 0));
@@ -1093,7 +1196,7 @@ PP(pp_sge)
PP(pp_seq)
{
- dSP; tryAMAGICbinSET(seq,0);
+ djSP; tryAMAGICbinSET(seq,0);
{
dPOPTOPssrl;
SETs(boolSV(sv_eq(left, right)));
@@ -1103,7 +1206,7 @@ PP(pp_seq)
PP(pp_sne)
{
- dSP; tryAMAGICbinSET(sne,0);
+ djSP; tryAMAGICbinSET(sne,0);
{
dPOPTOPssrl;
SETs(boolSV(!sv_eq(left, right)));
@@ -1113,10 +1216,10 @@ PP(pp_sne)
PP(pp_scmp)
{
- dSP; dTARGET; tryAMAGICbin(scmp,0);
+ djSP; dTARGET; tryAMAGICbin(scmp,0);
{
dPOPTOPssrl;
- int cmp = ((op->op_private & OPpLOCALE)
+ int cmp = ((PL_op->op_private & OPpLOCALE)
? sv_cmp_locale(left, right)
: sv_cmp(left, right));
SETi( cmp );
@@ -1126,21 +1229,21 @@ PP(pp_scmp)
PP(pp_bit_and)
{
- dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(band,opASSIGN);
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
- if (op->op_private & HINT_INTEGER) {
- IBW value = SvIV(left) & SvIV(right);
+ if (PL_op->op_private & HINT_INTEGER) {
+ IBW value = SvIV(left) & SvIV(right);
SETi(BWi(value));
}
else {
- UBW value = SvUV(left) & SvUV(right);
+ UBW value = SvUV(left) & SvUV(right);
SETu(BWu(value));
}
}
else {
- do_vop(op->op_type, TARG, left, right);
+ do_vop(PL_op->op_type, TARG, left, right);
SETTARG;
}
RETURN;
@@ -1149,21 +1252,21 @@ PP(pp_bit_and)
PP(pp_bit_xor)
{
- dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
- if (op->op_private & HINT_INTEGER) {
- IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
+ if (PL_op->op_private & HINT_INTEGER) {
+ IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
SETi(BWi(value));
}
else {
- UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
+ UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
SETu(BWu(value));
}
}
else {
- do_vop(op->op_type, TARG, left, right);
+ do_vop(PL_op->op_type, TARG, left, right);
SETTARG;
}
RETURN;
@@ -1172,21 +1275,21 @@ PP(pp_bit_xor)
PP(pp_bit_or)
{
- dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
- if (op->op_private & HINT_INTEGER) {
- IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
+ if (PL_op->op_private & HINT_INTEGER) {
+ IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
SETi(BWi(value));
}
else {
- UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
+ UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
SETu(BWu(value));
}
}
else {
- do_vop(op->op_type, TARG, left, right);
+ do_vop(PL_op->op_type, TARG, left, right);
SETTARG;
}
RETURN;
@@ -1195,7 +1298,7 @@ PP(pp_bit_or)
PP(pp_negate)
{
- dSP; dTARGET; tryAMAGICun(neg);
+ djSP; dTARGET; tryAMAGICun(neg);
{
dTOPss;
if (SvGMAGICAL(sv))
@@ -1228,19 +1331,19 @@ PP(pp_negate)
PP(pp_not)
{
#ifdef OVERLOAD
- dSP; tryAMAGICunSET(not);
+ djSP; tryAMAGICunSET(not);
#endif /* OVERLOAD */
- *stack_sp = boolSV(!SvTRUE(*stack_sp));
+ *PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp));
return NORMAL;
}
PP(pp_complement)
{
- dSP; dTARGET; tryAMAGICun(compl);
+ djSP; dTARGET; tryAMAGICun(compl);
{
dTOPss;
if (SvNIOKp(sv)) {
- if (op->op_private & HINT_INTEGER) {
+ if (PL_op->op_private & HINT_INTEGER) {
IBW value = ~SvIV(sv);
SETi(BWi(value));
}
@@ -1279,7 +1382,7 @@ PP(pp_complement)
PP(pp_i_multiply)
{
- dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
{
dPOPTOPiirl;
SETi( left * right );
@@ -1289,7 +1392,7 @@ PP(pp_i_multiply)
PP(pp_i_divide)
{
- dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(div,opASSIGN);
{
dPOPiv;
if (value == 0)
@@ -1302,7 +1405,7 @@ PP(pp_i_divide)
PP(pp_i_modulo)
{
- dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
dPOPTOPiirl;
if (!right)
@@ -1314,7 +1417,7 @@ PP(pp_i_modulo)
PP(pp_i_add)
{
- dSP; dATARGET; tryAMAGICbin(add,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(add,opASSIGN);
{
dPOPTOPiirl;
SETi( left + right );
@@ -1324,7 +1427,7 @@ PP(pp_i_add)
PP(pp_i_subtract)
{
- dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
{
dPOPTOPiirl;
SETi( left - right );
@@ -1334,7 +1437,7 @@ PP(pp_i_subtract)
PP(pp_i_lt)
{
- dSP; tryAMAGICbinSET(lt,0);
+ djSP; tryAMAGICbinSET(lt,0);
{
dPOPTOPiirl;
SETs(boolSV(left < right));
@@ -1344,7 +1447,7 @@ PP(pp_i_lt)
PP(pp_i_gt)
{
- dSP; tryAMAGICbinSET(gt,0);
+ djSP; tryAMAGICbinSET(gt,0);
{
dPOPTOPiirl;
SETs(boolSV(left > right));
@@ -1354,7 +1457,7 @@ PP(pp_i_gt)
PP(pp_i_le)
{
- dSP; tryAMAGICbinSET(le,0);
+ djSP; tryAMAGICbinSET(le,0);
{
dPOPTOPiirl;
SETs(boolSV(left <= right));
@@ -1364,7 +1467,7 @@ PP(pp_i_le)
PP(pp_i_ge)
{
- dSP; tryAMAGICbinSET(ge,0);
+ djSP; tryAMAGICbinSET(ge,0);
{
dPOPTOPiirl;
SETs(boolSV(left >= right));
@@ -1374,7 +1477,7 @@ PP(pp_i_ge)
PP(pp_i_eq)
{
- dSP; tryAMAGICbinSET(eq,0);
+ djSP; tryAMAGICbinSET(eq,0);
{
dPOPTOPiirl;
SETs(boolSV(left == right));
@@ -1384,7 +1487,7 @@ PP(pp_i_eq)
PP(pp_i_ne)
{
- dSP; tryAMAGICbinSET(ne,0);
+ djSP; tryAMAGICbinSET(ne,0);
{
dPOPTOPiirl;
SETs(boolSV(left != right));
@@ -1394,7 +1497,7 @@ PP(pp_i_ne)
PP(pp_i_ncmp)
{
- dSP; dTARGET; tryAMAGICbin(ncmp,0);
+ djSP; dTARGET; tryAMAGICbin(ncmp,0);
{
dPOPTOPiirl;
I32 value;
@@ -1412,7 +1515,7 @@ PP(pp_i_ncmp)
PP(pp_i_negate)
{
- dSP; dTARGET; tryAMAGICun(neg);
+ djSP; dTARGET; tryAMAGICun(neg);
SETi(-TOPi);
RETURN;
}
@@ -1421,7 +1524,7 @@ PP(pp_i_negate)
PP(pp_atan2)
{
- dSP; dTARGET; tryAMAGICbin(atan2,0);
+ djSP; dTARGET; tryAMAGICbin(atan2,0);
{
dPOPTOPnnrl;
SETn(atan2(left, right));
@@ -1431,7 +1534,7 @@ PP(pp_atan2)
PP(pp_sin)
{
- dSP; dTARGET; tryAMAGICun(sin);
+ djSP; dTARGET; tryAMAGICun(sin);
{
double value;
value = POPn;
@@ -1443,7 +1546,7 @@ PP(pp_sin)
PP(pp_cos)
{
- dSP; dTARGET; tryAMAGICun(cos);
+ djSP; dTARGET; tryAMAGICun(cos);
{
double value;
value = POPn;
@@ -1453,9 +1556,22 @@ PP(pp_cos)
}
}
+/* Support Configure command-line overrides for rand() functions.
+ After 5.005, perhaps we should replace this by Configure support
+ for drand48(), random(), or rand(). For 5.005, though, maintain
+ compatibility by calling rand() but allow the user to override it.
+ See INSTALL for details. --Andy Dougherty 15 July 1998
+*/
+#ifndef my_rand
+# define my_rand rand
+#endif
+#ifndef my_srand
+# define my_srand srand
+#endif
+
PP(pp_rand)
{
- dSP; dTARGET;
+ djSP; dTARGET;
double value;
if (MAXARG < 1)
value = 1.0;
@@ -1464,19 +1580,19 @@ PP(pp_rand)
if (value == 0.0)
value = 1.0;
if (!srand_called) {
- (void)srand((unsigned)seed());
+ (void)my_srand((unsigned)seed());
srand_called = TRUE;
}
#if RANDBITS == 31
- value = rand() * value / 2147483648.0;
+ value = my_rand() * value / 2147483648.0;
#else
#if RANDBITS == 16
- value = rand() * value / 65536.0;
+ value = my_rand() * value / 65536.0;
#else
#if RANDBITS == 15
- value = rand() * value / 32768.0;
+ value = my_rand() * value / 32768.0;
#else
- value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
+ value = my_rand() * value / (double)(((unsigned long)1) << RANDBITS);
#endif
#endif
#endif
@@ -1486,20 +1602,20 @@ PP(pp_rand)
PP(pp_srand)
{
- dSP;
+ djSP;
UV anum;
if (MAXARG < 1)
anum = seed();
else
anum = POPu;
- (void)srand((unsigned)anum);
+ (void)my_srand((unsigned)anum);
srand_called = TRUE;
EXTEND(SP, 1);
RETPUSHYES;
}
-static U32
-seed()
+STATIC U32
+seed(void)
{
/*
* This is really just a quick hack which grabs various garbage
@@ -1523,27 +1639,57 @@ seed()
#define SEED_C3 269
#define SEED_C5 26107
+ dTHR;
+#ifndef PERL_NO_DEV_RANDOM
+ int fd;
+#endif
U32 u;
#ifdef VMS
# include <starlet.h>
/* when[] = (low 32 bits, high 32 bits) of time since epoch
* in 100-ns units, typically incremented ever 10 ms. */
unsigned int when[2];
+#else
+# ifdef HAS_GETTIMEOFDAY
+ struct timeval when;
+# else
+ Time_t when;
+# endif
+#endif
+
+/* This test is an escape hatch, this symbol isn't set by Configure. */
+#ifndef PERL_NO_DEV_RANDOM
+#ifndef PERL_RANDOM_DEVICE
+ /* /dev/random isn't used by default because reads from it will block
+ * if there isn't enough entropy available. You can compile with
+ * PERL_RANDOM_DEVICE to it if you'd prefer Perl to block until there
+ * is enough real entropy to fill the seed. */
+# define PERL_RANDOM_DEVICE "/dev/urandom"
+#endif
+ fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0);
+ if (fd != -1) {
+ if (PerlLIO_read(fd, &u, sizeof u) != sizeof u)
+ u = 0;
+ PerlLIO_close(fd);
+ if (u)
+ return u;
+ }
+#endif
+
+#ifdef VMS
_ckvmssts(sys$gettim(when));
u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1];
#else
# ifdef HAS_GETTIMEOFDAY
- struct timeval when;
gettimeofday(&when,(struct timezone *) 0);
u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec;
# else
- Time_t when;
(void)time(&when);
u = (U32)SEED_C1 * when;
# endif
#endif
u += SEED_C3 * (U32)getpid();
- u += SEED_C4 * (U32)(UV)stack_sp;
+ u += SEED_C4 * (U32)(UV)PL_stack_sp;
#ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */
u += SEED_C5 * (U32)(UV)&when;
#endif
@@ -1552,7 +1698,7 @@ seed()
PP(pp_exp)
{
- dSP; dTARGET; tryAMAGICun(exp);
+ djSP; dTARGET; tryAMAGICun(exp);
{
double value;
value = POPn;
@@ -1564,7 +1710,7 @@ PP(pp_exp)
PP(pp_log)
{
- dSP; dTARGET; tryAMAGICun(log);
+ djSP; dTARGET; tryAMAGICun(log);
{
double value;
value = POPn;
@@ -1580,7 +1726,7 @@ PP(pp_log)
PP(pp_sqrt)
{
- dSP; dTARGET; tryAMAGICun(sqrt);
+ djSP; dTARGET; tryAMAGICun(sqrt);
{
double value;
value = POPn;
@@ -1596,7 +1742,7 @@ PP(pp_sqrt)
PP(pp_int)
{
- dSP; dTARGET;
+ djSP; dTARGET;
{
double value = TOPn;
IV iv;
@@ -1624,7 +1770,7 @@ PP(pp_int)
PP(pp_abs)
{
- dSP; dTARGET; tryAMAGICun(abs);
+ djSP; dTARGET; tryAMAGICun(abs);
{
double value = TOPn;
IV iv;
@@ -1646,23 +1792,25 @@ PP(pp_abs)
PP(pp_hex)
{
- dSP; dTARGET;
+ djSP; dTARGET;
char *tmps;
I32 argtype;
+ STRLEN n_a;
- tmps = POPp;
+ tmps = POPpx;
XPUSHu(scan_hex(tmps, 99, &argtype));
RETURN;
}
PP(pp_oct)
{
- dSP; dTARGET;
+ djSP; dTARGET;
UV value;
I32 argtype;
char *tmps;
+ STRLEN n_a;
- tmps = POPp;
+ tmps = POPpx;
while (*tmps && isSPACE(*tmps))
tmps++;
if (*tmps == '0')
@@ -1679,64 +1827,73 @@ PP(pp_oct)
PP(pp_length)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SETi( sv_len(TOPs) );
RETURN;
}
PP(pp_substr)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SV *sv;
I32 len;
STRLEN curlen;
I32 pos;
I32 rem;
I32 fail;
- I32 lvalue = op->op_flags & OPf_MOD;
+ I32 lvalue = PL_op->op_flags & OPf_MOD;
char *tmps;
- I32 arybase = curcop->cop_arybase;
-
- if (MAXARG > 2)
+ I32 arybase = PL_curcop->cop_arybase;
+ char *repl = 0;
+ STRLEN repl_len;
+
+ SvTAINTED_off(TARG); /* decontaminate */
+ if (MAXARG > 2) {
+ if (MAXARG > 3) {
+ sv = POPs;
+ repl = SvPV(sv, repl_len);
+ }
len = POPi;
+ }
pos = POPi;
sv = POPs;
+ PUTBACK;
tmps = SvPV(sv, curlen);
if (pos >= arybase) {
pos -= arybase;
rem = curlen-pos;
fail = rem;
- if (MAXARG > 2) {
- if (len < 0) {
- rem += len;
- if (rem < 0)
- rem = 0;
- }
- else if (rem > len)
- rem = len;
- }
+ if (MAXARG > 2) {
+ if (len < 0) {
+ rem += len;
+ if (rem < 0)
+ rem = 0;
+ }
+ else if (rem > len)
+ rem = len;
+ }
}
else {
- pos += curlen;
- if (MAXARG < 3)
- rem = curlen;
- else if (len >= 0) {
- rem = pos+len;
- if (rem > (I32)curlen)
- rem = curlen;
- }
- else {
- rem = curlen+len;
- if (rem < pos)
- rem = pos;
- }
- if (pos < 0)
- pos = 0;
- fail = rem;
- rem -= pos;
+ pos += curlen;
+ if (MAXARG < 3)
+ rem = curlen;
+ else if (len >= 0) {
+ rem = pos+len;
+ if (rem > (I32)curlen)
+ rem = curlen;
+ }
+ else {
+ rem = curlen+len;
+ if (rem < pos)
+ rem = pos;
+ }
+ if (pos < 0)
+ pos = 0;
+ fail = rem;
+ rem -= pos;
}
if (fail < 0) {
- if (dowarn || lvalue)
+ if (PL_dowarn || lvalue || repl)
warn("substr outside of string");
RETPUSHUNDEF;
}
@@ -1746,8 +1903,9 @@ PP(pp_substr)
if (lvalue) { /* it's an lvalue! */
if (!SvGMAGICAL(sv)) {
if (SvROK(sv)) {
- SvPV_force(sv,na);
- if (dowarn)
+ STRLEN n_a;
+ SvPV_force(sv,n_a);
+ if (PL_dowarn)
warn("Attempt to use reference as lvalue in substr");
}
if (SvOK(sv)) /* is it defined ? */
@@ -1762,27 +1920,35 @@ PP(pp_substr)
}
LvTYPE(TARG) = 'x';
- LvTARG(TARG) = sv;
+ if (LvTARG(TARG) != sv) {
+ if (LvTARG(TARG))
+ SvREFCNT_dec(LvTARG(TARG));
+ LvTARG(TARG) = SvREFCNT_inc(sv);
+ }
LvTARGOFF(TARG) = pos;
- LvTARGLEN(TARG) = rem;
+ LvTARGLEN(TARG) = rem;
}
+ else if (repl)
+ sv_insert(sv, pos, rem, repl, repl_len);
}
+ SPAGAIN;
PUSHs(TARG); /* avoid SvSETMAGIC here */
RETURN;
}
PP(pp_vec)
{
- dSP; dTARGET;
+ djSP; dTARGET;
register I32 size = POPi;
register I32 offset = POPi;
register SV *src = POPs;
- I32 lvalue = op->op_flags & OPf_MOD;
+ I32 lvalue = PL_op->op_flags & OPf_MOD;
STRLEN srclen;
unsigned char *s = (unsigned char*)SvPV(src, srclen);
unsigned long retnum;
I32 len;
+ SvTAINTED_off(TARG); /* decontaminate */
offset *= size; /* turn into bit offset */
len = (offset + size + 7) / 8;
if (offset < 0 || size < 1)
@@ -1795,9 +1961,13 @@ PP(pp_vec)
}
LvTYPE(TARG) = 'v';
- LvTARG(TARG) = src;
- LvTARGOFF(TARG) = offset;
- LvTARGLEN(TARG) = size;
+ if (LvTARG(TARG) != src) {
+ if (LvTARG(TARG))
+ SvREFCNT_dec(LvTARG(TARG));
+ LvTARG(TARG) = SvREFCNT_inc(src);
+ }
+ LvTARGOFF(TARG) = offset;
+ LvTARGLEN(TARG) = size;
}
if (len > srclen) {
if (size <= 8)
@@ -1840,14 +2010,14 @@ PP(pp_vec)
}
}
- sv_setiv(TARG, (IV)retnum);
+ sv_setuv(TARG, (UV)retnum);
PUSHs(TARG);
RETURN;
}
PP(pp_index)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SV *big;
SV *little;
I32 offset;
@@ -1855,7 +2025,7 @@ PP(pp_index)
char *tmps;
char *tmps2;
STRLEN biglen;
- I32 arybase = curcop->cop_arybase;
+ I32 arybase = PL_curcop->cop_arybase;
if (MAXARG < 3)
offset = 0;
@@ -1869,7 +2039,7 @@ PP(pp_index)
else if (offset > biglen)
offset = biglen;
if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
- (unsigned char*)tmps + biglen, little)))
+ (unsigned char*)tmps + biglen, little, 0)))
retval = -1 + arybase;
else
retval = tmps2 - tmps + arybase;
@@ -1879,7 +2049,7 @@ PP(pp_index)
PP(pp_rindex)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SV *big;
SV *little;
STRLEN blen;
@@ -1889,7 +2059,7 @@ PP(pp_rindex)
I32 retval;
char *tmps;
char *tmps2;
- I32 arybase = curcop->cop_arybase;
+ I32 arybase = PL_curcop->cop_arybase;
if (MAXARG >= 3)
offstr = POPs;
@@ -1916,9 +2086,9 @@ PP(pp_rindex)
PP(pp_sprintf)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
#ifdef USE_LOCALE_NUMERIC
- if (op->op_private & OPpLOCALE)
+ if (PL_op->op_private & OPpLOCALE)
SET_NUMERIC_LOCAL();
else
SET_NUMERIC_STANDARD();
@@ -1932,16 +2102,17 @@ PP(pp_sprintf)
PP(pp_ord)
{
- dSP; dTARGET;
+ djSP; dTARGET;
I32 value;
char *tmps;
+ STRLEN n_a;
#ifndef I286
- tmps = POPp;
+ tmps = POPpx;
value = (I32) (*tmps & 255);
#else
I32 anum;
- tmps = POPp;
+ tmps = POPpx;
anum = (I32) *tmps;
value = (I32) (anum & 255);
#endif
@@ -1951,7 +2122,7 @@ PP(pp_ord)
PP(pp_chr)
{
- dSP; dTARGET;
+ djSP; dTARGET;
char *tmps;
(void)SvUPGRADE(TARG,SVt_PV);
@@ -1967,13 +2138,14 @@ PP(pp_chr)
PP(pp_crypt)
{
- dSP; dTARGET; dPOPTOPssrl;
+ djSP; dTARGET; dPOPTOPssrl;
+ STRLEN n_a;
#ifdef HAS_CRYPT
- char *tmps = SvPV(left, na);
+ char *tmps = SvPV(left, n_a);
#ifdef FCRYPT
- sv_setpv(TARG, fcrypt(tmps, SvPV(right, na)));
+ sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a)));
#else
- sv_setpv(TARG, crypt(tmps, SvPV(right, na)));
+ sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
#endif
#else
DIE(
@@ -1985,9 +2157,10 @@ PP(pp_crypt)
PP(pp_ucfirst)
{
- dSP;
+ djSP;
SV *sv = TOPs;
register char *s;
+ STRLEN n_a;
if (!SvPADTMP(sv)) {
dTARGET;
@@ -1995,9 +2168,9 @@ PP(pp_ucfirst)
sv = TARG;
SETs(sv);
}
- s = SvPV_force(sv, na);
+ s = SvPV_force(sv, n_a);
if (*s) {
- if (op->op_private & OPpLOCALE) {
+ if (PL_op->op_private & OPpLOCALE) {
TAINT;
SvTAINTED_on(sv);
*s = toUPPER_LC(*s);
@@ -2011,9 +2184,10 @@ PP(pp_ucfirst)
PP(pp_lcfirst)
{
- dSP;
+ djSP;
SV *sv = TOPs;
register char *s;
+ STRLEN n_a;
if (!SvPADTMP(sv)) {
dTARGET;
@@ -2021,9 +2195,9 @@ PP(pp_lcfirst)
sv = TARG;
SETs(sv);
}
- s = SvPV_force(sv, na);
+ s = SvPV_force(sv, n_a);
if (*s) {
- if (op->op_private & OPpLOCALE) {
+ if (PL_op->op_private & OPpLOCALE) {
TAINT;
SvTAINTED_on(sv);
*s = toLOWER_LC(*s);
@@ -2038,7 +2212,7 @@ PP(pp_lcfirst)
PP(pp_uc)
{
- dSP;
+ djSP;
SV *sv = TOPs;
register char *s;
STRLEN len;
@@ -2054,7 +2228,7 @@ PP(pp_uc)
if (len) {
register char *send = s + len;
- if (op->op_private & OPpLOCALE) {
+ if (PL_op->op_private & OPpLOCALE) {
TAINT;
SvTAINTED_on(sv);
for (; s < send; s++)
@@ -2070,7 +2244,7 @@ PP(pp_uc)
PP(pp_lc)
{
- dSP;
+ djSP;
SV *sv = TOPs;
register char *s;
STRLEN len;
@@ -2086,7 +2260,7 @@ PP(pp_lc)
if (len) {
register char *send = s + len;
- if (op->op_private & OPpLOCALE) {
+ if (PL_op->op_private & OPpLOCALE) {
TAINT;
SvTAINTED_on(sv);
for (; s < send; s++)
@@ -2102,7 +2276,7 @@ PP(pp_lc)
PP(pp_quotemeta)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SV *sv = TOPs;
STRLEN len;
register char *s = SvPV(sv,len);
@@ -2131,17 +2305,17 @@ PP(pp_quotemeta)
PP(pp_aslice)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
register SV** svp;
register AV* av = (AV*)POPs;
- register I32 lval = op->op_flags & OPf_MOD;
- I32 arybase = curcop->cop_arybase;
+ register I32 lval = PL_op->op_flags & OPf_MOD;
+ I32 arybase = PL_curcop->cop_arybase;
I32 elem;
if (SvTYPE(av) == SVt_PVAV) {
- if (lval && op->op_private & OPpLVAL_INTRO) {
+ if (lval && PL_op->op_private & OPpLVAL_INTRO) {
I32 max = -1;
- for (svp = mark + 1; svp <= sp; svp++) {
+ for (svp = MARK + 1; svp <= SP; svp++) {
elem = SvIVx(*svp);
if (elem > max)
max = elem;
@@ -2156,12 +2330,12 @@ PP(pp_aslice)
elem -= arybase;
svp = av_fetch(av, elem, lval);
if (lval) {
- if (!svp || *svp == &sv_undef)
+ if (!svp || *svp == &PL_sv_undef)
DIE(no_aelem, elem);
- if (op->op_private & OPpLVAL_INTRO)
- save_svref(svp);
+ if (PL_op->op_private & OPpLVAL_INTRO)
+ save_aelem(av, elem, svp);
}
- *MARK = svp ? *svp : &sv_undef;
+ *MARK = svp ? *svp : &PL_sv_undef;
}
}
if (GIMME != G_ARRAY) {
@@ -2176,13 +2350,15 @@ PP(pp_aslice)
PP(pp_each)
{
- dSP; dTARGET;
+ djSP; dTARGET;
HV *hash = (HV*)POPs;
HE *entry;
I32 gimme = GIMME_V;
-
+ I32 realhv = (SvTYPE(hash) == SVt_PVHV);
+
PUTBACK;
- entry = hv_iternext(hash); /* might clobber stack_sp */
+ /* might clobber stack_sp */
+ entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash);
SPAGAIN;
EXTEND(SP, 2);
@@ -2190,7 +2366,9 @@ PP(pp_each)
PUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */
if (gimme == G_ARRAY) {
PUTBACK;
- sv_setsv(TARG, hv_iterval(hash, entry)); /* might hit stack_sp */
+ /* might clobber stack_sp */
+ sv_setsv(TARG, realhv ?
+ hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry));
SPAGAIN;
PUSHs(TARG);
}
@@ -2213,20 +2391,23 @@ PP(pp_keys)
PP(pp_delete)
{
- dSP;
+ djSP;
I32 gimme = GIMME_V;
I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
SV *sv;
HV *hv;
- if (op->op_private & OPpSLICE) {
+ if (PL_op->op_private & OPpSLICE) {
dMARK; dORIGMARK;
+ U32 hvtype;
hv = (HV*)POPs;
- if (SvTYPE(hv) != SVt_PVHV)
- DIE("Not a HASH reference");
+ hvtype = SvTYPE(hv);
while (++MARK <= SP) {
- sv = hv_delete_ent(hv, *MARK, discard, 0);
- *MARK = sv ? sv : &sv_undef;
+ if (hvtype == SVt_PVHV)
+ sv = hv_delete_ent(hv, *MARK, discard, 0);
+ else
+ DIE("Not a HASH reference");
+ *MARK = sv ? sv : &PL_sv_undef;
}
if (discard)
SP = ORIGMARK;
@@ -2239,11 +2420,12 @@ PP(pp_delete)
else {
SV *keysv = POPs;
hv = (HV*)POPs;
- if (SvTYPE(hv) != SVt_PVHV)
+ if (SvTYPE(hv) == SVt_PVHV)
+ sv = hv_delete_ent(hv, keysv, discard, 0);
+ else
DIE("Not a HASH reference");
- sv = hv_delete_ent(hv, keysv, discard, 0);
if (!sv)
- sv = &sv_undef;
+ sv = &PL_sv_undef;
if (!discard)
PUSHs(sv);
}
@@ -2252,37 +2434,50 @@ PP(pp_delete)
PP(pp_exists)
{
- dSP;
+ djSP;
SV *tmpsv = POPs;
HV *hv = (HV*)POPs;
- STRLEN len;
- if (SvTYPE(hv) != SVt_PVHV) {
+ if (SvTYPE(hv) == SVt_PVHV) {
+ if (hv_exists_ent(hv, tmpsv, 0))
+ RETPUSHYES;
+ } else if (SvTYPE(hv) == SVt_PVAV) {
+ if (avhv_exists_ent((AV*)hv, tmpsv, 0))
+ RETPUSHYES;
+ } else {
DIE("Not a HASH reference");
}
- if (hv_exists_ent(hv, tmpsv, 0))
- RETPUSHYES;
RETPUSHNO;
}
PP(pp_hslice)
{
- dSP; dMARK; dORIGMARK;
- register HE *he;
+ djSP; dMARK; dORIGMARK;
register HV *hv = (HV*)POPs;
- register I32 lval = op->op_flags & OPf_MOD;
+ register I32 lval = PL_op->op_flags & OPf_MOD;
+ I32 realhv = (SvTYPE(hv) == SVt_PVHV);
- if (SvTYPE(hv) == SVt_PVHV) {
+ if (!realhv && PL_op->op_private & OPpLVAL_INTRO)
+ DIE("Can't localize pseudo-hash element");
+
+ if (realhv || SvTYPE(hv) == SVt_PVAV) {
while (++MARK <= SP) {
SV *keysv = *MARK;
-
- he = hv_fetch_ent(hv, keysv, lval, 0);
+ SV **svp;
+ if (realhv) {
+ HE *he = hv_fetch_ent(hv, keysv, lval, 0);
+ svp = he ? &HeVAL(he) : 0;
+ } else {
+ svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
+ }
if (lval) {
- if (!he || HeVAL(he) == &sv_undef)
- DIE(no_helem, SvPV(keysv, na));
- if (op->op_private & OPpLVAL_INTRO)
- save_svref(&HeVAL(he));
+ if (!svp || *svp == &PL_sv_undef) {
+ STRLEN n_a;
+ DIE(no_helem, SvPV(keysv, n_a));
+ }
+ if (PL_op->op_private & OPpLVAL_INTRO)
+ save_helem(hv, keysv, svp);
}
- *MARK = he ? HeVAL(he) : &sv_undef;
+ *MARK = svp ? *svp : &PL_sv_undef;
}
}
if (GIMME != G_ARRAY) {
@@ -2297,12 +2492,12 @@ PP(pp_hslice)
PP(pp_list)
{
- dSP; dMARK;
+ djSP; dMARK;
if (GIMME != G_ARRAY) {
if (++MARK <= SP)
*MARK = *SP; /* unwanted list, return last item */
else
- *MARK = &sv_undef;
+ *MARK = &PL_sv_undef;
SP = MARK;
}
RETURN;
@@ -2310,13 +2505,13 @@ PP(pp_list)
PP(pp_lslice)
{
- dSP;
- SV **lastrelem = stack_sp;
- SV **lastlelem = stack_base + POPMARK;
- SV **firstlelem = stack_base + POPMARK + 1;
+ djSP;
+ SV **lastrelem = PL_stack_sp;
+ SV **lastlelem = PL_stack_base + POPMARK;
+ SV **firstlelem = PL_stack_base + POPMARK + 1;
register SV **firstrelem = lastlelem + 1;
- I32 arybase = curcop->cop_arybase;
- I32 lval = op->op_flags & OPf_MOD;
+ I32 arybase = PL_curcop->cop_arybase;
+ I32 lval = PL_op->op_flags & OPf_MOD;
I32 is_something_there = lval;
register I32 max = lastrelem - lastlelem;
@@ -2330,7 +2525,7 @@ PP(pp_lslice)
else
ix -= arybase;
if (ix < 0 || ix >= max)
- *firstlelem = &sv_undef;
+ *firstlelem = &PL_sv_undef;
else
*firstlelem = firstrelem[ix];
SP = firstlelem;
@@ -2347,14 +2542,14 @@ PP(pp_lslice)
if (ix < 0) {
ix += max;
if (ix < 0)
- *lelem = &sv_undef;
+ *lelem = &PL_sv_undef;
else if (!(*lelem = firstrelem[ix]))
- *lelem = &sv_undef;
+ *lelem = &PL_sv_undef;
}
else {
ix -= arybase;
if (ix >= max || !(*lelem = firstrelem[ix]))
- *lelem = &sv_undef;
+ *lelem = &PL_sv_undef;
}
if (!is_something_there && (SvOK(*lelem) || SvGMAGICAL(*lelem)))
is_something_there = TRUE;
@@ -2368,7 +2563,7 @@ PP(pp_lslice)
PP(pp_anonlist)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
I32 items = SP - MARK;
SV *av = sv_2mortal((SV*)av_make(items, MARK+1));
SP = ORIGMARK; /* av_make() might realloc stack_sp */
@@ -2378,7 +2573,7 @@ PP(pp_anonlist)
PP(pp_anonhash)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
HV* hv = (HV*)sv_2mortal((SV*)newHV());
while (MARK < SP) {
@@ -2386,8 +2581,8 @@ PP(pp_anonhash)
SV *val = NEWSV(46, 0);
if (MARK < SP)
sv_setsv(val, *++MARK);
- else if (dowarn)
- warn("Odd number of elements in hash list");
+ else if (PL_dowarn)
+ warn("Odd number of elements in hash assignment");
(void)hv_store_ent(hv,key,val,0);
}
SP = ORIGMARK;
@@ -2397,7 +2592,7 @@ PP(pp_anonhash)
PP(pp_splice)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
register AV *ary = (AV*)*++MARK;
register SV **src;
register SV **dst;
@@ -2408,21 +2603,36 @@ PP(pp_splice)
I32 after;
I32 diff;
SV **tmparyval = 0;
+ MAGIC *mg;
+
+ if (mg = SvTIED_mg((SV*)ary, 'P')) {
+ *MARK-- = SvTIED_obj((SV*)ary, mg);
+ PUSHMARK(MARK);
+ PUTBACK;
+ ENTER;
+ perl_call_method("SPLICE",GIMME_V);
+ LEAVE;
+ SPAGAIN;
+ RETURN;
+ }
SP++;
if (++MARK < SP) {
offset = i = SvIVx(*MARK);
if (offset < 0)
- offset += AvFILL(ary) + 1;
+ offset += AvFILLp(ary) + 1;
else
- offset -= curcop->cop_arybase;
+ offset -= PL_curcop->cop_arybase;
if (offset < 0)
DIE(no_aelem, i);
if (++MARK < SP) {
length = SvIVx(*MARK++);
- if (length < 0)
- length = 0;
+ if (length < 0) {
+ length += AvFILLp(ary) - offset + 1;
+ if (length < 0)
+ length = 0;
+ }
}
else
length = AvMAX(ary) + 1; /* close enough to infinity */
@@ -2431,9 +2641,9 @@ PP(pp_splice)
offset = 0;
length = AvMAX(ary) + 1;
}
- if (offset > AvFILL(ary) + 1)
- offset = AvFILL(ary) + 1;
- after = AvFILL(ary) + 1 - (offset + length);
+ if (offset > AvFILLp(ary) + 1)
+ offset = AvFILLp(ary) + 1;
+ after = AvFILLp(ary) + 1 - (offset + length);
if (after < 0) { /* not that much array */
length += after; /* offset+length now in array */
after = 0;
@@ -2465,8 +2675,7 @@ PP(pp_splice)
if (AvREAL(ary)) {
EXTEND_MORTAL(length);
for (i = length, dst = MARK; i; i--) {
- if (!SvIMMORTAL(*dst))
- sv_2mortal(*dst); /* free them eventualy */
+ sv_2mortal(*dst); /* free them eventualy */
dst++;
}
}
@@ -2475,13 +2684,12 @@ PP(pp_splice)
else {
*MARK = AvARRAY(ary)[offset+length-1];
if (AvREAL(ary)) {
- if (!SvIMMORTAL(*MARK))
- sv_2mortal(*MARK);
+ sv_2mortal(*MARK);
for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
SvREFCNT_dec(*dst++); /* free them now */
}
}
- AvFILL(ary) += diff;
+ AvFILLp(ary) += diff;
/* pull up or down? */
@@ -2502,12 +2710,12 @@ PP(pp_splice)
dst = src + diff; /* diff is negative */
Move(src, dst, after, SV*);
}
- dst = &AvARRAY(ary)[AvFILL(ary)+1];
+ dst = &AvARRAY(ary)[AvFILLp(ary)+1];
/* avoid later double free */
}
i = -diff;
while (i)
- dst[--i] = &sv_undef;
+ dst[--i] = &PL_sv_undef;
if (newlen) {
for (src = tmparyval, dst = AvARRAY(ary) + offset;
@@ -2536,15 +2744,15 @@ PP(pp_splice)
}
SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
AvMAX(ary) += diff;
- AvFILL(ary) += diff;
+ AvFILLp(ary) += diff;
}
else {
- if (AvFILL(ary) + diff >= AvMAX(ary)) /* oh, well */
- av_extend(ary, AvFILL(ary) + diff);
- AvFILL(ary) += diff;
+ if (AvFILLp(ary) + diff >= AvMAX(ary)) /* oh, well */
+ av_extend(ary, AvFILLp(ary) + diff);
+ AvFILLp(ary) += diff;
if (after) {
- dst = AvARRAY(ary) + AvFILL(ary);
+ dst = AvARRAY(ary) + AvFILLp(ary);
src = dst - diff;
for (i = after; i; i--) {
*dst-- = *src--;
@@ -2564,8 +2772,7 @@ PP(pp_splice)
if (AvREAL(ary)) {
EXTEND_MORTAL(length);
for (i = length, dst = MARK; i; i--) {
- if (!SvIMMORTAL(*dst))
- sv_2mortal(*dst); /* free them eventualy */
+ sv_2mortal(*dst); /* free them eventualy */
dst++;
}
}
@@ -2576,15 +2783,14 @@ PP(pp_splice)
else if (length--) {
*MARK = tmparyval[length];
if (AvREAL(ary)) {
- if (!SvIMMORTAL(*MARK))
- sv_2mortal(*MARK);
+ sv_2mortal(*MARK);
while (length-- > 0)
SvREFCNT_dec(tmparyval[length]);
}
Safefree(tmparyval);
}
else
- *MARK = &sv_undef;
+ *MARK = &PL_sv_undef;
}
SP = MARK;
RETURN;
@@ -2592,15 +2798,28 @@ PP(pp_splice)
PP(pp_push)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
register AV *ary = (AV*)*++MARK;
- register SV *sv = &sv_undef;
-
- for (++MARK; MARK <= SP; MARK++) {
- sv = NEWSV(51, 0);
- if (*MARK)
- sv_setsv(sv, *MARK);
- av_push(ary, sv);
+ register SV *sv = &PL_sv_undef;
+ MAGIC *mg;
+
+ if (mg = SvTIED_mg((SV*)ary, 'P')) {
+ *MARK-- = SvTIED_obj((SV*)ary, mg);
+ PUSHMARK(MARK);
+ PUTBACK;
+ ENTER;
+ perl_call_method("PUSH",G_SCALAR|G_DISCARD);
+ LEAVE;
+ SPAGAIN;
+ }
+ else {
+ /* Why no pre-extend of ary here ? */
+ for (++MARK; MARK <= SP; MARK++) {
+ sv = NEWSV(51, 0);
+ if (*MARK)
+ sv_setsv(sv, *MARK);
+ av_push(ary, sv);
+ }
}
SP = ORIGMARK;
PUSHi( AvFILL(ary) + 1 );
@@ -2609,10 +2828,10 @@ PP(pp_push)
PP(pp_pop)
{
- dSP;
+ djSP;
AV *av = (AV*)POPs;
SV *sv = av_pop(av);
- if (!SvIMMORTAL(sv) && AvREAL(av))
+ if (AvREAL(av))
(void)sv_2mortal(sv);
PUSHs(sv);
RETURN;
@@ -2620,13 +2839,13 @@ PP(pp_pop)
PP(pp_shift)
{
- dSP;
+ djSP;
AV *av = (AV*)POPs;
SV *sv = av_shift(av);
EXTEND(SP, 1);
if (!sv)
RETPUSHUNDEF;
- if (!SvIMMORTAL(sv) && AvREAL(av))
+ if (AvREAL(av))
(void)sv_2mortal(sv);
PUSHs(sv);
RETURN;
@@ -2634,18 +2853,29 @@ PP(pp_shift)
PP(pp_unshift)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
register AV *ary = (AV*)*++MARK;
register SV *sv;
register I32 i = 0;
+ MAGIC *mg;
- av_unshift(ary, SP - MARK);
- while (MARK < SP) {
- sv = NEWSV(27, 0);
- sv_setsv(sv, *++MARK);
- (void)av_store(ary, i++, sv);
+ if (mg = SvTIED_mg((SV*)ary, 'P')) {
+ *MARK-- = SvTIED_obj((SV*)ary, mg);
+ PUSHMARK(MARK);
+ PUTBACK;
+ ENTER;
+ perl_call_method("UNSHIFT",G_SCALAR|G_DISCARD);
+ LEAVE;
+ SPAGAIN;
+ }
+ else {
+ av_unshift(ary, SP - MARK);
+ while (MARK < SP) {
+ sv = NEWSV(27, 0);
+ sv_setsv(sv, *++MARK);
+ (void)av_store(ary, i++, sv);
+ }
}
-
SP = ORIGMARK;
PUSHi( AvFILL(ary) + 1 );
RETURN;
@@ -2653,7 +2883,7 @@ PP(pp_unshift)
PP(pp_reverse)
{
- dSP; dMARK;
+ djSP; dMARK;
register SV *tmp;
SV **oldsp = SP;
@@ -2674,9 +2904,9 @@ PP(pp_reverse)
STRLEN len;
if (SP - MARK > 1)
- do_join(TARG, &sv_no, MARK, SP);
+ do_join(TARG, &PL_sv_no, MARK, SP);
else
- sv_setsv(TARG, (SP > MARK) ? *SP : GvSV(defgv));
+ sv_setsv(TARG, (SP > MARK) ? *SP : DEFSV);
up = SvPV_force(TARG, len);
if (len > 1) {
down = SvPVX(TARG) + len - 1;
@@ -2693,10 +2923,8 @@ PP(pp_reverse)
RETURN;
}
-static SV *
-mul128(sv, m)
- SV *sv;
- U8 m;
+STATIC SV *
+mul128(SV *sv, U8 m)
{
STRLEN len;
char *s = SvPV(sv, len);
@@ -2704,11 +2932,11 @@ mul128(sv, m)
U32 i = 0;
if (!strnEQ(s, "0000", 4)) { /* need to grow sv */
- SV *new = newSVpv("0000000000", 10);
+ SV *tmpNew = newSVpv("0000000000", 10);
- sv_catsv(new, sv);
+ sv_catsv(tmpNew, sv);
SvREFCNT_dec(sv); /* free old sv */
- sv = new;
+ sv = tmpNew;
s = SvPV(sv, len);
}
t = s + len - 1;
@@ -2724,11 +2952,27 @@ mul128(sv, m)
/* Explosives and implosives. */
+static const char uuemap[] =
+ "`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_";
+#ifndef PERL_OBJECT
+static char uudmap[256]; /* Initialised on first use */
+#endif
+#if 'I' == 73 && 'J' == 74
+/* On an ASCII/ISO kind of system */
+#define ISUUCHAR(ch) ((ch) >= ' ' && (ch) < 'a')
+#else
+/*
+ Some other sort of character set - use memchr() so we don't match
+ the null byte.
+ */
+#define ISUUCHAR(ch) (memchr(uuemap, (ch), sizeof(uuemap)-1) || (ch) == ' ')
+#endif
+
PP(pp_unpack)
{
- dSP;
+ djSP;
dPOPPOPssrl;
- SV **oldsp = sp;
+ SV **oldsp = SP;
I32 gimme = GIMME_V;
SV *sv;
STRLEN llen;
@@ -2761,13 +3005,15 @@ PP(pp_unpack)
I32 checksum = 0;
register U32 culong;
double cdouble;
+#ifndef PERL_OBJECT
static char* bitcount = 0;
+#endif
int commas = 0;
if (gimme != G_ARRAY) { /* arrange to do first one only */
/*SUPPRESS 530*/
for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
- if (strchr("aAbBhHP", *patend) || *pat == '%') {
+ if (strchr("aAZbBhHP", *patend) || *pat == '%') {
patend++;
while (isDIGIT(*patend) || *patend == '*')
patend++;
@@ -2797,7 +3043,7 @@ PP(pp_unpack)
default:
croak("Invalid type in unpack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
- if (commas++ == 0 && dowarn)
+ if (commas++ == 0 && PL_dowarn)
warn("Invalid type in unpack: '%c'", (int)datumtype);
break;
case '%':
@@ -2825,6 +3071,7 @@ PP(pp_unpack)
s += len;
break;
case 'A':
+ case 'Z':
case 'a':
if (len > strend - s)
len = strend - s;
@@ -2833,12 +3080,19 @@ PP(pp_unpack)
sv = NEWSV(35, len);
sv_setpvn(sv, s, len);
s += len;
- if (datumtype == 'A') {
+ if (datumtype == 'A' || datumtype == 'Z') {
aptr = s; /* borrow register */
- s = SvPVX(sv) + len - 1;
- while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
- s--;
- *++s = '\0';
+ if (datumtype == 'Z') { /* 'Z' strips stuff after first null */
+ s = SvPVX(sv);
+ while (*s)
+ s++;
+ }
+ else { /* 'A' strips both nulls and spaces */
+ s = SvPVX(sv) + len - 1;
+ while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
+ s--;
+ *++s = '\0';
+ }
SvCUR_set(sv, s - SvPVX(sv));
s = aptr; /* unborrow register */
}
@@ -2928,7 +3182,7 @@ PP(pp_unpack)
bits >>= 4;
else
bits = *s++;
- *pat++ = hexdigit[bits & 15];
+ *pat++ = PL_hexdigit[bits & 15];
}
}
else {
@@ -2938,7 +3192,7 @@ PP(pp_unpack)
bits <<= 4;
else
bits = *s++;
- *pat++ = hexdigit[(bits >> 4) & 15];
+ *pat++ = PL_hexdigit[(bits >> 4) & 15];
}
}
*pat = '\0';
@@ -2997,6 +3251,10 @@ PP(pp_unpack)
if (checksum) {
while (len-- > 0) {
COPY16(s, &ashort);
+#if SHORTSIZE > SIZE16
+ if (ashort > 32767)
+ ashort -= 65536;
+#endif
s += SIZE16;
culong += ashort;
}
@@ -3006,6 +3264,10 @@ PP(pp_unpack)
EXTEND_MORTAL(len);
while (len-- > 0) {
COPY16(s, &ashort);
+#if SHORTSIZE > SIZE16
+ if (ashort > 32767)
+ ashort -= 65536;
+#endif
s += SIZE16;
sv = NEWSV(38, 0);
sv_setiv(sv, (IV)ashort);
@@ -3025,7 +3287,7 @@ PP(pp_unpack)
s += SIZE16;
#ifdef HAS_NTOHS
if (datumtype == 'n')
- aushort = ntohs(aushort);
+ aushort = PerlSock_ntohs(aushort);
#endif
#ifdef HAS_VTOHS
if (datumtype == 'v')
@@ -3043,7 +3305,7 @@ PP(pp_unpack)
sv = NEWSV(39, 0);
#ifdef HAS_NTOHS
if (datumtype == 'n')
- aushort = ntohs(aushort);
+ aushort = PerlSock_ntohs(aushort);
#endif
#ifdef HAS_VTOHS
if (datumtype == 'v')
@@ -3075,6 +3337,13 @@ PP(pp_unpack)
Copy(s, &aint, 1, int);
s += sizeof(int);
sv = NEWSV(40, 0);
+#ifdef __osf__
+ /* Without the dummy below unpack("i", pack("i",-1))
+ * return 0xFFffFFff instead of -1 for Digital Unix V4.0
+ * cc with optimization turned on */
+ (aint) ?
+ sv_setiv(sv, (IV)aint) :
+#endif
sv_setiv(sv, (IV)aint);
PUSHs(sv_2mortal(sv));
}
@@ -3101,6 +3370,17 @@ PP(pp_unpack)
Copy(s, &auint, 1, unsigned int);
s += sizeof(unsigned int);
sv = NEWSV(41, 0);
+#ifdef __osf__
+ /* Without the dummy below unpack("I", pack("I",0xFFFFFFFF))
+ * returns 1.84467440737096e+19 instead of 0xFFFFFFFF for
+ * DEC C V5.8-009 on Digital UNIX V4.0 (Rev. 1091) (aka V4.0D)
+ * with optimization turned on.
+ * (DEC C V5.2-040 on Digital UNIX V4.0 (Rev. 564) (aka V4.0B)
+ * does not have this problem even with -O4)
+ */
+ (auint) ?
+ sv_setuv(sv, (UV)auint) :
+#endif
sv_setuv(sv, (UV)auint);
PUSHs(sv_2mortal(sv));
}
@@ -3113,6 +3393,10 @@ PP(pp_unpack)
if (checksum) {
while (len-- > 0) {
COPY32(s, &along);
+#if LONGSIZE > SIZE32
+ if (along > 2147483647)
+ along -= 4294967296;
+#endif
s += SIZE32;
if (checksum > 32)
cdouble += (double)along;
@@ -3125,6 +3409,10 @@ PP(pp_unpack)
EXTEND_MORTAL(len);
while (len-- > 0) {
COPY32(s, &along);
+#if LONGSIZE > SIZE32
+ if (along > 2147483647)
+ along -= 4294967296;
+#endif
s += SIZE32;
sv = NEWSV(42, 0);
sv_setiv(sv, (IV)along);
@@ -3144,7 +3432,7 @@ PP(pp_unpack)
s += SIZE32;
#ifdef HAS_NTOHL
if (datumtype == 'N')
- aulong = ntohl(aulong);
+ aulong = PerlSock_ntohl(aulong);
#endif
#ifdef HAS_VTOHL
if (datumtype == 'V')
@@ -3164,7 +3452,7 @@ PP(pp_unpack)
s += SIZE32;
#ifdef HAS_NTOHL
if (datumtype == 'N')
- aulong = ntohl(aulong);
+ aulong = PerlSock_ntohl(aulong);
#endif
#ifdef HAS_VTOHL
if (datumtype == 'V')
@@ -3198,7 +3486,7 @@ PP(pp_unpack)
case 'w':
EXTEND(SP, len);
EXTEND_MORTAL(len);
- {
+ {
UV auv = 0;
U32 bytes = 0;
@@ -3214,6 +3502,7 @@ PP(pp_unpack)
}
else if (++bytes >= sizeof(UV)) { /* promote to string */
char *t;
+ STRLEN n_a;
sv = newSVpvf("%.*Vu", (int)TYPE_DIGITS(UV), auv);
while (s < strend) {
@@ -3223,7 +3512,7 @@ PP(pp_unpack)
break;
}
}
- t = SvPV(sv, na);
+ t = SvPV(sv, n_a);
while (*t == '0')
t++;
sv_chop(sv, t);
@@ -3251,6 +3540,9 @@ PP(pp_unpack)
break;
#ifdef HAS_QUAD
case 'q':
+ along = (strend - s) / sizeof(Quad_t);
+ if (len > along)
+ len = along;
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0) {
@@ -3269,6 +3561,9 @@ PP(pp_unpack)
}
break;
case 'Q':
+ along = (strend - s) / sizeof(Quad_t);
+ if (len > along)
+ len = along;
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0) {
@@ -3279,7 +3574,7 @@ PP(pp_unpack)
s += sizeof(unsigned Quad_t);
}
sv = NEWSV(43, 0);
- if (aquad <= UV_MAX)
+ if (auquad <= UV_MAX)
sv_setuv(sv, (UV)auquad);
else
sv_setnv(sv, (double)auquad);
@@ -3337,37 +3632,54 @@ PP(pp_unpack)
}
break;
case 'u':
+ /* MKS:
+ * Initialise the decode mapping. By using a table driven
+ * algorithm, the code will be character-set independent
+ * (and just as fast as doing character arithmetic)
+ */
+ if (uudmap['M'] == 0) {
+ int i;
+
+ for (i = 0; i < sizeof(uuemap); i += 1)
+ uudmap[uuemap[i]] = i;
+ /*
+ * Because ' ' and '`' map to the same value,
+ * we need to decode them both the same.
+ */
+ uudmap[' '] = 0;
+ }
+
along = (strend - s) * 3 / 4;
sv = NEWSV(42, along);
if (along)
SvPOK_on(sv);
- while (s < strend && *s > ' ' && *s < 'a') {
+ while (s < strend && *s > ' ' && ISUUCHAR(*s)) {
I32 a, b, c, d;
char hunk[4];
hunk[3] = '\0';
- len = (*s++ - ' ') & 077;
+ len = uudmap[*s++] & 077;
while (len > 0) {
- if (s < strend && *s >= ' ')
- a = (*s++ - ' ') & 077;
- else
- a = 0;
- if (s < strend && *s >= ' ')
- b = (*s++ - ' ') & 077;
- else
- b = 0;
- if (s < strend && *s >= ' ')
- c = (*s++ - ' ') & 077;
- else
- c = 0;
- if (s < strend && *s >= ' ')
- d = (*s++ - ' ') & 077;
+ if (s < strend && ISUUCHAR(*s))
+ a = uudmap[*s++] & 077;
+ else
+ a = 0;
+ if (s < strend && ISUUCHAR(*s))
+ b = uudmap[*s++] & 077;
+ else
+ b = 0;
+ if (s < strend && ISUUCHAR(*s))
+ c = uudmap[*s++] & 077;
+ else
+ c = 0;
+ if (s < strend && ISUUCHAR(*s))
+ d = uudmap[*s++] & 077;
else
d = 0;
- hunk[0] = a << 2 | b >> 4;
- hunk[1] = b << 4 | c >> 2;
- hunk[2] = c << 6 | d;
- sv_catpvn(sv, hunk, len > 3 ? 3 : len);
+ hunk[0] = (a << 2) | (b >> 4);
+ hunk[1] = (b << 4) | (c >> 2);
+ hunk[2] = (c << 6) | d;
+ sv_catpvn(sv, hunk, (len > 3) ? 3 : len);
len -= 3;
}
if (*s == '\n')
@@ -3412,45 +3724,45 @@ PP(pp_unpack)
checksum = 0;
}
}
- if (sp == oldsp && gimme == G_SCALAR)
- PUSHs(&sv_undef);
+ if (SP == oldsp && gimme == G_SCALAR)
+ PUSHs(&PL_sv_undef);
RETURN;
}
-static void
-doencodes(sv, s, len)
-register SV *sv;
-register char *s;
-register I32 len;
+STATIC void
+doencodes(register SV *sv, register char *s, register I32 len)
{
char hunk[5];
- *hunk = len + ' ';
+ *hunk = uuemap[len];
sv_catpvn(sv, hunk, 1);
hunk[4] = '\0';
- while (len > 0) {
- hunk[0] = ' ' + (077 & (*s >> 2));
- hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
- hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
- hunk[3] = ' ' + (077 & (s[2] & 077));
+ while (len > 2) {
+ hunk[0] = uuemap[(077 & (*s >> 2))];
+ hunk[1] = uuemap[(077 & (((*s << 4) & 060) | ((s[1] >> 4) & 017)))];
+ hunk[2] = uuemap[(077 & (((s[1] << 2) & 074) | ((s[2] >> 6) & 03)))];
+ hunk[3] = uuemap[(077 & (s[2] & 077))];
sv_catpvn(sv, hunk, 4);
s += 3;
len -= 3;
}
- for (s = SvPVX(sv); *s; s++) {
- if (*s == ' ')
- *s = '`';
+ if (len > 0) {
+ char r = (len > 1 ? s[1] : '\0');
+ hunk[0] = uuemap[(077 & (*s >> 2))];
+ hunk[1] = uuemap[(077 & (((*s << 4) & 060) | ((r >> 4) & 017)))];
+ hunk[2] = uuemap[(077 & ((r << 2) & 074))];
+ hunk[3] = uuemap[0];
+ sv_catpvn(sv, hunk, 4);
}
sv_catpvn(sv, "\n", 1);
}
-static SV *
-is_an_int(s, l)
- char *s;
- STRLEN l;
+STATIC SV *
+is_an_int(char *s, STRLEN l)
{
+ STRLEN n_a;
SV *result = newSVpv("", l);
- char *result_c = SvPV(result, na); /* convenience */
+ char *result_c = SvPV(result, n_a); /* convenience */
char *out = result_c;
bool skip = 1;
bool ignore = 0;
@@ -3494,10 +3806,10 @@ is_an_int(s, l)
return (result);
}
-static int
-div128(pnum, done)
- SV *pnum; /* must be '\0' terminated */
- bool *done;
+STATIC int
+div128(SV *pnum, bool *done)
+ /* must be '\0' terminated */
+
{
STRLEN len;
char *s = SvPV(pnum, len);
@@ -3525,7 +3837,7 @@ div128(pnum, done)
PP(pp_pack)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
register SV *cat = TARG;
register I32 items;
STRLEN fromlen;
@@ -3558,7 +3870,7 @@ PP(pp_pack)
MARK++;
sv_setpvn(cat, "", 0);
while (pat < patend) {
-#define NEXTFROM (items-- > 0 ? *MARK++ : &sv_no)
+#define NEXTFROM (items-- > 0 ? *MARK++ : &PL_sv_no)
datumtype = *pat++ & 0xFF;
if (isSPACE(datumtype))
continue;
@@ -3577,7 +3889,7 @@ PP(pp_pack)
default:
croak("Invalid type in pack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
- if (commas++ == 0 && dowarn)
+ if (commas++ == 0 && PL_dowarn)
warn("Invalid type in pack: '%c'", (int)datumtype);
break;
case '%':
@@ -3606,6 +3918,7 @@ PP(pp_pack)
sv_catpvn(cat, null10, len);
break;
case 'A':
+ case 'Z':
case 'a':
fromstr = NEXTFROM;
aptr = SvPV(fromstr, fromlen);
@@ -3779,7 +4092,7 @@ PP(pp_pack)
fromstr = NEXTFROM;
ashort = (I16)SvIV(fromstr);
#ifdef HAS_HTONS
- ashort = htons(ashort);
+ ashort = PerlSock_htons(ashort);
#endif
CAT16(cat, &ashort);
}
@@ -3845,7 +4158,7 @@ PP(pp_pack)
SV *norm;
STRLEN len;
bool done;
-
+
/* Copy string and check for compliance */
from = SvPV(fromstr, len);
if ((norm = is_an_int(from, len)) == NULL)
@@ -3891,7 +4204,7 @@ PP(pp_pack)
fromstr = NEXTFROM;
aulong = SvUV(fromstr);
#ifdef HAS_HTONL
- aulong = htonl(aulong);
+ aulong = PerlSock_htonl(aulong);
#endif
CAT32(cat, &aulong);
}
@@ -3942,20 +4255,21 @@ PP(pp_pack)
case 'p':
while (len-- > 0) {
fromstr = NEXTFROM;
- if (fromstr == &sv_undef)
+ if (fromstr == &PL_sv_undef)
aptr = NULL;
else {
+ STRLEN n_a;
/* XXX better yet, could spirit away the string to
* a safe spot and hang on to it until the result
* of pack() (and all copies of the result) are
* gone.
*/
- if (dowarn && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
+ if (PL_dowarn && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
warn("Attempt to pack pointer to temporary value");
if (SvPOK(fromstr) || SvNIOK(fromstr))
- aptr = SvPV(fromstr,na);
+ aptr = SvPV(fromstr,n_a);
else
- aptr = SvPV_force(fromstr,na);
+ aptr = SvPV_force(fromstr,n_a);
}
sv_catpvn(cat, (char*)&aptr, sizeof(char*));
}
@@ -3989,9 +4303,10 @@ PP(pp_pack)
}
#undef NEXTFROM
+
PP(pp_split)
{
- dSP; dTARG;
+ djSP; dTARG;
AV *ary;
register I32 limit = POPi; /* note, negative is forever */
SV *sv = POPs;
@@ -4009,9 +4324,11 @@ PP(pp_split)
I32 origlimit = limit;
I32 realarray = 0;
I32 base;
- AV *oldstack = curstack;
+ AV *oldstack = PL_curstack;
I32 gimme = GIMME_V;
- I32 oldsave = savestack_ix;
+ I32 oldsave = PL_savestack_ix;
+ I32 make_mortal = 1;
+ MAGIC *mg = (MAGIC *) NULL;
#ifdef DEBUGGING
Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*);
@@ -4028,22 +4345,35 @@ PP(pp_split)
if (pm->op_pmreplroot)
ary = GvAVn((GV*)pm->op_pmreplroot);
else if (gimme != G_ARRAY)
- ary = GvAVn(defgv);
+#ifdef USE_THREADS
+ ary = (AV*)PL_curpad[0];
+#else
+ ary = GvAVn(PL_defgv);
+#endif /* USE_THREADS */
else
ary = Nullav;
if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
realarray = 1;
- if (!AvREAL(ary)) {
- AvREAL_on(ary);
- for (i = AvFILL(ary); i >= 0; i--)
- AvARRAY(ary)[i] = &sv_undef; /* don't free mere refs */
- }
+ PUTBACK;
av_extend(ary,0);
av_clear(ary);
- /* temporarily switch stacks */
- SWITCHSTACK(curstack, ary);
+ SPAGAIN;
+ if (mg = SvTIED_mg((SV*)ary, 'P')) {
+ PUSHMARK(SP);
+ XPUSHs(SvTIED_obj((SV*)ary, mg));
+ }
+ else {
+ if (!AvREAL(ary)) {
+ AvREAL_on(ary);
+ for (i = AvFILLp(ary); i >= 0; i--)
+ AvARRAY(ary)[i] = &PL_sv_undef; /* don't free mere refs */
+ }
+ /* temporarily switch stacks */
+ SWITCHSTACK(PL_curstack, ary);
+ make_mortal = 0;
+ }
}
- base = SP - stack_base;
+ base = SP - PL_stack_base;
orig = s;
if (pm->op_pmflags & PMf_SKIPWHITE) {
if (pm->op_pmflags & PMf_LOCALE) {
@@ -4056,8 +4386,8 @@ PP(pp_split)
}
}
if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
- SAVEINT(multiline);
- multiline = pm->op_pmflags & PMf_MULTILINE;
+ SAVEINT(PL_multiline);
+ PL_multiline = pm->op_pmflags & PMf_MULTILINE;
}
if (!limit)
@@ -4074,7 +4404,7 @@ PP(pp_split)
dstr = NEWSV(30, m-s);
sv_setpvn(dstr, s, m-s);
- if (!realarray)
+ if (make_mortal)
sv_2mortal(dstr);
XPUSHs(dstr);
@@ -4094,16 +4424,18 @@ PP(pp_split)
break;
dstr = NEWSV(30, m-s);
sv_setpvn(dstr, s, m-s);
- if (!realarray)
+ if (make_mortal)
sv_2mortal(dstr);
XPUSHs(dstr);
s = m;
}
}
- else if (pm->op_pmshort && !rx->nparens) {
- i = SvCUR(pm->op_pmshort);
- if (i == 1) {
- i = *SvPVX(pm->op_pmshort);
+ else if (rx->check_substr && !rx->nparens
+ && (rx->reganch & ROPT_CHECK_ALL)
+ && !(rx->reganch & ROPT_ANCH)) {
+ i = SvCUR(rx->check_substr);
+ if (i == 1 && !SvTAIL(rx->check_substr)) {
+ i = *SvPVX(rx->check_substr);
while (--limit) {
/*SUPPRESS 530*/
for (m = s; m < strend && *m != i; m++) ;
@@ -4111,7 +4443,7 @@ PP(pp_split)
break;
dstr = NEWSV(30, m-s);
sv_setpvn(dstr, s, m-s);
- if (!realarray)
+ if (make_mortal)
sv_2mortal(dstr);
XPUSHs(dstr);
s = m + 1;
@@ -4121,12 +4453,12 @@ PP(pp_split)
#ifndef lint
while (s < strend && --limit &&
(m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
- pm->op_pmshort)) )
+ rx->check_substr, 0)) )
#endif
{
dstr = NEWSV(31, m-s);
sv_setpvn(dstr, s, m-s);
- if (!realarray)
+ if (make_mortal)
sv_2mortal(dstr);
XPUSHs(dstr);
s = m + i;
@@ -4136,9 +4468,9 @@ PP(pp_split)
else {
maxiters += (strend - s) * rx->nparens;
while (s < strend && --limit &&
- pregexec(rx, s, strend, orig, 1, Nullsv, TRUE))
+ CALLREGEXEC(rx, s, strend, orig, 1, Nullsv, NULL, 0))
{
- TAINT_IF(rx->exec_tainted);
+ TAINT_IF(RX_MATCH_TAINTED(rx));
if (rx->subbase
&& rx->subbase != orig) {
m = s;
@@ -4150,7 +4482,7 @@ PP(pp_split)
m = rx->startp[0];
dstr = NEWSV(32, m-s);
sv_setpvn(dstr, s, m-s);
- if (!realarray)
+ if (make_mortal)
sv_2mortal(dstr);
XPUSHs(dstr);
if (rx->nparens) {
@@ -4163,7 +4495,7 @@ PP(pp_split)
}
else
dstr = NEWSV(33, 0);
- if (!realarray)
+ if (make_mortal)
sv_2mortal(dstr);
XPUSHs(dstr);
}
@@ -4171,16 +4503,17 @@ PP(pp_split)
s = rx->endp[0];
}
}
+
LEAVE_SCOPE(oldsave);
- iters = (SP - stack_base) - base;
+ iters = (SP - PL_stack_base) - base;
if (iters > maxiters)
DIE("Split loop");
-
+
/* keep field after final delim? */
if (s < strend || (iters && origlimit)) {
dstr = NEWSV(34, strend-s);
sv_setpvn(dstr, s, strend-s);
- if (!realarray)
+ if (make_mortal)
sv_2mortal(dstr);
XPUSHs(dstr);
iters++;
@@ -4189,18 +4522,37 @@ PP(pp_split)
while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0))
iters--, SP--;
}
+
if (realarray) {
- SWITCHSTACK(ary, oldstack);
- if (SvSMAGICAL(ary)) {
+ if (!mg) {
+ SWITCHSTACK(ary, oldstack);
+ if (SvSMAGICAL(ary)) {
+ PUTBACK;
+ mg_set((SV*)ary);
+ SPAGAIN;
+ }
+ if (gimme == G_ARRAY) {
+ EXTEND(SP, iters);
+ Copy(AvARRAY(ary), SP + 1, iters, SV*);
+ SP += iters;
+ RETURN;
+ }
+ }
+ else {
PUTBACK;
- mg_set((SV*)ary);
+ ENTER;
+ perl_call_method("PUSH",G_SCALAR|G_DISCARD);
+ LEAVE;
SPAGAIN;
- }
- if (gimme == G_ARRAY) {
- EXTEND(SP, iters);
- Copy(AvARRAY(ary), SP + 1, iters, SV*);
- SP += iters;
- RETURN;
+ if (gimme == G_ARRAY) {
+ /* EXTEND should not be needed - we just popped them */
+ EXTEND(SP, iters);
+ for (i=0; i < iters; i++) {
+ SV **svp = av_fetch(ary, i, FALSE);
+ PUSHs((svp) ? *svp : &PL_sv_undef);
+ }
+ RETURN;
+ }
}
}
else {
@@ -4215,3 +4567,70 @@ PP(pp_split)
RETPUSHUNDEF;
}
+#ifdef USE_THREADS
+void
+unlock_condpair(void *svv)
+{
+ dTHR;
+ MAGIC *mg = mg_find((SV*)svv, 'm');
+
+ if (!mg)
+ croak("panic: unlock_condpair unlocking non-mutex");
+ MUTEX_LOCK(MgMUTEXP(mg));
+ if (MgOWNER(mg) != thr)
+ croak("panic: unlock_condpair unlocking mutex that we don't own");
+ MgOWNER(mg) = 0;
+ COND_SIGNAL(MgOWNERCONDP(mg));
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: unlock 0x%lx\n",
+ (unsigned long)thr, (unsigned long)svv);)
+ MUTEX_UNLOCK(MgMUTEXP(mg));
+}
+#endif /* USE_THREADS */
+
+PP(pp_lock)
+{
+ djSP;
+ dTOPss;
+ SV *retsv = sv;
+#ifdef USE_THREADS
+ MAGIC *mg;
+
+ if (SvROK(sv))
+ sv = SvRV(sv);
+
+ mg = condpair_magic(sv);
+ MUTEX_LOCK(MgMUTEXP(mg));
+ if (MgOWNER(mg) == thr)
+ MUTEX_UNLOCK(MgMUTEXP(mg));
+ else {
+ while (MgOWNER(mg))
+ COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
+ MgOWNER(mg) = thr;
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n",
+ (unsigned long)thr, (unsigned long)sv);)
+ MUTEX_UNLOCK(MgMUTEXP(mg));
+ save_destructor(unlock_condpair, sv);
+ }
+#endif /* USE_THREADS */
+ if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
+ || SvTYPE(retsv) == SVt_PVCV) {
+ retsv = refto(retsv);
+ }
+ SETs(retsv);
+ RETURN;
+}
+
+PP(pp_threadsv)
+{
+ djSP;
+#ifdef USE_THREADS
+ EXTEND(SP, 1);
+ if (PL_op->op_private & OPpLVAL_INTRO)
+ PUSHs(*save_threadsv(PL_op->op_targ));
+ else
+ PUSHs(THREADSV(PL_op->op_targ));
+ RETURN;
+#else
+ DIE("tried to access per-thread data in non-threaded perl");
+#endif /* USE_THREADS */
+}
diff --git a/gnu/usr.bin/perl/pp.h b/gnu/usr.bin/perl/pp.h
index 3c3bdcf9c07..c0cebcc2969 100644
--- a/gnu/usr.bin/perl/pp.h
+++ b/gnu/usr.bin/perl/pp.h
@@ -1,80 +1,91 @@
/* pp.h
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
*
*/
+#ifdef USE_THREADS
+#define ARGS thr
+#define dARGS struct perl_thread *thr;
+#else
#define ARGS
-#define ARGSproto void
#define dARGS
-#define PP(s) OP* s(ARGS) dARGS
+#endif /* USE_THREADS */
+#ifdef PERL_OBJECT
+#define PP(s) OP * CPerlObj::s(ARGSproto)
+#else
+#define PP(s) OP * s(ARGSproto)
+#endif
#define SP sp
#define MARK mark
#define TARG targ
-#define PUSHMARK(p) if (++markstack_ptr == markstack_max) \
+#define PUSHMARK(p) if (++PL_markstack_ptr == PL_markstack_max) \
markstack_grow(); \
- *markstack_ptr = (p) - stack_base
+ *PL_markstack_ptr = (p) - PL_stack_base
-#define TOPMARK (*markstack_ptr)
-#define POPMARK (*markstack_ptr--)
+#define TOPMARK (*PL_markstack_ptr)
+#define POPMARK (*PL_markstack_ptr--)
-#define dSP register SV **sp = stack_sp
-#define dMARK register SV **mark = stack_base + POPMARK
-#define dORIGMARK I32 origmark = mark - stack_base
-#define SETORIGMARK origmark = mark - stack_base
-#define ORIGMARK (stack_base + origmark)
+#define djSP register SV **sp = PL_stack_sp
+#define dSP dTHR; djSP
+#define dMARK register SV **mark = PL_stack_base + POPMARK
+#define dORIGMARK I32 origmark = mark - PL_stack_base
+#define SETORIGMARK origmark = mark - PL_stack_base
+#define ORIGMARK (PL_stack_base + origmark)
-#define SPAGAIN sp = stack_sp
-#define MSPAGAIN sp = stack_sp; mark = ORIGMARK
+#define SPAGAIN sp = PL_stack_sp
+#define MSPAGAIN sp = PL_stack_sp; mark = ORIGMARK
-#define GETTARGETSTACKED targ = (op->op_flags & OPf_STACKED ? POPs : PAD_SV(op->op_targ))
+#define GETTARGETSTACKED targ = (PL_op->op_flags & OPf_STACKED ? POPs : PAD_SV(PL_op->op_targ))
#define dTARGETSTACKED SV * GETTARGETSTACKED
-#define GETTARGET targ = PAD_SV(op->op_targ)
+#define GETTARGET targ = PAD_SV(PL_op->op_targ)
#define dTARGET SV * GETTARGET
-#define GETATARGET targ = (op->op_flags & OPf_STACKED ? sp[-1] : PAD_SV(op->op_targ))
+#define GETATARGET targ = (PL_op->op_flags & OPf_STACKED ? sp[-1] : PAD_SV(PL_op->op_targ))
#define dATARGET SV * GETATARGET
#define dTARG SV *targ
-#define NORMAL op->op_next
+#define NORMAL PL_op->op_next
#define DIE return die
-#define PUTBACK stack_sp = sp
+#define PUTBACK PL_stack_sp = sp
#define RETURN return PUTBACK, NORMAL
#define RETURNOP(o) return PUTBACK, o
#define RETURNX(x) return x, PUTBACK, NORMAL
#define POPs (*sp--)
-#define POPp (SvPVx(POPs, na))
+#define POPp (SvPVx(POPs, PL_na)) /* deprecated */
+#define POPpx (SvPVx(POPs, n_a))
#define POPn (SvNVx(POPs))
#define POPi ((IV)SvIVx(POPs))
#define POPu ((UV)SvUVx(POPs))
#define POPl ((long)SvIVx(POPs))
#define TOPs (*sp)
-#define TOPp (SvPV(TOPs, na))
+#define TOPp (SvPV(TOPs, PL_na)) /* deprecated */
+#define TOPpx (SvPV(TOPs, n_a))
#define TOPn (SvNV(TOPs))
#define TOPi ((IV)SvIV(TOPs))
#define TOPu ((UV)SvUV(TOPs))
#define TOPl ((long)SvIV(TOPs))
/* Go to some pains in the rare event that we must extend the stack. */
-#define EXTEND(p,n) STMT_START { if (stack_max - p < (n)) { \
+#define EXTEND(p,n) STMT_START { if (PL_stack_max - p < (n)) { \
sp = stack_grow(sp,p, (int) (n)); \
} } STMT_END
/* Same thing, but update mark register too. */
-#define MEXTEND(p,n) STMT_START {if (stack_max - p < (n)) { \
- int markoff = mark - stack_base; \
+#define MEXTEND(p,n) STMT_START {if (PL_stack_max - p < (n)) { \
+ int markoff = mark - PL_stack_base; \
sp = stack_grow(sp,p,(int) (n)); \
- mark = stack_base + markoff; \
+ mark = PL_stack_base + markoff; \
} } STMT_END
#define PUSHs(s) (*++sp = (s))
@@ -112,7 +123,7 @@
#define dPOPXiirl(X) IV right = POPi; IV left = CAT2(X,i)
#define USE_LEFT(sv) \
- (SvOK(sv) || SvGMAGICAL(sv) || !(op->op_flags & OPf_STACKED))
+ (SvOK(sv) || SvGMAGICAL(sv) || !(PL_op->op_flags & OPf_STACKED))
#define dPOPXnnrl_ul(X) \
double right = POPn; \
SV *leftsv = CAT2(X,s); \
@@ -134,27 +145,30 @@
#define dPOPTOPiirl dPOPXiirl(TOP)
#define dPOPTOPiirl_ul dPOPXiirl_ul(TOP)
-#define RETPUSHYES RETURNX(PUSHs(&sv_yes))
-#define RETPUSHNO RETURNX(PUSHs(&sv_no))
-#define RETPUSHUNDEF RETURNX(PUSHs(&sv_undef))
+#define RETPUSHYES RETURNX(PUSHs(&PL_sv_yes))
+#define RETPUSHNO RETURNX(PUSHs(&PL_sv_no))
+#define RETPUSHUNDEF RETURNX(PUSHs(&PL_sv_undef))
-#define RETSETYES RETURNX(SETs(&sv_yes))
-#define RETSETNO RETURNX(SETs(&sv_no))
-#define RETSETUNDEF RETURNX(SETs(&sv_undef))
+#define RETSETYES RETURNX(SETs(&PL_sv_yes))
+#define RETSETNO RETURNX(SETs(&PL_sv_no))
+#define RETSETUNDEF RETURNX(SETs(&PL_sv_undef))
-#define ARGTARG op->op_targ
-#define MAXARG op->op_private
+#define ARGTARG PL_op->op_targ
+#define MAXARG PL_op->op_private
-#define SWITCHSTACK(f,t) AvFILL(f) = sp - stack_base; \
- stack_base = AvARRAY(t); \
- stack_max = stack_base + AvMAX(t); \
- sp = stack_sp = stack_base + AvFILL(t); \
- curstack = t;
+#define SWITCHSTACK(f,t) \
+ STMT_START { \
+ AvFILLp(f) = sp - PL_stack_base; \
+ PL_stack_base = AvARRAY(t); \
+ PL_stack_max = PL_stack_base + AvMAX(t); \
+ sp = PL_stack_sp = PL_stack_base + AvFILLp(t); \
+ PL_curstack = t; \
+ } STMT_END
#define EXTEND_MORTAL(n) \
STMT_START { \
- if (tmps_ix + (n) >= tmps_max) \
- Renew(tmps_stack, tmps_max = tmps_ix + (n) + 1, SV*); \
+ if (PL_tmps_ix + (n) >= PL_tmps_max) \
+ Renew(PL_tmps_stack, PL_tmps_max = PL_tmps_ix + (n) + 1, SV*); \
} STMT_END
#ifdef OVERLOAD
@@ -165,7 +179,7 @@
#define AMGf_unary 8
#define tryAMAGICbinW(meth,assign,set) STMT_START { \
- if (amagic_generation) { \
+ if (PL_amagic_generation) { \
SV* tmpsv; \
SV* right= *(sp); SV* left= *(sp-1);\
if ((SvAMAGIC(left)||SvAMAGIC(right))&&\
@@ -181,13 +195,13 @@
#define tryAMAGICbin(meth,assign) tryAMAGICbinW(meth,assign,SETsv)
#define tryAMAGICbinSET(meth,assign) tryAMAGICbinW(meth,assign,SETs)
-#define AMG_CALLun(sv,meth) amagic_call(sv,&sv_undef, \
+#define AMG_CALLun(sv,meth) amagic_call(sv,&PL_sv_undef, \
CAT2(meth,_amg),AMGf_noright | AMGf_unary)
#define AMG_CALLbinL(left,right,meth) \
amagic_call(left,right,CAT2(meth,_amg),AMGf_noright)
#define tryAMAGICunW(meth,set) STMT_START { \
- if (amagic_generation) { \
+ if (PL_amagic_generation) { \
SV* tmpsv; \
SV* arg= *(sp); \
if ((SvAMAGIC(arg))&&\
@@ -200,7 +214,7 @@
#define tryAMAGICun tryAMAGICunSET
#define tryAMAGICunSET(meth) tryAMAGICunW(meth,SETs)
-#define opASSIGN (op->op_flags & OPf_STACKED)
+#define opASSIGN (PL_op->op_flags & OPf_STACKED)
#define SETsv(sv) STMT_START { \
if (opASSIGN) { sv_setsv(TARG, (sv)); SETTARG; } \
else SETs(sv); } STMT_END
@@ -208,10 +222,11 @@
/* newSVsv does not behave as advertised, so we copy missing
* information by hand */
-
-#define RvDEEPCP(rv) STMT_START { SV* ref=SvRV(rv); \
- if (SvREFCNT(ref)>1) { \
- SvREFCNT_dec(ref); \
+/* SV* ref causes confusion with the member variable
+ changed SV* ref to SV* tmpRef */
+#define RvDEEPCP(rv) STMT_START { SV* tmpRef=SvRV(rv); \
+ if (SvREFCNT(tmpRef)>1) { \
+ SvREFCNT_dec(tmpRef); \
SvRV(rv)=AMG_CALLun(rv,copy); \
} } STMT_END
#else
diff --git a/gnu/usr.bin/perl/pp_ctl.c b/gnu/usr.bin/perl/pp_ctl.c
index 516e41e5b1c..653a3455f84 100644
--- a/gnu/usr.bin/perl/pp_ctl.c
+++ b/gnu/usr.bin/perl/pp_ctl.c
@@ -1,6 +1,6 @@
/* pp_ctl.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -25,24 +25,27 @@
#define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o))
+#ifdef PERL_OBJECT
+#define CALLOP this->*PL_op
+#else
+#define CALLOP *PL_op
static OP *docatch _((OP *o));
-static OP *doeval _((int gimme));
-static OP *dofindlabel _((OP *op, char *label, OP **opstack, OP **oplimit));
+static OP *dofindlabel _((OP *o, char *label, OP **opstack, OP **oplimit));
static void doparseform _((SV *sv));
static I32 dopoptoeval _((I32 startingblock));
static I32 dopoptolabel _((char *label));
static I32 dopoptoloop _((I32 startingblock));
static I32 dopoptosub _((I32 startingblock));
+static I32 dopoptosub_at _((PERL_CONTEXT *cxstk, I32 startingblock));
static void save_lines _((AV *array, SV *sv));
-static int sortcv _((const void *, const void *));
-static int sortcmp _((const void *, const void *));
-static int sortcmp_locale _((const void *, const void *));
-
-static I32 sortcxix;
+static I32 sortcv _((SV *a, SV *b));
+static void qsortsv _((SV **array, size_t num_elts, I32 (*fun)(SV *a, SV *b)));
+static OP *doeval _((int gimme, OP** startop));
+#endif
PP(pp_wantarray)
{
- dSP;
+ djSP;
I32 cxix;
EXTEND(SP, 1);
@@ -65,47 +68,82 @@ PP(pp_regcmaybe)
return NORMAL;
}
-PP(pp_regcomp) {
- dSP;
+PP(pp_regcreset)
+{
+ /* XXXX Should store the old value to allow for tie/overload - and
+ restore in regcomp, where marked with XXXX. */
+ PL_reginterp_cnt = 0;
+ return NORMAL;
+}
+
+PP(pp_regcomp)
+{
+ djSP;
register PMOP *pm = (PMOP*)cLOGOP->op_other;
register char *t;
SV *tmpstr;
STRLEN len;
+ MAGIC *mg = Null(MAGIC*);
tmpstr = POPs;
- t = SvPV(tmpstr, len);
-
- /* JMR: Check against the last compiled regexp */
- if ( ! pm->op_pmregexp || ! pm->op_pmregexp->precomp
- || strnNE(pm->op_pmregexp->precomp, t, len)
- || pm->op_pmregexp->precomp[len]) {
- if (pm->op_pmregexp) {
- pregfree(pm->op_pmregexp);
- pm->op_pmregexp = Null(REGEXP*); /* crucial if regcomp aborts */
+ if (SvROK(tmpstr)) {
+ SV *sv = SvRV(tmpstr);
+ if(SvMAGICAL(sv))
+ mg = mg_find(sv, 'r');
+ }
+ if (mg) {
+ regexp *re = (regexp *)mg->mg_obj;
+ ReREFCNT_dec(pm->op_pmregexp);
+ pm->op_pmregexp = ReREFCNT_inc(re);
+ }
+ else {
+ t = SvPV(tmpstr, len);
+
+ /* Check against the last compiled regexp. */
+ if (!pm->op_pmregexp || !pm->op_pmregexp->precomp ||
+ pm->op_pmregexp->prelen != len ||
+ memNE(pm->op_pmregexp->precomp, t, len))
+ {
+ if (pm->op_pmregexp) {
+ ReREFCNT_dec(pm->op_pmregexp);
+ pm->op_pmregexp = Null(REGEXP*); /* crucial if regcomp aborts */
+ }
+ if (PL_op->op_flags & OPf_SPECIAL)
+ PL_reginterp_cnt = I32_MAX; /* Mark as safe. */
+
+ pm->op_pmflags = pm->op_pmpermflags; /* reset case sensitivity */
+ pm->op_pmregexp = CALLREGCOMP(t, t + len, pm);
+ PL_reginterp_cnt = 0; /* XXXX Be extra paranoid - needed
+ inside tie/overload accessors. */
}
+ }
- pm->op_pmflags = pm->op_pmpermflags; /* reset case sensitivity */
- pm->op_pmregexp = pregcomp(t, t + len, pm);
+#ifndef INCOMPLETE_TAINTS
+ if (PL_tainting) {
+ if (PL_tainted)
+ pm->op_pmdynflags |= PMdf_TAINTED;
+ else
+ pm->op_pmdynflags &= ~PMdf_TAINTED;
}
+#endif
- if (!pm->op_pmregexp->prelen && curpm)
- pm = curpm;
+ if (!pm->op_pmregexp->prelen && PL_curpm)
+ pm = PL_curpm;
else if (strEQ("\\s+", pm->op_pmregexp->precomp))
pm->op_pmflags |= PMf_WHITE;
if (pm->op_pmflags & PMf_KEEP) {
pm->op_private &= ~OPpRUNTIME; /* no point compiling again */
- hoistmust(pm);
- cLOGOP->op_first->op_next = op->op_next;
+ cLOGOP->op_first->op_next = PL_op->op_next;
}
RETURN;
}
PP(pp_substcont)
{
- dSP;
+ djSP;
register PMOP *pm = (PMOP*) cLOGOP->op_other;
- register CONTEXT *cx = &cxstack[cxstack_ix];
+ register PERL_CONTEXT *cx = &cxstack[cxstack_ix];
register SV *dstr = cx->sb_dstr;
register char *s = cx->sb_s;
register char *m = cx->sb_m;
@@ -118,18 +156,19 @@ PP(pp_substcont)
if (cx->sb_iters > cx->sb_maxiters)
DIE("Substitution loop");
- if (!cx->sb_rxtainted)
- cx->sb_rxtainted = SvTAINTED(TOPs);
+ if (!(cx->sb_rxtainted & 2) && SvTAINTED(TOPs))
+ cx->sb_rxtainted |= 2;
sv_catsv(dstr, POPs);
/* Are we done */
- if (cx->sb_once || !pregexec(rx, s, cx->sb_strend, orig,
- s == m, Nullsv, cx->sb_safebase))
+ if (cx->sb_once || !CALLREGEXEC(rx, s, cx->sb_strend, orig,
+ s == m, Nullsv, NULL,
+ cx->sb_safebase ? 0 : REXEC_COPY_STR))
{
SV *targ = cx->sb_targ;
sv_catpvn(dstr, s, cx->sb_strend - s);
- TAINT_IF(cx->sb_rxtainted || rx->exec_tainted);
+ cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
(void)SvOOK_off(targ);
Safefree(SvPVX(targ));
@@ -138,11 +177,15 @@ PP(pp_substcont)
SvLEN_set(targ, SvLEN(dstr));
SvPVX(dstr) = 0;
sv_free(dstr);
+
+ TAINT_IF(cx->sb_rxtainted & 1);
+ PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1)));
+
(void)SvPOK_only(targ);
+ TAINT_IF(cx->sb_rxtainted);
SvSETMAGIC(targ);
SvTAINT(targ);
- PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1)));
LEAVE_SCOPE(cx->sb_oldsave);
POPSUBST(cx);
RETURNOP(pm->op_next);
@@ -158,15 +201,13 @@ PP(pp_substcont)
cx->sb_m = m = rx->startp[0];
sv_catpvn(dstr, s, m-s);
cx->sb_s = rx->endp[0];
- cx->sb_rxtainted |= rx->exec_tainted;
+ cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
rxres_save(&cx->sb_rxres, rx);
RETURNOP(pm->op_pmreplstart);
}
void
-rxres_save(rsp, rx)
-void **rsp;
-REGEXP *rx;
+rxres_save(void **rsp, REGEXP *rx)
{
UV *p = (UV*)*rsp;
U32 i;
@@ -194,9 +235,7 @@ REGEXP *rx;
}
void
-rxres_restore(rsp, rx)
-void **rsp;
-REGEXP *rx;
+rxres_restore(void **rsp, REGEXP *rx)
{
UV *p = (UV*)*rsp;
U32 i;
@@ -216,8 +255,7 @@ REGEXP *rx;
}
void
-rxres_free(rsp)
-void **rsp;
+rxres_free(void **rsp)
{
UV *p = (UV*)*rsp;
@@ -230,8 +268,8 @@ void **rsp;
PP(pp_formline)
{
- dSP; dMARK; dORIGMARK;
- register SV *form = *++MARK;
+ djSP; dMARK; dORIGMARK;
+ register SV *tmpForm = *++MARK;
register U16 *fpc;
register char *t;
register char *f;
@@ -243,24 +281,24 @@ PP(pp_formline)
I32 itemsize;
I32 fieldsize;
I32 lines = 0;
- bool chopspace = (strchr(chopset, ' ') != Nullch);
+ bool chopspace = (strchr(PL_chopset, ' ') != Nullch);
char *chophere;
char *linemark;
double value;
bool gotsome;
STRLEN len;
- if (!SvMAGICAL(form) || !SvCOMPILED(form)) {
- SvREADONLY_off(form);
- doparseform(form);
+ if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) {
+ SvREADONLY_off(tmpForm);
+ doparseform(tmpForm);
}
- SvPV_force(formtarget, len);
- t = SvGROW(formtarget, len + SvCUR(form) + 1); /* XXX SvCUR bad */
+ SvPV_force(PL_formtarget, len);
+ t = SvGROW(PL_formtarget, len + SvCUR(tmpForm) + 1); /* XXX SvCUR bad */
t += len;
- f = SvPV(form, len);
+ f = SvPV(tmpForm, len);
/* need to jump to the next word */
- s = f + len + WORD_ALIGN - SvCUR(form) % WORD_ALIGN;
+ s = f + len + WORD_ALIGN - SvCUR(tmpForm) % WORD_ALIGN;
fpc = (U16*)s;
@@ -317,8 +355,8 @@ PP(pp_formline)
if (MARK < SP)
sv = *++MARK;
else {
- sv = &sv_no;
- if (dowarn)
+ sv = &PL_sv_no;
+ if (PL_dowarn)
warn("Not enough format arguments");
}
break;
@@ -366,7 +404,7 @@ PP(pp_formline)
else {
if (*s & ~31)
gotsome = TRUE;
- if (strchr(chopset, *s))
+ if (strchr(PL_chopset, *s))
chophere = s + 1;
}
s++;
@@ -398,15 +436,13 @@ PP(pp_formline)
arg = itemsize;
s = item;
while (arg--) {
-#if 'z' - 'a' != 25
+#ifdef EBCDIC
int ch = *t++ = *s++;
- if (!iscntrl(ch))
- t[-1] = ' ';
+ if (iscntrl(ch))
#else
if ( !((*t++ = *s++) & ~31) )
- t[-1] = ' ';
#endif
-
+ t[-1] = ' ';
}
break;
@@ -433,10 +469,10 @@ PP(pp_formline)
lines++;
}
}
- SvCUR_set(formtarget, t - SvPVX(formtarget));
- sv_catpvn(formtarget, item, itemsize);
- SvGROW(formtarget, SvCUR(formtarget) + SvCUR(form) + 1);
- t = SvPVX(formtarget) + SvCUR(formtarget);
+ SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget));
+ sv_catpvn(PL_formtarget, item, itemsize);
+ SvGROW(PL_formtarget, SvCUR(PL_formtarget) + SvCUR(tmpForm) + 1);
+ t = SvPVX(PL_formtarget) + SvCUR(PL_formtarget);
}
break;
@@ -474,14 +510,14 @@ PP(pp_formline)
if (gotsome) {
if (arg) { /* repeat until fields exhausted? */
*t = '\0';
- SvCUR_set(formtarget, t - SvPVX(formtarget));
- lines += FmLINES(formtarget);
+ SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget));
+ lines += FmLINES(PL_formtarget);
if (lines == 200) {
arg = t - linemark;
if (strnEQ(linemark, linemark - arg, arg))
DIE("Runaway format");
}
- FmLINES(formtarget) = lines;
+ FmLINES(PL_formtarget) = lines;
SP = ORIGMARK;
RETURNOP(cLISTOP->op_first);
}
@@ -493,7 +529,13 @@ PP(pp_formline)
break;
case FF_MORE:
- if (itemsize) {
+ s = chophere;
+ send = item + len;
+ if (chopspace) {
+ while (*s && isSPACE(*s) && s < send)
+ s++;
+ }
+ if (s < send) {
arg = fieldsize - itemsize;
if (arg) {
fieldsize -= arg;
@@ -502,7 +544,7 @@ PP(pp_formline)
}
s = t - 3;
if (strnEQ(s," ",3)) {
- while (s > SvPVX(formtarget) && isSPACE(s[-1]))
+ while (s > SvPVX(PL_formtarget) && isSPACE(s[-1]))
s--;
}
*s++ = '.';
@@ -513,8 +555,8 @@ PP(pp_formline)
case FF_END:
*t = '\0';
- SvCUR_set(formtarget, t - SvPVX(formtarget));
- FmLINES(formtarget) += lines;
+ SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget));
+ FmLINES(PL_formtarget) += lines;
SP = ORIGMARK;
RETPUSHYES;
}
@@ -523,34 +565,38 @@ PP(pp_formline)
PP(pp_grepstart)
{
- dSP;
+ djSP;
SV *src;
- if (stack_base + *markstack_ptr == sp) {
+ if (PL_stack_base + *PL_markstack_ptr == SP) {
(void)POPMARK;
if (GIMME_V == G_SCALAR)
- XPUSHs(&sv_no);
- RETURNOP(op->op_next->op_next);
+ XPUSHs(&PL_sv_no);
+ RETURNOP(PL_op->op_next->op_next);
}
- stack_sp = stack_base + *markstack_ptr + 1;
- pp_pushmark(); /* push dst */
- pp_pushmark(); /* push src */
+ PL_stack_sp = PL_stack_base + *PL_markstack_ptr + 1;
+ pp_pushmark(ARGS); /* push dst */
+ pp_pushmark(ARGS); /* push src */
ENTER; /* enter outer scope */
SAVETMPS;
- SAVESPTR(GvSV(defgv));
-
+#ifdef USE_THREADS
+ /* SAVE_DEFSV does *not* suffice here */
+ save_sptr(&THREADSV(0));
+#else
+ SAVESPTR(GvSV(PL_defgv));
+#endif /* USE_THREADS */
ENTER; /* enter inner scope */
- SAVESPTR(curpm);
+ SAVESPTR(PL_curpm);
- src = stack_base[*markstack_ptr];
+ src = PL_stack_base[*PL_markstack_ptr];
SvTEMP_off(src);
- GvSV(defgv) = src;
+ DEFSV = src;
PUTBACK;
- if (op->op_type == OP_MAPSTART)
- pp_pushmark(); /* push top */
- return ((LOGOP*)op->op_next)->op_other;
+ if (PL_op->op_type == OP_MAPSTART)
+ pp_pushmark(ARGS); /* push top */
+ return ((LOGOP*)PL_op->op_next)->op_other;
}
PP(pp_mapstart)
@@ -560,28 +606,28 @@ PP(pp_mapstart)
PP(pp_mapwhile)
{
- dSP;
- I32 diff = (sp - stack_base) - *markstack_ptr;
+ djSP;
+ I32 diff = (SP - PL_stack_base) - *PL_markstack_ptr;
I32 count;
I32 shift;
SV** src;
SV** dst;
- ++markstack_ptr[-1];
+ ++PL_markstack_ptr[-1];
if (diff) {
- if (diff > markstack_ptr[-1] - markstack_ptr[-2]) {
- shift = diff - (markstack_ptr[-1] - markstack_ptr[-2]);
- count = (sp - stack_base) - markstack_ptr[-1] + 2;
+ if (diff > PL_markstack_ptr[-1] - PL_markstack_ptr[-2]) {
+ shift = diff - (PL_markstack_ptr[-1] - PL_markstack_ptr[-2]);
+ count = (SP - PL_stack_base) - PL_markstack_ptr[-1] + 2;
- EXTEND(sp,shift);
- src = sp;
- dst = (sp += shift);
- markstack_ptr[-1] += shift;
- *markstack_ptr += shift;
+ EXTEND(SP,shift);
+ src = SP;
+ dst = (SP += shift);
+ PL_markstack_ptr[-1] += shift;
+ *PL_markstack_ptr += shift;
while (--count)
*dst-- = *src--;
}
- dst = stack_base + (markstack_ptr[-2] += diff) - 1;
+ dst = PL_stack_base + (PL_markstack_ptr[-2] += diff) - 1;
++diff;
while (--diff)
*dst-- = SvTEMP(TOPs) ? POPs : sv_mortalcopy(POPs);
@@ -589,16 +635,16 @@ PP(pp_mapwhile)
LEAVE; /* exit inner scope */
/* All done yet? */
- if (markstack_ptr[-1] > *markstack_ptr) {
+ if (PL_markstack_ptr[-1] > *PL_markstack_ptr) {
I32 items;
I32 gimme = GIMME_V;
(void)POPMARK; /* pop top */
LEAVE; /* exit outer scope */
(void)POPMARK; /* pop src */
- items = --*markstack_ptr - markstack_ptr[-1];
+ items = --*PL_markstack_ptr - PL_markstack_ptr[-1];
(void)POPMARK; /* pop dst */
- SP = stack_base + POPMARK; /* pop original mark */
+ SP = PL_stack_base + POPMARK; /* pop original mark */
if (gimme == G_SCALAR) {
dTARGET;
XPUSHi(items);
@@ -611,20 +657,74 @@ PP(pp_mapwhile)
SV *src;
ENTER; /* enter inner scope */
- SAVESPTR(curpm);
+ SAVESPTR(PL_curpm);
- src = stack_base[markstack_ptr[-1]];
+ src = PL_stack_base[PL_markstack_ptr[-1]];
SvTEMP_off(src);
- GvSV(defgv) = src;
+ DEFSV = src;
RETURNOP(cLOGOP->op_other);
}
}
+#define tryCALL_AMAGICbin(left,right,meth,svp) STMT_START { \
+ *svp = Nullsv; \
+ if (PL_amagic_generation) { \
+ if (SvAMAGIC(left)||SvAMAGIC(right))\
+ *svp = amagic_call(left, \
+ right, \
+ CAT2(meth,_amg), \
+ 0); \
+ } \
+ } STMT_END
+
+STATIC I32
+amagic_cmp(register SV *str1, register SV *str2)
+{
+ SV *tmpsv;
+ tryCALL_AMAGICbin(str1,str2,scmp,&tmpsv);
+ if (tmpsv) {
+ double d;
+
+ if (SvIOK(tmpsv)) {
+ I32 i = SvIVX(tmpsv);
+ if (i > 0)
+ return 1;
+ return i? -1 : 0;
+ }
+ d = SvNV(tmpsv);
+ if (d > 0)
+ return 1;
+ return d? -1 : 0;
+ }
+ return sv_cmp(str1, str2);
+}
+
+STATIC I32
+amagic_cmp_locale(register SV *str1, register SV *str2)
+{
+ SV *tmpsv;
+ tryCALL_AMAGICbin(str1,str2,scmp,&tmpsv);
+ if (tmpsv) {
+ double d;
+
+ if (SvIOK(tmpsv)) {
+ I32 i = SvIVX(tmpsv);
+ if (i > 0)
+ return 1;
+ return i? -1 : 0;
+ }
+ d = SvNV(tmpsv);
+ if (d > 0)
+ return 1;
+ return d? -1 : 0;
+ }
+ return sv_cmp_locale(str1, str2);
+}
PP(pp_sort)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
register SV **up;
SV **myorigmark = ORIGMARK;
register I32 max;
@@ -632,21 +732,23 @@ PP(pp_sort)
GV *gv;
CV *cv;
I32 gimme = GIMME;
- OP* nextop = op->op_next;
+ OP* nextop = PL_op->op_next;
+ I32 overloading = 0;
if (gimme != G_ARRAY) {
SP = MARK;
RETPUSHUNDEF;
}
- if (op->op_flags & OPf_STACKED) {
- ENTER;
- if (op->op_flags & OPf_SPECIAL) {
+ ENTER;
+ SAVEPPTR(PL_sortcop);
+ if (PL_op->op_flags & OPf_STACKED) {
+ if (PL_op->op_flags & OPf_SPECIAL) {
OP *kid = cLISTOP->op_first->op_sibling; /* pass pushmark */
kid = kUNOP->op_first; /* pass rv2gv */
kid = kUNOP->op_first; /* pass leave */
- sortcop = kid->op_next;
- stash = curcop->cop_stash;
+ PL_sortcop = kid->op_next;
+ stash = PL_curcop->cop_stash;
}
else {
cv = sv_2cv(*++MARK, &stash, &gv, 0);
@@ -666,17 +768,17 @@ PP(pp_sort)
}
DIE("Not a CODE reference in sort");
}
- sortcop = CvSTART(cv);
+ PL_sortcop = CvSTART(cv);
SAVESPTR(CvROOT(cv)->op_ppaddr);
CvROOT(cv)->op_ppaddr = ppaddr[OP_NULL];
- SAVESPTR(curpad);
- curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]);
+ SAVESPTR(PL_curpad);
+ PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]);
}
}
else {
- sortcop = Nullop;
- stash = curcop->cop_stash;
+ PL_sortcop = Nullop;
+ stash = PL_curcop->cop_stash;
}
up = myorigmark + 1;
@@ -684,41 +786,40 @@ PP(pp_sort)
/*SUPPRESS 560*/
if (*up = *++MARK) { /* Weed out nulls. */
SvTEMP_off(*up);
- if (!sortcop && !SvPOK(*up))
- (void)sv_2pv(*up, &na);
+ if (!PL_sortcop && !SvPOK(*up)) {
+ if (SvAMAGIC(*up))
+ overloading = 1;
+ else {
+ STRLEN n_a;
+ (void)sv_2pv(*up, &n_a);
+ }
+ }
up++;
}
}
max = --up - myorigmark;
- if (sortcop) {
+ if (PL_sortcop) {
if (max > 1) {
- AV *oldstack;
- CONTEXT *cx;
+ PERL_CONTEXT *cx;
SV** newsp;
bool oldcatch = CATCH_GET;
SAVETMPS;
- SAVESPTR(op);
+ SAVEOP();
- oldstack = curstack;
- if (!sortstack) {
- sortstack = newAV();
- AvREAL_off(sortstack);
- av_extend(sortstack, 32);
- }
CATCH_SET(TRUE);
- SWITCHSTACK(curstack, sortstack);
- if (sortstash != stash) {
- firstgv = gv_fetchpv("a", TRUE, SVt_PV);
- secondgv = gv_fetchpv("b", TRUE, SVt_PV);
- sortstash = stash;
+ PUSHSTACKi(PERLSI_SORT);
+ if (PL_sortstash != stash) {
+ PL_firstgv = gv_fetchpv("a", TRUE, SVt_PV);
+ PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV);
+ PL_sortstash = stash;
}
- SAVESPTR(GvSV(firstgv));
- SAVESPTR(GvSV(secondgv));
+ SAVESPTR(GvSV(PL_firstgv));
+ SAVESPTR(GvSV(PL_secondgv));
- PUSHBLOCK(cx, CXt_NULL, stack_base);
- if (!(op->op_flags & OPf_SPECIAL)) {
+ PUSHBLOCK(cx, CXt_NULL, PL_stack_base);
+ if (!(PL_op->op_flags & OPf_SPECIAL)) {
bool hasargs = FALSE;
cx->cx_type = CXt_SUB;
cx->blk_gimme = G_SCALAR;
@@ -726,24 +827,29 @@ PP(pp_sort)
if (!CvDEPTH(cv))
(void)SvREFCNT_inc(cv); /* in preparation for POPSUB */
}
- sortcxix = cxstack_ix;
-
- qsort((char*)(myorigmark+1), max, sizeof(SV*), sortcv);
+ PL_sortcxix = cxstack_ix;
+ qsortsv((myorigmark+1), max, FUNC_NAME_TO_PTR(sortcv));
- POPBLOCK(cx,curpm);
- SWITCHSTACK(sortstack, oldstack);
+ POPBLOCK(cx,PL_curpm);
+ POPSTACK;
CATCH_SET(oldcatch);
}
- LEAVE;
}
else {
if (max > 1) {
MEXTEND(SP, 20); /* Can't afford stack realloc on signal. */
- qsort((char*)(ORIGMARK+1), max, sizeof(SV*),
- (op->op_private & OPpLOCALE) ? sortcmp_locale : sortcmp);
+ qsortsv(ORIGMARK+1, max,
+ (PL_op->op_private & OPpLOCALE)
+ ? ( overloading
+ ? FUNC_NAME_TO_PTR(amagic_cmp_locale)
+ : FUNC_NAME_TO_PTR(sv_cmp_locale))
+ : ( overloading
+ ? FUNC_NAME_TO_PTR(amagic_cmp)
+ : FUNC_NAME_TO_PTR(sv_cmp) ));
}
}
- stack_sp = ORIGMARK + max;
+ LEAVE;
+ PL_stack_sp = ORIGMARK + max;
return nextop;
}
@@ -753,32 +859,32 @@ PP(pp_range)
{
if (GIMME == G_ARRAY)
return cCONDOP->op_true;
- return SvTRUEx(PAD_SV(op->op_targ)) ? cCONDOP->op_false : cCONDOP->op_true;
+ return SvTRUEx(PAD_SV(PL_op->op_targ)) ? cCONDOP->op_false : cCONDOP->op_true;
}
PP(pp_flip)
{
- dSP;
+ djSP;
if (GIMME == G_ARRAY) {
RETURNOP(((CONDOP*)cUNOP->op_first)->op_false);
}
else {
dTOPss;
- SV *targ = PAD_SV(op->op_targ);
+ SV *targ = PAD_SV(PL_op->op_targ);
- if ((op->op_private & OPpFLIP_LINENUM)
- ? last_in_gv && SvIV(sv) == IoLINES(GvIOp(last_in_gv))
+ if ((PL_op->op_private & OPpFLIP_LINENUM)
+ ? (PL_last_in_gv && SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv)))
: SvTRUE(sv) ) {
sv_setiv(PAD_SV(cUNOP->op_first->op_targ), 1);
- if (op->op_flags & OPf_SPECIAL) {
+ if (PL_op->op_flags & OPf_SPECIAL) {
sv_setiv(targ, 1);
SETs(targ);
RETURN;
}
else {
sv_setiv(targ, 0);
- sp--;
+ SP--;
RETURNOP(((CONDOP*)cUNOP->op_first)->op_false);
}
}
@@ -790,24 +896,29 @@ PP(pp_flip)
PP(pp_flop)
{
- dSP;
+ djSP;
if (GIMME == G_ARRAY) {
dPOPPOPssrl;
- register I32 i;
+ register I32 i, j;
register SV *sv;
I32 max;
if (SvNIOKp(left) || !SvPOKp(left) ||
(looks_like_number(left) && *SvPVX(left) != '0') )
{
+ if (SvNV(left) < IV_MIN || SvNV(right) > IV_MAX)
+ croak("Range iterator outside integer range");
i = SvIV(left);
max = SvIV(right);
if (max >= i) {
- EXTEND_MORTAL(max - i + 1);
- EXTEND(SP, max - i + 1);
+ j = max - i + 1;
+ EXTEND_MORTAL(j);
+ EXTEND(SP, j);
}
- while (i <= max) {
+ else
+ j = 0;
+ while (j--) {
sv = sv_2mortal(newSViv(i++));
PUSHs(sv);
}
@@ -815,25 +926,26 @@ PP(pp_flop)
else {
SV *final = sv_mortalcopy(right);
STRLEN len;
+ STRLEN n_a;
char *tmps = SvPV(final, len);
sv = sv_mortalcopy(left);
- while (!SvNIOKp(sv) && SvCUR(sv) <= len &&
- strNE(SvPVX(sv),tmps) ) {
+ SvPV_force(sv,n_a);
+ while (!SvNIOKp(sv) && SvCUR(sv) <= len) {
XPUSHs(sv);
+ if (strEQ(SvPVX(sv),tmps))
+ break;
sv = sv_2mortal(newSVsv(sv));
sv_inc(sv);
}
- if (strEQ(SvPVX(sv),tmps))
- XPUSHs(sv);
}
}
else {
dTOPss;
SV *targ = PAD_SV(cUNOP->op_first->op_targ);
sv_inc(targ);
- if ((op->op_private & OPpFLIP_LINENUM)
- ? last_in_gv && SvIV(sv) == IoLINES(GvIOp(last_in_gv))
+ if ((PL_op->op_private & OPpFLIP_LINENUM)
+ ? (PL_last_in_gv && SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv)))
: SvTRUE(sv) ) {
sv_setiv(PAD_SV(((UNOP*)cUNOP->op_first)->op_first->op_targ), 0);
sv_catpv(targ, "E0");
@@ -846,31 +958,31 @@ PP(pp_flop)
/* Control. */
-static I32
-dopoptolabel(label)
-char *label;
+STATIC I32
+dopoptolabel(char *label)
{
+ dTHR;
register I32 i;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
for (i = cxstack_ix; i >= 0; i--) {
cx = &cxstack[i];
- switch (cx->cx_type) {
+ switch (CxTYPE(cx)) {
case CXt_SUBST:
- if (dowarn)
- warn("Exiting substitution via %s", op_name[op->op_type]);
+ if (PL_dowarn)
+ warn("Exiting substitution via %s", op_name[PL_op->op_type]);
break;
case CXt_SUB:
- if (dowarn)
- warn("Exiting subroutine via %s", op_name[op->op_type]);
+ if (PL_dowarn)
+ warn("Exiting subroutine via %s", op_name[PL_op->op_type]);
break;
case CXt_EVAL:
- if (dowarn)
- warn("Exiting eval via %s", op_name[op->op_type]);
+ if (PL_dowarn)
+ warn("Exiting eval via %s", op_name[PL_op->op_type]);
break;
case CXt_NULL:
- if (dowarn)
- warn("Exiting pseudo-block via %s", op_name[op->op_type]);
+ if (PL_dowarn)
+ warn("Exiting pseudo-block via %s", op_name[PL_op->op_type]);
return -1;
case CXt_LOOP:
if (!cx->blk_loop.label ||
@@ -887,15 +999,16 @@ char *label;
}
I32
-dowantarray()
+dowantarray(void)
{
I32 gimme = block_gimme();
return (gimme == G_VOID) ? G_SCALAR : gimme;
}
I32
-block_gimme()
+block_gimme(void)
{
+ dTHR;
I32 cxix;
cxix = dopoptosub(cxstack_ix);
@@ -911,18 +1024,27 @@ block_gimme()
return G_ARRAY;
default:
croak("panic: bad gimme: %d\n", cxstack[cxix].blk_gimme);
+ /* NOTREACHED */
+ return 0;
}
}
-static I32
-dopoptosub(startingblock)
-I32 startingblock;
+STATIC I32
+dopoptosub(I32 startingblock)
+{
+ dTHR;
+ return dopoptosub_at(cxstack, startingblock);
+}
+
+STATIC I32
+dopoptosub_at(PERL_CONTEXT *cxstk, I32 startingblock)
{
+ dTHR;
I32 i;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
- cx = &cxstack[i];
- switch (cx->cx_type) {
+ cx = &cxstk[i];
+ switch (CxTYPE(cx)) {
default:
continue;
case CXt_EVAL:
@@ -934,15 +1056,15 @@ I32 startingblock;
return i;
}
-static I32
-dopoptoeval(startingblock)
-I32 startingblock;
+STATIC I32
+dopoptoeval(I32 startingblock)
{
+ dTHR;
I32 i;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
cx = &cxstack[i];
- switch (cx->cx_type) {
+ switch (CxTYPE(cx)) {
default:
continue;
case CXt_EVAL:
@@ -953,30 +1075,30 @@ I32 startingblock;
return i;
}
-static I32
-dopoptoloop(startingblock)
-I32 startingblock;
+STATIC I32
+dopoptoloop(I32 startingblock)
{
+ dTHR;
I32 i;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
cx = &cxstack[i];
- switch (cx->cx_type) {
+ switch (CxTYPE(cx)) {
case CXt_SUBST:
- if (dowarn)
- warn("Exiting substitution via %s", op_name[op->op_type]);
+ if (PL_dowarn)
+ warn("Exiting substitution via %s", op_name[PL_op->op_type]);
break;
case CXt_SUB:
- if (dowarn)
- warn("Exiting subroutine via %s", op_name[op->op_type]);
+ if (PL_dowarn)
+ warn("Exiting subroutine via %s", op_name[PL_op->op_type]);
break;
case CXt_EVAL:
- if (dowarn)
- warn("Exiting eval via %s", op_name[op->op_type]);
+ if (PL_dowarn)
+ warn("Exiting eval via %s", op_name[PL_op->op_type]);
break;
case CXt_NULL:
- if (dowarn)
- warn("Exiting pseudo-block via %s", op_name[op->op_type]);
+ if (PL_dowarn)
+ warn("Exiting pseudo-block via %s", op_name[PL_op->op_type]);
return -1;
case CXt_LOOP:
DEBUG_l( deb("(Found loop #%ld)\n", (long)i));
@@ -987,19 +1109,19 @@ I32 startingblock;
}
void
-dounwind(cxix)
-I32 cxix;
+dounwind(I32 cxix)
{
- register CONTEXT *cx;
+ dTHR;
+ register PERL_CONTEXT *cx;
SV **newsp;
I32 optype;
while (cxstack_ix > cxix) {
cx = &cxstack[cxstack_ix];
DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n",
- (long) cxstack_ix+1, block_type[cx->cx_type]));
+ (long) cxstack_ix, block_type[CxTYPE(cx)]));
/* Note: we don't need to restore the base context info till the end. */
- switch (cx->cx_type) {
+ switch (CxTYPE(cx)) {
case CXt_SUBST:
POPSUBST(cx);
continue; /* not break */
@@ -1020,62 +1142,76 @@ I32 cxix;
}
OP *
-die_where(message)
-char *message;
+die_where(char *message)
{
- if (in_eval) {
+ dSP;
+ STRLEN n_a;
+ if (PL_in_eval) {
I32 cxix;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 gimme;
SV **newsp;
- if (in_eval & 4) {
- SV **svp;
- STRLEN klen = strlen(message);
-
- svp = hv_fetch(GvHV(errgv), message, klen, TRUE);
- if (svp) {
- if (!SvIOK(*svp)) {
- static char prefix[] = "\t(in cleanup) ";
- sv_upgrade(*svp, SVt_IV);
- (void)SvIOK_only(*svp);
- SvGROW(GvSV(errgv), SvCUR(GvSV(errgv))+sizeof(prefix)+klen);
- sv_catpvn(GvSV(errgv), prefix, sizeof(prefix)-1);
- sv_catpvn(GvSV(errgv), message, klen);
+ if (message) {
+ if (PL_in_eval & 4) {
+ SV **svp;
+ STRLEN klen = strlen(message);
+
+ svp = hv_fetch(ERRHV, message, klen, TRUE);
+ if (svp) {
+ if (!SvIOK(*svp)) {
+ static char prefix[] = "\t(in cleanup) ";
+ SV *err = ERRSV;
+ sv_upgrade(*svp, SVt_IV);
+ (void)SvIOK_only(*svp);
+ if (!SvPOK(err))
+ sv_setpv(err,"");
+ SvGROW(err, SvCUR(err)+sizeof(prefix)+klen);
+ sv_catpvn(err, prefix, sizeof(prefix)-1);
+ sv_catpvn(err, message, klen);
+ }
+ sv_inc(*svp);
}
- sv_inc(*svp);
}
+ else
+ sv_setpv(ERRSV, message);
}
else
- sv_setpv(GvSV(errgv), message);
-
- cxix = dopoptoeval(cxstack_ix);
+ message = SvPVx(ERRSV, n_a);
+
+ while ((cxix = dopoptoeval(cxstack_ix)) < 0 && PL_curstackinfo->si_prev) {
+ dounwind(-1);
+ POPSTACK;
+ }
+
if (cxix >= 0) {
I32 optype;
if (cxix < cxstack_ix)
dounwind(cxix);
- POPBLOCK(cx,curpm);
- if (cx->cx_type != CXt_EVAL) {
+ POPBLOCK(cx,PL_curpm);
+ if (CxTYPE(cx) != CXt_EVAL) {
PerlIO_printf(PerlIO_stderr(), "panic: die %s", message);
my_exit(1);
}
POPEVAL(cx);
if (gimme == G_SCALAR)
- *++newsp = &sv_undef;
- stack_sp = newsp;
+ *++newsp = &PL_sv_undef;
+ PL_stack_sp = newsp;
LEAVE;
if (optype == OP_REQUIRE) {
- char* msg = SvPVx(GvSV(errgv), na);
+ char* msg = SvPVx(ERRSV, n_a);
DIE("%s", *msg ? msg : "Compilation failed in require");
}
return pop_return();
}
}
+ if(!message)
+ message = SvPVx(ERRSV, n_a);
PerlIO_printf(PerlIO_stderr(), "%s",message);
PerlIO_flush(PerlIO_stderr());
my_failure_exit();
@@ -1085,7 +1221,7 @@ char *message;
PP(pp_xor)
{
- dSP; dPOPTOPssrl;
+ djSP; dPOPTOPssrl;
if (SvTRUE(left) != SvTRUE(right))
RETSETYES;
else
@@ -1094,7 +1230,7 @@ PP(pp_xor)
PP(pp_andassign)
{
- dSP;
+ djSP;
if (!SvTRUE(TOPs))
RETURN;
else
@@ -1103,35 +1239,23 @@ PP(pp_andassign)
PP(pp_orassign)
{
- dSP;
+ djSP;
if (SvTRUE(TOPs))
RETURN;
else
RETURNOP(cLOGOP->op_other);
}
-#ifdef DEPRECATED
-PP(pp_entersubr)
-{
- dSP;
- SV** mark = (stack_base + *markstack_ptr + 1);
- SV* cv = *mark;
- while (mark < sp) { /* emulate old interface */
- *mark = mark[1];
- mark++;
- }
- *sp = cv;
- return pp_entersub();
-}
-#endif
-
PP(pp_caller)
{
- dSP;
+ djSP;
register I32 cxix = dopoptosub(cxstack_ix);
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
+ register PERL_CONTEXT *ccstack = cxstack;
+ PERL_SI *top_si = PL_curstackinfo;
I32 dbcxix;
I32 gimme;
+ HV *hv;
SV *sv;
I32 count = 0;
@@ -1139,43 +1263,58 @@ PP(pp_caller)
count = POPi;
EXTEND(SP, 6);
for (;;) {
+ /* we may be in a higher stacklevel, so dig down deeper */
+ while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
+ top_si = top_si->si_prev;
+ ccstack = top_si->si_cxstack;
+ cxix = dopoptosub_at(ccstack, top_si->si_cxix);
+ }
if (cxix < 0) {
if (GIMME != G_ARRAY)
RETPUSHUNDEF;
RETURN;
}
- if (DBsub && cxix >= 0 &&
- cxstack[cxix].blk_sub.cv == GvCV(DBsub))
+ if (PL_DBsub && cxix >= 0 &&
+ ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
count++;
if (!count--)
break;
- cxix = dopoptosub(cxix - 1);
+ cxix = dopoptosub_at(ccstack, cxix - 1);
}
- cx = &cxstack[cxix];
- if (cxstack[cxix].cx_type == CXt_SUB) {
- dbcxix = dopoptosub(cxix - 1);
- /* We expect that cxstack[dbcxix] is CXt_SUB, anyway, the
+
+ cx = &ccstack[cxix];
+ if (CxTYPE(cx) == CXt_SUB) {
+ dbcxix = dopoptosub_at(ccstack, cxix - 1);
+ /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
field below is defined for any cx. */
- if (DBsub && dbcxix >= 0 && cxstack[dbcxix].blk_sub.cv == GvCV(DBsub))
- cx = &cxstack[dbcxix];
+ if (PL_DBsub && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
+ cx = &ccstack[dbcxix];
}
if (GIMME != G_ARRAY) {
- dTARGET;
-
- sv_setpv(TARG, HvNAME(cx->blk_oldcop->cop_stash));
- PUSHs(TARG);
+ hv = cx->blk_oldcop->cop_stash;
+ if (!hv)
+ PUSHs(&PL_sv_undef);
+ else {
+ dTARGET;
+ sv_setpv(TARG, HvNAME(hv));
+ PUSHs(TARG);
+ }
RETURN;
}
- PUSHs(sv_2mortal(newSVpv(HvNAME(cx->blk_oldcop->cop_stash), 0)));
+ hv = cx->blk_oldcop->cop_stash;
+ if (!hv)
+ PUSHs(&PL_sv_undef);
+ else
+ PUSHs(sv_2mortal(newSVpv(HvNAME(hv), 0)));
PUSHs(sv_2mortal(newSVpv(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)), 0)));
PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line)));
if (!MAXARG)
RETURN;
- if (cx->cx_type == CXt_SUB) { /* So is cxstack[dbcxix]. */
+ if (CxTYPE(cx) == CXt_SUB) { /* So is ccstack[dbcxix]. */
sv = NEWSV(49, 0);
- gv_efullname3(sv, CvGV(cxstack[cxix].blk_sub.cv), Nullch);
+ gv_efullname3(sv, CvGV(ccstack[cxix].blk_sub.cv), Nullch);
PUSHs(sv_2mortal(sv));
PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
}
@@ -1185,97 +1324,79 @@ PP(pp_caller)
}
gimme = (I32)cx->blk_gimme;
if (gimme == G_VOID)
- PUSHs(&sv_undef);
+ PUSHs(&PL_sv_undef);
else
PUSHs(sv_2mortal(newSViv(gimme & G_ARRAY)));
- if (cx->cx_type == CXt_EVAL) {
+ if (CxTYPE(cx) == CXt_EVAL) {
if (cx->blk_eval.old_op_type == OP_ENTEREVAL) {
PUSHs(cx->blk_eval.cur_text);
- PUSHs(&sv_no);
+ PUSHs(&PL_sv_no);
}
else if (cx->blk_eval.old_name) { /* Try blocks have old_name == 0. */
/* Require, put the name. */
PUSHs(sv_2mortal(newSVpv(cx->blk_eval.old_name, 0)));
- PUSHs(&sv_yes);
+ PUSHs(&PL_sv_yes);
}
}
- else if (cx->cx_type == CXt_SUB &&
+ else if (CxTYPE(cx) == CXt_SUB &&
cx->blk_sub.hasargs &&
- curcop->cop_stash == debstash)
+ PL_curcop->cop_stash == PL_debstash)
{
AV *ary = cx->blk_sub.argarray;
int off = AvARRAY(ary) - AvALLOC(ary);
- if (!dbargs) {
+ if (!PL_dbargs) {
GV* tmpgv;
- dbargs = GvAV(gv_AVadd(tmpgv = gv_fetchpv("DB::args", TRUE,
+ PL_dbargs = GvAV(gv_AVadd(tmpgv = gv_fetchpv("DB::args", TRUE,
SVt_PVAV)));
GvMULTI_on(tmpgv);
- AvREAL_off(dbargs); /* XXX Should be REIFY */
+ AvREAL_off(PL_dbargs); /* XXX Should be REIFY */
}
- if (AvMAX(dbargs) < AvFILL(ary) + off)
- av_extend(dbargs, AvFILL(ary) + off);
- Copy(AvALLOC(ary), AvARRAY(dbargs), AvFILL(ary) + 1 + off, SV*);
- AvFILL(dbargs) = AvFILL(ary) + off;
+ if (AvMAX(PL_dbargs) < AvFILLp(ary) + off)
+ av_extend(PL_dbargs, AvFILLp(ary) + off);
+ Copy(AvALLOC(ary), AvARRAY(PL_dbargs), AvFILLp(ary) + 1 + off, SV*);
+ AvFILLp(PL_dbargs) = AvFILLp(ary) + off;
}
RETURN;
}
-static int
-sortcv(a, b)
-const void *a;
-const void *b;
+STATIC I32
+sortcv(SV *a, SV *b)
{
- SV * const *str1 = (SV * const *)a;
- SV * const *str2 = (SV * const *)b;
- I32 oldsaveix = savestack_ix;
- I32 oldscopeix = scopestack_ix;
+ dTHR;
+ I32 oldsaveix = PL_savestack_ix;
+ I32 oldscopeix = PL_scopestack_ix;
I32 result;
- GvSV(firstgv) = *str1;
- GvSV(secondgv) = *str2;
- stack_sp = stack_base;
- op = sortcop;
- runops();
- if (stack_sp != stack_base + 1)
+ GvSV(PL_firstgv) = a;
+ GvSV(PL_secondgv) = b;
+ PL_stack_sp = PL_stack_base;
+ PL_op = PL_sortcop;
+ CALLRUNOPS();
+ if (PL_stack_sp != PL_stack_base + 1)
croak("Sort subroutine didn't return single value");
- if (!SvNIOKp(*stack_sp))
+ if (!SvNIOKp(*PL_stack_sp))
croak("Sort subroutine didn't return a numeric value");
- result = SvIV(*stack_sp);
- while (scopestack_ix > oldscopeix) {
+ result = SvIV(*PL_stack_sp);
+ while (PL_scopestack_ix > oldscopeix) {
LEAVE;
}
leave_scope(oldsaveix);
return result;
}
-static int
-sortcmp(a, b)
-const void *a;
-const void *b;
-{
- return sv_cmp(*(SV * const *)a, *(SV * const *)b);
-}
-
-static int
-sortcmp_locale(a, b)
-const void *a;
-const void *b;
-{
- return sv_cmp_locale(*(SV * const *)a, *(SV * const *)b);
-}
-
PP(pp_reset)
{
- dSP;
+ djSP;
char *tmps;
+ STRLEN n_a;
if (MAXARG < 1)
tmps = "";
else
- tmps = POPp;
- sv_reset(tmps, curcop->cop_stash);
- PUSHs(&sv_yes);
+ tmps = POPpx;
+ sv_reset(tmps, PL_curcop->cop_stash);
+ PUSHs(&PL_sv_yes);
RETURN;
}
@@ -1286,44 +1407,44 @@ PP(pp_lineseq)
PP(pp_dbstate)
{
- curcop = (COP*)op;
+ PL_curcop = (COP*)PL_op;
TAINT_NOT; /* Each statement is presumed innocent */
- stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
+ PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
FREETMPS;
- if (op->op_private || SvIV(DBsingle) || SvIV(DBsignal) || SvIV(DBtrace))
+ if (PL_op->op_private || SvIV(PL_DBsingle) || SvIV(PL_DBsignal) || SvIV(PL_DBtrace))
{
- SV **sp;
+ djSP;
register CV *cv;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 gimme = G_ARRAY;
I32 hasargs;
GV *gv;
- gv = DBgv;
+ gv = PL_DBgv;
cv = GvCV(gv);
if (!cv)
DIE("No DB::DB routine defined");
- if (CvDEPTH(cv) >= 1 && !(debug & (1<<30))) /* don't do recursive DB::DB call */
+ if (CvDEPTH(cv) >= 1 && !(PL_debug & (1<<30))) /* don't do recursive DB::DB call */
return NORMAL;
ENTER;
SAVETMPS;
- SAVEI32(debug);
+ SAVEI32(PL_debug);
SAVESTACK_POS();
- debug = 0;
+ PL_debug = 0;
hasargs = 0;
- sp = stack_sp;
+ SPAGAIN;
- push_return(op->op_next);
- PUSHBLOCK(cx, CXt_SUB, sp);
+ push_return(PL_op->op_next);
+ PUSHBLOCK(cx, CXt_SUB, SP);
PUSHSUB(cx);
CvDEPTH(cv)++;
(void)SvREFCNT_inc(cv);
- SAVESPTR(curpad);
- curpad = AvARRAY((AV*)*av_fetch(CvPADLIST(cv),1,FALSE));
+ SAVESPTR(PL_curpad);
+ PL_curpad = AvARRAY((AV*)*av_fetch(CvPADLIST(cv),1,FALSE));
RETURNOP(CvSTART(cv));
}
else
@@ -1337,31 +1458,57 @@ PP(pp_scope)
PP(pp_enteriter)
{
- dSP; dMARK;
- register CONTEXT *cx;
+ djSP; dMARK;
+ register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
SV **svp;
ENTER;
SAVETMPS;
- if (op->op_targ)
- svp = &curpad[op->op_targ]; /* "my" variable */
+#ifdef USE_THREADS
+ if (PL_op->op_flags & OPf_SPECIAL) {
+ dTHR;
+ svp = &THREADSV(PL_op->op_targ); /* per-thread variable */
+ SAVEGENERICSV(*svp);
+ *svp = NEWSV(0,0);
+ }
else
+#endif /* USE_THREADS */
+ if (PL_op->op_targ) {
+ svp = &PL_curpad[PL_op->op_targ]; /* "my" variable */
+ SAVESPTR(*svp);
+ }
+ else {
svp = &GvSV((GV*)POPs); /* symbol table variable */
-
- SAVESPTR(*svp);
+ SAVEGENERICSV(*svp);
+ *svp = NEWSV(0,0);
+ }
ENTER;
PUSHBLOCK(cx, CXt_LOOP, SP);
PUSHLOOP(cx, svp, MARK);
- if (op->op_flags & OPf_STACKED)
+ if (PL_op->op_flags & OPf_STACKED) {
cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
+ if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
+ dPOPss;
+ if (SvNIOKp(sv) || !SvPOKp(sv) ||
+ (looks_like_number(sv) && *SvPVX(sv) != '0')) {
+ if (SvNV(sv) < IV_MIN ||
+ SvNV((SV*)cx->blk_loop.iterary) >= IV_MAX)
+ croak("Range iterator outside integer range");
+ cx->blk_loop.iterix = SvIV(sv);
+ cx->blk_loop.itermax = SvIV((SV*)cx->blk_loop.iterary);
+ }
+ else
+ cx->blk_loop.iterlval = newSVsv(sv);
+ }
+ }
else {
- cx->blk_loop.iterary = curstack;
- AvFILL(curstack) = sp - stack_base;
- cx->blk_loop.iterix = MARK - stack_base;
+ cx->blk_loop.iterary = PL_curstack;
+ AvFILLp(PL_curstack) = SP - PL_stack_base;
+ cx->blk_loop.iterix = MARK - PL_stack_base;
}
RETURN;
@@ -1369,8 +1516,8 @@ PP(pp_enteriter)
PP(pp_enterloop)
{
- dSP;
- register CONTEXT *cx;
+ djSP;
+ register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
ENTER;
@@ -1385,8 +1532,8 @@ PP(pp_enterloop)
PP(pp_leaveloop)
{
- dSP;
- register CONTEXT *cx;
+ djSP;
+ register PERL_CONTEXT *cx;
struct block_loop cxloop;
I32 gimme;
SV **newsp;
@@ -1404,7 +1551,7 @@ PP(pp_leaveloop)
if (mark < SP)
*++newsp = sv_mortalcopy(*SP);
else
- *++newsp = &sv_undef;
+ *++newsp = &PL_sv_undef;
}
else {
while (mark < SP) {
@@ -1416,7 +1563,7 @@ PP(pp_leaveloop)
PUTBACK;
POPLOOP2(); /* Stack values are safe: release loop vars ... */
- curpm = newpm; /* ... and pop $1 et al */
+ PL_curpm = newpm; /* ... and pop $1 et al */
LEAVE;
LEAVE;
@@ -1426,9 +1573,9 @@ PP(pp_leaveloop)
PP(pp_return)
{
- dSP; dMARK;
+ djSP; dMARK;
I32 cxix;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
struct block_sub cxsub;
bool popsub2 = FALSE;
I32 gimme;
@@ -1436,12 +1583,12 @@ PP(pp_return)
PMOP *newpm;
I32 optype = 0;
- if (curstack == sortstack) {
- if (cxstack_ix == sortcxix || dopoptosub(cxstack_ix) <= sortcxix) {
- if (cxstack_ix > sortcxix)
- dounwind(sortcxix);
- AvARRAY(curstack)[1] = *SP;
- stack_sp = stack_base + 1;
+ if (PL_curstackinfo->si_type == PERLSI_SORT) {
+ if (cxstack_ix == PL_sortcxix || dopoptosub(cxstack_ix) <= PL_sortcxix) {
+ if (cxstack_ix > PL_sortcxix)
+ dounwind(PL_sortcxix);
+ AvARRAY(PL_curstack)[1] = *SP;
+ PL_stack_sp = PL_stack_base + 1;
return 0;
}
}
@@ -1453,7 +1600,7 @@ PP(pp_return)
dounwind(cxix);
POPBLOCK(cx,newpm);
- switch (cx->cx_type) {
+ switch (CxTYPE(cx)) {
case CXt_SUB:
POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */
popsub2 = TRUE;
@@ -1465,7 +1612,7 @@ PP(pp_return)
{
/* Unassume the success we assumed earlier. */
char *name = cx->blk_eval.old_name;
- (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD);
+ (void)hv_delete(GvHVn(PL_incgv), name, strlen(name), G_DISCARD);
DIE("%s did not return a true value", name);
}
break;
@@ -1475,11 +1622,23 @@ PP(pp_return)
TAINT_NOT;
if (gimme == G_SCALAR) {
- if (MARK < SP)
- *++newsp = (popsub2 && SvTEMP(*SP))
- ? *SP : sv_mortalcopy(*SP);
- else
- *++newsp = &sv_undef;
+ if (MARK < SP) {
+ if (popsub2) {
+ if (cxsub.cv && CvDEPTH(cxsub.cv) > 1) {
+ if (SvTEMP(TOPs)) {
+ *++newsp = SvREFCNT_inc(*SP);
+ FREETMPS;
+ sv_2mortal(*newsp);
+ } else {
+ FREETMPS;
+ *++newsp = sv_mortalcopy(*SP);
+ }
+ } else
+ *++newsp = (SvTEMP(*SP)) ? *SP : sv_mortalcopy(*SP);
+ } else
+ *++newsp = sv_mortalcopy(*SP);
+ } else
+ *++newsp = &PL_sv_undef;
}
else if (gimme == G_ARRAY) {
while (++MARK <= SP) {
@@ -1488,13 +1647,13 @@ PP(pp_return)
TAINT_NOT; /* Each item is independent */
}
}
- stack_sp = newsp;
+ PL_stack_sp = newsp;
/* Stack values are safe: */
if (popsub2) {
POPSUB2(); /* release CV and @_ ... */
}
- curpm = newpm; /* ... and pop $1 et al */
+ PL_curpm = newpm; /* ... and pop $1 et al */
LEAVE;
return pop_return();
@@ -1502,9 +1661,9 @@ PP(pp_return)
PP(pp_last)
{
- dSP;
+ djSP;
I32 cxix;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
struct block_loop cxloop;
struct block_sub cxsub;
I32 pop2 = 0;
@@ -1513,9 +1672,9 @@ PP(pp_last)
OP *nextop;
SV **newsp;
PMOP *newpm;
- SV **mark = stack_base + cxstack[cxstack_ix].blk_oldsp;
+ SV **mark = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
- if (op->op_flags & OPf_SPECIAL) {
+ if (PL_op->op_flags & OPf_SPECIAL) {
cxix = dopoptoloop(cxstack_ix);
if (cxix < 0)
DIE("Can't \"last\" outside a block");
@@ -1529,7 +1688,7 @@ PP(pp_last)
dounwind(cxix);
POPBLOCK(cx,newpm);
- switch (cx->cx_type) {
+ switch (CxTYPE(cx)) {
case CXt_LOOP:
POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */
pop2 = CXt_LOOP;
@@ -1554,7 +1713,7 @@ PP(pp_last)
*++newsp = ((pop2 == CXt_SUB) && SvTEMP(*SP))
? *SP : sv_mortalcopy(*SP);
else
- *++newsp = &sv_undef;
+ *++newsp = &PL_sv_undef;
}
else if (gimme == G_ARRAY) {
while (++MARK <= SP) {
@@ -1576,7 +1735,7 @@ PP(pp_last)
POPSUB2(); /* release CV and @_ ... */
break;
}
- curpm = newpm; /* ... and pop $1 et al */
+ PL_curpm = newpm; /* ... and pop $1 et al */
LEAVE;
return nextop;
@@ -1585,10 +1744,10 @@ PP(pp_last)
PP(pp_next)
{
I32 cxix;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 oldsave;
- if (op->op_flags & OPf_SPECIAL) {
+ if (PL_op->op_flags & OPf_SPECIAL) {
cxix = dopoptoloop(cxstack_ix);
if (cxix < 0)
DIE("Can't \"next\" outside a block");
@@ -1602,7 +1761,7 @@ PP(pp_next)
dounwind(cxix);
TOPBLOCK(cx);
- oldsave = scopestack[scopestack_ix - 1];
+ oldsave = PL_scopestack[PL_scopestack_ix - 1];
LEAVE_SCOPE(oldsave);
return cx->blk_loop.next_op;
}
@@ -1610,10 +1769,10 @@ PP(pp_next)
PP(pp_redo)
{
I32 cxix;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 oldsave;
- if (op->op_flags & OPf_SPECIAL) {
+ if (PL_op->op_flags & OPf_SPECIAL) {
cxix = dopoptoloop(cxstack_ix);
if (cxix < 0)
DIE("Can't \"redo\" outside a block");
@@ -1627,19 +1786,13 @@ PP(pp_redo)
dounwind(cxix);
TOPBLOCK(cx);
- oldsave = scopestack[scopestack_ix - 1];
+ oldsave = PL_scopestack[PL_scopestack_ix - 1];
LEAVE_SCOPE(oldsave);
return cx->blk_loop.redo_op;
}
-static OP* lastgotoprobe;
-
-static OP *
-dofindlabel(op,label,opstack,oplimit)
-OP *op;
-char *label;
-OP **opstack;
-OP **oplimit;
+STATIC OP *
+dofindlabel(OP *o, char *label, OP **opstack, OP **oplimit)
{
OP *kid;
OP **ops = opstack;
@@ -1647,33 +1800,34 @@ OP **oplimit;
if (ops >= oplimit)
croak(too_deep);
- if (op->op_type == OP_LEAVE ||
- op->op_type == OP_SCOPE ||
- op->op_type == OP_LEAVELOOP ||
- op->op_type == OP_LEAVETRY)
+ if (o->op_type == OP_LEAVE ||
+ o->op_type == OP_SCOPE ||
+ o->op_type == OP_LEAVELOOP ||
+ o->op_type == OP_LEAVETRY)
{
- *ops++ = cUNOP->op_first;
+ *ops++ = cUNOPo->op_first;
if (ops >= oplimit)
croak(too_deep);
}
*ops = 0;
- if (op->op_flags & OPf_KIDS) {
+ if (o->op_flags & OPf_KIDS) {
+ dTHR;
/* First try all the kids at this level, since that's likeliest. */
- for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
+ for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&
kCOP->cop_label && strEQ(kCOP->cop_label, label))
return kid;
}
- for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
- if (kid == lastgotoprobe)
+ for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
+ if (kid == PL_lastgotoprobe)
continue;
if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&
(ops == opstack ||
(ops[-1]->op_type != OP_NEXTSTATE &&
ops[-1]->op_type != OP_DBSTATE)))
*ops++ = kid;
- if (op = dofindlabel(kid, label, ops, oplimit))
- return op;
+ if (o = dofindlabel(kid, label, ops, oplimit))
+ return o;
}
}
*ops = 0;
@@ -1688,32 +1842,45 @@ PP(pp_dump)
PP(pp_goto)
{
- dSP;
+ djSP;
OP *retop = 0;
I32 ix;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
#define GOTO_DEPTH 64
OP *enterops[GOTO_DEPTH];
char *label;
- int do_dump = (op->op_type == OP_DUMP);
+ int do_dump = (PL_op->op_type == OP_DUMP);
label = 0;
- if (op->op_flags & OPf_STACKED) {
+ if (PL_op->op_flags & OPf_STACKED) {
SV *sv = POPs;
+ STRLEN n_a;
/* This egregious kludge implements goto &subroutine */
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) {
I32 cxix;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
CV* cv = (CV*)SvRV(sv);
SV** mark;
I32 items = 0;
I32 oldsave;
+ int arg_was_real = 0;
+ retry:
if (!CvROOT(cv) && !CvXSUB(cv)) {
- if (CvGV(cv)) {
- SV *tmpstr = sv_newmortal();
- gv_efullname3(tmpstr, CvGV(cv), Nullch);
+ GV *gv = CvGV(cv);
+ GV *autogv;
+ if (gv) {
+ SV *tmpstr;
+ /* autoloaded stub? */
+ if (cv != GvCV(gv) && (cv = GvCV(gv)))
+ goto retry;
+ autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv),
+ GvNAMELEN(gv), FALSE);
+ if (autogv && (cv = GvCV(autogv)))
+ goto retry;
+ tmpstr = sv_newmortal();
+ gv_efullname3(tmpstr, gv, Nullch);
DIE("Goto undefined subroutine &%s",SvPVX(tmpstr));
}
DIE("Goto undefined subroutine");
@@ -1726,23 +1893,46 @@ PP(pp_goto)
if (cxix < cxstack_ix)
dounwind(cxix);
TOPBLOCK(cx);
- mark = stack_sp;
- if (cx->blk_sub.hasargs) { /* put @_ back onto stack */
+ if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL)
+ DIE("Can't goto subroutine from an eval-string");
+ mark = PL_stack_sp;
+ if (CxTYPE(cx) == CXt_SUB &&
+ cx->blk_sub.hasargs) { /* put @_ back onto stack */
AV* av = cx->blk_sub.argarray;
- items = AvFILL(av) + 1;
- stack_sp++;
- EXTEND(stack_sp, items); /* @_ could have been extended. */
- Copy(AvARRAY(av), stack_sp, items, SV*);
- stack_sp += items;
- SvREFCNT_dec(GvAV(defgv));
- GvAV(defgv) = cx->blk_sub.savearray;
- AvREAL_off(av);
+ items = AvFILLp(av) + 1;
+ PL_stack_sp++;
+ EXTEND(PL_stack_sp, items); /* @_ could have been extended. */
+ Copy(AvARRAY(av), PL_stack_sp, items, SV*);
+ PL_stack_sp += items;
+#ifndef USE_THREADS
+ SvREFCNT_dec(GvAV(PL_defgv));
+ GvAV(PL_defgv) = cx->blk_sub.savearray;
+#endif /* USE_THREADS */
+ if (AvREAL(av)) {
+ arg_was_real = 1;
+ AvREAL_off(av); /* so av_clear() won't clobber elts */
+ }
av_clear(av);
}
- if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))
+ else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */
+ AV* av;
+ int i;
+#ifdef USE_THREADS
+ av = (AV*)PL_curpad[0];
+#else
+ av = GvAV(PL_defgv);
+#endif
+ items = AvFILLp(av) + 1;
+ PL_stack_sp++;
+ EXTEND(PL_stack_sp, items); /* @_ could have been extended. */
+ Copy(AvARRAY(av), PL_stack_sp, items, SV*);
+ PL_stack_sp += items;
+ }
+ if (CxTYPE(cx) == CXt_SUB &&
+ !(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))
SvREFCNT_dec(cx->blk_sub.cv);
- oldsave = scopestack[scopestack_ix - 1];
+ oldsave = PL_scopestack[PL_scopestack_ix - 1];
LEAVE_SCOPE(oldsave);
/* Now do some callish stuff. */
@@ -1750,19 +1940,27 @@ PP(pp_goto)
if (CvXSUB(cv)) {
if (CvOLDSTYLE(cv)) {
I32 (*fp3)_((int,int,int));
- while (sp > mark) {
- sp[1] = sp[0];
- sp--;
+ while (SP > mark) {
+ SP[1] = SP[0];
+ SP--;
}
fp3 = (I32(*)_((int,int,int)))CvXSUB(cv);
items = (*fp3)(CvXSUBANY(cv).any_i32,
- mark - stack_base + 1,
+ mark - PL_stack_base + 1,
items);
- sp = stack_base + items;
+ SP = PL_stack_base + items;
}
else {
- stack_sp--; /* There is no cv arg. */
- (void)(*CvXSUB(cv))(cv);
+ SV **newsp;
+ I32 gimme;
+
+ PL_stack_sp--; /* There is no cv arg. */
+ /* Push a mark for the start of arglist */
+ PUSHMARK(mark);
+ (void)(*CvXSUB(cv))(cv _PERL_OBJECT_THIS);
+ /* Pop the current context like a decent sub should */
+ POPBLOCK(cx, PL_curpm);
+ /* Do _not_ use PUTBACK, keep the XSUB's return stack! */
}
LEAVE;
return pop_return();
@@ -1770,21 +1968,27 @@ PP(pp_goto)
else {
AV* padlist = CvPADLIST(cv);
SV** svp = AvARRAY(padlist);
+ if (CxTYPE(cx) == CXt_EVAL) {
+ PL_in_eval = cx->blk_eval.old_in_eval;
+ PL_eval_root = cx->blk_eval.old_eval_root;
+ cx->cx_type = CXt_SUB;
+ cx->blk_sub.hasargs = 0;
+ }
cx->blk_sub.cv = cv;
cx->blk_sub.olddepth = CvDEPTH(cv);
CvDEPTH(cv)++;
if (CvDEPTH(cv) < 2)
(void)SvREFCNT_inc(cv);
else { /* save temporaries on recursion? */
- if (CvDEPTH(cv) == 100 && dowarn)
+ if (CvDEPTH(cv) == 100 && PL_dowarn)
sub_crush_depth(cv);
- if (CvDEPTH(cv) > AvFILL(padlist)) {
+ if (CvDEPTH(cv) > AvFILLp(padlist)) {
AV *newpad = newAV();
SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
- I32 ix = AvFILL((AV*)svp[1]);
+ I32 ix = AvFILLp((AV*)svp[1]);
svp = AvARRAY(svp[0]);
for ( ;ix > 0; ix--) {
- if (svp[ix] != &sv_undef) {
+ if (svp[ix] != &PL_sv_undef) {
char *name = SvPVX(svp[ix]);
if ((SvFLAGS(svp[ix]) & SVf_FAKE)
|| *name == '&')
@@ -1815,19 +2019,38 @@ PP(pp_goto)
AvFLAGS(av) = AVf_REIFY;
}
av_store(padlist, CvDEPTH(cv), (SV*)newpad);
- AvFILL(padlist) = CvDEPTH(cv);
+ AvFILLp(padlist) = CvDEPTH(cv);
svp = AvARRAY(padlist);
}
}
- SAVESPTR(curpad);
- curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
- if (cx->blk_sub.hasargs) {
- AV* av = (AV*)curpad[0];
+#ifdef USE_THREADS
+ if (!cx->blk_sub.hasargs) {
+ AV* av = (AV*)PL_curpad[0];
+
+ items = AvFILLp(av) + 1;
+ if (items) {
+ /* Mark is at the end of the stack. */
+ EXTEND(SP, items);
+ Copy(AvARRAY(av), SP + 1, items, SV*);
+ SP += items;
+ PUTBACK ;
+ }
+ }
+#endif /* USE_THREADS */
+ SAVESPTR(PL_curpad);
+ PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
+#ifndef USE_THREADS
+ if (cx->blk_sub.hasargs)
+#endif /* USE_THREADS */
+ {
+ AV* av = (AV*)PL_curpad[0];
SV** ary;
- cx->blk_sub.savearray = GvAV(defgv);
+#ifndef USE_THREADS
+ cx->blk_sub.savearray = GvAV(PL_defgv);
+ GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
+#endif /* USE_THREADS */
cx->blk_sub.argarray = av;
- GvAV(defgv) = (AV*)SvREFCNT_inc(av);
++mark;
if (items >= AvMAX(av) + 1) {
@@ -1844,30 +2067,46 @@ PP(pp_goto)
}
}
Copy(mark,AvARRAY(av),items,SV*);
- AvFILL(av) = items - 1;
-
+ AvFILLp(av) = items - 1;
+ /* preserve @_ nature */
+ if (arg_was_real) {
+ AvREIFY_off(av);
+ AvREAL_on(av);
+ }
while (items--) {
if (*mark)
SvTEMP_off(*mark);
mark++;
}
}
- if (PERLDB_SUB && curstash != debstash) {
+ if (PERLDB_SUB) { /* Checking curstash breaks DProf. */
/*
* We do not care about using sv to call CV;
* it's for informational purposes only.
*/
- SV *sv = GvSV(DBsub);
- save_item(sv);
- gv_efullname3(sv, CvGV(cv), Nullch);
+ SV *sv = GvSV(PL_DBsub);
+ CV *gotocv;
+
+ if (PERLDB_SUB_NN) {
+ SvIVX(sv) = (IV)cv; /* Already upgraded, saved */
+ } else {
+ save_item(sv);
+ gv_efullname3(sv, CvGV(cv), Nullch);
+ }
+ if ( PERLDB_GOTO
+ && (gotocv = perl_get_cv("DB::goto", FALSE)) ) {
+ PUSHMARK( PL_stack_sp );
+ perl_call_sv((SV*)gotocv, G_SCALAR | G_NODEBUG);
+ PL_stack_sp--;
+ }
}
RETURNOP(CvSTART(cv));
}
}
else
- label = SvPV(sv,na);
+ label = SvPV(sv,n_a);
}
- else if (op->op_flags & OPf_SPECIAL) {
+ else if (PL_op->op_flags & OPf_SPECIAL) {
if (! do_dump)
DIE("goto must have label");
}
@@ -1879,13 +2118,13 @@ PP(pp_goto)
/* find label */
- lastgotoprobe = 0;
+ PL_lastgotoprobe = 0;
*enterops = 0;
for (ix = cxstack_ix; ix >= 0; ix--) {
cx = &cxstack[ix];
- switch (cx->cx_type) {
+ switch (CxTYPE(cx)) {
case CXt_EVAL:
- gotoprobe = eval_root; /* XXX not good for nested eval */
+ gotoprobe = PL_eval_root; /* XXX not good for nested eval */
break;
case CXt_LOOP:
gotoprobe = cx->blk_oldcop->op_sibling;
@@ -1896,7 +2135,7 @@ PP(pp_goto)
if (ix)
gotoprobe = cx->blk_oldcop->op_sibling;
else
- gotoprobe = main_root;
+ gotoprobe = PL_main_root;
break;
case CXt_SUB:
if (CvDEPTH(cx->blk_sub.cv)) {
@@ -1909,14 +2148,14 @@ PP(pp_goto)
default:
if (ix)
DIE("panic: goto");
- gotoprobe = main_root;
+ gotoprobe = PL_main_root;
break;
}
retop = dofindlabel(gotoprobe, label,
enterops, enterops + GOTO_DEPTH);
if (retop)
break;
- lastgotoprobe = gotoprobe;
+ PL_lastgotoprobe = gotoprobe;
}
if (!retop)
DIE("Can't find label %s", label);
@@ -1930,43 +2169,38 @@ PP(pp_goto)
ix = 0;
dounwind(ix);
TOPBLOCK(cx);
- oldsave = scopestack[scopestack_ix];
+ oldsave = PL_scopestack[PL_scopestack_ix];
LEAVE_SCOPE(oldsave);
}
/* push wanted frames */
if (*enterops && enterops[1]) {
- OP *oldop = op;
+ OP *oldop = PL_op;
for (ix = 1; enterops[ix]; ix++) {
- op = enterops[ix];
+ PL_op = enterops[ix];
/* Eventually we may want to stack the needed arguments
* for each op. For now, we punt on the hard ones. */
- if (op->op_type == OP_ENTERITER)
+ if (PL_op->op_type == OP_ENTERITER)
DIE("Can't \"goto\" into the middle of a foreach loop",
label);
- (*op->op_ppaddr)();
+ (CALLOP->op_ppaddr)(ARGS);
}
- op = oldop;
+ PL_op = oldop;
}
}
if (do_dump) {
#ifdef VMS
- if (!retop) retop = main_start;
+ if (!retop) retop = PL_main_start;
#endif
- restartop = retop;
- do_undump = TRUE;
+ PL_restartop = retop;
+ PL_do_undump = TRUE;
my_unexec();
- restartop = 0; /* hmm, must be GNU unexec().. */
- do_undump = FALSE;
- }
-
- if (curstack == signalstack) {
- restartop = retop;
- JMPENV_JUMP(3);
+ PL_restartop = 0; /* hmm, must be GNU unexec().. */
+ PL_do_undump = FALSE;
}
RETURNOP(retop);
@@ -1974,7 +2208,7 @@ PP(pp_goto)
PP(pp_exit)
{
- dSP;
+ djSP;
I32 anum;
if (MAXARG < 1)
@@ -1987,14 +2221,14 @@ PP(pp_exit)
#endif
}
my_exit(anum);
- PUSHs(&sv_undef);
+ PUSHs(&PL_sv_undef);
RETURN;
}
#ifdef NOTYET
PP(pp_nswitch)
{
- dSP;
+ djSP;
double value = SvNVx(GvSV(cCOP->cop_gv));
register I32 match = I_32(value);
@@ -2007,36 +2241,35 @@ PP(pp_nswitch)
match = 0;
else if (match > cCOP->uop.scop.scop_max)
match = cCOP->uop.scop.scop_max;
- op = cCOP->uop.scop.scop_next[match];
- RETURNOP(op);
+ PL_op = cCOP->uop.scop.scop_next[match];
+ RETURNOP(PL_op);
}
PP(pp_cswitch)
{
- dSP;
+ djSP;
register I32 match;
- if (multiline)
- op = op->op_next; /* can't assume anything */
+ if (PL_multiline)
+ PL_op = PL_op->op_next; /* can't assume anything */
else {
- match = *(SvPVx(GvSV(cCOP->cop_gv), na)) & 255;
+ STRLEN n_a;
+ match = *(SvPVx(GvSV(cCOP->cop_gv), n_a)) & 255;
match -= cCOP->uop.scop.scop_offset;
if (match < 0)
match = 0;
else if (match > cCOP->uop.scop.scop_max)
match = cCOP->uop.scop.scop_max;
- op = cCOP->uop.scop.scop_next[match];
+ PL_op = cCOP->uop.scop.scop_next[match];
}
- RETURNOP(op);
+ RETURNOP(PL_op);
}
#endif
/* Eval. */
-static void
-save_lines(array, sv)
-AV *array;
-SV *sv;
+STATIC void
+save_lines(AV *array, SV *sv)
{
register char *s = SvPVX(sv);
register char *send = SvPVX(sv) + SvCUR(sv);
@@ -2059,153 +2292,255 @@ SV *sv;
}
}
-static OP *
-docatch(o)
-OP *o;
+STATIC OP *
+docatch(OP *o)
{
+ dTHR;
int ret;
- I32 oldrunlevel = runlevel;
- OP *oldop = op;
+ OP *oldop = PL_op;
dJMPENV;
- op = o;
+ PL_op = o;
#ifdef DEBUGGING
assert(CATCH_GET == TRUE);
- DEBUG_l(deb("(Setting up local jumplevel, runlevel = %ld)\n", (long)runlevel+1));
+ DEBUG_l(deb("Setting up local jumplevel %p, was %p\n", &cur_env, PL_top_env));
#endif
JMPENV_PUSH(ret);
switch (ret) {
default: /* topmost level handles it */
+pass_the_buck:
JMPENV_POP;
- runlevel = oldrunlevel;
- op = oldop;
+ PL_op = oldop;
JMPENV_JUMP(ret);
/* NOTREACHED */
case 3:
- if (!restartop) {
- PerlIO_printf(PerlIO_stderr(), "panic: restartop\n");
- break;
- }
- op = restartop;
- restartop = 0;
+ if (!PL_restartop)
+ goto pass_the_buck;
+ PL_op = PL_restartop;
+ PL_restartop = 0;
/* FALL THROUGH */
case 0:
- runops();
+ CALLRUNOPS();
break;
}
JMPENV_POP;
- runlevel = oldrunlevel;
- op = oldop;
+ PL_op = oldop;
return Nullop;
}
-static OP *
-doeval(gimme)
-int gimme;
+OP *
+sv_compile_2op(SV *sv, OP** startop, char *code, AV** avp)
+/* sv Text to convert to OP tree. */
+/* startop op_free() this to undo. */
+/* code Short string id of the caller. */
+{
+ dSP; /* Make POPBLOCK work. */
+ PERL_CONTEXT *cx;
+ SV **newsp;
+ I32 gimme = 0; /* SUSPECT - INITIALZE TO WHAT? NI-S */
+ I32 optype;
+ OP dummy;
+ OP *oop = PL_op, *rop;
+ char tmpbuf[TYPE_DIGITS(long) + 12 + 10];
+ char *safestr;
+
+ ENTER;
+ lex_start(sv);
+ SAVETMPS;
+ /* switch to eval mode */
+
+ if (PL_curcop == &PL_compiling) {
+ SAVESPTR(PL_compiling.cop_stash);
+ PL_compiling.cop_stash = PL_curstash;
+ }
+ SAVESPTR(PL_compiling.cop_filegv);
+ SAVEI16(PL_compiling.cop_line);
+ sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq);
+ PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2);
+ PL_compiling.cop_line = 1;
+ /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
+ deleting the eval's FILEGV from the stash before gv_check() runs
+ (i.e. before run-time proper). To work around the coredump that
+ ensues, we always turn GvMULTI_on for any globals that were
+ introduced within evals. See force_ident(). GSAR 96-10-12 */
+ safestr = savepv(tmpbuf);
+ SAVEDELETE(PL_defstash, safestr, strlen(safestr));
+ SAVEHINTS();
+#ifdef OP_IN_REGISTER
+ PL_opsave = op;
+#else
+ SAVEPPTR(PL_op);
+#endif
+ PL_hints = 0;
+
+ PL_op = &dummy;
+ PL_op->op_type = 0; /* Avoid uninit warning. */
+ PL_op->op_flags = 0; /* Avoid uninit warning. */
+ PUSHBLOCK(cx, CXt_EVAL, SP);
+ PUSHEVAL(cx, 0, PL_compiling.cop_filegv);
+ rop = doeval(G_SCALAR, startop);
+ POPBLOCK(cx,PL_curpm);
+ POPEVAL(cx);
+
+ (*startop)->op_type = OP_NULL;
+ (*startop)->op_ppaddr = ppaddr[OP_NULL];
+ lex_end();
+ *avp = (AV*)SvREFCNT_inc(PL_comppad);
+ LEAVE;
+#ifdef OP_IN_REGISTER
+ op = PL_opsave;
+#endif
+ return rop;
+}
+
+/* With USE_THREADS, eval_owner must be held on entry to doeval */
+STATIC OP *
+doeval(int gimme, OP** startop)
{
dSP;
- OP *saveop = op;
+ OP *saveop = PL_op;
HV *newstash;
CV *caller;
AV* comppadlist;
+ I32 i;
- in_eval = 1;
+ PL_in_eval = 1;
PUSHMARK(SP);
/* set up a scratch pad */
- SAVEI32(padix);
- SAVESPTR(curpad);
- SAVESPTR(comppad);
- SAVESPTR(comppad_name);
- SAVEI32(comppad_name_fill);
- SAVEI32(min_intro_pending);
- SAVEI32(max_intro_pending);
-
- caller = compcv;
- SAVESPTR(compcv);
- compcv = (CV*)NEWSV(1104,0);
- sv_upgrade((SV *)compcv, SVt_PVCV);
- CvUNIQUE_on(compcv);
-
- comppad = newAV();
- comppad_name = newAV();
- comppad_name_fill = 0;
- min_intro_pending = 0;
- av_push(comppad, Nullsv);
- curpad = AvARRAY(comppad);
- padix = 0;
+ SAVEI32(PL_padix);
+ SAVESPTR(PL_curpad);
+ SAVESPTR(PL_comppad);
+ SAVESPTR(PL_comppad_name);
+ SAVEI32(PL_comppad_name_fill);
+ SAVEI32(PL_min_intro_pending);
+ SAVEI32(PL_max_intro_pending);
+
+ caller = PL_compcv;
+ for (i = cxstack_ix - 1; i >= 0; i--) {
+ PERL_CONTEXT *cx = &cxstack[i];
+ if (CxTYPE(cx) == CXt_EVAL)
+ break;
+ else if (CxTYPE(cx) == CXt_SUB) {
+ caller = cx->blk_sub.cv;
+ break;
+ }
+ }
+
+ SAVESPTR(PL_compcv);
+ PL_compcv = (CV*)NEWSV(1104,0);
+ sv_upgrade((SV *)PL_compcv, SVt_PVCV);
+ CvEVAL_on(PL_compcv);
+#ifdef USE_THREADS
+ CvOWNER(PL_compcv) = 0;
+ New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);
+ MUTEX_INIT(CvMUTEXP(PL_compcv));
+#endif /* USE_THREADS */
+
+ PL_comppad = newAV();
+ av_push(PL_comppad, Nullsv);
+ PL_curpad = AvARRAY(PL_comppad);
+ PL_comppad_name = newAV();
+ PL_comppad_name_fill = 0;
+ PL_min_intro_pending = 0;
+ PL_padix = 0;
+#ifdef USE_THREADS
+ av_store(PL_comppad_name, 0, newSVpv("@_", 2));
+ PL_curpad[0] = (SV*)newAV();
+ SvPADMY_on(PL_curpad[0]); /* XXX Needed? */
+#endif /* USE_THREADS */
comppadlist = newAV();
AvREAL_off(comppadlist);
- av_store(comppadlist, 0, (SV*)comppad_name);
- av_store(comppadlist, 1, (SV*)comppad);
- CvPADLIST(compcv) = comppadlist;
+ av_store(comppadlist, 0, (SV*)PL_comppad_name);
+ av_store(comppadlist, 1, (SV*)PL_comppad);
+ CvPADLIST(PL_compcv) = comppadlist;
- if (saveop->op_type != OP_REQUIRE)
- CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc(caller);
+ if (!saveop || saveop->op_type != OP_REQUIRE)
+ CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(caller);
- SAVEFREESV(compcv);
+ SAVEFREESV(PL_compcv);
/* make sure we compile in the right package */
- newstash = curcop->cop_stash;
- if (curstash != newstash) {
- SAVESPTR(curstash);
- curstash = newstash;
+ newstash = PL_curcop->cop_stash;
+ if (PL_curstash != newstash) {
+ SAVESPTR(PL_curstash);
+ PL_curstash = newstash;
}
- SAVESPTR(beginav);
- beginav = newAV();
- SAVEFREESV(beginav);
+ SAVESPTR(PL_beginav);
+ PL_beginav = newAV();
+ SAVEFREESV(PL_beginav);
/* try to compile it */
- eval_root = Nullop;
- error_count = 0;
- curcop = &compiling;
- curcop->cop_arybase = 0;
- SvREFCNT_dec(rs);
- rs = newSVpv("\n", 1);
- if (saveop->op_flags & OPf_SPECIAL)
- in_eval |= 4;
+ PL_eval_root = Nullop;
+ PL_error_count = 0;
+ PL_curcop = &PL_compiling;
+ PL_curcop->cop_arybase = 0;
+ SvREFCNT_dec(PL_rs);
+ PL_rs = newSVpv("\n", 1);
+ if (saveop && saveop->op_flags & OPf_SPECIAL)
+ PL_in_eval |= 4;
else
- sv_setpv(GvSV(errgv),"");
- if (yyparse() || error_count || !eval_root) {
+ sv_setpv(ERRSV,"");
+ if (yyparse() || PL_error_count || !PL_eval_root) {
SV **newsp;
I32 gimme;
- CONTEXT *cx;
- I32 optype;
-
- op = saveop;
- if (eval_root) {
- op_free(eval_root);
- eval_root = Nullop;
+ PERL_CONTEXT *cx;
+ I32 optype = 0; /* Might be reset by POPEVAL. */
+ STRLEN n_a;
+
+ PL_op = saveop;
+ if (PL_eval_root) {
+ op_free(PL_eval_root);
+ PL_eval_root = Nullop;
+ }
+ SP = PL_stack_base + POPMARK; /* pop original mark */
+ if (!startop) {
+ POPBLOCK(cx,PL_curpm);
+ POPEVAL(cx);
+ pop_return();
}
- SP = stack_base + POPMARK; /* pop original mark */
- POPBLOCK(cx,curpm);
- POPEVAL(cx);
- pop_return();
lex_end();
LEAVE;
if (optype == OP_REQUIRE) {
- char* msg = SvPVx(GvSV(errgv), na);
+ char* msg = SvPVx(ERRSV, n_a);
DIE("%s", *msg ? msg : "Compilation failed in require");
+ } else if (startop) {
+ char* msg = SvPVx(ERRSV, n_a);
+
+ POPBLOCK(cx,PL_curpm);
+ POPEVAL(cx);
+ croak("%sCompilation failed in regexp", (*msg ? msg : "Unknown error\n"));
}
- SvREFCNT_dec(rs);
- rs = SvREFCNT_inc(nrs);
+ SvREFCNT_dec(PL_rs);
+ PL_rs = SvREFCNT_inc(PL_nrs);
+#ifdef USE_THREADS
+ MUTEX_LOCK(&PL_eval_mutex);
+ PL_eval_owner = 0;
+ COND_SIGNAL(&PL_eval_cond);
+ MUTEX_UNLOCK(&PL_eval_mutex);
+#endif /* USE_THREADS */
RETPUSHUNDEF;
}
- SvREFCNT_dec(rs);
- rs = SvREFCNT_inc(nrs);
- compiling.cop_line = 0;
- SAVEFREEOP(eval_root);
+ SvREFCNT_dec(PL_rs);
+ PL_rs = SvREFCNT_inc(PL_nrs);
+ PL_compiling.cop_line = 0;
+ if (startop) {
+ *startop = PL_eval_root;
+ SvREFCNT_dec(CvOUTSIDE(PL_compcv));
+ CvOUTSIDE(PL_compcv) = Nullcv;
+ } else
+ SAVEFREEOP(PL_eval_root);
if (gimme & G_VOID)
- scalarvoid(eval_root);
+ scalarvoid(PL_eval_root);
else if (gimme & G_ARRAY)
- list(eval_root);
+ list(PL_eval_root);
else
- scalar(eval_root);
+ scalar(PL_eval_root);
DEBUG_x(dump_eval());
@@ -2214,8 +2549,8 @@ int gimme;
CV *cv = perl_get_cv("DB::postponed", FALSE);
if (cv) {
dSP;
- PUSHMARK(sp);
- XPUSHs((SV*)compiling.cop_filegv);
+ PUSHMARK(SP);
+ XPUSHs((SV*)PL_compiling.cop_filegv);
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
}
@@ -2223,40 +2558,48 @@ int gimme;
/* compiled okay, so do it */
- CvDEPTH(compcv) = 1;
-
- SP = stack_base + POPMARK; /* pop original mark */
- op = saveop; /* The caller may need it. */
- RETURNOP(eval_start);
+ CvDEPTH(PL_compcv) = 1;
+ SP = PL_stack_base + POPMARK; /* pop original mark */
+ PL_op = saveop; /* The caller may need it. */
+#ifdef USE_THREADS
+ MUTEX_LOCK(&PL_eval_mutex);
+ PL_eval_owner = 0;
+ COND_SIGNAL(&PL_eval_cond);
+ MUTEX_UNLOCK(&PL_eval_mutex);
+#endif /* USE_THREADS */
+
+ RETURNOP(PL_eval_start);
}
PP(pp_require)
{
- dSP;
- register CONTEXT *cx;
+ djSP;
+ register PERL_CONTEXT *cx;
SV *sv;
char *name;
+ STRLEN len;
char *tryname;
SV *namesv = Nullsv;
SV** svp;
I32 gimme = G_SCALAR;
PerlIO *tryrsfp = 0;
+ STRLEN n_a;
sv = POPs;
if (SvNIOKp(sv) && !SvPOKp(sv)) {
SET_NUMERIC_STANDARD();
- if (atof(patchlevel) + 0.00000999 < SvNV(sv))
+ if (atof(PL_patchlevel) + 0.00000999 < SvNV(sv))
DIE("Perl %s required--this is only version %s, stopped",
- SvPV(sv,na),patchlevel);
+ SvPV(sv,n_a),PL_patchlevel);
RETPUSHYES;
}
- name = SvPV(sv, na);
- if (!*name)
+ name = SvPV(sv, len);
+ if (!(name && len > 0 && *name))
DIE("Null filename used");
TAINT_PROPER("require");
- if (op->op_type == OP_REQUIRE &&
- (svp = hv_fetch(GvHVn(incgv), name, SvCUR(sv), 0)) &&
- *svp != &sv_undef)
+ if (PL_op->op_type == OP_REQUIRE &&
+ (svp = hv_fetch(GvHVn(PL_incgv), name, len, 0)) &&
+ *svp != &PL_sv_undef)
RETPUSHYES;
/* prepare to compile file */
@@ -2278,10 +2621,10 @@ PP(pp_require)
)
{
tryname = name;
- tryrsfp = PerlIO_open(name,"r");
+ tryrsfp = PerlIO_open(name,PERL_SCRIPT_MODE);
}
else {
- AV *ar = GvAVn(incgv);
+ AV *ar = GvAVn(PL_incgv);
I32 i;
#ifdef VMS
char *unixname;
@@ -2290,7 +2633,7 @@ PP(pp_require)
{
namesv = NEWSV(806, 0);
for (i = 0; i <= AvFILL(ar); i++) {
- char *dir = SvPVx(*av_fetch(ar, i, TRUE), na);
+ char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a);
#ifdef VMS
char *unixdir;
if ((unixdir = tounixpath(dir, Nullch)) == Nullch)
@@ -2300,8 +2643,9 @@ PP(pp_require)
#else
sv_setpvf(namesv, "%s/%s", dir, name);
#endif
+ TAINT_PROPER("require");
tryname = SvPVX(namesv);
- tryrsfp = PerlIO_open(tryname, "r");
+ tryrsfp = PerlIO_open(tryname, PERL_SCRIPT_MODE);
if (tryrsfp) {
if (tryname[0] == '.' && tryname[1] == '/')
tryname += 2;
@@ -2310,14 +2654,14 @@ PP(pp_require)
}
}
}
- SAVESPTR(compiling.cop_filegv);
- compiling.cop_filegv = gv_fetchfile(tryrsfp ? tryname : name);
+ SAVESPTR(PL_compiling.cop_filegv);
+ PL_compiling.cop_filegv = gv_fetchfile(tryrsfp ? tryname : name);
SvREFCNT_dec(namesv);
if (!tryrsfp) {
- if (op->op_type == OP_REQUIRE) {
+ if (PL_op->op_type == OP_REQUIRE) {
SV *msg = sv_2mortal(newSVpvf("Can't locate %s in @INC", name));
SV *dirmsgsv = NEWSV(0, 0);
- AV *ar = GvAVn(incgv);
+ AV *ar = GvAVn(PL_incgv);
I32 i;
if (instr(SvPVX(msg), ".h "))
sv_catpv(msg, " (change .h to .ph maybe?)");
@@ -2325,7 +2669,7 @@ PP(pp_require)
sv_catpv(msg, " (did you run h2ph?)");
sv_catpv(msg, " (@INC contains:");
for (i = 0; i <= AvFILL(ar); i++) {
- char *dir = SvPVx(*av_fetch(ar, i, TRUE), na);
+ char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a);
sv_setpvf(dirmsgsv, " %s", dir);
sv_catsv(msg, dirmsgsv);
}
@@ -2336,35 +2680,44 @@ PP(pp_require)
RETPUSHUNDEF;
}
+ else
+ SETERRNO(0, SS$_NORMAL);
/* Assume success here to prevent recursive requirement. */
- (void)hv_store(GvHVn(incgv), name, strlen(name),
- newSVsv(GvSV(compiling.cop_filegv)), 0 );
+ (void)hv_store(GvHVn(PL_incgv), name, strlen(name),
+ newSVsv(GvSV(PL_compiling.cop_filegv)), 0 );
ENTER;
SAVETMPS;
lex_start(sv_2mortal(newSVpv("",0)));
- if (rsfp_filters){
- save_aptr(&rsfp_filters);
- rsfp_filters = NULL;
- }
+ SAVEGENERICSV(PL_rsfp_filters);
+ PL_rsfp_filters = Nullav;
- rsfp = tryrsfp;
+ PL_rsfp = tryrsfp;
name = savepv(name);
SAVEFREEPV(name);
- SAVEI32(hints);
- hints = 0;
+ SAVEHINTS();
+ PL_hints = 0;
/* switch to eval mode */
- push_return(op->op_next);
+ push_return(PL_op->op_next);
PUSHBLOCK(cx, CXt_EVAL, SP);
- PUSHEVAL(cx, name, compiling.cop_filegv);
+ PUSHEVAL(cx, name, PL_compiling.cop_filegv);
- compiling.cop_line = 0;
+ SAVEI16(PL_compiling.cop_line);
+ PL_compiling.cop_line = 0;
PUTBACK;
- return DOCATCH(doeval(G_SCALAR));
+#ifdef USE_THREADS
+ MUTEX_LOCK(&PL_eval_mutex);
+ if (PL_eval_owner && PL_eval_owner != thr)
+ while (PL_eval_owner)
+ COND_WAIT(&PL_eval_cond, &PL_eval_mutex);
+ PL_eval_owner = thr;
+ MUTEX_UNLOCK(&PL_eval_mutex);
+#endif /* USE_THREADS */
+ return DOCATCH(doeval(G_SCALAR, NULL));
}
PP(pp_dofile)
@@ -2374,10 +2727,10 @@ PP(pp_dofile)
PP(pp_entereval)
{
- dSP;
- register CONTEXT *cx;
+ djSP;
+ register PERL_CONTEXT *cx;
dPOPss;
- I32 gimme = GIMME_V, was = sub_generation;
+ I32 gimme = GIMME_V, was = PL_sub_generation;
char tmpbuf[TYPE_DIGITS(long) + 12];
char *safestr;
STRLEN len;
@@ -2393,32 +2746,40 @@ PP(pp_entereval)
/* switch to eval mode */
- SAVESPTR(compiling.cop_filegv);
- sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++evalseq);
- compiling.cop_filegv = gv_fetchfile(tmpbuf+2);
- compiling.cop_line = 1;
+ SAVESPTR(PL_compiling.cop_filegv);
+ sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq);
+ PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2);
+ PL_compiling.cop_line = 1;
/* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
deleting the eval's FILEGV from the stash before gv_check() runs
(i.e. before run-time proper). To work around the coredump that
ensues, we always turn GvMULTI_on for any globals that were
introduced within evals. See force_ident(). GSAR 96-10-12 */
safestr = savepv(tmpbuf);
- SAVEDELETE(defstash, safestr, strlen(safestr));
- SAVEI32(hints);
- hints = op->op_targ;
+ SAVEDELETE(PL_defstash, safestr, strlen(safestr));
+ SAVEHINTS();
+ PL_hints = PL_op->op_targ;
- push_return(op->op_next);
- PUSHBLOCK(cx, CXt_EVAL, SP);
- PUSHEVAL(cx, 0, compiling.cop_filegv);
+ push_return(PL_op->op_next);
+ PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP);
+ PUSHEVAL(cx, 0, PL_compiling.cop_filegv);
/* prepare to compile string */
- if (PERLDB_LINE && curstash != debstash)
- save_lines(GvAV(compiling.cop_filegv), linestr);
+ if (PERLDB_LINE && PL_curstash != PL_debstash)
+ save_lines(GvAV(PL_compiling.cop_filegv), PL_linestr);
PUTBACK;
- ret = doeval(gimme);
- if (PERLDB_INTER && was != sub_generation /* Some subs defined here. */
- && ret != op->op_next) { /* Successive compilation. */
+#ifdef USE_THREADS
+ MUTEX_LOCK(&PL_eval_mutex);
+ if (PL_eval_owner && PL_eval_owner != thr)
+ while (PL_eval_owner)
+ COND_WAIT(&PL_eval_cond, &PL_eval_mutex);
+ PL_eval_owner = thr;
+ MUTEX_UNLOCK(&PL_eval_mutex);
+#endif /* USE_THREADS */
+ ret = doeval(gimme, NULL);
+ if (PERLDB_INTER && was != PL_sub_generation /* Some subs defined here. */
+ && ret != PL_op->op_next) { /* Successive compilation. */
strcpy(safestr, "_<(eval )"); /* Anything fake and short. */
}
return DOCATCH(ret);
@@ -2426,14 +2787,14 @@ PP(pp_entereval)
PP(pp_leaveeval)
{
- dSP;
+ djSP;
register SV **mark;
SV **newsp;
PMOP *newpm;
I32 gimme;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
OP *retop;
- U8 save_flags = op -> op_flags;
+ U8 save_flags = PL_op -> op_flags;
I32 optype;
POPBLOCK(cx,newpm);
@@ -2453,7 +2814,7 @@ PP(pp_leaveeval)
}
else {
MEXTEND(mark,0);
- *MARK = &sv_undef;
+ *MARK = &PL_sv_undef;
}
}
else {
@@ -2465,7 +2826,7 @@ PP(pp_leaveeval)
}
}
}
- curpm = newpm; /* Don't pop $1 et al till now */
+ PL_curpm = newpm; /* Don't pop $1 et al till now */
/*
* Closures mentioned at top level of eval cannot be referenced
@@ -2473,16 +2834,16 @@ PP(pp_leaveeval)
* (Note that the fact that compcv and friends are still set here
* is, AFAIK, an accident.) --Chip
*/
- if (AvFILL(comppad_name) >= 0) {
- SV **svp = AvARRAY(comppad_name);
+ if (AvFILLp(PL_comppad_name) >= 0) {
+ SV **svp = AvARRAY(PL_comppad_name);
I32 ix;
- for (ix = AvFILL(comppad_name); ix >= 0; ix--) {
+ for (ix = AvFILLp(PL_comppad_name); ix >= 0; ix--) {
SV *sv = svp[ix];
- if (sv && sv != &sv_undef && *SvPVX(sv) == '&') {
+ if (sv && sv != &PL_sv_undef && *SvPVX(sv) == '&') {
SvREFCNT_dec(sv);
- svp[ix] = &sv_undef;
+ svp[ix] = &PL_sv_undef;
- sv = curpad[ix];
+ sv = PL_curpad[ix];
if (CvCLONE(sv)) {
SvREFCNT_dec(CvOUTSIDE(sv));
CvOUTSIDE(sv) = Nullcv;
@@ -2491,39 +2852,40 @@ PP(pp_leaveeval)
SvREFCNT_dec(sv);
sv = NEWSV(0,0);
SvPADTMP_on(sv);
- curpad[ix] = sv;
+ PL_curpad[ix] = sv;
}
}
}
}
#ifdef DEBUGGING
- assert(CvDEPTH(compcv) == 1);
+ assert(CvDEPTH(PL_compcv) == 1);
#endif
- CvDEPTH(compcv) = 0;
+ CvDEPTH(PL_compcv) = 0;
+ lex_end();
if (optype == OP_REQUIRE &&
- !(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp))
+ !(gimme == G_SCALAR ? SvTRUE(*SP) : SP > newsp))
{
/* Unassume the success we assumed earlier. */
char *name = cx->blk_eval.old_name;
- (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD);
+ (void)hv_delete(GvHVn(PL_incgv), name, strlen(name), G_DISCARD);
retop = die("%s did not return a true value", name);
+ /* die_where() did LEAVE, or we won't be here */
+ }
+ else {
+ LEAVE;
+ if (!(save_flags & OPf_SPECIAL))
+ sv_setpv(ERRSV,"");
}
-
- lex_end();
- LEAVE;
-
- if (!(save_flags & OPf_SPECIAL))
- sv_setpv(GvSV(errgv),"");
RETURNOP(retop);
}
PP(pp_entertry)
{
- dSP;
- register CONTEXT *cx;
+ djSP;
+ register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
ENTER;
@@ -2532,22 +2894,22 @@ PP(pp_entertry)
push_return(cLOGOP->op_other->op_next);
PUSHBLOCK(cx, CXt_EVAL, SP);
PUSHEVAL(cx, 0, 0);
- eval_root = op; /* Only needed so that goto works right. */
+ PL_eval_root = PL_op; /* Only needed so that goto works right. */
- in_eval = 1;
- sv_setpv(GvSV(errgv),"");
+ PL_in_eval = 1;
+ sv_setpv(ERRSV,"");
PUTBACK;
- return DOCATCH(op->op_next);
+ return DOCATCH(PL_op->op_next);
}
PP(pp_leavetry)
{
- dSP;
+ djSP;
register SV **mark;
SV **newsp;
PMOP *newpm;
I32 gimme;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 optype;
POPBLOCK(cx,newpm);
@@ -2567,7 +2929,7 @@ PP(pp_leavetry)
}
else {
MEXTEND(mark,0);
- *MARK = &sv_undef;
+ *MARK = &PL_sv_undef;
}
SP = MARK;
}
@@ -2580,16 +2942,15 @@ PP(pp_leavetry)
}
}
}
- curpm = newpm; /* Don't pop $1 et al till now */
+ PL_curpm = newpm; /* Don't pop $1 et al till now */
LEAVE;
- sv_setpv(GvSV(errgv),"");
+ sv_setpv(ERRSV,"");
RETURN;
}
-static void
-doparseform(sv)
-SV *sv;
+STATIC void
+doparseform(SV *sv)
{
STRLEN len;
register char *s = SvPV_force(sv, len);
@@ -2765,3 +3126,694 @@ SV *sv;
sv_magic(sv, Nullsv, 'f', Nullch, 0);
SvCOMPILED_on(sv);
}
+
+/*
+ * The rest of this file was derived from source code contributed
+ * by Tom Horsley.
+ *
+ * NOTE: this code was derived from Tom Horsley's qsort replacement
+ * and should not be confused with the original code.
+ */
+
+/* Copyright (C) Tom Horsley, 1997. All rights reserved.
+
+ Permission granted to distribute under the same terms as perl which are
+ (briefly):
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of either:
+
+ a) the GNU General Public License as published by the Free
+ Software Foundation; either version 1, or (at your option) any
+ later version, or
+
+ b) the "Artistic License" which comes with this Kit.
+
+ Details on the perl license can be found in the perl source code which
+ may be located via the www.perl.com web page.
+
+ This is the most wonderfulest possible qsort I can come up with (and
+ still be mostly portable) My (limited) tests indicate it consistently
+ does about 20% fewer calls to compare than does the qsort in the Visual
+ C++ library, other vendors may vary.
+
+ Some of the ideas in here can be found in "Algorithms" by Sedgewick,
+ others I invented myself (or more likely re-invented since they seemed
+ pretty obvious once I watched the algorithm operate for a while).
+
+ Most of this code was written while watching the Marlins sweep the Giants
+ in the 1997 National League Playoffs - no Braves fans allowed to use this
+ code (just kidding :-).
+
+ I realize that if I wanted to be true to the perl tradition, the only
+ comment in this file would be something like:
+
+ ...they shuffled back towards the rear of the line. 'No, not at the
+ rear!' the slave-driver shouted. 'Three files up. And stay there...
+
+ However, I really needed to violate that tradition just so I could keep
+ track of what happens myself, not to mention some poor fool trying to
+ understand this years from now :-).
+*/
+
+/* ********************************************************** Configuration */
+
+#ifndef QSORT_ORDER_GUESS
+#define QSORT_ORDER_GUESS 2 /* Select doubling version of the netBSD trick */
+#endif
+
+/* QSORT_MAX_STACK is the largest number of partitions that can be stacked up for
+ future processing - a good max upper bound is log base 2 of memory size
+ (32 on 32 bit machines, 64 on 64 bit machines, etc). In reality can
+ safely be smaller than that since the program is taking up some space and
+ most operating systems only let you grab some subset of contiguous
+ memory (not to mention that you are normally sorting data larger than
+ 1 byte element size :-).
+*/
+#ifndef QSORT_MAX_STACK
+#define QSORT_MAX_STACK 32
+#endif
+
+/* QSORT_BREAK_EVEN is the size of the largest partition we should insertion sort.
+ Anything bigger and we use qsort. If you make this too small, the qsort
+ will probably break (or become less efficient), because it doesn't expect
+ the middle element of a partition to be the same as the right or left -
+ you have been warned).
+*/
+#ifndef QSORT_BREAK_EVEN
+#define QSORT_BREAK_EVEN 6
+#endif
+
+/* ************************************************************* Data Types */
+
+/* hold left and right index values of a partition waiting to be sorted (the
+ partition includes both left and right - right is NOT one past the end or
+ anything like that).
+*/
+struct partition_stack_entry {
+ int left;
+ int right;
+#ifdef QSORT_ORDER_GUESS
+ int qsort_break_even;
+#endif
+};
+
+/* ******************************************************* Shorthand Macros */
+
+/* Note that these macros will be used from inside the qsort function where
+ we happen to know that the variable 'elt_size' contains the size of an
+ array element and the variable 'temp' points to enough space to hold a
+ temp element and the variable 'array' points to the array being sorted
+ and 'compare' is the pointer to the compare routine.
+
+ Also note that there are very many highly architecture specific ways
+ these might be sped up, but this is simply the most generally portable
+ code I could think of.
+*/
+
+/* Return < 0 == 0 or > 0 as the value of elt1 is < elt2, == elt2, > elt2
+*/
+#ifdef PERL_OBJECT
+#define qsort_cmp(elt1, elt2) \
+ ((this->*compare)(array[elt1], array[elt2]))
+#else
+#define qsort_cmp(elt1, elt2) \
+ ((*compare)(array[elt1], array[elt2]))
+#endif
+
+#ifdef QSORT_ORDER_GUESS
+#define QSORT_NOTICE_SWAP swapped++;
+#else
+#define QSORT_NOTICE_SWAP
+#endif
+
+/* swaps contents of array elements elt1, elt2.
+*/
+#define qsort_swap(elt1, elt2) \
+ STMT_START { \
+ QSORT_NOTICE_SWAP \
+ temp = array[elt1]; \
+ array[elt1] = array[elt2]; \
+ array[elt2] = temp; \
+ } STMT_END
+
+/* rotate contents of elt1, elt2, elt3 such that elt1 gets elt2, elt2 gets
+ elt3 and elt3 gets elt1.
+*/
+#define qsort_rotate(elt1, elt2, elt3) \
+ STMT_START { \
+ QSORT_NOTICE_SWAP \
+ temp = array[elt1]; \
+ array[elt1] = array[elt2]; \
+ array[elt2] = array[elt3]; \
+ array[elt3] = temp; \
+ } STMT_END
+
+/* ************************************************************ Debug stuff */
+
+#ifdef QSORT_DEBUG
+
+static void
+break_here()
+{
+ return; /* good place to set a breakpoint */
+}
+
+#define qsort_assert(t) (void)( (t) || (break_here(), 0) )
+
+static void
+doqsort_all_asserts(
+ void * array,
+ size_t num_elts,
+ size_t elt_size,
+ int (*compare)(const void * elt1, const void * elt2),
+ int pc_left, int pc_right, int u_left, int u_right)
+{
+ int i;
+
+ qsort_assert(pc_left <= pc_right);
+ qsort_assert(u_right < pc_left);
+ qsort_assert(pc_right < u_left);
+ for (i = u_right + 1; i < pc_left; ++i) {
+ qsort_assert(qsort_cmp(i, pc_left) < 0);
+ }
+ for (i = pc_left; i < pc_right; ++i) {
+ qsort_assert(qsort_cmp(i, pc_right) == 0);
+ }
+ for (i = pc_right + 1; i < u_left; ++i) {
+ qsort_assert(qsort_cmp(pc_right, i) < 0);
+ }
+}
+
+#define qsort_all_asserts(PC_LEFT, PC_RIGHT, U_LEFT, U_RIGHT) \
+ doqsort_all_asserts(array, num_elts, elt_size, compare, \
+ PC_LEFT, PC_RIGHT, U_LEFT, U_RIGHT)
+
+#else
+
+#define qsort_assert(t) ((void)0)
+
+#define qsort_all_asserts(PC_LEFT, PC_RIGHT, U_LEFT, U_RIGHT) ((void)0)
+
+#endif
+
+/* ****************************************************************** qsort */
+
+STATIC void
+#ifdef PERL_OBJECT
+qsortsv(SV ** array, size_t num_elts, SVCOMPARE compare)
+#else
+qsortsv(
+ SV ** array,
+ size_t num_elts,
+ I32 (*compare)(SV *a, SV *b))
+#endif
+{
+ register SV * temp;
+
+ struct partition_stack_entry partition_stack[QSORT_MAX_STACK];
+ int next_stack_entry = 0;
+
+ int part_left;
+ int part_right;
+#ifdef QSORT_ORDER_GUESS
+ int qsort_break_even;
+ int swapped;
+#endif
+
+ /* Make sure we actually have work to do.
+ */
+ if (num_elts <= 1) {
+ return;
+ }
+
+ /* Setup the initial partition definition and fall into the sorting loop
+ */
+ part_left = 0;
+ part_right = (int)(num_elts - 1);
+#ifdef QSORT_ORDER_GUESS
+ qsort_break_even = QSORT_BREAK_EVEN;
+#else
+#define qsort_break_even QSORT_BREAK_EVEN
+#endif
+ for ( ; ; ) {
+ if ((part_right - part_left) >= qsort_break_even) {
+ /* OK, this is gonna get hairy, so lets try to document all the
+ concepts and abbreviations and variables and what they keep
+ track of:
+
+ pc: pivot chunk - the set of array elements we accumulate in the
+ middle of the partition, all equal in value to the original
+ pivot element selected. The pc is defined by:
+
+ pc_left - the leftmost array index of the pc
+ pc_right - the rightmost array index of the pc
+
+ we start with pc_left == pc_right and only one element
+ in the pivot chunk (but it can grow during the scan).
+
+ u: uncompared elements - the set of elements in the partition
+ we have not yet compared to the pivot value. There are two
+ uncompared sets during the scan - one to the left of the pc
+ and one to the right.
+
+ u_right - the rightmost index of the left side's uncompared set
+ u_left - the leftmost index of the right side's uncompared set
+
+ The leftmost index of the left sides's uncompared set
+ doesn't need its own variable because it is always defined
+ by the leftmost edge of the whole partition (part_left). The
+ same goes for the rightmost edge of the right partition
+ (part_right).
+
+ We know there are no uncompared elements on the left once we
+ get u_right < part_left and no uncompared elements on the
+ right once u_left > part_right. When both these conditions
+ are met, we have completed the scan of the partition.
+
+ Any elements which are between the pivot chunk and the
+ uncompared elements should be less than the pivot value on
+ the left side and greater than the pivot value on the right
+ side (in fact, the goal of the whole algorithm is to arrange
+ for that to be true and make the groups of less-than and
+ greater-then elements into new partitions to sort again).
+
+ As you marvel at the complexity of the code and wonder why it
+ has to be so confusing. Consider some of the things this level
+ of confusion brings:
+
+ Once I do a compare, I squeeze every ounce of juice out of it. I
+ never do compare calls I don't have to do, and I certainly never
+ do redundant calls.
+
+ I also never swap any elements unless I can prove there is a
+ good reason. Many sort algorithms will swap a known value with
+ an uncompared value just to get things in the right place (or
+ avoid complexity :-), but that uncompared value, once it gets
+ compared, may then have to be swapped again. A lot of the
+ complexity of this code is due to the fact that it never swaps
+ anything except compared values, and it only swaps them when the
+ compare shows they are out of position.
+ */
+ int pc_left, pc_right;
+ int u_right, u_left;
+
+ int s;
+
+ pc_left = ((part_left + part_right) / 2);
+ pc_right = pc_left;
+ u_right = pc_left - 1;
+ u_left = pc_right + 1;
+
+ /* Qsort works best when the pivot value is also the median value
+ in the partition (unfortunately you can't find the median value
+ without first sorting :-), so to give the algorithm a helping
+ hand, we pick 3 elements and sort them and use the median value
+ of that tiny set as the pivot value.
+
+ Some versions of qsort like to use the left middle and right as
+ the 3 elements to sort so they can insure the ends of the
+ partition will contain values which will stop the scan in the
+ compare loop, but when you have to call an arbitrarily complex
+ routine to do a compare, its really better to just keep track of
+ array index values to know when you hit the edge of the
+ partition and avoid the extra compare. An even better reason to
+ avoid using a compare call is the fact that you can drop off the
+ edge of the array if someone foolishly provides you with an
+ unstable compare function that doesn't always provide consistent
+ results.
+
+ So, since it is simpler for us to compare the three adjacent
+ elements in the middle of the partition, those are the ones we
+ pick here (conveniently pointed at by u_right, pc_left, and
+ u_left). The values of the left, center, and right elements
+ are refered to as l c and r in the following comments.
+ */
+
+#ifdef QSORT_ORDER_GUESS
+ swapped = 0;
+#endif
+ s = qsort_cmp(u_right, pc_left);
+ if (s < 0) {
+ /* l < c */
+ s = qsort_cmp(pc_left, u_left);
+ /* if l < c, c < r - already in order - nothing to do */
+ if (s == 0) {
+ /* l < c, c == r - already in order, pc grows */
+ ++pc_right;
+ qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
+ } else if (s > 0) {
+ /* l < c, c > r - need to know more */
+ s = qsort_cmp(u_right, u_left);
+ if (s < 0) {
+ /* l < c, c > r, l < r - swap c & r to get ordered */
+ qsort_swap(pc_left, u_left);
+ qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
+ } else if (s == 0) {
+ /* l < c, c > r, l == r - swap c&r, grow pc */
+ qsort_swap(pc_left, u_left);
+ --pc_left;
+ qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
+ } else {
+ /* l < c, c > r, l > r - make lcr into rlc to get ordered */
+ qsort_rotate(pc_left, u_right, u_left);
+ qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
+ }
+ }
+ } else if (s == 0) {
+ /* l == c */
+ s = qsort_cmp(pc_left, u_left);
+ if (s < 0) {
+ /* l == c, c < r - already in order, grow pc */
+ --pc_left;
+ qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
+ } else if (s == 0) {
+ /* l == c, c == r - already in order, grow pc both ways */
+ --pc_left;
+ ++pc_right;
+ qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
+ } else {
+ /* l == c, c > r - swap l & r, grow pc */
+ qsort_swap(u_right, u_left);
+ ++pc_right;
+ qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
+ }
+ } else {
+ /* l > c */
+ s = qsort_cmp(pc_left, u_left);
+ if (s < 0) {
+ /* l > c, c < r - need to know more */
+ s = qsort_cmp(u_right, u_left);
+ if (s < 0) {
+ /* l > c, c < r, l < r - swap l & c to get ordered */
+ qsort_swap(u_right, pc_left);
+ qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
+ } else if (s == 0) {
+ /* l > c, c < r, l == r - swap l & c, grow pc */
+ qsort_swap(u_right, pc_left);
+ ++pc_right;
+ qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
+ } else {
+ /* l > c, c < r, l > r - rotate lcr into crl to order */
+ qsort_rotate(u_right, pc_left, u_left);
+ qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
+ }
+ } else if (s == 0) {
+ /* l > c, c == r - swap ends, grow pc */
+ qsort_swap(u_right, u_left);
+ --pc_left;
+ qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
+ } else {
+ /* l > c, c > r - swap ends to get in order */
+ qsort_swap(u_right, u_left);
+ qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
+ }
+ }
+ /* We now know the 3 middle elements have been compared and
+ arranged in the desired order, so we can shrink the uncompared
+ sets on both sides
+ */
+ --u_right;
+ ++u_left;
+ qsort_all_asserts(pc_left, pc_right, u_left, u_right);
+
+ /* The above massive nested if was the simple part :-). We now have
+ the middle 3 elements ordered and we need to scan through the
+ uncompared sets on either side, swapping elements that are on
+ the wrong side or simply shuffling equal elements around to get
+ all equal elements into the pivot chunk.
+ */
+
+ for ( ; ; ) {
+ int still_work_on_left;
+ int still_work_on_right;
+
+ /* Scan the uncompared values on the left. If I find a value
+ equal to the pivot value, move it over so it is adjacent to
+ the pivot chunk and expand the pivot chunk. If I find a value
+ less than the pivot value, then just leave it - its already
+ on the correct side of the partition. If I find a greater
+ value, then stop the scan.
+ */
+ while (still_work_on_left = (u_right >= part_left)) {
+ s = qsort_cmp(u_right, pc_left);
+ if (s < 0) {
+ --u_right;
+ } else if (s == 0) {
+ --pc_left;
+ if (pc_left != u_right) {
+ qsort_swap(u_right, pc_left);
+ }
+ --u_right;
+ } else {
+ break;
+ }
+ qsort_assert(u_right < pc_left);
+ qsort_assert(pc_left <= pc_right);
+ qsort_assert(qsort_cmp(u_right + 1, pc_left) <= 0);
+ qsort_assert(qsort_cmp(pc_left, pc_right) == 0);
+ }
+
+ /* Do a mirror image scan of uncompared values on the right
+ */
+ while (still_work_on_right = (u_left <= part_right)) {
+ s = qsort_cmp(pc_right, u_left);
+ if (s < 0) {
+ ++u_left;
+ } else if (s == 0) {
+ ++pc_right;
+ if (pc_right != u_left) {
+ qsort_swap(pc_right, u_left);
+ }
+ ++u_left;
+ } else {
+ break;
+ }
+ qsort_assert(u_left > pc_right);
+ qsort_assert(pc_left <= pc_right);
+ qsort_assert(qsort_cmp(pc_right, u_left - 1) <= 0);
+ qsort_assert(qsort_cmp(pc_left, pc_right) == 0);
+ }
+
+ if (still_work_on_left) {
+ /* I know I have a value on the left side which needs to be
+ on the right side, but I need to know more to decide
+ exactly the best thing to do with it.
+ */
+ if (still_work_on_right) {
+ /* I know I have values on both side which are out of
+ position. This is a big win because I kill two birds
+ with one swap (so to speak). I can advance the
+ uncompared pointers on both sides after swapping both
+ of them into the right place.
+ */
+ qsort_swap(u_right, u_left);
+ --u_right;
+ ++u_left;
+ qsort_all_asserts(pc_left, pc_right, u_left, u_right);
+ } else {
+ /* I have an out of position value on the left, but the
+ right is fully scanned, so I "slide" the pivot chunk
+ and any less-than values left one to make room for the
+ greater value over on the right. If the out of position
+ value is immediately adjacent to the pivot chunk (there
+ are no less-than values), I can do that with a swap,
+ otherwise, I have to rotate one of the less than values
+ into the former position of the out of position value
+ and the right end of the pivot chunk into the left end
+ (got all that?).
+ */
+ --pc_left;
+ if (pc_left == u_right) {
+ qsort_swap(u_right, pc_right);
+ qsort_all_asserts(pc_left, pc_right-1, u_left, u_right-1);
+ } else {
+ qsort_rotate(u_right, pc_left, pc_right);
+ qsort_all_asserts(pc_left, pc_right-1, u_left, u_right-1);
+ }
+ --pc_right;
+ --u_right;
+ }
+ } else if (still_work_on_right) {
+ /* Mirror image of complex case above: I have an out of
+ position value on the right, but the left is fully
+ scanned, so I need to shuffle things around to make room
+ for the right value on the left.
+ */
+ ++pc_right;
+ if (pc_right == u_left) {
+ qsort_swap(u_left, pc_left);
+ qsort_all_asserts(pc_left+1, pc_right, u_left+1, u_right);
+ } else {
+ qsort_rotate(pc_right, pc_left, u_left);
+ qsort_all_asserts(pc_left+1, pc_right, u_left+1, u_right);
+ }
+ ++pc_left;
+ ++u_left;
+ } else {
+ /* No more scanning required on either side of partition,
+ break out of loop and figure out next set of partitions
+ */
+ break;
+ }
+ }
+
+ /* The elements in the pivot chunk are now in the right place. They
+ will never move or be compared again. All I have to do is decide
+ what to do with the stuff to the left and right of the pivot
+ chunk.
+
+ Notes on the QSORT_ORDER_GUESS ifdef code:
+
+ 1. If I just built these partitions without swapping any (or
+ very many) elements, there is a chance that the elements are
+ already ordered properly (being properly ordered will
+ certainly result in no swapping, but the converse can't be
+ proved :-).
+
+ 2. A (properly written) insertion sort will run faster on
+ already ordered data than qsort will.
+
+ 3. Perhaps there is some way to make a good guess about
+ switching to an insertion sort earlier than partition size 6
+ (for instance - we could save the partition size on the stack
+ and increase the size each time we find we didn't swap, thus
+ switching to insertion sort earlier for partitions with a
+ history of not swapping).
+
+ 4. Naturally, if I just switch right away, it will make
+ artificial benchmarks with pure ascending (or descending)
+ data look really good, but is that a good reason in general?
+ Hard to say...
+ */
+
+#ifdef QSORT_ORDER_GUESS
+ if (swapped < 3) {
+#if QSORT_ORDER_GUESS == 1
+ qsort_break_even = (part_right - part_left) + 1;
+#endif
+#if QSORT_ORDER_GUESS == 2
+ qsort_break_even *= 2;
+#endif
+#if QSORT_ORDER_GUESS == 3
+ int prev_break = qsort_break_even;
+ qsort_break_even *= qsort_break_even;
+ if (qsort_break_even < prev_break) {
+ qsort_break_even = (part_right - part_left) + 1;
+ }
+#endif
+ } else {
+ qsort_break_even = QSORT_BREAK_EVEN;
+ }
+#endif
+
+ if (part_left < pc_left) {
+ /* There are elements on the left which need more processing.
+ Check the right as well before deciding what to do.
+ */
+ if (pc_right < part_right) {
+ /* We have two partitions to be sorted. Stack the biggest one
+ and process the smallest one on the next iteration. This
+ minimizes the stack height by insuring that any additional
+ stack entries must come from the smallest partition which
+ (because it is smallest) will have the fewest
+ opportunities to generate additional stack entries.
+ */
+ if ((part_right - pc_right) > (pc_left - part_left)) {
+ /* stack the right partition, process the left */
+ partition_stack[next_stack_entry].left = pc_right + 1;
+ partition_stack[next_stack_entry].right = part_right;
+#ifdef QSORT_ORDER_GUESS
+ partition_stack[next_stack_entry].qsort_break_even = qsort_break_even;
+#endif
+ part_right = pc_left - 1;
+ } else {
+ /* stack the left partition, process the right */
+ partition_stack[next_stack_entry].left = part_left;
+ partition_stack[next_stack_entry].right = pc_left - 1;
+#ifdef QSORT_ORDER_GUESS
+ partition_stack[next_stack_entry].qsort_break_even = qsort_break_even;
+#endif
+ part_left = pc_right + 1;
+ }
+ qsort_assert(next_stack_entry < QSORT_MAX_STACK);
+ ++next_stack_entry;
+ } else {
+ /* The elements on the left are the only remaining elements
+ that need sorting, arrange for them to be processed as the
+ next partition.
+ */
+ part_right = pc_left - 1;
+ }
+ } else if (pc_right < part_right) {
+ /* There is only one chunk on the right to be sorted, make it
+ the new partition and loop back around.
+ */
+ part_left = pc_right + 1;
+ } else {
+ /* This whole partition wound up in the pivot chunk, so
+ we need to get a new partition off the stack.
+ */
+ if (next_stack_entry == 0) {
+ /* the stack is empty - we are done */
+ break;
+ }
+ --next_stack_entry;
+ part_left = partition_stack[next_stack_entry].left;
+ part_right = partition_stack[next_stack_entry].right;
+#ifdef QSORT_ORDER_GUESS
+ qsort_break_even = partition_stack[next_stack_entry].qsort_break_even;
+#endif
+ }
+ } else {
+ /* This partition is too small to fool with qsort complexity, just
+ do an ordinary insertion sort to minimize overhead.
+ */
+ int i;
+ /* Assume 1st element is in right place already, and start checking
+ at 2nd element to see where it should be inserted.
+ */
+ for (i = part_left + 1; i <= part_right; ++i) {
+ int j;
+ /* Scan (backwards - just in case 'i' is already in right place)
+ through the elements already sorted to see if the ith element
+ belongs ahead of one of them.
+ */
+ for (j = i - 1; j >= part_left; --j) {
+ if (qsort_cmp(i, j) >= 0) {
+ /* i belongs right after j
+ */
+ break;
+ }
+ }
+ ++j;
+ if (j != i) {
+ /* Looks like we really need to move some things
+ */
+ int k;
+ temp = array[i];
+ for (k = i - 1; k >= j; --k)
+ array[k + 1] = array[k];
+ array[j] = temp;
+ }
+ }
+
+ /* That partition is now sorted, grab the next one, or get out
+ of the loop if there aren't any more.
+ */
+
+ if (next_stack_entry == 0) {
+ /* the stack is empty - we are done */
+ break;
+ }
+ --next_stack_entry;
+ part_left = partition_stack[next_stack_entry].left;
+ part_right = partition_stack[next_stack_entry].right;
+#ifdef QSORT_ORDER_GUESS
+ qsort_break_even = partition_stack[next_stack_entry].qsort_break_even;
+#endif
+ }
+ }
+
+ /* Believe it or not, the array is sorted at this point! */
+}
diff --git a/gnu/usr.bin/perl/pp_hot.c b/gnu/usr.bin/perl/pp_hot.c
index e1f4476dda8..e4d398d14ee 100644
--- a/gnu/usr.bin/perl/pp_hot.c
+++ b/gnu/usr.bin/perl/pp_hot.c
@@ -1,6 +1,6 @@
/* pp_hot.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -18,29 +18,61 @@
#include "EXTERN.h"
#include "perl.h"
+#ifdef I_UNISTD
+#include <unistd.h>
+#endif
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
+
/* Hot code. */
+#ifdef USE_THREADS
+static void
+unset_cvowner(void *cvarg)
+{
+ register CV* cv = (CV *) cvarg;
+#ifdef DEBUGGING
+ dTHR;
+#endif /* DEBUGGING */
+
+ DEBUG_S((PerlIO_printf(PerlIO_stderr(), "%p unsetting CvOWNER of %p:%s\n",
+ thr, cv, SvPEEK((SV*)cv))));
+ MUTEX_LOCK(CvMUTEXP(cv));
+ DEBUG_S(if (CvDEPTH(cv) != 0)
+ PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n",
+ CvDEPTH(cv)););
+ assert(thr == CvOWNER(cv));
+ CvOWNER(cv) = 0;
+ MUTEX_UNLOCK(CvMUTEXP(cv));
+ SvREFCNT_dec(cv);
+}
+#endif /* USE_THREADS */
+
PP(pp_const)
{
- dSP;
+ djSP;
XPUSHs(cSVOP->op_sv);
RETURN;
}
PP(pp_nextstate)
{
- curcop = (COP*)op;
+ PL_curcop = (COP*)PL_op;
TAINT_NOT; /* Each statement is presumed innocent */
- stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
+ PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
FREETMPS;
return NORMAL;
}
PP(pp_gvsv)
{
- dSP;
- EXTEND(sp,1);
- if (op->op_private & OPpLVAL_INTRO)
+ djSP;
+ EXTEND(SP,1);
+ if (PL_op->op_private & OPpLVAL_INTRO)
PUSHs(save_scalar(cGVOP->op_gv));
else
PUSHs(GvSV(cGVOP->op_gv));
@@ -54,13 +86,13 @@ PP(pp_null)
PP(pp_pushmark)
{
- PUSHMARK(stack_sp);
+ PUSHMARK(PL_stack_sp);
return NORMAL;
}
PP(pp_stringify)
{
- dSP; dTARGET;
+ djSP; dTARGET;
STRLEN len;
char *s;
s = SvPV(TOPs,len);
@@ -71,14 +103,14 @@ PP(pp_stringify)
PP(pp_gv)
{
- dSP;
+ djSP;
XPUSHs((SV*)cGVOP->op_gv);
RETURN;
}
PP(pp_and)
{
- dSP;
+ djSP;
if (!SvTRUE(TOPs))
RETURN;
else {
@@ -89,14 +121,14 @@ PP(pp_and)
PP(pp_sassign)
{
- dSP; dPOPTOPssrl;
+ djSP; dPOPTOPssrl;
MAGIC *mg;
- if (op->op_private & OPpASSIGN_BACKWARDS) {
+ if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
SV *temp;
temp = left; left = right; right = temp;
}
- if (tainting && tainted && !SvTAINTED(left))
+ if (PL_tainting && PL_tainted && !SvTAINTED(left))
TAINT_NOT;
SvSetMagicSV(right, left);
SETs(right);
@@ -105,7 +137,7 @@ PP(pp_sassign)
PP(pp_cond_expr)
{
- dSP;
+ djSP;
if (SvTRUEx(POPs))
RETURNOP(cCONDOP->op_true);
else
@@ -116,16 +148,16 @@ PP(pp_unstack)
{
I32 oldsave;
TAINT_NOT; /* Each statement is presumed innocent */
- stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
+ PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
FREETMPS;
- oldsave = scopestack[scopestack_ix - 1];
+ oldsave = PL_scopestack[PL_scopestack_ix - 1];
LEAVE_SCOPE(oldsave);
return NORMAL;
}
PP(pp_concat)
{
- dSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
{
dPOPTOPssrl;
STRLEN len;
@@ -152,26 +184,29 @@ PP(pp_concat)
PP(pp_padsv)
{
- dSP; dTARGET;
+ djSP; dTARGET;
XPUSHs(TARG);
- if (op->op_flags & OPf_MOD) {
- if (op->op_private & OPpLVAL_INTRO)
- SAVECLEARSV(curpad[op->op_targ]);
- else if (op->op_private & OPpDEREF)
- vivify_ref(curpad[op->op_targ], op->op_private & OPpDEREF);
+ if (PL_op->op_flags & OPf_MOD) {
+ if (PL_op->op_private & OPpLVAL_INTRO)
+ SAVECLEARSV(PL_curpad[PL_op->op_targ]);
+ else if (PL_op->op_private & OPpDEREF) {
+ PUTBACK;
+ vivify_ref(PL_curpad[PL_op->op_targ], PL_op->op_private & OPpDEREF);
+ SPAGAIN;
+ }
}
RETURN;
}
PP(pp_readline)
{
- last_in_gv = (GV*)(*stack_sp--);
+ PL_last_in_gv = (GV*)(*PL_stack_sp--);
return do_readline();
}
PP(pp_eq)
{
- dSP; tryAMAGICbinSET(eq,0);
+ djSP; tryAMAGICbinSET(eq,0);
{
dPOPnv;
SETs(boolSV(TOPn == value));
@@ -181,7 +216,7 @@ PP(pp_eq)
PP(pp_preinc)
{
- dSP;
+ djSP;
if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
croak(no_modify);
if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
@@ -198,7 +233,7 @@ PP(pp_preinc)
PP(pp_or)
{
- dSP;
+ djSP;
if (SvTRUE(TOPs))
RETURN;
else {
@@ -209,7 +244,7 @@ PP(pp_or)
PP(pp_add)
{
- dSP; dATARGET; tryAMAGICbin(add,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(add,opASSIGN);
{
dPOPTOPnnrl_ul;
SETn( left + right );
@@ -219,16 +254,21 @@ PP(pp_add)
PP(pp_aelemfast)
{
- dSP;
+ djSP;
AV *av = GvAV((GV*)cSVOP->op_sv);
- SV** svp = av_fetch(av, op->op_private, op->op_flags & OPf_MOD);
- PUSHs(svp ? *svp : &sv_undef);
+ U32 lval = PL_op->op_flags & OPf_MOD;
+ SV** svp = av_fetch(av, PL_op->op_private, lval);
+ SV *sv = (svp ? *svp : &PL_sv_undef);
+ EXTEND(SP, 1);
+ if (!lval && SvGMAGICAL(sv)) /* see note in pp_helem() */
+ sv = sv_mortalcopy(sv);
+ PUSHs(sv);
RETURN;
}
PP(pp_join)
{
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
MARK++;
do_join(TARG, *MARK, MARK, SP);
SP = MARK;
@@ -238,7 +278,7 @@ PP(pp_join)
PP(pp_pushre)
{
- dSP;
+ djSP;
#ifdef DEBUGGING
/*
* We ass_u_me that LvTARGOFF() comes first, and that two STRLENs
@@ -247,10 +287,10 @@ PP(pp_pushre)
SV* sv = sv_newmortal();
sv_upgrade(sv, SVt_PVLV);
LvTYPE(sv) = '/';
- Copy(&op, &LvTARGOFF(sv), 1, OP*);
+ Copy(&PL_op, &LvTARGOFF(sv), 1, OP*);
XPUSHs(sv);
#else
- XPUSHs((SV*)op);
+ XPUSHs((SV*)PL_op);
#endif
RETURN;
}
@@ -259,25 +299,29 @@ PP(pp_pushre)
PP(pp_print)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
GV *gv;
IO *io;
register PerlIO *fp;
MAGIC *mg;
+ STRLEN n_a;
- if (op->op_flags & OPf_STACKED)
+ if (PL_op->op_flags & OPf_STACKED)
gv = (GV*)*++MARK;
else
- gv = defoutgv;
- if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+ gv = PL_defoutgv;
+ if (mg = SvTIED_mg((SV*)gv, 'q')) {
if (MARK == ORIGMARK) {
- EXTEND(SP, 1);
+ /* If using default handle then we need to make space to
+ * pass object as 1st arg, so move other args up ...
+ */
+ MEXTEND(SP, 1);
++MARK;
Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
++SP;
}
PUSHMARK(MARK - 1);
- *MARK = mg->mg_obj;
+ *MARK = SvTIED_obj((SV*)gv, mg);
PUTBACK;
ENTER;
perl_call_method("PRINT", G_SCALAR);
@@ -289,36 +333,36 @@ PP(pp_print)
RETURN;
}
if (!(io = GvIO(gv))) {
- if (dowarn) {
+ if (PL_dowarn) {
SV* sv = sv_newmortal();
gv_fullname3(sv, gv, Nullch);
- warn("Filehandle %s never opened", SvPV(sv,na));
+ warn("Filehandle %s never opened", SvPV(sv,n_a));
}
SETERRNO(EBADF,RMS$_IFI);
goto just_say_no;
}
else if (!(fp = IoOFP(io))) {
- if (dowarn) {
+ if (PL_dowarn) {
SV* sv = sv_newmortal();
gv_fullname3(sv, gv, Nullch);
if (IoIFP(io))
- warn("Filehandle %s opened only for input", SvPV(sv,na));
+ warn("Filehandle %s opened only for input", SvPV(sv,n_a));
else
- warn("print on closed filehandle %s", SvPV(sv,na));
+ warn("print on closed filehandle %s", SvPV(sv,n_a));
}
SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
}
else {
MARK++;
- if (ofslen) {
+ if (PL_ofslen) {
while (MARK <= SP) {
if (!do_print(*MARK, fp))
break;
MARK++;
if (MARK <= SP) {
- if (PerlIO_write(fp, ofs, ofslen) == 0 || PerlIO_error(fp)) {
+ if (PerlIO_write(fp, PL_ofs, PL_ofslen) == 0 || PerlIO_error(fp)) {
MARK--;
break;
}
@@ -335,8 +379,8 @@ PP(pp_print)
if (MARK <= SP)
goto just_say_no;
else {
- if (orslen)
- if (PerlIO_write(fp, ors, orslen) == 0 || PerlIO_error(fp))
+ if (PL_orslen)
+ if (PerlIO_write(fp, PL_ors, PL_orslen) == 0 || PerlIO_error(fp))
goto just_say_no;
if (IoFLAGS(io) & IOf_FLUSH)
@@ -345,18 +389,18 @@ PP(pp_print)
}
}
SP = ORIGMARK;
- PUSHs(&sv_yes);
+ PUSHs(&PL_sv_yes);
RETURN;
just_say_no:
SP = ORIGMARK;
- PUSHs(&sv_undef);
+ PUSHs(&PL_sv_undef);
RETURN;
}
PP(pp_rv2av)
{
- dSP; dPOPss;
+ djSP; dPOPss;
AV *av;
if (SvROK(sv)) {
@@ -364,7 +408,7 @@ PP(pp_rv2av)
av = (AV*)SvRV(sv);
if (SvTYPE(av) != SVt_PVAV)
DIE("Not an ARRAY reference");
- if (op->op_flags & OPf_REF) {
+ if (PL_op->op_flags & OPf_REF) {
PUSHs((SV*)av);
RETURN;
}
@@ -372,7 +416,7 @@ PP(pp_rv2av)
else {
if (SvTYPE(sv) == SVt_PVAV) {
av = (AV*)sv;
- if (op->op_flags & OPf_REF) {
+ if (PL_op->op_flags & OPf_REF) {
PUSHs((SV*)av);
RETURN;
}
@@ -382,6 +426,7 @@ PP(pp_rv2av)
if (SvTYPE(sv) != SVt_PVGV) {
char *sym;
+ STRLEN n_a;
if (SvGMAGICAL(sv)) {
mg_get(sv);
@@ -389,26 +434,26 @@ PP(pp_rv2av)
goto wasref;
}
if (!SvOK(sv)) {
- if (op->op_flags & OPf_REF ||
- op->op_private & HINT_STRICT_REFS)
+ if (PL_op->op_flags & OPf_REF ||
+ PL_op->op_private & HINT_STRICT_REFS)
DIE(no_usym, "an ARRAY");
- if (dowarn)
+ if (PL_dowarn)
warn(warn_uninit);
if (GIMME == G_ARRAY)
RETURN;
RETPUSHUNDEF;
}
- sym = SvPV(sv,na);
- if (op->op_private & HINT_STRICT_REFS)
+ sym = SvPV(sv,n_a);
+ if (PL_op->op_private & HINT_STRICT_REFS)
DIE(no_symref, sym, "an ARRAY");
gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV);
} else {
gv = (GV*)sv;
}
av = GvAVn(gv);
- if (op->op_private & OPpLVAL_INTRO)
+ if (PL_op->op_private & OPpLVAL_INTRO)
av = save_ary(gv);
- if (op->op_flags & OPf_REF) {
+ if (PL_op->op_flags & OPf_REF) {
PUSHs((SV*)av);
RETURN;
}
@@ -417,8 +462,17 @@ PP(pp_rv2av)
if (GIMME == G_ARRAY) {
I32 maxarg = AvFILL(av) + 1;
- EXTEND(SP, maxarg);
- Copy(AvARRAY(av), SP+1, maxarg, SV*);
+ EXTEND(SP, maxarg);
+ if (SvRMAGICAL(av)) {
+ U32 i;
+ for (i=0; i < maxarg; i++) {
+ SV **svp = av_fetch(av, i, FALSE);
+ SP[i+1] = (svp) ? *svp : &PL_sv_undef;
+ }
+ }
+ else {
+ Copy(AvARRAY(av), SP+1, maxarg, SV*);
+ }
SP += maxarg;
}
else {
@@ -431,23 +485,23 @@ PP(pp_rv2av)
PP(pp_rv2hv)
{
- dSP; dTOPss;
+ djSP; dTOPss;
HV *hv;
if (SvROK(sv)) {
wasref:
hv = (HV*)SvRV(sv);
- if (SvTYPE(hv) != SVt_PVHV)
+ if (SvTYPE(hv) != SVt_PVHV && SvTYPE(hv) != SVt_PVAV)
DIE("Not a HASH reference");
- if (op->op_flags & OPf_REF) {
+ if (PL_op->op_flags & OPf_REF) {
SETs((SV*)hv);
RETURN;
}
}
else {
- if (SvTYPE(sv) == SVt_PVHV) {
+ if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) {
hv = (HV*)sv;
- if (op->op_flags & OPf_REF) {
+ if (PL_op->op_flags & OPf_REF) {
SETs((SV*)hv);
RETURN;
}
@@ -457,6 +511,7 @@ PP(pp_rv2hv)
if (SvTYPE(sv) != SVt_PVGV) {
char *sym;
+ STRLEN n_a;
if (SvGMAGICAL(sv)) {
mg_get(sv);
@@ -464,10 +519,10 @@ PP(pp_rv2hv)
goto wasref;
}
if (!SvOK(sv)) {
- if (op->op_flags & OPf_REF ||
- op->op_private & HINT_STRICT_REFS)
+ if (PL_op->op_flags & OPf_REF ||
+ PL_op->op_private & HINT_STRICT_REFS)
DIE(no_usym, "a HASH");
- if (dowarn)
+ if (PL_dowarn)
warn(warn_uninit);
if (GIMME == G_ARRAY) {
SP--;
@@ -475,17 +530,17 @@ PP(pp_rv2hv)
}
RETSETUNDEF;
}
- sym = SvPV(sv,na);
- if (op->op_private & HINT_STRICT_REFS)
+ sym = SvPV(sv,n_a);
+ if (PL_op->op_private & HINT_STRICT_REFS)
DIE(no_symref, sym, "a HASH");
gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV);
} else {
gv = (GV*)sv;
}
hv = GvHVn(gv);
- if (op->op_private & OPpLVAL_INTRO)
+ if (PL_op->op_private & OPpLVAL_INTRO)
hv = save_hash(gv);
- if (op->op_flags & OPf_REF) {
+ if (PL_op->op_flags & OPf_REF) {
SETs((SV*)hv);
RETURN;
}
@@ -493,16 +548,19 @@ PP(pp_rv2hv)
}
if (GIMME == G_ARRAY) { /* array wanted */
- *stack_sp = (SV*)hv;
+ *PL_stack_sp = (SV*)hv;
return do_kv(ARGS);
}
else {
dTARGET;
+ if (SvTYPE(hv) == SVt_PVAV)
+ hv = avhv_keys((AV*)hv);
if (HvFILL(hv))
sv_setpvf(TARG, "%ld/%ld",
(long)HvFILL(hv), (long)HvMAX(hv) + 1);
else
sv_setiv(TARG, 0);
+
SETTARG;
RETURN;
}
@@ -510,10 +568,10 @@ PP(pp_rv2hv)
PP(pp_aassign)
{
- dSP;
- SV **lastlelem = stack_sp;
- SV **lastrelem = stack_base + POPMARK;
- SV **firstrelem = stack_base + POPMARK + 1;
+ djSP;
+ SV **lastlelem = PL_stack_sp;
+ SV **lastrelem = PL_stack_base + POPMARK;
+ SV **firstrelem = PL_stack_base + POPMARK + 1;
SV **firstlelem = lastrelem + 1;
register SV **relem;
@@ -527,13 +585,13 @@ PP(pp_aassign)
I32 i;
int magic;
- delaymagic = DM_DELAY; /* catch simultaneous items */
+ PL_delaymagic = DM_DELAY; /* catch simultaneous items */
/* If there's a common identifier on both sides we have to take
* special care that assigning the identifier on the left doesn't
* clobber a value on the right that's used later in the list.
*/
- if (op->op_private & OPpASSIGN_COMMON) {
+ if (PL_op->op_private & OPpASSIGN_COMMON) {
for (relem = firstrelem; relem <= lastrelem; relem++) {
/*SUPPRESS 560*/
if (sv = *relem) {
@@ -582,12 +640,11 @@ PP(pp_aassign)
hv_clear(hash);
while (relem < lastrelem) { /* gobble up all the rest */
- STRLEN len;
HE *didstore;
if (*relem)
sv = *(relem++);
else
- sv = &sv_no, relem++;
+ sv = &PL_sv_no, relem++;
tmpstr = NEWSV(29,0);
if (*relem)
sv_setsv(tmpstr,*relem); /* value */
@@ -601,14 +658,36 @@ PP(pp_aassign)
}
TAINT_NOT;
}
- if (relem == lastrelem && dowarn)
- warn("Odd number of elements in hash list");
+ if (relem == lastrelem) {
+ if (*relem) {
+ HE *didstore;
+ if (PL_dowarn) {
+ if (relem == firstrelem &&
+ SvROK(*relem) &&
+ ( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
+ SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
+ warn("Reference found where even-sized list expected");
+ else
+ warn("Odd number of elements in hash assignment");
+ }
+ tmpstr = NEWSV(29,0);
+ didstore = hv_store_ent(hash,*relem,tmpstr,0);
+ if (magic) {
+ if (SvSMAGICAL(tmpstr))
+ mg_set(tmpstr);
+ if (!didstore)
+ SvREFCNT_dec(tmpstr);
+ }
+ TAINT_NOT;
+ }
+ relem++;
+ }
}
break;
default:
if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling) {
- if (sv != &sv_undef && sv != &sv_yes && sv != &sv_no)
+ if (SvREADONLY(sv) && PL_curcop != &PL_compiling) {
+ if (!SvIMMORTAL(sv))
DIE(no_modify);
if (relem <= lastrelem)
relem++;
@@ -622,73 +701,73 @@ PP(pp_aassign)
*(relem++) = sv;
}
else
- sv_setsv(sv, &sv_undef);
+ sv_setsv(sv, &PL_sv_undef);
SvSETMAGIC(sv);
break;
}
}
- if (delaymagic & ~DM_DELAY) {
- if (delaymagic & DM_UID) {
+ if (PL_delaymagic & ~DM_DELAY) {
+ if (PL_delaymagic & DM_UID) {
#ifdef HAS_SETRESUID
- (void)setresuid(uid,euid,(Uid_t)-1);
+ (void)setresuid(PL_uid,PL_euid,(Uid_t)-1);
#else
# ifdef HAS_SETREUID
- (void)setreuid(uid,euid);
+ (void)setreuid(PL_uid,PL_euid);
# else
# ifdef HAS_SETRUID
- if ((delaymagic & DM_UID) == DM_RUID) {
- (void)setruid(uid);
- delaymagic &= ~DM_RUID;
+ if ((PL_delaymagic & DM_UID) == DM_RUID) {
+ (void)setruid(PL_uid);
+ PL_delaymagic &= ~DM_RUID;
}
# endif /* HAS_SETRUID */
# ifdef HAS_SETEUID
- if ((delaymagic & DM_UID) == DM_EUID) {
- (void)seteuid(uid);
- delaymagic &= ~DM_EUID;
+ if ((PL_delaymagic & DM_UID) == DM_EUID) {
+ (void)seteuid(PL_uid);
+ PL_delaymagic &= ~DM_EUID;
}
# endif /* HAS_SETEUID */
- if (delaymagic & DM_UID) {
- if (uid != euid)
+ if (PL_delaymagic & DM_UID) {
+ if (PL_uid != PL_euid)
DIE("No setreuid available");
- (void)setuid(uid);
+ (void)PerlProc_setuid(PL_uid);
}
# endif /* HAS_SETREUID */
#endif /* HAS_SETRESUID */
- uid = (int)getuid();
- euid = (int)geteuid();
+ PL_uid = (int)PerlProc_getuid();
+ PL_euid = (int)PerlProc_geteuid();
}
- if (delaymagic & DM_GID) {
+ if (PL_delaymagic & DM_GID) {
#ifdef HAS_SETRESGID
- (void)setresgid(gid,egid,(Gid_t)-1);
+ (void)setresgid(PL_gid,PL_egid,(Gid_t)-1);
#else
# ifdef HAS_SETREGID
- (void)setregid(gid,egid);
+ (void)setregid(PL_gid,PL_egid);
# else
# ifdef HAS_SETRGID
- if ((delaymagic & DM_GID) == DM_RGID) {
- (void)setrgid(gid);
- delaymagic &= ~DM_RGID;
+ if ((PL_delaymagic & DM_GID) == DM_RGID) {
+ (void)setrgid(PL_gid);
+ PL_delaymagic &= ~DM_RGID;
}
# endif /* HAS_SETRGID */
# ifdef HAS_SETEGID
- if ((delaymagic & DM_GID) == DM_EGID) {
- (void)setegid(gid);
- delaymagic &= ~DM_EGID;
+ if ((PL_delaymagic & DM_GID) == DM_EGID) {
+ (void)setegid(PL_gid);
+ PL_delaymagic &= ~DM_EGID;
}
# endif /* HAS_SETEGID */
- if (delaymagic & DM_GID) {
- if (gid != egid)
+ if (PL_delaymagic & DM_GID) {
+ if (PL_gid != PL_egid)
DIE("No setregid available");
- (void)setgid(gid);
+ (void)PerlProc_setgid(PL_gid);
}
# endif /* HAS_SETREGID */
#endif /* HAS_SETRESGID */
- gid = (int)getgid();
- egid = (int)getegid();
+ PL_gid = (int)PerlProc_getgid();
+ PL_egid = (int)PerlProc_getegid();
}
- tainting |= (uid && (euid != uid || egid != gid));
+ PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
}
- delaymagic = 0;
+ PL_delaymagic = 0;
gimme = GIMME_V;
if (gimme == G_VOID)
@@ -705,14 +784,24 @@ PP(pp_aassign)
SP = firstrelem + (lastlelem - firstlelem);
lelem = firstlelem + (relem - firstrelem);
while (relem <= SP)
- *relem++ = (lelem <= lastlelem) ? *lelem++ : &sv_undef;
+ *relem++ = (lelem <= lastlelem) ? *lelem++ : &PL_sv_undef;
}
RETURN;
}
+PP(pp_qr)
+{
+ djSP;
+ register PMOP *pm = cPMOP;
+ SV *rv = sv_newmortal();
+ SV *sv = newSVrv(rv, "Regexp");
+ sv_magic(sv,(SV*)ReREFCNT_inc(pm->op_pmregexp),'r',0,0);
+ RETURNX(PUSHs(rv));
+}
+
PP(pp_match)
{
- dSP; dTARG;
+ djSP; dTARG;
register PMOP *pm = cPMOP;
register char *t;
register char *s;
@@ -721,34 +810,46 @@ PP(pp_match)
I32 safebase;
char *truebase;
register REGEXP *rx = pm->op_pmregexp;
+ bool rxtainted;
I32 gimme = GIMME;
STRLEN len;
I32 minmatch = 0;
- I32 oldsave = savestack_ix;
+ I32 oldsave = PL_savestack_ix;
I32 update_minmatch = 1;
+ SV *screamer;
- if (op->op_flags & OPf_STACKED)
+ if (PL_op->op_flags & OPf_STACKED)
TARG = POPs;
else {
- TARG = GvSV(defgv);
+ TARG = DEFSV;
EXTEND(SP,1);
}
+ PUTBACK; /* EVAL blocks need stack_sp. */
s = SvPV(TARG, len);
strend = s + len;
if (!s)
DIE("panic: do_match");
+ rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
+ (PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
TAINT_NOT;
- if (pm->op_pmflags & PMf_USED) {
+ if (pm->op_pmdynflags & PMdf_USED) {
+ failure:
if (gimme == G_ARRAY)
RETURN;
RETPUSHNO;
}
- if (!rx->prelen && curpm) {
- pm = curpm;
+ if (!rx->prelen && PL_curpm) {
+ pm = PL_curpm;
rx = pm->op_pmregexp;
}
+ if (rx->minlen > len) goto failure;
+
+ screamer = ( (SvSCREAM(TARG) && rx->check_substr
+ && SvTYPE(rx->check_substr) == SVt_PVBM
+ && SvVALID(rx->check_substr))
+ ? TARG : Nullsv);
truebase = t = s;
if (global = pm->op_pmflags & PMf_GLOBAL) {
rx->startp[0] = 0;
@@ -761,13 +862,12 @@ PP(pp_match)
}
}
}
- if (!rx->nparens && !global)
- gimme = G_SCALAR; /* accidental array context? */
- safebase = (((gimme == G_ARRAY) || global || !rx->nparens)
- && !sawampersand);
+ safebase = ((gimme != G_ARRAY && !global && rx->nparens)
+ || SvTEMP(TARG) || PL_sawampersand)
+ ? REXEC_COPY_STR : 0;
if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
- SAVEINT(multiline);
- multiline = pm->op_pmflags & PMf_MULTILINE;
+ SAVEINT(PL_multiline);
+ PL_multiline = pm->op_pmflags & PMf_MULTILINE;
}
play_it_again:
@@ -778,47 +878,56 @@ play_it_again:
if (update_minmatch++)
minmatch = (s == rx->startp[0]);
}
- if (pm->op_pmshort) {
- if (pm->op_pmflags & PMf_SCANFIRST) {
- if (SvSCREAM(TARG)) {
- if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
+ if (rx->check_substr) {
+ if (!(rx->reganch & ROPT_NOSCAN)) { /* Floating checkstring. */
+ if ( screamer ) {
+ I32 p = -1;
+
+ if (PL_screamfirst[BmRARE(rx->check_substr)] < 0)
goto nope;
- else if (!(s = screaminstr(TARG, pm->op_pmshort)))
+ else if (!(s = screaminstr(TARG, rx->check_substr,
+ rx->check_offset_min, 0, &p, 0)))
goto nope;
- else if (pm->op_pmflags & PMf_ALL)
+ else if ((rx->reganch & ROPT_CHECK_ALL)
+ && !PL_sawampersand && !SvTAIL(rx->check_substr))
goto yup;
}
- else if (!(s = fbm_instr((unsigned char*)s,
- (unsigned char*)strend, pm->op_pmshort)))
+ else if (!(s = fbm_instr((unsigned char*)s + rx->check_offset_min,
+ (unsigned char*)strend,
+ rx->check_substr, 0)))
goto nope;
- else if (pm->op_pmflags & PMf_ALL)
+ else if ((rx->reganch & ROPT_CHECK_ALL) && !PL_sawampersand)
goto yup;
- if (s && rx->regback >= 0) {
- ++BmUSEFUL(pm->op_pmshort);
- s -= rx->regback;
- if (s < t)
- s = t;
+ if (s && rx->check_offset_max < s - t) {
+ ++BmUSEFUL(rx->check_substr);
+ s -= rx->check_offset_max;
}
else
s = t;
}
- else if (!multiline) {
- if (*SvPVX(pm->op_pmshort) != *s
- || (pm->op_pmslen > 1
- && memNE(SvPVX(pm->op_pmshort), s, pm->op_pmslen)))
+ /* Now checkstring is fixed, i.e. at fixed offset from the
+ beginning of match, and the match is anchored at s. */
+ else if (!PL_multiline) { /* Anchored near beginning of string. */
+ I32 slen;
+ if (*SvPVX(rx->check_substr) != s[rx->check_offset_min]
+ || ((slen = SvCUR(rx->check_substr)) > 1
+ && memNE(SvPVX(rx->check_substr),
+ s + rx->check_offset_min, slen)))
goto nope;
}
- if (!rx->naughty && --BmUSEFUL(pm->op_pmshort) < 0) {
- SvREFCNT_dec(pm->op_pmshort);
- pm->op_pmshort = Nullsv; /* opt is being useless */
+ if (!rx->naughty && --BmUSEFUL(rx->check_substr) < 0
+ && rx->check_substr == rx->float_substr) {
+ SvREFCNT_dec(rx->check_substr);
+ rx->check_substr = Nullsv; /* opt is being useless */
+ rx->float_substr = Nullsv;
}
}
- if (pregexec(rx, s, strend, truebase, minmatch,
- SvSCREAM(TARG) ? TARG : Nullsv, safebase))
+ if (CALLREGEXEC(rx, s, strend, truebase, minmatch,
+ screamer, NULL, safebase))
{
- curpm = pm;
+ PL_curpm = pm;
if (pm->op_pmflags & PMf_ONCE)
- pm->op_pmflags |= PMf_USED;
+ pm->op_pmdynflags |= PMdf_USED;
goto gotcha;
}
else
@@ -826,7 +935,9 @@ play_it_again:
/*NOTREACHED*/
gotcha:
- TAINT_IF(rx->exec_tainted);
+ if (rxtainted)
+ RX_MATCH_TAINTED_on(rx);
+ TAINT_IF(RX_MATCH_TAINTED(rx));
if (gimme == G_ARRAY) {
I32 iters, i, len;
@@ -835,6 +946,7 @@ play_it_again:
i = 1;
else
i = 0;
+ SPAGAIN; /* EVAL blocks could move the stack. */
EXTEND(SP, iters + i);
EXTEND_MORTAL(iters + i);
for (i = !i; i <= iters; i++) {
@@ -850,8 +962,11 @@ play_it_again:
strend = rx->subend;
if (rx->startp[0] && rx->startp[0] == rx->endp[0])
++rx->endp[0];
+ PUTBACK; /* EVAL blocks may use stack */
goto play_it_again;
}
+ else if (!iters)
+ XPUSHs(&PL_sv_yes);
LEAVE_SCOPE(oldsave);
RETURN;
}
@@ -876,36 +991,38 @@ play_it_again:
RETPUSHYES;
}
-yup:
- TAINT_IF(rx->exec_tainted);
- ++BmUSEFUL(pm->op_pmshort);
- curpm = pm;
+yup: /* Confirmed by check_substr */
+ if (rxtainted)
+ RX_MATCH_TAINTED_on(rx);
+ TAINT_IF(RX_MATCH_TAINTED(rx));
+ ++BmUSEFUL(rx->check_substr);
+ PL_curpm = pm;
if (pm->op_pmflags & PMf_ONCE)
- pm->op_pmflags |= PMf_USED;
+ pm->op_pmdynflags |= PMdf_USED;
Safefree(rx->subbase);
rx->subbase = Nullch;
if (global) {
rx->subbeg = truebase;
rx->subend = strend;
rx->startp[0] = s;
- rx->endp[0] = s + SvCUR(pm->op_pmshort);
+ rx->endp[0] = s + SvCUR(rx->check_substr);
goto gotcha;
}
- if (sawampersand) {
+ if (PL_sawampersand) {
char *tmps;
tmps = rx->subbase = savepvn(t, strend-t);
rx->subbeg = tmps;
rx->subend = tmps + (strend-t);
tmps = rx->startp[0] = tmps + (s - t);
- rx->endp[0] = tmps + SvCUR(pm->op_pmshort);
+ rx->endp[0] = tmps + SvCUR(rx->check_substr);
}
LEAVE_SCOPE(oldsave);
RETPUSHYES;
nope:
- if (pm->op_pmshort)
- ++BmUSEFUL(pm->op_pmshort);
+ if (rx->check_substr)
+ ++BmUSEFUL(rx->check_substr);
ret_no:
if (global && !(pm->op_pmflags & PMf_CONTINUE)) {
@@ -922,21 +1039,21 @@ ret_no:
}
OP *
-do_readline()
+do_readline(void)
{
dSP; dTARGETSTACKED;
register SV *sv;
STRLEN tmplen = 0;
STRLEN offset;
PerlIO *fp;
- register IO *io = GvIO(last_in_gv);
- register I32 type = op->op_type;
+ register IO *io = GvIO(PL_last_in_gv);
+ register I32 type = PL_op->op_type;
I32 gimme = GIMME_V;
MAGIC *mg;
- if (SvMAGICAL(last_in_gv) && (mg = mg_find((SV*)last_in_gv, 'q'))) {
+ if (mg = SvTIED_mg((SV*)PL_last_in_gv, 'q')) {
PUSHMARK(SP);
- XPUSHs(mg->mg_obj);
+ XPUSHs(SvTIED_obj((SV*)PL_last_in_gv, mg));
PUTBACK;
ENTER;
perl_call_method("READLINE", gimme);
@@ -954,14 +1071,17 @@ do_readline()
if (IoFLAGS(io) & IOf_START) {
IoFLAGS(io) &= ~IOf_START;
IoLINES(io) = 0;
- if (av_len(GvAVn(last_in_gv)) < 0) {
- SV *tmpstr = newSVpv("-", 1); /* assume stdin */
- av_push(GvAVn(last_in_gv), tmpstr);
+ if (av_len(GvAVn(PL_last_in_gv)) < 0) {
+ do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,Nullfp);
+ sv_setpvn(GvSV(PL_last_in_gv), "-", 1);
+ SvSETMAGIC(GvSV(PL_last_in_gv));
+ fp = IoIFP(io);
+ goto have_fp;
}
}
- fp = nextargv(last_in_gv);
+ fp = nextargv(PL_last_in_gv);
if (!fp) { /* Note: fp != IoIFP(io) */
- (void)do_close(last_in_gv, FALSE); /* now it does*/
+ (void)do_close(PL_last_in_gv, FALSE); /* now it does*/
IoFLAGS(io) |= IOf_START;
}
}
@@ -995,7 +1115,7 @@ do_readline()
((struct NAM *)((struct FAB *)cxt)->fab$l_nam)->nam$l_fnb
but that's unsupported, so I don't want to do it now and
have it bite someone in the future. */
- strcat(tmpfnam,tmpnam(NULL));
+ strcat(tmpfnam,PerlLIO_tmpnam(NULL));
cp = SvPV(tmpglob,i);
for (; i; i--) {
if (cp[i] == ';') hasver = 1;
@@ -1013,7 +1133,10 @@ do_readline()
}
}
if ((tmpfp = PerlIO_open(tmpfnam,"w+","fop=dlt")) != NULL) {
- ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
+ Stat_t st;
+ if (!PerlLIO_stat(SvPVX(tmpglob),&st) && S_ISDIR(st.st_mode))
+ ok = ((wilddsc.dsc$a_pointer = tovmspath(SvPVX(tmpglob),vmsspec)) != NULL);
+ else ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer);
while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt,
&dfltdsc,NULL,NULL,NULL))&1)) {
@@ -1057,13 +1180,18 @@ do_readline()
sv_catsv(tmpcmd, tmpglob);
sv_catpv(tmpcmd, "; do echo \"$a\\0\\c\"; done |");
#else
+#ifdef DJGPP
+ sv_setpv(tmpcmd, "/dev/dosglob/"); /* File System Extension */
+ sv_catsv(tmpcmd, tmpglob);
+#else
sv_setpv(tmpcmd, "perlglob ");
sv_catsv(tmpcmd, tmpglob);
sv_catpv(tmpcmd, " |");
+#endif /* !DJGPP */
#endif /* !OS2 */
#else /* !DOSISH */
#if defined(CSH)
- sv_setpvn(tmpcmd, cshname, cshlen);
+ sv_setpvn(tmpcmd, PL_cshname, PL_cshlen);
sv_catpv(tmpcmd, " -cf 'set nonomatch; glob ");
sv_catsv(tmpcmd, tmpglob);
sv_catpv(tmpcmd, "' 2>/dev/null |");
@@ -1077,8 +1205,8 @@ do_readline()
#endif
#endif /* !CSH */
#endif /* !DOSISH */
- (void)do_open(last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),
- FALSE, 0, 0, Nullfp);
+ (void)do_open(PL_last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),
+ FALSE, O_RDONLY, 0, Nullfp);
fp = IoIFP(io);
#endif /* !VMS */
LEAVE;
@@ -1088,14 +1216,15 @@ do_readline()
SP--;
}
if (!fp) {
- if (dowarn && io && !(IoFLAGS(io) & IOf_START))
- warn("Read on closed filehandle <%s>", GvENAME(last_in_gv));
+ if (PL_dowarn && io && !(IoFLAGS(io) & IOf_START))
+ warn("Read on closed filehandle <%s>", GvENAME(PL_last_in_gv));
if (gimme == G_SCALAR) {
(void)SvOK_off(TARG);
PUSHTARG;
}
RETURN;
}
+ have_fp:
if (gimme == G_SCALAR) {
sv = TARG;
if (SvROK(sv))
@@ -1113,19 +1242,32 @@ do_readline()
sv = sv_2mortal(NEWSV(57, 80));
offset = 0;
}
+
+/* flip-flop EOF state for a snarfed empty file */
+#define SNARF_EOF(gimme,rs,io,sv) \
+ ((gimme != G_SCALAR || SvCUR(sv) \
+ || (IoFLAGS(io) & IOf_NOLINE) || IoLINES(io) || !RsSNARF(rs)) \
+ ? ((IoFLAGS(io) &= ~IOf_NOLINE), TRUE) \
+ : ((IoFLAGS(io) |= IOf_NOLINE), FALSE))
+
for (;;) {
- if (!sv_gets(sv, fp, offset)) {
+ if (!sv_gets(sv, fp, offset)
+ && (type == OP_GLOB || SNARF_EOF(gimme, PL_rs, io, sv)))
+ {
PerlIO_clearerr(fp);
if (IoFLAGS(io) & IOf_ARGV) {
- fp = nextargv(last_in_gv);
+ fp = nextargv(PL_last_in_gv);
if (fp)
continue;
- (void)do_close(last_in_gv, FALSE);
+ (void)do_close(PL_last_in_gv, FALSE);
IoFLAGS(io) |= IOf_START;
}
else if (type == OP_GLOB) {
- if (do_close(last_in_gv, FALSE) & ~0xFF)
- warn("internal error: glob failed");
+ if (!do_close(PL_last_in_gv, FALSE)) {
+ warn("glob failed (child exited with status %d%s)",
+ STATUS_CURRENT >> 8,
+ (STATUS_CURRENT & 0x80) ? ", core dumped" : "");
+ }
}
if (gimme == G_SCALAR) {
(void)SvOK_off(TARG);
@@ -1144,9 +1286,9 @@ do_readline()
if (type == OP_GLOB) {
char *tmps;
- if (SvCUR(sv) > 0 && SvCUR(rs) > 0) {
+ if (SvCUR(sv) > 0 && SvCUR(PL_rs) > 0) {
tmps = SvEND(sv) - 1;
- if (*tmps == *SvPVX(rs)) {
+ if (*tmps == *SvPVX(PL_rs)) {
*tmps = '\0';
SvCUR(sv)--;
}
@@ -1155,7 +1297,7 @@ do_readline()
if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
break;
- if (*tmps && Stat(SvPVX(sv), &statbuf) < 0) {
+ if (*tmps && PerlLIO_stat(SvPVX(sv), &PL_statbuf) < 0) {
(void)POPs; /* Unmatched wildcard? Chuck it... */
continue;
}
@@ -1182,9 +1324,9 @@ do_readline()
PP(pp_enter)
{
- dSP;
- register CONTEXT *cx;
- I32 gimme = OP_GIMME(op, -1);
+ djSP;
+ register PERL_CONTEXT *cx;
+ I32 gimme = OP_GIMME(PL_op, -1);
if (gimme == -1) {
if (cxstack_ix >= 0)
@@ -1196,29 +1338,42 @@ PP(pp_enter)
ENTER;
SAVETMPS;
- PUSHBLOCK(cx, CXt_BLOCK, sp);
+ PUSHBLOCK(cx, CXt_BLOCK, SP);
RETURN;
}
PP(pp_helem)
{
- dSP;
+ djSP;
HE* he;
+ SV **svp;
SV *keysv = POPs;
HV *hv = (HV*)POPs;
- U32 lval = op->op_flags & OPf_MOD;
- U32 defer = op->op_private & OPpLVAL_DEFER;
+ U32 lval = PL_op->op_flags & OPf_MOD;
+ U32 defer = PL_op->op_private & OPpLVAL_DEFER;
+ SV *sv;
- if (SvTYPE(hv) != SVt_PVHV)
+ if (SvTYPE(hv) == SVt_PVHV) {
+ he = hv_fetch_ent(hv, keysv, lval && !defer, 0);
+ svp = he ? &HeVAL(he) : 0;
+ }
+ else if (SvTYPE(hv) == SVt_PVAV) {
+ if (PL_op->op_private & OPpLVAL_INTRO)
+ DIE("Can't localize pseudo-hash element");
+ svp = avhv_fetch_ent((AV*)hv, keysv, lval && !defer, 0);
+ }
+ else {
RETPUSHUNDEF;
- he = hv_fetch_ent(hv, keysv, lval && !defer, 0);
+ }
if (lval) {
- if (!he || HeVAL(he) == &sv_undef) {
+ if (!svp || *svp == &PL_sv_undef) {
SV* lv;
SV* key2;
- if (!defer)
- DIE(no_helem, SvPV(keysv, na));
+ if (!defer) {
+ STRLEN n_a;
+ DIE(no_helem, SvPV(keysv, n_a));
+ }
lv = sv_newmortal();
sv_upgrade(lv, SVt_PVLV);
LvTYPE(lv) = 'y';
@@ -1229,36 +1384,45 @@ PP(pp_helem)
PUSHs(lv);
RETURN;
}
- if (op->op_private & OPpLVAL_INTRO) {
- if (HvNAME(hv) && isGV(HeVAL(he)))
- save_gp((GV*)HeVAL(he), !(op->op_flags & OPf_SPECIAL));
+ if (PL_op->op_private & OPpLVAL_INTRO) {
+ if (HvNAME(hv) && isGV(*svp))
+ save_gp((GV*)*svp, !(PL_op->op_flags & OPf_SPECIAL));
else
- save_svref(&HeVAL(he));
- }
- else if (op->op_private & OPpDEREF)
- vivify_ref(HeVAL(he), op->op_private & OPpDEREF);
- }
- PUSHs(he ? HeVAL(he) : &sv_undef);
+ save_helem(hv, keysv, svp);
+ }
+ else if (PL_op->op_private & OPpDEREF)
+ vivify_ref(*svp, PL_op->op_private & OPpDEREF);
+ }
+ sv = (svp ? *svp : &PL_sv_undef);
+ /* This makes C<local $tied{foo} = $tied{foo}> possible.
+ * Pushing the magical RHS on to the stack is useless, since
+ * that magic is soon destined to be misled by the local(),
+ * and thus the later pp_sassign() will fail to mg_get() the
+ * old value. This should also cure problems with delayed
+ * mg_get()s. GSAR 98-07-03 */
+ if (!lval && SvGMAGICAL(sv))
+ sv = sv_mortalcopy(sv);
+ PUSHs(sv);
RETURN;
}
PP(pp_leave)
{
- dSP;
- register CONTEXT *cx;
+ djSP;
+ register PERL_CONTEXT *cx;
register SV **mark;
SV **newsp;
PMOP *newpm;
I32 gimme;
- if (op->op_flags & OPf_SPECIAL) {
+ if (PL_op->op_flags & OPf_SPECIAL) {
cx = &cxstack[cxstack_ix];
- cx->blk_oldpm = curpm; /* fake block should preserve $1 et al */
+ cx->blk_oldpm = PL_curpm; /* fake block should preserve $1 et al */
}
POPBLOCK(cx,newpm);
- gimme = OP_GIMME(op, -1);
+ gimme = OP_GIMME(PL_op, -1);
if (gimme == -1) {
if (cxstack_ix >= 0)
gimme = cxstack[cxstack_ix].blk_gimme;
@@ -1278,7 +1442,7 @@ PP(pp_leave)
*MARK = sv_mortalcopy(TOPs);
else {
MEXTEND(mark,0);
- *MARK = &sv_undef;
+ *MARK = &PL_sv_undef;
}
SP = MARK;
}
@@ -1291,7 +1455,7 @@ PP(pp_leave)
}
}
}
- curpm = newpm; /* Don't pop $1 et al till now */
+ PL_curpm = newpm; /* Don't pop $1 et al till now */
LEAVE;
@@ -1300,27 +1464,85 @@ PP(pp_leave)
PP(pp_iter)
{
- dSP;
- register CONTEXT *cx;
+ djSP;
+ register PERL_CONTEXT *cx;
SV* sv;
AV* av;
- EXTEND(sp, 1);
+ EXTEND(SP, 1);
cx = &cxstack[cxstack_ix];
- if (cx->cx_type != CXt_LOOP)
+ if (CxTYPE(cx) != CXt_LOOP)
DIE("panic: pp_iter");
av = cx->blk_loop.iterary;
- if (cx->blk_loop.iterix >= (av == curstack ? cx->blk_oldsp : AvFILL(av)))
+ if (SvTYPE(av) != SVt_PVAV) {
+ /* iterate ($min .. $max) */
+ if (cx->blk_loop.iterlval) {
+ /* string increment */
+ register SV* cur = cx->blk_loop.iterlval;
+ STRLEN maxlen;
+ char *max = SvPV((SV*)av, maxlen);
+ if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
+#ifndef USE_THREADS /* don't risk potential race */
+ if (SvREFCNT(*cx->blk_loop.itervar) == 1
+ && !SvMAGICAL(*cx->blk_loop.itervar))
+ {
+ /* safe to reuse old SV */
+ sv_setsv(*cx->blk_loop.itervar, cur);
+ }
+ else
+#endif
+ {
+ /* we need a fresh SV every time so that loop body sees a
+ * completely new SV for closures/references to work as
+ * they used to */
+ SvREFCNT_dec(*cx->blk_loop.itervar);
+ *cx->blk_loop.itervar = newSVsv(cur);
+ }
+ if (strEQ(SvPVX(cur), max))
+ sv_setiv(cur, 0); /* terminate next time */
+ else
+ sv_inc(cur);
+ RETPUSHYES;
+ }
+ RETPUSHNO;
+ }
+ /* integer increment */
+ if (cx->blk_loop.iterix > cx->blk_loop.itermax)
+ RETPUSHNO;
+
+#ifndef USE_THREADS /* don't risk potential race */
+ if (SvREFCNT(*cx->blk_loop.itervar) == 1
+ && !SvMAGICAL(*cx->blk_loop.itervar))
+ {
+ /* safe to reuse old SV */
+ sv_setiv(*cx->blk_loop.itervar, cx->blk_loop.iterix++);
+ }
+ else
+#endif
+ {
+ /* we need a fresh SV every time so that loop body sees a
+ * completely new SV for closures/references to work as they
+ * used to */
+ SvREFCNT_dec(*cx->blk_loop.itervar);
+ *cx->blk_loop.itervar = newSViv(cx->blk_loop.iterix++);
+ }
+ RETPUSHYES;
+ }
+
+ /* iterate array */
+ if (cx->blk_loop.iterix >= (av == PL_curstack ? cx->blk_oldsp : AvFILL(av)))
RETPUSHNO;
SvREFCNT_dec(*cx->blk_loop.itervar);
- if (sv = AvARRAY(av)[++cx->blk_loop.iterix])
+ if (sv = (SvMAGICAL(av))
+ ? *av_fetch(av, ++cx->blk_loop.iterix, FALSE)
+ : AvARRAY(av)[++cx->blk_loop.iterix])
SvTEMP_off(sv);
else
- sv = &sv_undef;
- if (av != curstack && SvIMMORTAL(sv)) {
+ sv = &PL_sv_undef;
+ if (av != PL_curstack && SvIMMORTAL(sv)) {
SV *lv = cx->blk_loop.iterlval;
if (lv && SvREFCNT(lv) > 1) {
SvREFCNT_dec(lv);
@@ -1336,7 +1558,7 @@ PP(pp_iter)
}
LvTARG(lv) = SvREFCNT_inc(av);
LvTARGOFF(lv) = cx->blk_loop.iterix;
- LvTARGLEN(lv) = -1;
+ LvTARGLEN(lv) = (UV) -1;
sv = (SV*)lv;
}
@@ -1346,7 +1568,7 @@ PP(pp_iter)
PP(pp_subst)
{
- dSP; dTARG;
+ djSP; dTARG;
register PMOP *pm = cPMOP;
PMOP *rpm = pm;
register SV *dstr;
@@ -1366,23 +1588,31 @@ PP(pp_subst)
register REGEXP *rx = pm->op_pmregexp;
STRLEN len;
int force_on_match = 0;
- I32 oldsave = savestack_ix;
+ I32 oldsave = PL_savestack_ix;
+ I32 update_minmatch = 1;
+ SV *screamer;
/* known replacement string? */
dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv;
- if (op->op_flags & OPf_STACKED)
+ if (PL_op->op_flags & OPf_STACKED)
TARG = POPs;
else {
- TARG = GvSV(defgv);
+ TARG = DEFSV;
EXTEND(SP,1);
- }
+ }
if (SvREADONLY(TARG)
|| (SvTYPE(TARG) > SVt_PVLV
&& !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))
croak(no_modify);
+ PUTBACK;
+
s = SvPV(TARG, len);
if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV)
force_on_match = 1;
+ rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
+ (PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
+ if (PL_tainted)
+ rxtainted |= 2;
TAINT_NOT;
force_it:
@@ -1390,47 +1620,61 @@ PP(pp_subst)
DIE("panic: do_subst");
strend = s + len;
- maxiters = (strend - s) + 10;
+ maxiters = 2*(strend - s) + 10; /* We can match twice at each
+ position, once with zero-length,
+ second time with non-zero. */
- if (!rx->prelen && curpm) {
- pm = curpm;
+ if (!rx->prelen && PL_curpm) {
+ pm = PL_curpm;
rx = pm->op_pmregexp;
}
- safebase = (!rx->nparens && !sawampersand);
+ screamer = ( (SvSCREAM(TARG) && rx->check_substr
+ && SvTYPE(rx->check_substr) == SVt_PVBM
+ && SvVALID(rx->check_substr))
+ ? TARG : Nullsv);
+ safebase = (rx->nparens || SvTEMP(TARG) || PL_sawampersand)
+ ? REXEC_COPY_STR : 0;
if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
- SAVEINT(multiline);
- multiline = pm->op_pmflags & PMf_MULTILINE;
+ SAVEINT(PL_multiline);
+ PL_multiline = pm->op_pmflags & PMf_MULTILINE;
}
orig = m = s;
- if (pm->op_pmshort) {
- if (pm->op_pmflags & PMf_SCANFIRST) {
- if (SvSCREAM(TARG)) {
- if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
+ if (rx->check_substr) {
+ if (!(rx->reganch & ROPT_NOSCAN)) { /* It floats. */
+ if (screamer) {
+ I32 p = -1;
+
+ if (PL_screamfirst[BmRARE(rx->check_substr)] < 0)
goto nope;
- else if (!(s = screaminstr(TARG, pm->op_pmshort)))
+ else if (!(s = screaminstr(TARG, rx->check_substr, rx->check_offset_min, 0, &p, 0)))
goto nope;
}
- else if (!(s = fbm_instr((unsigned char*)s, (unsigned char*)strend,
- pm->op_pmshort)))
+ else if (!(s = fbm_instr((unsigned char*)s + rx->check_offset_min,
+ (unsigned char*)strend,
+ rx->check_substr, 0)))
goto nope;
- if (s && rx->regback >= 0) {
- ++BmUSEFUL(pm->op_pmshort);
- s -= rx->regback;
- if (s < m)
- s = m;
+ if (s && rx->check_offset_max < s - m) {
+ ++BmUSEFUL(rx->check_substr);
+ s -= rx->check_offset_max;
}
else
s = m;
}
- else if (!multiline) {
- if (*SvPVX(pm->op_pmshort) != *s
- || (pm->op_pmslen > 1
- && memNE(SvPVX(pm->op_pmshort), s, pm->op_pmslen)))
+ /* Now checkstring is fixed, i.e. at fixed offset from the
+ beginning of match, and the match is anchored at s. */
+ else if (!PL_multiline) { /* Anchored at beginning of string. */
+ I32 slen;
+ if (*SvPVX(rx->check_substr) != s[rx->check_offset_min]
+ || ((slen = SvCUR(rx->check_substr)) > 1
+ && memNE(SvPVX(rx->check_substr),
+ s + rx->check_offset_min, slen)))
goto nope;
}
- if (!rx->naughty && --BmUSEFUL(pm->op_pmshort) < 0) {
- SvREFCNT_dec(pm->op_pmshort);
- pm->op_pmshort = Nullsv; /* opt is being useless */
+ if (!rx->naughty && --BmUSEFUL(rx->check_substr) < 0
+ && rx->check_substr == rx->float_substr) {
+ SvREFCNT_dec(rx->check_substr);
+ rx->check_substr = Nullsv; /* opt is being useless */
+ rx->float_substr = Nullsv;
}
}
@@ -1441,10 +1685,11 @@ PP(pp_subst)
c = dstr ? SvPV(dstr, clen) : Nullch;
/* can do inplace substitution? */
- if (c && clen <= rx->minlen && safebase) {
- if (! pregexec(rx, s, strend, orig, 0,
- SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
- PUSHs(&sv_no);
+ if (c && clen <= rx->minlen && (once || !(safebase & REXEC_COPY_STR))
+ && !(rx->reganch & ROPT_LOOKBEHIND_SEEN)) {
+ if (!CALLREGEXEC(rx, s, strend, orig, 0, screamer, NULL, safebase)) {
+ SPAGAIN;
+ PUSHs(&PL_sv_no);
LEAVE_SCOPE(oldsave);
RETURN;
}
@@ -1454,12 +1699,17 @@ PP(pp_subst)
goto force_it;
}
d = s;
- curpm = pm;
+ PL_curpm = pm;
SvSCREAM_off(TARG); /* disable possible screamer */
if (once) {
- rxtainted = rx->exec_tainted;
- m = rx->startp[0];
- d = rx->endp[0];
+ rxtainted |= RX_MATCH_TAINTED(rx);
+ if (rx->subbase) {
+ m = orig + (rx->startp[0] - rx->subbase);
+ d = orig + (rx->endp[0] - rx->subbase);
+ } else {
+ m = rx->startp[0];
+ d = rx->endp[0];
+ }
s = orig;
if (m - s > strend - d) { /* faster to shorten from end */
if (clen) {
@@ -1493,15 +1743,15 @@ PP(pp_subst)
else {
sv_chop(TARG, d);
}
- TAINT_IF(rxtainted);
- PUSHs(&sv_yes);
+ TAINT_IF(rxtainted & 1);
+ SPAGAIN;
+ PUSHs(&PL_sv_yes);
}
else {
- rxtainted = 0;
do {
if (iters++ > maxiters)
DIE("Substitution loop");
- rxtainted |= rx->exec_tainted;
+ rxtainted |= RX_MATCH_TAINTED(rx);
m = rx->startp[0];
/*SUPPRESS 560*/
if (i = m - s) {
@@ -1514,43 +1764,49 @@ PP(pp_subst)
d += clen;
}
s = rx->endp[0];
- } while (pregexec(rx, s, strend, orig, s == m,
- Nullsv, TRUE)); /* don't match same null twice */
+ } while (CALLREGEXEC(rx, s, strend, orig, s == m,
+ Nullsv, NULL, 0)); /* don't match same null twice */
if (s != d) {
i = strend - s;
SvCUR_set(TARG, d - SvPVX(TARG) + i);
Move(s, d, i+1, char); /* include the NUL */
}
- TAINT_IF(rxtainted);
+ TAINT_IF(rxtainted & 1);
+ SPAGAIN;
PUSHs(sv_2mortal(newSViv((I32)iters)));
}
(void)SvPOK_only(TARG);
- SvSETMAGIC(TARG);
+ TAINT_IF(rxtainted);
+ if (SvSMAGICAL(TARG)) {
+ PUTBACK;
+ mg_set(TARG);
+ SPAGAIN;
+ }
SvTAINT(TARG);
LEAVE_SCOPE(oldsave);
RETURN;
}
- if (pregexec(rx, s, strend, orig, 0,
- SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
+ if (CALLREGEXEC(rx, s, strend, orig, 0, screamer, NULL, safebase)) {
if (force_on_match) {
force_on_match = 0;
s = SvPV_force(TARG, len);
goto force_it;
}
- rxtainted = rx->exec_tainted;
- dstr = NEWSV(25, sv_len(TARG));
+ rxtainted |= RX_MATCH_TAINTED(rx);
+ dstr = NEWSV(25, len);
sv_setpvn(dstr, m, s-m);
- curpm = pm;
+ PL_curpm = pm;
if (!c) {
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
+ SPAGAIN;
PUSHSUBST(cx);
RETURNOP(cPMOP->op_pmreplroot);
}
do {
if (iters++ > maxiters)
DIE("Substitution loop");
- rxtainted |= rx->exec_tainted;
+ rxtainted |= RX_MATCH_TAINTED(rx);
if (rx->subbase && rx->subbase != orig) {
m = s;
s = orig;
@@ -1565,11 +1821,9 @@ PP(pp_subst)
sv_catpvn(dstr, c, clen);
if (once)
break;
- } while (pregexec(rx, s, strend, orig, s == m, Nullsv, safebase));
+ } while (CALLREGEXEC(rx, s, strend, orig, s == m, Nullsv, NULL, safebase));
sv_catpvn(dstr, s, strend - s);
- TAINT_IF(rxtainted);
-
(void)SvOOK_off(TARG);
Safefree(SvPVX(TARG));
SvPVX(TARG) = SvPVX(dstr);
@@ -1578,43 +1832,48 @@ PP(pp_subst)
SvPVX(dstr) = 0;
sv_free(dstr);
+ TAINT_IF(rxtainted & 1);
+ SPAGAIN;
+ PUSHs(sv_2mortal(newSViv((I32)iters)));
+
(void)SvPOK_only(TARG);
+ TAINT_IF(rxtainted);
SvSETMAGIC(TARG);
SvTAINT(TARG);
- PUSHs(sv_2mortal(newSViv((I32)iters)));
LEAVE_SCOPE(oldsave);
RETURN;
}
goto ret_no;
nope:
- ++BmUSEFUL(pm->op_pmshort);
+ ++BmUSEFUL(rx->check_substr);
-ret_no:
- PUSHs(&sv_no);
+ret_no:
+ SPAGAIN;
+ PUSHs(&PL_sv_no);
LEAVE_SCOPE(oldsave);
RETURN;
}
PP(pp_grepwhile)
{
- dSP;
+ djSP;
if (SvTRUEx(POPs))
- stack_base[markstack_ptr[-1]++] = stack_base[*markstack_ptr];
- ++*markstack_ptr;
+ PL_stack_base[PL_markstack_ptr[-1]++] = PL_stack_base[*PL_markstack_ptr];
+ ++*PL_markstack_ptr;
LEAVE; /* exit inner scope */
/* All done yet? */
- if (stack_base + *markstack_ptr > sp) {
+ if (PL_stack_base + *PL_markstack_ptr > SP) {
I32 items;
I32 gimme = GIMME_V;
LEAVE; /* exit outer scope */
(void)POPMARK; /* pop src */
- items = --*markstack_ptr - markstack_ptr[-1];
+ items = --*PL_markstack_ptr - PL_markstack_ptr[-1];
(void)POPMARK; /* pop dst */
- SP = stack_base + POPMARK; /* pop original mark */
+ SP = PL_stack_base + POPMARK; /* pop original mark */
if (gimme == G_SCALAR) {
dTARGET;
XPUSHi(items);
@@ -1627,11 +1886,11 @@ PP(pp_grepwhile)
SV *src;
ENTER; /* enter inner scope */
- SAVESPTR(curpm);
+ SAVESPTR(PL_curpm);
- src = stack_base[*markstack_ptr];
+ src = PL_stack_base[*PL_markstack_ptr];
SvTEMP_off(src);
- GvSV(defgv) = src;
+ DEFSV = src;
RETURNOP(cLOGOP->op_other);
}
@@ -1639,12 +1898,12 @@ PP(pp_grepwhile)
PP(pp_leavesub)
{
- dSP;
+ djSP;
SV **mark;
SV **newsp;
PMOP *newpm;
I32 gimme;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
struct block_sub cxsub;
POPBLOCK(cx,newpm);
@@ -1653,11 +1912,21 @@ PP(pp_leavesub)
TAINT_NOT;
if (gimme == G_SCALAR) {
MARK = newsp + 1;
- if (MARK <= SP)
- *MARK = SvTEMP(TOPs) ? TOPs : sv_mortalcopy(TOPs);
- else {
+ if (MARK <= SP) {
+ if (cxsub.cv && CvDEPTH(cxsub.cv) > 1) {
+ if (SvTEMP(TOPs)) {
+ *MARK = SvREFCNT_inc(TOPs);
+ FREETMPS;
+ sv_2mortal(*MARK);
+ } else {
+ FREETMPS;
+ *MARK = sv_mortalcopy(TOPs);
+ }
+ } else
+ *MARK = SvTEMP(TOPs) ? TOPs : sv_mortalcopy(TOPs);
+ } else {
MEXTEND(MARK, 0);
- *MARK = &sv_undef;
+ *MARK = &PL_sv_undef;
}
SP = MARK;
}
@@ -1672,21 +1941,57 @@ PP(pp_leavesub)
PUTBACK;
POPSUB2(); /* Stack values are safe: release CV and @_ ... */
- curpm = newpm; /* ... and pop $1 et al */
+ PL_curpm = newpm; /* ... and pop $1 et al */
LEAVE;
return pop_return();
}
+STATIC CV *
+get_db_sub(SV **svp, CV *cv)
+{
+ dTHR;
+ SV *dbsv = GvSV(PL_DBsub);
+
+ if (!PERLDB_SUB_NN) {
+ GV *gv = CvGV(cv);
+
+ save_item(dbsv);
+ if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
+ || strEQ(GvNAME(gv), "END")
+ || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
+ !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv)
+ && (gv = (GV*)*svp) ))) {
+ /* Use GV from the stack as a fallback. */
+ /* GV is potentially non-unique, or contain different CV. */
+ sv_setsv(dbsv, newRV((SV*)cv));
+ }
+ else {
+ gv_efullname3(dbsv, gv, Nullch);
+ }
+ }
+ else {
+ SvUPGRADE(dbsv, SVt_PVIV);
+ SvIOK_on(dbsv);
+ SAVEIV(SvIVX(dbsv));
+ SvIVX(dbsv) = (IV)cv; /* Do it the quickest way */
+ }
+
+ if (CvXSUB(cv))
+ PL_curcopdb = PL_curcop;
+ cv = GvCV(PL_DBsub);
+ return cv;
+}
+
PP(pp_entersub)
{
- dSP; dPOPss;
+ djSP; dPOPss;
GV *gv;
HV *stash;
register CV *cv;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 gimme;
- bool hasargs = (op->op_flags & OPf_STACKED) != 0;
+ bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0;
if (!sv)
DIE("Not a CODE reference");
@@ -1694,10 +1999,11 @@ PP(pp_entersub)
default:
if (!SvROK(sv)) {
char *sym;
+ STRLEN n_a;
- if (sv == &sv_yes) { /* unfound import, ignore */
+ if (sv == &PL_sv_yes) { /* unfound import, ignore */
if (hasargs)
- SP = stack_base + POPMARK;
+ SP = PL_stack_base + POPMARK;
RETURN;
}
if (SvGMAGICAL(sv)) {
@@ -1705,10 +2011,10 @@ PP(pp_entersub)
sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
}
else
- sym = SvPV(sv, na);
+ sym = SvPV(sv, n_a);
if (!sym)
DIE(no_usym, "a subroutine");
- if (op->op_private & HINT_STRICT_REFS)
+ if (PL_op->op_private & HINT_STRICT_REFS)
DIE(no_symref, sym, "a subroutine");
cv = perl_get_cv(sym, TRUE);
break;
@@ -1738,7 +2044,7 @@ PP(pp_entersub)
if (!CvROOT(cv) && !CvXSUB(cv)) {
GV* autogv;
- SV* subname;
+ SV* sub_name;
/* anonymous or undef'd function leaves us no recourse */
if (CvANON(cv) || !(gv = CvGV(cv)))
@@ -1756,33 +2062,144 @@ PP(pp_entersub)
goto retry;
}
/* sorry */
- subname = sv_newmortal();
- gv_efullname3(subname, gv, Nullch);
- DIE("Undefined subroutine &%s called", SvPVX(subname));
+ sub_name = sv_newmortal();
+ gv_efullname3(sub_name, gv, Nullch);
+ DIE("Undefined subroutine &%s called", SvPVX(sub_name));
}
gimme = GIMME_V;
- if ((op->op_private & OPpENTERSUB_DB) && GvCV(DBsub) && !CvNODEBUG(cv)) {
- SV *oldsv = sv;
- sv = GvSV(DBsub);
- save_item(sv);
- gv = CvGV(cv);
- if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
- || strEQ(GvNAME(gv), "END")
- || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
- !( (SvTYPE(oldsv) == SVt_PVGV) && (GvCV((GV*)oldsv) == cv)
- && (gv = (GV*)oldsv) ))) { /* Use GV from the stack as a fallback. */
- /* GV is potentially non-unique, or contain different CV. */
- sv_setsv(sv, newRV((SV*)cv));
+ if ((PL_op->op_private & OPpENTERSUB_DB) && GvCV(PL_DBsub) && !CvNODEBUG(cv))
+ cv = get_db_sub(&sv, cv);
+ if (!cv)
+ DIE("No DBsub routine");
+
+#ifdef USE_THREADS
+ /*
+ * First we need to check if the sub or method requires locking.
+ * If so, we gain a lock on the CV, the first argument or the
+ * stash (for static methods), as appropriate. This has to be
+ * inline because for FAKE_THREADS, COND_WAIT inlines code to
+ * reschedule by returning a new op.
+ */
+ MUTEX_LOCK(CvMUTEXP(cv));
+ if (CvFLAGS(cv) & CVf_LOCKED) {
+ MAGIC *mg;
+ if (CvFLAGS(cv) & CVf_METHOD) {
+ if (SP > PL_stack_base + TOPMARK)
+ sv = *(PL_stack_base + TOPMARK + 1);
+ else {
+ MUTEX_UNLOCK(CvMUTEXP(cv));
+ croak("no argument for locked method call");
+ }
+ if (SvROK(sv))
+ sv = SvRV(sv);
+ else {
+ STRLEN len;
+ char *stashname = SvPV(sv, len);
+ sv = (SV*)gv_stashpvn(stashname, len, TRUE);
+ }
}
else {
- gv_efullname3(sv, gv, Nullch);
+ sv = (SV*)cv;
}
- cv = GvCV(DBsub);
- if (CvXSUB(cv)) curcopdb = curcop;
- if (!cv)
- DIE("No DBsub routine");
+ MUTEX_UNLOCK(CvMUTEXP(cv));
+ mg = condpair_magic(sv);
+ MUTEX_LOCK(MgMUTEXP(mg));
+ if (MgOWNER(mg) == thr)
+ MUTEX_UNLOCK(MgMUTEXP(mg));
+ else {
+ while (MgOWNER(mg))
+ COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
+ MgOWNER(mg) = thr;
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: pp_entersub lock %p\n",
+ thr, sv);)
+ MUTEX_UNLOCK(MgMUTEXP(mg));
+ save_destructor(unlock_condpair, sv);
+ }
+ MUTEX_LOCK(CvMUTEXP(cv));
}
+ /*
+ * Now we have permission to enter the sub, we must distinguish
+ * four cases. (0) It's an XSUB (in which case we don't care
+ * about ownership); (1) it's ours already (and we're recursing);
+ * (2) it's free (but we may already be using a cached clone);
+ * (3) another thread owns it. Case (1) is easy: we just use it.
+ * Case (2) means we look for a clone--if we have one, use it
+ * otherwise grab ownership of cv. Case (3) means we look for a
+ * clone (for non-XSUBs) and have to create one if we don't
+ * already have one.
+ * Why look for a clone in case (2) when we could just grab
+ * ownership of cv straight away? Well, we could be recursing,
+ * i.e. we originally tried to enter cv while another thread
+ * owned it (hence we used a clone) but it has been freed up
+ * and we're now recursing into it. It may or may not be "better"
+ * to use the clone but at least CvDEPTH can be trusted.
+ */
+ if (CvOWNER(cv) == thr || CvXSUB(cv))
+ MUTEX_UNLOCK(CvMUTEXP(cv));
+ else {
+ /* Case (2) or (3) */
+ SV **svp;
+
+ /*
+ * XXX Might it be better to release CvMUTEXP(cv) while we
+ * do the hv_fetch? We might find someone has pinched it
+ * when we look again, in which case we would be in case
+ * (3) instead of (2) so we'd have to clone. Would the fact
+ * that we released the mutex more quickly make up for this?
+ */
+ if ((svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE)))
+ {
+ /* We already have a clone to use */
+ MUTEX_UNLOCK(CvMUTEXP(cv));
+ cv = *(CV**)svp;
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ "entersub: %p already has clone %p:%s\n",
+ thr, cv, SvPEEK((SV*)cv)));
+ CvOWNER(cv) = thr;
+ SvREFCNT_inc(cv);
+ if (CvDEPTH(cv) == 0)
+ SAVEDESTRUCTOR(unset_cvowner, (void*) cv);
+ }
+ else {
+ /* (2) => grab ownership of cv. (3) => make clone */
+ if (!CvOWNER(cv)) {
+ CvOWNER(cv) = thr;
+ SvREFCNT_inc(cv);
+ MUTEX_UNLOCK(CvMUTEXP(cv));
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ "entersub: %p grabbing %p:%s in stash %s\n",
+ thr, cv, SvPEEK((SV*)cv), CvSTASH(cv) ?
+ HvNAME(CvSTASH(cv)) : "(none)"));
+ } else {
+ /* Make a new clone. */
+ CV *clonecv;
+ SvREFCNT_inc(cv); /* don't let it vanish from under us */
+ MUTEX_UNLOCK(CvMUTEXP(cv));
+ DEBUG_S((PerlIO_printf(PerlIO_stderr(),
+ "entersub: %p cloning %p:%s\n",
+ thr, cv, SvPEEK((SV*)cv))));
+ /*
+ * We're creating a new clone so there's no race
+ * between the original MUTEX_UNLOCK and the
+ * SvREFCNT_inc since no one will be trying to undef
+ * it out from underneath us. At least, I don't think
+ * there's a race...
+ */
+ clonecv = cv_clone(cv);
+ SvREFCNT_dec(cv); /* finished with this */
+ hv_store(thr->cvcache, (char*)cv, sizeof(cv), (SV*)clonecv,0);
+ CvOWNER(clonecv) = thr;
+ cv = clonecv;
+ SvREFCNT_inc(cv);
+ }
+ DEBUG_S(if (CvDEPTH(cv) != 0)
+ PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n",
+ CvDEPTH(cv)););
+ SAVEDESTRUCTOR(unset_cvowner, (void*) cv);
+ }
+ }
+#endif /* USE_THREADS */
if (CvXSUB(cv)) {
if (CvOLDSTYLE(cv)) {
@@ -1790,16 +2207,16 @@ PP(pp_entersub)
dMARK;
register I32 items = SP - MARK;
/* We dont worry to copy from @_. */
- while (sp > mark) {
- sp[1] = sp[0];
- sp--;
+ while (SP > mark) {
+ SP[1] = SP[0];
+ SP--;
}
- stack_sp = mark + 1;
+ PL_stack_sp = mark + 1;
fp3 = (I32(*)_((int,int,int)))CvXSUB(cv);
items = (*fp3)(CvXSUBANY(cv).any_i32,
- MARK - stack_base + 1,
+ MARK - PL_stack_base + 1,
items);
- stack_sp = stack_base + items;
+ PL_stack_sp = PL_stack_base + items;
}
else {
I32 markix = TOPMARK;
@@ -1810,34 +2227,40 @@ PP(pp_entersub)
/* Need to copy @_ to stack. Alternative may be to
* switch stack to @_, and copy return values
* back. This would allow popping @_ in XSUB, e.g.. XXXX */
- AV* av = GvAV(defgv);
- I32 items = AvFILL(av) + 1;
+ AV* av;
+ I32 items;
+#ifdef USE_THREADS
+ av = (AV*)PL_curpad[0];
+#else
+ av = GvAV(PL_defgv);
+#endif /* USE_THREADS */
+ items = AvFILLp(av) + 1; /* @_ is not tieable */
if (items) {
/* Mark is at the end of the stack. */
- EXTEND(sp, items);
- Copy(AvARRAY(av), sp + 1, items, SV*);
- sp += items;
+ EXTEND(SP, items);
+ Copy(AvARRAY(av), SP + 1, items, SV*);
+ SP += items;
PUTBACK ;
}
}
- if (curcopdb) { /* We assume that the first
+ if (PL_curcopdb) { /* We assume that the first
XSUB in &DB::sub is the
called one. */
- SAVESPTR(curcop);
- curcop = curcopdb;
- curcopdb = NULL;
+ SAVESPTR(PL_curcop);
+ PL_curcop = PL_curcopdb;
+ PL_curcopdb = NULL;
}
/* Do we need to open block here? XXXX */
- (void)(*CvXSUB(cv))(cv);
+ (void)(*CvXSUB(cv))(cv _PERL_OBJECT_THIS);
/* Enforce some sanity in scalar context. */
- if (gimme == G_SCALAR && ++markix != stack_sp - stack_base ) {
- if (markix > stack_sp - stack_base)
- *(stack_base + markix) = &sv_undef;
+ if (gimme == G_SCALAR && ++markix != PL_stack_sp - PL_stack_base ) {
+ if (markix > PL_stack_sp - PL_stack_base)
+ *(PL_stack_base + markix) = &PL_sv_undef;
else
- *(stack_base + markix) = *stack_sp;
- stack_sp = stack_base + markix;
+ *(PL_stack_base + markix) = *PL_stack_sp;
+ PL_stack_sp = PL_stack_base + markix;
}
}
LEAVE;
@@ -1848,24 +2271,26 @@ PP(pp_entersub)
register I32 items = SP - MARK;
AV* padlist = CvPADLIST(cv);
SV** svp = AvARRAY(padlist);
- push_return(op->op_next);
+ push_return(PL_op->op_next);
PUSHBLOCK(cx, CXt_SUB, MARK);
PUSHSUB(cx);
CvDEPTH(cv)++;
+ /* XXX This would be a natural place to set C<PL_compcv = cv> so
+ * that eval'' ops within this sub know the correct lexical space.
+ * Owing the speed considerations, we choose to search for the cv
+ * in doeval() instead.
+ */
if (CvDEPTH(cv) < 2)
(void)SvREFCNT_inc(cv);
else { /* save temporaries on recursion? */
- if (CvDEPTH(cv) == 100 && dowarn
- && !(PERLDB_SUB && cv == GvCV(DBsub)))
- sub_crush_depth(cv);
- if (CvDEPTH(cv) > AvFILL(padlist)) {
+ if (CvDEPTH(cv) > AvFILLp(padlist)) {
AV *av;
AV *newpad = newAV();
SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
- I32 ix = AvFILL((AV*)svp[1]);
+ I32 ix = AvFILLp((AV*)svp[1]);
svp = AvARRAY(svp[0]);
for ( ;ix > 0; ix--) {
- if (svp[ix] != &sv_undef) {
+ if (svp[ix] != &PL_sv_undef) {
char *name = SvPVX(svp[ix]);
if ((SvFLAGS(svp[ix]) & SVf_FAKE) /* outer lexical? */
|| *name == '&') /* anonymous code? */
@@ -1892,23 +2317,47 @@ PP(pp_entersub)
av_store(newpad, 0, (SV*)av);
AvFLAGS(av) = AVf_REIFY;
av_store(padlist, CvDEPTH(cv), (SV*)newpad);
- AvFILL(padlist) = CvDEPTH(cv);
+ AvFILLp(padlist) = CvDEPTH(cv);
svp = AvARRAY(padlist);
}
}
- SAVESPTR(curpad);
- curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
- if (hasargs) {
- AV* av = (AV*)curpad[0];
+#ifdef USE_THREADS
+ if (!hasargs) {
+ AV* av = (AV*)PL_curpad[0];
+
+ items = AvFILLp(av) + 1;
+ if (items) {
+ /* Mark is at the end of the stack. */
+ EXTEND(SP, items);
+ Copy(AvARRAY(av), SP + 1, items, SV*);
+ SP += items;
+ PUTBACK ;
+ }
+ }
+#endif /* USE_THREADS */
+ SAVESPTR(PL_curpad);
+ PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
+#ifndef USE_THREADS
+ if (hasargs)
+#endif /* USE_THREADS */
+ {
+ AV* av;
SV** ary;
+#if 0
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ "%p entersub preparing @_\n", thr));
+#endif
+ av = (AV*)PL_curpad[0];
if (AvREAL(av)) {
av_clear(av);
AvREAL_off(av);
}
- cx->blk_sub.savearray = GvAV(defgv);
+#ifndef USE_THREADS
+ cx->blk_sub.savearray = GvAV(PL_defgv);
+ GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
+#endif /* USE_THREADS */
cx->blk_sub.argarray = av;
- GvAV(defgv) = (AV*)SvREFCNT_inc(av);
++MARK;
if (items > AvMAX(av) + 1) {
@@ -1925,7 +2374,7 @@ PP(pp_entersub)
}
}
Copy(MARK,AvARRAY(av),items,SV*);
- AvFILL(av) = items - 1;
+ AvFILLp(av) = items - 1;
while (items--) {
if (*MARK)
@@ -1933,13 +2382,23 @@ PP(pp_entersub)
MARK++;
}
}
+ /* warning must come *after* we fully set up the context
+ * stuff so that __WARN__ handlers can safely dounwind()
+ * if they want to
+ */
+ if (CvDEPTH(cv) == 100 && PL_dowarn
+ && !(PERLDB_SUB && cv == GvCV(PL_DBsub)))
+ sub_crush_depth(cv);
+#if 0
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ "%p entersub returning %p\n", thr, CvSTART(cv)));
+#endif
RETURNOP(CvSTART(cv));
}
}
void
-sub_crush_depth(cv)
-CV* cv;
+sub_crush_depth(CV *cv)
{
if (CvANON(cv))
warn("Deep recursion on anonymous subroutine");
@@ -1952,20 +2411,21 @@ CV* cv;
PP(pp_aelem)
{
- dSP;
+ djSP;
SV** svp;
I32 elem = POPi;
AV* av = (AV*)POPs;
- U32 lval = op->op_flags & OPf_MOD;
- U32 defer = (op->op_private & OPpLVAL_DEFER) && (elem > AvFILL(av));
+ U32 lval = PL_op->op_flags & OPf_MOD;
+ U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > AvFILL(av));
+ SV *sv;
if (elem > 0)
- elem -= curcop->cop_arybase;
+ elem -= PL_curcop->cop_arybase;
if (SvTYPE(av) != SVt_PVAV)
RETPUSHUNDEF;
svp = av_fetch(av, elem, lval && !defer);
if (lval) {
- if (!svp || *svp == &sv_undef) {
+ if (!svp || *svp == &PL_sv_undef) {
SV* lv;
if (!defer)
DIE(no_aelem, elem);
@@ -1979,19 +2439,20 @@ PP(pp_aelem)
PUSHs(lv);
RETURN;
}
- if (op->op_private & OPpLVAL_INTRO)
- save_svref(svp);
- else if (op->op_private & OPpDEREF)
- vivify_ref(*svp, op->op_private & OPpDEREF);
+ if (PL_op->op_private & OPpLVAL_INTRO)
+ save_aelem(av, elem, svp);
+ else if (PL_op->op_private & OPpDEREF)
+ vivify_ref(*svp, PL_op->op_private & OPpDEREF);
}
- PUSHs(svp ? *svp : &sv_undef);
+ sv = (svp ? *svp : &PL_sv_undef);
+ if (!lval && SvGMAGICAL(sv)) /* see note in pp_helem() */
+ sv = sv_mortalcopy(sv);
+ PUSHs(sv);
RETURN;
}
void
-vivify_ref(sv, to_what)
-SV* sv;
-U32 to_what;
+vivify_ref(SV *sv, U32 to_what)
{
if (SvGMAGICAL(sv))
mg_get(sv);
@@ -2007,7 +2468,7 @@ U32 to_what;
}
switch (to_what) {
case OPpDEREF_SV:
- SvRV(sv) = newSV(0);
+ SvRV(sv) = NEWSV(355,0);
break;
case OPpDEREF_AV:
SvRV(sv) = (SV*)newAV();
@@ -2023,7 +2484,7 @@ U32 to_what;
PP(pp_method)
{
- dSP;
+ djSP;
SV* sv;
SV* ob;
GV* gv;
@@ -2040,8 +2501,8 @@ PP(pp_method)
}
}
- name = SvPV(TOPs, na);
- sv = *(stack_base + TOPMARK + 1);
+ name = SvPV(TOPs, packlen);
+ sv = *(PL_stack_base + TOPMARK + 1);
if (SvGMAGICAL(sv))
mg_get(sv);
@@ -2057,11 +2518,13 @@ PP(pp_method)
!(ob=(SV*)GvIO(iogv)))
{
if (!packname || !isIDFIRST(*packname))
- DIE("Can't call method \"%s\" without a package or object reference", name);
+ DIE("Can't call method \"%s\" %s", name,
+ SvOK(sv)? "without a package or object reference"
+ : "on an undefined value");
stash = gv_stashpvn(packname, packlen, TRUE);
goto fetch;
}
- *(stack_base + TOPMARK + 1) = sv_2mortal(newRV((SV*)iogv));
+ *(PL_stack_base + TOPMARK + 1) = sv_2mortal(newRV((SV*)iogv));
}
if (!ob || !SvOBJECT(ob))
@@ -2083,7 +2546,7 @@ PP(pp_method)
sep = p, leaf = p + 2;
}
if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) {
- packname = HvNAME(sep ? curcop->cop_stash : stash);
+ packname = HvNAME(sep ? PL_curcop->cop_stash : stash);
packlen = strlen(packname);
}
else {
@@ -2096,3 +2559,4 @@ PP(pp_method)
SETs(isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv);
RETURN;
}
+
diff --git a/gnu/usr.bin/perl/pp_sys.c b/gnu/usr.bin/perl/pp_sys.c
index d574b2e8528..1f3b11918cf 100644
--- a/gnu/usr.bin/perl/pp_sys.c
+++ b/gnu/usr.bin/perl/pp_sys.c
@@ -1,6 +1,6 @@
/* pp_sys.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -22,6 +22,12 @@
# include <unistd.h>
#endif
+#ifdef HAS_SYSCALL
+#ifdef __cplusplus
+extern "C" int syscall(unsigned long,...);
+#endif
+#endif
+
#ifdef I_SYS_WAIT
# include <sys/wait.h>
#endif
@@ -32,7 +38,9 @@
#if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
# include <sys/socket.h>
-# include <netdb.h>
+# ifdef I_NETDB
+# include <netdb.h>
+# endif
# ifndef ENOTSOCK
# ifdef I_NET_ERRNO
# include <net/errno.h>
@@ -46,7 +54,14 @@
#endif
#endif
-#ifdef HOST_NOT_FOUND
+/* XXX Configure test needed.
+ h_errno might not be a simple 'int', especially for multi-threaded
+ applications, see "extern int errno in perl.h". Creating such
+ a test requires taking into account the differences between
+ compiling multithreaded and singlethreaded ($ccflags et al).
+ HOST_NOT_FOUND is typically defined in <netdb.h>.
+*/
+#if defined(HOST_NOT_FOUND) && !defined(h_errno)
extern int h_errno;
#endif
@@ -57,7 +72,9 @@ extern int h_errno;
struct passwd *getpwnam _((char *));
struct passwd *getpwuid _((Uid_t));
# endif
+# ifdef HAS_GETPWENT
struct passwd *getpwent _((void));
+# endif
#endif
#ifdef HAS_GROUP
@@ -67,11 +84,13 @@ extern int h_errno;
struct group *getgrnam _((char *));
struct group *getgrgid _((Gid_t));
# endif
+# ifdef HAS_GETGRENT
struct group *getgrent _((void));
+# endif
#endif
#ifdef I_UTIME
-# ifdef _MSC_VER
+# if defined(_MSC_VER) || defined(__MINGW32__)
# include <sys/utime.h>
# else
# include <utime.h>
@@ -106,7 +125,7 @@ static int dooneliner _((char *cmd, char *filename));
# ifdef my_chsize /* Probably #defined to Perl_my_chsize in embed.h */
# undef my_chsize
# endif
-# define my_chsize chsize
+# define my_chsize PerlLIO_chsize
#endif
#ifdef HAS_FLOCK
@@ -169,16 +188,18 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true";
PP(pp_backtick)
{
- dSP; dTARGET;
+ djSP; dTARGET;
PerlIO *fp;
- char *tmps = POPp;
+ STRLEN n_a;
+ char *tmps = POPpx;
I32 gimme = GIMME_V;
TAINT_PROPER("``");
- fp = my_popen(tmps, "r");
+ fp = PerlProc_popen(tmps, "r");
if (fp) {
if (gimme == G_VOID) {
- while (PerlIO_read(fp, tokenbuf, sizeof tokenbuf) > 0)
+ char tmpbuf[256];
+ while (PerlIO_read(fp, tmpbuf, sizeof tmpbuf) > 0)
/*SUPPRESS 530*/
;
}
@@ -194,7 +215,7 @@ PP(pp_backtick)
SV *sv;
for (;;) {
- sv = NEWSV(56, 80);
+ sv = NEWSV(56, 79);
if (sv_gets(sv, fp, 0) == Nullch) {
SvREFCNT_dec(sv);
break;
@@ -207,7 +228,7 @@ PP(pp_backtick)
SvTAINTED_on(sv);
}
}
- STATUS_NATIVE_SET(my_pclose(fp));
+ STATUS_NATIVE_SET(PerlProc_pclose(fp));
TAINT; /* "I believe that this is not gratuitous!" */
}
else {
@@ -225,7 +246,7 @@ PP(pp_glob)
ENTER;
#ifndef VMS
- if (tainting) {
+ if (PL_tainting) {
/*
* The external globbing program may use things we can't control,
* so for security reasons we must assume the worst.
@@ -235,14 +256,14 @@ PP(pp_glob)
}
#endif /* !VMS */
- SAVESPTR(last_in_gv); /* We don't want this to be permanent. */
- last_in_gv = (GV*)*stack_sp--;
+ SAVESPTR(PL_last_in_gv); /* We don't want this to be permanent. */
+ PL_last_in_gv = (GV*)*PL_stack_sp--;
- SAVESPTR(rs); /* This is not permanent, either. */
- rs = sv_2mortal(newSVpv("", 1));
+ SAVESPTR(PL_rs); /* This is not permanent, either. */
+ PL_rs = sv_2mortal(newSVpv("", 1));
#ifndef DOSISH
#ifndef CSH
- *SvPVX(rs) = '\n';
+ *SvPVX(PL_rs) = '\n';
#endif /* !CSH */
#endif /* !DOSISH */
@@ -251,37 +272,41 @@ PP(pp_glob)
return result;
}
+#if 0 /* XXX never used! */
PP(pp_indread)
{
- last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*stack_sp--)), na), TRUE,SVt_PVIO);
+ STRLEN n_a;
+ PL_last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*PL_stack_sp--)), n_a), TRUE,SVt_PVIO);
return do_readline();
}
+#endif
PP(pp_rcatline)
{
- last_in_gv = cGVOP->op_gv;
+ PL_last_in_gv = cGVOP->op_gv;
return do_readline();
}
PP(pp_warn)
{
- dSP; dMARK;
+ djSP; dMARK;
char *tmps;
+ STRLEN n_a;
if (SP - MARK != 1) {
dTARGET;
- do_join(TARG, &sv_no, MARK, SP);
- tmps = SvPV(TARG, na);
+ do_join(TARG, &PL_sv_no, MARK, SP);
+ tmps = SvPV(TARG, n_a);
SP = MARK + 1;
}
else {
- tmps = SvPV(TOPs, na);
+ tmps = SvPV(TOPs, n_a);
}
if (!tmps || !*tmps) {
- SV *error = GvSV(errgv);
+ SV *error = ERRSV;
(void)SvUPGRADE(error, SVt_PV);
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...caught");
- tmps = SvPV(error, na);
+ tmps = SvPV(error, n_a);
}
if (!tmps || !*tmps)
tmps = "Warning: something's wrong";
@@ -291,34 +316,62 @@ PP(pp_warn)
PP(pp_die)
{
- dSP; dMARK;
+ djSP; dMARK;
char *tmps;
+ SV *tmpsv = Nullsv;
+ char *pat = "%s";
+ STRLEN n_a;
if (SP - MARK != 1) {
dTARGET;
- do_join(TARG, &sv_no, MARK, SP);
- tmps = SvPV(TARG, na);
+ do_join(TARG, &PL_sv_no, MARK, SP);
+ tmps = SvPV(TARG, n_a);
SP = MARK + 1;
}
else {
- tmps = SvPV(TOPs, na);
+ tmpsv = TOPs;
+ tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, n_a);
}
if (!tmps || !*tmps) {
- SV *error = GvSV(errgv);
+ SV *error = ERRSV;
(void)SvUPGRADE(error, SVt_PV);
- if (SvPOK(error) && SvCUR(error))
- sv_catpv(error, "\t...propagated");
- tmps = SvPV(error, na);
+ if(tmpsv ? SvROK(tmpsv) : SvROK(error)) {
+ if(tmpsv)
+ SvSetSV(error,tmpsv);
+ else if(sv_isobject(error)) {
+ HV *stash = SvSTASH(SvRV(error));
+ GV *gv = gv_fetchmethod(stash, "PROPAGATE");
+ if (gv) {
+ SV *file = sv_2mortal(newSVsv(GvSV(PL_curcop->cop_filegv)));
+ SV *line = sv_2mortal(newSViv(PL_curcop->cop_line));
+ EXTEND(SP, 3);
+ PUSHMARK(SP);
+ PUSHs(error);
+ PUSHs(file);
+ PUSHs(line);
+ PUTBACK;
+ perl_call_sv((SV*)GvCV(gv),
+ G_SCALAR|G_EVAL|G_KEEPERR);
+ sv_setsv(error,*PL_stack_sp--);
+ }
+ }
+ pat = Nullch;
+ }
+ else {
+ if (SvPOK(error) && SvCUR(error))
+ sv_catpv(error, "\t...propagated");
+ tmps = SvPV(error, n_a);
+ }
}
if (!tmps || !*tmps)
tmps = "Died";
- DIE("%s", tmps);
+ DIE(pat, tmps);
}
/* I/O. */
PP(pp_open)
{
- dSP; dTARGET;
+ djSP; dTARGET;
GV *gv;
SV *sv;
char *tmps;
@@ -336,9 +389,9 @@ PP(pp_open)
if (GvIOp(gv))
IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
tmps = SvPV(sv, len);
- if (do_open(gv, tmps, len, FALSE, 0, 0, Nullfp))
- PUSHi( (I32)forkprocess );
- else if (forkprocess == 0) /* we are a new child */
+ if (do_open(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp))
+ PUSHi( (I32)PL_forkprocess );
+ else if (PL_forkprocess == 0) /* we are a new child */
PUSHi(0);
else
RETPUSHUNDEF;
@@ -347,13 +400,25 @@ PP(pp_open)
PP(pp_close)
{
- dSP;
+ djSP;
GV *gv;
+ MAGIC *mg;
if (MAXARG == 0)
- gv = defoutgv;
+ gv = PL_defoutgv;
else
gv = (GV*)POPs;
+
+ if (mg = SvTIED_mg((SV*)gv, 'q')) {
+ PUSHMARK(SP);
+ XPUSHs(SvTIED_obj((SV*)gv, mg));
+ PUTBACK;
+ ENTER;
+ perl_call_method("CLOSE", G_SCALAR);
+ LEAVE;
+ SPAGAIN;
+ RETURN;
+ }
EXTEND(SP, 1);
PUSHs(boolSV(do_close(gv, TRUE)));
RETURN;
@@ -361,7 +426,7 @@ PP(pp_close)
PP(pp_pipe_op)
{
- dSP;
+ djSP;
#ifdef HAS_PIPE
GV *rgv;
GV *wgv;
@@ -385,7 +450,7 @@ PP(pp_pipe_op)
if (IoIFP(wstio))
do_close(wgv, FALSE);
- if (pipe(fd) < 0)
+ if (PerlProc_pipe(fd) < 0)
goto badexit;
IoIFP(rstio) = PerlIO_fdopen(fd[0], "r");
@@ -396,12 +461,15 @@ PP(pp_pipe_op)
if (!IoIFP(rstio) || !IoOFP(wstio)) {
if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio));
- else close(fd[0]);
+ else PerlLIO_close(fd[0]);
if (IoOFP(wstio)) PerlIO_close(IoOFP(wstio));
- else close(fd[1]);
+ else PerlLIO_close(fd[1]);
goto badexit;
}
-
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+ fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */
+ fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */
+#endif
RETPUSHYES;
badexit:
@@ -413,7 +481,7 @@ badexit:
PP(pp_fileno)
{
- dSP; dTARGET;
+ djSP; dTARGET;
GV *gv;
IO *io;
PerlIO *fp;
@@ -428,27 +496,32 @@ PP(pp_fileno)
PP(pp_umask)
{
- dSP; dTARGET;
+ djSP; dTARGET;
int anum;
#ifdef HAS_UMASK
if (MAXARG < 1) {
- anum = umask(0);
- (void)umask(anum);
+ anum = PerlLIO_umask(0);
+ (void)PerlLIO_umask(anum);
}
else
- anum = umask(POPi);
+ anum = PerlLIO_umask(POPi);
TAINT_PROPER("umask");
XPUSHi(anum);
#else
- DIE(no_func, "Unsupported function umask");
+ /* Only DIE if trying to restrict permissions on `user' (self).
+ * Otherwise it's harmless and more useful to just return undef
+ * since 'group' and 'other' concepts probably don't exist here. */
+ if (MAXARG >= 1 && (POPi & 0700))
+ DIE("umask not implemented");
+ XPUSHs(&PL_sv_undef);
#endif
RETURN;
}
PP(pp_binmode)
{
- dSP;
+ djSP;
GV *gv;
IO *io;
PerlIO *fp;
@@ -462,171 +535,135 @@ PP(pp_binmode)
if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
RETPUSHUNDEF;
-#ifdef DOSISH
-#ifdef atarist
- if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN))
+ if (do_binmode(fp,IoTYPE(io),TRUE))
RETPUSHYES;
else
RETPUSHUNDEF;
-#else
- if (setmode(PerlIO_fileno(fp), OP_BINARY) != -1) {
-#if defined(WIN32) && defined(__BORLANDC__)
- /* The translation mode of the stream is maintained independent
- * of the translation mode of the fd in the Borland RTL (heavy
- * digging through their runtime sources reveal). User has to
- * set the mode explicitly for the stream (though they don't
- * document this anywhere). GSAR 97-5-24
- */
- PerlIO_seek(fp,0L,0);
- fp->flags |= _F_BIN;
-#endif
- RETPUSHYES;
- }
- else
- RETPUSHUNDEF;
-#endif
-#else
-#if defined(USEMYBINMODE)
- if (my_binmode(fp,IoTYPE(io)) != NULL)
- RETPUSHYES;
- else
- RETPUSHUNDEF;
-#else
- RETPUSHYES;
-#endif
-#endif
-
}
+
PP(pp_tie)
{
- dSP;
+ djSP;
+ dMARK;
SV *varsv;
HV* stash;
GV *gv;
- BINOP myop;
SV *sv;
- SV **mark = stack_base + ++*markstack_ptr; /* reuse in entersub */
- I32 markoff = mark - stack_base - 1;
+ I32 markoff = MARK - PL_stack_base;
char *methname;
- bool oldcatch = CATCH_GET;
-
- varsv = mark[0];
- if (SvTYPE(varsv) == SVt_PVHV)
- methname = "TIEHASH";
- else if (SvTYPE(varsv) == SVt_PVAV)
- methname = "TIEARRAY";
- else if (SvTYPE(varsv) == SVt_PVGV)
- methname = "TIEHANDLE";
- else
- methname = "TIESCALAR";
-
- stash = gv_stashsv(mark[1], FALSE);
- if (!stash || !(gv = gv_fetchmethod(stash, methname)))
- DIE("Can't locate object method \"%s\" via package \"%s\"",
- methname, SvPV(mark[1],na));
+ int how = 'P';
+ U32 items;
- Zero(&myop, 1, BINOP);
- myop.op_last = (OP *) &myop;
- myop.op_next = Nullop;
- myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED;
- CATCH_SET(TRUE);
-
- ENTER;
- SAVESPTR(op);
- op = (OP *) &myop;
- if (PERLDB_SUB && curstash != debstash)
- op->op_private |= OPpENTERSUB_DB;
-
- XPUSHs((SV*)GvCV(gv));
- PUTBACK;
-
- if (op = pp_entersub())
- runops();
+ varsv = *++MARK;
+ switch(SvTYPE(varsv)) {
+ case SVt_PVHV:
+ methname = "TIEHASH";
+ break;
+ case SVt_PVAV:
+ methname = "TIEARRAY";
+ break;
+ case SVt_PVGV:
+ methname = "TIEHANDLE";
+ how = 'q';
+ break;
+ default:
+ methname = "TIESCALAR";
+ how = 'q';
+ break;
+ }
+ items = SP - MARK++;
+ if (sv_isobject(*MARK)) {
+ ENTER;
+ PUSHSTACKi(PERLSI_MAGIC);
+ PUSHMARK(SP);
+ EXTEND(SP,items);
+ while (items--)
+ PUSHs(*MARK++);
+ PUTBACK;
+ perl_call_method(methname, G_SCALAR);
+ }
+ else {
+ /* Not clear why we don't call perl_call_method here too.
+ * perhaps to get different error message ?
+ */
+ stash = gv_stashsv(*MARK, FALSE);
+ if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
+ STRLEN n_a;
+ DIE("Can't locate object method \"%s\" via package \"%s\"",
+ methname, SvPV(*MARK,n_a));
+ }
+ ENTER;
+ PUSHSTACKi(PERLSI_MAGIC);
+ PUSHMARK(SP);
+ EXTEND(SP,items);
+ while (items--)
+ PUSHs(*MARK++);
+ PUTBACK;
+ perl_call_sv((SV*)GvCV(gv), G_SCALAR);
+ }
SPAGAIN;
- CATCH_SET(oldcatch);
sv = TOPs;
+ POPSTACK;
if (sv_isobject(sv)) {
- if (SvTYPE(varsv) == SVt_PVHV || SvTYPE(varsv) == SVt_PVAV) {
- sv_unmagic(varsv, 'P');
- sv_magic(varsv, sv, 'P', Nullch, 0);
- }
- else {
- sv_unmagic(varsv, 'q');
- sv_magic(varsv, sv, 'q', Nullch, 0);
- }
+ sv_unmagic(varsv, how);
+ sv_magic(varsv, (SvRV(sv) == varsv ? Nullsv : sv), how, Nullch, 0);
}
LEAVE;
- SP = stack_base + markoff;
+ SP = PL_stack_base + markoff;
PUSHs(sv);
RETURN;
}
PP(pp_untie)
{
- dSP;
- SV * sv ;
+ djSP;
+ SV *sv = POPs;
+ char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q';
- sv = POPs;
-
- if (dowarn) {
- MAGIC * mg ;
- if (SvMAGICAL(sv)) {
- if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
- mg = mg_find(sv, 'P') ;
- else
- mg = mg_find(sv, 'q') ;
-
- if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1)
+ if (PL_dowarn) {
+ MAGIC *mg;
+ if (mg = SvTIED_mg(sv, how)) {
+ if (mg->mg_obj && SvREFCNT(SvRV(mg->mg_obj)) > 1)
warn("untie attempted while %lu inner references still exist",
(unsigned long)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
}
}
- if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
- sv_unmagic(sv, 'P');
- else
- sv_unmagic(sv, 'q');
+ sv_unmagic(sv, how);
RETPUSHYES;
}
PP(pp_tied)
{
- dSP;
- SV * sv ;
- MAGIC * mg ;
+ djSP;
+ SV *sv = POPs;
+ char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q';
+ MAGIC *mg;
- sv = POPs;
- if (SvMAGICAL(sv)) {
- if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
- mg = mg_find(sv, 'P') ;
- else
- mg = mg_find(sv, 'q') ;
-
- if (mg) {
- PUSHs(sv_2mortal(newSVsv(mg->mg_obj))) ;
- RETURN ;
- }
+ if (mg = SvTIED_mg(sv, how)) {
+ SV *osv = SvTIED_obj(sv, mg);
+ if (osv == mg->mg_obj)
+ osv = sv_mortalcopy(osv);
+ PUSHs(osv);
+ RETURN;
}
-
RETPUSHUNDEF;
}
PP(pp_dbmopen)
{
- dSP;
+ djSP;
HV *hv;
dPOPPOPssrl;
HV* stash;
GV *gv;
- BINOP myop;
SV *sv;
- bool oldcatch = CATCH_GET;
hv = (HV*)POPs;
- sv = sv_mortalcopy(&sv_no);
+ sv = sv_mortalcopy(&PL_sv_no);
sv_setpv(sv, "AnyDBM_File");
stash = gv_stashsv(sv, FALSE);
if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
@@ -637,21 +674,10 @@ PP(pp_dbmopen)
DIE("No dbm on this machine");
}
- Zero(&myop, 1, BINOP);
- myop.op_last = (OP *) &myop;
- myop.op_next = Nullop;
- myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED;
- CATCH_SET(TRUE);
-
ENTER;
- SAVESPTR(op);
- op = (OP *) &myop;
- if (PERLDB_SUB && curstash != debstash)
- op->op_private |= OPpENTERSUB_DB;
- PUTBACK;
- pp_pushmark();
+ PUSHMARK(SP);
- EXTEND(sp, 5);
+ EXTEND(SP, 5);
PUSHs(sv);
PUSHs(left);
if (SvIV(right))
@@ -659,34 +685,26 @@ PP(pp_dbmopen)
else
PUSHs(sv_2mortal(newSViv(O_RDWR)));
PUSHs(right);
- PUSHs((SV*)GvCV(gv));
PUTBACK;
-
- if (op = pp_entersub())
- runops();
+ perl_call_sv((SV*)GvCV(gv), G_SCALAR);
SPAGAIN;
if (!sv_isobject(TOPs)) {
- sp--;
- op = (OP *) &myop;
- PUTBACK;
- pp_pushmark();
-
+ SP--;
+ PUSHMARK(SP);
PUSHs(sv);
PUSHs(left);
PUSHs(sv_2mortal(newSViv(O_RDONLY)));
PUSHs(right);
- PUSHs((SV*)GvCV(gv));
PUTBACK;
-
- if (op = pp_entersub())
- runops();
+ perl_call_sv((SV*)GvCV(gv), G_SCALAR);
SPAGAIN;
}
- CATCH_SET(oldcatch);
- if (sv_isobject(TOPs))
+ if (sv_isobject(TOPs)) {
+ sv_unmagic((SV *) hv, 'P');
sv_magic((SV*)hv, TOPs, 'P', Nullch, 0);
+ }
LEAVE;
RETURN;
}
@@ -698,7 +716,7 @@ PP(pp_dbmclose)
PP(pp_sselect)
{
- dSP; dTARGET;
+ djSP; dTARGET;
#ifdef HAS_SELECT
register I32 i;
register I32 j;
@@ -711,6 +729,7 @@ PP(pp_sselect)
struct timeval *tbuf = &timebuf;
I32 growsize;
char *fd_sets[4];
+ STRLEN n_a;
#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
I32 masksize;
I32 offset;
@@ -733,11 +752,17 @@ PP(pp_sselect)
maxlen = j;
}
+/* little endians can use vecs directly */
#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
-#if defined(__linux__) || defined(OS2)
- growsize = sizeof(fd_set);
+# if SELECT_MIN_BITS > 1
+ /* If SELECT_MIN_BITS is greater than one we most probably will want
+ * to align the sizes with SELECT_MIN_BITS/8 because for example
+ * in many little-endian (Intel, Alpha) systems (Linux, OS/2, Digital
+ * UNIX, Solaris, NeXT) the smallest quantum select() operates on
+ * (sets bit) is 32 bits. */
+ growsize = maxlen + (SELECT_MIN_BITS/8 - (maxlen % (SELECT_MIN_BITS/8)));
#else
- growsize = maxlen; /* little endians can use vecs directly */
+ growsize = sizeof(fd_set);
#endif
#else
#ifdef NFDBITS
@@ -773,7 +798,7 @@ PP(pp_sselect)
continue;
}
else if (!SvPOK(sv))
- SvPV_force(sv,na); /* force string conversion */
+ SvPV_force(sv,n_a); /* force string conversion */
j = SvLEN(sv);
if (j < growsize) {
Sv_Grow(sv, growsize);
@@ -796,7 +821,7 @@ PP(pp_sselect)
#endif
}
- nfound = select(
+ nfound = PerlSock_select(
maxlen * 8,
(Select_fd_set_t) fd_sets[1],
(Select_fd_set_t) fd_sets[2],
@@ -821,7 +846,7 @@ PP(pp_sselect)
if (GIMME == G_ARRAY && tbuf) {
value = (double)(timebuf.tv_sec) +
(double)(timebuf.tv_usec) / 1000000.0;
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setnv(sv, value);
}
RETURN;
@@ -831,34 +856,34 @@ PP(pp_sselect)
}
void
-setdefout(gv)
-GV *gv;
+setdefout(GV *gv)
{
+ dTHR;
if (gv)
(void)SvREFCNT_inc(gv);
- if (defoutgv)
- SvREFCNT_dec(defoutgv);
- defoutgv = gv;
+ if (PL_defoutgv)
+ SvREFCNT_dec(PL_defoutgv);
+ PL_defoutgv = gv;
}
PP(pp_select)
{
- dSP; dTARGET;
+ djSP; dTARGET;
GV *newdefout, *egv;
HV *hv;
- newdefout = (op->op_private > 0) ? ((GV *) POPs) : NULL;
+ newdefout = (PL_op->op_private > 0) ? ((GV *) POPs) : (GV *) NULL;
- egv = GvEGV(defoutgv);
+ egv = GvEGV(PL_defoutgv);
if (!egv)
- egv = defoutgv;
+ egv = PL_defoutgv;
hv = GvSTASH(egv);
if (! hv)
- XPUSHs(&sv_undef);
+ XPUSHs(&PL_sv_undef);
else {
GV **gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
if (gvp && *gvp == egv) {
- gv_efullname3(TARG, defoutgv, Nullch);
+ gv_efullname3(TARG, PL_defoutgv, Nullch);
XPUSHTARG;
}
else {
@@ -877,21 +902,21 @@ PP(pp_select)
PP(pp_getc)
{
- dSP; dTARGET;
+ djSP; dTARGET;
GV *gv;
MAGIC *mg;
if (MAXARG <= 0)
- gv = stdingv;
+ gv = PL_stdingv;
else
gv = (GV*)POPs;
if (!gv)
- gv = argvgv;
+ gv = PL_argvgv;
- if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+ if (mg = SvTIED_mg((SV*)gv, 'q')) {
I32 gimme = GIMME_V;
PUSHMARK(SP);
- XPUSHs(mg->mg_obj);
+ XPUSHs(SvTIED_obj((SV*)gv, mg));
PUTBACK;
ENTER;
perl_call_method("GETC", gimme);
@@ -915,13 +940,11 @@ PP(pp_read)
return pp_sysread(ARGS);
}
-static OP *
-doform(cv,gv,retop)
-CV *cv;
-GV *gv;
-OP *retop;
+STATIC OP *
+doform(CV *cv, GV *gv, OP *retop)
{
- register CONTEXT *cx;
+ dTHR;
+ register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
AV* padlist = CvPADLIST(cv);
SV** svp = AvARRAY(padlist);
@@ -930,10 +953,10 @@ OP *retop;
SAVETMPS;
push_return(retop);
- PUSHBLOCK(cx, CXt_SUB, stack_sp);
+ PUSHBLOCK(cx, CXt_SUB, PL_stack_sp);
PUSHFORMAT(cx);
- SAVESPTR(curpad);
- curpad = AvARRAY((AV*)svp[1]);
+ SAVESPTR(PL_curpad);
+ PL_curpad = AvARRAY((AV*)svp[1]);
setdefout(gv); /* locally select filehandle so $% et al work */
return CvSTART(cv);
@@ -941,18 +964,18 @@ OP *retop;
PP(pp_enterwrite)
{
- dSP;
+ djSP;
register GV *gv;
register IO *io;
GV *fgv;
CV *cv;
if (MAXARG == 0)
- gv = defoutgv;
+ gv = PL_defoutgv;
else {
gv = (GV*)POPs;
if (!gv)
- gv = defoutgv;
+ gv = PL_defoutgv;
}
EXTEND(SP, 1);
io = GvIO(gv);
@@ -977,24 +1000,24 @@ PP(pp_enterwrite)
cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
IoFLAGS(io) &= ~IOf_DIDTOP;
- return doform(cv,gv,op->op_next);
+ return doform(cv,gv,PL_op->op_next);
}
PP(pp_leavewrite)
{
- dSP;
+ djSP;
GV *gv = cxstack[cxstack_ix].blk_sub.gv;
register IO *io = GvIOp(gv);
PerlIO *ofp = IoOFP(io);
PerlIO *fp;
SV **newsp;
I32 gimme;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
DEBUG_f(PerlIO_printf(Perl_debug_log, "left=%ld, todo=%ld\n",
- (long)IoLINES_LEFT(io), (long)FmLINES(formtarget)));
- if (IoLINES_LEFT(io) < FmLINES(formtarget) &&
- formtarget != toptarget)
+ (long)IoLINES_LEFT(io), (long)FmLINES(PL_formtarget)));
+ if (IoLINES_LEFT(io) < FmLINES(PL_formtarget) &&
+ PL_formtarget != PL_toptarget)
{
GV *fgv;
CV *cv;
@@ -1022,7 +1045,7 @@ PP(pp_leavewrite)
}
if (IoFLAGS(io) & IOf_DIDTOP) { /* Oh dear. It still doesn't fit. */
I32 lines = IoLINES_LEFT(io);
- char *s = SvPVX(formtarget);
+ char *s = SvPVX(PL_formtarget);
if (lines <= 0) /* Yow, header didn't even fit!!! */
goto forget_top;
while (lines-- > 0) {
@@ -1032,16 +1055,16 @@ PP(pp_leavewrite)
s++;
}
if (s) {
- PerlIO_write(ofp, SvPVX(formtarget), s - SvPVX(formtarget));
- sv_chop(formtarget, s);
- FmLINES(formtarget) -= IoLINES_LEFT(io);
+ PerlIO_write(ofp, SvPVX(PL_formtarget), s - SvPVX(PL_formtarget));
+ sv_chop(PL_formtarget, s);
+ FmLINES(PL_formtarget) -= IoLINES_LEFT(io);
}
}
if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0)
- PerlIO_write(ofp, SvPVX(formfeed), SvCUR(formfeed));
+ PerlIO_write(ofp, SvPVX(PL_formfeed), SvCUR(PL_formfeed));
IoLINES_LEFT(io) = IoPAGE_LEN(io);
IoPAGE(io)++;
- formtarget = toptarget;
+ PL_formtarget = PL_toptarget;
IoFLAGS(io) |= IOf_DIDTOP;
fgv = IoTOP_GV(io);
if (!fgv)
@@ -1054,69 +1077,70 @@ PP(pp_leavewrite)
}
if (CvCLONE(cv))
cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
- return doform(cv,gv,op);
+ return doform(cv,gv,PL_op);
}
forget_top:
- POPBLOCK(cx,curpm);
+ POPBLOCK(cx,PL_curpm);
POPFORMAT(cx);
LEAVE;
fp = IoOFP(io);
if (!fp) {
- if (dowarn) {
+ if (PL_dowarn) {
if (IoIFP(io))
warn("Filehandle only opened for input");
else
warn("Write on closed filehandle");
}
- PUSHs(&sv_no);
+ PUSHs(&PL_sv_no);
}
else {
- if ((IoLINES_LEFT(io) -= FmLINES(formtarget)) < 0) {
- if (dowarn)
+ if ((IoLINES_LEFT(io) -= FmLINES(PL_formtarget)) < 0) {
+ if (PL_dowarn)
warn("page overflow");
}
- if (!PerlIO_write(ofp, SvPVX(formtarget), SvCUR(formtarget)) ||
+ if (!PerlIO_write(ofp, SvPVX(PL_formtarget), SvCUR(PL_formtarget)) ||
PerlIO_error(fp))
- PUSHs(&sv_no);
+ PUSHs(&PL_sv_no);
else {
- FmLINES(formtarget) = 0;
- SvCUR_set(formtarget, 0);
- *SvEND(formtarget) = '\0';
+ FmLINES(PL_formtarget) = 0;
+ SvCUR_set(PL_formtarget, 0);
+ *SvEND(PL_formtarget) = '\0';
if (IoFLAGS(io) & IOf_FLUSH)
(void)PerlIO_flush(fp);
- PUSHs(&sv_yes);
+ PUSHs(&PL_sv_yes);
}
}
- formtarget = bodytarget;
+ PL_formtarget = PL_bodytarget;
PUTBACK;
return pop_return();
}
PP(pp_prtf)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
GV *gv;
IO *io;
PerlIO *fp;
SV *sv;
MAGIC *mg;
+ STRLEN n_a;
- if (op->op_flags & OPf_STACKED)
+ if (PL_op->op_flags & OPf_STACKED)
gv = (GV*)*++MARK;
else
- gv = defoutgv;
+ gv = PL_defoutgv;
- if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+ if (mg = SvTIED_mg((SV*)gv, 'q')) {
if (MARK == ORIGMARK) {
- EXTEND(SP, 1);
+ MEXTEND(SP, 1);
++MARK;
Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
++SP;
}
PUSHMARK(MARK - 1);
- *MARK = mg->mg_obj;
+ *MARK = SvTIED_obj((SV*)gv, mg);
PUTBACK;
ENTER;
perl_call_method("PRINTF", G_SCALAR);
@@ -1130,27 +1154,27 @@ PP(pp_prtf)
sv = NEWSV(0,0);
if (!(io = GvIO(gv))) {
- if (dowarn) {
+ if (PL_dowarn) {
gv_fullname3(sv, gv, Nullch);
- warn("Filehandle %s never opened", SvPV(sv,na));
+ warn("Filehandle %s never opened", SvPV(sv,n_a));
}
SETERRNO(EBADF,RMS$_IFI);
goto just_say_no;
}
else if (!(fp = IoOFP(io))) {
- if (dowarn) {
+ if (PL_dowarn) {
gv_fullname3(sv, gv, Nullch);
if (IoIFP(io))
- warn("Filehandle %s opened only for input", SvPV(sv,na));
+ warn("Filehandle %s opened only for input", SvPV(sv,n_a));
else
- warn("printf on closed filehandle %s", SvPV(sv,na));
+ warn("printf on closed filehandle %s", SvPV(sv,n_a));
}
SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
}
else {
#ifdef USE_LOCALE_NUMERIC
- if (op->op_private & OPpLOCALE)
+ if (PL_op->op_private & OPpLOCALE)
SET_NUMERIC_LOCAL();
else
SET_NUMERIC_STANDARD();
@@ -1165,19 +1189,19 @@ PP(pp_prtf)
}
SvREFCNT_dec(sv);
SP = ORIGMARK;
- PUSHs(&sv_yes);
+ PUSHs(&PL_sv_yes);
RETURN;
just_say_no:
SvREFCNT_dec(sv);
SP = ORIGMARK;
- PUSHs(&sv_undef);
+ PUSHs(&PL_sv_undef);
RETURN;
}
PP(pp_sysopen)
{
- dSP;
+ djSP;
GV *gv;
SV *sv;
char *tmps;
@@ -1195,17 +1219,17 @@ PP(pp_sysopen)
tmps = SvPV(sv, len);
if (do_open(gv, tmps, len, TRUE, mode, perm, Nullfp)) {
IoLINES(GvIOp(gv)) = 0;
- PUSHs(&sv_yes);
+ PUSHs(&PL_sv_yes);
}
else {
- PUSHs(&sv_undef);
+ PUSHs(&PL_sv_undef);
}
RETURN;
}
PP(pp_sysread)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
int offset;
GV *gv;
IO *io;
@@ -1217,13 +1241,13 @@ PP(pp_sysread)
MAGIC *mg;
gv = (GV*)*++MARK;
- if ((op->op_type == OP_READ || op->op_type == OP_SYSREAD) &&
- SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q')))
+ if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) &&
+ (mg = SvTIED_mg((SV*)gv, 'q')))
{
SV *sv;
PUSHMARK(MARK-1);
- *MARK = mg->mg_obj;
+ *MARK = SvTIED_obj((SV*)gv, mg);
ENTER;
perl_call_method("READ", G_SCALAR);
LEAVE;
@@ -1252,16 +1276,16 @@ PP(pp_sysread)
if (!io || !IoIFP(io))
goto say_undef;
#ifdef HAS_SOCKET
- if (op->op_type == OP_RECV) {
+ if (PL_op->op_type == OP_RECV) {
char namebuf[MAXPATHLEN];
-#if defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)
+#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(MPE)
bufsize = sizeof (struct sockaddr_in);
#else
bufsize = sizeof namebuf;
#endif
buffer = SvGROW(bufsv, length+1);
/* 'offset' means 'flags' here */
- length = recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
+ length = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
(struct sockaddr *)namebuf, &bufsize);
if (length < 0)
RETPUSHUNDEF;
@@ -1278,7 +1302,7 @@ PP(pp_sysread)
RETURN;
}
#else
- if (op->op_type == OP_RECV)
+ if (PL_op->op_type == OP_RECV)
DIE(no_sock_func, "recv");
#endif
if (offset < 0) {
@@ -1291,8 +1315,18 @@ PP(pp_sysread)
if (offset > bufsize) { /* Zero any newly allocated space */
Zero(buffer+bufsize, offset-bufsize, char);
}
- if (op->op_type == OP_SYSREAD) {
- length = read(PerlIO_fileno(IoIFP(io)), buffer+offset, length);
+ if (PL_op->op_type == OP_SYSREAD) {
+#ifdef PERL_SOCK_SYSREAD_IS_RECV
+ if (IoTYPE(io) == 's') {
+ length = PerlSock_recv(PerlIO_fileno(IoIFP(io)),
+ buffer+offset, length, 0);
+ }
+ else
+#endif
+ {
+ length = PerlLIO_read(PerlIO_fileno(IoIFP(io)),
+ buffer+offset, length);
+ }
}
else
#ifdef HAS_SOCKET__bad_code_maybe
@@ -1303,12 +1337,17 @@ PP(pp_sysread)
#else
bufsize = sizeof namebuf;
#endif
- length = recvfrom(PerlIO_fileno(IoIFP(io)), buffer+offset, length, 0,
+ length = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer+offset, length, 0,
(struct sockaddr *)namebuf, &bufsize);
}
else
#endif
+ {
length = PerlIO_read(IoIFP(io), buffer+offset, length);
+ /* fread() returns 0 on both error and EOF */
+ if (length == 0 && PerlIO_error(IoIFP(io)))
+ length = -1;
+ }
if (length < 0)
goto say_undef;
SvCUR_set(bufsv, length+offset);
@@ -1329,12 +1368,21 @@ PP(pp_sysread)
PP(pp_syswrite)
{
+ djSP;
+ int items = (SP - PL_stack_base) - TOPMARK;
+ if (items == 2) {
+ SV *sv;
+ EXTEND(SP, 1);
+ sv = sv_2mortal(newSViv(sv_len(*SP)));
+ PUSHs(sv);
+ PUTBACK;
+ }
return pp_send(ARGS);
}
PP(pp_send)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
GV *gv;
IO *io;
int offset;
@@ -1342,8 +1390,23 @@ PP(pp_send)
char *buffer;
int length;
STRLEN blen;
+ MAGIC *mg;
gv = (GV*)*++MARK;
+ if (PL_op->op_type == OP_SYSWRITE && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+ SV *sv;
+
+ PUSHMARK(MARK-1);
+ *MARK = SvTIED_obj((SV*)gv, mg);
+ ENTER;
+ perl_call_method("WRITE", G_SCALAR);
+ LEAVE;
+ SPAGAIN;
+ sv = POPs;
+ SP = ORIGMARK;
+ PUSHs(sv);
+ RETURN;
+ }
if (!gv)
goto say_undef;
bufsv = *++MARK;
@@ -1355,14 +1418,14 @@ PP(pp_send)
io = GvIO(gv);
if (!io || !IoIFP(io)) {
length = -1;
- if (dowarn) {
- if (op->op_type == OP_SYSWRITE)
+ if (PL_dowarn) {
+ if (PL_op->op_type == OP_SYSWRITE)
warn("Syswrite on closed filehandle");
else
warn("Send on closed socket");
}
}
- else if (op->op_type == OP_SYSWRITE) {
+ else if (PL_op->op_type == OP_SYSWRITE) {
if (MARK < SP) {
offset = SvIVx(*++MARK);
if (offset < 0) {
@@ -1375,18 +1438,28 @@ PP(pp_send)
offset = 0;
if (length > blen - offset)
length = blen - offset;
- length = write(PerlIO_fileno(IoIFP(io)), buffer+offset, length);
+#ifdef PERL_SOCK_SYSWRITE_IS_SEND
+ if (IoTYPE(io) == 's') {
+ length = PerlSock_send(PerlIO_fileno(IoIFP(io)),
+ buffer+offset, length, 0);
+ }
+ else
+#endif
+ {
+ length = PerlLIO_write(PerlIO_fileno(IoIFP(io)),
+ buffer+offset, length);
+ }
}
#ifdef HAS_SOCKET
else if (SP > MARK) {
char *sockbuf;
STRLEN mlen;
sockbuf = SvPVx(*++MARK, mlen);
- length = sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, length,
+ length = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, length,
(struct sockaddr *)sockbuf, mlen);
}
else
- length = send(PerlIO_fileno(IoIFP(io)), buffer, blen, length);
+ length = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, length);
#else
else
@@ -1410,26 +1483,26 @@ PP(pp_recv)
PP(pp_eof)
{
- dSP;
+ djSP;
GV *gv;
if (MAXARG <= 0)
- gv = last_in_gv;
+ gv = PL_last_in_gv;
else
- gv = last_in_gv = (GV*)POPs;
+ gv = PL_last_in_gv = (GV*)POPs;
PUSHs(boolSV(!gv || do_eof(gv)));
RETURN;
}
PP(pp_tell)
{
- dSP; dTARGET;
+ djSP; dTARGET;
GV *gv;
if (MAXARG <= 0)
- gv = last_in_gv;
+ gv = PL_last_in_gv;
else
- gv = last_in_gv = (GV*)POPs;
+ gv = PL_last_in_gv = (GV*)POPs;
PUSHi( do_tell(gv) );
RETURN;
}
@@ -1441,17 +1514,17 @@ PP(pp_seek)
PP(pp_sysseek)
{
- dSP;
+ djSP;
GV *gv;
int whence = POPi;
long offset = POPl;
- gv = last_in_gv = (GV*)POPs;
- if (op->op_type == OP_SEEK)
+ gv = PL_last_in_gv = (GV*)POPs;
+ if (PL_op->op_type == OP_SEEK)
PUSHs(boolSV(do_seek(gv, offset, whence)));
else {
long n = do_sysseek(gv, offset, whence);
- PUSHs((n < 0) ? &sv_undef
+ PUSHs((n < 0) ? &PL_sv_undef
: sv_2mortal(n ? newSViv((IV)n)
: newSVpv(zero_but_true, ZBTLEN)));
}
@@ -1460,15 +1533,16 @@ PP(pp_sysseek)
PP(pp_truncate)
{
- dSP;
+ djSP;
Off_t len = (Off_t)POPn;
int result = 1;
GV *tmpgv;
+ STRLEN n_a;
SETERRNO(0,0);
#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
- if (op->op_flags & OPf_SPECIAL) {
- tmpgv = gv_fetchpv(POPp, FALSE, SVt_PVIO);
+ if (PL_op->op_flags & OPf_SPECIAL) {
+ tmpgv = gv_fetchpv(POPpx, FALSE, SVt_PVIO);
do_ftruncate:
TAINT_PROPER("truncate");
if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
@@ -1492,7 +1566,7 @@ PP(pp_truncate)
goto do_ftruncate;
}
- name = SvPV(sv, na);
+ name = SvPV(sv, n_a);
TAINT_PROPER("truncate");
#ifdef HAS_TRUNCATE
if (truncate(name, len) < 0)
@@ -1500,12 +1574,12 @@ PP(pp_truncate)
#else
{
int tmpfd;
- if ((tmpfd = open(name, O_RDWR)) < 0)
+ if ((tmpfd = PerlLIO_open(name, O_RDWR)) < 0)
result = 0;
else {
if (my_chsize(tmpfd, len) < 0)
result = 0;
- close(tmpfd);
+ PerlLIO_close(tmpfd);
}
}
#endif
@@ -1528,10 +1602,10 @@ PP(pp_fcntl)
PP(pp_ioctl)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SV *argsv = POPs;
unsigned int func = U_I(POPn);
- int optype = op->op_type;
+ int optype = PL_op->op_type;
char *s;
IV retval;
GV *gv = (GV*)POPs;
@@ -1563,7 +1637,7 @@ PP(pp_ioctl)
if (optype == OP_IOCTL)
#ifdef HAS_IOCTL
- retval = ioctl(PerlIO_fileno(IoIFP(io)), func, s);
+ retval = PerlLIO_ioctl(PerlIO_fileno(IoIFP(io)), func, s);
#else
DIE("ioctl is not implemented");
#endif
@@ -1599,7 +1673,7 @@ PP(pp_ioctl)
PP(pp_flock)
{
- dSP; dTARGET;
+ djSP; dTARGET;
I32 value;
int argtype;
GV *gv;
@@ -1608,7 +1682,7 @@ PP(pp_flock)
#ifdef FLOCK
argtype = POPi;
if (MAXARG <= 0)
- gv = last_in_gv;
+ gv = PL_last_in_gv;
else
gv = (GV*)POPs;
if (gv && GvIO(gv))
@@ -1617,7 +1691,7 @@ PP(pp_flock)
fp = Nullfp;
if (fp) {
(void)PerlIO_flush(fp);
- value = (I32)(FLOCK(PerlIO_fileno(fp), argtype) >= 0);
+ value = (I32)(PerlLIO_flock(PerlIO_fileno(fp), argtype) >= 0);
}
else
value = 0;
@@ -1632,7 +1706,7 @@ PP(pp_flock)
PP(pp_socket)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
GV *gv;
register IO *io;
@@ -1653,7 +1727,7 @@ PP(pp_socket)
do_close(gv, FALSE);
TAINT_PROPER("socket");
- fd = socket(domain, type, protocol);
+ fd = PerlSock_socket(domain, type, protocol);
if (fd < 0)
RETPUSHUNDEF;
IoIFP(io) = PerlIO_fdopen(fd, "r"); /* stdio gets confused about sockets */
@@ -1662,7 +1736,7 @@ PP(pp_socket)
if (!IoIFP(io) || !IoOFP(io)) {
if (IoIFP(io)) PerlIO_close(IoIFP(io));
if (IoOFP(io)) PerlIO_close(IoOFP(io));
- if (!IoIFP(io) && !IoOFP(io)) close(fd);
+ if (!IoIFP(io) && !IoOFP(io)) PerlLIO_close(fd);
RETPUSHUNDEF;
}
@@ -1674,7 +1748,7 @@ PP(pp_socket)
PP(pp_sockpair)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKETPAIR
GV *gv1;
GV *gv2;
@@ -1698,7 +1772,7 @@ PP(pp_sockpair)
do_close(gv2, FALSE);
TAINT_PROPER("socketpair");
- if (socketpair(domain, type, protocol, fd) < 0)
+ if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
RETPUSHUNDEF;
IoIFP(io1) = PerlIO_fdopen(fd[0], "r");
IoOFP(io1) = PerlIO_fdopen(fd[0], "w");
@@ -1709,10 +1783,10 @@ PP(pp_sockpair)
if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
if (IoIFP(io1)) PerlIO_close(IoIFP(io1));
if (IoOFP(io1)) PerlIO_close(IoOFP(io1));
- if (!IoIFP(io1) && !IoOFP(io1)) close(fd[0]);
+ if (!IoIFP(io1) && !IoOFP(io1)) PerlLIO_close(fd[0]);
if (IoIFP(io2)) PerlIO_close(IoIFP(io2));
if (IoOFP(io2)) PerlIO_close(IoOFP(io2));
- if (!IoIFP(io2) && !IoOFP(io2)) close(fd[1]);
+ if (!IoIFP(io2) && !IoOFP(io2)) PerlLIO_close(fd[1]);
RETPUSHUNDEF;
}
@@ -1724,26 +1798,55 @@ PP(pp_sockpair)
PP(pp_bind)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
+#ifdef MPE /* Requires PRIV mode to bind() to ports < 1024 */
+ extern GETPRIVMODE();
+ extern GETUSERMODE();
+#endif
SV *addrsv = POPs;
char *addr;
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
STRLEN len;
+ int bind_ok = 0;
+#ifdef MPE
+ int mpeprivmode = 0;
+#endif
if (!io || !IoIFP(io))
goto nuts;
addr = SvPV(addrsv, len);
TAINT_PROPER("bind");
- if (bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
+#ifdef MPE /* Deal with MPE bind() peculiarities */
+ if (((struct sockaddr *)addr)->sa_family == AF_INET) {
+ /* The address *MUST* stupidly be zero. */
+ ((struct sockaddr_in *)addr)->sin_addr.s_addr = INADDR_ANY;
+ /* PRIV mode is required to bind() to ports < 1024. */
+ if (((struct sockaddr_in *)addr)->sin_port < 1024 &&
+ ((struct sockaddr_in *)addr)->sin_port > 0) {
+ GETPRIVMODE(); /* If this fails, we are aborted by MPE/iX. */
+ mpeprivmode = 1;
+ }
+ }
+#endif /* MPE */
+ if (PerlSock_bind(PerlIO_fileno(IoIFP(io)),
+ (struct sockaddr *)addr, len) >= 0)
+ bind_ok = 1;
+
+#ifdef MPE /* Switch back to USER mode */
+ if (mpeprivmode)
+ GETUSERMODE();
+#endif /* MPE */
+
+ if (bind_ok)
RETPUSHYES;
else
RETPUSHUNDEF;
nuts:
- if (dowarn)
+ if (PL_dowarn)
warn("bind() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
@@ -1754,7 +1857,7 @@ nuts:
PP(pp_connect)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
SV *addrsv = POPs;
char *addr;
@@ -1767,13 +1870,13 @@ PP(pp_connect)
addr = SvPV(addrsv, len);
TAINT_PROPER("connect");
- if (connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
+ if (PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
RETPUSHYES;
else
RETPUSHUNDEF;
nuts:
- if (dowarn)
+ if (PL_dowarn)
warn("connect() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
@@ -1784,7 +1887,7 @@ nuts:
PP(pp_listen)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
int backlog = POPi;
GV *gv = (GV*)POPs;
@@ -1793,13 +1896,13 @@ PP(pp_listen)
if (!io || !IoIFP(io))
goto nuts;
- if (listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0)
+ if (PerlSock_listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0)
RETPUSHYES;
else
RETPUSHUNDEF;
nuts:
- if (dowarn)
+ if (PL_dowarn)
warn("listen() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
@@ -1810,7 +1913,7 @@ nuts:
PP(pp_accept)
{
- dSP; dTARGET;
+ djSP; dTARGET;
#ifdef HAS_SOCKET
GV *ngv;
GV *ggv;
@@ -1836,7 +1939,7 @@ PP(pp_accept)
if (IoIFP(nstio))
do_close(ngv, FALSE);
- fd = accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
+ fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
if (fd < 0)
goto badexit;
IoIFP(nstio) = PerlIO_fdopen(fd, "r");
@@ -1845,7 +1948,7 @@ PP(pp_accept)
if (!IoIFP(nstio) || !IoOFP(nstio)) {
if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio));
if (IoOFP(nstio)) PerlIO_close(IoOFP(nstio));
- if (!IoIFP(nstio) && !IoOFP(nstio)) close(fd);
+ if (!IoIFP(nstio) && !IoOFP(nstio)) PerlLIO_close(fd);
goto badexit;
}
@@ -1853,7 +1956,7 @@ PP(pp_accept)
RETURN;
nuts:
- if (dowarn)
+ if (PL_dowarn)
warn("accept() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
@@ -1867,7 +1970,7 @@ badexit:
PP(pp_shutdown)
{
- dSP; dTARGET;
+ djSP; dTARGET;
#ifdef HAS_SOCKET
int how = POPi;
GV *gv = (GV*)POPs;
@@ -1876,11 +1979,11 @@ PP(pp_shutdown)
if (!io || !IoIFP(io))
goto nuts;
- PUSHi( shutdown(PerlIO_fileno(IoIFP(io)), how) >= 0 );
+ PUSHi( PerlSock_shutdown(PerlIO_fileno(IoIFP(io)), how) >= 0 );
RETURN;
nuts:
- if (dowarn)
+ if (PL_dowarn)
warn("shutdown() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
@@ -1900,9 +2003,9 @@ PP(pp_gsockopt)
PP(pp_ssockopt)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
- int optype = op->op_type;
+ int optype = PL_op->op_type;
SV *sv;
int fd;
unsigned int optname;
@@ -1931,7 +2034,7 @@ PP(pp_ssockopt)
SvCUR_set(sv,256);
*SvEND(sv) ='\0';
len = SvCUR(sv);
- if (getsockopt(fd, lvl, optname, SvPVX(sv), &len) < 0)
+ if (PerlSock_getsockopt(fd, lvl, optname, SvPVX(sv), &len) < 0)
goto nuts2;
SvCUR_set(sv, len);
*SvEND(sv) ='\0';
@@ -1941,24 +2044,25 @@ PP(pp_ssockopt)
char *buf;
int aint;
if (SvPOKp(sv)) {
- buf = SvPV(sv, na);
- len = na;
+ STRLEN l;
+ buf = SvPV(sv, l);
+ len = l;
}
- else if (SvOK(sv)) {
+ else {
aint = (int)SvIV(sv);
buf = (char*)&aint;
len = sizeof(int);
}
- if (setsockopt(fd, lvl, optname, buf, len) < 0)
+ if (PerlSock_setsockopt(fd, lvl, optname, buf, len) < 0)
goto nuts2;
- PUSHs(&sv_yes);
+ PUSHs(&PL_sv_yes);
}
break;
}
RETURN;
nuts:
- if (dowarn)
+ if (PL_dowarn)
warn("[gs]etsockopt() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
nuts2:
@@ -1980,9 +2084,9 @@ PP(pp_getsockname)
PP(pp_getpeername)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
- int optype = op->op_type;
+ int optype = PL_op->op_type;
SV *sv;
int fd;
GV *gv = (GV*)POPs;
@@ -2000,11 +2104,11 @@ PP(pp_getpeername)
fd = PerlIO_fileno(IoIFP(io));
switch (optype) {
case OP_GETSOCKNAME:
- if (getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0)
+ if (PerlSock_getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0)
goto nuts2;
break;
case OP_GETPEERNAME:
- if (getpeername(fd, (struct sockaddr *)SvPVX(sv), &len) < 0)
+ if (PerlSock_getpeername(fd, (struct sockaddr *)SvPVX(sv), &len) < 0)
goto nuts2;
#if defined(VMS_DO_SOCKETS) && defined (DECCRTL_SOCKETS)
{
@@ -2031,7 +2135,7 @@ PP(pp_getpeername)
RETURN;
nuts:
- if (dowarn)
+ if (PL_dowarn)
warn("get{sock, peer}name() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
nuts2:
@@ -2051,22 +2155,23 @@ PP(pp_lstat)
PP(pp_stat)
{
- dSP;
+ djSP;
GV *tmpgv;
I32 gimme;
I32 max = 13;
+ STRLEN n_a;
- if (op->op_flags & OPf_REF) {
+ if (PL_op->op_flags & OPf_REF) {
tmpgv = cGVOP->op_gv;
do_fstat:
- if (tmpgv != defgv) {
- laststype = OP_STAT;
- statgv = tmpgv;
- sv_setpv(statname, "");
- laststatval = (GvIO(tmpgv) && IoIFP(GvIOp(tmpgv))
- ? Fstat(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), &statcache) : -1);
+ if (tmpgv != PL_defgv) {
+ PL_laststype = OP_STAT;
+ PL_statgv = tmpgv;
+ sv_setpv(PL_statname, "");
+ PL_laststatval = (GvIO(tmpgv) && IoIFP(GvIOp(tmpgv))
+ ? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), &PL_statcache) : -1);
}
- if (laststatval < 0)
+ if (PL_laststatval < 0)
max = 0;
}
else {
@@ -2079,17 +2184,17 @@ PP(pp_stat)
tmpgv = (GV*)SvRV(sv);
goto do_fstat;
}
- sv_setpv(statname, SvPV(sv,na));
- statgv = Nullgv;
+ sv_setpv(PL_statname, SvPV(sv,n_a));
+ PL_statgv = Nullgv;
#ifdef HAS_LSTAT
- laststype = op->op_type;
- if (op->op_type == OP_LSTAT)
- laststatval = lstat(SvPV(statname, na), &statcache);
+ PL_laststype = PL_op->op_type;
+ if (PL_op->op_type == OP_LSTAT)
+ PL_laststatval = PerlLIO_lstat(SvPV(PL_statname, n_a), &PL_statcache);
else
#endif
- laststatval = Stat(SvPV(statname, na), &statcache);
- if (laststatval < 0) {
- if (dowarn && strchr(SvPV(statname, na), '\n'))
+ PL_laststatval = PerlLIO_stat(SvPV(PL_statname, n_a), &PL_statcache);
+ if (PL_laststatval < 0) {
+ if (PL_dowarn && strchr(SvPV(PL_statname, n_a), '\n'))
warn(warn_nl, "stat");
max = 0;
}
@@ -2104,30 +2209,30 @@ PP(pp_stat)
if (max) {
EXTEND(SP, max);
EXTEND_MORTAL(max);
- PUSHs(sv_2mortal(newSViv((I32)statcache.st_dev)));
- PUSHs(sv_2mortal(newSViv((I32)statcache.st_ino)));
- PUSHs(sv_2mortal(newSViv((I32)statcache.st_mode)));
- PUSHs(sv_2mortal(newSViv((I32)statcache.st_nlink)));
- PUSHs(sv_2mortal(newSViv((I32)statcache.st_uid)));
- PUSHs(sv_2mortal(newSViv((I32)statcache.st_gid)));
+ PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_dev)));
+ PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_ino)));
+ PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_mode)));
+ PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_nlink)));
+ PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_uid)));
+ PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_gid)));
#ifdef USE_STAT_RDEV
- PUSHs(sv_2mortal(newSViv((I32)statcache.st_rdev)));
+ PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_rdev)));
#else
PUSHs(sv_2mortal(newSVpv("", 0)));
#endif
- PUSHs(sv_2mortal(newSViv((I32)statcache.st_size)));
+ PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_size)));
#ifdef BIG_TIME
- PUSHs(sv_2mortal(newSVnv((U32)statcache.st_atime)));
- PUSHs(sv_2mortal(newSVnv((U32)statcache.st_mtime)));
- PUSHs(sv_2mortal(newSVnv((U32)statcache.st_ctime)));
+ PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_atime)));
+ PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_mtime)));
+ PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_ctime)));
#else
- PUSHs(sv_2mortal(newSViv((I32)statcache.st_atime)));
- PUSHs(sv_2mortal(newSViv((I32)statcache.st_mtime)));
- PUSHs(sv_2mortal(newSViv((I32)statcache.st_ctime)));
+ PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_atime)));
+ PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_mtime)));
+ PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_ctime)));
#endif
#ifdef USE_STAT_BLOCKS
- PUSHs(sv_2mortal(newSViv((I32)statcache.st_blksize)));
- PUSHs(sv_2mortal(newSViv((I32)statcache.st_blocks)));
+ PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_blksize)));
+ PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_blocks)));
#else
PUSHs(sv_2mortal(newSVpv("", 0)));
PUSHs(sv_2mortal(newSVpv("", 0)));
@@ -2139,10 +2244,10 @@ PP(pp_stat)
PP(pp_ftrread)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
- if (cando(S_IRUSR, 0, &statcache))
+ if (cando(S_IRUSR, 0, &PL_statcache))
RETPUSHYES;
RETPUSHNO;
}
@@ -2150,10 +2255,10 @@ PP(pp_ftrread)
PP(pp_ftrwrite)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
- if (cando(S_IWUSR, 0, &statcache))
+ if (cando(S_IWUSR, 0, &PL_statcache))
RETPUSHYES;
RETPUSHNO;
}
@@ -2161,10 +2266,10 @@ PP(pp_ftrwrite)
PP(pp_ftrexec)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
- if (cando(S_IXUSR, 0, &statcache))
+ if (cando(S_IXUSR, 0, &PL_statcache))
RETPUSHYES;
RETPUSHNO;
}
@@ -2172,10 +2277,10 @@ PP(pp_ftrexec)
PP(pp_fteread)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
- if (cando(S_IRUSR, 1, &statcache))
+ if (cando(S_IRUSR, 1, &PL_statcache))
RETPUSHYES;
RETPUSHNO;
}
@@ -2183,10 +2288,10 @@ PP(pp_fteread)
PP(pp_ftewrite)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
- if (cando(S_IWUSR, 1, &statcache))
+ if (cando(S_IWUSR, 1, &PL_statcache))
RETPUSHYES;
RETPUSHNO;
}
@@ -2194,10 +2299,10 @@ PP(pp_ftewrite)
PP(pp_fteexec)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
- if (cando(S_IXUSR, 1, &statcache))
+ if (cando(S_IXUSR, 1, &PL_statcache))
RETPUSHYES;
RETPUSHNO;
}
@@ -2205,7 +2310,7 @@ PP(pp_fteexec)
PP(pp_ftis)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
RETPUSHYES;
@@ -2219,10 +2324,10 @@ PP(pp_fteowned)
PP(pp_ftrowned)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
- if (statcache.st_uid == (op->op_type == OP_FTEOWNED ? euid : uid) )
+ if (PL_statcache.st_uid == (PL_op->op_type == OP_FTEOWNED ? PL_euid : PL_uid) )
RETPUSHYES;
RETPUSHNO;
}
@@ -2230,10 +2335,10 @@ PP(pp_ftrowned)
PP(pp_ftzero)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
- if (!statcache.st_size)
+ if (!PL_statcache.st_size)
RETPUSHYES;
RETPUSHNO;
}
@@ -2241,50 +2346,50 @@ PP(pp_ftzero)
PP(pp_ftsize)
{
I32 result = my_stat(ARGS);
- dSP; dTARGET;
+ djSP; dTARGET;
if (result < 0)
RETPUSHUNDEF;
- PUSHi(statcache.st_size);
+ PUSHi(PL_statcache.st_size);
RETURN;
}
PP(pp_ftmtime)
{
I32 result = my_stat(ARGS);
- dSP; dTARGET;
+ djSP; dTARGET;
if (result < 0)
RETPUSHUNDEF;
- PUSHn( ((I32)basetime - (I32)statcache.st_mtime) / 86400.0 );
+ PUSHn( ((I32)PL_basetime - (I32)PL_statcache.st_mtime) / 86400.0 );
RETURN;
}
PP(pp_ftatime)
{
I32 result = my_stat(ARGS);
- dSP; dTARGET;
+ djSP; dTARGET;
if (result < 0)
RETPUSHUNDEF;
- PUSHn( ((I32)basetime - (I32)statcache.st_atime) / 86400.0 );
+ PUSHn( ((I32)PL_basetime - (I32)PL_statcache.st_atime) / 86400.0 );
RETURN;
}
PP(pp_ftctime)
{
I32 result = my_stat(ARGS);
- dSP; dTARGET;
+ djSP; dTARGET;
if (result < 0)
RETPUSHUNDEF;
- PUSHn( ((I32)basetime - (I32)statcache.st_ctime) / 86400.0 );
+ PUSHn( ((I32)PL_basetime - (I32)PL_statcache.st_ctime) / 86400.0 );
RETURN;
}
PP(pp_ftsock)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
- if (S_ISSOCK(statcache.st_mode))
+ if (S_ISSOCK(PL_statcache.st_mode))
RETPUSHYES;
RETPUSHNO;
}
@@ -2292,10 +2397,10 @@ PP(pp_ftsock)
PP(pp_ftchr)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
- if (S_ISCHR(statcache.st_mode))
+ if (S_ISCHR(PL_statcache.st_mode))
RETPUSHYES;
RETPUSHNO;
}
@@ -2303,10 +2408,10 @@ PP(pp_ftchr)
PP(pp_ftblk)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
- if (S_ISBLK(statcache.st_mode))
+ if (S_ISBLK(PL_statcache.st_mode))
RETPUSHYES;
RETPUSHNO;
}
@@ -2314,10 +2419,10 @@ PP(pp_ftblk)
PP(pp_ftfile)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
- if (S_ISREG(statcache.st_mode))
+ if (S_ISREG(PL_statcache.st_mode))
RETPUSHYES;
RETPUSHNO;
}
@@ -2325,10 +2430,10 @@ PP(pp_ftfile)
PP(pp_ftdir)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
- if (S_ISDIR(statcache.st_mode))
+ if (S_ISDIR(PL_statcache.st_mode))
RETPUSHYES;
RETPUSHNO;
}
@@ -2336,10 +2441,10 @@ PP(pp_ftdir)
PP(pp_ftpipe)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
- if (S_ISFIFO(statcache.st_mode))
+ if (S_ISFIFO(PL_statcache.st_mode))
RETPUSHYES;
RETPUSHNO;
}
@@ -2347,23 +2452,23 @@ PP(pp_ftpipe)
PP(pp_ftlink)
{
I32 result = my_lstat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
- if (S_ISLNK(statcache.st_mode))
+ if (S_ISLNK(PL_statcache.st_mode))
RETPUSHYES;
RETPUSHNO;
}
PP(pp_ftsuid)
{
- dSP;
+ djSP;
#ifdef S_ISUID
I32 result = my_stat(ARGS);
SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
- if (statcache.st_mode & S_ISUID)
+ if (PL_statcache.st_mode & S_ISUID)
RETPUSHYES;
#endif
RETPUSHNO;
@@ -2371,13 +2476,13 @@ PP(pp_ftsuid)
PP(pp_ftsgid)
{
- dSP;
+ djSP;
#ifdef S_ISGID
I32 result = my_stat(ARGS);
SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
- if (statcache.st_mode & S_ISGID)
+ if (PL_statcache.st_mode & S_ISGID)
RETPUSHYES;
#endif
RETPUSHNO;
@@ -2385,13 +2490,13 @@ PP(pp_ftsgid)
PP(pp_ftsvtx)
{
- dSP;
+ djSP;
#ifdef S_ISVTX
I32 result = my_stat(ARGS);
SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
- if (statcache.st_mode & S_ISVTX)
+ if (PL_statcache.st_mode & S_ISVTX)
RETPUSHYES;
#endif
RETPUSHNO;
@@ -2399,19 +2504,20 @@ PP(pp_ftsvtx)
PP(pp_fttty)
{
- dSP;
+ djSP;
int fd;
GV *gv;
char *tmps = Nullch;
+ STRLEN n_a;
- if (op->op_flags & OPf_REF)
+ if (PL_op->op_flags & OPf_REF)
gv = cGVOP->op_gv;
else if (isGV(TOPs))
gv = (GV*)POPs;
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
gv = (GV*)SvRV(POPs);
else
- gv = gv_fetchpv(tmps = POPp, FALSE, SVt_PVIO);
+ gv = gv_fetchpv(tmps = POPpx, FALSE, SVt_PVIO);
if (GvIO(gv) && IoIFP(GvIOp(gv)))
fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
@@ -2419,7 +2525,7 @@ PP(pp_fttty)
fd = atoi(tmps);
else
RETPUSHUNDEF;
- if (isatty(fd))
+ if (PerlLIO_isatty(fd))
RETPUSHYES;
RETPUSHNO;
}
@@ -2434,7 +2540,7 @@ PP(pp_fttty)
PP(pp_fttext)
{
- dSP;
+ djSP;
I32 i;
I32 len;
I32 odd = 0;
@@ -2443,8 +2549,9 @@ PP(pp_fttext)
register IO *io;
register SV *sv;
GV *gv;
+ STRLEN n_a;
- if (op->op_flags & OPf_REF)
+ if (PL_op->op_flags & OPf_REF)
gv = cGVOP->op_gv;
else if (isGV(TOPs))
gv = (GV*)POPs;
@@ -2455,28 +2562,28 @@ PP(pp_fttext)
if (gv) {
EXTEND(SP, 1);
- if (gv == defgv) {
- if (statgv)
- io = GvIO(statgv);
+ if (gv == PL_defgv) {
+ if (PL_statgv)
+ io = GvIO(PL_statgv);
else {
- sv = statname;
+ sv = PL_statname;
goto really_filename;
}
}
else {
- statgv = gv;
- laststatval = -1;
- sv_setpv(statname, "");
- io = GvIO(statgv);
+ PL_statgv = gv;
+ PL_laststatval = -1;
+ sv_setpv(PL_statname, "");
+ io = GvIO(PL_statgv);
}
if (io && IoIFP(io)) {
if (! PerlIO_has_base(IoIFP(io)))
DIE("-T and -B not implemented on filehandles");
- laststatval = Fstat(PerlIO_fileno(IoIFP(io)), &statcache);
- if (laststatval < 0)
+ PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache);
+ if (PL_laststatval < 0)
RETPUSHUNDEF;
- if (S_ISDIR(statcache.st_mode)) /* handle NFS glitch */
- if (op->op_type == OP_FTTEXT)
+ if (S_ISDIR(PL_statcache.st_mode)) /* handle NFS glitch */
+ if (PL_op->op_type == OP_FTTEXT)
RETPUSHNO;
else
RETPUSHYES;
@@ -2494,7 +2601,7 @@ PP(pp_fttext)
len = 512;
}
else {
- if (dowarn)
+ if (PL_dowarn)
warn("Test on unopened file <%s>",
GvENAME(cGVOP->op_gv));
SETERRNO(EBADF,RMS$_IFI);
@@ -2504,26 +2611,26 @@ PP(pp_fttext)
else {
sv = POPs;
really_filename:
- statgv = Nullgv;
- laststatval = -1;
- sv_setpv(statname, SvPV(sv, na));
+ PL_statgv = Nullgv;
+ PL_laststatval = -1;
+ sv_setpv(PL_statname, SvPV(sv, n_a));
#ifdef HAS_OPEN3
- i = open(SvPV(sv, na), O_RDONLY, 0);
+ i = PerlLIO_open3(SvPV(sv, n_a), O_RDONLY, 0);
#else
- i = open(SvPV(sv, na), 0);
+ i = PerlLIO_open(SvPV(sv, n_a), 0);
#endif
if (i < 0) {
- if (dowarn && strchr(SvPV(sv, na), '\n'))
+ if (PL_dowarn && strchr(SvPV(sv, n_a), '\n'))
warn(warn_nl, "open");
RETPUSHUNDEF;
}
- laststatval = Fstat(i, &statcache);
- if (laststatval < 0)
+ PL_laststatval = PerlLIO_fstat(i, &PL_statcache);
+ if (PL_laststatval < 0)
RETPUSHUNDEF;
- len = read(i, tbuf, 512);
- (void)close(i);
+ len = PerlLIO_read(i, tbuf, 512);
+ (void)PerlLIO_close(i);
if (len <= 0) {
- if (S_ISDIR(statcache.st_mode) && op->op_type == OP_FTTEXT)
+ if (S_ISDIR(PL_statcache.st_mode) && PL_op->op_type == OP_FTTEXT)
RETPUSHNO; /* special case NFS directories */
RETPUSHYES; /* null file is anything */
}
@@ -2538,15 +2645,20 @@ PP(pp_fttext)
odd += len;
break;
}
+#ifdef EBCDIC
+ else if (!(isPRINT(*s) || isSPACE(*s)))
+ odd++;
+#else
else if (*s & 128)
odd++;
else if (*s < 32 &&
*s != '\n' && *s != '\r' && *s != '\b' &&
*s != '\t' && *s != '\f' && *s != 27)
odd++;
+#endif
}
- if ((odd * 3 > len) == (op->op_type == OP_FTTEXT)) /* allow 1/3 odd */
+ if ((odd * 3 > len) == (PL_op->op_type == OP_FTTEXT)) /* allow 1/3 odd */
RETPUSHNO;
else
RETPUSHYES;
@@ -2561,40 +2673,48 @@ PP(pp_ftbinary)
PP(pp_chdir)
{
- dSP; dTARGET;
+ djSP; dTARGET;
char *tmps;
SV **svp;
+ STRLEN n_a;
if (MAXARG < 1)
tmps = Nullch;
else
- tmps = POPp;
+ tmps = POPpx;
if (!tmps || !*tmps) {
- svp = hv_fetch(GvHVn(envgv), "HOME", 4, FALSE);
+ svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE);
if (svp)
- tmps = SvPV(*svp, na);
+ tmps = SvPV(*svp, n_a);
}
if (!tmps || !*tmps) {
- svp = hv_fetch(GvHVn(envgv), "LOGDIR", 6, FALSE);
+ svp = hv_fetch(GvHVn(PL_envgv), "LOGDIR", 6, FALSE);
if (svp)
- tmps = SvPV(*svp, na);
+ tmps = SvPV(*svp, n_a);
}
+#ifdef VMS
+ if (!tmps || !*tmps) {
+ svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE);
+ if (svp)
+ tmps = SvPV(*svp, n_a);
+ }
+#endif
TAINT_PROPER("chdir");
- PUSHi( chdir(tmps) >= 0 );
+ PUSHi( PerlDir_chdir(tmps) >= 0 );
#ifdef VMS
/* Clear the DEFAULT element of ENV so we'll get the new value
* in the future. */
- hv_delete(GvHVn(envgv),"DEFAULT",7,G_DISCARD);
+ hv_delete(GvHVn(PL_envgv),"DEFAULT",7,G_DISCARD);
#endif
RETURN;
}
PP(pp_chown)
{
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
I32 value;
#ifdef HAS_CHOWN
- value = (I32)apply(op->op_type, MARK, SP);
+ value = (I32)apply(PL_op->op_type, MARK, SP);
SP = MARK;
PUSHi(value);
RETURN;
@@ -2605,10 +2725,11 @@ PP(pp_chown)
PP(pp_chroot)
{
- dSP; dTARGET;
+ djSP; dTARGET;
char *tmps;
+ STRLEN n_a;
#ifdef HAS_CHROOT
- tmps = POPp;
+ tmps = POPpx;
TAINT_PROPER("chroot");
PUSHi( chroot(tmps) >= 0 );
RETURN;
@@ -2619,9 +2740,9 @@ PP(pp_chroot)
PP(pp_unlink)
{
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
I32 value;
- value = (I32)apply(op->op_type, MARK, SP);
+ value = (I32)apply(PL_op->op_type, MARK, SP);
SP = MARK;
PUSHi(value);
RETURN;
@@ -2629,9 +2750,9 @@ PP(pp_unlink)
PP(pp_chmod)
{
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
I32 value;
- value = (I32)apply(op->op_type, MARK, SP);
+ value = (I32)apply(PL_op->op_type, MARK, SP);
SP = MARK;
PUSHi(value);
RETURN;
@@ -2639,9 +2760,9 @@ PP(pp_chmod)
PP(pp_utime)
{
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
I32 value;
- value = (I32)apply(op->op_type, MARK, SP);
+ value = (I32)apply(PL_op->op_type, MARK, SP);
SP = MARK;
PUSHi(value);
RETURN;
@@ -2649,20 +2770,21 @@ PP(pp_utime)
PP(pp_rename)
{
- dSP; dTARGET;
+ djSP; dTARGET;
int anum;
+ STRLEN n_a;
- char *tmps2 = POPp;
- char *tmps = SvPV(TOPs, na);
+ char *tmps2 = POPpx;
+ char *tmps = SvPV(TOPs, n_a);
TAINT_PROPER("rename");
#ifdef HAS_RENAME
- anum = rename(tmps, tmps2);
+ anum = PerlLIO_rename(tmps, tmps2);
#else
- if (!(anum = Stat(tmps, &statbuf))) {
+ if (!(anum = PerlLIO_stat(tmps, &PL_statbuf))) {
if (same_dirent(tmps2, tmps)) /* can always rename to same name */
anum = 1;
else {
- if (euid || Stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
+ if (PL_euid || PerlLIO_stat(tmps2, &PL_statbuf) < 0 || !S_ISDIR(PL_statbuf.st_mode))
(void)UNLINK(tmps2);
if (!(anum = link(tmps, tmps2)))
anum = UNLINK(tmps);
@@ -2675,10 +2797,11 @@ PP(pp_rename)
PP(pp_link)
{
- dSP; dTARGET;
+ djSP; dTARGET;
#ifdef HAS_LINK
- char *tmps2 = POPp;
- char *tmps = SvPV(TOPs, na);
+ STRLEN n_a;
+ char *tmps2 = POPpx;
+ char *tmps = SvPV(TOPs, n_a);
TAINT_PROPER("link");
SETi( link(tmps, tmps2) >= 0 );
#else
@@ -2689,10 +2812,11 @@ PP(pp_link)
PP(pp_symlink)
{
- dSP; dTARGET;
+ djSP; dTARGET;
#ifdef HAS_SYMLINK
- char *tmps2 = POPp;
- char *tmps = SvPV(TOPs, na);
+ STRLEN n_a;
+ char *tmps2 = POPpx;
+ char *tmps = SvPV(TOPs, n_a);
TAINT_PROPER("symlink");
SETi( symlink(tmps, tmps2) >= 0 );
RETURN;
@@ -2703,16 +2827,17 @@ PP(pp_symlink)
PP(pp_readlink)
{
- dSP; dTARGET;
+ djSP; dTARGET;
#ifdef HAS_SYMLINK
char *tmps;
char buf[MAXPATHLEN];
int len;
+ STRLEN n_a;
#ifndef INCOMPLETE_TAINTS
TAINT;
#endif
- tmps = POPp;
+ tmps = POPpx;
len = readlink(tmps, buf, sizeof buf);
EXTEND(SP, 1);
if (len < 0)
@@ -2745,14 +2870,14 @@ char *filename;
*s++ = *filename++;
}
strcpy(s, " 2>&1");
- myfp = my_popen(cmdline, "r");
+ myfp = PerlProc_popen(cmdline, "r");
Safefree(cmdline);
if (myfp) {
SV *tmpsv = sv_newmortal();
- /* Need to save/restore 'rs' ?? */
+ /* Need to save/restore 'PL_rs' ?? */
s = sv_gets(tmpsv, myfp, 0);
- (void)my_pclose(myfp);
+ (void)PerlProc_pclose(myfp);
if (s != Nullch) {
int e;
for (e = 1;
@@ -2799,8 +2924,8 @@ char *filename;
return 0;
}
else { /* some mkdirs return no failure indication */
- anum = (Stat(save_filename, &statbuf) >= 0);
- if (op->op_type == OP_RMDIR)
+ anum = (PerlLIO_stat(save_filename, &PL_statbuf) >= 0);
+ if (PL_op->op_type == OP_RMDIR)
anum = !anum;
if (anum)
SETERRNO(0,0);
@@ -2816,34 +2941,36 @@ char *filename;
PP(pp_mkdir)
{
- dSP; dTARGET;
+ djSP; dTARGET;
int mode = POPi;
#ifndef HAS_MKDIR
int oldumask;
#endif
- char *tmps = SvPV(TOPs, na);
+ STRLEN n_a;
+ char *tmps = SvPV(TOPs, n_a);
TAINT_PROPER("mkdir");
#ifdef HAS_MKDIR
- SETi( Mkdir(tmps, mode) >= 0 );
+ SETi( PerlDir_mkdir(tmps, mode) >= 0 );
#else
SETi( dooneliner("mkdir", tmps) );
- oldumask = umask(0);
- umask(oldumask);
- chmod(tmps, (mode & ~oldumask) & 0777);
+ oldumask = PerlLIO_umask(0);
+ PerlLIO_umask(oldumask);
+ PerlLIO_chmod(tmps, (mode & ~oldumask) & 0777);
#endif
RETURN;
}
PP(pp_rmdir)
{
- dSP; dTARGET;
+ djSP; dTARGET;
char *tmps;
+ STRLEN n_a;
- tmps = POPp;
+ tmps = POPpx;
TAINT_PROPER("rmdir");
#ifdef HAS_RMDIR
- XPUSHi( rmdir(tmps) >= 0 );
+ XPUSHi( PerlDir_rmdir(tmps) >= 0 );
#else
XPUSHi( dooneliner("rmdir", tmps) );
#endif
@@ -2854,9 +2981,10 @@ PP(pp_rmdir)
PP(pp_open_dir)
{
- dSP;
+ djSP;
#if defined(Direntry_t) && defined(HAS_READDIR)
- char *dirname = POPp;
+ STRLEN n_a;
+ char *dirname = POPpx;
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
@@ -2864,8 +2992,8 @@ PP(pp_open_dir)
goto nope;
if (IoDIRP(io))
- closedir(IoDIRP(io));
- if (!(IoDIRP(io) = opendir(dirname)))
+ PerlDir_close(IoDIRP(io));
+ if (!(IoDIRP(io) = PerlDir_open(dirname)))
goto nope;
RETPUSHYES;
@@ -2880,7 +3008,7 @@ nope:
PP(pp_readdir)
{
- dSP;
+ djSP;
#if defined(Direntry_t) && defined(HAS_READDIR)
#ifndef I_DIRENT
Direntry_t *readdir _((DIR *));
@@ -2895,7 +3023,7 @@ PP(pp_readdir)
if (GIMME == G_ARRAY) {
/*SUPPRESS 560*/
- while (dp = (Direntry_t *)readdir(IoDIRP(io))) {
+ while (dp = (Direntry_t *)PerlDir_read(IoDIRP(io))) {
#ifdef DIRNAMLEN
sv = newSVpv(dp->d_name, dp->d_namlen);
#else
@@ -2908,7 +3036,7 @@ PP(pp_readdir)
}
}
else {
- if (!(dp = (Direntry_t *)readdir(IoDIRP(io))))
+ if (!(dp = (Direntry_t *)PerlDir_read(IoDIRP(io))))
goto nope;
#ifdef DIRNAMLEN
sv = newSVpv(dp->d_name, dp->d_namlen);
@@ -2936,18 +3064,18 @@ nope:
PP(pp_telldir)
{
- dSP; dTARGET;
+ djSP; dTARGET;
#if defined(HAS_TELLDIR) || defined(telldir)
-#if !defined(telldir) && !defined(HAS_TELLDIR_PROTOTYPE)
+# ifdef NEED_TELLDIR_PROTO /* XXX does _anyone_ need this? --AD 2/20/1998 */
long telldir _((DIR *));
-#endif
+# endif
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
if (!io || !IoDIRP(io))
goto nope;
- PUSHi( telldir(IoDIRP(io)) );
+ PUSHi( PerlDir_tell(IoDIRP(io)) );
RETURN;
nope:
if (!errno)
@@ -2960,7 +3088,7 @@ nope:
PP(pp_seekdir)
{
- dSP;
+ djSP;
#if defined(HAS_SEEKDIR) || defined(seekdir)
long along = POPl;
GV *gv = (GV*)POPs;
@@ -2969,7 +3097,7 @@ PP(pp_seekdir)
if (!io || !IoDIRP(io))
goto nope;
- (void)seekdir(IoDIRP(io), along);
+ (void)PerlDir_seek(IoDIRP(io), along);
RETPUSHYES;
nope:
@@ -2983,7 +3111,7 @@ nope:
PP(pp_rewinddir)
{
- dSP;
+ djSP;
#if defined(HAS_REWINDDIR) || defined(rewinddir)
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
@@ -2991,7 +3119,7 @@ PP(pp_rewinddir)
if (!io || !IoDIRP(io))
goto nope;
- (void)rewinddir(IoDIRP(io));
+ (void)PerlDir_rewind(IoDIRP(io));
RETPUSHYES;
nope:
if (!errno)
@@ -3004,7 +3132,7 @@ nope:
PP(pp_closedir)
{
- dSP;
+ djSP;
#if defined(Direntry_t) && defined(HAS_READDIR)
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
@@ -3013,9 +3141,9 @@ PP(pp_closedir)
goto nope;
#ifdef VOID_CLOSEDIR
- closedir(IoDIRP(io));
+ PerlDir_close(IoDIRP(io));
#else
- if (closedir(IoDIRP(io)) < 0) {
+ if (PerlDir_close(IoDIRP(io)) < 0) {
IoDIRP(io) = 0; /* Don't try to close again--coredumps on SysV */
goto nope;
}
@@ -3037,7 +3165,7 @@ nope:
PP(pp_fork)
{
#ifdef HAS_FORK
- dSP; dTARGET;
+ djSP; dTARGET;
int childpid;
GV *tmpgv;
@@ -3049,7 +3177,7 @@ PP(pp_fork)
/*SUPPRESS 560*/
if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
sv_setiv(GvSV(tmpgv), (IV)getpid());
- hv_clear(pidstatus); /* no kids, so don't wait for 'em */
+ hv_clear(PL_pidstatus); /* no kids, so don't wait for 'em */
}
PUSHi(childpid);
RETURN;
@@ -3060,8 +3188,8 @@ PP(pp_fork)
PP(pp_wait)
{
-#if !defined(DOSISH) || defined(OS2)
- dSP; dTARGET;
+#if !defined(DOSISH) || defined(OS2) || defined(WIN32)
+ djSP; dTARGET;
int childpid;
int argflags;
@@ -3076,8 +3204,8 @@ PP(pp_wait)
PP(pp_waitpid)
{
-#if !defined(DOSISH) || defined(OS2)
- dSP; dTARGET;
+#if !defined(DOSISH) || defined(OS2) || defined(WIN32)
+ djSP; dTARGET;
int childpid;
int optype;
int argflags;
@@ -3089,22 +3217,23 @@ PP(pp_waitpid)
SETi(childpid);
RETURN;
#else
- DIE(no_func, "Unsupported function wait");
+ DIE(no_func, "Unsupported function waitpid");
#endif
}
PP(pp_system)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
I32 value;
int childpid;
int result;
int status;
Sigsave_t ihand,qhand; /* place to save signals during system() */
+ STRLEN n_a;
if (SP - MARK == 1) {
- if (tainting) {
- char *junk = SvPV(TOPs, na);
+ if (PL_tainting) {
+ char *junk = SvPV(TOPs, n_a);
TAINT_ENV();
TAINT_PROPER("system");
}
@@ -3133,25 +3262,25 @@ PP(pp_system)
PUSHi(STATUS_CURRENT);
RETURN;
}
- if (op->op_flags & OPf_STACKED) {
+ if (PL_op->op_flags & OPf_STACKED) {
SV *really = *++MARK;
value = (I32)do_aexec(really, MARK, SP);
}
else if (SP - MARK != 1)
value = (I32)do_aexec(Nullsv, MARK, SP);
else {
- value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
+ value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
}
- _exit(-1);
+ PerlProc__exit(-1);
#else /* ! FORK or VMS or OS/2 */
- if (op->op_flags & OPf_STACKED) {
+ if (PL_op->op_flags & OPf_STACKED) {
SV *really = *++MARK;
- value = (I32)do_aspawn(really, MARK, SP);
+ value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
}
else if (SP - MARK != 1)
- value = (I32)do_aspawn(Nullsv, MARK, SP);
+ value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
else {
- value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), na));
+ value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
}
STATUS_NATIVE_SET(value);
do_execfree();
@@ -3163,10 +3292,11 @@ PP(pp_system)
PP(pp_exec)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
I32 value;
+ STRLEN n_a;
- if (op->op_flags & OPf_STACKED) {
+ if (PL_op->op_flags & OPf_STACKED) {
SV *really = *++MARK;
value = (I32)do_aexec(really, MARK, SP);
}
@@ -3177,15 +3307,15 @@ PP(pp_exec)
value = (I32)do_aexec(Nullsv, MARK, SP);
#endif
else {
- if (tainting) {
- char *junk = SvPV(*SP, na);
+ if (PL_tainting) {
+ char *junk = SvPV(*SP, n_a);
TAINT_ENV();
TAINT_PROPER("exec");
}
#ifdef VMS
- value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), na));
+ value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
#else
- value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
+ value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
#endif
}
SP = ORIGMARK;
@@ -3195,10 +3325,10 @@ PP(pp_exec)
PP(pp_kill)
{
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
I32 value;
#ifdef HAS_KILL
- value = (I32)apply(op->op_type, MARK, SP);
+ value = (I32)apply(PL_op->op_type, MARK, SP);
SP = MARK;
PUSHi(value);
RETURN;
@@ -3210,7 +3340,7 @@ PP(pp_kill)
PP(pp_getppid)
{
#ifdef HAS_GETPPID
- dSP; dTARGET;
+ djSP; dTARGET;
XPUSHi( getppid() );
RETURN;
#else
@@ -3221,7 +3351,7 @@ PP(pp_getppid)
PP(pp_getpgrp)
{
#ifdef HAS_GETPGRP
- dSP; dTARGET;
+ djSP; dTARGET;
int pid;
I32 value;
@@ -3246,7 +3376,7 @@ PP(pp_getpgrp)
PP(pp_setpgrp)
{
#ifdef HAS_SETPGRP
- dSP; dTARGET;
+ djSP; dTARGET;
int pgrp;
int pid;
if (MAXARG < 2) {
@@ -3274,7 +3404,7 @@ PP(pp_setpgrp)
PP(pp_getpriority)
{
- dSP; dTARGET;
+ djSP; dTARGET;
int which;
int who;
#ifdef HAS_GETPRIORITY
@@ -3289,7 +3419,7 @@ PP(pp_getpriority)
PP(pp_setpriority)
{
- dSP; dTARGET;
+ djSP; dTARGET;
int which;
int who;
int niceval;
@@ -3309,7 +3439,7 @@ PP(pp_setpriority)
PP(pp_time)
{
- dSP; dTARGET;
+ djSP; dTARGET;
#ifdef BIG_TIME
XPUSHn( time(Null(Time_t*)) );
#else
@@ -3336,7 +3466,7 @@ PP(pp_time)
PP(pp_tms)
{
- dSP;
+ djSP;
#ifndef HAS_TIMES
DIE("times not implemented");
@@ -3344,18 +3474,18 @@ PP(pp_tms)
EXTEND(SP, 4);
#ifndef VMS
- (void)times(&timesbuf);
+ (void)PerlProc_times(&PL_timesbuf);
#else
- (void)times((tbuffer_t *)&timesbuf); /* time.h uses different name for */
- /* struct tms, though same data */
- /* is returned. */
+ (void)PerlProc_times((tbuffer_t *)&PL_timesbuf); /* time.h uses different name for */
+ /* struct tms, though same data */
+ /* is returned. */
#endif
- PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_utime)/HZ)));
+ PUSHs(sv_2mortal(newSVnv(((double)PL_timesbuf.tms_utime)/HZ)));
if (GIMME == G_ARRAY) {
- PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_stime)/HZ)));
- PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cutime)/HZ)));
- PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cstime)/HZ)));
+ PUSHs(sv_2mortal(newSVnv(((double)PL_timesbuf.tms_stime)/HZ)));
+ PUSHs(sv_2mortal(newSVnv(((double)PL_timesbuf.tms_cutime)/HZ)));
+ PUSHs(sv_2mortal(newSVnv(((double)PL_timesbuf.tms_cstime)/HZ)));
}
RETURN;
#endif /* HAS_TIMES */
@@ -3368,7 +3498,7 @@ PP(pp_localtime)
PP(pp_gmtime)
{
- dSP;
+ djSP;
Time_t when;
struct tm *tmbuf;
static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
@@ -3384,7 +3514,7 @@ PP(pp_gmtime)
when = (Time_t)SvIVx(POPs);
#endif
- if (op->op_type == OP_LOCALTIME)
+ if (PL_op->op_type == OP_LOCALTIME)
tmbuf = localtime(&when);
else
tmbuf = gmtime(&when);
@@ -3422,7 +3552,7 @@ PP(pp_gmtime)
PP(pp_alarm)
{
- dSP; dTARGET;
+ djSP; dTARGET;
int anum;
#ifdef HAS_ALARM
anum = POPi;
@@ -3439,17 +3569,17 @@ PP(pp_alarm)
PP(pp_sleep)
{
- dSP; dTARGET;
+ djSP; dTARGET;
I32 duration;
Time_t lasttime;
Time_t when;
(void)time(&lasttime);
if (MAXARG < 1)
- Pause();
+ PerlProc_pause();
else {
duration = POPi;
- sleep((unsigned int)duration);
+ PerlProc_sleep((unsigned int)duration);
}
(void)time(&when);
XPUSHi(when - lasttime);
@@ -3476,8 +3606,8 @@ PP(pp_shmread)
PP(pp_shmwrite)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dSP; dMARK; dTARGET;
- I32 value = (I32)(do_shmio(op->op_type, MARK, SP) >= 0);
+ djSP; dMARK; dTARGET;
+ I32 value = (I32)(do_shmio(PL_op->op_type, MARK, SP) >= 0);
SP = MARK;
PUSHi(value);
RETURN;
@@ -3501,7 +3631,7 @@ PP(pp_msgctl)
PP(pp_msgsnd)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
I32 value = (I32)(do_msgsnd(MARK, SP) >= 0);
SP = MARK;
PUSHi(value);
@@ -3514,7 +3644,7 @@ PP(pp_msgsnd)
PP(pp_msgrcv)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
I32 value = (I32)(do_msgrcv(MARK, SP) >= 0);
SP = MARK;
PUSHi(value);
@@ -3529,8 +3659,8 @@ PP(pp_msgrcv)
PP(pp_semget)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dSP; dMARK; dTARGET;
- int anum = do_ipcget(op->op_type, MARK, SP);
+ djSP; dMARK; dTARGET;
+ int anum = do_ipcget(PL_op->op_type, MARK, SP);
SP = MARK;
if (anum == -1)
RETPUSHUNDEF;
@@ -3544,8 +3674,8 @@ PP(pp_semget)
PP(pp_semctl)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dSP; dMARK; dTARGET;
- int anum = do_ipcctl(op->op_type, MARK, SP);
+ djSP; dMARK; dTARGET;
+ int anum = do_ipcctl(PL_op->op_type, MARK, SP);
SP = MARK;
if (anum == -1)
RETSETUNDEF;
@@ -3564,7 +3694,7 @@ PP(pp_semctl)
PP(pp_semop)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
I32 value = (I32)(do_semop(MARK, SP) >= 0);
SP = MARK;
PUSHi(value);
@@ -3578,7 +3708,7 @@ PP(pp_semop)
PP(pp_ghbyname)
{
-#ifdef HAS_SOCKET
+#ifdef HAS_GETHOSTBYNAME
return pp_ghostent(ARGS);
#else
DIE(no_sock_func, "gethostbyname");
@@ -3587,7 +3717,7 @@ PP(pp_ghbyname)
PP(pp_ghbyaddr)
{
-#ifdef HAS_SOCKET
+#ifdef HAS_GETHOSTBYADDR
return pp_ghostent(ARGS);
#else
DIE(no_sock_func, "gethostbyaddr");
@@ -3596,36 +3726,45 @@ PP(pp_ghbyaddr)
PP(pp_ghostent)
{
- dSP;
-#ifdef HAS_SOCKET
- I32 which = op->op_type;
+ djSP;
+#if defined(HAS_GETHOSTBYNAME) || defined(HAS_GETHOSTBYADDR) || defined(HAS_GETHOSTENT)
+ I32 which = PL_op->op_type;
register char **elem;
register SV *sv;
- struct hostent *gethostbyname();
- struct hostent *gethostbyaddr();
-#ifdef HAS_GETHOSTENT
- struct hostent *gethostent();
+#ifndef HAS_GETHOST_PROTOS /* XXX Do we need individual probes? */
+ struct hostent *PerlSock_gethostbyaddr(Netdb_host_t, Netdb_hlen_t, int);
+ struct hostent *PerlSock_gethostbyname(Netdb_name_t);
+ struct hostent *PerlSock_gethostent(void);
#endif
struct hostent *hent;
unsigned long len;
EXTEND(SP, 10);
if (which == OP_GHBYNAME) {
- hent = gethostbyname(POPp);
+#ifdef HAS_GETHOSTBYNAME
+ STRLEN n_a;
+ hent = PerlSock_gethostbyname(POPpx);
+#else
+ DIE(no_sock_func, "gethostbyname");
+#endif
}
else if (which == OP_GHBYADDR) {
+#ifdef HAS_GETHOSTBYADDR
int addrtype = POPi;
SV *addrsv = POPs;
STRLEN addrlen;
- char *addr = SvPV(addrsv, addrlen);
+ Netdb_host_t addr = (Netdb_host_t) SvPV(addrsv, addrlen);
- hent = gethostbyaddr(addr, addrlen, addrtype);
+ hent = PerlSock_gethostbyaddr(addr, (Netdb_hlen_t) addrlen, addrtype);
+#else
+ DIE(no_sock_func, "gethostbyaddr");
+#endif
}
else
#ifdef HAS_GETHOSTENT
- hent = gethostent();
+ hent = PerlSock_gethostent();
#else
- DIE("gethostent not implemented");
+ DIE(no_sock_func, "gethostent");
#endif
#ifdef HOST_NOT_FOUND
@@ -3647,26 +3786,26 @@ PP(pp_ghostent)
}
if (hent) {
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setpv(sv, (char*)hent->h_name);
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
for (elem = hent->h_aliases; elem && *elem; elem++) {
sv_catpv(sv, *elem);
if (elem[1])
sv_catpvn(sv, " ", 1);
}
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setiv(sv, (IV)hent->h_addrtype);
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
len = hent->h_length;
sv_setiv(sv, (IV)len);
#ifdef h_addr
for (elem = hent->h_addr_list; elem && *elem; elem++) {
- XPUSHs(sv = sv_mortalcopy(&sv_no));
+ XPUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setpvn(sv, *elem, len);
}
#else
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
if (hent->h_addr)
sv_setpvn(sv, hent->h_addr, len);
#endif /* h_addr */
@@ -3679,7 +3818,7 @@ PP(pp_ghostent)
PP(pp_gnbyname)
{
-#ifdef HAS_SOCKET
+#ifdef HAS_GETNETBYNAME
return pp_gnetent(ARGS);
#else
DIE(no_sock_func, "getnetbyname");
@@ -3688,7 +3827,7 @@ PP(pp_gnbyname)
PP(pp_gnbyaddr)
{
-#ifdef HAS_SOCKET
+#ifdef HAS_GETNETBYADDR
return pp_gnetent(ARGS);
#else
DIE(no_sock_func, "getnetbyaddr");
@@ -3697,25 +3836,41 @@ PP(pp_gnbyaddr)
PP(pp_gnetent)
{
- dSP;
-#ifdef HAS_SOCKET
- I32 which = op->op_type;
+ djSP;
+#if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT)
+ I32 which = PL_op->op_type;
register char **elem;
register SV *sv;
- struct netent *getnetbyname();
- struct netent *getnetbyaddr();
- struct netent *getnetent();
+#ifndef HAS_GETNET_PROTOS /* XXX Do we need individual probes? */
+ struct netent *PerlSock_getnetbyaddr(Netdb_net_t, int);
+ struct netent *PerlSock_getnetbyname(Netdb_name_t);
+ struct netent *PerlSock_getnetent(void);
+#endif
struct netent *nent;
- if (which == OP_GNBYNAME)
- nent = getnetbyname(POPp);
+ if (which == OP_GNBYNAME) {
+#ifdef HAS_GETNETBYNAME
+ STRLEN n_a;
+ nent = PerlSock_getnetbyname(POPpx);
+#else
+ DIE(no_sock_func, "getnetbyname");
+#endif
+ }
else if (which == OP_GNBYADDR) {
+#ifdef HAS_GETNETBYADDR
int addrtype = POPi;
- unsigned long addr = U_L(POPn);
- nent = getnetbyaddr((long)addr, addrtype);
+ Netdb_net_t addr = (Netdb_net_t) U_L(POPn);
+ nent = PerlSock_getnetbyaddr(addr, addrtype);
+#else
+ DIE(no_sock_func, "getnetbyaddr");
+#endif
}
else
- nent = getnetent();
+#ifdef HAS_GETNETENT
+ nent = PerlSock_getnetent();
+#else
+ DIE(no_sock_func, "getnetent");
+#endif
EXTEND(SP, 4);
if (GIMME != G_ARRAY) {
@@ -3730,17 +3885,17 @@ PP(pp_gnetent)
}
if (nent) {
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setpv(sv, nent->n_name);
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
for (elem = nent->n_aliases; elem && *elem; elem++) {
sv_catpv(sv, *elem);
if (elem[1])
sv_catpvn(sv, " ", 1);
}
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setiv(sv, (IV)nent->n_addrtype);
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setiv(sv, (IV)nent->n_net);
}
@@ -3752,7 +3907,7 @@ PP(pp_gnetent)
PP(pp_gpbyname)
{
-#ifdef HAS_SOCKET
+#ifdef HAS_GETPROTOBYNAME
return pp_gprotoent(ARGS);
#else
DIE(no_sock_func, "getprotobyname");
@@ -3761,7 +3916,7 @@ PP(pp_gpbyname)
PP(pp_gpbynumber)
{
-#ifdef HAS_SOCKET
+#ifdef HAS_GETPROTOBYNUMBER
return pp_gprotoent(ARGS);
#else
DIE(no_sock_func, "getprotobynumber");
@@ -3770,22 +3925,38 @@ PP(pp_gpbynumber)
PP(pp_gprotoent)
{
- dSP;
-#ifdef HAS_SOCKET
- I32 which = op->op_type;
+ djSP;
+#if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT)
+ I32 which = PL_op->op_type;
register char **elem;
- register SV *sv;
- struct protoent *getprotobyname();
- struct protoent *getprotobynumber();
- struct protoent *getprotoent();
+ register SV *sv;
+#ifndef HAS_GETPROTO_PROTOS /* XXX Do we need individual probes? */
+ struct protoent *PerlSock_getprotobyname(Netdb_name_t);
+ struct protoent *PerlSock_getprotobynumber(int);
+ struct protoent *PerlSock_getprotoent(void);
+#endif
struct protoent *pent;
- if (which == OP_GPBYNAME)
- pent = getprotobyname(POPp);
+ if (which == OP_GPBYNAME) {
+#ifdef HAS_GETPROTOBYNAME
+ STRLEN n_a;
+ pent = PerlSock_getprotobyname(POPpx);
+#else
+ DIE(no_sock_func, "getprotobyname");
+#endif
+ }
else if (which == OP_GPBYNUMBER)
- pent = getprotobynumber(POPi);
+#ifdef HAS_GETPROTOBYNUMBER
+ pent = PerlSock_getprotobynumber(POPi);
+#else
+ DIE(no_sock_func, "getprotobynumber");
+#endif
else
- pent = getprotoent();
+#ifdef HAS_GETPROTOENT
+ pent = PerlSock_getprotoent();
+#else
+ DIE(no_sock_func, "getprotoent");
+#endif
EXTEND(SP, 3);
if (GIMME != G_ARRAY) {
@@ -3800,15 +3971,15 @@ PP(pp_gprotoent)
}
if (pent) {
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setpv(sv, pent->p_name);
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
for (elem = pent->p_aliases; elem && *elem; elem++) {
sv_catpv(sv, *elem);
if (elem[1])
sv_catpvn(sv, " ", 1);
}
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setiv(sv, (IV)pent->p_proto);
}
@@ -3820,7 +3991,7 @@ PP(pp_gprotoent)
PP(pp_gsbyname)
{
-#ifdef HAS_SOCKET
+#ifdef HAS_GETSERVBYNAME
return pp_gservent(ARGS);
#else
DIE(no_sock_func, "getservbyname");
@@ -3829,7 +4000,7 @@ PP(pp_gsbyname)
PP(pp_gsbyport)
{
-#ifdef HAS_SOCKET
+#ifdef HAS_GETSERVBYPORT
return pp_gservent(ARGS);
#else
DIE(no_sock_func, "getservbyport");
@@ -3838,36 +4009,52 @@ PP(pp_gsbyport)
PP(pp_gservent)
{
- dSP;
-#ifdef HAS_SOCKET
- I32 which = op->op_type;
+ djSP;
+#if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT)
+ I32 which = PL_op->op_type;
register char **elem;
register SV *sv;
- struct servent *getservbyname();
- struct servent *getservbynumber();
- struct servent *getservent();
+#ifndef HAS_GETSERV_PROTOS /* XXX Do we need individual probes? */
+ struct servent *PerlSock_getservbyname(Netdb_name_t, Netdb_name_t);
+ struct servent *PerlSock_getservbyport(int, Netdb_name_t);
+ struct servent *PerlSock_getservent(void);
+#endif
struct servent *sent;
if (which == OP_GSBYNAME) {
- char *proto = POPp;
- char *name = POPp;
+#ifdef HAS_GETSERVBYNAME
+ STRLEN n_a;
+ char *proto = POPpx;
+ char *name = POPpx;
if (proto && !*proto)
proto = Nullch;
- sent = getservbyname(name, proto);
+ sent = PerlSock_getservbyname(name, proto);
+#else
+ DIE(no_sock_func, "getservbyname");
+#endif
}
else if (which == OP_GSBYPORT) {
- char *proto = POPp;
+#ifdef HAS_GETSERVBYPORT
+ STRLEN n_a;
+ char *proto = POPpx;
unsigned short port = POPu;
#ifdef HAS_HTONS
- port = htons(port);
+ port = PerlSock_htons(port);
+#endif
+ sent = PerlSock_getservbyport(port, proto);
+#else
+ DIE(no_sock_func, "getservbyport");
#endif
- sent = getservbyport(port, proto);
}
else
- sent = getservent();
+#ifdef HAS_GETSERVENT
+ sent = PerlSock_getservent();
+#else
+ DIE(no_sock_func, "getservent");
+#endif
EXTEND(SP, 4);
if (GIMME != G_ARRAY) {
@@ -3875,7 +4062,7 @@ PP(pp_gservent)
if (sent) {
if (which == OP_GSBYNAME) {
#ifdef HAS_NTOHS
- sv_setiv(sv, (IV)ntohs(sent->s_port));
+ sv_setiv(sv, (IV)PerlSock_ntohs(sent->s_port));
#else
sv_setiv(sv, (IV)(sent->s_port));
#endif
@@ -3887,21 +4074,21 @@ PP(pp_gservent)
}
if (sent) {
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setpv(sv, sent->s_name);
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
for (elem = sent->s_aliases; elem && *elem; elem++) {
sv_catpv(sv, *elem);
if (elem[1])
sv_catpvn(sv, " ", 1);
}
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
#ifdef HAS_NTOHS
- sv_setiv(sv, (IV)ntohs(sent->s_port));
+ sv_setiv(sv, (IV)PerlSock_ntohs(sent->s_port));
#else
sv_setiv(sv, (IV)(sent->s_port));
#endif
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setpv(sv, sent->s_proto);
}
@@ -3913,9 +4100,9 @@ PP(pp_gservent)
PP(pp_shostent)
{
- dSP;
-#ifdef HAS_SOCKET
- sethostent(TOPi);
+ djSP;
+#ifdef HAS_SETHOSTENT
+ PerlSock_sethostent(TOPi);
RETSETYES;
#else
DIE(no_sock_func, "sethostent");
@@ -3924,9 +4111,9 @@ PP(pp_shostent)
PP(pp_snetent)
{
- dSP;
-#ifdef HAS_SOCKET
- setnetent(TOPi);
+ djSP;
+#ifdef HAS_SETNETENT
+ PerlSock_setnetent(TOPi);
RETSETYES;
#else
DIE(no_sock_func, "setnetent");
@@ -3935,9 +4122,9 @@ PP(pp_snetent)
PP(pp_sprotoent)
{
- dSP;
-#ifdef HAS_SOCKET
- setprotoent(TOPi);
+ djSP;
+#ifdef HAS_SETPROTOENT
+ PerlSock_setprotoent(TOPi);
RETSETYES;
#else
DIE(no_sock_func, "setprotoent");
@@ -3946,9 +4133,9 @@ PP(pp_sprotoent)
PP(pp_sservent)
{
- dSP;
-#ifdef HAS_SOCKET
- setservent(TOPi);
+ djSP;
+#ifdef HAS_SETSERVENT
+ PerlSock_setservent(TOPi);
RETSETYES;
#else
DIE(no_sock_func, "setservent");
@@ -3957,10 +4144,10 @@ PP(pp_sservent)
PP(pp_ehostent)
{
- dSP;
-#ifdef HAS_SOCKET
- endhostent();
- EXTEND(sp,1);
+ djSP;
+#ifdef HAS_ENDHOSTENT
+ PerlSock_endhostent();
+ EXTEND(SP,1);
RETPUSHYES;
#else
DIE(no_sock_func, "endhostent");
@@ -3969,10 +4156,10 @@ PP(pp_ehostent)
PP(pp_enetent)
{
- dSP;
-#ifdef HAS_SOCKET
- endnetent();
- EXTEND(sp,1);
+ djSP;
+#ifdef HAS_ENDNETENT
+ PerlSock_endnetent();
+ EXTEND(SP,1);
RETPUSHYES;
#else
DIE(no_sock_func, "endnetent");
@@ -3981,10 +4168,10 @@ PP(pp_enetent)
PP(pp_eprotoent)
{
- dSP;
-#ifdef HAS_SOCKET
- endprotoent();
- EXTEND(sp,1);
+ djSP;
+#ifdef HAS_ENDPROTOENT
+ PerlSock_endprotoent();
+ EXTEND(SP,1);
RETPUSHYES;
#else
DIE(no_sock_func, "endprotoent");
@@ -3993,10 +4180,10 @@ PP(pp_eprotoent)
PP(pp_eservent)
{
- dSP;
-#ifdef HAS_SOCKET
- endservent();
- EXTEND(sp,1);
+ djSP;
+#ifdef HAS_ENDSERVENT
+ PerlSock_endservent();
+ EXTEND(SP,1);
RETPUSHYES;
#else
DIE(no_sock_func, "endservent");
@@ -4023,14 +4210,15 @@ PP(pp_gpwuid)
PP(pp_gpwent)
{
- dSP;
-#ifdef HAS_PASSWD
- I32 which = op->op_type;
+ djSP;
+#if defined(HAS_PASSWD) && defined(HAS_GETPWENT)
+ I32 which = PL_op->op_type;
register SV *sv;
struct passwd *pwent;
+ STRLEN n_a;
if (which == OP_GPWNAM)
- pwent = getpwnam(POPp);
+ pwent = getpwnam(POPpx);
else if (which == OP_GPWUID)
pwent = getpwuid(POPi);
else
@@ -4049,45 +4237,61 @@ PP(pp_gpwent)
}
if (pwent) {
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setpv(sv, pwent->pw_name);
- PUSHs(sv = sv_mortalcopy(&sv_no));
+
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
+#ifdef PWPASSWD
sv_setpv(sv, pwent->pw_passwd);
- PUSHs(sv = sv_mortalcopy(&sv_no));
+#endif
+
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setiv(sv, (IV)pwent->pw_uid);
- PUSHs(sv = sv_mortalcopy(&sv_no));
+
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setiv(sv, (IV)pwent->pw_gid);
- PUSHs(sv = sv_mortalcopy(&sv_no));
+
+ /* pw_change, pw_quota, and pw_age are mutually exclusive. */
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
#ifdef PWCHANGE
sv_setiv(sv, (IV)pwent->pw_change);
#else
-#ifdef PWQUOTA
+# ifdef PWQUOTA
sv_setiv(sv, (IV)pwent->pw_quota);
-#else
-#ifdef PWAGE
+# else
+# ifdef PWAGE
sv_setpv(sv, pwent->pw_age);
+# endif
+# endif
#endif
-#endif
-#endif
- PUSHs(sv = sv_mortalcopy(&sv_no));
+
+ /* pw_class and pw_comment are mutually exclusive. */
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
#ifdef PWCLASS
sv_setpv(sv, pwent->pw_class);
#else
-#ifdef PWCOMMENT
+# ifdef PWCOMMENT
sv_setpv(sv, pwent->pw_comment);
+# endif
#endif
-#endif
- PUSHs(sv = sv_mortalcopy(&sv_no));
+
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
+#ifdef PWGECOS
sv_setpv(sv, pwent->pw_gecos);
+#endif
#ifndef INCOMPLETE_TAINTS
+ /* pw_gecos is tainted because user himself can diddle with it. */
SvTAINTED_on(sv);
#endif
- PUSHs(sv = sv_mortalcopy(&sv_no));
+
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setpv(sv, pwent->pw_dir);
- PUSHs(sv = sv_mortalcopy(&sv_no));
+
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setpv(sv, pwent->pw_shell);
+
#ifdef PWEXPIRE
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setiv(sv, (IV)pwent->pw_expire);
#endif
}
@@ -4099,8 +4303,8 @@ PP(pp_gpwent)
PP(pp_spwent)
{
- dSP;
-#if defined(HAS_PASSWD) && !defined(CYGWIN32)
+ djSP;
+#if defined(HAS_PASSWD) && defined(HAS_SETPWENT) && !defined(CYGWIN32)
setpwent();
RETPUSHYES;
#else
@@ -4110,8 +4314,8 @@ PP(pp_spwent)
PP(pp_epwent)
{
- dSP;
-#ifdef HAS_PASSWD
+ djSP;
+#if defined(HAS_PASSWD) && defined(HAS_ENDPWENT)
endpwent();
RETPUSHYES;
#else
@@ -4139,15 +4343,16 @@ PP(pp_ggrgid)
PP(pp_ggrent)
{
- dSP;
-#ifdef HAS_GROUP
- I32 which = op->op_type;
+ djSP;
+#if defined(HAS_GROUP) && defined(HAS_GETGRENT)
+ I32 which = PL_op->op_type;
register char **elem;
register SV *sv;
struct group *grent;
+ STRLEN n_a;
if (which == OP_GGRNAM)
- grent = (struct group *)getgrnam(POPp);
+ grent = (struct group *)getgrnam(POPpx);
else if (which == OP_GGRGID)
grent = (struct group *)getgrgid(POPi);
else
@@ -4166,13 +4371,18 @@ PP(pp_ggrent)
}
if (grent) {
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setpv(sv, grent->gr_name);
- PUSHs(sv = sv_mortalcopy(&sv_no));
+
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
+#ifdef GRPASSWD
sv_setpv(sv, grent->gr_passwd);
- PUSHs(sv = sv_mortalcopy(&sv_no));
+#endif
+
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setiv(sv, (IV)grent->gr_gid);
- PUSHs(sv = sv_mortalcopy(&sv_no));
+
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
for (elem = grent->gr_mem; elem && *elem; elem++) {
sv_catpv(sv, *elem);
if (elem[1])
@@ -4188,8 +4398,8 @@ PP(pp_ggrent)
PP(pp_sgrent)
{
- dSP;
-#ifdef HAS_GROUP
+ djSP;
+#if defined(HAS_GROUP) && defined(HAS_SETGRENT)
setgrent();
RETPUSHYES;
#else
@@ -4199,8 +4409,8 @@ PP(pp_sgrent)
PP(pp_egrent)
{
- dSP;
-#ifdef HAS_GROUP
+ djSP;
+#if defined(HAS_GROUP) && defined(HAS_ENDGRENT)
endgrent();
RETPUSHYES;
#else
@@ -4210,11 +4420,11 @@ PP(pp_egrent)
PP(pp_getlogin)
{
- dSP; dTARGET;
+ djSP; dTARGET;
#ifdef HAS_GETLOGIN
char *tmps;
EXTEND(SP, 1);
- if (!(tmps = getlogin()))
+ if (!(tmps = PerlProc_getlogin()))
RETPUSHUNDEF;
PUSHp(tmps, strlen(tmps));
RETURN;
@@ -4228,14 +4438,14 @@ PP(pp_getlogin)
PP(pp_syscall)
{
#ifdef HAS_SYSCALL
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
register I32 items = SP - MARK;
unsigned long a[20];
register I32 i = 0;
I32 retval = -1;
MAGIC *mg;
- if (tainting) {
+ if (PL_tainting) {
while (++MARK <= SP) {
if (SvTAINTED(*MARK)) {
TAINT;
@@ -4253,10 +4463,12 @@ PP(pp_syscall)
while (++MARK <= SP) {
if (SvNIOK(*MARK) || !i)
a[i++] = SvIV(*MARK);
- else if (*MARK == &sv_undef)
+ else if (*MARK == &PL_sv_undef)
a[i++] = 0;
- else
- a[i++] = (unsigned long)SvPV_force(*MARK, na);
+ else {
+ STRLEN n_a;
+ a[i++] = (unsigned long)SvPV_force(*MARK, n_a);
+ }
if (i > 15)
break;
}
@@ -4329,9 +4541,7 @@ PP(pp_syscall)
*/
static int
-fcntl_emulate_flock(fd, operation)
-int fd;
-int operation;
+fcntl_emulate_flock(int fd, int operation)
{
struct flock flock;
@@ -4398,9 +4608,9 @@ int operation;
/* flock locks entire file so for lockf we need to do the same */
save_errno = errno;
- pos = lseek(fd, (Off_t)0, SEEK_CUR); /* get pos to restore later */
+ pos = PerlLIO_lseek(fd, (Off_t)0, SEEK_CUR); /* get pos to restore later */
if (pos > 0) /* is seekable and needs to be repositioned */
- if (lseek(fd, (Off_t)0, SEEK_SET) < 0)
+ if (PerlLIO_lseek(fd, (Off_t)0, SEEK_SET) < 0)
pos = -1; /* seek failed, so don't seek back afterwards */
errno = save_errno;
@@ -4437,7 +4647,7 @@ int operation;
}
if (pos > 0) /* need to restore position of the handle */
- lseek(fd, pos, SEEK_SET); /* ignore error here */
+ PerlLIO_lseek(fd, pos, SEEK_SET); /* ignore error here */
return (i);
}
diff --git a/gnu/usr.bin/perl/proto.h b/gnu/usr.bin/perl/proto.h
index 463b4989227..62fb9f6414e 100644
--- a/gnu/usr.bin/perl/proto.h
+++ b/gnu/usr.bin/perl/proto.h
@@ -1,556 +1,909 @@
+#ifndef PERL_CALLCONV
+# define PERL_CALLCONV
+#endif
+
+#ifdef PERL_OBJECT
+#define VIRTUAL virtual PERL_CALLCONV
+#else
+#define VIRTUAL PERL_CALLCONV
+START_EXTERN_C
+#endif
+
+/* NOTE!!! When new virtual functions are added, they must be added at
+ * the end of this file to maintain binary compatibility with PERL_OBJECT
+ */
+
+
#ifndef NEXT30_NO_ATTRIBUTE
#ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */
#ifdef __attribute__ /* Avoid possible redefinition errors */
#undef __attribute__
#endif
#define __attribute__(attr)
-#endif
+#endif
#endif
#ifdef OVERLOAD
-SV* amagic_call _((SV* left,SV* right,int method,int dir));
-bool Gv_AMupdate _((HV* stash));
+VIRTUAL SV* amagic_call _((SV* left,SV* right,int method,int dir));
+VIRTUAL bool Gv_AMupdate _((HV* stash));
#endif /* OVERLOAD */
-OP* append_elem _((I32 optype, OP* head, OP* tail));
-OP* append_list _((I32 optype, LISTOP* first, LISTOP* last));
-I32 apply _((I32 type, SV** mark, SV** sp));
-void assertref _((OP* op));
-void av_clear _((AV* ar));
-void av_extend _((AV* ar, I32 key));
-AV* av_fake _((I32 size, SV** svp));
-SV** av_fetch _((AV* ar, I32 key, I32 lval));
-void av_fill _((AV* ar, I32 fill));
-I32 av_len _((AV* ar));
-AV* av_make _((I32 size, SV** svp));
-SV* av_pop _((AV* ar));
-void av_push _((AV* ar, SV* val));
-void av_reify _((AV* ar));
-SV* av_shift _((AV* ar));
-SV** av_store _((AV* ar, I32 key, SV* val));
-void av_undef _((AV* ar));
-void av_unshift _((AV* ar, I32 num));
-OP* bind_match _((I32 type, OP* left, OP* pat));
-OP* block_end _((I32 floor, OP* seq));
-I32 block_gimme _((void));
-int block_start _((int full));
-void boot_core_UNIVERSAL _((void));
-void call_list _((I32 oldscope, AV* list));
-I32 cando _((I32 bit, I32 effective, struct stat* statbufp));
+VIRTUAL OP* append_elem _((I32 optype, OP* head, OP* tail));
+VIRTUAL OP* append_list _((I32 optype, LISTOP* first, LISTOP* last));
+VIRTUAL I32 apply _((I32 type, SV** mark, SV** sp));
+VIRTUAL void assertref _((OP* o));
+VIRTUAL bool avhv_exists_ent _((AV *ar, SV* keysv, U32 hash));
+VIRTUAL SV** avhv_fetch_ent _((AV *ar, SV* keysv, I32 lval, U32 hash));
+VIRTUAL HE* avhv_iternext _((AV *ar));
+VIRTUAL SV* avhv_iterval _((AV *ar, HE* entry));
+VIRTUAL HV* avhv_keys _((AV *ar));
+VIRTUAL void av_clear _((AV* ar));
+VIRTUAL void av_extend _((AV* ar, I32 key));
+VIRTUAL AV* av_fake _((I32 size, SV** svp));
+VIRTUAL SV** av_fetch _((AV* ar, I32 key, I32 lval));
+VIRTUAL void av_fill _((AV* ar, I32 fill));
+VIRTUAL I32 av_len _((AV* ar));
+VIRTUAL AV* av_make _((I32 size, SV** svp));
+VIRTUAL SV* av_pop _((AV* ar));
+VIRTUAL void av_push _((AV* ar, SV* val));
+VIRTUAL void av_reify _((AV* ar));
+VIRTUAL SV* av_shift _((AV* ar));
+VIRTUAL SV** av_store _((AV* ar, I32 key, SV* val));
+VIRTUAL void av_undef _((AV* ar));
+VIRTUAL void av_unshift _((AV* ar, I32 num));
+VIRTUAL OP* bind_match _((I32 type, OP* left, OP* pat));
+VIRTUAL OP* block_end _((I32 floor, OP* seq));
+VIRTUAL I32 block_gimme _((void));
+VIRTUAL int block_start _((int full));
+VIRTUAL void boot_core_UNIVERSAL _((void));
+VIRTUAL void call_list _((I32 oldscope, AV* av_list));
+VIRTUAL I32 cando _((I32 bit, I32 effective, Stat_t* statbufp));
#ifndef CASTNEGFLOAT
-U32 cast_ulong _((double f));
+VIRTUAL U32 cast_ulong _((double f));
#endif
#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
-I32 my_chsize _((int fd, Off_t length));
-#endif
-OP* ck_gvconst _((OP* o));
-OP* ck_retarget _((OP* op));
-OP* convert _((I32 optype, I32 flags, OP* op));
-void croak _((const char* pat,...)) __attribute__((noreturn));
-void cv_ckproto _((CV* cv, GV* gv, char* p));
-CV* cv_clone _((CV* proto));
-SV* cv_const_sv _((CV* cv));
-void cv_undef _((CV* cv));
-#ifdef DEBUGGING
-void cx_dump _((CONTEXT* cs));
-#endif
-SV* filter_add _((filter_t funcp, SV* datasv));
-void filter_del _((filter_t funcp));
-I32 filter_read _((int idx, SV* buffer, int maxlen));
-I32 cxinc _((void));
-void deb _((const char* pat,...)) __attribute__((format(printf,1,2)));
-void deb_growlevel _((void));
-I32 debop _((OP* op));
-I32 debstackptrs _((void));
-#ifdef DEBUGGING
-void debprofdump _((void));
+VIRTUAL I32 my_chsize _((int fd, Off_t length));
+#endif
+VIRTUAL OP* ck_gvconst _((OP* o));
+VIRTUAL OP* ck_retarget _((OP* o));
+#ifdef USE_THREADS
+VIRTUAL MAGIC * condpair_magic _((SV *sv));
#endif
-I32 debstack _((void));
-char* delimcpy _((char* to, char* toend, char* from, char* fromend,
+VIRTUAL OP* convert _((I32 optype, I32 flags, OP* o));
+VIRTUAL void croak _((const char* pat,...)) __attribute__((noreturn));
+VIRTUAL void cv_ckproto _((CV* cv, GV* gv, char* p));
+VIRTUAL CV* cv_clone _((CV* proto));
+VIRTUAL SV* cv_const_sv _((CV* cv));
+VIRTUAL SV* op_const_sv _((OP* o, CV* cv));
+VIRTUAL void cv_undef _((CV* cv));
+VIRTUAL void cx_dump _((PERL_CONTEXT* cs));
+VIRTUAL SV* filter_add _((filter_t funcp, SV* datasv));
+VIRTUAL void filter_del _((filter_t funcp));
+VIRTUAL I32 filter_read _((int idx, SV* buffer, int maxlen));
+VIRTUAL char ** get_op_descs _((void));
+VIRTUAL char ** get_op_names _((void));
+VIRTUAL char * get_no_modify _((void));
+VIRTUAL U32 * get_opargs _((void));
+VIRTUAL I32 cxinc _((void));
+VIRTUAL void deb _((const char* pat,...));
+VIRTUAL void deb_growlevel _((void));
+VIRTUAL void debprofdump _((void));
+VIRTUAL I32 debop _((OP* o));
+VIRTUAL I32 debstack _((void));
+VIRTUAL I32 debstackptrs _((void));
+VIRTUAL char* delimcpy _((char* to, char* toend, char* from, char* fromend,
int delim, I32* retlen));
-void deprecate _((char* s));
-OP* die _((const char* pat,...));
-OP* die_where _((char* message));
-void dounwind _((I32 cxix));
-bool do_aexec _((SV* really, SV** mark, SV** sp));
-void do_chop _((SV* asv, SV* sv));
-bool do_close _((GV* gv, bool not_implicit));
-bool do_eof _((GV* gv));
-bool do_exec _((char* cmd));
-void do_execfree _((void));
+VIRTUAL void deprecate _((char* s));
+VIRTUAL OP* die _((const char* pat,...));
+VIRTUAL OP* die_where _((char* message));
+VIRTUAL void dounwind _((I32 cxix));
+VIRTUAL bool do_aexec _((SV* really, SV** mark, SV** sp));
+VIRTUAL int do_binmode _((PerlIO *fp, int iotype, int flag));
+VIRTUAL void do_chop _((SV* asv, SV* sv));
+VIRTUAL bool do_close _((GV* gv, bool not_implicit));
+VIRTUAL bool do_eof _((GV* gv));
+VIRTUAL bool do_exec _((char* cmd));
+VIRTUAL void do_execfree _((void));
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
I32 do_ipcctl _((I32 optype, SV** mark, SV** sp));
I32 do_ipcget _((I32 optype, SV** mark, SV** sp));
#endif
-void do_join _((SV* sv, SV* del, SV** mark, SV** sp));
-OP* do_kv _((void));
+VIRTUAL void do_join _((SV* sv, SV* del, SV** mark, SV** sp));
+VIRTUAL OP* do_kv _((ARGSproto));
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
I32 do_msgrcv _((SV** mark, SV** sp));
I32 do_msgsnd _((SV** mark, SV** sp));
#endif
-bool do_open _((GV* gv, char* name, I32 len,
+VIRTUAL bool do_open _((GV* gv, char* name, I32 len,
int as_raw, int rawmode, int rawperm, PerlIO* supplied_fp));
-void do_pipe _((SV* sv, GV* rgv, GV* wgv));
-bool do_print _((SV* sv, PerlIO* fp));
-OP* do_readline _((void));
-I32 do_chomp _((SV* sv));
-bool do_seek _((GV* gv, long pos, int whence));
+VIRTUAL void do_pipe _((SV* sv, GV* rgv, GV* wgv));
+VIRTUAL bool do_print _((SV* sv, PerlIO* fp));
+VIRTUAL OP* do_readline _((void));
+VIRTUAL I32 do_chomp _((SV* sv));
+VIRTUAL bool do_seek _((GV* gv, long pos, int whence));
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
I32 do_semop _((SV** mark, SV** sp));
I32 do_shmio _((I32 optype, SV** mark, SV** sp));
#endif
-void do_sprintf _((SV* sv, I32 len, SV** sarg));
-long do_sysseek _((GV* gv, long pos, int whence));
-long do_tell _((GV* gv));
-I32 do_trans _((SV* sv, OP* arg));
-void do_vecset _((SV* sv));
-void do_vop _((I32 optype, SV* sv, SV* left, SV* right));
-I32 dowantarray _((void));
-void dump_all _((void));
-void dump_eval _((void));
+VIRTUAL void do_sprintf _((SV* sv, I32 len, SV** sarg));
+VIRTUAL long do_sysseek _((GV* gv, long pos, int whence));
+VIRTUAL long do_tell _((GV* gv));
+VIRTUAL I32 do_trans _((SV* sv, OP* arg));
+VIRTUAL void do_vecset _((SV* sv));
+VIRTUAL void do_vop _((I32 optype, SV* sv, SV* left, SV* right));
+VIRTUAL I32 dowantarray _((void));
+VIRTUAL void dump_all _((void));
+VIRTUAL void dump_eval _((void));
#ifdef DUMP_FDS /* See util.c */
-int dump_fds _((char* s));
+VIRTUAL void dump_fds _((char* s));
#endif
-void dump_form _((GV* gv));
-void dump_gv _((GV* gv));
+VIRTUAL void dump_form _((GV* gv));
+VIRTUAL void dump_gv _((GV* gv));
#ifdef MYMALLOC
-void dump_mstats _((char* s));
-#endif
-void dump_op _((OP* arg));
-void dump_pm _((PMOP* pm));
-void dump_packsubs _((HV* stash));
-void dump_sub _((GV* gv));
-void fbm_compile _((SV* sv));
-char* fbm_instr _((unsigned char* big, unsigned char* bigend, SV* littlesv));
-OP* force_list _((OP* arg));
-OP* fold_constants _((OP* arg));
-char* form _((const char* pat, ...));
-void free_tmps _((void));
-OP* gen_constant_list _((OP* op));
-void gp_free _((GV* gv));
-GP* gp_ref _((GP* gp));
-GV* gv_AVadd _((GV* gv));
-GV* gv_HVadd _((GV* gv));
-GV* gv_IOadd _((GV* gv));
-GV* gv_autoload4 _((HV* stash, char* name, STRLEN len, I32 method));
-void gv_check _((HV* stash));
-void gv_efullname _((SV* sv, GV* gv));
-void gv_efullname3 _((SV* sv, GV* gv, char* prefix));
-GV* gv_fetchfile _((char* name));
-GV* gv_fetchmeth _((HV* stash, char* name, STRLEN len, I32 level));
-GV* gv_fetchmethod _((HV* stash, char* name));
-GV* gv_fetchmethod_autoload _((HV* stash, char* name, I32 autoload));
-GV* gv_fetchpv _((char* name, I32 add, I32 sv_type));
-void gv_fullname _((SV* sv, GV* gv));
-void gv_fullname3 _((SV* sv, GV* gv, char* prefix));
-void gv_init _((GV* gv, HV* stash, char* name, STRLEN len, int multi));
-HV* gv_stashpv _((char* name, I32 create));
-HV* gv_stashpvn _((char* name, U32 namelen, I32 create));
-HV* gv_stashsv _((SV* sv, I32 create));
-void hoistmust _((PMOP* pm));
-void hv_clear _((HV* tb));
-void hv_delayfree_ent _((HV* hv, HE* entry));
-SV* hv_delete _((HV* tb, char* key, U32 klen, I32 flags));
-SV* hv_delete_ent _((HV* tb, SV* key, I32 flags, U32 hash));
-bool hv_exists _((HV* tb, char* key, U32 klen));
-bool hv_exists_ent _((HV* tb, SV* key, U32 hash));
-SV** hv_fetch _((HV* tb, char* key, U32 klen, I32 lval));
-HE* hv_fetch_ent _((HV* tb, SV* key, I32 lval, U32 hash));
-void hv_free_ent _((HV* hv, HE* entry));
-I32 hv_iterinit _((HV* tb));
-char* hv_iterkey _((HE* entry, I32* retlen));
-SV* hv_iterkeysv _((HE* entry));
-HE* hv_iternext _((HV* tb));
-SV* hv_iternextsv _((HV* hv, char** key, I32* retlen));
-SV* hv_iterval _((HV* tb, HE* entry));
-void hv_ksplit _((HV* hv, IV newmax));
-void hv_magic _((HV* hv, GV* gv, int how));
-SV** hv_store _((HV* tb, char* key, U32 klen, SV* val, U32 hash));
-HE* hv_store_ent _((HV* tb, SV* key, SV* val, U32 hash));
-void hv_undef _((HV* tb));
-I32 ibcmp _((char* a, char* b, I32 len));
-I32 ibcmp_locale _((char* a, char* b, I32 len));
-I32 ingroup _((I32 testgid, I32 effective));
-U32 intro_my _((void));
-char* instr _((char* big, char* little));
-bool io_close _((IO* io));
-OP* invert _((OP* cmd));
-OP* jmaybe _((OP* arg));
-I32 keyword _((char* d, I32 len));
-void leave_scope _((I32 base));
-void lex_end _((void));
-void lex_start _((SV* line));
-OP* linklist _((OP* op));
-OP* list _((OP* o));
-OP* listkids _((OP* o));
-OP* localize _((OP* arg, I32 lexical));
-I32 looks_like_number _((SV* sv));
-int magic_clearenv _((SV* sv, MAGIC* mg));
-int magic_clear_all_env _((SV* sv, MAGIC* mg));
-int magic_clearpack _((SV* sv, MAGIC* mg));
-int magic_clearsig _((SV* sv, MAGIC* mg));
-int magic_existspack _((SV* sv, MAGIC* mg));
-int magic_freedefelem _((SV* sv, MAGIC* mg));
-int magic_get _((SV* sv, MAGIC* mg));
-int magic_getarylen _((SV* sv, MAGIC* mg));
-int magic_getdefelem _((SV* sv, MAGIC* mg));
-int magic_getglob _((SV* sv, MAGIC* mg));
-int magic_getpack _((SV* sv, MAGIC* mg));
-int magic_getpos _((SV* sv, MAGIC* mg));
-int magic_getsig _((SV* sv, MAGIC* mg));
-int magic_gettaint _((SV* sv, MAGIC* mg));
-int magic_getuvar _((SV* sv, MAGIC* mg));
-U32 magic_len _((SV* sv, MAGIC* mg));
-int magic_nextpack _((SV* sv, MAGIC* mg, SV* key));
-int magic_set _((SV* sv, MAGIC* mg));
+VIRTUAL void dump_mstats _((char* s));
+#endif
+VIRTUAL void dump_op _((OP* arg));
+VIRTUAL void dump_pm _((PMOP* pm));
+VIRTUAL void dump_packsubs _((HV* stash));
+VIRTUAL void dump_sub _((GV* gv));
+VIRTUAL void fbm_compile _((SV* sv, U32 flags));
+VIRTUAL char* fbm_instr _((unsigned char* big, unsigned char* bigend, SV* littlesv, U32 flags));
+VIRTUAL char* find_script _((char *scriptname, bool dosearch, char **search_ext, I32 flags));
+#ifdef USE_THREADS
+VIRTUAL PADOFFSET find_threadsv _((char *name));
+#endif
+VIRTUAL OP* force_list _((OP* arg));
+VIRTUAL OP* fold_constants _((OP* arg));
+VIRTUAL char* form _((const char* pat, ...));
+VIRTUAL void free_tmps _((void));
+VIRTUAL OP* gen_constant_list _((OP* o));
+VIRTUAL void gp_free _((GV* gv));
+VIRTUAL GP* gp_ref _((GP* gp));
+VIRTUAL GV* gv_AVadd _((GV* gv));
+VIRTUAL GV* gv_HVadd _((GV* gv));
+VIRTUAL GV* gv_IOadd _((GV* gv));
+VIRTUAL GV* gv_autoload4 _((HV* stash, char* name, STRLEN len, I32 method));
+VIRTUAL void gv_check _((HV* stash));
+VIRTUAL void gv_efullname _((SV* sv, GV* gv));
+VIRTUAL void gv_efullname3 _((SV* sv, GV* gv, char* prefix));
+VIRTUAL GV* gv_fetchfile _((char* name));
+VIRTUAL GV* gv_fetchmeth _((HV* stash, char* name, STRLEN len, I32 level));
+VIRTUAL GV* gv_fetchmethod _((HV* stash, char* name));
+VIRTUAL GV* gv_fetchmethod_autoload _((HV* stash, char* name, I32 autoload));
+VIRTUAL GV* gv_fetchpv _((char* name, I32 add, I32 sv_type));
+VIRTUAL void gv_fullname _((SV* sv, GV* gv));
+VIRTUAL void gv_fullname3 _((SV* sv, GV* gv, char* prefix));
+VIRTUAL void gv_init _((GV* gv, HV* stash, char* name, STRLEN len, int multi));
+VIRTUAL HV* gv_stashpv _((char* name, I32 create));
+VIRTUAL HV* gv_stashpvn _((char* name, U32 namelen, I32 create));
+VIRTUAL HV* gv_stashsv _((SV* sv, I32 create));
+VIRTUAL void hv_clear _((HV* tb));
+VIRTUAL void hv_delayfree_ent _((HV* hv, HE* entry));
+VIRTUAL SV* hv_delete _((HV* tb, char* key, U32 klen, I32 flags));
+VIRTUAL SV* hv_delete_ent _((HV* tb, SV* key, I32 flags, U32 hash));
+VIRTUAL bool hv_exists _((HV* tb, char* key, U32 klen));
+VIRTUAL bool hv_exists_ent _((HV* tb, SV* key, U32 hash));
+VIRTUAL SV** hv_fetch _((HV* tb, char* key, U32 klen, I32 lval));
+VIRTUAL HE* hv_fetch_ent _((HV* tb, SV* key, I32 lval, U32 hash));
+VIRTUAL void hv_free_ent _((HV* hv, HE* entry));
+VIRTUAL I32 hv_iterinit _((HV* tb));
+VIRTUAL char* hv_iterkey _((HE* entry, I32* retlen));
+VIRTUAL SV* hv_iterkeysv _((HE* entry));
+VIRTUAL HE* hv_iternext _((HV* tb));
+VIRTUAL SV* hv_iternextsv _((HV* hv, char** key, I32* retlen));
+VIRTUAL SV* hv_iterval _((HV* tb, HE* entry));
+VIRTUAL void hv_ksplit _((HV* hv, IV newmax));
+VIRTUAL void hv_magic _((HV* hv, GV* gv, int how));
+VIRTUAL SV** hv_store _((HV* tb, char* key, U32 klen, SV* val, U32 hash));
+VIRTUAL HE* hv_store_ent _((HV* tb, SV* key, SV* val, U32 hash));
+VIRTUAL void hv_undef _((HV* tb));
+VIRTUAL I32 ibcmp _((char* a, char* b, I32 len));
+VIRTUAL I32 ibcmp_locale _((char* a, char* b, I32 len));
+VIRTUAL I32 ingroup _((I32 testgid, I32 effective));
+VIRTUAL void init_stacks _((ARGSproto));
+VIRTUAL U32 intro_my _((void));
+VIRTUAL char* instr _((char* big, char* little));
+VIRTUAL bool io_close _((IO* io));
+VIRTUAL OP* invert _((OP* cmd));
+VIRTUAL OP* jmaybe _((OP* arg));
+VIRTUAL I32 keyword _((char* d, I32 len));
+VIRTUAL void leave_scope _((I32 base));
+VIRTUAL void lex_end _((void));
+VIRTUAL void lex_start _((SV* line));
+VIRTUAL OP* linklist _((OP* o));
+VIRTUAL OP* list _((OP* o));
+VIRTUAL OP* listkids _((OP* o));
+VIRTUAL OP* localize _((OP* arg, I32 lexical));
+VIRTUAL I32 looks_like_number _((SV* sv));
+VIRTUAL int magic_clearenv _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_clear_all_env _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_clearpack _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_clearsig _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_existspack _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_freeregexp _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_get _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_getarylen _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_getdefelem _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_getglob _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_getnkeys _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_getpack _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_getpos _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_getsig _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_getsubstr _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_gettaint _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_getuvar _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_getvec _((SV* sv, MAGIC* mg));
+VIRTUAL U32 magic_len _((SV* sv, MAGIC* mg));
+#ifdef USE_THREADS
+VIRTUAL int magic_mutexfree _((SV* sv, MAGIC* mg));
+#endif /* USE_THREADS */
+VIRTUAL int magic_nextpack _((SV* sv, MAGIC* mg, SV* key));
+VIRTUAL int magic_set _((SV* sv, MAGIC* mg));
#ifdef OVERLOAD
-int magic_setamagic _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_setamagic _((SV* sv, MAGIC* mg));
#endif /* OVERLOAD */
-int magic_setarylen _((SV* sv, MAGIC* mg));
-int magic_setbm _((SV* sv, MAGIC* mg));
-int magic_setdbline _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_setarylen _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_setbm _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_setdbline _((SV* sv, MAGIC* mg));
#ifdef USE_LOCALE_COLLATE
-int magic_setcollxfrm _((SV* sv, MAGIC* mg));
-#endif
-int magic_setdefelem _((SV* sv, MAGIC* mg));
-int magic_setenv _((SV* sv, MAGIC* mg));
-int magic_setfm _((SV* sv, MAGIC* mg));
-int magic_setisa _((SV* sv, MAGIC* mg));
-int magic_setglob _((SV* sv, MAGIC* mg));
-int magic_setmglob _((SV* sv, MAGIC* mg));
-int magic_setnkeys _((SV* sv, MAGIC* mg));
-int magic_setpack _((SV* sv, MAGIC* mg));
-int magic_setpos _((SV* sv, MAGIC* mg));
-int magic_setsig _((SV* sv, MAGIC* mg));
-int magic_setsubstr _((SV* sv, MAGIC* mg));
-int magic_settaint _((SV* sv, MAGIC* mg));
-int magic_setuvar _((SV* sv, MAGIC* mg));
-int magic_setvec _((SV* sv, MAGIC* mg));
-int magic_set_all_env _((SV* sv, MAGIC* mg));
-int magic_wipepack _((SV* sv, MAGIC* mg));
-void magicname _((char* sym, char* name, I32 namlen));
+VIRTUAL int magic_setcollxfrm _((SV* sv, MAGIC* mg));
+#endif
+VIRTUAL int magic_setdefelem _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_setenv _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_setfm _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_setisa _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_setglob _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_setmglob _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_setnkeys _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_setpack _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_setpos _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_setsig _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_setsubstr _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_settaint _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_setuvar _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_setvec _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_set_all_env _((SV* sv, MAGIC* mg));
+VIRTUAL U32 magic_sizepack _((SV* sv, MAGIC* mg));
+VIRTUAL int magic_wipepack _((SV* sv, MAGIC* mg));
+VIRTUAL void magicname _((char* sym, char* name, I32 namlen));
int main _((int argc, char** argv, char** env));
-void markstack_grow _((void));
+#ifdef MYMALLOC
+VIRTUAL MEM_SIZE malloced_size _((void *p));
+#endif
+VIRTUAL void markstack_grow _((void));
#ifdef USE_LOCALE_COLLATE
-char* mem_collxfrm _((const char* s, STRLEN len, STRLEN* xlen));
-#endif
-char* mess _((const char* pat, va_list* args));
-int mg_clear _((SV* sv));
-int mg_copy _((SV* , SV* , char* , I32));
-MAGIC* mg_find _((SV* sv, int type));
-int mg_free _((SV* sv));
-int mg_get _((SV* sv));
-U32 mg_len _((SV* sv));
-void mg_magical _((SV* sv));
-int mg_set _((SV* sv));
-OP* mod _((OP* op, I32 type));
-char* moreswitches _((char* s));
-OP* my _((OP* op));
+VIRTUAL char* mem_collxfrm _((const char* s, STRLEN len, STRLEN* xlen));
+#endif
+VIRTUAL char* mess _((const char* pat, va_list* args));
+VIRTUAL int mg_clear _((SV* sv));
+VIRTUAL int mg_copy _((SV* sv, SV* nsv, char* key, I32 klen));
+VIRTUAL MAGIC* mg_find _((SV* sv, int type));
+VIRTUAL int mg_free _((SV* sv));
+VIRTUAL int mg_get _((SV* sv));
+VIRTUAL U32 mg_length _((SV* sv));
+VIRTUAL void mg_magical _((SV* sv));
+VIRTUAL int mg_set _((SV* sv));
+VIRTUAL I32 mg_size _((SV* sv));
+VIRTUAL OP* mod _((OP* o, I32 type));
+VIRTUAL char* moreswitches _((char* s));
+VIRTUAL OP* my _((OP* o));
#if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
-char* my_bcopy _((char* from, char* to, I32 len));
+VIRTUAL char* my_bcopy _((char* from, char* to, I32 len));
#endif
#if !defined(HAS_BZERO) && !defined(HAS_MEMSET)
char* my_bzero _((char* loc, I32 len));
#endif
-void my_exit _((U32 status)) __attribute__((noreturn));
-void my_failure_exit _((void)) __attribute__((noreturn));
-I32 my_lstat _((void));
+VIRTUAL void my_exit _((U32 status)) __attribute__((noreturn));
+VIRTUAL void my_failure_exit _((void)) __attribute__((noreturn));
+VIRTUAL I32 my_lstat _((ARGSproto));
#if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP)
-I32 my_memcmp _((char* s1, char* s2, I32 len));
+VIRTUAL I32 my_memcmp _((char* s1, char* s2, I32 len));
#endif
#if !defined(HAS_MEMSET)
-void* my_memset _((char* loc, I32 ch, I32 len));
+VIRTUAL void* my_memset _((char* loc, I32 ch, I32 len));
#endif
-I32 my_pclose _((PerlIO* ptr));
-PerlIO* my_popen _((char* cmd, char* mode));
-void my_setenv _((char* nam, char* val));
-I32 my_stat _((void));
+#ifndef PERL_OBJECT
+VIRTUAL I32 my_pclose _((PerlIO* ptr));
+VIRTUAL PerlIO* my_popen _((char* cmd, char* mode));
+#endif
+VIRTUAL void my_setenv _((char* nam, char* val));
+VIRTUAL I32 my_stat _((ARGSproto));
#ifdef MYSWAP
-short my_swap _((short s));
-long my_htonl _((long l));
-long my_ntohl _((long l));
-#endif
-void my_unexec _((void));
-OP* newANONLIST _((OP* op));
-OP* newANONHASH _((OP* op));
-OP* newANONSUB _((I32 floor, OP* proto, OP* block));
-OP* newASSIGNOP _((I32 flags, OP* left, I32 optype, OP* right));
-OP* newCONDOP _((I32 flags, OP* expr, OP* trueop, OP* falseop));
-void newFORM _((I32 floor, OP* op, OP* block));
-OP* newFOROP _((I32 flags, char* label, line_t forline, OP* scalar, OP* expr, OP*block, OP*cont));
-OP* newLOGOP _((I32 optype, I32 flags, OP* left, OP* right));
-OP* newLOOPEX _((I32 type, OP* label));
-OP* newLOOPOP _((I32 flags, I32 debuggable, OP* expr, OP* block));
-OP* newNULLLIST _((void));
-OP* newOP _((I32 optype, I32 flags));
-void newPROG _((OP* op));
-OP* newRANGE _((I32 flags, OP* left, OP* right));
-OP* newSLICEOP _((I32 flags, OP* subscript, OP* list));
-OP* newSTATEOP _((I32 flags, char* label, OP* o));
-CV* newSUB _((I32 floor, OP* op, OP* proto, OP* block));
-CV* newXS _((char* name, void (*subaddr)(CV* cv), char* filename));
-#ifdef DEPRECATED
-CV* newXSUB _((char* name, I32 ix, I32 (*subaddr)(int,int,int), char* filename));
-#endif
-AV* newAV _((void));
-OP* newAVREF _((OP* o));
-OP* newBINOP _((I32 type, I32 flags, OP* first, OP* last));
-OP* newCVREF _((I32 flags, OP* o));
-OP* newGVOP _((I32 type, I32 flags, GV* gv));
-GV* newGVgen _((char* pack));
-OP* newGVREF _((I32 type, OP* o));
-OP* newHVREF _((OP* o));
-HV* newHV _((void));
-IO* newIO _((void));
-OP* newLISTOP _((I32 type, I32 flags, OP* first, OP* last));
-OP* newPMOP _((I32 type, I32 flags));
-OP* newPVOP _((I32 type, I32 flags, char* pv));
-SV* newRV _((SV* ref));
-#ifdef LEAKTEST
-SV* newSV _((I32 x, STRLEN len));
-#else
-SV* newSV _((STRLEN len));
-#endif
-OP* newSVREF _((OP* o));
-OP* newSVOP _((I32 type, I32 flags, SV* sv));
-SV* newSViv _((IV i));
-SV* newSVnv _((double n));
-SV* newSVpv _((char* s, STRLEN len));
-SV* newSVpvf _((const char* pat, ...));
-SV* newSVrv _((SV* rv, char* classname));
-SV* newSVsv _((SV* old));
-OP* newUNOP _((I32 type, I32 flags, OP* first));
-OP* newWHILEOP _((I32 flags, I32 debuggable, LOOP* loop,
+VIRTUAL short my_swap _((short s));
+VIRTUAL long my_htonl _((long l));
+VIRTUAL long my_ntohl _((long l));
+#endif
+VIRTUAL void my_unexec _((void));
+VIRTUAL OP* newANONLIST _((OP* o));
+VIRTUAL OP* newANONHASH _((OP* o));
+VIRTUAL OP* newANONSUB _((I32 floor, OP* proto, OP* block));
+VIRTUAL OP* newASSIGNOP _((I32 flags, OP* left, I32 optype, OP* right));
+VIRTUAL OP* newCONDOP _((I32 flags, OP* expr, OP* trueop, OP* falseop));
+VIRTUAL void newCONSTSUB _((HV* stash, char* name, SV* sv));
+VIRTUAL void newFORM _((I32 floor, OP* o, OP* block));
+VIRTUAL OP* newFOROP _((I32 flags, char* label, line_t forline, OP* sclr, OP* expr, OP*block, OP*cont));
+VIRTUAL OP* newLOGOP _((I32 optype, I32 flags, OP* left, OP* right));
+VIRTUAL OP* newLOOPEX _((I32 type, OP* label));
+VIRTUAL OP* newLOOPOP _((I32 flags, I32 debuggable, OP* expr, OP* block));
+VIRTUAL OP* newNULLLIST _((void));
+VIRTUAL OP* newOP _((I32 optype, I32 flags));
+VIRTUAL void newPROG _((OP* o));
+VIRTUAL OP* newRANGE _((I32 flags, OP* left, OP* right));
+VIRTUAL OP* newSLICEOP _((I32 flags, OP* subscript, OP* list));
+VIRTUAL OP* newSTATEOP _((I32 flags, char* label, OP* o));
+VIRTUAL CV* newSUB _((I32 floor, OP* o, OP* proto, OP* block));
+VIRTUAL CV* newXS _((char* name, void (*subaddr)(CV* cv _CPERLproto), char* filename));
+VIRTUAL AV* newAV _((void));
+VIRTUAL OP* newAVREF _((OP* o));
+VIRTUAL OP* newBINOP _((I32 type, I32 flags, OP* first, OP* last));
+VIRTUAL OP* newCVREF _((I32 flags, OP* o));
+VIRTUAL OP* newGVOP _((I32 type, I32 flags, GV* gv));
+VIRTUAL GV* newGVgen _((char* pack));
+VIRTUAL OP* newGVREF _((I32 type, OP* o));
+VIRTUAL OP* newHVREF _((OP* o));
+VIRTUAL HV* newHV _((void));
+VIRTUAL HV* newHVhv _((HV* hv));
+VIRTUAL IO* newIO _((void));
+VIRTUAL OP* newLISTOP _((I32 type, I32 flags, OP* first, OP* last));
+VIRTUAL OP* newPMOP _((I32 type, I32 flags));
+VIRTUAL OP* newPVOP _((I32 type, I32 flags, char* pv));
+VIRTUAL SV* newRV _((SV* pref));
+VIRTUAL SV* newRV_noinc _((SV *sv));
+VIRTUAL SV* newSV _((STRLEN len));
+VIRTUAL OP* newSVREF _((OP* o));
+VIRTUAL OP* newSVOP _((I32 type, I32 flags, SV* sv));
+VIRTUAL SV* newSViv _((IV i));
+VIRTUAL SV* newSVnv _((double n));
+VIRTUAL SV* newSVpv _((char* s, STRLEN len));
+VIRTUAL SV* newSVpvn _((char *s, STRLEN len));
+VIRTUAL SV* newSVpvf _((const char* pat, ...));
+VIRTUAL SV* newSVrv _((SV* rv, char* classname));
+VIRTUAL SV* newSVsv _((SV* old));
+VIRTUAL OP* newUNOP _((I32 type, I32 flags, OP* first));
+VIRTUAL OP* newWHILEOP _((I32 flags, I32 debuggable, LOOP* loop,
I32 whileline, OP* expr, OP* block, OP* cont));
-PerlIO* nextargv _((GV* gv));
-char* ninstr _((char* big, char* bigend, char* little, char* lend));
-OP* oopsCV _((OP* o));
-void op_free _((OP* arg));
-void package _((OP* op));
-PADOFFSET pad_alloc _((I32 optype, U32 tmptype));
-PADOFFSET pad_allocmy _((char* name));
-PADOFFSET pad_findmy _((char* name));
-OP* oopsAV _((OP* o));
-OP* oopsHV _((OP* o));
-void pad_leavemy _((I32 fill));
-SV* pad_sv _((PADOFFSET po));
-void pad_free _((PADOFFSET po));
-void pad_reset _((void));
-void pad_swipe _((PADOFFSET po));
-void peep _((OP* op));
+#ifdef USE_THREADS
+VIRTUAL struct perl_thread * new_struct_thread _((struct perl_thread *t));
+#endif
+VIRTUAL PERL_SI * new_stackinfo _((I32 stitems, I32 cxitems));
+VIRTUAL PerlIO* nextargv _((GV* gv));
+VIRTUAL char* ninstr _((char* big, char* bigend, char* little, char* lend));
+VIRTUAL OP* oopsCV _((OP* o));
+VIRTUAL void op_free _((OP* arg));
+VIRTUAL void package _((OP* o));
+VIRTUAL PADOFFSET pad_alloc _((I32 optype, U32 tmptype));
+VIRTUAL PADOFFSET pad_allocmy _((char* name));
+VIRTUAL PADOFFSET pad_findmy _((char* name));
+VIRTUAL OP* oopsAV _((OP* o));
+VIRTUAL OP* oopsHV _((OP* o));
+VIRTUAL void pad_leavemy _((I32 fill));
+VIRTUAL SV* pad_sv _((PADOFFSET po));
+VIRTUAL void pad_free _((PADOFFSET po));
+VIRTUAL void pad_reset _((void));
+VIRTUAL void pad_swipe _((PADOFFSET po));
+VIRTUAL void peep _((OP* o));
+#ifndef PERL_OBJECT
PerlInterpreter* perl_alloc _((void));
-I32 perl_call_argv _((char* subname, I32 flags, char** argv));
-I32 perl_call_method _((char* methname, I32 flags));
-I32 perl_call_pv _((char* subname, I32 flags));
-I32 perl_call_sv _((SV* sv, I32 flags));
+#endif
+#ifdef PERL_OBJECT
+VIRTUAL void perl_atexit _((void(*fn)(CPerlObj *, void *), void* ptr));
+#else
+void perl_atexit _((void(*fn)(void *), void*));
+#endif
+VIRTUAL I32 perl_call_argv _((char* sub_name, I32 flags, char** argv));
+VIRTUAL I32 perl_call_method _((char* methname, I32 flags));
+VIRTUAL I32 perl_call_pv _((char* sub_name, I32 flags));
+VIRTUAL I32 perl_call_sv _((SV* sv, I32 flags));
+#ifdef PERL_OBJECT
+VIRTUAL void perl_construct _((void));
+VIRTUAL void perl_destruct _((void));
+#else
void perl_construct _((PerlInterpreter* sv_interp));
void perl_destruct _((PerlInterpreter* sv_interp));
-SV* perl_eval_pv _((char* p, I32 croak_on_error));
-I32 perl_eval_sv _((SV* sv, I32 flags));
+#endif
+VIRTUAL SV* perl_eval_pv _((char* p, I32 croak_on_error));
+VIRTUAL I32 perl_eval_sv _((SV* sv, I32 flags));
+#ifdef PERL_OBJECT
+VIRTUAL void perl_free _((void));
+#else
void perl_free _((PerlInterpreter* sv_interp));
-SV* perl_get_sv _((char* name, I32 create));
-AV* perl_get_av _((char* name, I32 create));
-HV* perl_get_hv _((char* name, I32 create));
-CV* perl_get_cv _((char* name, I32 create));
-int perl_init_i18nl10n _((int printwarn));
-int perl_init_i18nl14n _((int printwarn));
-void perl_new_collate _((char* newcoll));
-void perl_new_ctype _((char* newctype));
-void perl_new_numeric _((char* newcoll));
-void perl_set_numeric_local _((void));
-void perl_set_numeric_standard _((void));
+#endif
+VIRTUAL SV* perl_get_sv _((char* name, I32 create));
+VIRTUAL AV* perl_get_av _((char* name, I32 create));
+VIRTUAL HV* perl_get_hv _((char* name, I32 create));
+VIRTUAL CV* perl_get_cv _((char* name, I32 create));
+VIRTUAL int perl_init_i18nl10n _((int printwarn));
+VIRTUAL int perl_init_i18nl14n _((int printwarn));
+VIRTUAL void perl_new_collate _((char* newcoll));
+VIRTUAL void perl_new_ctype _((char* newctype));
+VIRTUAL void perl_new_numeric _((char* newcoll));
+VIRTUAL void perl_set_numeric_local _((void));
+VIRTUAL void perl_set_numeric_standard _((void));
+#ifdef PERL_OBJECT
+VIRTUAL int perl_parse _((void(*xsinit)(CPerlObj*), int argc, char** argv, char** env));
+#else
int perl_parse _((PerlInterpreter* sv_interp, void(*xsinit)(void), int argc, char** argv, char** env));
-void perl_require_pv _((char* pv));
+#endif
+VIRTUAL void perl_require_pv _((char* pv));
#define perl_requirepv perl_require_pv
+#ifdef PERL_OBJECT
+VIRTUAL int perl_run _((void));
+#else
int perl_run _((PerlInterpreter* sv_interp));
-void pidgone _((int pid, int status));
-void pmflag _((U16* pmfl, int ch));
-OP* pmruntime _((OP* pm, OP* expr, OP* repl));
-OP* pmtrans _((OP* op, OP* expr, OP* repl));
-OP* pop_return _((void));
-void pop_scope _((void));
-OP* prepend_elem _((I32 optype, OP* head, OP* tail));
-void push_return _((OP* op));
-void push_scope _((void));
-regexp* pregcomp _((char* exp, char* xend, PMOP* pm));
-OP* ref _((OP* op, I32 type));
-OP* refkids _((OP* op, I32 type));
-void regdump _((regexp* r));
-I32 pregexec _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, I32 safebase));
-void pregfree _((struct regexp* r));
-char* regnext _((char* p));
-void regprop _((SV* sv, char* op));
-void repeatcpy _((char* to, char* from, I32 len, I32 count));
-char* rninstr _((char* big, char* bigend, char* little, char* lend));
-Sighandler_t rsignal _((int, Sighandler_t));
-int rsignal_restore _((int, Sigsave_t*));
-int rsignal_save _((int, Sighandler_t, Sigsave_t*));
-Sighandler_t rsignal_state _((int));
-int runops _((void));
-void rxres_free _((void** rsp));
-void rxres_restore _((void** rsp, REGEXP* rx));
-void rxres_save _((void** rsp, REGEXP* rx));
+#endif
+VIRTUAL void pidgone _((int pid, int status));
+VIRTUAL void pmflag _((U16* pmfl, int ch));
+VIRTUAL OP* pmruntime _((OP* pm, OP* expr, OP* repl));
+VIRTUAL OP* pmtrans _((OP* o, OP* expr, OP* repl));
+VIRTUAL OP* pop_return _((void));
+VIRTUAL void pop_scope _((void));
+VIRTUAL OP* prepend_elem _((I32 optype, OP* head, OP* tail));
+VIRTUAL void push_return _((OP* o));
+VIRTUAL void push_scope _((void));
+VIRTUAL OP* ref _((OP* o, I32 type));
+VIRTUAL OP* refkids _((OP* o, I32 type));
+VIRTUAL void regdump _((regexp* r));
+VIRTUAL I32 pregexec _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, U32 nosave));
+VIRTUAL void pregfree _((struct regexp* r));
+VIRTUAL regexp* pregcomp _((char* exp, char* xend, PMOP* pm));
+VIRTUAL I32 regexec_flags _((regexp* prog, char* stringarg, char* strend,
+ char* strbeg, I32 minend, SV* screamer,
+ void* data, U32 flags));
+VIRTUAL regnode* regnext _((regnode* p));
+VIRTUAL void regprop _((SV* sv, regnode* o));
+VIRTUAL void repeatcpy _((char* to, char* from, I32 len, I32 count));
+VIRTUAL char* rninstr _((char* big, char* bigend, char* little, char* lend));
+VIRTUAL Sighandler_t rsignal _((int i, Sighandler_t t));
+VIRTUAL int rsignal_restore _((int i, Sigsave_t* t));
+VIRTUAL int rsignal_save _((int i, Sighandler_t t1, Sigsave_t* t2));
+VIRTUAL Sighandler_t rsignal_state _((int i));
+VIRTUAL void rxres_free _((void** rsp));
+VIRTUAL void rxres_restore _((void** rsp, REGEXP* prx));
+VIRTUAL void rxres_save _((void** rsp, REGEXP* prx));
#ifndef HAS_RENAME
-I32 same_dirent _((char* a, char* b));
-#endif
-char* savepv _((char* sv));
-char* savepvn _((char* sv, I32 len));
-void savestack_grow _((void));
-void save_aptr _((AV** aptr));
-AV* save_ary _((GV* gv));
-void save_clearsv _((SV** svp));
-void save_delete _((HV* hv, char* key, I32 klen));
+VIRTUAL I32 same_dirent _((char* a, char* b));
+#endif
+VIRTUAL char* savepv _((char* sv));
+VIRTUAL char* savepvn _((char* sv, I32 len));
+VIRTUAL void savestack_grow _((void));
+VIRTUAL void save_aelem _((AV* av, I32 idx, SV **sptr));
+VIRTUAL void save_aptr _((AV** aptr));
+VIRTUAL AV* save_ary _((GV* gv));
+VIRTUAL void save_clearsv _((SV** svp));
+VIRTUAL void save_delete _((HV* hv, char* key, I32 klen));
#ifndef titan /* TitanOS cc can't handle this */
+#ifdef PERL_OBJECT
+typedef void (CPerlObj::*DESTRUCTORFUNC) _((void*));
+VIRTUAL void save_destructor _((DESTRUCTORFUNC f, void* p));
+#else
void save_destructor _((void (*f)(void*), void* p));
+#endif
#endif /* titan */
-void save_freesv _((SV* sv));
-void save_freeop _((OP* op));
-void save_freepv _((char* pv));
-void save_gp _((GV* gv, I32 empty));
-HV* save_hash _((GV* gv));
-void save_hptr _((HV** hptr));
-void save_I16 _((I16* intp));
-void save_I32 _((I32* intp));
-void save_int _((int* intp));
-void save_item _((SV* item));
-void save_iv _((IV* iv));
-void save_list _((SV** sarg, I32 maxsarg));
-void save_long _((long* longp));
-void save_nogv _((GV* gv));
-SV* save_scalar _((GV* gv));
-void save_pptr _((char** pptr));
-void save_sptr _((SV** sptr));
-SV* save_svref _((SV** sptr));
-OP* sawparens _((OP* o));
-OP* scalar _((OP* o));
-OP* scalarkids _((OP* op));
-OP* scalarseq _((OP* o));
-OP* scalarvoid _((OP* op));
-UV scan_hex _((char* start, I32 len, I32* retlen));
-char* scan_num _((char* s));
-UV scan_oct _((char* start, I32 len, I32* retlen));
-OP* scope _((OP* o));
-char* screaminstr _((SV* bigsv, SV* littlesv));
+VIRTUAL void save_freesv _((SV* sv));
+VIRTUAL void save_freeop _((OP* o));
+VIRTUAL void save_freepv _((char* pv));
+VIRTUAL void save_gp _((GV* gv, I32 empty));
+VIRTUAL HV* save_hash _((GV* gv));
+VIRTUAL void save_helem _((HV* hv, SV *key, SV **sptr));
+VIRTUAL void save_hints _((void));
+VIRTUAL void save_hptr _((HV** hptr));
+VIRTUAL void save_I16 _((I16* intp));
+VIRTUAL void save_I32 _((I32* intp));
+VIRTUAL void save_int _((int* intp));
+VIRTUAL void save_item _((SV* item));
+VIRTUAL void save_iv _((IV* iv));
+VIRTUAL void save_list _((SV** sarg, I32 maxsarg));
+VIRTUAL void save_long _((long* longp));
+VIRTUAL void save_nogv _((GV* gv));
+VIRTUAL void save_op _((void));
+VIRTUAL SV* save_scalar _((GV* gv));
+VIRTUAL void save_pptr _((char** pptr));
+VIRTUAL void save_sptr _((SV** sptr));
+VIRTUAL SV* save_svref _((SV** sptr));
+VIRTUAL SV** save_threadsv _((PADOFFSET i));
+VIRTUAL OP* sawparens _((OP* o));
+VIRTUAL OP* scalar _((OP* o));
+VIRTUAL OP* scalarkids _((OP* o));
+VIRTUAL OP* scalarseq _((OP* o));
+VIRTUAL OP* scalarvoid _((OP* o));
+VIRTUAL UV scan_hex _((char* start, I32 len, I32* retlen));
+VIRTUAL char* scan_num _((char* s));
+VIRTUAL UV scan_oct _((char* start, I32 len, I32* retlen));
+VIRTUAL OP* scope _((OP* o));
+VIRTUAL char* screaminstr _((SV* bigsv, SV* littlesv, I32 start_shift, I32 end_shift, I32 *state, I32 last));
#ifndef VMS
-I32 setenv_getix _((char* nam));
-#endif
-void setdefout _((GV* gv));
-char* sharepvn _((char* sv, I32 len, U32 hash));
-HEK* share_hek _((char* sv, I32 len, U32 hash));
-Signal_t sighandler _((int sig));
-SV** stack_grow _((SV** sp, SV**p, int n));
-I32 start_subparse _((I32 is_format, U32 flags));
-void sub_crush_depth _((CV* cv));
-bool sv_2bool _((SV* sv));
-CV* sv_2cv _((SV* sv, HV** st, GV** gvp, I32 lref));
-IO* sv_2io _((SV* sv));
-IV sv_2iv _((SV* sv));
-SV* sv_2mortal _((SV* sv));
-double sv_2nv _((SV* sv));
-char* sv_2pv _((SV* sv, STRLEN* lp));
-UV sv_2uv _((SV* sv));
-void sv_add_arena _((char* ptr, U32 size, U32 flags));
-int sv_backoff _((SV* sv));
-SV* sv_bless _((SV* sv, HV* stash));
-void sv_catpvf _((SV* sv, const char* pat, ...));
-void sv_catpv _((SV* sv, char* ptr));
-void sv_catpvn _((SV* sv, char* ptr, STRLEN len));
-void sv_catsv _((SV* dsv, SV* ssv));
-void sv_chop _((SV* sv, char* ptr));
-void sv_clean_all _((void));
-void sv_clean_objs _((void));
-void sv_clear _((SV* sv));
-I32 sv_cmp _((SV* sv1, SV* sv2));
-I32 sv_cmp_locale _((SV* sv1, SV* sv2));
+VIRTUAL I32 setenv_getix _((char* nam));
+#endif
+VIRTUAL void setdefout _((GV* gv));
+VIRTUAL char* sharepvn _((char* sv, I32 len, U32 hash));
+VIRTUAL HEK* share_hek _((char* sv, I32 len, U32 hash));
+VIRTUAL Signal_t sighandler _((int sig));
+VIRTUAL SV** stack_grow _((SV** sp, SV**p, int n));
+VIRTUAL I32 start_subparse _((I32 is_format, U32 flags));
+VIRTUAL void sub_crush_depth _((CV* cv));
+VIRTUAL bool sv_2bool _((SV* sv));
+VIRTUAL CV* sv_2cv _((SV* sv, HV** st, GV** gvp, I32 lref));
+VIRTUAL IO* sv_2io _((SV* sv));
+VIRTUAL IV sv_2iv _((SV* sv));
+VIRTUAL SV* sv_2mortal _((SV* sv));
+VIRTUAL double sv_2nv _((SV* sv));
+VIRTUAL char* sv_2pv _((SV* sv, STRLEN* lp));
+VIRTUAL UV sv_2uv _((SV* sv));
+VIRTUAL IV sv_iv _((SV* sv));
+VIRTUAL UV sv_uv _((SV* sv));
+VIRTUAL double sv_nv _((SV* sv));
+VIRTUAL char * sv_pvn _((SV *sv, STRLEN *len));
+VIRTUAL I32 sv_true _((SV *sv));
+VIRTUAL void sv_add_arena _((char* ptr, U32 size, U32 flags));
+VIRTUAL int sv_backoff _((SV* sv));
+VIRTUAL SV* sv_bless _((SV* sv, HV* stash));
+VIRTUAL void sv_catpvf _((SV* sv, const char* pat, ...));
+VIRTUAL void sv_catpv _((SV* sv, char* ptr));
+VIRTUAL void sv_catpvn _((SV* sv, char* ptr, STRLEN len));
+VIRTUAL void sv_catsv _((SV* dsv, SV* ssv));
+VIRTUAL void sv_chop _((SV* sv, char* ptr));
+VIRTUAL void sv_clean_all _((void));
+VIRTUAL void sv_clean_objs _((void));
+VIRTUAL void sv_clear _((SV* sv));
+VIRTUAL I32 sv_cmp _((SV* sv1, SV* sv2));
+VIRTUAL I32 sv_cmp_locale _((SV* sv1, SV* sv2));
#ifdef USE_LOCALE_COLLATE
-char* sv_collxfrm _((SV* sv, STRLEN* nxp));
-#endif
-void sv_dec _((SV* sv));
-void sv_dump _((SV* sv));
-bool sv_derived_from _((SV* sv, char* name));
-I32 sv_eq _((SV* sv1, SV* sv2));
-void sv_free _((SV* sv));
-void sv_free_arenas _((void));
-char* sv_gets _((SV* sv, PerlIO* fp, I32 append));
+VIRTUAL char* sv_collxfrm _((SV* sv, STRLEN* nxp));
+#endif
+VIRTUAL OP* sv_compile_2op _((SV* sv, OP** startp, char* code, AV** avp));
+VIRTUAL void sv_dec _((SV* sv));
+VIRTUAL void sv_dump _((SV* sv));
+VIRTUAL bool sv_derived_from _((SV* sv, char* name));
+VIRTUAL I32 sv_eq _((SV* sv1, SV* sv2));
+VIRTUAL void sv_free _((SV* sv));
+VIRTUAL void sv_free_arenas _((void));
+VIRTUAL char* sv_gets _((SV* sv, PerlIO* fp, I32 append));
#ifndef DOSISH
-char* sv_grow _((SV* sv, I32 newlen));
+VIRTUAL char* sv_grow _((SV* sv, I32 newlen));
#else
-char* sv_grow _((SV* sv, unsigned long newlen));
-#endif
-void sv_inc _((SV* sv));
-void sv_insert _((SV* bigsv, STRLEN offset, STRLEN len, char* little, STRLEN littlelen));
-int sv_isa _((SV* sv, char* name));
-int sv_isobject _((SV* sv));
-STRLEN sv_len _((SV* sv));
-void sv_magic _((SV* sv, SV* obj, int how, char* name, I32 namlen));
-SV* sv_mortalcopy _((SV* oldsv));
-SV* sv_newmortal _((void));
-SV* sv_newref _((SV* sv));
-char* sv_peek _((SV* sv));
-char* sv_pvn_force _((SV* sv, STRLEN* lp));
-char* sv_reftype _((SV* sv, int ob));
-void sv_replace _((SV* sv, SV* nsv));
-void sv_report_used _((void));
-void sv_reset _((char* s, HV* stash));
-void sv_setpvf _((SV* sv, const char* pat, ...));
-void sv_setiv _((SV* sv, IV num));
-void sv_setpviv _((SV* sv, IV num));
-void sv_setuv _((SV* sv, UV num));
-void sv_setnv _((SV* sv, double num));
-SV* sv_setref_iv _((SV* rv, char* classname, IV iv));
-SV* sv_setref_nv _((SV* rv, char* classname, double nv));
-SV* sv_setref_pv _((SV* rv, char* classname, void* pv));
-SV* sv_setref_pvn _((SV* rv, char* classname, char* pv, I32 n));
-void sv_setpv _((SV* sv, const char* ptr));
-void sv_setpvn _((SV* sv, const char* ptr, STRLEN len));
-void sv_setsv _((SV* dsv, SV* ssv));
-void sv_taint _((SV* sv));
-bool sv_tainted _((SV* sv));
-int sv_unmagic _((SV* sv, int type));
-void sv_unref _((SV* sv));
-void sv_untaint _((SV* sv));
-bool sv_upgrade _((SV* sv, U32 mt));
-void sv_usepvn _((SV* sv, char* ptr, STRLEN len));
-void sv_vcatpvfn _((SV* sv, const char* pat, STRLEN patlen,
+VIRTUAL char* sv_grow _((SV* sv, unsigned long newlen));
+#endif
+VIRTUAL void sv_inc _((SV* sv));
+VIRTUAL void sv_insert _((SV* bigsv, STRLEN offset, STRLEN len, char* little, STRLEN littlelen));
+VIRTUAL int sv_isa _((SV* sv, char* name));
+VIRTUAL int sv_isobject _((SV* sv));
+VIRTUAL STRLEN sv_len _((SV* sv));
+VIRTUAL void sv_magic _((SV* sv, SV* obj, int how, char* name, I32 namlen));
+VIRTUAL SV* sv_mortalcopy _((SV* oldsv));
+VIRTUAL SV* sv_newmortal _((void));
+VIRTUAL SV* sv_newref _((SV* sv));
+VIRTUAL char* sv_peek _((SV* sv));
+VIRTUAL char* sv_pvn_force _((SV* sv, STRLEN* lp));
+VIRTUAL char* sv_reftype _((SV* sv, int ob));
+VIRTUAL void sv_replace _((SV* sv, SV* nsv));
+VIRTUAL void sv_report_used _((void));
+VIRTUAL void sv_reset _((char* s, HV* stash));
+VIRTUAL void sv_setpvf _((SV* sv, const char* pat, ...));
+VIRTUAL void sv_setiv _((SV* sv, IV num));
+VIRTUAL void sv_setpviv _((SV* sv, IV num));
+VIRTUAL void sv_setuv _((SV* sv, UV num));
+VIRTUAL void sv_setnv _((SV* sv, double num));
+VIRTUAL SV* sv_setref_iv _((SV* rv, char* classname, IV iv));
+VIRTUAL SV* sv_setref_nv _((SV* rv, char* classname, double nv));
+VIRTUAL SV* sv_setref_pv _((SV* rv, char* classname, void* pv));
+VIRTUAL SV* sv_setref_pvn _((SV* rv, char* classname, char* pv, I32 n));
+VIRTUAL void sv_setpv _((SV* sv, const char* ptr));
+VIRTUAL void sv_setpvn _((SV* sv, const char* ptr, STRLEN len));
+VIRTUAL void sv_setsv _((SV* dsv, SV* ssv));
+VIRTUAL void sv_taint _((SV* sv));
+VIRTUAL bool sv_tainted _((SV* sv));
+VIRTUAL int sv_unmagic _((SV* sv, int type));
+VIRTUAL void sv_unref _((SV* sv));
+VIRTUAL void sv_untaint _((SV* sv));
+VIRTUAL bool sv_upgrade _((SV* sv, U32 mt));
+VIRTUAL void sv_usepvn _((SV* sv, char* ptr, STRLEN len));
+VIRTUAL void sv_vcatpvfn _((SV* sv, const char* pat, STRLEN patlen,
va_list* args, SV** svargs, I32 svmax,
bool *used_locale));
-void sv_vsetpvfn _((SV* sv, const char* pat, STRLEN patlen,
+VIRTUAL void sv_vsetpvfn _((SV* sv, const char* pat, STRLEN patlen,
va_list* args, SV** svargs, I32 svmax,
bool *used_locale));
-void taint_env _((void));
-void taint_proper _((const char* f, char* s));
+VIRTUAL void taint_env _((void));
+VIRTUAL void taint_proper _((const char* f, char* s));
#ifdef UNLINK_ALL_VERSIONS
-I32 unlnk _((char* f));
-#endif
-void unsharepvn _((char* sv, I32 len, U32 hash));
-void unshare_hek _((HEK* hek));
-void utilize _((int aver, I32 floor, OP* version, OP* id, OP* arg));
-void vivify_defelem _((SV* sv));
-void vivify_ref _((SV* sv, U32 to_what));
-I32 wait4pid _((int pid, int* statusp, int flags));
-void warn _((const char* pat,...));
-void watch _((char** addr));
-I32 whichsig _((char* sig));
-int yyerror _((char* s));
-int yylex _((void));
-int yyparse _((void));
-int yywarn _((char* s));
-
-#if defined(MYMALLOC) || !defined(STANDARD_C)
-Malloc_t malloc _((MEM_SIZE nbytes));
-Malloc_t calloc _((MEM_SIZE elements, MEM_SIZE size));
-Malloc_t realloc _((Malloc_t where, MEM_SIZE nbytes));
-Free_t free _((Malloc_t where));
+VIRTUAL I32 unlnk _((char* f));
+#endif
+#ifdef USE_THREADS
+VIRTUAL void unlock_condpair _((void* svv));
#endif
+VIRTUAL void unsharepvn _((char* sv, I32 len, U32 hash));
+VIRTUAL void unshare_hek _((HEK* hek));
+VIRTUAL void utilize _((int aver, I32 floor, OP* version, OP* id, OP* arg));
+VIRTUAL void vivify_defelem _((SV* sv));
+VIRTUAL void vivify_ref _((SV* sv, U32 to_what));
+VIRTUAL I32 wait4pid _((int pid, int* statusp, int flags));
+VIRTUAL void warn _((const char* pat,...));
+VIRTUAL void watch _((char** addr));
+VIRTUAL I32 whichsig _((char* sig));
+VIRTUAL int yyerror _((char* s));
+VIRTUAL int yylex _((void));
+VIRTUAL int yyparse _((void));
+VIRTUAL int yywarn _((char* s));
#ifndef MYMALLOC
-Malloc_t safemalloc _((MEM_SIZE nbytes));
-Malloc_t safecalloc _((MEM_SIZE elements, MEM_SIZE size));
-Malloc_t saferealloc _((Malloc_t where, MEM_SIZE nbytes));
-Free_t safefree _((Malloc_t where));
+VIRTUAL Malloc_t safemalloc _((MEM_SIZE nbytes));
+VIRTUAL Malloc_t safecalloc _((MEM_SIZE elements, MEM_SIZE size));
+VIRTUAL Malloc_t saferealloc _((Malloc_t where, MEM_SIZE nbytes));
+VIRTUAL Free_t safefree _((Malloc_t where));
#endif
#ifdef LEAKTEST
-Malloc_t safexmalloc _((I32 x, MEM_SIZE size));
-Malloc_t safexcalloc _((I32 x, MEM_SIZE elements, MEM_SIZE size));
-Malloc_t safexrealloc _((Malloc_t where, MEM_SIZE size));
-void safexfree _((Malloc_t where));
+VIRTUAL Malloc_t safexmalloc _((I32 x, MEM_SIZE size));
+VIRTUAL Malloc_t safexcalloc _((I32 x, MEM_SIZE elements, MEM_SIZE size));
+VIRTUAL Malloc_t safexrealloc _((Malloc_t where, MEM_SIZE size));
+VIRTUAL void safexfree _((Malloc_t where));
+#endif
+
+#ifdef PERL_GLOBAL_STRUCT
+VIRTUAL struct perl_vars *Perl_GetVars _((void));
+#endif
+
+#ifdef PERL_OBJECT
+protected:
+void hsplit _((HV *hv));
+void hfreeentries _((HV *hv));
+void more_he _((void));
+HE* new_he _((void));
+void del_he _((HE *p));
+HEK *save_hek _((char *str, I32 len, U32 hash));
+SV *mess_alloc _((void));
+void gv_init_sv _((GV *gv, I32 sv_type));
+SV *save_scalar_at _((SV **sptr));
+IV asIV _((SV* sv));
+UV asUV _((SV* sv));
+SV *more_sv _((void));
+void more_xiv _((void));
+void more_xnv _((void));
+void more_xpv _((void));
+void more_xrv _((void));
+XPVIV *new_xiv _((void));
+XPVNV *new_xnv _((void));
+XPV *new_xpv _((void));
+XRV *new_xrv _((void));
+void del_xiv _((XPVIV* p));
+void del_xnv _((XPVNV* p));
+void del_xpv _((XPV* p));
+void del_xrv _((XRV* p));
+void sv_mortalgrow _((void));
+void sv_unglob _((SV* sv));
+void sv_check_thinkfirst _((SV *sv));
+I32 avhv_index_sv _((SV* sv));
+
+void do_report_used _((SV *sv));
+void do_clean_objs _((SV *sv));
+void do_clean_named_objs _((SV *sv));
+void do_clean_all _((SV *sv));
+void not_a_number _((SV *sv));
+void* my_safemalloc _((MEM_SIZE size));
+
+typedef void (CPerlObj::*SVFUNC) _((SV*));
+void visit _((SVFUNC f));
+
+typedef I32 (CPerlObj::*SVCOMPARE) _((SV*, SV*));
+void qsortsv _((SV ** array, size_t num_elts, SVCOMPARE f));
+I32 sortcv _((SV *a, SV *b));
+void save_magic _((MGS *mgs, SV *sv));
+int magic_methpack _((SV *sv, MAGIC *mg, char *meth));
+int magic_methcall _((SV *sv, MAGIC *mg, char *meth, I32 flags, int n, SV *val));
+OP * doform _((CV *cv, GV *gv, OP *retop));
+void doencodes _((SV* sv, char* s, I32 len));
+SV* refto _((SV* sv));
+U32 seed _((void));
+OP *docatch _((OP *o));
+OP *dofindlabel _((OP *o, char *label, OP **opstack, OP **oplimit));
+void doparseform _((SV *sv));
+I32 dopoptoeval _((I32 startingblock));
+I32 dopoptolabel _((char *label));
+I32 dopoptoloop _((I32 startingblock));
+I32 dopoptosub _((I32 startingblock));
+I32 dopoptosub_at _((PERL_CONTEXT* cxstk, I32 startingblock));
+void save_lines _((AV *array, SV *sv));
+OP *doeval _((int gimme, OP** startop));
+SV *mul128 _((SV *sv, U8 m));
+SV *is_an_int _((char *s, STRLEN l));
+int div128 _((SV *pnum, bool *done));
+
+int runops_standard _((void));
+int runops_debug _((void));
+
+void check_uni _((void));
+void force_next _((I32 type));
+char *force_version _((char *start));
+char *force_word _((char *start, int token, int check_keyword, int allow_pack, int allow_tick));
+SV *tokeq _((SV *sv));
+char *scan_const _((char *start));
+char *scan_formline _((char *s));
+char *scan_heredoc _((char *s));
+char *scan_ident _((char *s, char *send, char *dest, STRLEN destlen, I32 ck_uni));
+char *scan_inputsymbol _((char *start));
+char *scan_pat _((char *start, I32 type));
+char *scan_str _((char *start));
+char *scan_subst _((char *start));
+char *scan_trans _((char *start));
+char *scan_word _((char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp));
+char *skipspace _((char *s));
+void checkcomma _((char *s, char *name, char *what));
+void force_ident _((char *s, int kind));
+void incline _((char *s));
+int intuit_method _((char *s, GV *gv));
+int intuit_more _((char *s));
+I32 lop _((I32 f, expectation x, char *s));
+void missingterm _((char *s));
+void no_op _((char *what, char *s));
+void set_csh _((void));
+I32 sublex_done _((void));
+I32 sublex_push _((void));
+I32 sublex_start _((void));
+#ifdef CRIPPLED_CC
+int uni _((I32 f, char *s));
+#endif
+char * filter_gets _((SV *sv, PerlIO *fp, STRLEN append));
+SV *new_constant _((char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type));
+int ao _((int toketype));
+void depcom _((void));
+#ifdef WIN32
+I32 win32_textfilter _((int idx, SV *sv, int maxlen));
#endif
+char* incl_perldb _((void));
+SV *isa_lookup _((HV *stash, char *name, int len, int level));
+CV *get_db_sub _((SV **svp, CV *cv));
+I32 list_assignment _((OP *o));
+void bad_type _((I32 n, char *t, char *name, OP *kid));
+OP *modkids _((OP *o, I32 type));
+OP *no_fh_allowed _((OP *o));
+OP *scalarboolean _((OP *o));
+OP *too_few_arguments _((OP *o, char* name));
+OP *too_many_arguments _((OP *o, char* name));
+void null _((OP* o));
+PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval, U32 flags));
+OP *newDEFSVOP _((void));
+char* gv_ename _((GV *gv));
+CV *cv_clone2 _((CV *proto, CV *outside));
+
+void find_beginning _((void));
+void forbid_setid _((char *));
+void incpush _((char *, int));
+void init_interp _((void));
+void init_ids _((void));
+void init_debugger _((void));
+void init_lexer _((void));
+void init_main_stash _((void));
+#ifdef USE_THREADS
+struct perl_thread * init_main_thread _((void));
+#endif /* USE_THREADS */
+void init_perllib _((void));
+void init_postdump_symbols _((int, char **, char **));
+void init_predump_symbols _((void));
+void my_exit_jump _((void)) __attribute__((noreturn));
+void nuke_stacks _((void));
+void open_script _((char *, bool, SV *, int *fd));
+void usage _((char *));
+void validate_suid _((char *, char*, int));
+
+regnode *reg _((I32, I32 *));
+regnode *reganode _((U8, U32));
+regnode *regatom _((I32 *));
+regnode *regbranch _((I32 *, I32));
+void regc _((U8, char *));
+regnode *regclass _((void));
+I32 regcurly _((char *));
+regnode *reg_node _((U8));
+regnode *regpiece _((I32 *));
+void reginsert _((U8, regnode *));
+void regoptail _((regnode *, regnode *));
+void regset _((char *, I32));
+void regtail _((regnode *, regnode *));
+char* regwhite _((char *, char *));
+char* nextchar _((void));
+regnode *dumpuntil _((regnode *start, regnode *node, regnode *last, SV* sv, I32 l));
+void scan_commit _((scan_data_t *data));
+I32 study_chunk _((regnode **scanp, I32 *deltap, regnode *last, scan_data_t *data, U32 flags));
+I32 add_data _((I32 n, char *s));
+void re_croak2 _((const char* pat1,const char* pat2,...)) __attribute__((noreturn));
+I32 regmatch _((regnode *prog));
+I32 regrepeat _((regnode *p, I32 max));
+I32 regrepeat_hard _((regnode *p, I32 max, I32 *lp));
+I32 regtry _((regexp *prog, char *startpos));
+bool reginclass _((char *p, I32 c));
+CHECKPOINT regcppush _((I32 parenfloor));
+char * regcppop _((void));
+void dump _((char *pat,...));
+#ifdef WIN32
+int do_aspawn _((void *vreally, void **vmark, void **vsp));
+#endif
+
+#ifdef DEBUGGING
+void del_sv _((SV *p));
+#endif
+void debprof _((OP *o));
+
+void *bset_obj_store _((void *obj, I32 ix));
+OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
+I32 amagic_cmp _((register SV *str1, register SV *str2));
+I32 amagic_cmp_locale _((register SV *str1, register SV *str2));
+
+#define PPDEF(s) OP* CPerlObj::s _((ARGSproto));
+public:
+
+#include "pp_proto.h"
+
+OP * ck_ftst _((OP *o));
+OP *ck_anoncode _((OP *o));
+OP *ck_bitop _((OP *o));
+OP *ck_concat _((OP *o));
+OP *ck_spair _((OP *o));
+OP *ck_delete _((OP *o));
+OP *ck_eof _((OP *o));
+OP *ck_eval _((OP *o));
+OP *ck_exec _((OP *o));
+OP *ck_exists _((OP *o));
+OP *ck_rvconst _((OP *o));
+OP *ck_fun _((OP *o));
+OP *ck_glob _((OP *o));
+OP *ck_grep _((OP *o));
+OP *ck_index _((OP *o));
+OP *ck_lengthconst _((OP *o));
+OP *ck_lfun _((OP *o));
+OP *ck_rfun _((OP *o));
+OP *ck_listiob _((OP *o));
+OP *ck_fun_locale _((OP *o));
+OP *ck_scmp _((OP *o));
+OP *ck_match _((OP *o));
+OP *ck_null _((OP *o));
+OP *ck_repeat _((OP *o));
+OP *ck_require _((OP *o));
+OP *ck_select _((OP *o));
+OP *ck_shift _((OP *o));
+OP *ck_sort _((OP *o));
+OP *ck_split _((OP *o));
+OP *ck_subr _((OP *o));
+OP *ck_svconst _((OP *o));
+OP *ck_trunc _((OP *o));
+void unwind_handler_stack _((void *p));
+void restore_magic _((void *p));
+void restore_rsfp _((void *f));
+void restore_expect _((void *e));
+void restore_lex_expect _((void *e));
+void yydestruct _((void *ptr));
+
+VIRTUAL int fprintf _((PerlIO *pf, const char *pat, ...));
+VIRTUAL SV** get_specialsv_list _((void));
+
+#ifdef WIN32
+VIRTUAL int& ErrorNo _((void));
+#endif /* WIN32 */
+#else /* !PERL_OBJECT */
+END_EXTERN_C
+#endif /* PERL_OBJECT */
+
+#ifdef INDIRECT_BGET_MACROS
+VIRTUAL void byterun _((struct bytestream bs));
+#else
+VIRTUAL void byterun _((PerlIO *fp));
+#endif /* INDIRECT_BGET_MACROS */
+
+VIRTUAL void sv_catpvf_mg _((SV *sv, const char* pat, ...));
+VIRTUAL void sv_catpv_mg _((SV *sv, char *ptr));
+VIRTUAL void sv_catpvn_mg _((SV *sv, char *ptr, STRLEN len));
+VIRTUAL void sv_catsv_mg _((SV *dstr, SV *sstr));
+VIRTUAL void sv_setpvf_mg _((SV *sv, const char* pat, ...));
+VIRTUAL void sv_setiv_mg _((SV *sv, IV i));
+VIRTUAL void sv_setpviv_mg _((SV *sv, IV iv));
+VIRTUAL void sv_setuv_mg _((SV *sv, UV u));
+VIRTUAL void sv_setnv_mg _((SV *sv, double num));
+VIRTUAL void sv_setpv_mg _((SV *sv, const char *ptr));
+VIRTUAL void sv_setpvn_mg _((SV *sv, const char *ptr, STRLEN len));
+VIRTUAL void sv_setsv_mg _((SV *dstr, SV *sstr));
+VIRTUAL void sv_usepvn_mg _((SV *sv, char *ptr, STRLEN len));
+
+VIRTUAL MGVTBL* get_vtbl _((int vtbl_id));
+VIRTUAL OP* dofile _((OP* term));
+VIRTUAL void save_generic_svref _((SV** sptr));
+
+/* New virtual functions must be added here to maintain binary
+ * compatablity with PERL_OBJECT
+ */
+
diff --git a/gnu/usr.bin/perl/regcomp.c b/gnu/usr.bin/perl/regcomp.c
index d99d6c7d062..6ddecf9c8dd 100644
--- a/gnu/usr.bin/perl/regcomp.c
+++ b/gnu/usr.bin/perl/regcomp.c
@@ -19,6 +19,27 @@
* with the POSIX routines of the same names.
*/
+#ifdef PERL_EXT_RE_BUILD
+/* need to replace pregcomp et al, so enable that */
+# ifndef PERL_IN_XSUB_RE
+# define PERL_IN_XSUB_RE
+# endif
+/* need access to debugger hooks */
+# ifndef DEBUGGING
+# define DEBUGGING
+# endif
+#endif
+
+#ifdef PERL_IN_XSUB_RE
+/* We *really* need to overwrite these symbols: */
+# define Perl_pregcomp my_regcomp
+# define Perl_regdump my_regdump
+# define Perl_regprop my_regprop
+/* *These* symbols are masked to allow static link. */
+# define Perl_pregfree my_regfree
+# define Perl_regnext my_regnext
+#endif
+
/*SUPPRESS 112*/
/*
* pregcomp and pregexec -- regsub and regerror are not used in perl
@@ -43,7 +64,7 @@
*
**** Alterations to Henry's code are...
****
- **** Copyright (c) 1991-1997, Larry Wall
+ **** Copyright (c) 1991-1999, 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.
@@ -55,9 +76,18 @@
*/
#include "EXTERN.h"
#include "perl.h"
-#include "INTERN.h"
+
+#ifndef PERL_IN_XSUB_RE
+# include "INTERN.h"
+#endif
+
+#define REG_COMP_C
#include "regcomp.h"
+#ifdef op
+#undef op
+#endif /* op */
+
#ifdef MSDOS
# if defined(BUGGY_MSC6)
/* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
@@ -87,7 +117,7 @@
* Flags to be passed up and down.
*/
#define WORST 0 /* Worst case. */
-#define HASWIDTH 0x1 /* Known never to match null string. */
+#define HASWIDTH 0x1 /* Known to match non-null strings. */
#define SIMPLE 0x2 /* Simple enough to be STAR/PLUS operand. */
#define SPSTART 0x4 /* Starts with * or +. */
#define TRYAGAIN 0x8 /* Weeded out a declaration. */
@@ -96,21 +126,579 @@
* Forward declarations for pregcomp()'s friends.
*/
-static char *reg _((I32, I32 *));
-static char *reganode _((char, unsigned short));
-static char *regatom _((I32 *));
-static char *regbranch _((I32 *));
-static void regc _((char));
-static char *regclass _((void));
+#ifndef PERL_OBJECT
+static regnode *reg _((I32, I32 *));
+static regnode *reganode _((U8, U32));
+static regnode *regatom _((I32 *));
+static regnode *regbranch _((I32 *, I32));
+static void regc _((U8, char *));
+static regnode *regclass _((void));
STATIC I32 regcurly _((char *));
-static char *regnode _((char));
-static char *regpiece _((I32 *));
-static void reginsert _((char, char *));
-static void regoptail _((char *, char *));
-static void regset _((char *, I32));
-static void regtail _((char *, char *));
+static regnode *reg_node _((U8));
+static regnode *regpiece _((I32 *));
+static void reginsert _((U8, regnode *));
+static void regoptail _((regnode *, regnode *));
+static void regtail _((regnode *, regnode *));
static char* regwhite _((char *, char *));
static char* nextchar _((void));
+static void re_croak2 _((const char* pat1,const char* pat2,...)) __attribute__((noreturn));
+#endif
+
+/* Length of a variant. */
+
+#ifndef PERL_OBJECT
+typedef struct {
+ I32 len_min;
+ I32 len_delta;
+ I32 pos_min;
+ I32 pos_delta;
+ SV *last_found;
+ I32 last_end; /* min value, <0 unless valid. */
+ I32 last_start_min;
+ I32 last_start_max;
+ SV **longest; /* Either &l_fixed, or &l_float. */
+ SV *longest_fixed;
+ I32 offset_fixed;
+ SV *longest_float;
+ I32 offset_float_min;
+ I32 offset_float_max;
+ I32 flags;
+} scan_data_t;
+#endif
+
+static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
+
+#define SF_BEFORE_EOL (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
+#define SF_BEFORE_SEOL 0x1
+#define SF_BEFORE_MEOL 0x2
+#define SF_FIX_BEFORE_EOL (SF_FIX_BEFORE_SEOL|SF_FIX_BEFORE_MEOL)
+#define SF_FL_BEFORE_EOL (SF_FL_BEFORE_SEOL|SF_FL_BEFORE_MEOL)
+
+#ifdef NO_UNARY_PLUS
+# define SF_FIX_SHIFT_EOL (0+2)
+# define SF_FL_SHIFT_EOL (0+4)
+#else
+# define SF_FIX_SHIFT_EOL (+2)
+# define SF_FL_SHIFT_EOL (+4)
+#endif
+
+#define SF_FIX_BEFORE_SEOL (SF_BEFORE_SEOL << SF_FIX_SHIFT_EOL)
+#define SF_FIX_BEFORE_MEOL (SF_BEFORE_MEOL << SF_FIX_SHIFT_EOL)
+
+#define SF_FL_BEFORE_SEOL (SF_BEFORE_SEOL << SF_FL_SHIFT_EOL)
+#define SF_FL_BEFORE_MEOL (SF_BEFORE_MEOL << SF_FL_SHIFT_EOL) /* 0x20 */
+#define SF_IS_INF 0x40
+#define SF_HAS_PAR 0x80
+#define SF_IN_PAR 0x100
+#define SF_HAS_EVAL 0x200
+#define SCF_DO_SUBSTR 0x400
+
+STATIC void
+scan_commit(scan_data_t *data)
+{
+ STRLEN l = SvCUR(data->last_found);
+ STRLEN old_l = SvCUR(*data->longest);
+
+ if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) {
+ sv_setsv(*data->longest, data->last_found);
+ if (*data->longest == data->longest_fixed) {
+ data->offset_fixed = l ? data->last_start_min : data->pos_min;
+ if (data->flags & SF_BEFORE_EOL)
+ data->flags
+ |= ((data->flags & SF_BEFORE_EOL) << SF_FIX_SHIFT_EOL);
+ else
+ data->flags &= ~SF_FIX_BEFORE_EOL;
+ } else {
+ data->offset_float_min = l ? data->last_start_min : data->pos_min;
+ data->offset_float_max = (l
+ ? data->last_start_max
+ : data->pos_min + data->pos_delta);
+ if (data->flags & SF_BEFORE_EOL)
+ data->flags
+ |= ((data->flags & SF_BEFORE_EOL) << SF_FL_SHIFT_EOL);
+ else
+ data->flags &= ~SF_FL_BEFORE_EOL;
+ }
+ }
+ SvCUR_set(data->last_found, 0);
+ data->last_end = -1;
+ data->flags &= ~SF_BEFORE_EOL;
+}
+
+/* Stops at toplevel WHILEM as well as at `last'. At end *scanp is set
+ to the position after last scanned or to NULL. */
+
+STATIC I32
+study_chunk(regnode **scanp, I32 *deltap, regnode *last, scan_data_t *data, U32 flags)
+ /* scanp: Start here (read-write). */
+ /* deltap: Write maxlen-minlen here. */
+ /* last: Stop before this one. */
+{
+ dTHR;
+ I32 min = 0, pars = 0, code;
+ regnode *scan = *scanp, *next;
+ I32 delta = 0;
+ int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
+ int is_inf_internal = 0; /* The studied chunk is infinite */
+ I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
+ scan_data_t data_fake;
+
+ while (scan && OP(scan) != END && scan < last) {
+ /* Peephole optimizer: */
+
+ if (regkind[(U8)OP(scan)] == EXACT) {
+ regnode *n = regnext(scan);
+ U32 stringok = 1;
+#ifdef DEBUGGING
+ regnode *stop = scan;
+#endif
+
+ next = scan + (*OPERAND(scan) + 2 - 1)/sizeof(regnode) + 2;
+ /* Skip NOTHING, merge EXACT*. */
+ while (n &&
+ ( regkind[(U8)OP(n)] == NOTHING ||
+ (stringok && (OP(n) == OP(scan))))
+ && NEXT_OFF(n)
+ && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) {
+ if (OP(n) == TAIL || n > next)
+ stringok = 0;
+ if (regkind[(U8)OP(n)] == NOTHING) {
+ NEXT_OFF(scan) += NEXT_OFF(n);
+ next = n + NODE_STEP_REGNODE;
+#ifdef DEBUGGING
+ if (stringok)
+ stop = n;
+#endif
+ n = regnext(n);
+ } else {
+ int oldl = *OPERAND(scan);
+ regnode *nnext = regnext(n);
+
+ if (oldl + *OPERAND(n) > U8_MAX)
+ break;
+ NEXT_OFF(scan) += NEXT_OFF(n);
+ *OPERAND(scan) += *OPERAND(n);
+ next = n + (*OPERAND(n) + 2 - 1)/sizeof(regnode) + 2;
+ /* Now we can overwrite *n : */
+ Move(OPERAND(n) + 1, OPERAND(scan) + oldl + 1,
+ *OPERAND(n) + 1, char);
+#ifdef DEBUGGING
+ if (stringok)
+ stop = next - 1;
+#endif
+ n = nnext;
+ }
+ }
+#ifdef DEBUGGING
+ /* Allow dumping */
+ n = scan + (*OPERAND(scan) + 2 - 1)/sizeof(regnode) + 2;
+ while (n <= stop) {
+ /* Purify reports a benign UMR here sometimes, because we
+ * don't initialize the OP() slot of a node when that node
+ * is occupied by just the trailing null of the string in
+ * an EXACT node */
+ if (regkind[(U8)OP(n)] != NOTHING || OP(n) == NOTHING) {
+ OP(n) = OPTIMIZED;
+ NEXT_OFF(n) = 0;
+ }
+ n++;
+ }
+#endif
+
+ }
+ if (OP(scan) != CURLYX) {
+ int max = (reg_off_by_arg[OP(scan)]
+ ? I32_MAX
+ /* I32 may be smaller than U16 on CRAYs! */
+ : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
+ int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
+ int noff;
+ regnode *n = scan;
+
+ /* Skip NOTHING and LONGJMP. */
+ while ((n = regnext(n))
+ && ((regkind[(U8)OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
+ || ((OP(n) == LONGJMP) && (noff = ARG(n))))
+ && off + noff < max)
+ off += noff;
+ if (reg_off_by_arg[OP(scan)])
+ ARG(scan) = off;
+ else
+ NEXT_OFF(scan) = off;
+ }
+ if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
+ || OP(scan) == IFTHEN || OP(scan) == SUSPEND) {
+ next = regnext(scan);
+ code = OP(scan);
+
+ if (OP(next) == code || code == IFTHEN || code == SUSPEND) {
+ I32 max1 = 0, min1 = I32_MAX, num = 0;
+
+ if (flags & SCF_DO_SUBSTR)
+ scan_commit(data);
+ while (OP(scan) == code) {
+ I32 deltanext, minnext;
+
+ num++;
+ data_fake.flags = 0;
+ next = regnext(scan);
+ scan = NEXTOPER(scan);
+ if (code != BRANCH)
+ scan = NEXTOPER(scan);
+ /* We suppose the run is continuous, last=next...*/
+ minnext = study_chunk(&scan, &deltanext, next,
+ &data_fake, 0);
+ if (min1 > minnext)
+ min1 = minnext;
+ if (max1 < minnext + deltanext)
+ max1 = minnext + deltanext;
+ if (deltanext == I32_MAX)
+ is_inf = is_inf_internal = 1;
+ scan = next;
+ if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
+ pars++;
+ if (data && (data_fake.flags & SF_HAS_EVAL))
+ data->flags |= SF_HAS_EVAL;
+ if (code == SUSPEND)
+ break;
+ }
+ if (code == IFTHEN && num < 2) /* Empty ELSE branch */
+ min1 = 0;
+ if (flags & SCF_DO_SUBSTR) {
+ data->pos_min += min1;
+ data->pos_delta += max1 - min1;
+ if (max1 != min1 || is_inf)
+ data->longest = &(data->longest_float);
+ }
+ min += min1;
+ delta += max1 - min1;
+ } else if (code == BRANCHJ) /* single branch is optimized. */
+ scan = NEXTOPER(NEXTOPER(scan));
+ else /* single branch is optimized. */
+ scan = NEXTOPER(scan);
+ continue;
+ } else if (OP(scan) == EXACT) {
+ min += *OPERAND(scan);
+ if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
+ I32 l = *OPERAND(scan);
+
+ /* The code below prefers earlier match for fixed
+ offset, later match for variable offset. */
+ if (data->last_end == -1) { /* Update the start info. */
+ data->last_start_min = data->pos_min;
+ data->last_start_max = is_inf
+ ? I32_MAX : data->pos_min + data->pos_delta;
+ }
+ sv_catpvn(data->last_found, (char *)(OPERAND(scan)+1), l);
+ data->last_end = data->pos_min + l;
+ data->pos_min += l; /* As in the first entry. */
+ data->flags &= ~SF_BEFORE_EOL;
+ }
+ } else if (regkind[(U8)OP(scan)] == EXACT) {
+ if (flags & SCF_DO_SUBSTR)
+ scan_commit(data);
+ min += *OPERAND(scan);
+ if (data && (flags & SCF_DO_SUBSTR))
+ data->pos_min += *OPERAND(scan);
+ } else if (strchr(varies,OP(scan))) {
+ I32 mincount, maxcount, minnext, deltanext, pos_before, fl;
+ regnode *oscan = scan;
+
+ switch (regkind[(U8)OP(scan)]) {
+ case WHILEM:
+ scan = NEXTOPER(scan);
+ goto finish;
+ case PLUS:
+ if (flags & SCF_DO_SUBSTR) {
+ next = NEXTOPER(scan);
+ if (OP(next) == EXACT) {
+ mincount = 1;
+ maxcount = REG_INFTY;
+ next = regnext(scan);
+ scan = NEXTOPER(scan);
+ goto do_curly;
+ }
+ }
+ if (flags & SCF_DO_SUBSTR)
+ data->pos_min++;
+ min++;
+ /* Fall through. */
+ case STAR:
+ is_inf = is_inf_internal = 1;
+ scan = regnext(scan);
+ if (flags & SCF_DO_SUBSTR) {
+ scan_commit(data);
+ data->longest = &(data->longest_float);
+ }
+ goto optimize_curly_tail;
+ case CURLY:
+ mincount = ARG1(scan);
+ maxcount = ARG2(scan);
+ next = regnext(scan);
+ scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
+ do_curly:
+ if (flags & SCF_DO_SUBSTR) {
+ if (mincount == 0) scan_commit(data);
+ pos_before = data->pos_min;
+ }
+ if (data) {
+ fl = data->flags;
+ data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
+ if (is_inf)
+ data->flags |= SF_IS_INF;
+ }
+ /* This will finish on WHILEM, setting scan, or on NULL: */
+ minnext = study_chunk(&scan, &deltanext, last, data,
+ mincount == 0
+ ? (flags & ~SCF_DO_SUBSTR) : flags);
+ if (!scan) /* It was not CURLYX, but CURLY. */
+ scan = next;
+ if (PL_dowarn && (minnext + deltanext == 0)
+ && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
+ && maxcount <= 10000) /* Complement check for big count */
+ warn("Strange *+?{} on zero-length expression");
+ min += minnext * mincount;
+ is_inf_internal |= (maxcount == REG_INFTY
+ && (minnext + deltanext) > 0
+ || deltanext == I32_MAX);
+ is_inf |= is_inf_internal;
+ delta += (minnext + deltanext) * maxcount - minnext * mincount;
+
+ /* Try powerful optimization CURLYX => CURLYN. */
+ if ( OP(oscan) == CURLYX && data
+ && data->flags & SF_IN_PAR
+ && !(data->flags & SF_HAS_EVAL)
+ && !deltanext && minnext == 1 ) {
+ /* Try to optimize to CURLYN. */
+ regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
+ regnode *nxt1 = nxt, *nxt2;
+
+ /* Skip open. */
+ nxt = regnext(nxt);
+ if (!strchr(simple,OP(nxt))
+ && !(regkind[(U8)OP(nxt)] == EXACT
+ && *OPERAND(nxt) == 1))
+ goto nogo;
+ nxt2 = nxt;
+ nxt = regnext(nxt);
+ if (OP(nxt) != CLOSE)
+ goto nogo;
+ /* Now we know that nxt2 is the only contents: */
+ oscan->flags = ARG(nxt);
+ OP(oscan) = CURLYN;
+ OP(nxt1) = NOTHING; /* was OPEN. */
+#ifdef DEBUGGING
+ OP(nxt1 + 1) = OPTIMIZED; /* was count. */
+ NEXT_OFF(nxt1+ 1) = 0; /* just for consistancy. */
+ NEXT_OFF(nxt2) = 0; /* just for consistancy with CURLY. */
+ OP(nxt) = OPTIMIZED; /* was CLOSE. */
+ OP(nxt + 1) = OPTIMIZED; /* was count. */
+ NEXT_OFF(nxt+ 1) = 0; /* just for consistancy. */
+#endif
+ }
+ nogo:
+
+ /* Try optimization CURLYX => CURLYM. */
+ if ( OP(oscan) == CURLYX && data
+ && !(data->flags & SF_HAS_PAR)
+ && !(data->flags & SF_HAS_EVAL)
+ && !deltanext ) {
+ /* XXXX How to optimize if data == 0? */
+ /* Optimize to a simpler form. */
+ regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
+ regnode *nxt2;
+
+ OP(oscan) = CURLYM;
+ while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
+ && (OP(nxt2) != WHILEM))
+ nxt = nxt2;
+ OP(nxt2) = SUCCEED; /* Whas WHILEM */
+ /* Need to optimize away parenths. */
+ if (data->flags & SF_IN_PAR) {
+ /* Set the parenth number. */
+ regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
+
+ if (OP(nxt) != CLOSE)
+ FAIL("panic opt close");
+ oscan->flags = ARG(nxt);
+ OP(nxt1) = OPTIMIZED; /* was OPEN. */
+ OP(nxt) = OPTIMIZED; /* was CLOSE. */
+#ifdef DEBUGGING
+ OP(nxt1 + 1) = OPTIMIZED; /* was count. */
+ OP(nxt + 1) = OPTIMIZED; /* was count. */
+ NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */
+ NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */
+#endif
+#if 0
+ while ( nxt1 && (OP(nxt1) != WHILEM)) {
+ regnode *nnxt = regnext(nxt1);
+
+ if (nnxt == nxt) {
+ if (reg_off_by_arg[OP(nxt1)])
+ ARG_SET(nxt1, nxt2 - nxt1);
+ else if (nxt2 - nxt1 < U16_MAX)
+ NEXT_OFF(nxt1) = nxt2 - nxt1;
+ else
+ OP(nxt) = NOTHING; /* Cannot beautify */
+ }
+ nxt1 = nnxt;
+ }
+#endif
+ /* Optimize again: */
+ study_chunk(&nxt1, &deltanext, nxt, NULL, 0);
+ } else
+ oscan->flags = 0;
+ }
+ if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
+ pars++;
+ if (flags & SCF_DO_SUBSTR) {
+ SV *last_str = Nullsv;
+ int counted = mincount != 0;
+
+ if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
+ I32 b = pos_before >= data->last_start_min
+ ? pos_before : data->last_start_min;
+ STRLEN l;
+ char *s = SvPV(data->last_found, l);
+
+ l -= b - data->last_start_min;
+ /* Get the added string: */
+ last_str = newSVpv(s + b - data->last_start_min, l);
+ if (deltanext == 0 && pos_before == b) {
+ /* What was added is a constant string */
+ if (mincount > 1) {
+ SvGROW(last_str, (mincount * l) + 1);
+ repeatcpy(SvPVX(last_str) + l,
+ SvPVX(last_str), l, mincount - 1);
+ SvCUR(last_str) *= mincount;
+ /* Add additional parts. */
+ SvCUR_set(data->last_found,
+ SvCUR(data->last_found) - l);
+ sv_catsv(data->last_found, last_str);
+ data->last_end += l * (mincount - 1);
+ }
+ }
+ }
+ /* It is counted once already... */
+ data->pos_min += minnext * (mincount - counted);
+ data->pos_delta += - counted * deltanext +
+ (minnext + deltanext) * maxcount - minnext * mincount;
+ if (mincount != maxcount) {
+ scan_commit(data);
+ if (mincount && last_str) {
+ sv_setsv(data->last_found, last_str);
+ data->last_end = data->pos_min;
+ data->last_start_min =
+ data->pos_min - SvCUR(last_str);
+ data->last_start_max = is_inf
+ ? I32_MAX
+ : data->pos_min + data->pos_delta
+ - SvCUR(last_str);
+ }
+ data->longest = &(data->longest_float);
+ }
+ SvREFCNT_dec(last_str);
+ }
+ if (data && (fl & SF_HAS_EVAL))
+ data->flags |= SF_HAS_EVAL;
+ optimize_curly_tail:
+ if (OP(oscan) != CURLYX) {
+ while (regkind[(U8)OP(next = regnext(oscan))] == NOTHING
+ && NEXT_OFF(next))
+ NEXT_OFF(oscan) += NEXT_OFF(next);
+ }
+ continue;
+ default: /* REF only? */
+ if (flags & SCF_DO_SUBSTR) {
+ scan_commit(data);
+ data->longest = &(data->longest_float);
+ }
+ is_inf = is_inf_internal = 1;
+ break;
+ }
+ } else if (strchr(simple,OP(scan))) {
+ if (flags & SCF_DO_SUBSTR) {
+ scan_commit(data);
+ data->pos_min++;
+ }
+ min++;
+ } else if (regkind[(U8)OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
+ data->flags |= (OP(scan) == MEOL
+ ? SF_BEFORE_MEOL
+ : SF_BEFORE_SEOL);
+ } else if (regkind[(U8)OP(scan)] == BRANCHJ
+ && (scan->flags || data)
+ && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
+ I32 deltanext, minnext;
+ regnode *nscan;
+
+ data_fake.flags = 0;
+ next = regnext(scan);
+ nscan = NEXTOPER(NEXTOPER(scan));
+ minnext = study_chunk(&nscan, &deltanext, last, &data_fake, 0);
+ if (scan->flags) {
+ if (deltanext) {
+ FAIL("variable length lookbehind not implemented");
+ } else if (minnext > U8_MAX) {
+ FAIL2("lookbehind longer than %d not implemented", U8_MAX);
+ }
+ scan->flags = minnext;
+ }
+ if (data && data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
+ pars++;
+ if (data && (data_fake.flags & SF_HAS_EVAL))
+ data->flags |= SF_HAS_EVAL;
+ } else if (OP(scan) == OPEN) {
+ pars++;
+ } else if (OP(scan) == CLOSE && ARG(scan) == is_par) {
+ next = regnext(scan);
+
+ if ( next && (OP(next) != WHILEM) && next < last)
+ is_par = 0; /* Disable optimization */
+ } else if (OP(scan) == EVAL) {
+ if (data)
+ data->flags |= SF_HAS_EVAL;
+ }
+ /* Else: zero-length, ignore. */
+ scan = regnext(scan);
+ }
+
+ finish:
+ *scanp = scan;
+ *deltap = is_inf_internal ? I32_MAX : delta;
+ if (flags & SCF_DO_SUBSTR && is_inf)
+ data->pos_delta = I32_MAX - data->pos_min;
+ if (is_par > U8_MAX)
+ is_par = 0;
+ if (is_par && pars==1 && data) {
+ data->flags |= SF_IN_PAR;
+ data->flags &= ~SF_HAS_PAR;
+ } else if (pars && data) {
+ data->flags |= SF_HAS_PAR;
+ data->flags &= ~SF_IN_PAR;
+ }
+ return min;
+}
+
+STATIC I32
+add_data(I32 n, char *s)
+{
+ dTHR;
+ if (PL_regcomp_rx->data) {
+ Renewc(PL_regcomp_rx->data,
+ sizeof(*PL_regcomp_rx->data) + sizeof(void*) * (PL_regcomp_rx->data->count + n - 1),
+ char, struct reg_data);
+ Renew(PL_regcomp_rx->data->what, PL_regcomp_rx->data->count + n, U8);
+ PL_regcomp_rx->data->count += n;
+ } else {
+ Newc(1207, PL_regcomp_rx->data, sizeof(*PL_regcomp_rx->data) + sizeof(void*) * (n - 1),
+ char, struct reg_data);
+ New(1208, PL_regcomp_rx->data->what, n, U8);
+ PL_regcomp_rx->data->count = n;
+ }
+ Copy(s, PL_regcomp_rx->data->what + PL_regcomp_rx->data->count - n, n, U8);
+ return PL_regcomp_rx->data->count - n;
+}
/*
- pregcomp - compile a regular expression into internal code
@@ -128,88 +716,125 @@ static char* nextchar _((void));
* of the structure of the compiled regexp. [I'll say.]
*/
regexp *
-pregcomp(exp,xend,pm)
-char* exp;
-char* xend;
-PMOP* pm;
+pregcomp(char *exp, char *xend, PMOP *pm)
{
+ dTHR;
register regexp *r;
- register char *scan;
- register SV *longish;
- SV *longest;
- register I32 len;
- register char *first;
+ regnode *scan;
+ SV **longest;
+ SV *longest_fixed;
+ SV *longest_float;
+ regnode *first;
I32 flags;
- I32 backish;
- I32 backest;
- I32 curback;
I32 minlen = 0;
I32 sawplus = 0;
I32 sawopen = 0;
-#define MAX_REPEAT_DEPTH 12
- struct {
- char *opcode;
- I32 count;
- } repeat_stack[MAX_REPEAT_DEPTH];
- I32 repeat_depth = 0;
- I32 repeat_count = 1; /* We start unmultiplied. */
if (exp == NULL)
- croak("NULL regexp argument");
+ FAIL("NULL regexp argument");
- regprecomp = savepvn(exp, xend - exp);
- regflags = pm->op_pmflags;
- regsawback = 0;
+ PL_regprecomp = savepvn(exp, xend - exp);
+ DEBUG_r(PerlIO_printf(Perl_debug_log, "compiling RE `%*s'\n",
+ xend - exp, PL_regprecomp));
+ PL_regflags = pm->op_pmflags;
+ PL_regsawback = 0;
+
+ PL_regseen = 0;
+ PL_seen_zerolen = *exp == '^' ? -1 : 0;
+ PL_seen_evals = 0;
+ PL_extralen = 0;
/* First pass: determine size, legality. */
- regparse = exp;
- regxend = xend;
- regnaughty = 0;
- regnpar = 1;
- regsize = 0L;
- regcode = &regdummy;
- regc((char)MAGIC);
+ PL_regcomp_parse = exp;
+ PL_regxend = xend;
+ PL_regnaughty = 0;
+ PL_regnpar = 1;
+ PL_regsize = 0L;
+ PL_regcode = &PL_regdummy;
+ regc((U8)MAGIC, (char*)PL_regcode);
if (reg(0, &flags) == NULL) {
- Safefree(regprecomp);
- regprecomp = Nullch;
+ Safefree(PL_regprecomp);
+ PL_regprecomp = Nullch;
return(NULL);
}
+ DEBUG_r(PerlIO_printf(Perl_debug_log, "size %d ", PL_regsize));
+
+ DEBUG_r(
+ if (!PL_colorset) {
+ int i = 0;
+ char *s = PerlEnv_getenv("TERMCAP_COLORS");
+
+ PL_colorset = 1;
+ if (s) {
+ PL_colors[0] = s = savepv(s);
+ while (++i < 4) {
+ s = strchr(s, '\t');
+ if (!s)
+ FAIL("Not enough TABs in TERMCAP_COLORS");
+ *s = '\0';
+ PL_colors[i] = ++s;
+ }
+ } else {
+ while (i < 4)
+ PL_colors[i++] = "";
+ }
+ /* Reset colors: */
+ PerlIO_printf(Perl_debug_log, "%s%s%s%s",
+ PL_colors[0],PL_colors[1],PL_colors[2],PL_colors[3]);
+ }
+ );
- /* Small enough for pointer-storage convention? */
- if (regsize >= 32767L) /* Probably could be 65535L. */
- FAIL("regexp too big");
+ /* Small enough for pointer-storage convention?
+ If extralen==0, this means that we will not need long jumps. */
+ if (PL_regsize >= 0x10000L && PL_extralen)
+ PL_regsize += PL_extralen;
+ else
+ PL_extralen = 0;
/* Allocate space and initialize. */
- Newc(1001, r, sizeof(regexp) + (unsigned)regsize, char, regexp);
+ Newc(1001, r, sizeof(regexp) + (unsigned)PL_regsize * sizeof(regnode),
+ char, regexp);
if (r == NULL)
FAIL("regexp out of space");
+ r->refcnt = 1;
r->prelen = xend - exp;
- r->precomp = regprecomp;
+ r->precomp = PL_regprecomp;
r->subbeg = r->subbase = NULL;
+ r->nparens = PL_regnpar - 1; /* set early to validate backrefs */
+ PL_regcomp_rx = r;
/* Second pass: emit code. */
- regparse = exp;
- regxend = xend;
- regnaughty = 0;
- regnpar = 1;
- regcode = r->program;
- regc((char)MAGIC);
+ PL_regcomp_parse = exp;
+ PL_regxend = xend;
+ PL_regnaughty = 0;
+ PL_regnpar = 1;
+ PL_regcode = r->program;
+ /* Store the count of eval-groups for security checks: */
+ PL_regcode->next_off = ((PL_seen_evals > U16_MAX) ? U16_MAX : PL_seen_evals);
+ regc((U8)MAGIC, (char*) PL_regcode++);
+ r->data = 0;
if (reg(0, &flags) == NULL)
return(NULL);
/* Dig out information for optimizations. */
- pm->op_pmflags = regflags;
- r->regstart = Nullsv; /* Worst-case defaults. */
- r->reganch = 0;
- r->regmust = Nullsv;
- r->regback = -1;
- r->regstclass = Nullch;
- r->naughty = regnaughty >= 10; /* Probably an expensive pattern. */
- scan = r->program+1; /* First BRANCH. */
- if (OP(regnext(scan)) == END) {/* Only one top-level choice. */
- scan = NEXTOPER(scan);
-
+ r->reganch = pm->op_pmflags & PMf_COMPILETIME;
+ pm->op_pmflags = PL_regflags;
+ r->regstclass = NULL;
+ r->naughty = PL_regnaughty >= 10; /* Probably an expensive pattern. */
+ scan = r->program + 1; /* First BRANCH. */
+
+ /* XXXX To minimize changes to RE engine we always allocate
+ 3-units-long substrs field. */
+ Newz(1004, r->substrs, 1, struct reg_substr_data);
+
+ if (OP(scan) != BRANCH) { /* Only one top-level choice. */
+ scan_data_t data;
+ I32 fake;
+ STRLEN longest_float_length, longest_fixed_length;
+
+ StructCopy(&zero_scan_data, &data, scan_data_t);
first = scan;
+ /* Skip introductions and multiplicators >= 1. */
while ((OP(first) == OPEN && (sawopen = 1)) ||
(OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
(OP(first) == PLUS) ||
@@ -224,19 +849,14 @@ PMOP* pm;
/* Starting-point info. */
again:
- if (OP(first) == EXACT) {
- r->regstart = newSVpv(OPERAND(first)+1,*OPERAND(first));
- if (SvCUR(r->regstart) > !sawstudy)
- fbm_compile(r->regstart);
- (void)SvUPGRADE(r->regstart, SVt_PVBM);
- }
+ if (OP(first) == EXACT); /* Empty, get anchored substr later. */
else if (strchr(simple+2,OP(first)))
r->regstclass = first;
else if (regkind[(U8)OP(first)] == BOUND ||
regkind[(U8)OP(first)] == NBOUND)
r->regstclass = first;
else if (regkind[(U8)OP(first)] == BOL) {
- r->reganch |= ROPT_ANCH_BOL;
+ r->reganch |= (OP(first) == MBOL ? ROPT_ANCH_MBOL: ROPT_ANCH_BOL);
first = NEXTOPER(first);
goto again;
}
@@ -254,11 +874,12 @@ PMOP* pm;
first = NEXTOPER(first);
goto again;
}
- if (sawplus && (!sawopen || !regsawback))
+ if (sawplus && (!sawopen || !PL_regsawback))
r->reganch |= ROPT_SKIP; /* x+ must match 1st of run */
- DEBUG_r(PerlIO_printf(Perl_debug_log, "first %d next %d offset %ld\n",
- OP(first), OP(NEXTOPER(first)), (long)(first - scan)));
+ /* Scan is after the zeroth branch, first is atomic matcher. */
+ DEBUG_r(PerlIO_printf(Perl_debug_log, "first at %d\n",
+ first - scan + 1));
/*
* If there's something expensive in the r.e., find the
* longest literal string that must appear and make it the
@@ -267,157 +888,102 @@ PMOP* pm;
* and avoiding duplication strengthens checking. Not a
* strong reason, but sufficient in the absence of others.
* [Now we resolve ties in favor of the earlier string if
- * it happens that curback has been invalidated, since the
+ * it happens that c_offset_min has been invalidated, since the
* earlier string may buy us something the later one won't.]
*/
- longish = newSVpv("",0);
- longest = newSVpv("",0);
- len = 0;
minlen = 0;
- curback = 0;
- backish = 0;
- backest = 0;
- while (OP(scan) != END) {
- if (OP(scan) == BRANCH) {
- if (OP(regnext(scan)) == BRANCH) {
- curback = -30000;
- while (OP(scan) == BRANCH)
- scan = regnext(scan);
- }
- else /* single branch is ok */
- scan = NEXTOPER(scan);
- continue;
- }
- if (OP(scan) == UNLESSM) {
- curback = -30000;
- scan = regnext(scan);
- continue;
- }
- if (OP(scan) == EXACT) {
- char *t;
-
- first = scan;
- while ((t = regnext(scan)) && OP(t) == CLOSE)
- scan = t;
- minlen += *OPERAND(first) * repeat_count;
- if (curback - backish == len) {
- sv_catpvn(longish, OPERAND(first)+1,
- *OPERAND(first));
- len += *OPERAND(first);
- curback += *OPERAND(first);
- first = regnext(scan);
- }
- else if (*OPERAND(first) >= len + (curback >= 0)) {
- len = *OPERAND(first);
- sv_setpvn(longish, OPERAND(first)+1,len);
- backish = curback;
- curback += len;
- first = regnext(scan);
- }
- else
- curback += *OPERAND(first);
- }
- else if (strchr(varies,OP(scan))) {
- int tcount;
- char *next;
-
- if (repeat_depth < MAX_REPEAT_DEPTH
- && ((OP(scan) == PLUS
- && (tcount = 1)
- && (next = NEXTOPER(scan)))
- || (regkind[(U8)OP(scan)] == CURLY
- && (tcount = ARG1(scan))
- && (next = NEXTOPER(scan)+4))))
- {
- /* We treat (abc)+ as (abc)(abc)*. */
-
- /* Mark the place to return back. */
- repeat_stack[repeat_depth].opcode = regnext(scan);
- repeat_stack[repeat_depth].count = repeat_count;
- repeat_depth++;
- repeat_count *= tcount;
-
- /* Go deeper: */
- scan = next;
- continue;
- }
- else {
- curback = -30000;
- len = 0;
- if (SvCUR(longish) > SvCUR(longest)) {
- sv_setsv(longest,longish);
- backest = backish;
- }
- sv_setpvn(longish,"",0);
- }
- }
- else if (strchr(simple,OP(scan))) {
- curback++;
- minlen += repeat_count;
- len = 0;
- if (SvCUR(longish) > SvCUR(longest)) {
- sv_setsv(longest,longish);
- backest = backish;
- }
- sv_setpvn(longish,"",0);
- }
- scan = regnext(scan);
- if (!scan) { /* Go up PLUS or CURLY. */
- if (!repeat_depth--)
- croak("panic: re scan");
- scan = repeat_stack[repeat_depth].opcode;
- repeat_count = repeat_stack[repeat_depth].count;
- /* Need to submit the longest string found: */
- curback = -30000;
- len = 0;
- if (SvCUR(longish) > SvCUR(longest)) {
- sv_setsv(longest,longish);
- backest = backish;
- }
- sv_setpvn(longish,"",0);
- }
- }
- /* Prefer earlier on tie, unless we can tail match latter */
-
- if (SvCUR(longish) + (first && regkind[(U8)OP(first)] == EOL)
- > SvCUR(longest))
- {
- sv_setsv(longest,longish);
- backest = backish;
+ data.longest_fixed = newSVpv("",0);
+ data.longest_float = newSVpv("",0);
+ data.last_found = newSVpv("",0);
+ data.longest = &(data.longest_fixed);
+ first = scan;
+
+ minlen = study_chunk(&first, &fake, scan + PL_regsize, /* Up to end */
+ &data, SCF_DO_SUBSTR);
+ if ( PL_regnpar == 1 && data.longest == &(data.longest_fixed)
+ && data.last_start_min == 0 && data.last_end > 0
+ && !PL_seen_zerolen
+ && (!(PL_regseen & REG_SEEN_GPOS) || (r->reganch & ROPT_ANCH_GPOS)))
+ r->reganch |= ROPT_CHECK_ALL;
+ scan_commit(&data);
+ SvREFCNT_dec(data.last_found);
+
+ longest_float_length = SvCUR(data.longest_float);
+ if (longest_float_length
+ || (data.flags & SF_FL_BEFORE_EOL
+ && (!(data.flags & SF_FL_BEFORE_MEOL)
+ || (PL_regflags & PMf_MULTILINE)))) {
+ if (SvCUR(data.longest_fixed)
+ && data.offset_fixed == data.offset_float_min
+ && SvCUR(data.longest_fixed) == SvCUR(data.longest_float))
+ goto remove_float; /* Like in (a)+. */
+
+ r->float_substr = data.longest_float;
+ r->float_min_offset = data.offset_float_min;
+ r->float_max_offset = data.offset_float_max;
+ fbm_compile(r->float_substr, 0);
+ BmUSEFUL(r->float_substr) = 100;
+ if (data.flags & SF_FL_BEFORE_EOL /* Cannot have SEOL and MULTI */
+ && (!(data.flags & SF_FL_BEFORE_MEOL)
+ || (PL_regflags & PMf_MULTILINE)))
+ SvTAIL_on(r->float_substr);
+ } else {
+ remove_float:
+ r->float_substr = Nullsv;
+ SvREFCNT_dec(data.longest_float);
+ longest_float_length = 0;
}
- else
- sv_setpvn(longish,"",0);
- if (SvCUR(longest)
- && (!r->regstart
- || !fbm_instr((unsigned char*) SvPVX(r->regstart),
- (unsigned char *) (SvPVX(r->regstart)
- + SvCUR(r->regstart)),
- longest)))
- {
- r->regmust = longest;
- if (backest < 0)
- backest = -1;
- r->regback = backest;
- if (SvCUR(longest) > !(sawstudy ||
- (first && regkind[(U8)OP(first)] == EOL)))
- fbm_compile(r->regmust);
- (void)SvUPGRADE(r->regmust, SVt_PVBM);
- BmUSEFUL(r->regmust) = 100;
- if (first && regkind[(U8)OP(first)] == EOL && SvCUR(longish))
- SvTAIL_on(r->regmust);
+
+ longest_fixed_length = SvCUR(data.longest_fixed);
+ if (longest_fixed_length
+ || (data.flags & SF_FIX_BEFORE_EOL /* Cannot have SEOL and MULTI */
+ && (!(data.flags & SF_FIX_BEFORE_MEOL)
+ || (PL_regflags & PMf_MULTILINE)))) {
+ r->anchored_substr = data.longest_fixed;
+ r->anchored_offset = data.offset_fixed;
+ fbm_compile(r->anchored_substr, 0);
+ BmUSEFUL(r->anchored_substr) = 100;
+ if (data.flags & SF_FIX_BEFORE_EOL /* Cannot have SEOL and MULTI */
+ && (!(data.flags & SF_FIX_BEFORE_MEOL)
+ || (PL_regflags & PMf_MULTILINE)))
+ SvTAIL_on(r->anchored_substr);
+ } else {
+ r->anchored_substr = Nullsv;
+ SvREFCNT_dec(data.longest_fixed);
+ longest_fixed_length = 0;
}
- else {
- SvREFCNT_dec(longest);
- longest = Nullsv;
+
+ /* A temporary algorithm prefers floated substr to fixed one to dig more info. */
+ if (longest_fixed_length > longest_float_length) {
+ r->check_substr = r->anchored_substr;
+ r->check_offset_min = r->check_offset_max = r->anchored_offset;
+ if (r->reganch & ROPT_ANCH_SINGLE)
+ r->reganch |= ROPT_NOSCAN;
+ } else {
+ r->check_substr = r->float_substr;
+ r->check_offset_min = data.offset_float_min;
+ r->check_offset_max = data.offset_float_max;
}
- SvREFCNT_dec(longish);
+ } else {
+ /* Several toplevels. Best we can is to set minlen. */
+ I32 fake;
+
+ DEBUG_r(PerlIO_printf(Perl_debug_log, "\n"));
+ scan = r->program + 1;
+ minlen = study_chunk(&scan, &fake, scan + PL_regsize, NULL, 0);
+ r->check_substr = r->anchored_substr = r->float_substr = Nullsv;
}
- r->nparens = regnpar - 1;
r->minlen = minlen;
- Newz(1002, r->startp, regnpar, char*);
- Newz(1002, r->endp, regnpar, char*);
+ if (PL_regseen & REG_SEEN_GPOS)
+ r->reganch |= ROPT_GPOS_SEEN;
+ if (PL_regseen & REG_SEEN_LOOKBEHIND)
+ r->reganch |= ROPT_LOOKBEHIND_SEEN;
+ if (PL_regseen & REG_SEEN_EVAL)
+ r->reganch |= ROPT_EVAL_SEEN;
+ Newz(1002, r->startp, PL_regnpar, char*);
+ Newz(1002, r->endp, PL_regnpar, char*);
DEBUG_r(regdump(r));
return(r);
}
@@ -431,128 +997,300 @@ PMOP* pm;
* is a trifle forced, but the need to tie the tails of the branches to what
* follows makes it hard to avoid.
*/
-static char *
-reg(paren, flagp)
-I32 paren; /* Parenthesized? */
-I32 *flagp;
+STATIC regnode *
+reg(I32 paren, I32 *flagp)
+ /* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */
{
- register char *ret;
- register char *br;
- register char *ender = 0;
+ dTHR;
+ register regnode *ret; /* Will be the head of the group. */
+ register regnode *br;
+ register regnode *lastbr;
+ register regnode *ender = 0;
register I32 parno = 0;
- I32 flags;
+ I32 flags, oregflags = PL_regflags, have_branch = 0, open = 0;
+ char c;
- *flagp = HASWIDTH; /* Tentatively. */
+ *flagp = 0; /* Tentatively. */
/* Make an OPEN node, if parenthesized. */
if (paren) {
- if (*regparse == '?') {
- regparse++;
- paren = *regparse++;
- ret = NULL;
+ if (*PL_regcomp_parse == '?') {
+ U16 posflags = 0, negflags = 0;
+ U16 *flagsp = &posflags;
+
+ PL_regcomp_parse++;
+ paren = *PL_regcomp_parse++;
+ ret = NULL; /* For look-ahead/behind. */
switch (paren) {
- case ':':
+ case '<':
+ PL_regseen |= REG_SEEN_LOOKBEHIND;
+ if (*PL_regcomp_parse == '!')
+ paren = ',';
+ if (*PL_regcomp_parse != '=' && *PL_regcomp_parse != '!')
+ goto unknown;
+ PL_regcomp_parse++;
case '=':
case '!':
+ PL_seen_zerolen++;
+ case ':':
+ case '>':
break;
case '$':
case '@':
- croak("Sequence (?%c...) not implemented", (int)paren);
+ FAIL2("Sequence (?%c...) not implemented", (int)paren);
break;
case '#':
- while (*regparse && *regparse != ')')
- regparse++;
- if (*regparse != ')')
- croak("Sequence (?#... not terminated");
+ while (*PL_regcomp_parse && *PL_regcomp_parse != ')')
+ PL_regcomp_parse++;
+ if (*PL_regcomp_parse != ')')
+ FAIL("Sequence (?#... not terminated");
nextchar();
*flagp = TRYAGAIN;
return NULL;
+ case '{':
+ {
+ dTHR;
+ I32 count = 1, n = 0;
+ char c;
+ char *s = PL_regcomp_parse;
+ SV *sv;
+ OP_4tree *sop, *rop;
+
+ PL_seen_zerolen++;
+ PL_regseen |= REG_SEEN_EVAL;
+ while (count && (c = *PL_regcomp_parse)) {
+ if (c == '\\' && PL_regcomp_parse[1])
+ PL_regcomp_parse++;
+ else if (c == '{')
+ count++;
+ else if (c == '}')
+ count--;
+ PL_regcomp_parse++;
+ }
+ if (*PL_regcomp_parse != ')')
+ FAIL("Sequence (?{...}) not terminated or not {}-balanced");
+ if (!SIZE_ONLY) {
+ AV *av;
+
+ if (PL_regcomp_parse - 1 - s)
+ sv = newSVpv(s, PL_regcomp_parse - 1 - s);
+ else
+ sv = newSVpv("", 0);
+
+ rop = sv_compile_2op(sv, &sop, "re", &av);
+
+ n = add_data(3, "nso");
+ PL_regcomp_rx->data->data[n] = (void*)rop;
+ PL_regcomp_rx->data->data[n+1] = (void*)av;
+ PL_regcomp_rx->data->data[n+2] = (void*)sop;
+ SvREFCNT_dec(sv);
+ } else { /* First pass */
+ if (PL_reginterp_cnt < ++PL_seen_evals && PL_curcop != &PL_compiling)
+ /* No compiled RE interpolated, has runtime
+ components ===> unsafe. */
+ FAIL("Eval-group not allowed at runtime, use re 'eval'");
+ if (PL_tainted)
+ FAIL("Eval-group in insecure regular expression");
+ }
+
+ nextchar();
+ return reganode(EVAL, n);
+ }
+ case '(':
+ {
+ if (PL_regcomp_parse[0] == '?') {
+ if (PL_regcomp_parse[1] == '=' || PL_regcomp_parse[1] == '!'
+ || PL_regcomp_parse[1] == '<'
+ || PL_regcomp_parse[1] == '{') { /* Lookahead or eval. */
+ I32 flag;
+
+ ret = reg_node(LOGICAL);
+ regtail(ret, reg(1, &flag));
+ goto insert_if;
+ }
+ } else if (PL_regcomp_parse[0] >= '1' && PL_regcomp_parse[0] <= '9' ) {
+ parno = atoi(PL_regcomp_parse++);
+
+ while (isDIGIT(*PL_regcomp_parse))
+ PL_regcomp_parse++;
+ ret = reganode(GROUPP, parno);
+ if ((c = *nextchar()) != ')')
+ FAIL2("Switch (?(number%c not recognized", c);
+ insert_if:
+ regtail(ret, reganode(IFTHEN, 0));
+ br = regbranch(&flags, 1);
+ if (br == NULL)
+ br = reganode(LONGJMP, 0);
+ else
+ regtail(br, reganode(LONGJMP, 0));
+ c = *nextchar();
+ if (flags&HASWIDTH)
+ *flagp |= HASWIDTH;
+ if (c == '|') {
+ lastbr = reganode(IFTHEN, 0); /* Fake one for optimizer. */
+ regbranch(&flags, 1);
+ regtail(ret, lastbr);
+ if (flags&HASWIDTH)
+ *flagp |= HASWIDTH;
+ c = *nextchar();
+ } else
+ lastbr = NULL;
+ if (c != ')')
+ FAIL("Switch (?(condition)... contains too many branches");
+ ender = reg_node(TAIL);
+ regtail(br, ender);
+ if (lastbr) {
+ regtail(lastbr, ender);
+ regtail(NEXTOPER(NEXTOPER(lastbr)), ender);
+ } else
+ regtail(ret, ender);
+ return ret;
+ } else {
+ FAIL2("Unknown condition for (?(%.2s", PL_regcomp_parse);
+ }
+ }
case 0:
- croak("Sequence (? incomplete");
+ FAIL("Sequence (? incomplete");
break;
default:
- --regparse;
- while (*regparse && strchr("iogcmsx", *regparse))
- pmflag(&regflags, *regparse++);
- if (*regparse != ')')
- croak("Sequence (?%c...) not recognized", *regparse);
+ --PL_regcomp_parse;
+ parse_flags:
+ while (*PL_regcomp_parse && strchr("iogcmsx", *PL_regcomp_parse)) {
+ if (*PL_regcomp_parse != 'o')
+ pmflag(flagsp, *PL_regcomp_parse);
+ ++PL_regcomp_parse;
+ }
+ if (*PL_regcomp_parse == '-') {
+ flagsp = &negflags;
+ ++PL_regcomp_parse;
+ goto parse_flags;
+ }
+ PL_regflags |= posflags;
+ PL_regflags &= ~negflags;
+ if (*PL_regcomp_parse == ':') {
+ PL_regcomp_parse++;
+ paren = ':';
+ break;
+ }
+ unknown:
+ if (*PL_regcomp_parse != ')')
+ FAIL2("Sequence (?%c...) not recognized", *PL_regcomp_parse);
nextchar();
*flagp = TRYAGAIN;
return NULL;
}
}
else {
- parno = regnpar;
- regnpar++;
+ parno = PL_regnpar;
+ PL_regnpar++;
ret = reganode(OPEN, parno);
+ open = 1;
}
} else
ret = NULL;
/* Pick up the branches, linking them together. */
- br = regbranch(&flags);
+ br = regbranch(&flags, 1);
if (br == NULL)
return(NULL);
- if (ret != NULL)
- regtail(ret, br); /* OPEN -> first. */
- else
+ if (*PL_regcomp_parse == '|') {
+ if (!SIZE_ONLY && PL_extralen) {
+ reginsert(BRANCHJ, br);
+ } else
+ reginsert(BRANCH, br);
+ have_branch = 1;
+ if (SIZE_ONLY)
+ PL_extralen += 1; /* For BRANCHJ-BRANCH. */
+ } else if (paren == ':') {
+ *flagp |= flags&SIMPLE;
+ }
+ if (open) { /* Starts with OPEN. */
+ regtail(ret, br); /* OPEN -> first. */
+ } else if (paren != '?') /* Not Conditional */
ret = br;
- if (!(flags&HASWIDTH))
- *flagp &= ~HASWIDTH;
+ if (flags&HASWIDTH)
+ *flagp |= HASWIDTH;
*flagp |= flags&SPSTART;
- while (*regparse == '|') {
+ lastbr = br;
+ while (*PL_regcomp_parse == '|') {
+ if (!SIZE_ONLY && PL_extralen) {
+ ender = reganode(LONGJMP,0);
+ regtail(NEXTOPER(NEXTOPER(lastbr)), ender); /* Append to the previous. */
+ }
+ if (SIZE_ONLY)
+ PL_extralen += 2; /* Account for LONGJMP. */
nextchar();
- br = regbranch(&flags);
+ br = regbranch(&flags, 0);
if (br == NULL)
return(NULL);
- regtail(ret, br); /* BRANCH -> BRANCH. */
- if (!(flags&HASWIDTH))
- *flagp &= ~HASWIDTH;
+ regtail(lastbr, br); /* BRANCH -> BRANCH. */
+ lastbr = br;
+ if (flags&HASWIDTH)
+ *flagp |= HASWIDTH;
*flagp |= flags&SPSTART;
}
- /* Make a closing node, and hook it on the end. */
- switch (paren) {
- case ':':
- ender = regnode(NOTHING);
- break;
- case 1:
- ender = reganode(CLOSE, parno);
- break;
- case '=':
- case '!':
- ender = regnode(SUCCEED);
- *flagp &= ~HASWIDTH;
- break;
- case 0:
- ender = regnode(END);
- break;
+ if (have_branch || paren != ':') {
+ /* Make a closing node, and hook it on the end. */
+ switch (paren) {
+ case ':':
+ ender = reg_node(TAIL);
+ break;
+ case 1:
+ ender = reganode(CLOSE, parno);
+ break;
+ case '<':
+ case ',':
+ case '=':
+ case '!':
+ *flagp &= ~HASWIDTH;
+ /* FALL THROUGH */
+ case '>':
+ ender = reg_node(SUCCEED);
+ break;
+ case 0:
+ ender = reg_node(END);
+ break;
+ }
+ regtail(lastbr, ender);
+
+ if (have_branch) {
+ /* Hook the tails of the branches to the closing node. */
+ for (br = ret; br != NULL; br = regnext(br)) {
+ regoptail(br, ender);
+ }
+ }
}
- regtail(ret, ender);
- /* Hook the tails of the branches to the closing node. */
- for (br = ret; br != NULL; br = regnext(br))
- regoptail(br, ender);
+ {
+ char *p;
+ static char parens[] = "=!<,>";
- if (paren == '=') {
- reginsert(IFMATCH,ret);
- regtail(ret, regnode(NOTHING));
- }
- else if (paren == '!') {
- reginsert(UNLESSM,ret);
- regtail(ret, regnode(NOTHING));
+ if (paren && (p = strchr(parens, paren))) {
+ int node = ((p - parens) % 2) ? UNLESSM : IFMATCH;
+ int flag = (p - parens) > 1;
+
+ if (paren == '>')
+ node = SUSPEND, flag = 0;
+ reginsert(node,ret);
+ ret->flags = flag;
+ regtail(ret, reg_node(TAIL));
+ }
}
/* Check for proper termination. */
- if (paren && (regparse >= regxend || *nextchar() != ')')) {
+ if (paren && (PL_regcomp_parse >= PL_regxend || *nextchar() != ')')) {
FAIL("unmatched () in regexp");
- } else if (!paren && regparse < regxend) {
- if (*regparse == ')') {
+ } else if (!paren && PL_regcomp_parse < PL_regxend) {
+ if (*PL_regcomp_parse == ')') {
FAIL("unmatched () in regexp");
} else
FAIL("junk on end of regexp"); /* "Can't happen". */
/* NOTREACHED */
}
+ if (paren != 0) {
+ PL_regflags = oregflags;
+ }
return(ret);
}
@@ -562,40 +1300,58 @@ I32 *flagp;
*
* Implements the concatenation operator.
*/
-static char *
-regbranch(flagp)
-I32 *flagp;
+STATIC regnode *
+regbranch(I32 *flagp, I32 first)
{
- register char *ret;
- register char *chain;
- register char *latest;
- I32 flags = 0;
+ dTHR;
+ register regnode *ret;
+ register regnode *chain = NULL;
+ register regnode *latest;
+ I32 flags = 0, c = 0;
- *flagp = WORST; /* Tentatively. */
+ if (first)
+ ret = NULL;
+ else {
+ if (!SIZE_ONLY && PL_extralen)
+ ret = reganode(BRANCHJ,0);
+ else
+ ret = reg_node(BRANCH);
+ }
+
+ if (!first && SIZE_ONLY)
+ PL_extralen += 1; /* BRANCHJ */
+
+ *flagp = WORST; /* Tentatively. */
- ret = regnode(BRANCH);
- chain = NULL;
- regparse--;
+ PL_regcomp_parse--;
nextchar();
- while (regparse < regxend && *regparse != '|' && *regparse != ')') {
+ while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != '|' && *PL_regcomp_parse != ')') {
flags &= ~TRYAGAIN;
latest = regpiece(&flags);
if (latest == NULL) {
if (flags & TRYAGAIN)
continue;
return(NULL);
- }
+ } else if (ret == NULL)
+ ret = latest;
*flagp |= flags&HASWIDTH;
- if (chain == NULL) /* First piece. */
+ if (chain == NULL) /* First piece. */
*flagp |= flags&SPSTART;
else {
- regnaughty++;
+ PL_regnaughty++;
regtail(chain, latest);
}
chain = latest;
+ c++;
+ }
+ if (chain == NULL) { /* Loop ran zero times. */
+ chain = reg_node(NOTHING);
+ if (ret == NULL)
+ ret = chain;
+ }
+ if (c == 1) {
+ *flagp |= flags&SIMPLE;
}
- if (chain == NULL) /* Loop ran zero times. */
- (void) regnode(NOTHING);
return(ret);
}
@@ -609,18 +1365,18 @@ I32 *flagp;
* It might seem that this node could be dispensed with entirely, but the
* endmarker role is not redundant.
*/
-static char *
-regpiece(flagp)
-I32 *flagp;
+STATIC regnode *
+regpiece(I32 *flagp)
{
- register char *ret;
+ dTHR;
+ register regnode *ret;
register char op;
register char *next;
I32 flags;
- char *origparse = regparse;
+ char *origparse = PL_regcomp_parse;
char *maxpos;
I32 min;
- I32 max = 32767;
+ I32 max = REG_INFTY;
ret = regatom(&flags);
if (ret == NULL) {
@@ -629,18 +1385,10 @@ I32 *flagp;
return(NULL);
}
- op = *regparse;
- if (op == '(' && regparse[1] == '?' && regparse[2] == '#') {
- while (op && op != ')')
- op = *++regparse;
- if (op) {
- nextchar();
- op = *regparse;
- }
- }
+ op = *PL_regcomp_parse;
- if (op == '{' && regcurly(regparse)) {
- next = regparse + 1;
+ if (op == '{' && regcurly(PL_regcomp_parse)) {
+ next = PL_regcomp_parse + 1;
maxpos = Nullch;
while (isDIGIT(*next) || *next == ',') {
if (*next == ',') {
@@ -654,42 +1402,51 @@ I32 *flagp;
if (*next == '}') { /* got one */
if (!maxpos)
maxpos = next;
- regparse++;
- min = atoi(regparse);
+ PL_regcomp_parse++;
+ min = atoi(PL_regcomp_parse);
if (*maxpos == ',')
maxpos++;
else
- maxpos = regparse;
+ maxpos = PL_regcomp_parse;
max = atoi(maxpos);
if (!max && *maxpos != '0')
- max = 32767; /* meaning "infinity" */
- regparse = next;
+ max = REG_INFTY; /* meaning "infinity" */
+ else if (max >= REG_INFTY)
+ FAIL2("Quantifier in {,} bigger than %d", REG_INFTY - 1);
+ PL_regcomp_parse = next;
nextchar();
do_curly:
if ((flags&SIMPLE)) {
- regnaughty += 2 + regnaughty / 2;
+ PL_regnaughty += 2 + PL_regnaughty / 2;
reginsert(CURLY, ret);
}
else {
- regnaughty += 4 + regnaughty; /* compound interest */
- regtail(ret, regnode(WHILEM));
+ PL_regnaughty += 4 + PL_regnaughty; /* compound interest */
+ regtail(ret, reg_node(WHILEM));
+ if (!SIZE_ONLY && PL_extralen) {
+ reginsert(LONGJMP,ret);
+ reginsert(NOTHING,ret);
+ NEXT_OFF(ret) = 3; /* Go over LONGJMP. */
+ }
reginsert(CURLYX,ret);
- regtail(ret, regnode(NOTHING));
+ if (!SIZE_ONLY && PL_extralen)
+ NEXT_OFF(ret) = 3; /* Go over NOTHING to LONGJMP. */
+ regtail(ret, reg_node(NOTHING));
+ if (SIZE_ONLY)
+ PL_extralen += 3;
}
+ ret->flags = 0;
if (min > 0)
- *flagp = (WORST|HASWIDTH);
+ *flagp = WORST;
+ if (max > 0)
+ *flagp |= HASWIDTH;
if (max && max < min)
- croak("Can't do {n,m} with n > m");
- if (regcode != &regdummy) {
-#ifdef REGALIGN
- *(unsigned short *)(ret+3) = min;
- *(unsigned short *)(ret+5) = max;
-#else
- ret[3] = min >> 8; ret[4] = min & 0377;
- ret[5] = max >> 8; ret[6] = max & 0377;
-#endif
+ FAIL("Can't do {n,m} with n > m");
+ if (!SIZE_ONLY) {
+ ARG1_SET(ret, min);
+ ARG2_SET(ret, max);
}
goto nest_check;
@@ -701,23 +1458,27 @@ I32 *flagp;
return(ret);
}
+#if 0 /* Now runtime fix should be reliable. */
if (!(flags&HASWIDTH) && op != '?')
- FAIL("regexp *+ operand could be empty"); /* else may core dump */
+ FAIL("regexp *+ operand could be empty");
+#endif
nextchar();
- *flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);
+ *flagp = (op != '+') ? (WORST|SPSTART|HASWIDTH) : (WORST|HASWIDTH);
if (op == '*' && (flags&SIMPLE)) {
reginsert(STAR, ret);
- regnaughty += 4;
+ ret->flags = 0;
+ PL_regnaughty += 4;
}
else if (op == '*') {
min = 0;
goto do_curly;
} else if (op == '+' && (flags&SIMPLE)) {
reginsert(PLUS, ret);
- regnaughty += 3;
+ ret->flags = 0;
+ PL_regnaughty += 3;
}
else if (op == '+') {
min = 1;
@@ -727,21 +1488,17 @@ I32 *flagp;
goto do_curly;
}
nest_check:
- if (dowarn && regcode != &regdummy && !(flags&HASWIDTH) && max > 10000) {
+ if (PL_dowarn && !SIZE_ONLY && !(flags&HASWIDTH) && max > 10000) {
warn("%.*s matches null string many times",
- regparse - origparse, origparse);
+ PL_regcomp_parse - origparse, origparse);
}
- if (*regparse == '?') {
+ if (*PL_regcomp_parse == '?') {
nextchar();
reginsert(MINMOD, ret);
-#ifdef REGALIGN
- regtail(ret, ret + 4);
-#else
- regtail(ret, ret + 3);
-#endif
+ regtail(ret, ret + NODE_STEP_REGNODE);
}
- if (ISMULT2(regparse))
+ if (ISMULT2(PL_regcomp_parse))
FAIL("nested *?+ in regexp");
return(ret);
@@ -757,46 +1514,49 @@ I32 *flagp;
*
* [Yes, it is worth fixing, some scripts can run twice the speed.]
*/
-static char *
-regatom(flagp)
-I32 *flagp;
+STATIC regnode *
+regatom(I32 *flagp)
{
- register char *ret = 0;
+ dTHR;
+ register regnode *ret = 0;
I32 flags;
*flagp = WORST; /* Tentatively. */
tryagain:
- switch (*regparse) {
+ switch (*PL_regcomp_parse) {
case '^':
+ PL_seen_zerolen++;
nextchar();
- if (regflags & PMf_MULTILINE)
- ret = regnode(MBOL);
- else if (regflags & PMf_SINGLELINE)
- ret = regnode(SBOL);
+ if (PL_regflags & PMf_MULTILINE)
+ ret = reg_node(MBOL);
+ else if (PL_regflags & PMf_SINGLELINE)
+ ret = reg_node(SBOL);
else
- ret = regnode(BOL);
+ ret = reg_node(BOL);
break;
case '$':
+ if (PL_regcomp_parse[1])
+ PL_seen_zerolen++;
nextchar();
- if (regflags & PMf_MULTILINE)
- ret = regnode(MEOL);
- else if (regflags & PMf_SINGLELINE)
- ret = regnode(SEOL);
+ if (PL_regflags & PMf_MULTILINE)
+ ret = reg_node(MEOL);
+ else if (PL_regflags & PMf_SINGLELINE)
+ ret = reg_node(SEOL);
else
- ret = regnode(EOL);
+ ret = reg_node(EOL);
break;
case '.':
nextchar();
- if (regflags & PMf_SINGLELINE)
- ret = regnode(SANY);
+ if (PL_regflags & PMf_SINGLELINE)
+ ret = reg_node(SANY);
else
- ret = regnode(ANY);
- regnaughty++;
+ ret = reg_node(ANY);
+ PL_regnaughty++;
*flagp |= HASWIDTH|SIMPLE;
break;
case '[':
- regparse++;
+ PL_regcomp_parse++;
ret = regclass();
*flagp |= HASWIDTH|SIMPLE;
break;
@@ -808,7 +1568,7 @@ tryagain:
goto tryagain;
return(NULL);
}
- *flagp |= flags&(HASWIDTH|SPSTART);
+ *flagp |= flags&(HASWIDTH|SPSTART|SIMPLE);
break;
case '|':
case ')':
@@ -816,12 +1576,12 @@ tryagain:
*flagp |= TRYAGAIN;
return NULL;
}
- croak("internal urp in regexp at /%s/", regparse);
+ FAIL2("internal urp in regexp at /%s/", PL_regcomp_parse);
/* Supposed to be caught earlier. */
break;
case '{':
- if (!regcurly(regparse)) {
- regparse++;
+ if (!regcurly(PL_regcomp_parse)) {
+ PL_regcomp_parse++;
goto defchar;
}
/* FALL THROUGH */
@@ -831,59 +1591,69 @@ tryagain:
FAIL("?+*{} follows nothing in regexp");
break;
case '\\':
- switch (*++regparse) {
+ switch (*++PL_regcomp_parse) {
case 'A':
- ret = regnode(SBOL);
+ PL_seen_zerolen++;
+ ret = reg_node(SBOL);
*flagp |= SIMPLE;
nextchar();
break;
case 'G':
- ret = regnode(GPOS);
+ ret = reg_node(GPOS);
+ PL_regseen |= REG_SEEN_GPOS;
*flagp |= SIMPLE;
nextchar();
break;
case 'Z':
- ret = regnode(SEOL);
+ ret = reg_node(SEOL);
+ *flagp |= SIMPLE;
+ nextchar();
+ break;
+ case 'z':
+ ret = reg_node(EOS);
*flagp |= SIMPLE;
+ PL_seen_zerolen++; /* Do not optimize RE away */
nextchar();
break;
case 'w':
- ret = regnode((regflags & PMf_LOCALE) ? ALNUML : ALNUM);
+ ret = reg_node((PL_regflags & PMf_LOCALE) ? ALNUML : ALNUM);
*flagp |= HASWIDTH|SIMPLE;
nextchar();
break;
case 'W':
- ret = regnode((regflags & PMf_LOCALE) ? NALNUML : NALNUM);
+ ret = reg_node((PL_regflags & PMf_LOCALE) ? NALNUML : NALNUM);
*flagp |= HASWIDTH|SIMPLE;
nextchar();
break;
case 'b':
- ret = regnode((regflags & PMf_LOCALE) ? BOUNDL : BOUND);
+ PL_seen_zerolen++;
+ ret = reg_node((PL_regflags & PMf_LOCALE) ? BOUNDL : BOUND);
*flagp |= SIMPLE;
nextchar();
break;
case 'B':
- ret = regnode((regflags & PMf_LOCALE) ? NBOUNDL : NBOUND);
+ PL_seen_zerolen++;
+ ret = reg_node((PL_regflags & PMf_LOCALE) ? NBOUNDL : NBOUND);
*flagp |= SIMPLE;
nextchar();
break;
case 's':
- ret = regnode((regflags & PMf_LOCALE) ? SPACEL : SPACE);
+ ret = reg_node((PL_regflags & PMf_LOCALE) ? SPACEL : SPACE);
*flagp |= HASWIDTH|SIMPLE;
nextchar();
break;
case 'S':
- ret = regnode((regflags & PMf_LOCALE) ? NSPACEL : NSPACE);
+ ret = reg_node((PL_regflags & PMf_LOCALE) ? NSPACEL : NSPACE);
*flagp |= HASWIDTH|SIMPLE;
nextchar();
break;
case 'd':
- ret = regnode(DIGIT);
+ ret = reg_node(DIGIT);
*flagp |= HASWIDTH|SIMPLE;
nextchar();
break;
case 'D':
- ret = regnode(NDIGIT);
+ ret = reg_node(NDIGIT);
*flagp |= HASWIDTH|SIMPLE;
nextchar();
break;
@@ -900,25 +1670,27 @@ tryagain:
case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
{
- I32 num = atoi(regparse);
+ I32 num = atoi(PL_regcomp_parse);
- if (num > 9 && num >= regnpar)
+ if (num > 9 && num >= PL_regnpar)
goto defchar;
else {
- regsawback = 1;
- ret = reganode((regflags & PMf_FOLD)
- ? ((regflags & PMf_LOCALE) ? REFFL : REFF)
+ if (!SIZE_ONLY && num > PL_regcomp_rx->nparens)
+ FAIL("reference to nonexistent group");
+ PL_regsawback = 1;
+ ret = reganode((PL_regflags & PMf_FOLD)
+ ? ((PL_regflags & PMf_LOCALE) ? REFFL : REFF)
: REF, num);
*flagp |= HASWIDTH;
- while (isDIGIT(*regparse))
- regparse++;
- regparse--;
+ while (isDIGIT(*PL_regcomp_parse))
+ PL_regcomp_parse++;
+ PL_regcomp_parse--;
nextchar();
}
}
break;
case '\0':
- if (regparse >= regxend)
+ if (PL_regcomp_parse >= PL_regxend)
FAIL("trailing \\ in regexp");
/* FALL THROUGH */
default:
@@ -927,35 +1699,36 @@ tryagain:
break;
case '#':
- if (regflags & PMf_EXTENDED) {
- while (regparse < regxend && *regparse != '\n') regparse++;
- if (regparse < regxend)
+ if (PL_regflags & PMf_EXTENDED) {
+ while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != '\n') PL_regcomp_parse++;
+ if (PL_regcomp_parse < PL_regxend)
goto tryagain;
}
/* FALL THROUGH */
default: {
register I32 len;
- register char ender;
+ register U8 ender;
register char *p;
- char *oldp;
+ char *oldp, *s;
I32 numlen;
- regparse++;
+ PL_regcomp_parse++;
defchar:
- ret = regnode((regflags & PMf_FOLD)
- ? ((regflags & PMf_LOCALE) ? EXACTFL : EXACTF)
+ ret = reg_node((PL_regflags & PMf_FOLD)
+ ? ((PL_regflags & PMf_LOCALE) ? EXACTFL : EXACTF)
: EXACT);
- regc(0); /* save spot for len */
- for (len = 0, p = regparse - 1;
- len < 127 && p < regxend;
+ s = (char *) OPERAND(ret);
+ regc(0, s++); /* save spot for len */
+ for (len = 0, p = PL_regcomp_parse - 1;
+ len < 127 && p < PL_regxend;
len++)
{
oldp = p;
- if (regflags & PMf_EXTENDED)
- p = regwhite(p, regxend);
+ if (PL_regflags & PMf_EXTENDED)
+ p = regwhite(p, PL_regxend);
switch (*p) {
case '^':
case '$':
@@ -970,6 +1743,7 @@ tryagain:
case 'A':
case 'G':
case 'Z':
+ case 'z':
case 'w':
case 'W':
case 'b':
@@ -1016,7 +1790,7 @@ tryagain:
case '0': case '1': case '2': case '3':case '4':
case '5': case '6': case '7': case '8':case '9':
if (*p == '0' ||
- (isDIGIT(p[1]) && atoi(p) >= regnpar) ) {
+ (isDIGIT(p[1]) && atoi(p) >= PL_regnpar) ) {
ender = scan_oct(p, 3, &numlen);
p += numlen;
}
@@ -1026,7 +1800,7 @@ tryagain:
}
break;
case '\0':
- if (p >= regxend)
+ if (p >= PL_regxend)
FAIL("trailing \\ in regexp");
/* FALL THROUGH */
default:
@@ -1038,21 +1812,21 @@ tryagain:
ender = *p++;
break;
}
- if (regflags & PMf_EXTENDED)
- p = regwhite(p, regxend);
+ if (PL_regflags & PMf_EXTENDED)
+ p = regwhite(p, PL_regxend);
if (ISMULT2(p)) { /* Back off on ?+*. */
if (len)
p = oldp;
else {
len++;
- regc(ender);
+ regc(ender, s++);
}
break;
}
- regc(ender);
+ regc(ender, s++);
}
loopdone:
- regparse = p - 1;
+ PL_regcomp_parse = p - 1;
nextchar();
if (len < 0)
FAIL("internal disaster in regexp");
@@ -1060,9 +1834,14 @@ tryagain:
*flagp |= HASWIDTH;
if (len == 1)
*flagp |= SIMPLE;
- if (regcode != &regdummy)
+ if (!SIZE_ONLY)
*OPERAND(ret) = len;
- regc('\0');
+ regc('\0', s++);
+ if (SIZE_ONLY) {
+ PL_regsize += (len + 2 + sizeof(regnode) - 1) / sizeof(regnode);
+ } else {
+ PL_regcode += (len + 2 + sizeof(regnode) - 1) / sizeof(regnode);
+ }
}
break;
}
@@ -1070,10 +1849,8 @@ tryagain:
return(ret);
}
-static char *
-regwhite(p, e)
-char *p;
-char *e;
+STATIC char *
+regwhite(char *p, char *e)
{
while (p < e) {
if (isSPACE(*p))
@@ -1089,194 +1866,250 @@ char *e;
return p;
}
-static void
-regset(opnd, c)
-char *opnd;
-register I32 c;
-{
- if (opnd == &regdummy)
- return;
- c &= 0xFF;
- opnd[1 + (c >> 3)] |= (1 << (c & 7));
-}
-
-static char *
-regclass()
+STATIC regnode *
+regclass(void)
{
- register char *opnd;
- register I32 class;
+ dTHR;
+ register char *opnd, *s;
+ register I32 Class;
register I32 lastclass = 1234;
register I32 range = 0;
- register char *ret;
+ register regnode *ret;
register I32 def;
I32 numlen;
- ret = regnode(ANYOF);
- opnd = regcode;
- for (class = 0; class < 33; class++)
- regc(0);
- if (*regparse == '^') { /* Complement of range. */
- regnaughty++;
- regparse++;
- if (opnd != &regdummy)
+ s = opnd = (char *) OPERAND(PL_regcode);
+ ret = reg_node(ANYOF);
+ for (Class = 0; Class < 33; Class++)
+ regc(0, s++);
+ if (*PL_regcomp_parse == '^') { /* Complement of range. */
+ PL_regnaughty++;
+ PL_regcomp_parse++;
+ if (!SIZE_ONLY)
*opnd |= ANYOF_INVERT;
}
- if (opnd != &regdummy) {
- if (regflags & PMf_FOLD)
+ if (!SIZE_ONLY) {
+ PL_regcode += ANY_SKIP;
+ if (PL_regflags & PMf_FOLD)
*opnd |= ANYOF_FOLD;
- if (regflags & PMf_LOCALE)
+ if (PL_regflags & PMf_LOCALE)
*opnd |= ANYOF_LOCALE;
+ } else {
+ PL_regsize += ANY_SKIP;
}
- if (*regparse == ']' || *regparse == '-')
+ if (*PL_regcomp_parse == ']' || *PL_regcomp_parse == '-')
goto skipcond; /* allow 1st char to be ] or - */
- while (regparse < regxend && *regparse != ']') {
+ while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != ']') {
skipcond:
- class = UCHARAT(regparse++);
- if (class == '\\') {
- class = UCHARAT(regparse++);
- switch (class) {
+ Class = UCHARAT(PL_regcomp_parse++);
+ if (Class == '[' && PL_regcomp_parse + 1 < PL_regxend &&
+ /* I smell either [: or [= or [. -- POSIX has been here, right? */
+ (*PL_regcomp_parse == ':' || *PL_regcomp_parse == '=' || *PL_regcomp_parse == '.')) {
+ char posixccc = *PL_regcomp_parse;
+ char* posixccs = PL_regcomp_parse++;
+
+ while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != posixccc)
+ PL_regcomp_parse++;
+ if (PL_regcomp_parse == PL_regxend)
+ /* Grandfather lone [:, [=, [. */
+ PL_regcomp_parse = posixccs;
+ else {
+ PL_regcomp_parse++; /* skip over the posixccc */
+ if (*PL_regcomp_parse == ']') {
+ /* Not Implemented Yet.
+ * (POSIX Extended Character Classes, that is)
+ * The text between e.g. [: and :] would start
+ * at posixccs + 1 and stop at regcomp_parse - 2. */
+ if (PL_dowarn && !SIZE_ONLY)
+ warn("Character class syntax [%c %c] is reserved for future extensions", posixccc, posixccc);
+ PL_regcomp_parse++; /* skip over the ending ] */
+ }
+ }
+ }
+ if (Class == '\\') {
+ Class = UCHARAT(PL_regcomp_parse++);
+ switch (Class) {
case 'w':
- if (regflags & PMf_LOCALE) {
- if (opnd != &regdummy)
+ if (!SIZE_ONLY) {
+ if (PL_regflags & PMf_LOCALE)
*opnd |= ANYOF_ALNUML;
- }
- else {
- for (class = 0; class < 256; class++)
- if (isALNUM(class))
- regset(opnd, class);
+ else {
+ for (Class = 0; Class < 256; Class++)
+ if (isALNUM(Class))
+ ANYOF_SET(opnd, Class);
+ }
}
lastclass = 1234;
continue;
case 'W':
- if (regflags & PMf_LOCALE) {
- if (opnd != &regdummy)
+ if (!SIZE_ONLY) {
+ if (PL_regflags & PMf_LOCALE)
*opnd |= ANYOF_NALNUML;
- }
- else {
- for (class = 0; class < 256; class++)
- if (!isALNUM(class))
- regset(opnd, class);
+ else {
+ for (Class = 0; Class < 256; Class++)
+ if (!isALNUM(Class))
+ ANYOF_SET(opnd, Class);
+ }
}
lastclass = 1234;
continue;
case 's':
- if (regflags & PMf_LOCALE) {
- if (opnd != &regdummy)
+ if (!SIZE_ONLY) {
+ if (PL_regflags & PMf_LOCALE)
*opnd |= ANYOF_SPACEL;
- }
- else {
- for (class = 0; class < 256; class++)
- if (isSPACE(class))
- regset(opnd, class);
+ else {
+ for (Class = 0; Class < 256; Class++)
+ if (isSPACE(Class))
+ ANYOF_SET(opnd, Class);
+ }
}
lastclass = 1234;
continue;
case 'S':
- if (regflags & PMf_LOCALE) {
- if (opnd != &regdummy)
+ if (!SIZE_ONLY) {
+ if (PL_regflags & PMf_LOCALE)
*opnd |= ANYOF_NSPACEL;
- }
- else {
- for (class = 0; class < 256; class++)
- if (!isSPACE(class))
- regset(opnd, class);
+ else {
+ for (Class = 0; Class < 256; Class++)
+ if (!isSPACE(Class))
+ ANYOF_SET(opnd, Class);
+ }
}
lastclass = 1234;
continue;
case 'd':
- for (class = '0'; class <= '9'; class++)
- regset(opnd, class);
+ if (!SIZE_ONLY) {
+ for (Class = '0'; Class <= '9'; Class++)
+ ANYOF_SET(opnd, Class);
+ }
lastclass = 1234;
continue;
case 'D':
- for (class = 0; class < '0'; class++)
- regset(opnd, class);
- for (class = '9' + 1; class < 256; class++)
- regset(opnd, class);
+ if (!SIZE_ONLY) {
+ for (Class = 0; Class < '0'; Class++)
+ ANYOF_SET(opnd, Class);
+ for (Class = '9' + 1; Class < 256; Class++)
+ ANYOF_SET(opnd, Class);
+ }
lastclass = 1234;
continue;
case 'n':
- class = '\n';
+ Class = '\n';
break;
case 'r':
- class = '\r';
+ Class = '\r';
break;
case 't':
- class = '\t';
+ Class = '\t';
break;
case 'f':
- class = '\f';
+ Class = '\f';
break;
case 'b':
- class = '\b';
+ Class = '\b';
break;
case 'e':
- class = '\033';
+ Class = '\033';
break;
case 'a':
- class = '\007';
+ Class = '\007';
break;
case 'x':
- class = scan_hex(regparse, 2, &numlen);
- regparse += numlen;
+ Class = scan_hex(PL_regcomp_parse, 2, &numlen);
+ PL_regcomp_parse += numlen;
break;
case 'c':
- class = UCHARAT(regparse++);
- class = toCTRL(class);
+ Class = UCHARAT(PL_regcomp_parse++);
+ Class = toCTRL(Class);
break;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
- class = scan_oct(--regparse, 3, &numlen);
- regparse += numlen;
+ Class = scan_oct(--PL_regcomp_parse, 3, &numlen);
+ PL_regcomp_parse += numlen;
break;
}
}
if (range) {
- if (lastclass > class)
+ if (lastclass > Class)
FAIL("invalid [] range in regexp");
range = 0;
}
else {
- lastclass = class;
- if (*regparse == '-' && regparse+1 < regxend &&
- regparse[1] != ']') {
- regparse++;
+ lastclass = Class;
+ if (*PL_regcomp_parse == '-' && PL_regcomp_parse+1 < PL_regxend &&
+ PL_regcomp_parse[1] != ']') {
+ PL_regcomp_parse++;
range = 1;
continue; /* do it next time */
}
}
- for ( ; lastclass <= class; lastclass++)
- regset(opnd, lastclass);
- lastclass = class;
+ if (!SIZE_ONLY) {
+#ifndef ASCIIish
+ register I32 i;
+ if ((isLOWER(lastclass) && isLOWER(Class)) ||
+ (isUPPER(lastclass) && isUPPER(Class))) {
+ if (isLOWER(lastclass)) {
+ for (i = lastclass; i <= Class; i++)
+ if (isLOWER(i))
+ ANYOF_SET(opnd, i);
+ } else {
+ for (i = lastclass; i <= Class; i++)
+ if (isUPPER(i))
+ ANYOF_SET(opnd, i);
+ }
+ }
+ else
+#endif
+ for ( ; lastclass <= Class; lastclass++)
+ ANYOF_SET(opnd, lastclass);
+ }
+ lastclass = Class;
}
- if (*regparse != ']')
+ if (*PL_regcomp_parse != ']')
FAIL("unmatched [] in regexp");
nextchar();
+ /* optimize case-insensitive simple patterns (e.g. /[a-z]/i) */
+ if (!SIZE_ONLY && (*opnd & (0xFF ^ ANYOF_INVERT)) == ANYOF_FOLD) {
+ for (Class = 0; Class < 256; ++Class) {
+ if (ANYOF_TEST(opnd, Class)) {
+ I32 cf = fold[Class];
+ ANYOF_SET(opnd, cf);
+ }
+ }
+ *opnd &= ~ANYOF_FOLD;
+ }
+ /* optimize inverted simple patterns (e.g. [^a-z]) */
+ if (!SIZE_ONLY && (*opnd & 0xFF) == ANYOF_INVERT) {
+ for (Class = 0; Class < 32; ++Class)
+ opnd[1 + Class] ^= 0xFF;
+ *opnd = 0;
+ }
return ret;
}
-static char*
-nextchar()
+STATIC char*
+nextchar(void)
{
- char* retval = regparse++;
+ dTHR;
+ char* retval = PL_regcomp_parse++;
for (;;) {
- if (*regparse == '(' && regparse[1] == '?' &&
- regparse[2] == '#') {
- while (*regparse && *regparse != ')')
- regparse++;
- regparse++;
+ if (*PL_regcomp_parse == '(' && PL_regcomp_parse[1] == '?' &&
+ PL_regcomp_parse[2] == '#') {
+ while (*PL_regcomp_parse && *PL_regcomp_parse != ')')
+ PL_regcomp_parse++;
+ PL_regcomp_parse++;
continue;
}
- if (regflags & PMf_EXTENDED) {
- if (isSPACE(*regparse)) {
- regparse++;
+ if (PL_regflags & PMf_EXTENDED) {
+ if (isSPACE(*PL_regcomp_parse)) {
+ PL_regcomp_parse++;
continue;
}
- else if (*regparse == '#') {
- while (*regparse && *regparse != '\n')
- regparse++;
- regparse++;
+ else if (*PL_regcomp_parse == '#') {
+ while (*PL_regcomp_parse && *PL_regcomp_parse != '\n')
+ PL_regcomp_parse++;
+ PL_regcomp_parse++;
continue;
}
}
@@ -1285,41 +2118,26 @@ nextchar()
}
/*
-- regnode - emit a node
+- reg_node - emit a node
*/
-#ifdef CAN_PROTOTYPE
-static char * /* Location. */
-regnode(char op)
-#else
-static char * /* Location. */
-regnode(op)
-char op;
-#endif
+STATIC regnode * /* Location. */
+reg_node(U8 op)
{
- register char *ret;
- register char *ptr;
-
- ret = regcode;
- if (ret == &regdummy) {
-#ifdef REGALIGN
- if (!(regsize & 1))
- regsize++;
-#endif
- regsize += 3;
+ dTHR;
+ register regnode *ret;
+ register regnode *ptr;
+
+ ret = PL_regcode;
+ if (SIZE_ONLY) {
+ SIZE_ALIGN(PL_regsize);
+ PL_regsize += 1;
return(ret);
}
-#ifdef REGALIGN
-#ifndef lint
- if (!((long)ret & 1))
- *ret++ = 127;
-#endif
-#endif
+ NODE_ALIGN_FILL(ret);
ptr = ret;
- *ptr++ = op;
- *ptr++ = '\0'; /* Null "next" pointer. */
- *ptr++ = '\0';
- regcode = ptr;
+ FILL_ADVANCE_NODE(ptr, op);
+ PL_regcode = ptr;
return(ret);
}
@@ -1327,46 +2145,24 @@ char op;
/*
- reganode - emit a node with an argument
*/
-#ifdef CAN_PROTOTYPE
-static char * /* Location. */
-reganode(char op, unsigned short arg)
-#else
-static char * /* Location. */
-reganode(op, arg)
-char op;
-unsigned short arg;
-#endif
+STATIC regnode * /* Location. */
+reganode(U8 op, U32 arg)
{
- register char *ret;
- register char *ptr;
-
- ret = regcode;
- if (ret == &regdummy) {
-#ifdef REGALIGN
- if (!(regsize & 1))
- regsize++;
-#endif
- regsize += 5;
+ dTHR;
+ register regnode *ret;
+ register regnode *ptr;
+
+ ret = PL_regcode;
+ if (SIZE_ONLY) {
+ SIZE_ALIGN(PL_regsize);
+ PL_regsize += 2;
return(ret);
}
-#ifdef REGALIGN
-#ifndef lint
- if (!((long)ret & 1))
- *ret++ = 127;
-#endif
-#endif
+ NODE_ALIGN_FILL(ret);
ptr = ret;
- *ptr++ = op;
- *ptr++ = '\0'; /* Null "next" pointer. */
- *ptr++ = '\0';
-#ifdef REGALIGN
- *(unsigned short *)(ret+3) = arg;
-#else
- ret[3] = arg >> 8; ret[4] = arg & 0377;
-#endif
- ptr += 2;
- regcode = ptr;
+ FILL_ADVANCE_NODE_ARG(ptr, op, arg);
+ PL_regcode = ptr;
return(ret);
}
@@ -1374,19 +2170,12 @@ unsigned short arg;
/*
- regc - emit (if appropriate) a byte of code
*/
-#ifdef CAN_PROTOTYPE
-static void
-regc(char b)
-#else
-static void
-regc(b)
-char b;
-#endif
+STATIC void
+regc(U8 b, char* s)
{
- if (regcode != &regdummy)
- *regcode++ = b;
- else
- regsize++;
+ dTHR;
+ if (!SIZE_ONLY)
+ *s = b;
}
/*
@@ -1394,64 +2183,46 @@ char b;
*
* Means relocating the operand.
*/
-#ifdef CAN_PROTOTYPE
-static void
-reginsert(char op, char *opnd)
-#else
-static void
-reginsert(op, opnd)
-char op;
-char *opnd;
-#endif
+STATIC void
+reginsert(U8 op, regnode *opnd)
{
- register char *src;
- register char *dst;
- register char *place;
- register int offset = (regkind[(U8)op] == CURLY ? 4 : 0);
-
- if (regcode == &regdummy) {
-#ifdef REGALIGN
- regsize += 4 + offset;
-#else
- regsize += 3 + offset;
-#endif
+ dTHR;
+ register regnode *src;
+ register regnode *dst;
+ register regnode *place;
+ register int offset = regarglen[(U8)op];
+
+/* (regkind[(U8)op] == CURLY ? EXTRA_STEP_2ARGS : 0); */
+
+ if (SIZE_ONLY) {
+ PL_regsize += NODE_STEP_REGNODE + offset;
return;
}
- src = regcode;
-#ifdef REGALIGN
- regcode += 4 + offset;
-#else
- regcode += 3 + offset;
-#endif
- dst = regcode;
+ src = PL_regcode;
+ PL_regcode += NODE_STEP_REGNODE + offset;
+ dst = PL_regcode;
while (src > opnd)
- *--dst = *--src;
+ StructCopy(--src, --dst, regnode);
place = opnd; /* Op node, where operand used to be. */
- *place++ = op;
- *place++ = '\0';
- *place++ = '\0';
- while (offset-- > 0)
- *place++ = '\0';
-#ifdef REGALIGN
- *place++ = '\177';
-#endif
+ src = NEXTOPER(place);
+ FILL_ADVANCE_NODE(place, op);
+ Zero(src, offset, regnode);
}
/*
-- regtail - set the next-pointer at the end of a node chain
+- regtail - set the next-pointer at the end of a node chain of p to val.
*/
-static void
-regtail(p, val)
-char *p;
-char *val;
+STATIC void
+regtail(regnode *p, regnode *val)
{
- register char *scan;
- register char *temp;
+ dTHR;
+ register regnode *scan;
+ register regnode *temp;
register I32 offset;
- if (p == &regdummy)
+ if (SIZE_ONLY)
return;
/* Find last node. */
@@ -1463,43 +2234,36 @@ char *val;
scan = temp;
}
-#ifdef REGALIGN
- offset = val - scan;
-#ifndef lint
- *(short*)(scan+1) = offset;
-#else
- offset = offset;
-#endif
-#else
- if (OP(scan) == BACK)
- offset = scan - val;
- else
- offset = val - scan;
- *(scan+1) = (offset>>8)&0377;
- *(scan+2) = offset&0377;
-#endif
+ if (reg_off_by_arg[OP(scan)]) {
+ ARG_SET(scan, val - scan);
+ } else {
+ NEXT_OFF(scan) = val - scan;
+ }
}
/*
- regoptail - regtail on operand of first argument; nop if operandless
*/
-static void
-regoptail(p, val)
-char *p;
-char *val;
+STATIC void
+regoptail(regnode *p, regnode *val)
{
+ dTHR;
/* "Operandless" and "op != BRANCH" are synonymous in practice. */
- if (p == NULL || p == &regdummy || regkind[(U8)OP(p)] != BRANCH)
+ if (p == NULL || SIZE_ONLY)
+ return;
+ if (regkind[(U8)OP(p)] == BRANCH) {
+ regtail(NEXTOPER(p), val);
+ } else if ( regkind[(U8)OP(p)] == BRANCHJ) {
+ regtail(NEXTOPER(NEXTOPER(p)), val);
+ } else
return;
- regtail(NEXTOPER(p), val);
}
/*
- regcurly - a little FSA that accepts {\d+,?\d*}
*/
STATIC I32
-regcurly(s)
-register char *s;
+regcurly(register char *s)
{
if (*s++ != '{')
return FALSE;
@@ -1516,58 +2280,109 @@ register char *s;
return TRUE;
}
+
+STATIC regnode *
+dumpuntil(regnode *start, regnode *node, regnode *last, SV* sv, I32 l)
+{
#ifdef DEBUGGING
+ register char op = EXACT; /* Arbitrary non-END op. */
+ register regnode *next, *onode;
+
+ while (op != END && (!last || node < last)) {
+ /* While that wasn't END last time... */
+
+ NODE_ALIGN(node);
+ op = OP(node);
+ if (op == CLOSE)
+ l--;
+ next = regnext(node);
+ /* Where, what. */
+ if (OP(node) == OPTIMIZED)
+ goto after_print;
+ regprop(sv, node);
+ PerlIO_printf(Perl_debug_log, "%4d:%*s%s", node - start,
+ 2*l + 1, "", SvPVX(sv));
+ if (next == NULL) /* Next ptr. */
+ PerlIO_printf(Perl_debug_log, "(0)");
+ else
+ PerlIO_printf(Perl_debug_log, "(%d)", next - start);
+ (void)PerlIO_putc(Perl_debug_log, '\n');
+ after_print:
+ if (regkind[(U8)op] == BRANCHJ) {
+ register regnode *nnode = (OP(next) == LONGJMP
+ ? regnext(next)
+ : next);
+ if (last && nnode > last)
+ nnode = last;
+ node = dumpuntil(start, NEXTOPER(NEXTOPER(node)), nnode, sv, l + 1);
+ } else if (regkind[(U8)op] == BRANCH) {
+ node = dumpuntil(start, NEXTOPER(node), next, sv, l + 1);
+ } else if ( op == CURLY) { /* `next' might be very big: optimizer */
+ node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS,
+ NEXTOPER(node) + EXTRA_STEP_2ARGS + 1, sv, l + 1);
+ } else if (regkind[(U8)op] == CURLY && op != CURLYX) {
+ node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS,
+ next, sv, l + 1);
+ } else if ( op == PLUS || op == STAR) {
+ node = dumpuntil(start, NEXTOPER(node), NEXTOPER(node) + 1, sv, l + 1);
+ } else if (op == ANYOF) {
+ node = NEXTOPER(node);
+ node += ANY_SKIP;
+ } else if (regkind[(U8)op] == EXACT) {
+ /* Literal string, where present. */
+ node += ((*OPERAND(node)) + 2 + sizeof(regnode) - 1) / sizeof(regnode);
+ node = NEXTOPER(node);
+ } else {
+ node = NEXTOPER(node);
+ node += regarglen[(U8)op];
+ }
+ if (op == CURLYX || op == OPEN)
+ l++;
+ else if (op == WHILEM)
+ l--;
+ }
+#endif /* DEBUGGING */
+ return node;
+}
/*
- regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
*/
void
-regdump(r)
-regexp *r;
+regdump(regexp *r)
{
- register char *s;
- register char op = EXACT; /* Arbitrary non-END op. */
- register char *next;
+#ifdef DEBUGGING
+ dTHR;
SV *sv = sv_newmortal();
- s = r->program + 1;
- while (op != END) { /* While that wasn't END last time... */
-#ifdef REGALIGN
- if (!((long)s & 1))
- s++;
-#endif
- op = OP(s);
- /* where, what */
- regprop(sv, s);
- PerlIO_printf(Perl_debug_log, "%2ld%s", (long)(s - r->program), SvPVX(sv));
- next = regnext(s);
- s += regarglen[(U8)op];
- if (next == NULL) /* Next ptr. */
- PerlIO_printf(Perl_debug_log, "(0)");
- else
- PerlIO_printf(Perl_debug_log, "(%ld)", (long)(s-r->program)+(next-s));
- s += 3;
- if (op == ANYOF) {
- s += 33;
- }
- if (regkind[(U8)op] == EXACT) {
- /* Literal string, where present. */
- s++;
- (void)PerlIO_putc(Perl_debug_log, ' ');
- (void)PerlIO_putc(Perl_debug_log, '<');
- while (*s != '\0') {
- (void)PerlIO_putc(Perl_debug_log,*s);
- s++;
- }
- (void)PerlIO_putc(Perl_debug_log, '>');
- s++;
- }
- (void)PerlIO_putc(Perl_debug_log, '\n');
- }
+ (void)dumpuntil(r->program, r->program + 1, NULL, sv, 0);
/* Header fields of interest. */
- if (r->regstart)
- PerlIO_printf(Perl_debug_log, "start `%s' ", SvPVX(r->regstart));
+ if (r->anchored_substr)
+ PerlIO_printf(Perl_debug_log, "anchored `%s%s%s'%s at %d ",
+ PL_colors[0],
+ SvPVX(r->anchored_substr),
+ PL_colors[1],
+ SvTAIL(r->anchored_substr) ? "$" : "",
+ r->anchored_offset);
+ if (r->float_substr)
+ PerlIO_printf(Perl_debug_log, "floating `%s%s%s'%s at %d..%u ",
+ PL_colors[0],
+ SvPVX(r->float_substr),
+ PL_colors[1],
+ SvTAIL(r->float_substr) ? "$" : "",
+ r->float_min_offset, r->float_max_offset);
+ if (r->check_substr)
+ PerlIO_printf(Perl_debug_log,
+ r->check_substr == r->float_substr
+ ? "(checking floating" : "(checking anchored");
+ if (r->reganch & ROPT_NOSCAN)
+ PerlIO_printf(Perl_debug_log, " noscan");
+ if (r->reganch & ROPT_CHECK_ALL)
+ PerlIO_printf(Perl_debug_log, " isall");
+ if (r->check_substr)
+ PerlIO_printf(Perl_debug_log, ") ");
+
if (r->regstclass) {
regprop(sv, r->regstclass);
PerlIO_printf(Perl_debug_log, "stclass `%s' ", SvPVX(sv));
@@ -1576,33 +2391,37 @@ regexp *r;
PerlIO_printf(Perl_debug_log, "anchored");
if (r->reganch & ROPT_ANCH_BOL)
PerlIO_printf(Perl_debug_log, "(BOL)");
+ if (r->reganch & ROPT_ANCH_MBOL)
+ PerlIO_printf(Perl_debug_log, "(MBOL)");
if (r->reganch & ROPT_ANCH_GPOS)
PerlIO_printf(Perl_debug_log, "(GPOS)");
PerlIO_putc(Perl_debug_log, ' ');
}
+ if (r->reganch & ROPT_GPOS_SEEN)
+ PerlIO_printf(Perl_debug_log, "GPOS ");
if (r->reganch & ROPT_SKIP)
PerlIO_printf(Perl_debug_log, "plus ");
if (r->reganch & ROPT_IMPLICIT)
PerlIO_printf(Perl_debug_log, "implicit ");
- if (r->regmust != NULL)
- PerlIO_printf(Perl_debug_log, "must have \"%s\" back %ld ", SvPVX(r->regmust),
- (long) r->regback);
PerlIO_printf(Perl_debug_log, "minlen %ld ", (long) r->minlen);
+ if (r->reganch & ROPT_EVAL_SEEN)
+ PerlIO_printf(Perl_debug_log, "with eval ");
PerlIO_printf(Perl_debug_log, "\n");
+#endif /* DEBUGGING */
}
/*
- regprop - printable representation of opcode
*/
void
-regprop(sv, op)
-SV *sv;
-char *op;
+regprop(SV *sv, regnode *o)
{
+#ifdef DEBUGGING
+ dTHR;
register char *p = 0;
- sv_setpv(sv, ":");
- switch (OP(op)) {
+ sv_setpvn(sv, "", 0);
+ switch (OP(o)) {
case BOL:
p = "BOL";
break;
@@ -1615,6 +2434,9 @@ char *op;
case EOL:
p = "EOL";
break;
+ case EOS:
+ p = "EOS";
+ break;
case MEOL:
p = "MEOL";
break;
@@ -1634,17 +2456,20 @@ char *op;
p = "BRANCH";
break;
case EXACT:
- p = "EXACT";
+ sv_catpvf(sv, "EXACT <%s%s%s>", PL_colors[0], OPERAND(o) + 1, PL_colors[1]);
break;
case EXACTF:
- p = "EXACTF";
+ sv_catpvf(sv, "EXACTF <%s%s%s>", PL_colors[0], OPERAND(o) + 1, PL_colors[1]);
break;
case EXACTFL:
- p = "EXACTFL";
+ sv_catpvf(sv, "EXACTFL <%s%s%s>", PL_colors[0], OPERAND(o) + 1, PL_colors[1]);
break;
case NOTHING:
p = "NOTHING";
break;
+ case TAIL:
+ p = "TAIL";
+ break;
case BACK:
p = "BACK";
break;
@@ -1664,25 +2489,31 @@ char *op;
p = "NBOUNDL";
break;
case CURLY:
- sv_catpvf(sv, "CURLY {%d,%d}", ARG1(op), ARG2(op));
+ sv_catpvf(sv, "CURLY {%d,%d}", ARG1(o), ARG2(o));
+ break;
+ case CURLYM:
+ sv_catpvf(sv, "CURLYM[%d] {%d,%d}", o->flags, ARG1(o), ARG2(o));
+ break;
+ case CURLYN:
+ sv_catpvf(sv, "CURLYN[%d] {%d,%d}", o->flags, ARG1(o), ARG2(o));
break;
case CURLYX:
- sv_catpvf(sv, "CURLYX {%d,%d}", ARG1(op), ARG2(op));
+ sv_catpvf(sv, "CURLYX {%d,%d}", ARG1(o), ARG2(o));
break;
case REF:
- sv_catpvf(sv, "REF%d", ARG1(op));
+ sv_catpvf(sv, "REF%d", ARG(o));
break;
case REFF:
- sv_catpvf(sv, "REFF%d", ARG1(op));
+ sv_catpvf(sv, "REFF%d", ARG(o));
break;
case REFFL:
- sv_catpvf(sv, "REFFL%d", ARG1(op));
+ sv_catpvf(sv, "REFFL%d", ARG(o));
break;
case OPEN:
- sv_catpvf(sv, "OPEN%d", ARG1(op));
+ sv_catpvf(sv, "OPEN%d", ARG(o));
break;
case CLOSE:
- sv_catpvf(sv, "CLOSE%d", ARG1(op));
+ sv_catpvf(sv, "CLOSE%d", ARG(o));
p = NULL;
break;
case STAR:
@@ -1698,10 +2529,10 @@ char *op;
p = "GPOS";
break;
case UNLESSM:
- p = "UNLESSM";
+ sv_catpvf(sv, "UNLESSM[-%d]", o->flags);
break;
case IFMATCH:
- p = "IFMATCH";
+ sv_catpvf(sv, "IFMATCH[-%d]", o->flags);
break;
case SUCCEED:
p = "SUCCEED";
@@ -1739,37 +2570,128 @@ char *op;
case NSPACEL:
p = "NSPACEL";
break;
+ case EVAL:
+ p = "EVAL";
+ break;
+ case LONGJMP:
+ p = "LONGJMP";
+ break;
+ case BRANCHJ:
+ p = "BRANCHJ";
+ break;
+ case IFTHEN:
+ p = "IFTHEN";
+ break;
+ case GROUPP:
+ sv_catpvf(sv, "GROUPP%d", ARG(o));
+ break;
+ case LOGICAL:
+ p = "LOGICAL";
+ break;
+ case SUSPEND:
+ p = "SUSPEND";
+ break;
+ case RENUM:
+ p = "RENUM";
+ break;
+ case OPTIMIZED:
+ p = "OPTIMIZED";
+ break;
default:
FAIL("corrupted regexp opcode");
}
if (p)
sv_catpv(sv, p);
+#endif /* DEBUGGING */
}
-#endif /* DEBUGGING */
void
-pregfree(r)
-struct regexp *r;
+pregfree(struct regexp *r)
{
- if (!r)
+ dTHR;
+ if (!r || (--r->refcnt > 0))
return;
- if (r->precomp) {
+ if (r->precomp)
Safefree(r->precomp);
- r->precomp = Nullch;
- }
- if (r->subbase) {
+ if (r->subbase)
Safefree(r->subbase);
- r->subbase = Nullch;
- }
- if (r->regmust) {
- SvREFCNT_dec(r->regmust);
- r->regmust = Nullsv;
+ if (r->substrs) {
+ if (r->anchored_substr)
+ SvREFCNT_dec(r->anchored_substr);
+ if (r->float_substr)
+ SvREFCNT_dec(r->float_substr);
+ Safefree(r->substrs);
}
- if (r->regstart) {
- SvREFCNT_dec(r->regstart);
- r->regstart = Nullsv;
+ if (r->data) {
+ int n = r->data->count;
+ while (--n >= 0) {
+ switch (r->data->what[n]) {
+ case 's':
+ SvREFCNT_dec((SV*)r->data->data[n]);
+ break;
+ case 'o':
+ op_free((OP_4tree*)r->data->data[n]);
+ break;
+ case 'n':
+ break;
+ default:
+ FAIL2("panic: regfree data code '%c'", r->data->what[n]);
+ }
+ }
+ Safefree(r->data->what);
+ Safefree(r->data);
}
Safefree(r->startp);
Safefree(r->endp);
Safefree(r);
}
+
+/*
+ - regnext - dig the "next" pointer out of a node
+ *
+ * [Note, when REGALIGN is defined there are two places in regmatch()
+ * that bypass this code for speed.]
+ */
+regnode *
+regnext(register regnode *p)
+{
+ dTHR;
+ register I32 offset;
+
+ if (p == &PL_regdummy)
+ return(NULL);
+
+ offset = (reg_off_by_arg[OP(p)] ? ARG(p) : NEXT_OFF(p));
+ if (offset == 0)
+ return(NULL);
+
+ return(p+offset);
+}
+
+STATIC void
+re_croak2(const char* pat1,const char* pat2,...)
+{
+ va_list args;
+ STRLEN l1 = strlen(pat1);
+ STRLEN l2 = strlen(pat2);
+ char buf[512];
+ char *message;
+
+ if (l1 > 510)
+ l1 = 510;
+ if (l1 + l2 > 510)
+ l2 = 510 - l1;
+ Copy(pat1, buf, l1 , char);
+ Copy(pat2, buf + l1, l2 , char);
+ buf[l1 + l2] = '\n';
+ buf[l1 + l2 + 1] = '\0';
+ va_start(args, pat2);
+ message = mess(buf, &args);
+ va_end(args);
+ l1 = strlen(message);
+ if (l1 > 512)
+ l1 = 512;
+ Copy(message, buf, l1 , char);
+ buf[l1] = '\0'; /* Overwrite \n */
+ croak("%s", buf);
+}
diff --git a/gnu/usr.bin/perl/regcomp.h b/gnu/usr.bin/perl/regcomp.h
index 5915086390d..526b885eecf 100644
--- a/gnu/usr.bin/perl/regcomp.h
+++ b/gnu/usr.bin/perl/regcomp.h
@@ -1,6 +1,8 @@
/* regcomp.h
*/
+typedef OP OP_4tree; /* Will be redefined later. */
+
/*
* The "internal use only" fields in regexp.h are present to pass info from
* compile to execute that permits the execute phase to run lots faster on
@@ -47,162 +49,6 @@
* to the thing following the set of BRANCHes.) The opcodes are:
*/
-/* definition number opnd? meaning */
-#define END 0 /* no End of program. */
-#define BOL 1 /* no Match "" at beginning of line. */
-#define MBOL 2 /* no Same, assuming multiline. */
-#define SBOL 3 /* no Same, assuming singleline. */
-#define EOL 4 /* no Match "" at end of line. */
-#define MEOL 5 /* no Same, assuming multiline. */
-#define SEOL 6 /* no Same, assuming singleline. */
-#define ANY 7 /* no Match any one character (except newline). */
-#define SANY 8 /* no Match any one character. */
-#define ANYOF 9 /* sv Match character in (or not in) this class. */
-#define CURLY 10 /* sv Match this simple thing {n,m} times. */
-#define CURLYX 11 /* sv Match this complex thing {n,m} times. */
-#define BRANCH 12 /* node Match this alternative, or the next... */
-#define BACK 13 /* no Match "", "next" ptr points backward. */
-#define EXACT 14 /* sv Match this string (preceded by length). */
-#define EXACTF 15 /* sv Match this string, folded (prec. by length). */
-#define EXACTFL 16 /* sv Match this string, folded in locale (w/len). */
-#define NOTHING 17 /* no Match empty string. */
-#define STAR 18 /* node Match this (simple) thing 0 or more times. */
-#define PLUS 19 /* node Match this (simple) thing 1 or more times. */
-#define BOUND 20 /* no Match "" at any word boundary */
-#define BOUNDL 21 /* no Match "" at any word boundary */
-#define NBOUND 22 /* no Match "" at any word non-boundary */
-#define NBOUNDL 23 /* no Match "" at any word non-boundary */
-#define REF 24 /* num Match already matched string */
-#define REFF 25 /* num Match already matched string, folded */
-#define REFFL 26 /* num Match already matched string, folded in loc. */
-#define OPEN 27 /* num Mark this point in input as start of #n. */
-#define CLOSE 28 /* num Analogous to OPEN. */
-#define MINMOD 29 /* no Next operator is not greedy. */
-#define GPOS 30 /* no Matches where last m//g left off. */
-#define IFMATCH 31 /* no Succeeds if the following matches. */
-#define UNLESSM 32 /* no Fails if the following matches. */
-#define SUCCEED 33 /* no Return from a subroutine, basically. */
-#define WHILEM 34 /* no Do curly processing and see if rest matches. */
-#define ALNUM 35 /* no Match any alphanumeric character */
-#define ALNUML 36 /* no Match any alphanumeric char in locale */
-#define NALNUM 37 /* no Match any non-alphanumeric character */
-#define NALNUML 38 /* no Match any non-alphanumeric char in locale */
-#define SPACE 39 /* no Match any whitespace character */
-#define SPACEL 40 /* no Match any whitespace char in locale */
-#define NSPACE 41 /* no Match any non-whitespace character */
-#define NSPACEL 42 /* no Match any non-whitespace char in locale */
-#define DIGIT 43 /* no Match any numeric character */
-#define NDIGIT 44 /* no Match any non-numeric character */
-
-/*
- * Opcode notes:
- *
- * BRANCH The set of branches constituting a single choice are hooked
- * together with their "next" pointers, since precedence prevents
- * anything being concatenated to any individual branch. The
- * "next" pointer of the last BRANCH in a choice points to the
- * thing following the whole choice. This is also where the
- * final "next" pointer of each individual branch points; each
- * branch starts with the operand node of a BRANCH node.
- *
- * BACK Normal "next" pointers all implicitly point forward; BACK
- * exists to make loop structures possible.
- *
- * STAR,PLUS '?', and complex '*' and '+', are implemented as circular
- * BRANCH structures using BACK. Simple cases (one character
- * per match) are implemented with STAR and PLUS for speed
- * and to minimize recursive plunges.
- *
- * OPEN,CLOSE ...are numbered at compile time.
- */
-
-#ifndef DOINIT
-EXT char regarglen[];
-#else
-EXT char regarglen[] = {
- 0,0,0,0,0,0,0,0,0,0,
- /*CURLY*/ 4, /*CURLYX*/ 4,
- 0,0,0,0,0,0,0,0,0,0,0,0,
- /*REF*/ 2, 2, 2, /*OPEN*/ 2, /*CLOSE*/ 2,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
-};
-#endif
-
-#ifndef DOINIT
-EXT char regkind[];
-#else
-EXT char regkind[] = {
- END,
- BOL,
- BOL,
- BOL,
- EOL,
- EOL,
- EOL,
- ANY,
- ANY,
- ANYOF,
- CURLY,
- CURLY,
- BRANCH,
- BACK,
- EXACT,
- EXACT,
- EXACT,
- NOTHING,
- STAR,
- PLUS,
- BOUND,
- BOUND,
- NBOUND,
- NBOUND,
- REF,
- REF,
- REF,
- OPEN,
- CLOSE,
- MINMOD,
- GPOS,
- BRANCH,
- BRANCH,
- END,
- WHILEM,
- ALNUM,
- ALNUM,
- NALNUM,
- NALNUM,
- SPACE,
- SPACE,
- NSPACE,
- NSPACE,
- DIGIT,
- NDIGIT,
-};
-#endif
-
-/* The following have no fixed length. */
-#ifndef DOINIT
-EXT char varies[];
-#else
-EXT char varies[] = {
- BRANCH, BACK, STAR, PLUS, CURLY, CURLYX, REF, REFF, REFFL, WHILEM, 0
-};
-#endif
-
-/* The following always have a length of 1. */
-#ifndef DOINIT
-EXT char simple[];
-#else
-EXT char simple[] = {
- ANY, SANY, ANYOF,
- ALNUM, ALNUML, NALNUM, NALNUML,
- SPACE, SPACEL, NSPACE, NSPACEL,
- DIGIT, NDIGIT, 0
-};
-#endif
-
-EXT char regdummy;
-
/*
* A node is one char of opcode followed by two chars of "next" pointer.
* "Next" pointers are stored as two 8-bit pieces, high order first. The
@@ -213,48 +59,101 @@ EXT char regdummy;
* Using two bytes for the "next" pointer is vast overkill for most things,
* but allows patterns to get big without disasters.
*
- * [If REGALIGN is defined, the "next" pointer is always aligned on an even
+ * [The "next" pointer is always aligned on an even
* boundary, and reads the offset directly as a short. Also, there is no
* special test to reverse the sign of BACK pointers since the offset is
* stored negative.]
*/
-#ifndef gould
-#ifndef cray
-#ifndef eta10
-#define REGALIGN
-#endif
+struct regnode_string {
+ U8 flags;
+ U8 type;
+ U16 next_off;
+ U8 string[1];
+};
+
+struct regnode_1 {
+ U8 flags;
+ U8 type;
+ U16 next_off;
+ U32 arg1;
+};
+
+struct regnode_2 {
+ U8 flags;
+ U8 type;
+ U16 next_off;
+ U16 arg1;
+ U16 arg2;
+};
+
+/* XXX fix this description.
+ Impose a limit of REG_INFTY on various pattern matching operations
+ to limit stack growth and to avoid "infinite" recursions.
+*/
+/* The default size for REG_INFTY is I16_MAX, which is the same as
+ SHORT_MAX (see perl.h). Unfortunately I16 isn't necessarily 16 bits
+ (see handy.h). On the Cray C90, sizeof(short)==4 and hence I16_MAX is
+ ((1<<31)-1), while on the Cray T90, sizeof(short)==8 and I16_MAX is
+ ((1<<63)-1). To limit stack growth to reasonable sizes, supply a
+ smaller default.
+ --Andy Dougherty 11 June 1998
+*/
+#if SHORTSIZE > 2
+# ifndef REG_INFTY
+# define REG_INFTY ((1<<15)-1)
+# endif
#endif
+
+#ifndef REG_INFTY
+# define REG_INFTY I16_MAX
#endif
-#define OP(p) (*(p))
+#define ARG_VALUE(arg) (arg)
+#define ARG__SET(arg,val) ((arg) = (val))
+
+#define ARG(p) ARG_VALUE(ARG_LOC(p))
+#define ARG1(p) ARG_VALUE(ARG1_LOC(p))
+#define ARG2(p) ARG_VALUE(ARG2_LOC(p))
+#define ARG_SET(p, val) ARG__SET(ARG_LOC(p), (val))
+#define ARG1_SET(p, val) ARG__SET(ARG1_LOC(p), (val))
+#define ARG2_SET(p, val) ARG__SET(ARG2_LOC(p), (val))
#ifndef lint
-#ifdef REGALIGN
-#define NEXT(p) (*(short*)(p+1))
-#define ARG1(p) (*(unsigned short*)(p+3))
-#define ARG2(p) (*(unsigned short*)(p+5))
-#else
-#define NEXT(p) (((*((p)+1)&0377)<<8) + (*((p)+2)&0377))
-#define ARG1(p) (((*((p)+3)&0377)<<8) + (*((p)+4)&0377))
-#define ARG2(p) (((*((p)+5)&0377)<<8) + (*((p)+6)&0377))
-#endif
+# define NEXT_OFF(p) ((p)->next_off)
+# define NODE_ALIGN(node)
+# define NODE_ALIGN_FILL(node) ((node)->flags = 0xde) /* deadbeef */
#else /* lint */
-#define NEXT(p) 0
+# define NEXT_OFF(p) 0
+# define NODE_ALIGN(node)
+# define NODE_ALIGN_FILL(node)
#endif /* lint */
-#define OPERAND(p) ((p) + 3)
+#define SIZE_ALIGN NODE_ALIGN
-#ifdef REGALIGN
-#define NEXTOPER(p) ((p) + 4)
-#define PREVOPER(p) ((p) - 4)
-#else
-#define NEXTOPER(p) ((p) + 3)
-#define PREVOPER(p) ((p) - 3)
-#endif
+#define OP(p) ((p)->type)
+#define OPERAND(p) (((struct regnode_string *)p)->string)
+#define NODE_ALIGN(node)
+#define ARG_LOC(p) (((struct regnode_1 *)p)->arg1)
+#define ARG1_LOC(p) (((struct regnode_2 *)p)->arg1)
+#define ARG2_LOC(p) (((struct regnode_2 *)p)->arg2)
+#define NODE_STEP_REGNODE 1 /* sizeof(regnode)/sizeof(regnode) */
+#define EXTRA_STEP_2ARGS EXTRA_SIZE(struct regnode_2)
+
+#define NODE_STEP_B 4
+
+#define NEXTOPER(p) ((p) + NODE_STEP_REGNODE)
+#define PREVOPER(p) ((p) - NODE_STEP_REGNODE)
+
+#define FILL_ADVANCE_NODE(ptr, op) STMT_START { \
+ (ptr)->type = op; (ptr)->next_off = 0; (ptr)++; } STMT_END
+#define FILL_ADVANCE_NODE_ARG(ptr, op, arg) STMT_START { \
+ ARG_SET(ptr, arg); FILL_ADVANCE_NODE(ptr, op); (ptr) += 1; } STMT_END
#define MAGIC 0234
+#define SIZE_ONLY (PL_regcode == &PL_regdummy)
+
/* Flags for first parameter byte of ANYOF */
#define ANYOF_INVERT 0x40
#define ANYOF_FOLD 0x20
@@ -265,6 +164,15 @@ EXT char regdummy;
#define ANYOF_SPACEL 0x02
#define ANYOF_NSPACEL 0x01
+/* Utility macros for bitmap of ANYOF */
+#define ANYOF_BYTE(p,c) (p)[1 + (((c) >> 3) & 31)]
+#define ANYOF_BIT(c) (1 << ((c) & 7))
+#define ANYOF_SET(p,c) (ANYOF_BYTE(p,c) |= ANYOF_BIT(c))
+#define ANYOF_CLEAR(p,c) (ANYOF_BYTE(p,c) &= ~ANYOF_BIT(c))
+#define ANYOF_TEST(p,c) (ANYOF_BYTE(p,c) & ANYOF_BIT(c))
+
+#define ANY_SKIP ((33 - 1)/sizeof(regnode) + 1)
+
/*
* Utility definitions.
*/
@@ -275,7 +183,40 @@ EXT char regdummy;
#define UCHARAT(p) ((int)*(p)&CHARMASK)
#endif
#else /* lint */
-#define UCHARAT(p) regdummy
+#define UCHARAT(p) PL_regdummy
#endif /* lint */
-#define FAIL(m) croak("/%.127s/: %s",regprecomp,m)
+#define FAIL(m) croak ("/%.127s/: %s", PL_regprecomp,m)
+#define FAIL2(pat,m) re_croak2("/%.127s/: ",pat,PL_regprecomp,m)
+
+#define EXTRA_SIZE(guy) ((sizeof(guy)-1)/sizeof(struct regnode))
+
+#define REG_SEEN_ZERO_LEN 1
+#define REG_SEEN_LOOKBEHIND 2
+#define REG_SEEN_GPOS 4
+#define REG_SEEN_EVAL 8
+
+#include "regnodes.h"
+
+/* The following have no fixed length. char* since we do strchr on it. */
+#ifndef DOINIT
+EXTCONST char varies[];
+#else
+EXTCONST char varies[] = {
+ BRANCH, BACK, STAR, PLUS, CURLY, CURLYX, REF, REFF, REFFL,
+ WHILEM, CURLYM, CURLYN, BRANCHJ, IFTHEN, SUSPEND, 0
+};
+#endif
+
+/* The following always have a length of 1. char* since we do strchr on it. */
+#ifndef DOINIT
+EXTCONST char simple[];
+#else
+EXTCONST char simple[] = {
+ ANY, SANY, ANYOF,
+ ALNUM, ALNUML, NALNUM, NALNUML,
+ SPACE, SPACEL, NSPACE, NSPACEL,
+ DIGIT, NDIGIT, 0
+};
+#endif
+
diff --git a/gnu/usr.bin/perl/regexec.c b/gnu/usr.bin/perl/regexec.c
index c640d6758d5..98f7ef53017 100644
--- a/gnu/usr.bin/perl/regexec.c
+++ b/gnu/usr.bin/perl/regexec.c
@@ -19,6 +19,26 @@
* with the POSIX routines of the same names.
*/
+#ifdef PERL_EXT_RE_BUILD
+/* need to replace pregcomp et al, so enable that */
+# ifndef PERL_IN_XSUB_RE
+# define PERL_IN_XSUB_RE
+# endif
+/* need access to debugger hooks */
+# ifndef DEBUGGING
+# define DEBUGGING
+# endif
+#endif
+
+#ifdef PERL_IN_XSUB_RE
+/* We *really* need to overwrite these symbols: */
+# define Perl_regexec_flags my_regexec
+# define Perl_regdump my_regdump
+# define Perl_regprop my_regprop
+/* *These* symbols are masked to allow static link. */
+# define Perl_pregexec my_pregexec
+#endif
+
/*SUPPRESS 112*/
/*
* pregcomp and pregexec -- regsub and regerror are not used in perl
@@ -42,7 +62,7 @@
*
**** Alterations to Henry's code are...
****
- **** Copyright (c) 1991-1997, Larry Wall
+ **** Copyright (c) 1991-1999, 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.
@@ -55,61 +75,72 @@
#include "perl.h"
#include "regcomp.h"
+#define RF_tainted 1 /* tainted information used? */
+#define RF_warned 2 /* warned about big count? */
+#define RF_evaled 4 /* Did an EVAL with setting? */
+
+#define RS_init 1 /* eval environment created */
+#define RS_set 2 /* replsv value is set */
+
#ifndef STATIC
#define STATIC static
#endif
-#ifdef DEBUGGING
-static I32 regnarrate = 0;
-static char* regprogram = 0;
-#endif
+#ifndef PERL_OBJECT
+typedef I32 CHECKPOINT;
-/* Current curly descriptor */
-typedef struct curcur CURCUR;
-struct curcur {
- int parenfloor; /* how far back to strip paren data */
- int cur; /* how many instances of scan we've matched */
- int min; /* the minimal number of scans to match */
- int max; /* the maximal number of scans to match */
- int minmod; /* whether to work our way up or down */
- char * scan; /* the thing to match */
- char * next; /* what has to match after it */
- char * lastloc; /* where we started matching this scan */
- CURCUR * oldcc; /* current curly before we started this one */
-};
-
-static CURCUR* regcc;
+/*
+ * Forwards.
+ */
-typedef I32 CHECKPOINT;
+static I32 regmatch _((regnode *prog));
+static I32 regrepeat _((regnode *p, I32 max));
+static I32 regrepeat_hard _((regnode *p, I32 max, I32 *lp));
+static I32 regtry _((regexp *prog, char *startpos));
+static bool reginclass _((char *p, I32 c));
static CHECKPOINT regcppush _((I32 parenfloor));
static char * regcppop _((void));
+#endif
+#define REGINCLASS(p,c) (*(p) ? reginclass(p,c) : ANYOF_TEST(p,c))
-static CHECKPOINT
-regcppush(parenfloor)
-I32 parenfloor;
+STATIC CHECKPOINT
+regcppush(I32 parenfloor)
{
- int retval = savestack_ix;
- int i = (regsize - parenfloor) * 3;
+ dTHR;
+ int retval = PL_savestack_ix;
+ int i = (PL_regsize - parenfloor) * 4;
int p;
SSCHECK(i + 5);
- for (p = regsize; p > parenfloor; p--) {
- SSPUSHPTR(regendp[p]);
- SSPUSHPTR(regstartp[p]);
+ for (p = PL_regsize; p > parenfloor; p--) {
+ SSPUSHPTR(PL_regendp[p]);
+ SSPUSHPTR(PL_regstartp[p]);
+ SSPUSHPTR(PL_reg_start_tmp[p]);
SSPUSHINT(p);
}
- SSPUSHINT(regsize);
- SSPUSHINT(*reglastparen);
- SSPUSHPTR(reginput);
+ SSPUSHINT(PL_regsize);
+ SSPUSHINT(*PL_reglastparen);
+ SSPUSHPTR(PL_reginput);
SSPUSHINT(i + 3);
SSPUSHINT(SAVEt_REGCONTEXT);
return retval;
}
-static char *
-regcppop()
+/* These are needed since we do not localize EVAL nodes: */
+# define REGCP_SET DEBUG_r(PerlIO_printf(Perl_debug_log, \
+ " Setting an EVAL scope, savestack=%i\n", \
+ PL_savestack_ix)); lastcp = PL_savestack_ix
+
+# define REGCP_UNWIND DEBUG_r(lastcp != PL_savestack_ix ? \
+ PerlIO_printf(Perl_debug_log, \
+ " Clearing an EVAL scope, savestack=%i..%i\n", \
+ lastcp, PL_savestack_ix) : 0); regcpblow(lastcp)
+
+STATIC char *
+regcppop(void)
{
+ dTHR;
I32 i = SSPOPINT;
U32 paren = 0;
char *input;
@@ -117,98 +148,96 @@ regcppop()
assert(i == SAVEt_REGCONTEXT);
i = SSPOPINT;
input = (char *) SSPOPPTR;
- *reglastparen = SSPOPINT;
- regsize = SSPOPINT;
- for (i -= 3; i > 0; i -= 3) {
+ *PL_reglastparen = SSPOPINT;
+ PL_regsize = SSPOPINT;
+ for (i -= 3; i > 0; i -= 4) {
paren = (U32)SSPOPINT;
- regstartp[paren] = (char *) SSPOPPTR;
+ PL_reg_start_tmp[paren] = (char *) SSPOPPTR;
+ PL_regstartp[paren] = (char *) SSPOPPTR;
tmps = (char*)SSPOPPTR;
- if (paren <= *reglastparen)
- regendp[paren] = tmps;
+ if (paren <= *PL_reglastparen)
+ PL_regendp[paren] = tmps;
+ DEBUG_r(
+ PerlIO_printf(Perl_debug_log,
+ " restoring \\%d to %d(%d)..%d%s\n",
+ paren, PL_regstartp[paren] - PL_regbol,
+ PL_reg_start_tmp[paren] - PL_regbol,
+ PL_regendp[paren] - PL_regbol,
+ (paren > *PL_reglastparen ? "(no)" : ""));
+ );
}
- for (paren = *reglastparen + 1; paren <= regnpar; paren++) {
- if (paren > regsize)
- regstartp[paren] = Nullch;
- regendp[paren] = Nullch;
+ DEBUG_r(
+ if (*PL_reglastparen + 1 <= PL_regnpar) {
+ PerlIO_printf(Perl_debug_log,
+ " restoring \\%d..\\%d to undef\n",
+ *PL_reglastparen + 1, PL_regnpar);
+ }
+ );
+ for (paren = *PL_reglastparen + 1; paren <= PL_regnpar; paren++) {
+ if (paren > PL_regsize)
+ PL_regstartp[paren] = Nullch;
+ PL_regendp[paren] = Nullch;
}
return input;
}
-/* After a successful match in WHILEM, we want to restore paren matches
- * that have been overwritten by a failed match attempt in the process
- * of reaching this success. We do this by restoring regstartp[i]
- * wherever regendp[i] has not changed; if OPEN is changed to modify
- * regendp[], the '== endp' test below should be changed to match.
- * This corrects the error of:
- * 0 > length [ "foobar" =~ / ( (foo) | (bar) )* /x ]->[1]
- */
-static void
-regcppartblow(base)
-I32 base;
-{
- I32 i = SSPOPINT;
- U32 paren;
- char *startp;
- char *endp;
- assert(i == SAVEt_REGCONTEXT);
- i = SSPOPINT;
- /* input, lastparen, size */
- SSPOPPTR; SSPOPINT; SSPOPINT;
- for (i -= 3; i > 0; i -= 3) {
- paren = (U32)SSPOPINT;
- startp = (char *) SSPOPPTR;
- endp = (char *) SSPOPPTR;
- if (paren <= *reglastparen && regendp[paren] == endp)
- regstartp[paren] = startp;
- }
- assert(savestack_ix == base);
-}
-
-#define regcpblow(cp) leave_scope(cp)
+#define regcpblow(cp) LEAVE_SCOPE(cp)
/*
* pregexec and friends
*/
/*
- * Forwards.
+ - pregexec - match a regexp against a string
*/
-
-static I32 regmatch _((char *prog));
-static I32 regrepeat _((char *p, I32 max));
-static I32 regtry _((regexp *prog, char *startpos));
-static bool reginclass _((char *p, I32 c));
-
-static bool regtainted; /* tainted information used? */
-
+I32
+pregexec(register regexp *prog, char *stringarg, register char *strend,
+ char *strbeg, I32 minend, SV *screamer, U32 nosave)
+/* strend: pointer to null at end of string */
+/* strbeg: real beginning of string */
+/* minend: end of match must be >=minend after stringarg. */
+/* nosave: For optimizations. */
+{
+ return
+ regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL,
+ nosave ? 0 : REXEC_COPY_STR);
+}
+
/*
- - pregexec - match a regexp against a string
+ - regexec_flags - match a regexp against a string
*/
I32
-pregexec(prog, stringarg, strend, strbeg, minend, screamer, safebase)
-register regexp *prog;
-char *stringarg;
-register char *strend; /* pointer to null at end of string */
-char *strbeg; /* real beginning of string */
-I32 minend; /* end of match must be at least minend after stringarg */
-SV *screamer;
-I32 safebase; /* no need to remember string in subbase */
+regexec_flags(register regexp *prog, char *stringarg, register char *strend,
+ char *strbeg, I32 minend, SV *screamer, void *data, U32 flags)
+/* strend: pointer to null at end of string */
+/* strbeg: real beginning of string */
+/* minend: end of match must be >=minend after stringarg. */
+/* data: May be used for some additional optimizations. */
+/* nosave: For optimizations. */
{
+ dTHR;
register char *s;
- register char *c;
+ register regnode *c;
register char *startpos = stringarg;
register I32 tmp;
- I32 minlen = 0; /* must match at least this many chars */
+ I32 minlen; /* must match at least this many chars */
I32 dontbother = 0; /* how many characters not to try at end */
CURCUR cc;
+ I32 start_shift = 0; /* Offset of the start to find
+ constant substr. */
+ I32 end_shift = 0; /* Same for the end. */
+ I32 scream_pos = -1; /* Internal iterator of scream. */
+ char *scream_olds;
+ SV* oreplsv = GvSV(PL_replgv);
cc.cur = 0;
cc.oldcc = 0;
- regcc = &cc;
+ PL_regcc = &cc;
+ PL_regprecomp = prog->precomp; /* Needed for error messages. */
#ifdef DEBUGGING
- regnarrate = debug & 512;
- regprogram = prog->program;
+ PL_regnarrate = PL_debug & 512;
+ PL_regprogram = prog->program;
#endif
/* Be paranoid... */
@@ -217,68 +246,85 @@ I32 safebase; /* no need to remember string in subbase */
return 0;
}
+ minlen = prog->minlen;
+ if (strend - startpos < minlen) goto phooey;
+
if (startpos == strbeg) /* is ^ valid at stringarg? */
- regprev = '\n';
+ PL_regprev = '\n';
else {
- regprev = stringarg[-1];
- if (!multiline && regprev == '\n')
- regprev = '\0'; /* force ^ to NOT match */
+ PL_regprev = stringarg[-1];
+ if (!PL_multiline && PL_regprev == '\n')
+ PL_regprev = '\0'; /* force ^ to NOT match */
}
- regprecomp = prog->precomp;
/* Check validity of program. */
if (UCHARAT(prog->program) != MAGIC) {
FAIL("corrupted regexp program");
}
- regnpar = prog->nparens;
- regtainted = FALSE;
+ PL_regnpar = prog->nparens;
+ PL_reg_flags = 0;
+ PL_reg_eval_set = 0;
/* If there is a "must appear" string, look for it. */
s = startpos;
- if (prog->regmust != Nullsv &&
+ if (!(flags & REXEC_CHECKED)
+ && prog->check_substr != Nullsv &&
!(prog->reganch & ROPT_ANCH_GPOS) &&
- (!(prog->reganch & ROPT_ANCH_BOL)
- || (multiline && prog->regback >= 0)) )
+ (!(prog->reganch & (ROPT_ANCH_BOL | ROPT_ANCH_MBOL))
+ || (PL_multiline && prog->check_substr == prog->anchored_substr)) )
{
- if (stringarg == strbeg && screamer) {
- if (screamfirst[BmRARE(prog->regmust)] >= 0)
- s = screaminstr(screamer,prog->regmust);
+ start_shift = prog->check_offset_min;
+ /* Should be nonnegative! */
+ end_shift = minlen - start_shift - SvCUR(prog->check_substr);
+ if (screamer) {
+ if (PL_screamfirst[BmRARE(prog->check_substr)] >= 0)
+ s = screaminstr(screamer, prog->check_substr,
+ start_shift + (stringarg - strbeg),
+ end_shift, &scream_pos, 0);
else
s = Nullch;
+ scream_olds = s;
}
else
- s = fbm_instr((unsigned char*)s, (unsigned char*)strend,
- prog->regmust);
+ s = fbm_instr((unsigned char*)s + start_shift,
+ (unsigned char*)strend - end_shift,
+ prog->check_substr, 0);
if (!s) {
- ++BmUSEFUL(prog->regmust); /* hooray */
+ ++BmUSEFUL(prog->check_substr); /* hooray */
goto phooey; /* not present */
- }
- else if (prog->regback >= 0) {
- s -= prog->regback;
- if (s < startpos)
- s = startpos;
- minlen = prog->regback + SvCUR(prog->regmust);
- }
- else if (!prog->naughty && --BmUSEFUL(prog->regmust) < 0) { /* boo */
- SvREFCNT_dec(prog->regmust);
- prog->regmust = Nullsv; /* disable regmust */
- s = startpos;
- }
- else {
+ } else if ((s - stringarg) > prog->check_offset_max) {
+ ++BmUSEFUL(prog->check_substr); /* hooray/2 */
+ s -= prog->check_offset_max;
+ } else if (!prog->naughty
+ && --BmUSEFUL(prog->check_substr) < 0
+ && prog->check_substr == prog->float_substr) { /* boo */
+ SvREFCNT_dec(prog->check_substr);
+ prog->check_substr = Nullsv; /* disable */
+ prog->float_substr = Nullsv; /* clear */
s = startpos;
- minlen = SvCUR(prog->regmust);
- }
+ } else s = startpos;
}
- /* Mark beginning of line for ^ . */
- regbol = startpos;
+ /* Mark beginning of line for ^ and lookbehind. */
+ PL_regbol = startpos;
+ PL_bostr = strbeg;
/* Mark end of line for $ (and such) */
- regeol = strend;
+ PL_regeol = strend;
/* see how far we have to get to not match where we matched before */
- regtill = startpos+minend;
+ PL_regtill = startpos+minend;
+
+ DEBUG_r(
+ PerlIO_printf(Perl_debug_log,
+ "Matching `%.60s%s' against `%.*s%s'\n",
+ prog->precomp,
+ (strlen(prog->precomp) > 60 ? "..." : ""),
+ (strend - startpos > 60 ? 60 : strend - startpos),
+ startpos,
+ (strend - startpos > 60 ? "..." : ""))
+ );
/* Simplest case: anchored match need be tried only once. */
/* [unless only anchor is BOL and multiline is set] */
@@ -286,7 +332,8 @@ I32 safebase; /* no need to remember string in subbase */
if (regtry(prog, startpos))
goto got_it;
else if (!(prog->reganch & ROPT_ANCH_GPOS) &&
- (multiline || (prog->reganch & ROPT_IMPLICIT)))
+ (PL_multiline || (prog->reganch & ROPT_IMPLICIT)
+ || (prog->reganch & ROPT_ANCH_MBOL)))
{
if (minlen)
dontbother = minlen - 1;
@@ -305,45 +352,64 @@ I32 safebase; /* no need to remember string in subbase */
}
/* Messy cases: unanchored match. */
- if (prog->regstart) {
- if (prog->reganch & ROPT_SKIP) { /* we have /x+whatever/ */
- /* it must be a one character string */
- char ch = SvPVX(prog->regstart)[0];
- while (s < strend) {
- if (*s == ch) {
- if (regtry(prog, s))
- goto got_it;
- s++;
- while (s < strend && *s == ch)
- s++;
- }
+ if (prog->anchored_substr && prog->reganch & ROPT_SKIP) {
+ /* we have /x+whatever/ */
+ /* it must be a one character string */
+ char ch = SvPVX(prog->anchored_substr)[0];
+ while (s < strend) {
+ if (*s == ch) {
+ if (regtry(prog, s)) goto got_it;
s++;
+ while (s < strend && *s == ch)
+ s++;
}
+ s++;
}
- else if (SvTYPE(prog->regstart) == SVt_PVBM) {
- /* We know what string it must start with. */
- while ((s = fbm_instr((unsigned char*)s,
- (unsigned char*)strend, prog->regstart)) != NULL)
- {
- if (regtry(prog, s))
- goto got_it;
- s++;
+ }
+ /*SUPPRESS 560*/
+ else if (prog->anchored_substr != Nullsv
+ || (prog->float_substr != Nullsv
+ && prog->float_max_offset < strend - s)) {
+ SV *must = prog->anchored_substr
+ ? prog->anchored_substr : prog->float_substr;
+ I32 back_max =
+ prog->anchored_substr ? prog->anchored_offset : prog->float_max_offset;
+ I32 back_min =
+ prog->anchored_substr ? prog->anchored_offset : prog->float_min_offset;
+ I32 delta = back_max - back_min;
+ char *last = strend - SvCUR(must) - back_min; /* Cannot start after this */
+ char *last1 = s - 1; /* Last position checked before */
+
+ /* XXXX check_substr already used to find `s', can optimize if
+ check_substr==must. */
+ scream_pos = -1;
+ dontbother = end_shift;
+ strend -= dontbother;
+ while ( (s <= last) &&
+ (screamer
+ ? (s = screaminstr(screamer, must, s + back_min - strbeg,
+ end_shift, &scream_pos, 0))
+ : (s = fbm_instr((unsigned char*)s + back_min,
+ (unsigned char*)strend, must, 0))) ) {
+ if (s - back_max > last1) {
+ last1 = s - back_min;
+ s = s - back_max;
+ } else {
+ char *t = last1 + 1;
+
+ last1 = s - back_min;
+ s = t;
}
- }
- else { /* Optimized fbm_instr: */
- c = SvPVX(prog->regstart);
- while ((s = ninstr(s, strend, c, c + SvCUR(prog->regstart))) != NULL)
- {
+ while (s <= last1) {
if (regtry(prog, s))
goto got_it;
s++;
}
}
goto phooey;
- }
- /*SUPPRESS 560*/
- if (c = prog->regstclass) {
+ } else if (c = prog->regstclass) {
I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
+ char *Class;
if (minlen)
dontbother = minlen - 1;
@@ -352,9 +418,9 @@ I32 safebase; /* no need to remember string in subbase */
/* We know what class it must start with. */
switch (OP(c)) {
case ANYOF:
- c = OPERAND(c);
+ Class = (char *) OPERAND(c);
while (s < strend) {
- if (reginclass(c, *s)) {
+ if (REGINCLASS(Class, *s)) {
if (tmp && regtry(prog, s))
goto got_it;
else
@@ -366,12 +432,12 @@ I32 safebase; /* no need to remember string in subbase */
}
break;
case BOUNDL:
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case BOUND:
if (minlen)
dontbother++,strend--;
- tmp = (s != startpos) ? UCHARAT(s - 1) : regprev;
+ tmp = (s != startpos) ? UCHARAT(s - 1) : PL_regprev;
tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
while (s < strend) {
if (tmp == !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
@@ -385,12 +451,12 @@ I32 safebase; /* no need to remember string in subbase */
goto got_it;
break;
case NBOUNDL:
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case NBOUND:
if (minlen)
dontbother++,strend--;
- tmp = (s != startpos) ? UCHARAT(s - 1) : regprev;
+ tmp = (s != startpos) ? UCHARAT(s - 1) : PL_regprev;
tmp = ((OP(c) == NBOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
while (s < strend) {
if (tmp == !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
@@ -416,7 +482,7 @@ I32 safebase; /* no need to remember string in subbase */
}
break;
case ALNUML:
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
while (s < strend) {
if (isALNUM_LC(*s)) {
if (tmp && regtry(prog, s))
@@ -443,7 +509,7 @@ I32 safebase; /* no need to remember string in subbase */
}
break;
case NALNUML:
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
while (s < strend) {
if (!isALNUM_LC(*s)) {
if (tmp && regtry(prog, s))
@@ -470,7 +536,7 @@ I32 safebase; /* no need to remember string in subbase */
}
break;
case SPACEL:
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
while (s < strend) {
if (isSPACE_LC(*s)) {
if (tmp && regtry(prog, s))
@@ -497,7 +563,7 @@ I32 safebase; /* no need to remember string in subbase */
}
break;
case NSPACEL:
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
while (s < strend) {
if (!isSPACE_LC(*s)) {
if (tmp && regtry(prog, s))
@@ -539,7 +605,29 @@ I32 safebase; /* no need to remember string in subbase */
}
}
else {
- if (minlen)
+ dontbother = 0;
+ if (prog->float_substr != Nullsv) { /* Trim the end. */
+ char *last;
+ I32 oldpos = scream_pos;
+
+ if (screamer) {
+ last = screaminstr(screamer, prog->float_substr, s - strbeg,
+ end_shift, &scream_pos, 1); /* last one */
+ if (!last) {
+ last = scream_olds; /* Only one occurence. */
+ }
+ } else {
+ STRLEN len;
+ char *little = SvPV(prog->float_substr, len);
+ if (len)
+ last = rninstr(s, strend, little, little + len);
+ else
+ last = strend; /* matching `$' */
+ }
+ if (last == NULL) goto phooey; /* Should not happen! */
+ dontbother = strend - last + prog->float_min_offset;
+ }
+ if (minlen && (dontbother < minlen))
dontbother = minlen - 1;
strend -= dontbother;
/* We don't know much -- general case. */
@@ -553,21 +641,20 @@ I32 safebase; /* no need to remember string in subbase */
goto phooey;
got_it:
- strend += dontbother; /* uncheat */
prog->subbeg = strbeg;
- prog->subend = strend;
- prog->exec_tainted = regtainted;
+ prog->subend = PL_regeol; /* strend may have been modified */
+ RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
/* make sure $`, $&, $', and $digit will work later */
- if (strbeg != prog->subbase) {
- if (safebase) {
+ if (strbeg != prog->subbase) { /* second+ //g match. */
+ if (!(flags & REXEC_COPY_STR)) {
if (prog->subbase) {
Safefree(prog->subbase);
prog->subbase = Nullch;
}
}
else {
- I32 i = strend - startpos + (stringarg - strbeg);
+ I32 i = PL_regeol - startpos + (stringarg - strbeg);
s = savepvn(strbeg, i);
Safefree(prog->subbase);
prog->subbase = s;
@@ -582,6 +669,12 @@ got_it:
}
}
}
+ /* Preserve the current value of $^R */
+ if (oreplsv != GvSV(PL_replgv)) {
+ sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
+ restored, the value remains
+ the same. */
+ }
return 1;
phooey:
@@ -591,37 +684,60 @@ phooey:
/*
- regtry - try match at specific point
*/
-static I32 /* 0 failure, 1 success */
-regtry(prog, startpos)
-regexp *prog;
-char *startpos;
+STATIC I32 /* 0 failure, 1 success */
+regtry(regexp *prog, char *startpos)
{
+ dTHR;
register I32 i;
register char **sp;
register char **ep;
-
- reginput = startpos;
- regstartp = prog->startp;
- regendp = prog->endp;
- reglastparen = &prog->lastparen;
+ CHECKPOINT lastcp;
+
+ if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) {
+ PL_reg_eval_set = RS_init;
+ DEBUG_r(DEBUG_s(
+ PerlIO_printf(Perl_debug_log, " setting stack tmpbase at %i\n",
+ PL_stack_sp - PL_stack_base);
+ ));
+ SAVEINT(cxstack[cxstack_ix].blk_oldsp);
+ cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
+ /* Otherwise OP_NEXTSTATE will free whatever on stack now. */
+ SAVETMPS;
+ /* Apparently this is not needed, judging by wantarray. */
+ /* SAVEINT(cxstack[cxstack_ix].blk_gimme);
+ cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
+ }
+ PL_reginput = startpos;
+ PL_regstartp = prog->startp;
+ PL_regendp = prog->endp;
+ PL_reglastparen = &prog->lastparen;
prog->lastparen = 0;
- regsize = 0;
+ PL_regsize = 0;
+ if (PL_reg_start_tmpl <= prog->nparens) {
+ PL_reg_start_tmpl = prog->nparens*3/2 + 3;
+ if(PL_reg_start_tmp)
+ Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
+ else
+ New(22,PL_reg_start_tmp, PL_reg_start_tmpl, char*);
+ }
sp = prog->startp;
ep = prog->endp;
+ PL_regdata = prog->data;
if (prog->nparens) {
for (i = prog->nparens; i >= 0; i--) {
*sp++ = NULL;
*ep++ = NULL;
}
}
- if (regmatch(prog->program + 1) && reginput >= regtill) {
+ REGCP_SET;
+ if (regmatch(prog->program + 1)) {
prog->startp[0] = startpos;
- prog->endp[0] = reginput;
+ prog->endp[0] = PL_reginput;
return 1;
}
- else
- return 0;
+ REGCP_UNWIND;
+ return 0;
}
/*
@@ -638,244 +754,262 @@ char *startpos;
* maybe save a little bit of pushing and popping on the stack. It also takes
* advantage of machines that use a register save mask on subroutine entry.
*/
-static I32 /* 0 failure, 1 success */
-regmatch(prog)
-char *prog;
+STATIC I32 /* 0 failure, 1 success */
+regmatch(regnode *prog)
{
- register char *scan; /* Current node. */
- char *next; /* Next node. */
- register I32 nextchar;
+ dTHR;
+ register regnode *scan; /* Current node. */
+ regnode *next; /* Next node. */
+ regnode *inner; /* Next node in internal branch. */
+ register I32 nextchr; /* renamed nextchr - nextchar colides with
+ function of same name */
register I32 n; /* no or next */
register I32 ln; /* len or last */
register char *s; /* operand or save */
- register char *locinput = reginput;
- register I32 c1, c2; /* case fold search */
- int minmod = 0;
+ register char *locinput = PL_reginput;
+ register I32 c1, c2, paren; /* case fold search, parenth */
+ int minmod = 0, sw = 0, logical = 0;
#ifdef DEBUGGING
- static int regindent = 0;
- regindent++;
+ PL_regindent++;
#endif
- nextchar = UCHARAT(locinput);
+ nextchr = UCHARAT(locinput);
scan = prog;
while (scan != NULL) {
+#define sayNO_L (logical ? (logical = 0, sw = 0, goto cont) : sayNO)
#ifdef DEBUGGING
-#define sayYES goto yes
-#define sayNO goto no
-#define saySAME(x) if (x) goto yes; else goto no
- if (regnarrate) {
- SV *prop = sv_newmortal();
- regprop(prop, scan);
- PerlIO_printf(Perl_debug_log, "%*s%2ld%-8.8s\t<%.10s>\n",
- regindent*2, "", (long)(scan - regprogram),
- SvPVX(prop), locinput);
- }
+# define sayYES goto yes
+# define sayNO goto no
+# define saySAME(x) if (x) goto yes; else goto no
+# define REPORT_CODE_OFF 24
#else
-#define sayYES return 1
-#define sayNO return 0
-#define saySAME(x) return x
+# define sayYES return 1
+# define sayNO return 0
+# define saySAME(x) return x
#endif
-
-#ifdef REGALIGN
- next = scan + NEXT(scan);
+ DEBUG_r( {
+ SV *prop = sv_newmortal();
+ int docolor = *PL_colors[0];
+ int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
+ int l = (PL_regeol - locinput > taill ? taill : PL_regeol - locinput);
+ int pref_len = (locinput - PL_bostr > (5 + taill) - l
+ ? (5 + taill) - l : locinput - PL_bostr);
+
+ if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
+ l = ( PL_regeol - locinput > (5 + taill) - pref_len
+ ? (5 + taill) - pref_len : PL_regeol - locinput);
+ regprop(prop, scan);
+ PerlIO_printf(Perl_debug_log,
+ "%4i <%s%.*s%s%s%s%.*s%s>%*s|%3d:%*s%s\n",
+ locinput - PL_bostr,
+ PL_colors[2], pref_len, locinput - pref_len, PL_colors[3],
+ (docolor ? "" : "> <"),
+ PL_colors[0], l, locinput, PL_colors[1],
+ 15 - l - pref_len + 1,
+ "",
+ scan - PL_regprogram, PL_regindent*2, "",
+ SvPVX(prop));
+ } );
+
+ next = scan + NEXT_OFF(scan);
if (next == scan)
next = NULL;
-#else
- next = regnext(scan);
-#endif
switch (OP(scan)) {
case BOL:
- if (locinput == regbol
- ? regprev == '\n'
- : ((nextchar || locinput < regeol) && locinput[-1] == '\n') )
+ if (locinput == PL_bostr
+ ? PL_regprev == '\n'
+ : (PL_multiline &&
+ (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
{
- /* regtill = regbol; */
+ /* PL_regtill = PL_regbol; */
break;
}
sayNO;
case MBOL:
- if (locinput == regbol
- ? regprev == '\n'
- : ((nextchar || locinput < regeol) && locinput[-1] == '\n') )
+ if (locinput == PL_bostr
+ ? PL_regprev == '\n'
+ : ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
{
break;
}
sayNO;
case SBOL:
- if (locinput == regbol && regprev == '\n')
+ if (locinput == PL_regbol && PL_regprev == '\n')
break;
sayNO;
case GPOS:
- if (locinput == regbol)
+ if (locinput == PL_regbol)
break;
sayNO;
case EOL:
- if (multiline)
+ if (PL_multiline)
goto meol;
else
goto seol;
case MEOL:
meol:
- if ((nextchar || locinput < regeol) && nextchar != '\n')
+ if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
sayNO;
break;
case SEOL:
seol:
- if ((nextchar || locinput < regeol) && nextchar != '\n')
+ if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
sayNO;
- if (regeol - locinput > 1)
+ if (PL_regeol - locinput > 1)
+ sayNO;
+ break;
+ case EOS:
+ if (PL_regeol != locinput)
sayNO;
break;
case SANY:
- if (!nextchar && locinput >= regeol)
+ if (!nextchr && locinput >= PL_regeol)
sayNO;
- nextchar = UCHARAT(++locinput);
+ nextchr = UCHARAT(++locinput);
break;
case ANY:
- if (!nextchar && locinput >= regeol || nextchar == '\n')
+ if (!nextchr && locinput >= PL_regeol || nextchr == '\n')
sayNO;
- nextchar = UCHARAT(++locinput);
+ nextchr = UCHARAT(++locinput);
break;
case EXACT:
- s = OPERAND(scan);
- ln = *s++;
+ s = (char *) OPERAND(scan);
+ ln = UCHARAT(s++);
/* Inline the first character, for speed. */
- if (UCHARAT(s) != nextchar)
+ if (UCHARAT(s) != nextchr)
sayNO;
- if (regeol - locinput < ln)
+ if (PL_regeol - locinput < ln)
sayNO;
if (ln > 1 && memNE(s, locinput, ln))
sayNO;
locinput += ln;
- nextchar = UCHARAT(locinput);
+ nextchr = UCHARAT(locinput);
break;
case EXACTFL:
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case EXACTF:
- s = OPERAND(scan);
- ln = *s++;
+ s = (char *) OPERAND(scan);
+ ln = UCHARAT(s++);
/* Inline the first character, for speed. */
- if (UCHARAT(s) != nextchar &&
+ if (UCHARAT(s) != nextchr &&
UCHARAT(s) != ((OP(scan) == EXACTF)
- ? fold : fold_locale)[nextchar])
+ ? fold : fold_locale)[nextchr])
sayNO;
- if (regeol - locinput < ln)
+ if (PL_regeol - locinput < ln)
sayNO;
if (ln > 1 && (OP(scan) == EXACTF
? ibcmp(s, locinput, ln)
: ibcmp_locale(s, locinput, ln)))
sayNO;
locinput += ln;
- nextchar = UCHARAT(locinput);
+ nextchr = UCHARAT(locinput);
break;
case ANYOF:
- s = OPERAND(scan);
- if (nextchar < 0)
- nextchar = UCHARAT(locinput);
- if (!reginclass(s, nextchar))
+ s = (char *) OPERAND(scan);
+ if (nextchr < 0)
+ nextchr = UCHARAT(locinput);
+ if (!REGINCLASS(s, nextchr))
sayNO;
- if (!nextchar && locinput >= regeol)
+ if (!nextchr && locinput >= PL_regeol)
sayNO;
- nextchar = UCHARAT(++locinput);
+ nextchr = UCHARAT(++locinput);
break;
case ALNUML:
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case ALNUM:
- if (!nextchar)
+ if (!nextchr)
sayNO;
if (!(OP(scan) == ALNUM
- ? isALNUM(nextchar) : isALNUM_LC(nextchar)))
+ ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
sayNO;
- nextchar = UCHARAT(++locinput);
+ nextchr = UCHARAT(++locinput);
break;
case NALNUML:
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case NALNUM:
- if (!nextchar && locinput >= regeol)
+ if (!nextchr && locinput >= PL_regeol)
sayNO;
if (OP(scan) == NALNUM
- ? isALNUM(nextchar) : isALNUM_LC(nextchar))
+ ? isALNUM(nextchr) : isALNUM_LC(nextchr))
sayNO;
- nextchar = UCHARAT(++locinput);
+ nextchr = UCHARAT(++locinput);
break;
case BOUNDL:
case NBOUNDL:
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case BOUND:
case NBOUND:
/* was last char in word? */
- ln = (locinput != regbol) ? UCHARAT(locinput - 1) : regprev;
+ ln = (locinput != PL_regbol) ? UCHARAT(locinput - 1) : PL_regprev;
if (OP(scan) == BOUND || OP(scan) == NBOUND) {
ln = isALNUM(ln);
- n = isALNUM(nextchar);
+ n = isALNUM(nextchr);
}
else {
ln = isALNUM_LC(ln);
- n = isALNUM_LC(nextchar);
+ n = isALNUM_LC(nextchr);
}
if (((!ln) == (!n)) == (OP(scan) == BOUND || OP(scan) == BOUNDL))
sayNO;
break;
case SPACEL:
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case SPACE:
- if (!nextchar && locinput >= regeol)
+ if (!nextchr && locinput >= PL_regeol)
sayNO;
if (!(OP(scan) == SPACE
- ? isSPACE(nextchar) : isSPACE_LC(nextchar)))
+ ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
sayNO;
- nextchar = UCHARAT(++locinput);
+ nextchr = UCHARAT(++locinput);
break;
case NSPACEL:
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case NSPACE:
- if (!nextchar)
+ if (!nextchr)
sayNO;
if (OP(scan) == SPACE
- ? isSPACE(nextchar) : isSPACE_LC(nextchar))
+ ? isSPACE(nextchr) : isSPACE_LC(nextchr))
sayNO;
- nextchar = UCHARAT(++locinput);
+ nextchr = UCHARAT(++locinput);
break;
case DIGIT:
- if (!isDIGIT(nextchar))
+ if (!isDIGIT(nextchr))
sayNO;
- nextchar = UCHARAT(++locinput);
+ nextchr = UCHARAT(++locinput);
break;
case NDIGIT:
- if (!nextchar && locinput >= regeol)
+ if (!nextchr && locinput >= PL_regeol)
sayNO;
- if (isDIGIT(nextchar))
+ if (isDIGIT(nextchr))
sayNO;
- nextchar = UCHARAT(++locinput);
+ nextchr = UCHARAT(++locinput);
break;
case REFFL:
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
- case REF:
+ case REF:
case REFF:
- n = ARG1(scan); /* which paren pair */
- s = regstartp[n];
- if (!s)
- sayNO;
- if (!regendp[n])
- sayNO;
- if (s == regendp[n])
+ n = ARG(scan); /* which paren pair */
+ s = PL_regstartp[n];
+ if (*PL_reglastparen < n || !s)
+ sayNO; /* Do not match unless seen CLOSEn. */
+ if (s == PL_regendp[n])
break;
/* Inline the first character, for speed. */
- if (UCHARAT(s) != nextchar &&
+ if (UCHARAT(s) != nextchr &&
(OP(scan) == REF ||
(UCHARAT(s) != ((OP(scan) == REFF
- ? fold : fold_locale)[nextchar]))))
+ ? fold : fold_locale)[nextchr]))))
sayNO;
- ln = regendp[n] - s;
- if (locinput + ln > regeol)
+ ln = PL_regendp[n] - s;
+ if (locinput + ln > PL_regeol)
sayNO;
if (ln > 1 && (OP(scan) == REF
? memNE(s, locinput, ln)
@@ -884,42 +1018,91 @@ char *prog;
: ibcmp_locale(s, locinput, ln))))
sayNO;
locinput += ln;
- nextchar = UCHARAT(locinput);
+ nextchr = UCHARAT(locinput);
break;
case NOTHING:
+ case TAIL:
break;
case BACK:
break;
+ case EVAL:
+ {
+ dSP;
+ OP_4tree *oop = PL_op;
+ COP *ocurcop = PL_curcop;
+ SV **ocurpad = PL_curpad;
+ SV *ret;
+
+ n = ARG(scan);
+ PL_op = (OP_4tree*)PL_regdata->data[n];
+ DEBUG_r( PerlIO_printf(Perl_debug_log, " re_eval 0x%x\n", PL_op) );
+ PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 1]);
+
+ CALLRUNOPS(); /* Scalar context. */
+ SPAGAIN;
+ ret = POPs;
+ PUTBACK;
+
+ if (logical) {
+ logical = 0;
+ sw = SvTRUE(ret);
+ } else
+ sv_setsv(save_scalar(PL_replgv), ret);
+ PL_op = oop;
+ PL_curpad = ocurpad;
+ PL_curcop = ocurcop;
+ break;
+ }
case OPEN:
- n = ARG1(scan); /* which paren pair */
- regstartp[n] = locinput;
- if (n > regsize)
- regsize = n;
+ n = ARG(scan); /* which paren pair */
+ PL_reg_start_tmp[n] = locinput;
+ if (n > PL_regsize)
+ PL_regsize = n;
break;
case CLOSE:
- n = ARG1(scan); /* which paren pair */
- regendp[n] = locinput;
- if (n > *reglastparen)
- *reglastparen = n;
+ n = ARG(scan); /* which paren pair */
+ PL_regstartp[n] = PL_reg_start_tmp[n];
+ PL_regendp[n] = locinput;
+ if (n > *PL_reglastparen)
+ *PL_reglastparen = n;
+ break;
+ case GROUPP:
+ n = ARG(scan); /* which paren pair */
+ sw = (*PL_reglastparen >= n && PL_regendp[n] != NULL);
+ break;
+ case IFTHEN:
+ if (sw)
+ next = NEXTOPER(NEXTOPER(scan));
+ else {
+ next = scan + ARG(scan);
+ if (OP(next) == IFTHEN) /* Fake one. */
+ next = NEXTOPER(NEXTOPER(next));
+ }
+ break;
+ case LOGICAL:
+ logical = 1;
break;
case CURLYX: {
CURCUR cc;
- CHECKPOINT cp = savestack_ix;
- cc.oldcc = regcc;
- regcc = &cc;
- cc.parenfloor = *reglastparen;
+ CHECKPOINT cp = PL_savestack_ix;
+
+ if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
+ next += ARG(next);
+ cc.oldcc = PL_regcc;
+ PL_regcc = &cc;
+ cc.parenfloor = *PL_reglastparen;
cc.cur = -1;
cc.min = ARG1(scan);
cc.max = ARG2(scan);
- cc.scan = NEXTOPER(scan) + 4;
+ cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
cc.next = next;
cc.minmod = minmod;
cc.lastloc = 0;
- reginput = locinput;
+ PL_reginput = locinput;
n = regmatch(PREVOPER(next)); /* start on the WHILEM */
regcpblow(cp);
- regcc = cc.oldcc;
+ PL_regcc = cc.oldcc;
saySAME(n);
}
/* NOT REACHED */
@@ -933,26 +1116,40 @@ char *prog;
* that we can try again after backing off.
*/
- CHECKPOINT cp;
- CURCUR* cc = regcc;
+ CHECKPOINT cp, lastcp;
+ CURCUR* cc = PL_regcc;
+ char *lastloc = cc->lastloc; /* Detection of 0-len. */
+
n = cc->cur + 1; /* how many we know we matched */
- reginput = locinput;
+ PL_reginput = locinput;
-#ifdef DEBUGGING
- if (regnarrate)
- PerlIO_printf(Perl_debug_log, "%*s %ld %lx\n", regindent*2, "",
- (long)n, (long)cc);
-#endif
+ DEBUG_r(
+ PerlIO_printf(Perl_debug_log,
+ "%*s %ld out of %ld..%ld cc=%lx\n",
+ REPORT_CODE_OFF+PL_regindent*2, "",
+ (long)n, (long)cc->min,
+ (long)cc->max, (long)cc)
+ );
/* If degenerate scan matches "", assume scan done. */
if (locinput == cc->lastloc && n >= cc->min) {
- regcc = cc->oldcc;
- ln = regcc->cur;
+ PL_regcc = cc->oldcc;
+ ln = PL_regcc->cur;
+ DEBUG_r(
+ PerlIO_printf(Perl_debug_log,
+ "%*s empty match detected, try continuation...\n",
+ REPORT_CODE_OFF+PL_regindent*2, "")
+ );
if (regmatch(cc->next))
sayYES;
- regcc->cur = ln;
- regcc = cc;
+ DEBUG_r(
+ PerlIO_printf(Perl_debug_log,
+ "%*s failed...\n",
+ REPORT_CODE_OFF+PL_regindent*2, "")
+ );
+ PL_regcc->cur = ln;
+ PL_regcc = cc;
sayNO;
}
@@ -964,37 +1161,66 @@ char *prog;
if (regmatch(cc->scan))
sayYES;
cc->cur = n - 1;
+ cc->lastloc = lastloc;
+ DEBUG_r(
+ PerlIO_printf(Perl_debug_log,
+ "%*s failed...\n",
+ REPORT_CODE_OFF+PL_regindent*2, "")
+ );
sayNO;
}
/* Prefer next over scan for minimal matching. */
if (cc->minmod) {
- regcc = cc->oldcc;
- ln = regcc->cur;
+ PL_regcc = cc->oldcc;
+ ln = PL_regcc->cur;
cp = regcppush(cc->parenfloor);
+ REGCP_SET;
if (regmatch(cc->next)) {
- regcppartblow(cp);
+ regcpblow(cp);
sayYES; /* All done. */
}
+ REGCP_UNWIND;
regcppop();
- regcc->cur = ln;
- regcc = cc;
-
- if (n >= cc->max) /* Maximum greed exceeded? */
+ PL_regcc->cur = ln;
+ PL_regcc = cc;
+
+ if (n >= cc->max) { /* Maximum greed exceeded? */
+ if (PL_dowarn && n >= REG_INFTY
+ && !(PL_reg_flags & RF_warned)) {
+ PL_reg_flags |= RF_warned;
+ warn("%s limit (%d) exceeded",
+ "Complex regular subexpression recursion",
+ REG_INFTY - 1);
+ }
sayNO;
+ }
+ DEBUG_r(
+ PerlIO_printf(Perl_debug_log,
+ "%*s trying longer...\n",
+ REPORT_CODE_OFF+PL_regindent*2, "")
+ );
/* Try scanning more and see if it helps. */
- reginput = locinput;
+ PL_reginput = locinput;
cc->cur = n;
cc->lastloc = locinput;
cp = regcppush(cc->parenfloor);
+ REGCP_SET;
if (regmatch(cc->scan)) {
- regcppartblow(cp);
+ regcpblow(cp);
sayYES;
}
+ DEBUG_r(
+ PerlIO_printf(Perl_debug_log,
+ "%*s failed...\n",
+ REPORT_CODE_OFF+PL_regindent*2, "")
+ );
+ REGCP_UNWIND;
regcppop();
cc->cur = n - 1;
+ cc->lastloc = lastloc;
sayNO;
}
@@ -1004,48 +1230,80 @@ char *prog;
cp = regcppush(cc->parenfloor);
cc->cur = n;
cc->lastloc = locinput;
+ REGCP_SET;
if (regmatch(cc->scan)) {
- regcppartblow(cp);
+ regcpblow(cp);
sayYES;
}
+ REGCP_UNWIND;
regcppop(); /* Restore some previous $<digit>s? */
- reginput = locinput;
+ PL_reginput = locinput;
+ DEBUG_r(
+ PerlIO_printf(Perl_debug_log,
+ "%*s failed, try continuation...\n",
+ REPORT_CODE_OFF+PL_regindent*2, "")
+ );
+ }
+ if (PL_dowarn && n >= REG_INFTY && !(PL_reg_flags & RF_warned)) {
+ PL_reg_flags |= RF_warned;
+ warn("%s limit (%d) exceeded",
+ "Complex regular subexpression recursion",
+ REG_INFTY - 1);
}
/* Failed deeper matches of scan, so see if this one works. */
- regcc = cc->oldcc;
- ln = regcc->cur;
+ PL_regcc = cc->oldcc;
+ ln = PL_regcc->cur;
if (regmatch(cc->next))
sayYES;
- regcc->cur = ln;
- regcc = cc;
+ DEBUG_r(
+ PerlIO_printf(Perl_debug_log, "%*s failed...\n",
+ REPORT_CODE_OFF+PL_regindent*2, "")
+ );
+ PL_regcc->cur = ln;
+ PL_regcc = cc;
cc->cur = n - 1;
+ cc->lastloc = lastloc;
sayNO;
}
/* NOT REACHED */
- case BRANCH: {
- if (OP(next) != BRANCH) /* No choice. */
- next = NEXTOPER(scan);/* Avoid recursion. */
+ case BRANCHJ:
+ next = scan + ARG(scan);
+ if (next == scan)
+ next = NULL;
+ inner = NEXTOPER(NEXTOPER(scan));
+ goto do_branch;
+ case BRANCH:
+ inner = NEXTOPER(scan);
+ do_branch:
+ {
+ CHECKPOINT lastcp;
+ c1 = OP(scan);
+ if (OP(next) != c1) /* No choice. */
+ next = inner; /* Avoid recursion. */
else {
- int lastparen = *reglastparen;
+ int lastparen = *PL_reglastparen;
+
+ REGCP_SET;
do {
- reginput = locinput;
- if (regmatch(NEXTOPER(scan)))
+ PL_reginput = locinput;
+ if (regmatch(inner))
sayYES;
- for (n = *reglastparen; n > lastparen; n--)
- regendp[n] = 0;
- *reglastparen = n;
-
-#ifdef REGALIGN
+ REGCP_UNWIND;
+ for (n = *PL_reglastparen; n > lastparen; n--)
+ PL_regendp[n] = 0;
+ *PL_reglastparen = n;
+ scan = next;
/*SUPPRESS 560*/
- if (n = NEXT(scan))
- scan += n;
+ if (n = (c1 == BRANCH ? NEXT_OFF(next) : ARG(next)))
+ next += n;
else
- scan = NULL;
-#else
- scan = regnext(scan);
-#endif
- } while (scan != NULL && OP(scan) == BRANCH);
+ next = NULL;
+ inner = NEXTOPER(scan);
+ if (c1 == BRANCHJ) {
+ inner = NEXTOPER(inner);
+ }
+ } while (scan != NULL && OP(scan) == c1);
sayNO;
/* NOTREACHED */
}
@@ -1054,25 +1312,166 @@ char *prog;
case MINMOD:
minmod = 1;
break;
+ case CURLYM:
+ {
+ I32 l = 0;
+ CHECKPOINT lastcp;
+
+ /* We suppose that the next guy does not need
+ backtracking: in particular, it is of constant length,
+ and has no parenths to influence future backrefs. */
+ ln = ARG1(scan); /* min to match */
+ n = ARG2(scan); /* max to match */
+ paren = scan->flags;
+ if (paren) {
+ if (paren > PL_regsize)
+ PL_regsize = paren;
+ if (paren > *PL_reglastparen)
+ *PL_reglastparen = paren;
+ }
+ scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
+ if (paren)
+ scan += NEXT_OFF(scan); /* Skip former OPEN. */
+ PL_reginput = locinput;
+ if (minmod) {
+ minmod = 0;
+ if (ln && regrepeat_hard(scan, ln, &l) < ln)
+ sayNO;
+ if (ln && l == 0 && n >= ln
+ /* In fact, this is tricky. If paren, then the
+ fact that we did/didnot match may influence
+ future execution. */
+ && !(paren && ln == 0))
+ ln = n;
+ locinput = PL_reginput;
+ if (regkind[(U8)OP(next)] == EXACT) {
+ c1 = UCHARAT(OPERAND(next) + 1);
+ if (OP(next) == EXACTF)
+ c2 = fold[c1];
+ else if (OP(next) == EXACTFL)
+ c2 = fold_locale[c1];
+ else
+ c2 = c1;
+ } else
+ c1 = c2 = -1000;
+ REGCP_SET;
+ /* This may be improved if l == 0. */
+ while (n >= ln || (n == REG_INFTY && ln > 0 && l)) { /* ln overflow ? */
+ /* If it could work, try it. */
+ if (c1 == -1000 ||
+ UCHARAT(PL_reginput) == c1 ||
+ UCHARAT(PL_reginput) == c2)
+ {
+ if (paren) {
+ if (n) {
+ PL_regstartp[paren] = PL_reginput - l;
+ PL_regendp[paren] = PL_reginput;
+ } else
+ PL_regendp[paren] = NULL;
+ }
+ if (regmatch(next))
+ sayYES;
+ REGCP_UNWIND;
+ }
+ /* Couldn't or didn't -- move forward. */
+ PL_reginput = locinput;
+ if (regrepeat_hard(scan, 1, &l)) {
+ ln++;
+ locinput = PL_reginput;
+ }
+ else
+ sayNO;
+ }
+ } else {
+ n = regrepeat_hard(scan, n, &l);
+ if (n != 0 && l == 0
+ /* In fact, this is tricky. If paren, then the
+ fact that we did/didnot match may influence
+ future execution. */
+ && !(paren && ln == 0))
+ ln = n;
+ locinput = PL_reginput;
+ DEBUG_r(
+ PerlIO_printf(Perl_debug_log,
+ "%*s matched %ld times, len=%ld...\n",
+ REPORT_CODE_OFF+PL_regindent*2, "", n, l)
+ );
+ if (n >= ln) {
+ if (regkind[(U8)OP(next)] == EXACT) {
+ c1 = UCHARAT(OPERAND(next) + 1);
+ if (OP(next) == EXACTF)
+ c2 = fold[c1];
+ else if (OP(next) == EXACTFL)
+ c2 = fold_locale[c1];
+ else
+ c2 = c1;
+ } else
+ c1 = c2 = -1000;
+ }
+ REGCP_SET;
+ while (n >= ln) {
+ /* If it could work, try it. */
+ if (c1 == -1000 ||
+ UCHARAT(PL_reginput) == c1 ||
+ UCHARAT(PL_reginput) == c2)
+ {
+ DEBUG_r(
+ PerlIO_printf(Perl_debug_log,
+ "%*s trying tail with n=%ld...\n",
+ REPORT_CODE_OFF+PL_regindent*2, "", n)
+ );
+ if (paren) {
+ if (n) {
+ PL_regstartp[paren] = PL_reginput - l;
+ PL_regendp[paren] = PL_reginput;
+ } else
+ PL_regendp[paren] = NULL;
+ }
+ if (regmatch(next))
+ sayYES;
+ REGCP_UNWIND;
+ }
+ /* Couldn't or didn't -- back up. */
+ n--;
+ locinput -= l;
+ PL_reginput = locinput;
+ }
+ }
+ sayNO;
+ break;
+ }
+ case CURLYN:
+ paren = scan->flags; /* Which paren to set */
+ if (paren > PL_regsize)
+ PL_regsize = paren;
+ if (paren > *PL_reglastparen)
+ *PL_reglastparen = paren;
+ ln = ARG1(scan); /* min to match */
+ n = ARG2(scan); /* max to match */
+ scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
+ goto repeat;
case CURLY:
+ paren = 0;
ln = ARG1(scan); /* min to match */
n = ARG2(scan); /* max to match */
- scan = NEXTOPER(scan) + 4;
+ scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
goto repeat;
case STAR:
ln = 0;
- n = 32767;
+ n = REG_INFTY;
scan = NEXTOPER(scan);
+ paren = 0;
goto repeat;
case PLUS:
+ ln = 1;
+ n = REG_INFTY;
+ scan = NEXTOPER(scan);
+ paren = 0;
+ repeat:
/*
* Lookahead to avoid useless match attempts
* when we know what character comes next.
*/
- ln = 1;
- n = 32767;
- scan = NEXTOPER(scan);
- repeat:
if (regkind[(U8)OP(next)] == EXACT) {
c1 = UCHARAT(OPERAND(next) + 1);
if (OP(next) == EXACTF)
@@ -1084,69 +1483,138 @@ char *prog;
}
else
c1 = c2 = -1000;
- reginput = locinput;
+ PL_reginput = locinput;
if (minmod) {
+ CHECKPOINT lastcp;
minmod = 0;
if (ln && regrepeat(scan, ln) < ln)
sayNO;
- while (n >= ln || (n == 32767 && ln > 0)) { /* ln overflow ? */
+ REGCP_SET;
+ while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
/* If it could work, try it. */
if (c1 == -1000 ||
- UCHARAT(reginput) == c1 ||
- UCHARAT(reginput) == c2)
+ UCHARAT(PL_reginput) == c1 ||
+ UCHARAT(PL_reginput) == c2)
{
+ if (paren) {
+ if (n) {
+ PL_regstartp[paren] = PL_reginput - 1;
+ PL_regendp[paren] = PL_reginput;
+ } else
+ PL_regendp[paren] = NULL;
+ }
if (regmatch(next))
sayYES;
+ REGCP_UNWIND;
}
- /* Couldn't or didn't -- back up. */
- reginput = locinput + ln;
+ /* Couldn't or didn't -- move forward. */
+ PL_reginput = locinput + ln;
if (regrepeat(scan, 1)) {
ln++;
- reginput = locinput + ln;
- }
- else
+ PL_reginput = locinput + ln;
+ } else
sayNO;
}
}
else {
+ CHECKPOINT lastcp;
n = regrepeat(scan, n);
if (ln < n && regkind[(U8)OP(next)] == EOL &&
- (!multiline || OP(next) == SEOL))
+ (!PL_multiline || OP(next) == SEOL))
ln = n; /* why back off? */
- while (n >= ln) {
- /* If it could work, try it. */
- if (c1 == -1000 ||
- UCHARAT(reginput) == c1 ||
- UCHARAT(reginput) == c2)
- {
- if (regmatch(next))
- sayYES;
+ REGCP_SET;
+ if (paren) {
+ while (n >= ln) {
+ /* If it could work, try it. */
+ if (c1 == -1000 ||
+ UCHARAT(PL_reginput) == c1 ||
+ UCHARAT(PL_reginput) == c2)
+ {
+ if (paren && n) {
+ if (n) {
+ PL_regstartp[paren] = PL_reginput - 1;
+ PL_regendp[paren] = PL_reginput;
+ } else
+ PL_regendp[paren] = NULL;
+ }
+ if (regmatch(next))
+ sayYES;
+ REGCP_UNWIND;
+ }
+ /* Couldn't or didn't -- back up. */
+ n--;
+ PL_reginput = locinput + n;
+ }
+ } else {
+ while (n >= ln) {
+ /* If it could work, try it. */
+ if (c1 == -1000 ||
+ UCHARAT(PL_reginput) == c1 ||
+ UCHARAT(PL_reginput) == c2)
+ {
+ if (regmatch(next))
+ sayYES;
+ REGCP_UNWIND;
+ }
+ /* Couldn't or didn't -- back up. */
+ n--;
+ PL_reginput = locinput + n;
}
- /* Couldn't or didn't -- back up. */
- n--;
- reginput = locinput + n;
}
}
sayNO;
- case SUCCEED:
+ break;
case END:
- reginput = locinput; /* put where regtry can find it */
+ if (locinput < PL_regtill)
+ sayNO; /* Cannot match: too short. */
+ /* Fall through */
+ case SUCCEED:
+ PL_reginput = locinput; /* put where regtry can find it */
sayYES; /* Success! */
- case IFMATCH:
- reginput = locinput;
- scan = NEXTOPER(scan);
- if (!regmatch(scan))
- sayNO;
- break;
+ case SUSPEND:
+ n = 1;
+ PL_reginput = locinput;
+ goto do_ifmatch;
case UNLESSM:
- reginput = locinput;
- scan = NEXTOPER(scan);
- if (regmatch(scan))
- sayNO;
+ n = 0;
+ if (locinput < PL_bostr + scan->flags)
+ goto say_yes;
+ goto do_ifmatch;
+ case IFMATCH:
+ n = 1;
+ if (locinput < PL_bostr + scan->flags)
+ goto say_no;
+ do_ifmatch:
+ PL_reginput = locinput - scan->flags;
+ inner = NEXTOPER(NEXTOPER(scan));
+ if (regmatch(inner) != n) {
+ say_no:
+ if (logical) {
+ logical = 0;
+ sw = 0;
+ goto do_longjump;
+ } else
+ sayNO;
+ }
+ say_yes:
+ if (logical) {
+ logical = 0;
+ sw = 1;
+ }
+ if (OP(scan) == SUSPEND) {
+ locinput = PL_reginput;
+ nextchr = UCHARAT(locinput);
+ }
+ /* FALL THROUGH. */
+ case LONGJMP:
+ do_longjump:
+ next = scan + ARG(scan);
+ if (next == scan)
+ next = NULL;
break;
default:
PerlIO_printf(PerlIO_stderr(), "%lx %d\n",
- (unsigned long)scan, scan[1]);
+ (unsigned long)scan, OP(scan));
FAIL("regexp memory corruption");
}
scan = next;
@@ -1162,13 +1630,13 @@ char *prog;
yes:
#ifdef DEBUGGING
- regindent--;
+ PL_regindent--;
#endif
return 1;
no:
#ifdef DEBUGGING
- regindent--;
+ PL_regindent--;
#endif
return 0;
}
@@ -1181,20 +1649,19 @@ no:
* That was true before, but now we assume scan - reginput is the count,
* rather than incrementing count on every character.]
*/
-static I32
-regrepeat(p, max)
-char *p;
-I32 max;
+STATIC I32
+regrepeat(regnode *p, I32 max)
{
+ dTHR;
register char *scan;
register char *opnd;
register I32 c;
- register char *loceol = regeol;
+ register char *loceol = PL_regeol;
- scan = reginput;
- if (max != 32767 && max < loceol - scan)
+ scan = PL_reginput;
+ if (max != REG_INFTY && max < loceol - scan)
loceol = scan + max;
- opnd = OPERAND(p);
+ opnd = (char *) OPERAND(p);
switch (OP(p)) {
case ANY:
while (scan < loceol && *scan != '\n')
@@ -1215,14 +1682,14 @@ I32 max;
scan++;
break;
case EXACTFL: /* length of string is 1 */
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
c = UCHARAT(++opnd);
while (scan < loceol &&
(UCHARAT(scan) == c || UCHARAT(scan) == fold_locale[c]))
scan++;
break;
case ANYOF:
- while (scan < loceol && reginclass(opnd, *scan))
+ while (scan < loceol && REGINCLASS(opnd, *scan))
scan++;
break;
case ALNUM:
@@ -1230,7 +1697,7 @@ I32 max;
scan++;
break;
case ALNUML:
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
while (scan < loceol && isALNUM_LC(*scan))
scan++;
break;
@@ -1239,7 +1706,7 @@ I32 max;
scan++;
break;
case NALNUML:
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
while (scan < loceol && !isALNUM_LC(*scan))
scan++;
break;
@@ -1248,7 +1715,7 @@ I32 max;
scan++;
break;
case SPACEL:
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
while (scan < loceol && isSPACE_LC(*scan))
scan++;
break;
@@ -1257,7 +1724,7 @@ I32 max;
scan++;
break;
case NSPACEL:
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
while (scan < loceol && !isSPACE_LC(*scan))
scan++;
break;
@@ -1273,41 +1740,85 @@ I32 max;
break; /* So match right here or not at all. */
}
- c = scan - reginput;
- reginput = scan;
+ c = scan - PL_reginput;
+ PL_reginput = scan;
+ DEBUG_r(
+ {
+ SV *prop = sv_newmortal();
+
+ regprop(prop, p);
+ PerlIO_printf(Perl_debug_log,
+ "%*s %s can match %ld times out of %ld...\n",
+ REPORT_CODE_OFF+1, "", SvPVX(prop),c,max);
+ });
+
return(c);
}
/*
+ - regrepeat_hard - repeatedly match something, report total lenth and length
+ *
+ * The repeater is supposed to have constant length.
+ */
+
+STATIC I32
+regrepeat_hard(regnode *p, I32 max, I32 *lp)
+{
+ dTHR;
+ register char *scan;
+ register char *start;
+ register char *loceol = PL_regeol;
+ I32 l = 0;
+ I32 count = 0, res = 1;
+
+ if (!max)
+ return 0;
+
+ start = PL_reginput;
+ while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
+ if (!count++) {
+ *lp = l = PL_reginput - start;
+ if (max != REG_INFTY && l*max < loceol - scan)
+ loceol = scan + l*max;
+ if (l == 0)
+ return max;
+ }
+ }
+ if (!res)
+ PL_reginput = scan;
+
+ return count;
+}
+
+/*
- regclass - determine if a character falls into a character class
*/
-static bool
-reginclass(p, c)
-register char *p;
-register I32 c;
+STATIC bool
+reginclass(register char *p, register I32 c)
{
+ dTHR;
char flags = *p;
bool match = FALSE;
c &= 0xFF;
- if (p[1 + (c >> 3)] & (1 << (c & 7)))
+ if (ANYOF_TEST(p, c))
match = TRUE;
else if (flags & ANYOF_FOLD) {
I32 cf;
if (flags & ANYOF_LOCALE) {
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
cf = fold_locale[c];
}
else
cf = fold[c];
- if (p[1 + (cf >> 3)] & (1 << (cf & 7)))
+ if (ANYOF_TEST(p, cf))
match = TRUE;
}
if (!match && (flags & ANYOF_ISA)) {
- regtainted = TRUE;
+ PL_reg_flags |= RF_tainted;
if (((flags & ANYOF_ALNUML) && isALNUM_LC(c)) ||
((flags & ANYOF_NALNUML) && !isALNUM_LC(c)) ||
@@ -1318,34 +1829,8 @@ register I32 c;
}
}
- return match ^ ((flags & ANYOF_INVERT) != 0);
+ return (flags & ANYOF_INVERT) ? !match : match;
}
-/*
- - regnext - dig the "next" pointer out of a node
- *
- * [Note, when REGALIGN is defined there are two places in regmatch()
- * that bypass this code for speed.]
- */
-char *
-regnext(p)
-register char *p;
-{
- register I32 offset;
-
- if (p == &regdummy)
- return(NULL);
- offset = NEXT(p);
- if (offset == 0)
- return(NULL);
-#ifdef REGALIGN
- return(p+offset);
-#else
- if (OP(p) == BACK)
- return(p-offset);
- else
- return(p+offset);
-#endif
-}
diff --git a/gnu/usr.bin/perl/regexp.h b/gnu/usr.bin/perl/regexp.h
index 684851c548d..fbc92370b84 100644
--- a/gnu/usr.bin/perl/regexp.h
+++ b/gnu/usr.bin/perl/regexp.h
@@ -9,13 +9,35 @@
*/
+struct regnode {
+ U8 flags;
+ U8 type;
+ U16 next_off;
+};
+
+typedef struct regnode regnode;
+
+struct reg_data {
+ U32 count;
+ U8 *what;
+ void* data[1];
+};
+
+struct reg_substr_datum {
+ I32 min_offset;
+ I32 max_offset;
+ SV *substr;
+};
+
+struct reg_substr_data {
+ struct reg_substr_datum data[3]; /* Actual array */
+};
+
typedef struct regexp {
+ I32 refcnt;
char **startp;
char **endp;
- SV *regstart; /* Internal use only. */
- char *regstclass;
- SV *regmust; /* Internal use only. */
- I32 regback; /* Can regmust locate first try? */
+ regnode *regstclass;
I32 minlen; /* mininum possible length of $& */
I32 prelen; /* length of precomp */
U32 nparens; /* number of parentheses */
@@ -25,13 +47,57 @@ typedef struct regexp {
char *subbeg; /* same, but not responsible for allocation */
char *subend; /* end of subbase */
U16 naughty; /* how exponential is this pattern? */
- char reganch; /* Internal use only. */
- char exec_tainted; /* Tainted information used by regexec? */
- char program[1]; /* Unwarranted chumminess with compiler. */
+ U16 reganch; /* Internal use only +
+ Tainted information used by regexec? */
+#if 0
+ SV *anchored_substr; /* Substring at fixed position wrt start. */
+ I32 anchored_offset; /* Position of it. */
+ SV *float_substr; /* Substring at variable position wrt start. */
+ I32 float_min_offset; /* Minimal position of it. */
+ I32 float_max_offset; /* Maximal position of it. */
+ SV *check_substr; /* Substring to check before matching. */
+ I32 check_offset_min; /* Offset of the above. */
+ I32 check_offset_max; /* Offset of the above. */
+#else
+ struct reg_substr_data *substrs;
+#endif
+ struct reg_data *data; /* Additional data. */
+ regnode program[1]; /* Unwarranted chumminess with compiler. */
} regexp;
-#define ROPT_ANCH 3
-#define ROPT_ANCH_BOL 1
-#define ROPT_ANCH_GPOS 2
-#define ROPT_SKIP 4
-#define ROPT_IMPLICIT 8
+#define anchored_substr substrs->data[0].substr
+#define anchored_offset substrs->data[0].min_offset
+#define float_substr substrs->data[1].substr
+#define float_min_offset substrs->data[1].min_offset
+#define float_max_offset substrs->data[1].max_offset
+#define check_substr substrs->data[2].substr
+#define check_offset_min substrs->data[2].min_offset
+#define check_offset_max substrs->data[2].max_offset
+
+#define ROPT_ANCH (ROPT_ANCH_BOL|ROPT_ANCH_MBOL|ROPT_ANCH_GPOS)
+#define ROPT_ANCH_SINGLE (ROPT_ANCH_BOL|ROPT_ANCH_GPOS)
+#define ROPT_ANCH_BOL 1
+#define ROPT_ANCH_MBOL 2
+#define ROPT_ANCH_GPOS 4
+#define ROPT_SKIP 8
+#define ROPT_IMPLICIT 0x10 /* Converted .* to ^.* */
+#define ROPT_NOSCAN 0x20 /* Check-string always at start. */
+#define ROPT_GPOS_SEEN 0x40
+#define ROPT_CHECK_ALL 0x80
+#define ROPT_LOOKBEHIND_SEEN 0x100
+#define ROPT_EVAL_SEEN 0x200
+#define ROPT_TAINTED_SEEN 0x400
+/* 0xf800 of reganch is used by PMf_COMPILETIME */
+
+#define RX_MATCH_TAINTED(prog) ((prog)->reganch & ROPT_TAINTED_SEEN)
+#define RX_MATCH_TAINTED_on(prog) ((prog)->reganch |= ROPT_TAINTED_SEEN)
+#define RX_MATCH_TAINTED_off(prog) ((prog)->reganch &= ~ROPT_TAINTED_SEEN)
+#define RX_MATCH_TAINTED_set(prog, t) ((t) \
+ ? RX_MATCH_TAINTED_on(prog) \
+ : RX_MATCH_TAINTED_off(prog))
+
+#define REXEC_COPY_STR 1 /* Need to copy the string. */
+#define REXEC_CHECKED 2 /* check_substr already checked. */
+
+#define ReREFCNT_inc(re) ((re && re->refcnt++), re)
+#define ReREFCNT_dec(re) pregfree(re)
diff --git a/gnu/usr.bin/perl/run.c b/gnu/usr.bin/perl/run.c
index 0ce2b9ffed0..ed50fb0f20d 100644
--- a/gnu/usr.bin/perl/run.c
+++ b/gnu/usr.bin/perl/run.c
@@ -1,6 +1,6 @@
/* run.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -16,67 +16,79 @@
* know. Run now! Hope is in speed!" --Gandalf
*/
-dEXT char **watchaddr = 0;
-dEXT char *watchok;
-
-#ifndef DEBUGGING
+#ifdef PERL_OBJECT
+#define CALLOP this->*PL_op
+#else
+#define CALLOP *PL_op
+#endif
int
-runops() {
- SAVEI32(runlevel);
- runlevel++;
+runops_standard(void)
+{
+ dTHR;
- while ( op = (*op->op_ppaddr)() ) ;
+ while ( PL_op = (CALLOP->op_ppaddr)(ARGS) ) ;
TAINT_NOT;
return 0;
}
-#else
+#ifdef DEBUGGING
+
+dEXT char **watchaddr = 0;
+dEXT char *watchok;
+
+#ifndef PERL_OBJECT
+static void debprof _((OP*o));
+#endif
-static void debprof _((OP*op));
+#endif /* DEBUGGING */
int
-runops() {
- if (!op) {
+runops_debug(void)
+{
+#ifdef DEBUGGING
+ dTHR;
+ if (!PL_op) {
warn("NULL OP IN RUN");
return 0;
}
- SAVEI32(runlevel);
- runlevel++;
-
do {
- if (debug) {
+ if (PL_debug) {
if (watchaddr != 0 && *watchaddr != watchok)
PerlIO_printf(Perl_debug_log, "WARNING: %lx changed from %lx to %lx\n",
(long)watchaddr, (long)watchok, (long)*watchaddr);
DEBUG_s(debstack());
- DEBUG_t(debop(op));
- DEBUG_P(debprof(op));
+ DEBUG_t(debop(PL_op));
+ DEBUG_P(debprof(PL_op));
}
- } while ( op = (*op->op_ppaddr)() );
+ } while ( PL_op = (CALLOP->op_ppaddr)(ARGS) );
TAINT_NOT;
return 0;
+#else
+ return runops_standard();
+#endif /* DEBUGGING */
}
I32
-debop(op)
-OP *op;
+debop(OP *o)
{
+#ifdef DEBUGGING
SV *sv;
- deb("%s", op_name[op->op_type]);
- switch (op->op_type) {
+ STRLEN n_a;
+ deb("%s", op_name[o->op_type]);
+ switch (o->op_type) {
case OP_CONST:
- PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOP->op_sv));
+ PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo->op_sv));
break;
case OP_GVSV:
case OP_GV:
- if (cGVOP->op_gv) {
+ if (cGVOPo->op_gv) {
sv = NEWSV(0,0);
- gv_fullname3(sv, cGVOP->op_gv, Nullch);
- PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, na));
+ gv_fullname3(sv, cGVOPo->op_gv, Nullch);
+ PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a));
SvREFCNT_dec(sv);
}
else
@@ -86,40 +98,43 @@ OP *op;
break;
}
PerlIO_printf(Perl_debug_log, "\n");
+#endif /* DEBUGGING */
return 0;
}
void
-watch(addr)
-char **addr;
+watch(char **addr)
{
+#ifdef DEBUGGING
watchaddr = addr;
watchok = *addr;
PerlIO_printf(Perl_debug_log, "WATCHING, %lx is currently %lx\n",
(long)watchaddr, (long)watchok);
+#endif /* DEBUGGING */
}
-static void
-debprof(op)
-OP* op;
+STATIC void
+debprof(OP *o)
{
- if (!profiledata)
- New(000, profiledata, MAXO, U32);
- ++profiledata[op->op_type];
+#ifdef DEBUGGING
+ if (!PL_profiledata)
+ Newz(000, PL_profiledata, MAXO, U32);
+ ++PL_profiledata[o->op_type];
+#endif /* DEBUGGING */
}
void
-debprofdump()
+debprofdump(void)
{
+#ifdef DEBUGGING
unsigned i;
- if (!profiledata)
+ if (!PL_profiledata)
return;
for (i = 0; i < MAXO; i++) {
- if (profiledata[i])
+ if (PL_profiledata[i])
PerlIO_printf(Perl_debug_log,
- "%u\t%lu\n", i, (unsigned long)profiledata[i]);
+ "%5lu %s\n", (unsigned long)PL_profiledata[i],
+ op_name[i]);
}
+#endif /* DEBUGGING */
}
-
-#endif
-
diff --git a/gnu/usr.bin/perl/scope.c b/gnu/usr.bin/perl/scope.c
index 3006f1adc35..ff893e60cbf 100644
--- a/gnu/usr.bin/perl/scope.c
+++ b/gnu/usr.bin/perl/scope.c
@@ -1,6 +1,6 @@
/* scope.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -16,101 +16,144 @@
#include "perl.h"
SV**
-stack_grow(sp, p, n)
-SV** sp;
-SV** p;
-int n;
+stack_grow(SV **sp, SV **p, int n)
{
- stack_sp = sp;
- av_extend(curstack, (p - stack_base) + (n) + 128);
- return stack_sp;
+ dTHR;
+#if defined(DEBUGGING) && !defined(USE_THREADS)
+ static int growing = 0;
+ if (growing++)
+ abort();
+#endif
+ PL_stack_sp = sp;
+#ifndef STRESS_REALLOC
+ av_extend(PL_curstack, (p - PL_stack_base) + (n) + 128);
+#else
+ av_extend(PL_curstack, (p - PL_stack_base) + (n) + 1);
+#endif
+#if defined(DEBUGGING) && !defined(USE_THREADS)
+ growing--;
+#endif
+ return PL_stack_sp;
+}
+
+#ifndef STRESS_REALLOC
+#define GROW(old) ((old) * 3 / 2)
+#else
+#define GROW(old) ((old) + 1)
+#endif
+
+PERL_SI *
+new_stackinfo(I32 stitems, I32 cxitems)
+{
+ PERL_SI *si;
+ PERL_CONTEXT *cxt;
+ New(56, si, 1, PERL_SI);
+ si->si_stack = newAV();
+ AvREAL_off(si->si_stack);
+ av_extend(si->si_stack, stitems > 0 ? stitems-1 : 0);
+ AvALLOC(si->si_stack)[0] = &PL_sv_undef;
+ AvFILLp(si->si_stack) = 0;
+ si->si_prev = 0;
+ si->si_next = 0;
+ si->si_cxmax = cxitems - 1;
+ si->si_cxix = -1;
+ si->si_type = PERLSI_UNDEF;
+ New(56, si->si_cxstack, cxitems, PERL_CONTEXT);
+ return si;
}
I32
-cxinc()
+cxinc(void)
{
- cxstack_max = cxstack_max * 3 / 2;
- Renew(cxstack, cxstack_max + 1, CONTEXT); /* XXX should fix CXINC macro */
+ dTHR;
+ cxstack_max = GROW(cxstack_max);
+ Renew(cxstack, cxstack_max + 1, PERL_CONTEXT); /* XXX should fix CXINC macro */
return cxstack_ix + 1;
}
void
-push_return(retop)
-OP *retop;
+push_return(OP *retop)
{
- if (retstack_ix == retstack_max) {
- retstack_max = retstack_max * 3 / 2;
- Renew(retstack, retstack_max, OP*);
+ dTHR;
+ if (PL_retstack_ix == PL_retstack_max) {
+ PL_retstack_max = GROW(PL_retstack_max);
+ Renew(PL_retstack, PL_retstack_max, OP*);
}
- retstack[retstack_ix++] = retop;
+ PL_retstack[PL_retstack_ix++] = retop;
}
OP *
-pop_return()
+pop_return(void)
{
- if (retstack_ix > 0)
- return retstack[--retstack_ix];
+ dTHR;
+ if (PL_retstack_ix > 0)
+ return PL_retstack[--PL_retstack_ix];
else
return Nullop;
}
void
-push_scope()
+push_scope(void)
{
- if (scopestack_ix == scopestack_max) {
- scopestack_max = scopestack_max * 3 / 2;
- Renew(scopestack, scopestack_max, I32);
+ dTHR;
+ if (PL_scopestack_ix == PL_scopestack_max) {
+ PL_scopestack_max = GROW(PL_scopestack_max);
+ Renew(PL_scopestack, PL_scopestack_max, I32);
}
- scopestack[scopestack_ix++] = savestack_ix;
+ PL_scopestack[PL_scopestack_ix++] = PL_savestack_ix;
}
void
-pop_scope()
+pop_scope(void)
{
- I32 oldsave = scopestack[--scopestack_ix];
+ dTHR;
+ I32 oldsave = PL_scopestack[--PL_scopestack_ix];
LEAVE_SCOPE(oldsave);
}
void
-markstack_grow()
+markstack_grow(void)
{
- I32 oldmax = markstack_max - markstack;
- I32 newmax = oldmax * 3 / 2;
+ dTHR;
+ I32 oldmax = PL_markstack_max - PL_markstack;
+ I32 newmax = GROW(oldmax);
- Renew(markstack, newmax, I32);
- markstack_ptr = markstack + oldmax;
- markstack_max = markstack + newmax;
+ Renew(PL_markstack, newmax, I32);
+ PL_markstack_ptr = PL_markstack + oldmax;
+ PL_markstack_max = PL_markstack + newmax;
}
void
-savestack_grow()
+savestack_grow(void)
{
- savestack_max = savestack_max * 3 / 2;
- Renew(savestack, savestack_max, ANY);
+ dTHR;
+ PL_savestack_max = GROW(PL_savestack_max) + 4;
+ Renew(PL_savestack, PL_savestack_max, ANY);
}
+#undef GROW
+
void
-free_tmps()
+free_tmps(void)
{
+ dTHR;
/* XXX should tmps_floor live in cxstack? */
- I32 myfloor = tmps_floor;
- while (tmps_ix > myfloor) { /* clean up after last statement */
- SV* sv = tmps_stack[tmps_ix];
- tmps_stack[tmps_ix--] = Nullsv;
+ I32 myfloor = PL_tmps_floor;
+ while (PL_tmps_ix > myfloor) { /* clean up after last statement */
+ SV* sv = PL_tmps_stack[PL_tmps_ix];
+ PL_tmps_stack[PL_tmps_ix--] = Nullsv;
if (sv) {
-#ifdef DEBUGGING
SvTEMP_off(sv);
-#endif
SvREFCNT_dec(sv); /* note, can modify tmps_ix!!! */
}
}
}
-static SV *
-save_scalar_at(sptr)
-SV **sptr;
+STATIC SV *
+save_scalar_at(SV **sptr)
{
+ dTHR;
register SV *sv;
SV *osv = *sptr;
@@ -119,52 +162,64 @@ SV **sptr;
sv_upgrade(sv, SvTYPE(osv));
if (SvGMAGICAL(osv)) {
MAGIC* mg;
- bool oldtainted = tainted;
+ bool oldtainted = PL_tainted;
mg_get(osv);
- if (tainting && tainted && (mg = mg_find(osv, 't'))) {
+ if (PL_tainting && PL_tainted && (mg = mg_find(osv, 't'))) {
SAVESPTR(mg->mg_obj);
mg->mg_obj = osv;
}
SvFLAGS(osv) |= (SvFLAGS(osv) &
(SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
- tainted = oldtainted;
+ PL_tainted = oldtainted;
}
SvMAGIC(sv) = SvMAGIC(osv);
SvFLAGS(sv) |= SvMAGICAL(osv);
- localizing = 1;
+ PL_localizing = 1;
SvSETMAGIC(sv);
- localizing = 0;
+ PL_localizing = 0;
}
return sv;
}
SV *
-save_scalar(gv)
-GV *gv;
+save_scalar(GV *gv)
{
+ dTHR;
+ SV **sptr = &GvSV(gv);
SSCHECK(3);
- SSPUSHPTR(gv);
- SSPUSHPTR(GvSV(gv));
+ SSPUSHPTR(SvREFCNT_inc(gv));
+ SSPUSHPTR(SvREFCNT_inc(*sptr));
SSPUSHINT(SAVEt_SV);
- return save_scalar_at(&GvSV(gv));
+ return save_scalar_at(sptr);
}
SV*
-save_svref(sptr)
-SV **sptr;
+save_svref(SV **sptr)
{
+ dTHR;
SSCHECK(3);
SSPUSHPTR(sptr);
- SSPUSHPTR(*sptr);
+ SSPUSHPTR(SvREFCNT_inc(*sptr));
SSPUSHINT(SAVEt_SVREF);
return save_scalar_at(sptr);
}
+/* Like save_svref(), but doesn't deal with magic. Can be used to
+ * restore a global SV to its prior contents, freeing new value. */
+void
+save_generic_svref(SV **sptr)
+{
+ dTHR;
+ SSCHECK(3);
+ SSPUSHPTR(sptr);
+ SSPUSHPTR(SvREFCNT_inc(*sptr));
+ SSPUSHINT(SAVEt_GENERIC_SVREF);
+}
+
void
-save_gp(gv, empty)
-GV *gv;
-I32 empty;
+save_gp(GV *gv, I32 empty)
{
+ dTHR;
SSCHECK(6);
SSPUSHIV((IV)SvLEN(gv));
SvLEN(gv) = 0; /* forget that anything was allocated here */
@@ -177,10 +232,13 @@ I32 empty;
if (empty) {
register GP *gp;
+
+ if (GvCVu(gv))
+ PL_sub_generation++; /* taking a method out of circulation */
Newz(602, gp, 1, GP);
GvGP(gv) = gp_ref(gp);
GvSV(gv) = NEWSV(72,0);
- GvLINE(gv) = curcop->cop_line;
+ GvLINE(gv) = PL_curcop->cop_line;
GvEGV(gv) = gv;
}
else {
@@ -190,14 +248,17 @@ I32 empty;
}
AV *
-save_ary(gv)
-GV *gv;
+save_ary(GV *gv)
{
- AV *oav, *av;
+ dTHR;
+ AV *oav = GvAVn(gv);
+ AV *av;
+ if (!AvREAL(oav) && AvREIFY(oav))
+ av_reify(oav);
SSCHECK(3);
SSPUSHPTR(gv);
- SSPUSHPTR(oav = GvAVn(gv));
+ SSPUSHPTR(oav);
SSPUSHINT(SAVEt_AV);
GvAV(gv) = Null(AV*);
@@ -207,17 +268,17 @@ GV *gv;
SvFLAGS(av) |= SvMAGICAL(oav);
SvMAGICAL_off(oav);
SvMAGIC(oav) = 0;
- localizing = 1;
+ PL_localizing = 1;
SvSETMAGIC((SV*)av);
- localizing = 0;
+ PL_localizing = 0;
}
return av;
}
HV *
-save_hash(gv)
-GV *gv;
+save_hash(GV *gv)
{
+ dTHR;
HV *ohv, *hv;
SSCHECK(3);
@@ -232,31 +293,30 @@ GV *gv;
SvFLAGS(hv) |= SvMAGICAL(ohv);
SvMAGICAL_off(ohv);
SvMAGIC(ohv) = 0;
- localizing = 1;
+ PL_localizing = 1;
SvSETMAGIC((SV*)hv);
- localizing = 0;
+ PL_localizing = 0;
}
return hv;
}
void
-save_item(item)
-register SV *item;
+save_item(register SV *item)
{
- register SV *sv;
+ dTHR;
+ register SV *sv = NEWSV(0,0);
+ sv_setsv(sv,item);
SSCHECK(3);
SSPUSHPTR(item); /* remember the pointer */
- sv = NEWSV(0,0);
- sv_setsv(sv,item);
SSPUSHPTR(sv); /* remember the value */
SSPUSHINT(SAVEt_ITEM);
}
void
-save_int(intp)
-int *intp;
+save_int(int *intp)
{
+ dTHR;
SSCHECK(3);
SSPUSHINT(*intp);
SSPUSHPTR(intp);
@@ -264,9 +324,9 @@ int *intp;
}
void
-save_long(longp)
-long *longp;
+save_long(long int *longp)
{
+ dTHR;
SSCHECK(3);
SSPUSHLONG(*longp);
SSPUSHPTR(longp);
@@ -274,9 +334,9 @@ long *longp;
}
void
-save_I32(intp)
-I32 *intp;
+save_I32(I32 *intp)
{
+ dTHR;
SSCHECK(3);
SSPUSHINT(*intp);
SSPUSHPTR(intp);
@@ -284,9 +344,9 @@ I32 *intp;
}
void
-save_I16(intp)
-I16 *intp;
+save_I16(I16 *intp)
{
+ dTHR;
SSCHECK(3);
SSPUSHINT(*intp);
SSPUSHPTR(intp);
@@ -294,9 +354,9 @@ I16 *intp;
}
void
-save_iv(ivp)
-IV *ivp;
+save_iv(IV *ivp)
{
+ dTHR;
SSCHECK(3);
SSPUSHIV(*ivp);
SSPUSHPTR(ivp);
@@ -307,9 +367,9 @@ IV *ivp;
* force word-alignment and we'll miss the pointer.
*/
void
-save_pptr(pptr)
-char **pptr;
+save_pptr(char **pptr)
{
+ dTHR;
SSCHECK(3);
SSPUSHPTR(*pptr);
SSPUSHPTR(pptr);
@@ -317,28 +377,44 @@ char **pptr;
}
void
-save_sptr(sptr)
-SV **sptr;
+save_sptr(SV **sptr)
{
+ dTHR;
SSCHECK(3);
SSPUSHPTR(*sptr);
SSPUSHPTR(sptr);
SSPUSHINT(SAVEt_SPTR);
}
+SV **
+save_threadsv(PADOFFSET i)
+{
+#ifdef USE_THREADS
+ dTHR;
+ SV **svp = &THREADSV(i); /* XXX Change to save by offset */
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(), "save_threadsv %u: %p %p:%s\n",
+ i, svp, *svp, SvPEEK(*svp)));
+ save_svref(svp);
+ return svp;
+#else
+ croak("panic: save_threadsv called in non-threaded perl");
+ return 0;
+#endif /* USE_THREADS */
+}
+
void
-save_nogv(gv)
-GV *gv;
+save_nogv(GV *gv)
{
+ dTHR;
SSCHECK(2);
SSPUSHPTR(gv);
SSPUSHINT(SAVEt_NSTAB);
}
void
-save_hptr(hptr)
-HV **hptr;
+save_hptr(HV **hptr)
{
+ dTHR;
SSCHECK(3);
SSPUSHPTR(*hptr);
SSPUSHPTR(hptr);
@@ -346,9 +422,9 @@ HV **hptr;
}
void
-save_aptr(aptr)
-AV **aptr;
+save_aptr(AV **aptr)
{
+ dTHR;
SSCHECK(3);
SSPUSHPTR(*aptr);
SSPUSHPTR(aptr);
@@ -356,77 +432,77 @@ AV **aptr;
}
void
-save_freesv(sv)
-SV *sv;
+save_freesv(SV *sv)
{
+ dTHR;
SSCHECK(2);
SSPUSHPTR(sv);
SSPUSHINT(SAVEt_FREESV);
}
void
-save_freeop(op)
-OP *op;
+save_freeop(OP *o)
{
+ dTHR;
SSCHECK(2);
- SSPUSHPTR(op);
+ SSPUSHPTR(o);
SSPUSHINT(SAVEt_FREEOP);
}
void
-save_freepv(pv)
-char *pv;
+save_freepv(char *pv)
{
+ dTHR;
SSCHECK(2);
SSPUSHPTR(pv);
SSPUSHINT(SAVEt_FREEPV);
}
void
-save_clearsv(svp)
-SV** svp;
+save_clearsv(SV **svp)
{
+ dTHR;
SSCHECK(2);
- SSPUSHLONG((long)(svp-curpad));
+ SSPUSHLONG((long)(svp-PL_curpad));
SSPUSHINT(SAVEt_CLEARSV);
}
void
-save_delete(hv,key,klen)
-HV *hv;
-char *key;
-I32 klen;
+save_delete(HV *hv, char *key, I32 klen)
{
+ dTHR;
SSCHECK(4);
SSPUSHINT(klen);
SSPUSHPTR(key);
- SSPUSHPTR(hv);
+ SSPUSHPTR(SvREFCNT_inc(hv));
SSPUSHINT(SAVEt_DELETE);
}
void
-save_list(sarg,maxsarg)
-register SV **sarg;
-I32 maxsarg;
+save_list(register SV **sarg, I32 maxsarg)
{
+ dTHR;
register SV *sv;
register I32 i;
- SSCHECK(3 * maxsarg);
for (i = 1; i <= maxsarg; i++) {
- SSPUSHPTR(sarg[i]); /* remember the pointer */
sv = NEWSV(0,0);
sv_setsv(sv,sarg[i]);
+ SSCHECK(3);
+ SSPUSHPTR(sarg[i]); /* remember the pointer */
SSPUSHPTR(sv); /* remember the value */
SSPUSHINT(SAVEt_ITEM);
}
}
void
-save_destructor(f,p)
-void (*f) _((void*));
-void* p;
+#ifdef PERL_OBJECT
+save_destructor(DESTRUCTORFUNC f, void* p)
+#else
+save_destructor(void (*f) (void *), void *p)
+#endif
{
+ dTHR;
SSCHECK(3);
SSPUSHDPTR(f);
SSPUSHPTR(p);
@@ -434,38 +510,86 @@ void* p;
}
void
-leave_scope(base)
-I32 base;
+save_aelem(AV *av, I32 idx, SV **sptr)
+{
+ dTHR;
+ SSCHECK(4);
+ SSPUSHPTR(SvREFCNT_inc(av));
+ SSPUSHINT(idx);
+ SSPUSHPTR(SvREFCNT_inc(*sptr));
+ SSPUSHINT(SAVEt_AELEM);
+ save_scalar_at(sptr);
+}
+
+void
+save_helem(HV *hv, SV *key, SV **sptr)
+{
+ dTHR;
+ SSCHECK(4);
+ SSPUSHPTR(SvREFCNT_inc(hv));
+ SSPUSHPTR(SvREFCNT_inc(key));
+ SSPUSHPTR(SvREFCNT_inc(*sptr));
+ SSPUSHINT(SAVEt_HELEM);
+ save_scalar_at(sptr);
+}
+
+void
+save_op(void)
+{
+ dTHR;
+ SSCHECK(2);
+ SSPUSHPTR(PL_op);
+ SSPUSHINT(SAVEt_OP);
+}
+
+void
+leave_scope(I32 base)
{
+ dTHR;
register SV *sv;
register SV *value;
register GV *gv;
register AV *av;
register HV *hv;
register void* ptr;
+ I32 i;
if (base < -1)
croak("panic: corrupt saved stack index");
- while (savestack_ix > base) {
+ while (PL_savestack_ix > base) {
switch (SSPOPINT) {
case SAVEt_ITEM: /* normal string */
value = (SV*)SSPOPPTR;
sv = (SV*)SSPOPPTR;
sv_replace(sv,value);
- localizing = 2;
+ PL_localizing = 2;
SvSETMAGIC(sv);
- localizing = 0;
+ PL_localizing = 0;
break;
case SAVEt_SV: /* scalar reference */
value = (SV*)SSPOPPTR;
gv = (GV*)SSPOPPTR;
ptr = &GvSV(gv);
+ SvREFCNT_dec(gv);
goto restore_sv;
+ case SAVEt_GENERIC_SVREF: /* generic sv */
+ value = (SV*)SSPOPPTR;
+ ptr = SSPOPPTR;
+ if (ptr) {
+ sv = *(SV**)ptr;
+ *(SV**)ptr = value;
+ SvREFCNT_dec(sv);
+ }
+ SvREFCNT_dec(value);
+ break;
case SAVEt_SVREF: /* scalar reference */
value = (SV*)SSPOPPTR;
ptr = SSPOPPTR;
restore_sv:
sv = *(SV**)ptr;
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ "restore svref: %p %p:%s -> %p:%s\n",
+ ptr, sv, SvPEEK(sv), value, SvPEEK(value)));
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) &&
SvTYPE(sv) != SVt_PVGV)
{
@@ -485,9 +609,10 @@ I32 base;
}
SvREFCNT_dec(sv);
*(SV**)ptr = value;
- localizing = 2;
+ PL_localizing = 2;
SvSETMAGIC(value);
- localizing = 0;
+ PL_localizing = 0;
+ SvREFCNT_dec(value);
break;
case SAVEt_AV: /* array reference */
av = (AV*)SSPOPPTR;
@@ -502,9 +627,9 @@ I32 base;
}
GvAV(gv) = av;
if (SvMAGICAL(av)) {
- localizing = 2;
+ PL_localizing = 2;
SvSETMAGIC((SV*)av);
- localizing = 0;
+ PL_localizing = 0;
}
break;
case SAVEt_HV: /* hash reference */
@@ -520,9 +645,9 @@ I32 base;
}
GvHV(gv) = hv;
if (SvMAGICAL(hv)) {
- localizing = 2;
+ PL_localizing = 2;
SvSETMAGIC((SV*)hv);
- localizing = 0;
+ PL_localizing = 0;
}
break;
case SAVEt_INT: /* int reference */
@@ -568,14 +693,16 @@ I32 base;
case SAVEt_GP: /* scalar reference */
ptr = SSPOPPTR;
gv = (GV*)SSPOPPTR;
- gp_free(gv);
- GvGP(gv) = (GP*)ptr;
- if (SvPOK(gv) && SvLEN(gv) > 0) {
+ if (SvPVX(gv) && SvLEN(gv) > 0) {
Safefree(SvPVX(gv));
}
SvPVX(gv) = (char *)SSPOPPTR;
SvCUR(gv) = (STRLEN)SSPOPIV;
SvLEN(gv) = (STRLEN)SSPOPIV;
+ gp_free(gv);
+ GvGP(gv) = (GP*)ptr;
+ if (GvCVu(gv))
+ PL_sub_generation++; /* putting a method back into circulation */
SvREFCNT_dec(gv);
break;
case SAVEt_FREESV:
@@ -584,8 +711,8 @@ I32 base;
break;
case SAVEt_FREEOP:
ptr = SSPOPPTR;
- if (comppad)
- curpad = AvARRAY(comppad);
+ if (PL_comppad)
+ PL_curpad = AvARRAY(PL_comppad);
op_free((OP*)ptr);
break;
case SAVEt_FREEPV:
@@ -593,7 +720,7 @@ I32 base;
Safefree((char*)ptr);
break;
case SAVEt_CLEARSV:
- ptr = (void*)&curpad[SSPOPLONG];
+ ptr = (void*)&PL_curpad[SSPOPLONG];
sv = *(SV**)ptr;
/* Can clear pad variable in place? */
if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) {
@@ -630,12 +757,12 @@ I32 base;
}
else { /* Someone has a claim on this, so abandon it. */
U32 padflags = SvFLAGS(sv) & (SVs_PADBUSY|SVs_PADMY|SVs_PADTMP);
- SvREFCNT_dec(sv); /* Cast current value to the winds. */
switch (SvTYPE(sv)) { /* Console ourselves with a new value */
case SVt_PVAV: *(SV**)ptr = (SV*)newAV(); break;
case SVt_PVHV: *(SV**)ptr = (SV*)newHV(); break;
default: *(SV**)ptr = NEWSV(0,0); break;
}
+ SvREFCNT_dec(sv); /* Cast current value to the winds. */
SvFLAGS(*(SV**)ptr) |= padflags; /* preserve pad nature */
}
break;
@@ -644,23 +771,67 @@ I32 base;
hv = (HV*)ptr;
ptr = SSPOPPTR;
(void)hv_delete(hv, (char*)ptr, (U32)SSPOPINT, G_DISCARD);
+ SvREFCNT_dec(hv);
Safefree(ptr);
break;
case SAVEt_DESTRUCTOR:
ptr = SSPOPPTR;
- (*SSPOPDPTR)(ptr);
+ (CALLDESTRUCTOR)(ptr);
break;
case SAVEt_REGCONTEXT:
- {
- I32 delta = SSPOPINT;
- savestack_ix -= delta; /* regexp must have croaked */
- }
+ i = SSPOPINT;
+ PL_savestack_ix -= i; /* regexp must have croaked */
break;
case SAVEt_STACK_POS: /* Position on Perl stack */
- {
- I32 delta = SSPOPINT;
- stack_sp = stack_base + delta;
+ i = SSPOPINT;
+ PL_stack_sp = PL_stack_base + i;
+ break;
+ case SAVEt_AELEM: /* array element */
+ value = (SV*)SSPOPPTR;
+ i = SSPOPINT;
+ av = (AV*)SSPOPPTR;
+ ptr = av_fetch(av,i,1);
+ if (ptr) {
+ sv = *(SV**)ptr;
+ if (sv && sv != &PL_sv_undef) {
+ if (SvTIED_mg((SV*)av, 'P'))
+ (void)SvREFCNT_inc(sv);
+ SvREFCNT_dec(av);
+ goto restore_sv;
+ }
}
+ SvREFCNT_dec(av);
+ SvREFCNT_dec(value);
+ break;
+ case SAVEt_HELEM: /* hash element */
+ value = (SV*)SSPOPPTR;
+ sv = (SV*)SSPOPPTR;
+ hv = (HV*)SSPOPPTR;
+ ptr = hv_fetch_ent(hv, sv, 1, 0);
+ if (ptr) {
+ SV *oval = HeVAL((HE*)ptr);
+ if (oval && oval != &PL_sv_undef) {
+ ptr = &HeVAL((HE*)ptr);
+ if (SvTIED_mg((SV*)hv, 'P'))
+ (void)SvREFCNT_inc(*(SV**)ptr);
+ SvREFCNT_dec(hv);
+ SvREFCNT_dec(sv);
+ goto restore_sv;
+ }
+ }
+ SvREFCNT_dec(hv);
+ SvREFCNT_dec(sv);
+ SvREFCNT_dec(value);
+ break;
+ case SAVEt_OP:
+ PL_op = (OP*)SSPOPPTR;
+ break;
+ case SAVEt_HINTS:
+ if (GvHV(PL_hintgv)) {
+ SvREFCNT_dec((SV*)GvHV(PL_hintgv));
+ GvHV(PL_hintgv) = NULL;
+ }
+ *(I32*)&PL_hints = (I32)SSPOPINT;
break;
default:
croak("panic: leave_scope inconsistency");
@@ -668,14 +839,13 @@ I32 base;
}
}
-#ifdef DEBUGGING
-
void
-cx_dump(cx)
-CONTEXT* cx;
+cx_dump(PERL_CONTEXT *cx)
{
- PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), block_type[cx->cx_type]);
- if (cx->cx_type != CXt_SUBST) {
+#ifdef DEBUGGING
+ dTHR;
+ PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), block_type[CxTYPE(cx)]);
+ if (CxTYPE(cx) != CXt_SUBST) {
PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop);
PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
@@ -684,7 +854,7 @@ CONTEXT* cx;
PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm);
PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
}
- switch (cx->cx_type) {
+ switch (CxTYPE(cx)) {
case CXt_NULL:
case CXt_BLOCK:
break;
@@ -761,5 +931,5 @@ CONTEXT* cx;
(long)cx->sb_rxres);
break;
}
+#endif /* DEBUGGING */
}
-#endif
diff --git a/gnu/usr.bin/perl/scope.h b/gnu/usr.bin/perl/scope.h
index debe1f88a7f..9fab6ee8d50 100644
--- a/gnu/usr.bin/perl/scope.h
+++ b/gnu/usr.bin/perl/scope.h
@@ -22,31 +22,49 @@
#define SAVEt_REGCONTEXT 21
#define SAVEt_STACK_POS 22
#define SAVEt_I16 23
+#define SAVEt_AELEM 24
+#define SAVEt_HELEM 25
+#define SAVEt_OP 26
+#define SAVEt_HINTS 27
+/* #define SAVEt_ALLOC 28 */ /* defined in 5.005_5x */
+#define SAVEt_GENERIC_SVREF 29
-#define SSCHECK(need) if (savestack_ix + need > savestack_max) savestack_grow()
-#define SSPUSHINT(i) (savestack[savestack_ix++].any_i32 = (I32)(i))
-#define SSPUSHLONG(i) (savestack[savestack_ix++].any_long = (long)(i))
-#define SSPUSHIV(i) (savestack[savestack_ix++].any_iv = (IV)(i))
-#define SSPUSHPTR(p) (savestack[savestack_ix++].any_ptr = (void*)(p))
-#define SSPUSHDPTR(p) (savestack[savestack_ix++].any_dptr = (p))
-#define SSPOPINT (savestack[--savestack_ix].any_i32)
-#define SSPOPLONG (savestack[--savestack_ix].any_long)
-#define SSPOPIV (savestack[--savestack_ix].any_iv)
-#define SSPOPPTR (savestack[--savestack_ix].any_ptr)
-#define SSPOPDPTR (savestack[--savestack_ix].any_dptr)
+#define SSCHECK(need) if (PL_savestack_ix + need > PL_savestack_max) savestack_grow()
+#define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i))
+#define SSPUSHLONG(i) (PL_savestack[PL_savestack_ix++].any_long = (long)(i))
+#define SSPUSHIV(i) (PL_savestack[PL_savestack_ix++].any_iv = (IV)(i))
+#define SSPUSHPTR(p) (PL_savestack[PL_savestack_ix++].any_ptr = (void*)(p))
+#define SSPUSHDPTR(p) (PL_savestack[PL_savestack_ix++].any_dptr = (p))
+#define SSPOPINT (PL_savestack[--PL_savestack_ix].any_i32)
+#define SSPOPLONG (PL_savestack[--PL_savestack_ix].any_long)
+#define SSPOPIV (PL_savestack[--PL_savestack_ix].any_iv)
+#define SSPOPPTR (PL_savestack[--PL_savestack_ix].any_ptr)
+#define SSPOPDPTR (PL_savestack[--PL_savestack_ix].any_dptr)
-#define SAVETMPS save_int((int*)&tmps_floor), tmps_floor = tmps_ix
-#define FREETMPS if (tmps_ix > tmps_floor) free_tmps()
-#ifdef DEPRECATED
-#define FREE_TMPS() FREETMPS
-#endif
+#define SAVETMPS save_int((int*)&PL_tmps_floor), PL_tmps_floor = PL_tmps_ix
+#define FREETMPS if (PL_tmps_ix > PL_tmps_floor) free_tmps()
+#ifdef DEBUGGING
+#define ENTER \
+ STMT_START { \
+ push_scope(); \
+ DEBUG_l(WITH_THR(deb("ENTER scope %ld at %s:%d\n", \
+ PL_scopestack_ix, __FILE__, __LINE__))); \
+ } STMT_END
+#define LEAVE \
+ STMT_START { \
+ DEBUG_l(WITH_THR(deb("LEAVE scope %ld at %s:%d\n", \
+ PL_scopestack_ix, __FILE__, __LINE__))); \
+ pop_scope(); \
+ } STMT_END
+#else
#define ENTER push_scope()
#define LEAVE pop_scope()
-#define LEAVE_SCOPE(old) if (savestack_ix > old) leave_scope(old)
+#endif
+#define LEAVE_SCOPE(old) if (PL_savestack_ix > old) leave_scope(old)
/*
- * Not using SOFT_CAST on SAVEFREESV and SAVEFREESV
+ * Not using SOFT_CAST on SAVESPTR, SAVEGENERICSV and SAVEFREESV
* because these are used for several kinds of pointer values
*/
#define SAVEI16(i) save_I16(SOFT_CAST(I16*)&(i))
@@ -60,16 +78,40 @@
#define SAVEFREEOP(o) save_freeop(SOFT_CAST(OP*)(o))
#define SAVEFREEPV(p) save_freepv(SOFT_CAST(char*)(p))
#define SAVECLEARSV(sv) save_clearsv(SOFT_CAST(SV**)&(sv))
+#define SAVEGENERICSV(s) save_generic_svref((SV**)&(s))
#define SAVEDELETE(h,k,l) \
save_delete(SOFT_CAST(HV*)(h), SOFT_CAST(char*)(k), (I32)(l))
+#ifdef PERL_OBJECT
+#define CALLDESTRUCTOR this->*SSPOPDPTR
+#define SAVEDESTRUCTOR(f,p) \
+ save_destructor((DESTRUCTORFUNC)(FUNC_NAME_TO_PTR(f)), \
+ SOFT_CAST(void*)(p))
+#else
+#define CALLDESTRUCTOR *SSPOPDPTR
#define SAVEDESTRUCTOR(f,p) \
- save_destructor(SOFT_CAST(void(*)_((void*)))(f),SOFT_CAST(void*)(p))
-#define SAVESTACK_POS() STMT_START { \
- SSCHECK(2); \
- SSPUSHINT(stack_sp - stack_base); \
- SSPUSHINT(SAVEt_STACK_POS); \
- } STMT_END
+ save_destructor(SOFT_CAST(void(*)_((void*)))(FUNC_NAME_TO_PTR(f)), \
+ SOFT_CAST(void*)(p))
+#endif
+
+#define SAVESTACK_POS() \
+ STMT_START { \
+ SSCHECK(2); \
+ SSPUSHINT(PL_stack_sp - PL_stack_base); \
+ SSPUSHINT(SAVEt_STACK_POS); \
+ } STMT_END
+#define SAVEOP() save_op()
+
+#define SAVEHINTS() \
+ STMT_START { \
+ if (PL_hints & HINT_LOCALIZE_HH) \
+ save_hints(); \
+ else { \
+ SSCHECK(2); \
+ SSPUSHINT(PL_hints); \
+ SSPUSHINT(SAVEt_HINTS); \
+ } \
+ } STMT_END
/* A jmpenv packages the state required to perform a proper non-local jump.
* Note that there is a start_env initialized when perl starts, and top_env
@@ -95,27 +137,38 @@ struct jmpenv {
typedef struct jmpenv JMPENV;
+#ifdef OP_IN_REGISTER
+#define OP_REG_TO_MEM PL_opsave = op
+#define OP_MEM_TO_REG op = PL_opsave
+#else
+#define OP_REG_TO_MEM NOOP
+#define OP_MEM_TO_REG NOOP
+#endif
+
#define dJMPENV JMPENV cur_env
#define JMPENV_PUSH(v) \
STMT_START { \
- cur_env.je_prev = top_env; \
- cur_env.je_ret = Sigsetjmp(cur_env.je_buf, 1); \
- top_env = &cur_env; \
+ cur_env.je_prev = PL_top_env; \
+ OP_REG_TO_MEM; \
+ cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, 1); \
+ OP_MEM_TO_REG; \
+ PL_top_env = &cur_env; \
cur_env.je_mustcatch = FALSE; \
(v) = cur_env.je_ret; \
} STMT_END
#define JMPENV_POP \
- STMT_START { top_env = cur_env.je_prev; } STMT_END
+ STMT_START { PL_top_env = cur_env.je_prev; } STMT_END
#define JMPENV_JUMP(v) \
STMT_START { \
- if (top_env->je_prev) \
- Siglongjmp(top_env->je_buf, (v)); \
+ OP_REG_TO_MEM; \
+ if (PL_top_env->je_prev) \
+ PerlProc_longjmp(PL_top_env->je_buf, (v)); \
if ((v) == 2) \
- exit(STATUS_NATIVE_EXPORT); \
+ PerlProc_exit(STATUS_NATIVE_EXPORT); \
PerlIO_printf(PerlIO_stderr(), "panic: top_env\n"); \
- exit(1); \
+ PerlProc_exit(1); \
} STMT_END
-#define CATCH_GET (top_env->je_mustcatch)
-#define CATCH_SET(v) (top_env->je_mustcatch = (v))
+#define CATCH_GET (PL_top_env->je_mustcatch)
+#define CATCH_SET(v) (PL_top_env->je_mustcatch = (v))
diff --git a/gnu/usr.bin/perl/sv.c b/gnu/usr.bin/perl/sv.c
index d9596cb90f6..0778a724bd6 100644
--- a/gnu/usr.bin/perl/sv.c
+++ b/gnu/usr.bin/perl/sv.c
@@ -1,6 +1,6 @@
/* sv.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -40,13 +40,19 @@
# define FAST_SV_GETS
#endif
+#ifdef PERL_OBJECT
+#define FCALL this->*f
+#define VTBL this->*vtbl
+
+#else /* !PERL_OBJECT */
+
static IV asIV _((SV* sv));
static UV asUV _((SV* sv));
static SV *more_sv _((void));
-static XPVIV *more_xiv _((void));
-static XPVNV *more_xnv _((void));
-static XPV *more_xpv _((void));
-static XRV *more_xrv _((void));
+static void more_xiv _((void));
+static void more_xnv _((void));
+static void more_xpv _((void));
+static void more_xrv _((void));
static XPVIV *new_xiv _((void));
static XPVNV *new_xnv _((void));
static XPV *new_xpv _((void));
@@ -57,35 +63,50 @@ static void del_xpv _((XPV* p));
static void del_xrv _((XRV* p));
static void sv_mortalgrow _((void));
static void sv_unglob _((SV* sv));
+static void sv_check_thinkfirst _((SV *sv));
+
+#ifndef PURIFY
+static void *my_safemalloc(MEM_SIZE size);
+#endif
typedef void (*SVFUNC) _((SV*));
+#define VTBL *vtbl
+#define FCALL *f
+
+#endif /* PERL_OBJECT */
+
+#define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_check_thinkfirst(sv)
#ifdef PURIFY
#define new_SV(p) \
do { \
+ LOCK_SV_MUTEX; \
(p) = (SV*)safemalloc(sizeof(SV)); \
reg_add(p); \
+ UNLOCK_SV_MUTEX; \
} while (0)
#define del_SV(p) \
do { \
+ LOCK_SV_MUTEX; \
reg_remove(p); \
- free((char*)(p)); \
+ Safefree((char*)(p)); \
+ UNLOCK_SV_MUTEX; \
} while (0)
static SV **registry;
-static I32 regsize;
+static I32 registry_size;
#define REGHASH(sv,size) ((((U32)(sv)) >> 2) % (size))
#define REG_REPLACE(sv,a,b) \
do { \
void* p = sv->sv_any; \
- I32 h = REGHASH(sv, regsize); \
+ I32 h = REGHASH(sv, registry_size); \
I32 i = h; \
while (registry[i] != (a)) { \
- if (++i >= regsize) \
+ if (++i >= registry_size) \
i = 0; \
if (i == h) \
die("SV registry bug"); \
@@ -100,14 +121,13 @@ static void
reg_add(sv)
SV* sv;
{
- if (sv_count >= (regsize >> 1))
+ if (PL_sv_count >= (registry_size >> 1))
{
SV **oldreg = registry;
- I32 oldsize = regsize;
+ I32 oldsize = registry_size;
- regsize = regsize ? ((regsize << 2) + 1) : 2037;
- registry = (SV**)safemalloc(regsize * sizeof(SV*));
- memzero(registry, regsize * sizeof(SV*));
+ registry_size = registry_size ? ((registry_size << 2) + 1) : 2037;
+ Newz(707, registry, registry_size, SV*);
if (oldreg) {
I32 i;
@@ -122,7 +142,7 @@ SV* sv;
}
REG_ADD(sv);
- ++sv_count;
+ ++PL_sv_count;
}
static void
@@ -130,7 +150,7 @@ reg_remove(sv)
SV* sv;
{
REG_REMOVE(sv);
- --sv_count;
+ --PL_sv_count;
}
static void
@@ -139,9 +159,9 @@ SVFUNC f;
{
I32 i;
- for (i = 0; i < regsize; ++i) {
+ for (i = 0; i < registry_size; ++i) {
SV* sv = registry[i];
- if (sv)
+ if (sv && SvTYPE(sv) != SVTYPEMASK)
(*f)(sv);
}
}
@@ -153,7 +173,7 @@ U32 size;
U32 flags;
{
if (!(flags & SVf_FAKE))
- free(ptr);
+ Safefree(ptr);
}
#else /* ! PURIFY */
@@ -164,43 +184,49 @@ U32 flags;
#define plant_SV(p) \
do { \
- SvANY(p) = (void *)sv_root; \
+ SvANY(p) = (void *)PL_sv_root; \
SvFLAGS(p) = SVTYPEMASK; \
- sv_root = (p); \
- --sv_count; \
+ PL_sv_root = (p); \
+ --PL_sv_count; \
} while (0)
+/* sv_mutex must be held while calling uproot_SV() */
#define uproot_SV(p) \
do { \
- (p) = sv_root; \
- sv_root = (SV*)SvANY(p); \
- ++sv_count; \
+ (p) = PL_sv_root; \
+ PL_sv_root = (SV*)SvANY(p); \
+ ++PL_sv_count; \
} while (0)
-#define new_SV(p) \
- if (sv_root) \
- uproot_SV(p); \
- else \
- (p) = more_sv()
+#define new_SV(p) do { \
+ LOCK_SV_MUTEX; \
+ if (PL_sv_root) \
+ uproot_SV(p); \
+ else \
+ (p) = more_sv(); \
+ UNLOCK_SV_MUTEX; \
+ } while (0)
#ifdef DEBUGGING
-#define del_SV(p) \
- if (debug & 32768) \
- del_sv(p); \
- else \
- plant_SV(p)
+#define del_SV(p) do { \
+ LOCK_SV_MUTEX; \
+ if (PL_debug & 32768) \
+ del_sv(p); \
+ else \
+ plant_SV(p); \
+ UNLOCK_SV_MUTEX; \
+ } while (0)
-static void
-del_sv(p)
-SV* p;
+STATIC void
+del_sv(SV *p)
{
- if (debug & 32768) {
+ if (PL_debug & 32768) {
SV* sva;
SV* sv;
SV* svend;
int ok = 0;
- for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
+ for (sva = PL_sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
sv = sva + 1;
svend = &sva[SvREFCNT(sva)];
if (p >= sv && p < svend)
@@ -221,10 +247,7 @@ SV* p;
#endif /* DEBUGGING */
void
-sv_add_arena(ptr, size, flags)
-char* ptr;
-U32 size;
-U32 flags;
+sv_add_arena(char *ptr, U32 size, U32 flags)
{
SV* sva = (SV*)ptr;
register SV* sv;
@@ -232,12 +255,12 @@ U32 flags;
Zero(sva, size, char);
/* The first SV in an arena isn't an SV. */
- SvANY(sva) = (void *) sv_arenaroot; /* ptr to next arena */
+ SvANY(sva) = (void *) PL_sv_arenaroot; /* ptr to next arena */
SvREFCNT(sva) = size / sizeof(SV); /* number of SV slots */
SvFLAGS(sva) = flags; /* FAKE if not to be freed */
- sv_arenaroot = sva;
- sv_root = sva + 1;
+ PL_sv_arenaroot = sva;
+ PL_sv_root = sva + 1;
svend = &sva[SvREFCNT(sva) - 1];
sv = sva + 1;
@@ -250,14 +273,15 @@ U32 flags;
SvFLAGS(sv) = SVTYPEMASK;
}
-static SV*
-more_sv()
+/* sv_mutex must be held while calling more_sv() */
+STATIC SV*
+more_sv(void)
{
register SV* sv;
- if (nice_chunk) {
- sv_add_arena(nice_chunk, nice_chunk_size, 0);
- nice_chunk = Nullch;
+ if (PL_nice_chunk) {
+ sv_add_arena(PL_nice_chunk, PL_nice_chunk_size, 0);
+ PL_nice_chunk = Nullch;
}
else {
char *chunk; /* must use New here to match call to */
@@ -268,28 +292,26 @@ more_sv()
return sv;
}
-static void
-visit(f)
-SVFUNC f;
+STATIC void
+visit(SVFUNC f)
{
SV* sva;
SV* sv;
register SV* svend;
- for (sva = sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
+ for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
svend = &sva[SvREFCNT(sva)];
for (sv = sva + 1; sv < svend; ++sv) {
if (SvTYPE(sv) != SVTYPEMASK)
- (*f)(sv);
+ (FCALL)(sv);
}
}
}
#endif /* PURIFY */
-static void
-do_report_used(sv)
-SV* sv;
+STATIC void
+do_report_used(SV *sv)
{
if (SvTYPE(sv) != SVTYPEMASK) {
/* XXX Perhaps this ought to go to Perl_debug_log, if DEBUGGING. */
@@ -299,14 +321,13 @@ SV* sv;
}
void
-sv_report_used()
+sv_report_used(void)
{
- visit(do_report_used);
+ visit(FUNC_NAME_TO_PTR(do_report_used));
}
-static void
-do_clean_objs(sv)
-SV* sv;
+STATIC void
+do_clean_objs(SV *sv)
{
SV* rv;
@@ -321,49 +342,53 @@ SV* sv;
}
#ifndef DISABLE_DESTRUCTOR_KLUDGE
-static void
-do_clean_named_objs(sv)
-SV* sv;
+STATIC void
+do_clean_named_objs(SV *sv)
{
- if (SvTYPE(sv) == SVt_PVGV && GvSV(sv))
- do_clean_objs(GvSV(sv));
+ if (SvTYPE(sv) == SVt_PVGV) {
+ if ( SvOBJECT(GvSV(sv)) ||
+ GvAV(sv) && SvOBJECT(GvAV(sv)) ||
+ GvHV(sv) && SvOBJECT(GvHV(sv)) ||
+ GvIO(sv) && SvOBJECT(GvIO(sv)) ||
+ GvCV(sv) && SvOBJECT(GvCV(sv)) )
+ {
+ DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv));)
+ SvREFCNT_dec(sv);
+ }
+ }
}
#endif
-static bool in_clean_objs = FALSE;
-
void
-sv_clean_objs()
+sv_clean_objs(void)
{
- in_clean_objs = TRUE;
+ PL_in_clean_objs = TRUE;
+ visit(FUNC_NAME_TO_PTR(do_clean_objs));
#ifndef DISABLE_DESTRUCTOR_KLUDGE
- visit(do_clean_named_objs);
+ /* some barnacles may yet remain, clinging to typeglobs */
+ visit(FUNC_NAME_TO_PTR(do_clean_named_objs));
#endif
- visit(do_clean_objs);
- in_clean_objs = FALSE;
+ PL_in_clean_objs = FALSE;
}
-static void
-do_clean_all(sv)
-SV* sv;
+STATIC void
+do_clean_all(SV *sv)
{
- DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops:\n "), sv_dump(sv));)
+ DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%lx\n", sv) );)
SvFLAGS(sv) |= SVf_BREAK;
SvREFCNT_dec(sv);
}
-static bool in_clean_all = FALSE;
-
void
-sv_clean_all()
+sv_clean_all(void)
{
- in_clean_all = TRUE;
- visit(do_clean_all);
- in_clean_all = FALSE;
+ PL_in_clean_all = TRUE;
+ visit(FUNC_NAME_TO_PTR(do_clean_all));
+ PL_in_clean_all = FALSE;
}
void
-sv_free_arenas()
+sv_free_arenas(void)
{
SV* sva;
SV* svanext;
@@ -371,7 +396,7 @@ sv_free_arenas()
/* Free arenas here, but be careful about fake ones. (We assume
contiguity of the fake ones with the corresponding real ones.) */
- for (sva = sv_arenaroot; sva; sva = svanext) {
+ for (sva = PL_sv_arenaroot; sva; sva = svanext) {
svanext = (SV*) SvANY(sva);
while (svanext && SvFAKE(svanext))
svanext = (SV*) SvANY(svanext);
@@ -380,234 +405,255 @@ sv_free_arenas()
Safefree((void *)sva);
}
- sv_arenaroot = 0;
- sv_root = 0;
+ if (PL_nice_chunk)
+ Safefree(PL_nice_chunk);
+ PL_nice_chunk = Nullch;
+ PL_nice_chunk_size = 0;
+ PL_sv_arenaroot = 0;
+ PL_sv_root = 0;
}
-static XPVIV*
-new_xiv()
+STATIC XPVIV*
+new_xiv(void)
{
- IV** xiv;
- if (xiv_root) {
- xiv = xiv_root;
- /*
- * See comment in more_xiv() -- RAM.
- */
- xiv_root = (IV**)*xiv;
- return (XPVIV*)((char*)xiv - sizeof(XPV));
- }
- return more_xiv();
+ IV* xiv;
+ LOCK_SV_MUTEX;
+ if (!PL_xiv_root)
+ more_xiv();
+ xiv = PL_xiv_root;
+ /*
+ * See comment in more_xiv() -- RAM.
+ */
+ PL_xiv_root = *(IV**)xiv;
+ UNLOCK_SV_MUTEX;
+ return (XPVIV*)((char*)xiv - STRUCT_OFFSET(XPVIV, xiv_iv));
}
-static void
-del_xiv(p)
-XPVIV* p;
+STATIC void
+del_xiv(XPVIV *p)
{
- IV** xiv = (IV**)((char*)(p) + sizeof(XPV));
- *xiv = (IV *)xiv_root;
- xiv_root = xiv;
+ IV* xiv = (IV*)((char*)(p) + STRUCT_OFFSET(XPVIV, xiv_iv));
+ LOCK_SV_MUTEX;
+ *(IV**)xiv = PL_xiv_root;
+ PL_xiv_root = xiv;
+ UNLOCK_SV_MUTEX;
}
-static XPVIV*
-more_xiv()
+STATIC void
+more_xiv(void)
{
- register IV** xiv;
- register IV** xivend;
- XPV* ptr = (XPV*)safemalloc(1008);
- ptr->xpv_pv = (char*)xiv_arenaroot; /* linked list of xiv arenas */
- xiv_arenaroot = ptr; /* to keep Purify happy */
-
- xiv = (IV**) ptr;
- xivend = &xiv[1008 / sizeof(IV *) - 1];
- xiv += (sizeof(XPV) - 1) / sizeof(IV *) + 1; /* fudge by size of XPV */
- xiv_root = xiv;
+ register IV* xiv;
+ register IV* xivend;
+ XPV* ptr;
+ New(705, ptr, 1008/sizeof(XPV), XPV);
+ ptr->xpv_pv = (char*)PL_xiv_arenaroot; /* linked list of xiv arenas */
+ PL_xiv_arenaroot = ptr; /* to keep Purify happy */
+
+ xiv = (IV*) ptr;
+ xivend = &xiv[1008 / sizeof(IV) - 1];
+ xiv += (sizeof(XPV) - 1) / sizeof(IV) + 1; /* fudge by size of XPV */
+ PL_xiv_root = xiv;
while (xiv < xivend) {
- *xiv = (IV *)(xiv + 1);
+ *(IV**)xiv = (IV *)(xiv + 1);
xiv++;
}
- *xiv = 0;
- return new_xiv();
+ *(IV**)xiv = 0;
}
-static XPVNV*
-new_xnv()
+STATIC XPVNV*
+new_xnv(void)
{
double* xnv;
- if (xnv_root) {
- xnv = xnv_root;
- xnv_root = *(double**)xnv;
- return (XPVNV*)((char*)xnv - sizeof(XPVIV));
- }
- return more_xnv();
+ LOCK_SV_MUTEX;
+ if (!PL_xnv_root)
+ more_xnv();
+ xnv = PL_xnv_root;
+ PL_xnv_root = *(double**)xnv;
+ UNLOCK_SV_MUTEX;
+ return (XPVNV*)((char*)xnv - STRUCT_OFFSET(XPVNV, xnv_nv));
}
-static void
-del_xnv(p)
-XPVNV* p;
+STATIC void
+del_xnv(XPVNV *p)
{
- double* xnv = (double*)((char*)(p) + sizeof(XPVIV));
- *(double**)xnv = xnv_root;
- xnv_root = xnv;
+ double* xnv = (double*)((char*)(p) + STRUCT_OFFSET(XPVNV, xnv_nv));
+ LOCK_SV_MUTEX;
+ *(double**)xnv = PL_xnv_root;
+ PL_xnv_root = xnv;
+ UNLOCK_SV_MUTEX;
}
-static XPVNV*
-more_xnv()
+STATIC void
+more_xnv(void)
{
register double* xnv;
register double* xnvend;
- xnv = (double*)safemalloc(1008);
+ New(711, xnv, 1008/sizeof(double), double);
xnvend = &xnv[1008 / sizeof(double) - 1];
xnv += (sizeof(XPVIV) - 1) / sizeof(double) + 1; /* fudge by sizeof XPVIV */
- xnv_root = xnv;
+ PL_xnv_root = xnv;
while (xnv < xnvend) {
*(double**)xnv = (double*)(xnv + 1);
xnv++;
}
*(double**)xnv = 0;
- return new_xnv();
}
-static XRV*
-new_xrv()
+STATIC XRV*
+new_xrv(void)
{
XRV* xrv;
- if (xrv_root) {
- xrv = xrv_root;
- xrv_root = (XRV*)xrv->xrv_rv;
- return xrv;
- }
- return more_xrv();
+ LOCK_SV_MUTEX;
+ if (!PL_xrv_root)
+ more_xrv();
+ xrv = PL_xrv_root;
+ PL_xrv_root = (XRV*)xrv->xrv_rv;
+ UNLOCK_SV_MUTEX;
+ return xrv;
}
-static void
-del_xrv(p)
-XRV* p;
+STATIC void
+del_xrv(XRV *p)
{
- p->xrv_rv = (SV*)xrv_root;
- xrv_root = p;
+ LOCK_SV_MUTEX;
+ p->xrv_rv = (SV*)PL_xrv_root;
+ PL_xrv_root = p;
+ UNLOCK_SV_MUTEX;
}
-static XRV*
-more_xrv()
+STATIC void
+more_xrv(void)
{
register XRV* xrv;
register XRV* xrvend;
- xrv_root = (XRV*)safemalloc(1008);
- xrv = xrv_root;
+ New(712, PL_xrv_root, 1008/sizeof(XRV), XRV);
+ xrv = PL_xrv_root;
xrvend = &xrv[1008 / sizeof(XRV) - 1];
while (xrv < xrvend) {
xrv->xrv_rv = (SV*)(xrv + 1);
xrv++;
}
xrv->xrv_rv = 0;
- return new_xrv();
}
-static XPV*
-new_xpv()
+STATIC XPV*
+new_xpv(void)
{
XPV* xpv;
- if (xpv_root) {
- xpv = xpv_root;
- xpv_root = (XPV*)xpv->xpv_pv;
- return xpv;
- }
- return more_xpv();
+ LOCK_SV_MUTEX;
+ if (!PL_xpv_root)
+ more_xpv();
+ xpv = PL_xpv_root;
+ PL_xpv_root = (XPV*)xpv->xpv_pv;
+ UNLOCK_SV_MUTEX;
+ return xpv;
}
-static void
-del_xpv(p)
-XPV* p;
+STATIC void
+del_xpv(XPV *p)
{
- p->xpv_pv = (char*)xpv_root;
- xpv_root = p;
+ LOCK_SV_MUTEX;
+ p->xpv_pv = (char*)PL_xpv_root;
+ PL_xpv_root = p;
+ UNLOCK_SV_MUTEX;
}
-static XPV*
-more_xpv()
+STATIC void
+more_xpv(void)
{
register XPV* xpv;
register XPV* xpvend;
- xpv_root = (XPV*)safemalloc(1008);
- xpv = xpv_root;
+ New(713, PL_xpv_root, 1008/sizeof(XPV), XPV);
+ xpv = PL_xpv_root;
xpvend = &xpv[1008 / sizeof(XPV) - 1];
while (xpv < xpvend) {
xpv->xpv_pv = (char*)(xpv + 1);
xpv++;
}
xpv->xpv_pv = 0;
- return new_xpv();
}
#ifdef PURIFY
#define new_XIV() (void*)safemalloc(sizeof(XPVIV))
-#define del_XIV(p) free((char*)p)
+#define del_XIV(p) Safefree((char*)p)
#else
#define new_XIV() (void*)new_xiv()
-#define del_XIV(p) del_xiv(p)
+#define del_XIV(p) del_xiv((XPVIV*) p)
#endif
#ifdef PURIFY
#define new_XNV() (void*)safemalloc(sizeof(XPVNV))
-#define del_XNV(p) free((char*)p)
+#define del_XNV(p) Safefree((char*)p)
#else
#define new_XNV() (void*)new_xnv()
-#define del_XNV(p) del_xnv(p)
+#define del_XNV(p) del_xnv((XPVNV*) p)
#endif
#ifdef PURIFY
#define new_XRV() (void*)safemalloc(sizeof(XRV))
-#define del_XRV(p) free((char*)p)
+#define del_XRV(p) Safefree((char*)p)
#else
#define new_XRV() (void*)new_xrv()
-#define del_XRV(p) del_xrv(p)
+#define del_XRV(p) del_xrv((XRV*) p)
#endif
#ifdef PURIFY
#define new_XPV() (void*)safemalloc(sizeof(XPV))
-#define del_XPV(p) free((char*)p)
+#define del_XPV(p) Safefree((char*)p)
#else
#define new_XPV() (void*)new_xpv()
-#define del_XPV(p) del_xpv(p)
+#define del_XPV(p) del_xpv((XPV *)p)
#endif
-#define new_XPVIV() (void*)safemalloc(sizeof(XPVIV))
-#define del_XPVIV(p) free((char*)p)
-
-#define new_XPVNV() (void*)safemalloc(sizeof(XPVNV))
-#define del_XPVNV(p) free((char*)p)
-
-#define new_XPVMG() (void*)safemalloc(sizeof(XPVMG))
-#define del_XPVMG(p) free((char*)p)
-
-#define new_XPVLV() (void*)safemalloc(sizeof(XPVLV))
-#define del_XPVLV(p) free((char*)p)
-
-#define new_XPVAV() (void*)safemalloc(sizeof(XPVAV))
-#define del_XPVAV(p) free((char*)p)
-
-#define new_XPVHV() (void*)safemalloc(sizeof(XPVHV))
-#define del_XPVHV(p) free((char*)p)
-
-#define new_XPVCV() (void*)safemalloc(sizeof(XPVCV))
-#define del_XPVCV(p) free((char*)p)
-
-#define new_XPVGV() (void*)safemalloc(sizeof(XPVGV))
-#define del_XPVGV(p) free((char*)p)
-
-#define new_XPVBM() (void*)safemalloc(sizeof(XPVBM))
-#define del_XPVBM(p) free((char*)p)
-
-#define new_XPVFM() (void*)safemalloc(sizeof(XPVFM))
-#define del_XPVFM(p) free((char*)p)
-
-#define new_XPVIO() (void*)safemalloc(sizeof(XPVIO))
-#define del_XPVIO(p) free((char*)p)
+#ifdef PURIFY
+# define my_safemalloc(s) safemalloc(s)
+# define my_safefree(s) free(s)
+#else
+STATIC void*
+my_safemalloc(MEM_SIZE size)
+{
+ char *p;
+ New(717, p, size, char);
+ return (void*)p;
+}
+# define my_safefree(s) Safefree(s)
+#endif
+
+#define new_XPVIV() (void*)my_safemalloc(sizeof(XPVIV))
+#define del_XPVIV(p) my_safefree((char*)p)
+
+#define new_XPVNV() (void*)my_safemalloc(sizeof(XPVNV))
+#define del_XPVNV(p) my_safefree((char*)p)
+
+#define new_XPVMG() (void*)my_safemalloc(sizeof(XPVMG))
+#define del_XPVMG(p) my_safefree((char*)p)
+
+#define new_XPVLV() (void*)my_safemalloc(sizeof(XPVLV))
+#define del_XPVLV(p) my_safefree((char*)p)
+
+#define new_XPVAV() (void*)my_safemalloc(sizeof(XPVAV))
+#define del_XPVAV(p) my_safefree((char*)p)
+
+#define new_XPVHV() (void*)my_safemalloc(sizeof(XPVHV))
+#define del_XPVHV(p) my_safefree((char*)p)
+
+#define new_XPVCV() (void*)my_safemalloc(sizeof(XPVCV))
+#define del_XPVCV(p) my_safefree((char*)p)
+
+#define new_XPVGV() (void*)my_safemalloc(sizeof(XPVGV))
+#define del_XPVGV(p) my_safefree((char*)p)
+
+#define new_XPVBM() (void*)my_safemalloc(sizeof(XPVBM))
+#define del_XPVBM(p) my_safefree((char*)p)
+
+#define new_XPVFM() (void*)my_safemalloc(sizeof(XPVFM))
+#define del_XPVFM(p) my_safefree((char*)p)
+
+#define new_XPVIO() (void*)my_safemalloc(sizeof(XPVIO))
+#define del_XPVIO(p) my_safefree((char*)p)
bool
-sv_upgrade(sv, mt)
-register SV* sv;
-U32 mt;
+sv_upgrade(register SV *sv, U32 mt)
{
char* pv;
U32 cur;
@@ -787,7 +833,7 @@ U32 mt;
Safefree(pv);
SvPVX(sv) = 0;
AvMAX(sv) = -1;
- AvFILL(sv) = -1;
+ AvFILLp(sv) = -1;
SvIVX(sv) = 0;
SvNVX(sv) = 0.0;
SvMAGIC(sv) = magic;
@@ -880,11 +926,10 @@ U32 mt;
return TRUE;
}
-#ifdef DEBUGGING
char *
-sv_peek(sv)
-register SV *sv;
+sv_peek(SV *sv)
{
+#ifdef DEBUGGING
SV *t = sv_newmortal();
STRLEN prevlen;
int unref = 0;
@@ -899,15 +944,15 @@ register SV *sv;
sv_catpv(t, "WILD");
goto finish;
}
- else if (sv == &sv_undef || sv == &sv_no || sv == &sv_yes) {
- if (sv == &sv_undef) {
+ else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes) {
+ if (sv == &PL_sv_undef) {
sv_catpv(t, "SV_UNDEF");
if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
SVs_GMG|SVs_SMG|SVs_RMG)) &&
SvREADONLY(sv))
goto finish;
}
- else if (sv == &sv_no) {
+ else if (sv == &PL_sv_no) {
sv_catpv(t, "SV_NO");
if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
SVs_GMG|SVs_SMG|SVs_RMG)) &&
@@ -1025,13 +1070,14 @@ register SV *sv;
while (unref--)
sv_catpv(t, ")");
}
- return SvPV(t, na);
+ return SvPV(t, prevlen);
+#else /* DEBUGGING */
+ return "";
+#endif /* DEBUGGING */
}
-#endif
int
-sv_backoff(sv)
-register SV *sv;
+sv_backoff(register SV *sv)
{
assert(SvOOK(sv));
if (SvIVX(sv)) {
@@ -1046,12 +1092,10 @@ register SV *sv;
}
char *
-sv_grow(sv,newlen)
-register SV *sv;
#ifndef DOSISH
-register I32 newlen;
+sv_grow(register SV *sv, register I32 newlen)
#else
-unsigned long newlen;
+sv_grow(SV* sv, unsigned long newlen)
#endif
{
register char *s;
@@ -1073,12 +1117,24 @@ unsigned long newlen;
s = SvPVX(sv);
if (newlen > SvLEN(sv))
newlen += 10 * (newlen - SvCUR(sv)); /* avoid copy each time */
+#ifdef HAS_64K_LIMIT
+ if (newlen >= 0x10000)
+ newlen = 0xFFFF;
+#endif
}
else
s = SvPVX(sv);
if (newlen > SvLEN(sv)) { /* need more room? */
- if (SvLEN(sv) && s)
+ if (SvLEN(sv) && s) {
+#if defined(MYMALLOC) && !defined(PURIFY) && !defined(LEAKTEST)
+ STRLEN l = malloced_size((void*)SvPVX(sv));
+ if (newlen <= l) {
+ SvLEN_set(sv, l);
+ return s;
+ } else
+#endif
Renew(s,newlen,char);
+ }
else
New(703,s,newlen,char);
SvPV_set(sv, s);
@@ -1088,16 +1144,9 @@ unsigned long newlen;
}
void
-sv_setiv(sv,i)
-register SV *sv;
-IV i;
+sv_setiv(register SV *sv, IV i)
{
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
- if (SvROK(sv))
- sv_unref(sv);
- }
+ SV_CHECK_THINKFIRST(sv);
switch (SvTYPE(sv)) {
case SVt_NULL:
sv_upgrade(sv, SVt_IV);
@@ -1121,8 +1170,11 @@ IV i;
case SVt_PVCV:
case SVt_PVFM:
case SVt_PVIO:
- croak("Can't coerce %s to integer in %s", sv_reftype(sv,0),
- op_desc[op->op_type]);
+ {
+ dTHR;
+ croak("Can't coerce %s to integer in %s", sv_reftype(sv,0),
+ op_desc[PL_op->op_type]);
+ }
}
(void)SvIOK_only(sv); /* validate number */
SvIVX(sv) = i;
@@ -1130,9 +1182,14 @@ IV i;
}
void
-sv_setuv(sv,u)
-register SV *sv;
-UV u;
+sv_setiv_mg(register SV *sv, IV i)
+{
+ sv_setiv(sv,i);
+ SvSETMAGIC(sv);
+}
+
+void
+sv_setuv(register SV *sv, UV u)
{
if (u <= IV_MAX)
sv_setiv(sv, u);
@@ -1141,34 +1198,27 @@ UV u;
}
void
-sv_setnv(sv,num)
-register SV *sv;
-double num;
+sv_setuv_mg(register SV *sv, UV u)
{
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
- if (SvROK(sv))
- sv_unref(sv);
- }
+ sv_setuv(sv,u);
+ SvSETMAGIC(sv);
+}
+
+void
+sv_setnv(register SV *sv, double num)
+{
+ SV_CHECK_THINKFIRST(sv);
switch (SvTYPE(sv)) {
case SVt_NULL:
case SVt_IV:
sv_upgrade(sv, SVt_NV);
break;
- case SVt_NV:
case SVt_RV:
case SVt_PV:
case SVt_PVIV:
sv_upgrade(sv, SVt_PVNV);
- /* FALL THROUGH */
- case SVt_PVNV:
- case SVt_PVMG:
- case SVt_PVBM:
- case SVt_PVLV:
- if (SvOOK(sv))
- (void)SvOOK_off(sv);
break;
+
case SVt_PVGV:
if (SvFAKE(sv)) {
sv_unglob(sv);
@@ -1180,18 +1230,28 @@ double num;
case SVt_PVCV:
case SVt_PVFM:
case SVt_PVIO:
- croak("Can't coerce %s to number in %s", sv_reftype(sv,0),
- op_name[op->op_type]);
+ {
+ dTHR;
+ croak("Can't coerce %s to number in %s", sv_reftype(sv,0),
+ op_name[PL_op->op_type]);
+ }
}
SvNVX(sv) = num;
(void)SvNOK_only(sv); /* validate number */
SvTAINT(sv);
}
-static void
-not_a_number(sv)
-SV *sv;
+void
+sv_setnv_mg(register SV *sv, double num)
+{
+ sv_setnv(sv,num);
+ SvSETMAGIC(sv);
+}
+
+STATIC void
+not_a_number(SV *sv)
{
+ dTHR;
char tmpbuf[64];
char *d = tmpbuf;
char *s;
@@ -1236,16 +1296,15 @@ SV *sv;
}
*d = '\0';
- if (op)
+ if (PL_op)
warn("Argument \"%s\" isn't numeric in %s", tmpbuf,
- op_name[op->op_type]);
+ op_name[PL_op->op_type]);
else
warn("Argument \"%s\" isn't numeric", tmpbuf);
}
IV
-sv_2iv(sv)
-register SV *sv;
+sv_2iv(register SV *sv)
{
if (!sv)
return 0;
@@ -1262,8 +1321,11 @@ register SV *sv;
if (SvPOKp(sv) && SvLEN(sv))
return asIV(sv);
if (!SvROK(sv)) {
- if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
- warn(warn_uninit);
+ if (PL_dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
+ dTHR;
+ if (!PL_localizing)
+ warn(warn_uninit);
+ }
return 0;
}
}
@@ -1285,7 +1347,7 @@ register SV *sv;
}
if (SvPOKp(sv) && SvLEN(sv))
return asIV(sv);
- if (dowarn)
+ if (PL_dowarn)
warn(warn_uninit);
return 0;
}
@@ -1313,7 +1375,8 @@ register SV *sv;
SvIVX(sv) = asIV(sv);
}
else {
- if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+ dTHR;
+ if (PL_dowarn && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
warn(warn_uninit);
return 0;
}
@@ -1323,8 +1386,7 @@ register SV *sv;
}
UV
-sv_2uv(sv)
-register SV *sv;
+sv_2uv(register SV *sv)
{
if (!sv)
return 0;
@@ -1337,8 +1399,11 @@ register SV *sv;
if (SvPOKp(sv) && SvLEN(sv))
return asUV(sv);
if (!SvROK(sv)) {
- if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
- warn(warn_uninit);
+ if (PL_dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
+ dTHR;
+ if (!PL_localizing)
+ warn(warn_uninit);
+ }
return 0;
}
}
@@ -1357,7 +1422,7 @@ register SV *sv;
}
if (SvPOKp(sv) && SvLEN(sv))
return asUV(sv);
- if (dowarn)
+ if (PL_dowarn)
warn(warn_uninit);
return 0;
}
@@ -1382,8 +1447,11 @@ register SV *sv;
SvUVX(sv) = asUV(sv);
}
else {
- if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
- warn(warn_uninit);
+ if (PL_dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
+ dTHR;
+ if (!PL_localizing)
+ warn(warn_uninit);
+ }
return 0;
}
DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2uv(%lu)\n",
@@ -1392,8 +1460,7 @@ register SV *sv;
}
double
-sv_2nv(sv)
-register SV *sv;
+sv_2nv(register SV *sv)
{
if (!sv)
return 0.0;
@@ -1402,7 +1469,7 @@ register SV *sv;
if (SvNOKp(sv))
return SvNVX(sv);
if (SvPOKp(sv) && SvLEN(sv)) {
- if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
+ if (PL_dowarn && !SvIOKp(sv) && !looks_like_number(sv))
not_a_number(sv);
SET_NUMERIC_STANDARD();
return atof(SvPVX(sv));
@@ -1410,8 +1477,11 @@ register SV *sv;
if (SvIOKp(sv))
return (double)SvIVX(sv);
if (!SvROK(sv)) {
- if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
- warn(warn_uninit);
+ if (PL_dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
+ dTHR;
+ if (!PL_localizing)
+ warn(warn_uninit);
+ }
return 0;
}
}
@@ -1426,14 +1496,14 @@ register SV *sv;
}
if (SvREADONLY(sv)) {
if (SvPOKp(sv) && SvLEN(sv)) {
- if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
+ if (PL_dowarn && !SvIOKp(sv) && !looks_like_number(sv))
not_a_number(sv);
SET_NUMERIC_STANDARD();
return atof(SvPVX(sv));
}
if (SvIOKp(sv))
return (double)SvIVX(sv);
- if (dowarn)
+ if (PL_dowarn)
warn(warn_uninit);
return 0.0;
}
@@ -1455,13 +1525,14 @@ register SV *sv;
SvNVX(sv) = (double)SvIVX(sv);
}
else if (SvPOKp(sv) && SvLEN(sv)) {
- if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
+ if (PL_dowarn && !SvIOKp(sv) && !looks_like_number(sv))
not_a_number(sv);
SET_NUMERIC_STANDARD();
SvNVX(sv) = atof(SvPVX(sv));
}
else {
- if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+ dTHR;
+ if (PL_dowarn && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
warn(warn_uninit);
return 0.0;
}
@@ -1472,16 +1543,15 @@ register SV *sv;
return SvNVX(sv);
}
-static IV
-asIV(sv)
-SV *sv;
+STATIC IV
+asIV(SV *sv)
{
I32 numtype = looks_like_number(sv);
double d;
if (numtype == 1)
return atol(SvPVX(sv));
- if (!numtype && dowarn)
+ if (!numtype && PL_dowarn)
not_a_number(sv);
SET_NUMERIC_STANDARD();
d = atof(SvPVX(sv));
@@ -1491,9 +1561,8 @@ SV *sv;
return (IV) U_V(d);
}
-static UV
-asUV(sv)
-SV *sv;
+STATIC UV
+asUV(SV *sv)
{
I32 numtype = looks_like_number(sv);
@@ -1501,15 +1570,14 @@ SV *sv;
if (numtype == 1)
return strtoul(SvPVX(sv), Null(char**), 10);
#endif
- if (!numtype && dowarn)
+ if (!numtype && PL_dowarn)
not_a_number(sv);
SET_NUMERIC_STANDARD();
return U_V(atof(SvPVX(sv)));
}
I32
-looks_like_number(sv)
-SV *sv;
+looks_like_number(SV *sv)
{
register char *s;
register char *send;
@@ -1588,13 +1656,12 @@ SV *sv;
}
char *
-sv_2pv(sv, lp)
-register SV *sv;
-STRLEN *lp;
+sv_2pv(register SV *sv, STRLEN *lp)
{
register char *s;
int olderrno;
SV *tsv;
+ char tmpbuf[64]; /* Must fit sprintf/Gconvert of longest IV/NV */
if (!sv) {
*lp = 0;
@@ -1607,19 +1674,22 @@ STRLEN *lp;
return SvPVX(sv);
}
if (SvIOKp(sv)) {
- (void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv));
+ (void)sprintf(tmpbuf,"%ld",(long)SvIVX(sv));
tsv = Nullsv;
goto tokensave;
}
if (SvNOKp(sv)) {
SET_NUMERIC_STANDARD();
- Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
+ Gconvert(SvNVX(sv), DBL_DIG, 0, tmpbuf);
tsv = Nullsv;
goto tokensave;
}
if (!SvROK(sv)) {
- if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
- warn(warn_uninit);
+ if (PL_dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
+ dTHR;
+ if (!PL_localizing)
+ warn(warn_uninit);
+ }
*lp = 0;
return "";
}
@@ -1635,7 +1705,54 @@ STRLEN *lp;
if (!sv)
s = "NULLREF";
else {
+ MAGIC *mg;
+
switch (SvTYPE(sv)) {
+ case SVt_PVMG:
+ if ( ((SvFLAGS(sv) &
+ (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
+ == (SVs_OBJECT|SVs_RMG))
+ && strEQ(s=HvNAME(SvSTASH(sv)), "Regexp")
+ && (mg = mg_find(sv, 'r'))) {
+ dTHR;
+ regexp *re = (regexp *)mg->mg_obj;
+
+ if (!mg->mg_ptr) {
+ char *fptr = "msix";
+ char reflags[6];
+ char ch;
+ int left = 0;
+ int right = 4;
+ U16 reganch = (re->reganch & PMf_COMPILETIME) >> 12;
+
+ while(ch = *fptr++) {
+ if(reganch & 1) {
+ reflags[left++] = ch;
+ }
+ else {
+ reflags[right--] = ch;
+ }
+ reganch >>= 1;
+ }
+ if(left != 4) {
+ reflags[left] = '-';
+ left = 5;
+ }
+
+ mg->mg_len = re->prelen + 4 + left;
+ New(616, mg->mg_ptr, mg->mg_len + 1 + left, char);
+ Copy("(?", mg->mg_ptr, 2, char);
+ Copy(reflags, mg->mg_ptr+2, left, char);
+ Copy(":", mg->mg_ptr+left+2, 1, char);
+ Copy(re->precomp, mg->mg_ptr+3+left, re->prelen, char);
+ mg->mg_ptr[mg->mg_len - 1] = ')';
+ mg->mg_ptr[mg->mg_len] = 0;
+ }
+ PL_reginterp_cnt += re->program[0].next_off;
+ *lp = mg->mg_len;
+ return mg->mg_ptr;
+ }
+ /* Fall through */
case SVt_NULL:
case SVt_IV:
case SVt_NV:
@@ -1643,14 +1760,13 @@ STRLEN *lp;
case SVt_PV:
case SVt_PVIV:
case SVt_PVNV:
- case SVt_PVBM:
- case SVt_PVMG: s = "SCALAR"; break;
+ case SVt_PVBM: s = "SCALAR"; break;
case SVt_PVLV: s = "LVALUE"; break;
case SVt_PVAV: s = "ARRAY"; break;
case SVt_PVHV: s = "HASH"; break;
case SVt_PVCV: s = "CODE"; break;
case SVt_PVGV: s = "GLOB"; break;
- case SVt_PVFM: s = "FORMATLINE"; break;
+ case SVt_PVFM: s = "FORMAT"; break;
case SVt_PVIO: s = "IO"; break;
default: s = "UNKNOWN"; break;
}
@@ -1668,23 +1784,22 @@ STRLEN *lp;
if (SvREADONLY(sv)) {
if (SvNOKp(sv)) {
SET_NUMERIC_STANDARD();
- Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
+ Gconvert(SvNVX(sv), DBL_DIG, 0, tmpbuf);
tsv = Nullsv;
goto tokensave;
}
if (SvIOKp(sv)) {
- (void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv));
+ (void)sprintf(tmpbuf,"%ld",(long)SvIVX(sv));
tsv = Nullsv;
goto tokensave;
}
- if (dowarn)
+ if (PL_dowarn)
warn(warn_uninit);
*lp = 0;
return "";
}
}
- if (!SvUPGRADE(sv, SVt_PV))
- return 0;
+ (void)SvUPGRADE(sv, SVt_PV);
if (SvNOKp(sv)) {
if (SvTYPE(sv) < SVt_PVNV)
sv_upgrade(sv, SVt_PVNV);
@@ -1725,7 +1840,8 @@ STRLEN *lp;
SvIOKp_on(sv);
}
else {
- if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+ dTHR;
+ if (PL_dowarn && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
warn(warn_uninit);
*lp = 0;
return "";
@@ -1742,7 +1858,7 @@ STRLEN *lp;
tokensaveref:
if (!tsv)
- tsv = newSVpv(tokenbuf, 0);
+ tsv = newSVpv(tmpbuf, 0);
sv_2mortal(tsv);
*lp = SvCUR(tsv);
return SvPVX(tsv);
@@ -1757,8 +1873,8 @@ STRLEN *lp;
len = SvCUR(tsv);
}
else {
- t = tokenbuf;
- len = strlen(tokenbuf);
+ t = tmpbuf;
+ len = strlen(tmpbuf);
}
#ifdef FIXNEGATIVEZERO
if (len == 2 && t[0] == '-' && t[1] == '0') {
@@ -1778,8 +1894,7 @@ STRLEN *lp;
/* This function is only called on magical items */
bool
-sv_2bool(sv)
-register SV *sv;
+sv_2bool(register SV *sv)
{
if (SvGMAGICAL(sv))
mg_get(sv);
@@ -1789,6 +1904,7 @@ register SV *sv;
if (SvROK(sv)) {
#ifdef OVERLOAD
{
+ dTHR;
SV* tmpsv;
if (SvAMAGIC(sv) && (tmpsv = AMG_CALLun(sv,bool_)))
return SvTRUE(tmpsv);
@@ -1797,11 +1913,11 @@ register SV *sv;
return SvRV(sv) != 0;
}
if (SvPOKp(sv)) {
- register XPV* Xpv;
- if ((Xpv = (XPV*)SvANY(sv)) &&
- (*Xpv->xpv_pv > '0' ||
- Xpv->xpv_cur > 1 ||
- (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
+ register XPV* Xpvtmp;
+ if ((Xpvtmp = (XPV*)SvANY(sv)) &&
+ (*Xpvtmp->xpv_pv > '0' ||
+ Xpvtmp->xpv_cur > 1 ||
+ (Xpvtmp->xpv_cur && *Xpvtmp->xpv_pv != '0')))
return 1;
else
return 0;
@@ -1824,24 +1940,18 @@ register SV *sv;
*/
void
-sv_setsv(dstr,sstr)
-SV *dstr;
-register SV *sstr;
+sv_setsv(SV *dstr, register SV *sstr)
{
+ dTHR;
register U32 sflags;
register int dtype;
register int stype;
if (sstr == dstr)
return;
- if (SvTHINKFIRST(dstr)) {
- if (SvREADONLY(dstr) && curcop != &compiling)
- croak(no_modify);
- if (SvROK(dstr))
- sv_unref(dstr);
- }
+ SV_CHECK_THINKFIRST(dstr);
if (!sstr)
- sstr = &sv_undef;
+ sstr = &PL_sv_undef;
stype = SvTYPE(sstr);
dtype = SvTYPE(dstr);
@@ -1859,26 +1969,53 @@ register SV *sstr;
switch (stype) {
case SVt_NULL:
- (void)SvOK_off(dstr);
- return;
+ undef_sstr:
+ if (dtype != SVt_PVGV) {
+ (void)SvOK_off(dstr);
+ return;
+ }
+ break;
case SVt_IV:
- if (dtype != SVt_IV && dtype < SVt_PVIV) {
- if (dtype < SVt_IV)
+ if (SvIOK(sstr)) {
+ switch (dtype) {
+ case SVt_NULL:
sv_upgrade(dstr, SVt_IV);
- else if (dtype == SVt_NV)
+ break;
+ case SVt_NV:
sv_upgrade(dstr, SVt_PVNV);
- else
+ break;
+ case SVt_RV:
+ case SVt_PV:
sv_upgrade(dstr, SVt_PVIV);
+ break;
+ }
+ (void)SvIOK_only(dstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvTAINT(dstr);
+ return;
}
- break;
+ goto undef_sstr;
+
case SVt_NV:
- if (dtype != SVt_NV && dtype < SVt_PVNV) {
- if (dtype < SVt_NV)
+ if (SvNOK(sstr)) {
+ switch (dtype) {
+ case SVt_NULL:
+ case SVt_IV:
sv_upgrade(dstr, SVt_NV);
- else
+ break;
+ case SVt_RV:
+ case SVt_PV:
+ case SVt_PVIV:
sv_upgrade(dstr, SVt_PVNV);
+ break;
+ }
+ SvNVX(dstr) = SvNVX(sstr);
+ (void)SvNOK_only(dstr);
+ SvTAINT(dstr);
+ return;
}
- break;
+ goto undef_sstr;
+
case SVt_RV:
if (dtype < SVt_RV)
sv_upgrade(dstr, SVt_RV);
@@ -1886,7 +2023,7 @@ register SV *sstr;
SvTYPE(SvRV(sstr)) == SVt_PVGV) {
sstr = SvRV(sstr);
if (sstr == dstr) {
- if (curcop->cop_stash != GvSTASH(dstr))
+ if (PL_curcop->cop_stash != GvSTASH(dstr))
GvIMPORTED_on(dstr);
GvMULTI_on(dstr);
return;
@@ -1907,18 +2044,13 @@ register SV *sstr;
if (dtype < SVt_PVNV)
sv_upgrade(dstr, SVt_PVNV);
break;
-
- case SVt_PVLV:
- sv_upgrade(dstr, SVt_PVLV);
- break;
-
case SVt_PVAV:
case SVt_PVHV:
case SVt_PVCV:
case SVt_PVIO:
- if (op)
+ if (PL_op)
croak("Bizarre copy of %s in %s", sv_reftype(sstr, 0),
- op_name[op->op_type]);
+ op_name[PL_op->op_type]);
else
croak("Bizarre copy of %s", sv_reftype(sstr, 0));
break;
@@ -1931,14 +2063,14 @@ register SV *sstr;
STRLEN len = GvNAMELEN(sstr);
sv_upgrade(dstr, SVt_PVGV);
sv_magic(dstr, dstr, '*', name, len);
- GvSTASH(dstr) = GvSTASH(sstr);
+ GvSTASH(dstr) = (HV*)SvREFCNT_inc(GvSTASH(sstr));
GvNAME(dstr) = savepvn(name, len);
GvNAMELEN(dstr) = len;
SvFAKE_on(dstr); /* can coerce to non-glob */
}
/* ahem, death to those who redefine active sort subs */
- else if (curstack == sortstack
- && GvCV(dstr) && sortcop == CvSTART(GvCV(dstr)))
+ else if (PL_curstackinfo->si_type == PERLSI_SORT
+ && GvCV(dstr) && PL_sortcop == CvSTART(GvCV(dstr)))
croak("Can't redefine active sort subroutine %s",
GvNAME(dstr));
(void)SvOK_off(dstr);
@@ -1946,7 +2078,7 @@ register SV *sstr;
gp_free((GV*)dstr);
GvGP(dstr) = gp_ref(GvGP(sstr));
SvTAINT(dstr);
- if (curcop->cop_stash != GvSTASH(dstr))
+ if (PL_curcop->cop_stash != GvSTASH(dstr))
GvIMPORTED_on(dstr);
GvMULTI_on(dstr);
return;
@@ -1962,8 +2094,10 @@ register SV *sstr;
goto glob_assign;
}
}
- if (dtype < stype)
- sv_upgrade(dstr, stype);
+ if (stype == SVt_PVLV)
+ SvUPGRADE(dstr, SVt_PVNV);
+ else
+ SvUPGRADE(dstr, stype);
}
sflags = SvFLAGS(sstr);
@@ -1982,7 +2116,7 @@ register SV *sstr;
Newz(602,gp, 1, GP);
GvGP(dstr) = gp_ref(gp);
GvSV(dstr) = NEWSV(72,0);
- GvLINE(dstr) = curcop->cop_line;
+ GvLINE(dstr) = PL_curcop->cop_line;
GvEGV(dstr) = (GV*)dstr;
}
GvMULTI_on(dstr);
@@ -1993,7 +2127,7 @@ register SV *sstr;
else
dref = (SV*)GvAV(dstr);
GvAV(dstr) = (AV*)sref;
- if (curcop->cop_stash != GvSTASH(dstr))
+ if (PL_curcop->cop_stash != GvSTASH(dstr))
GvIMPORTED_AV_on(dstr);
break;
case SVt_PVHV:
@@ -2002,7 +2136,7 @@ register SV *sstr;
else
dref = (SV*)GvHV(dstr);
GvHV(dstr) = (HV*)sref;
- if (curcop->cop_stash != GvSTASH(dstr))
+ if (PL_curcop->cop_stash != GvSTASH(dstr))
GvIMPORTED_HV_on(dstr);
break;
case SVt_PVCV:
@@ -2011,7 +2145,7 @@ register SV *sstr;
SvREFCNT_dec(GvCV(dstr));
GvCV(dstr) = Nullcv;
GvCVGEN(dstr) = 0; /* Switch off cacheness. */
- sub_generation++;
+ PL_sub_generation++;
}
SAVESPTR(GvCV(dstr));
}
@@ -2023,19 +2157,29 @@ register SV *sstr;
if (!GvCVGEN((GV*)dstr) &&
(CvROOT(cv) || CvXSUB(cv)))
{
+ SV *const_sv = cv_const_sv(cv);
+ bool const_changed = TRUE;
+ if(const_sv)
+ const_changed = sv_cmp(const_sv,
+ op_const_sv(CvSTART((CV*)sref),
+ Nullcv));
/* ahem, death to those who redefine
* active sort subs */
- if (curstack == sortstack &&
- sortcop == CvSTART(cv))
+ if (PL_curstackinfo->si_type == PERLSI_SORT &&
+ PL_sortcop == CvSTART(cv))
croak(
"Can't redefine active sort subroutine %s",
GvENAME((GV*)dstr));
- if (cv_const_sv(cv))
- warn("Constant subroutine %s redefined",
- GvENAME((GV*)dstr));
- else if (dowarn)
- warn("Subroutine %s redefined",
- GvENAME((GV*)dstr));
+ if (PL_dowarn || (const_changed && const_sv)) {
+ if (!(CvGV(cv) && GvSTASH(CvGV(cv))
+ && HvNAME(GvSTASH(CvGV(cv)))
+ && strEQ(HvNAME(GvSTASH(CvGV(cv))),
+ "autouse")))
+ warn(const_sv ?
+ "Constant subroutine %s redefined"
+ : "Subroutine %s redefined",
+ GvENAME((GV*)dstr));
+ }
}
cv_ckproto(cv, (GV*)dstr,
SvPOK(sref) ? SvPVX(sref) : Nullch);
@@ -2043,9 +2187,9 @@ register SV *sstr;
GvCV(dstr) = (CV*)sref;
GvCVGEN(dstr) = 0; /* Switch off cacheness. */
GvASSUMECV_on(dstr);
- sub_generation++;
+ PL_sub_generation++;
}
- if (curcop->cop_stash != GvSTASH(dstr))
+ if (PL_curcop->cop_stash != GvSTASH(dstr))
GvIMPORTED_CV_on(dstr);
break;
case SVt_PVIO:
@@ -2061,7 +2205,7 @@ register SV *sstr;
else
dref = (SV*)GvSV(dstr);
GvSV(dstr) = sref;
- if (curcop->cop_stash != GvSTASH(dstr))
+ if (PL_curcop->cop_stash != GvSTASH(dstr))
GvIMPORTED_SV_on(dstr);
break;
}
@@ -2105,6 +2249,7 @@ register SV *sstr;
*/
if (SvTEMP(sstr) && /* slated for free anyway? */
+ SvREFCNT(sstr) == 1 && /* and no other references to it? */
!(sflags & SVf_OOK)) /* and not involved in OOK hack? */
{
if (SvPVX(dstr)) { /* we know that dtype >= SVt_PV */
@@ -2158,25 +2303,30 @@ register SV *sstr;
SvIVX(dstr) = SvIVX(sstr);
}
else {
- (void)SvOK_off(dstr);
+ if (dtype == SVt_PVGV) {
+ if (PL_dowarn)
+ warn("Undefined value assigned to typeglob");
+ }
+ else
+ (void)SvOK_off(dstr);
}
SvTAINT(dstr);
}
void
-sv_setpvn(sv,ptr,len)
-register SV *sv;
-register const char *ptr;
-register STRLEN len;
+sv_setsv_mg(SV *dstr, register SV *sstr)
+{
+ sv_setsv(dstr,sstr);
+ SvSETMAGIC(dstr);
+}
+
+void
+sv_setpvn(register SV *sv, register const char *ptr, register STRLEN len)
{
+ register char *dptr;
assert(len >= 0); /* STRLEN is probably unsigned, so this may
elicit a warning, but it won't hurt. */
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
- if (SvROK(sv))
- sv_unref(sv);
- }
+ SV_CHECK_THINKFIRST(sv);
if (!ptr) {
(void)SvOK_off(sv);
return;
@@ -2185,29 +2335,31 @@ register STRLEN len;
if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
sv_unglob(sv);
}
- else if (!sv_upgrade(sv, SVt_PV))
- return;
+ else
+ sv_upgrade(sv, SVt_PV);
+
SvGROW(sv, len + 1);
- Move(ptr,SvPVX(sv),len,char);
+ dptr = SvPVX(sv);
+ Move(ptr,dptr,len,char);
+ dptr[len] = '\0';
SvCUR_set(sv, len);
- *SvEND(sv) = '\0';
(void)SvPOK_only(sv); /* validate pointer */
SvTAINT(sv);
}
void
-sv_setpv(sv,ptr)
-register SV *sv;
-register const char *ptr;
+sv_setpvn_mg(register SV *sv, register const char *ptr, register STRLEN len)
+{
+ sv_setpvn(sv,ptr,len);
+ SvSETMAGIC(sv);
+}
+
+void
+sv_setpv(register SV *sv, register const char *ptr)
{
register STRLEN len;
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
- if (SvROK(sv))
- sv_unref(sv);
- }
+ SV_CHECK_THINKFIRST(sv);
if (!ptr) {
(void)SvOK_off(sv);
return;
@@ -2217,8 +2369,9 @@ register const char *ptr;
if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
sv_unglob(sv);
}
- else if (!sv_upgrade(sv, SVt_PV))
- return;
+ else
+ sv_upgrade(sv, SVt_PV);
+
SvGROW(sv, len + 1);
Move(ptr,SvPVX(sv),len+1,char);
SvCUR_set(sv, len);
@@ -2227,19 +2380,17 @@ register const char *ptr;
}
void
-sv_usepvn(sv,ptr,len)
-register SV *sv;
-register char *ptr;
-register STRLEN len;
+sv_setpv_mg(register SV *sv, register const char *ptr)
{
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
- if (SvROK(sv))
- sv_unref(sv);
- }
- if (!SvUPGRADE(sv, SVt_PV))
- return;
+ sv_setpv(sv,ptr);
+ SvSETMAGIC(sv);
+}
+
+void
+sv_usepvn(register SV *sv, register char *ptr, register STRLEN len)
+{
+ SV_CHECK_THINKFIRST(sv);
+ (void)SvUPGRADE(sv, SVt_PV);
if (!ptr) {
(void)SvOK_off(sv);
return;
@@ -2256,20 +2407,34 @@ register STRLEN len;
}
void
-sv_chop(sv,ptr) /* like set but assuming ptr is in sv */
-register SV *sv;
-register char *ptr;
+sv_usepvn_mg(register SV *sv, register char *ptr, register STRLEN len)
+{
+ sv_usepvn(sv,ptr,len);
+ SvSETMAGIC(sv);
+}
+
+STATIC void
+sv_check_thinkfirst(register SV *sv)
+{
+ if (SvREADONLY(sv)) {
+ dTHR;
+ if (PL_curcop != &PL_compiling)
+ croak(no_modify);
+ }
+ if (SvROK(sv))
+ sv_unref(sv);
+}
+
+void
+sv_chop(register SV *sv, register char *ptr) /* like set but assuming ptr is in sv */
+
+
{
register STRLEN delta;
if (!ptr || !SvPOKp(sv))
return;
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
- if (SvROK(sv))
- sv_unref(sv);
- }
+ SV_CHECK_THINKFIRST(sv);
if (SvTYPE(sv) < SVt_PVIV)
sv_upgrade(sv,SVt_PVIV);
@@ -2286,10 +2451,7 @@ register char *ptr;
}
void
-sv_catpvn(sv,ptr,len)
-register SV *sv;
-register char *ptr;
-register STRLEN len;
+sv_catpvn(register SV *sv, register char *ptr, register STRLEN len)
{
STRLEN tlen;
char *junk;
@@ -2306,9 +2468,14 @@ register STRLEN len;
}
void
-sv_catsv(dstr,sstr)
-SV *dstr;
-register SV *sstr;
+sv_catpvn_mg(register SV *sv, register char *ptr, register STRLEN len)
+{
+ sv_catpvn(sv,ptr,len);
+ SvSETMAGIC(sv);
+}
+
+void
+sv_catsv(SV *dstr, register SV *sstr)
{
char *s;
STRLEN len;
@@ -2319,9 +2486,14 @@ register SV *sstr;
}
void
-sv_catpv(sv,ptr)
-register SV *sv;
-register char *ptr;
+sv_catsv_mg(SV *dstr, register SV *sstr)
+{
+ sv_catsv(dstr,sstr);
+ SvSETMAGIC(dstr);
+}
+
+void
+sv_catpv(register SV *sv, register char *ptr)
{
register STRLEN len;
STRLEN tlen;
@@ -2340,14 +2512,15 @@ register char *ptr;
SvTAINT(sv);
}
+void
+sv_catpv_mg(register SV *sv, register char *ptr)
+{
+ sv_catpv(sv,ptr);
+ SvSETMAGIC(sv);
+}
+
SV *
-#ifdef LEAKTEST
-newSV(x,len)
-I32 x;
-#else
-newSV(len)
-#endif
-STRLEN len;
+newSV(STRLEN len)
{
register SV *sv;
@@ -2365,17 +2538,15 @@ STRLEN len;
/* name is assumed to contain an SV* if (name && namelen == HEf_SVKEY) */
void
-sv_magic(sv, obj, how, name, namlen)
-register SV *sv;
-SV *obj;
-int how;
-char *name;
-I32 namlen;
+sv_magic(register SV *sv, SV *obj, int how, char *name, I32 namlen)
{
MAGIC* mg;
- if (SvREADONLY(sv) && curcop != &compiling && !strchr("gBf", how))
- croak(no_modify);
+ if (SvREADONLY(sv)) {
+ dTHR;
+ if (PL_curcop != &PL_compiling && !strchr("gBf", how))
+ croak(no_modify);
+ }
if (SvMAGICAL(sv) || (how == 't' && SvTYPE(sv) >= SVt_PVMG)) {
if (SvMAGIC(sv) && (mg = mg_find(sv, how))) {
if (how == 't')
@@ -2384,16 +2555,16 @@ I32 namlen;
}
}
else {
- if (!SvUPGRADE(sv, SVt_PVMG))
- return;
+ (void)SvUPGRADE(sv, SVt_PVMG);
}
Newz(702,mg, 1, MAGIC);
mg->mg_moremagic = SvMAGIC(sv);
SvMAGIC(sv) = mg;
- if (!obj || obj == sv || how == '#')
+ if (!obj || obj == sv || how == '#' || how == 'r')
mg->mg_obj = obj;
else {
+ dTHR;
mg->mg_obj = SvREFCNT_inc(obj);
mg->mg_flags |= MGf_REFCOUNTED;
}
@@ -2451,6 +2622,11 @@ I32 namlen;
case 'l':
mg->mg_virtual = &vtbl_dbline;
break;
+#ifdef USE_THREADS
+ case 'm':
+ mg->mg_virtual = &vtbl_mutex;
+ break;
+#endif /* USE_THREADS */
#ifdef USE_LOCALE_COLLATE
case 'o':
mg->mg_virtual = &vtbl_collxfrm;
@@ -2463,6 +2639,9 @@ I32 namlen;
case 'q':
mg->mg_virtual = &vtbl_packelem;
break;
+ case 'r':
+ mg->mg_virtual = &vtbl_regexp;
+ break;
case 'S':
mg->mg_virtual = &vtbl_sig;
break;
@@ -2509,9 +2688,7 @@ I32 namlen;
}
int
-sv_unmagic(sv, type)
-SV* sv;
-int type;
+sv_unmagic(SV *sv, int type)
{
MAGIC* mg;
MAGIC** mgp;
@@ -2522,8 +2699,8 @@ int type;
if (mg->mg_type == type) {
MGVTBL* vtbl = mg->mg_virtual;
*mgp = mg->mg_moremagic;
- if (vtbl && vtbl->svt_free)
- (*vtbl->svt_free)(sv, mg);
+ if (vtbl && (vtbl->svt_free != NULL))
+ (VTBL->svt_free)(sv, mg);
if (mg->mg_ptr && mg->mg_type != 'g')
if (mg->mg_len >= 0)
Safefree(mg->mg_ptr);
@@ -2545,22 +2722,24 @@ int type;
}
void
-sv_insert(bigstr,offset,len,little,littlelen)
-SV *bigstr;
-STRLEN offset;
-STRLEN len;
-char *little;
-STRLEN littlelen;
+sv_insert(SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN littlelen)
{
register char *big;
register char *mid;
register char *midend;
register char *bigend;
register I32 i;
+ STRLEN curlen;
+
if (!bigstr)
croak("Can't modify non-existent substring");
- SvPV_force(bigstr, na);
+ SvPV_force(bigstr, curlen);
+ if (offset + len > curlen) {
+ SvGROW(bigstr, offset+len+1);
+ Zero(SvPVX(bigstr)+curlen, offset+len-curlen, char);
+ SvCUR_set(bigstr, offset+len);
+ }
i = littlelen - len;
if (i > 0) { /* string might grow */
@@ -2628,17 +2807,10 @@ STRLEN littlelen;
/* make sv point to what nstr did */
void
-sv_replace(sv,nsv)
-register SV *sv;
-register SV *nsv;
+sv_replace(register SV *sv, register SV *nsv)
{
U32 refcnt = SvREFCNT(sv);
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
- if (SvROK(sv))
- sv_unref(sv);
- }
+ SV_CHECK_THINKFIRST(sv);
if (SvREFCNT(nsv) != 1)
warn("Reference miscount in sv_replace()");
if (SvMAGICAL(sv)) {
@@ -2661,53 +2833,55 @@ register SV *nsv;
}
void
-sv_clear(sv)
-register SV *sv;
+sv_clear(register SV *sv)
{
+ HV* stash;
assert(sv);
assert(SvREFCNT(sv) == 0);
if (SvOBJECT(sv)) {
- if (defstash) { /* Still have a symbol table? */
- dSP;
+ dTHR;
+ if (PL_defstash) { /* Still have a symbol table? */
+ djSP;
GV* destructor;
+ SV tmpref;
- ENTER;
- SAVEFREESV(SvSTASH(sv));
-
- destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
- if (destructor) {
- SV ref;
-
- Zero(&ref, 1, SV);
- sv_upgrade(&ref, SVt_RV);
- SvRV(&ref) = SvREFCNT_inc(sv);
- SvROK_on(&ref);
- SvREFCNT(&ref) = 1; /* Fake, but otherwise
- creating+destructing a ref
- leads to disaster. */
-
- EXTEND(SP, 2);
- PUSHMARK(SP);
- PUSHs(&ref);
- PUTBACK;
- perl_call_sv((SV*)GvCV(destructor),
- G_DISCARD|G_EVAL|G_KEEPERR);
- del_XRV(SvANY(&ref));
- SvREFCNT(sv)--;
- }
+ Zero(&tmpref, 1, SV);
+ sv_upgrade(&tmpref, SVt_RV);
+ SvROK_on(&tmpref);
+ SvREADONLY_on(&tmpref); /* DESTROY() could be naughty */
+ SvREFCNT(&tmpref) = 1;
- LEAVE;
+ do {
+ stash = SvSTASH(sv);
+ destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
+ if (destructor) {
+ ENTER;
+ PUSHSTACKi(PERLSI_DESTROY);
+ SvRV(&tmpref) = SvREFCNT_inc(sv);
+ EXTEND(SP, 2);
+ PUSHMARK(SP);
+ PUSHs(&tmpref);
+ PUTBACK;
+ perl_call_sv((SV*)GvCV(destructor),
+ G_DISCARD|G_EVAL|G_KEEPERR);
+ SvREFCNT(sv)--;
+ POPSTACK;
+ LEAVE;
+ }
+ } while (SvOBJECT(sv) && SvSTASH(sv) != stash);
+
+ del_XRV(SvANY(&tmpref));
}
- else
- SvREFCNT_dec(SvSTASH(sv));
+
if (SvOBJECT(sv)) {
+ SvREFCNT_dec(SvSTASH(sv)); /* possibly of changed persuasion */
SvOBJECT_off(sv); /* Curse the object. */
if (SvTYPE(sv) != SVt_PVIO)
- --sv_objcount; /* XXX Might want something more general */
+ --PL_sv_objcount; /* XXX Might want something more general */
}
if (SvREFCNT(sv)) {
- if (in_clean_objs)
+ if (PL_in_clean_objs)
croak("DESTROY created new reference to dead object");
/* DESTROY gave object new lease on life */
return;
@@ -2715,9 +2889,11 @@ register SV *sv;
}
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
mg_free(sv);
+ stash = NULL;
switch (SvTYPE(sv)) {
case SVt_PVIO:
- if (IoIFP(sv) != PerlIO_stdin() &&
+ if (IoIFP(sv) &&
+ IoIFP(sv) != PerlIO_stdin() &&
IoIFP(sv) != PerlIO_stdout() &&
IoIFP(sv) != PerlIO_stderr())
io_close((IO*)sv);
@@ -2737,11 +2913,18 @@ register SV *sv;
case SVt_PVAV:
av_undef((AV*)sv);
break;
+ case SVt_PVLV:
+ SvREFCNT_dec(LvTARG(sv));
+ goto freescalar;
case SVt_PVGV:
gp_free((GV*)sv);
Safefree(GvNAME(sv));
+ /* cannot decrease stash refcount yet, as we might recursively delete
+ ourselves when the refcnt drops to zero. Delay SvREFCNT_dec
+ of stash until current sv is completely gone.
+ -- JohnPC, 27 Mar 1998 */
+ stash = GvSTASH(sv);
/* FALL THROUGH */
- case SVt_PVLV:
case SVt_PVMG:
case SVt_PVNV:
case SVt_PVIV:
@@ -2801,7 +2984,13 @@ register SV *sv;
break;
case SVt_PVGV:
del_XPVGV(SvANY(sv));
- break;
+ /* code duplication for increased performance. */
+ SvFLAGS(sv) &= SVf_BREAK;
+ SvFLAGS(sv) |= SVTYPEMASK;
+ /* decrease refcount of the stash that owns this GV, if any */
+ if (stash)
+ SvREFCNT_dec(stash);
+ return; /* not break, SvFLAGS reset already happened */
case SVt_PVBM:
del_XPVBM(SvANY(sv));
break;
@@ -2817,48 +3006,54 @@ register SV *sv;
}
SV *
-sv_newref(sv)
-SV* sv;
+sv_newref(SV *sv)
{
if (sv)
- SvREFCNT(sv)++;
+ ATOMIC_INC(SvREFCNT(sv));
return sv;
}
void
-sv_free(sv)
-SV *sv;
+sv_free(SV *sv)
{
+ int refcount_is_zero;
+
if (!sv)
return;
- if (SvREADONLY(sv)) {
- if (sv == &sv_undef || sv == &sv_yes || sv == &sv_no)
- return;
- }
if (SvREFCNT(sv) == 0) {
if (SvFLAGS(sv) & SVf_BREAK)
return;
- if (in_clean_all) /* All is fair */
+ if (PL_in_clean_all) /* All is fair */
+ return;
+ if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
+ /* make sure SvREFCNT(sv)==0 happens very seldom */
+ SvREFCNT(sv) = (~(U32)0)/2;
return;
+ }
warn("Attempt to free unreferenced scalar");
return;
}
- if (--SvREFCNT(sv) > 0)
+ ATOMIC_DEC_AND_TEST(refcount_is_zero, SvREFCNT(sv));
+ if (!refcount_is_zero)
return;
#ifdef DEBUGGING
if (SvTEMP(sv)) {
- warn("Attempt to free temp prematurely");
+ warn("Attempt to free temp prematurely: SV 0x%lx", (unsigned long)sv);
return;
}
#endif
+ if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
+ /* make sure SvREFCNT(sv)==0 happens very seldom */
+ SvREFCNT(sv) = (~(U32)0)/2;
+ return;
+ }
sv_clear(sv);
if (! SvREFCNT(sv))
del_SV(sv);
}
STRLEN
-sv_len(sv)
-register SV *sv;
+sv_len(register SV *sv)
{
char *junk;
STRLEN len;
@@ -2867,16 +3062,14 @@ register SV *sv;
return 0;
if (SvGMAGICAL(sv))
- len = mg_len(sv);
+ len = mg_length(sv);
else
junk = SvPV(sv, len);
return len;
}
I32
-sv_eq(str1,str2)
-register SV *str1;
-register SV *str2;
+sv_eq(register SV *str1, register SV *str2)
{
char *pv1;
STRLEN cur1;
@@ -2902,14 +3095,12 @@ register SV *str2;
}
I32
-sv_cmp(str1, str2)
-register SV *str1;
-register SV *str2;
+sv_cmp(register SV *str1, register SV *str2)
{
STRLEN cur1 = 0;
- char *pv1 = str1 ? SvPV(str1, cur1) : NULL;
+ char *pv1 = str1 ? SvPV(str1, cur1) : (char *) NULL;
STRLEN cur2 = 0;
- char *pv2 = str2 ? SvPV(str2, cur2) : NULL;
+ char *pv2 = str2 ? SvPV(str2, cur2) : (char *) NULL;
I32 retval;
if (!cur1)
@@ -2930,9 +3121,7 @@ register SV *str2;
}
I32
-sv_cmp_locale(sv1, sv2)
-register SV *sv1;
-register SV *sv2;
+sv_cmp_locale(register SV *sv1, register SV *sv2)
{
#ifdef USE_LOCALE_COLLATE
@@ -2940,13 +3129,13 @@ register SV *sv2;
STRLEN len1, len2;
I32 retval;
- if (collation_standard)
+ if (PL_collation_standard)
goto raw_compare;
len1 = 0;
- pv1 = sv1 ? sv_collxfrm(sv1, &len1) : NULL;
+ pv1 = sv1 ? sv_collxfrm(sv1, &len1) : (char *) NULL;
len2 = 0;
- pv2 = sv2 ? sv_collxfrm(sv2, &len2) : NULL;
+ pv2 = sv2 ? sv_collxfrm(sv2, &len2) : (char *) NULL;
if (!pv1 || !len1) {
if (pv2 && len2)
@@ -2987,14 +3176,12 @@ register SV *sv2;
* according to the locale settings.
*/
char *
-sv_collxfrm(sv, nxp)
- SV *sv;
- STRLEN *nxp;
+sv_collxfrm(SV *sv, STRLEN *nxp)
{
MAGIC *mg;
- mg = SvMAGICAL(sv) ? mg_find(sv, 'o') : NULL;
- if (!mg || !mg->mg_ptr || *(U32*)mg->mg_ptr != collation_ix) {
+ mg = SvMAGICAL(sv) ? mg_find(sv, 'o') : (MAGIC *) NULL;
+ if (!mg || !mg->mg_ptr || *(U32*)mg->mg_ptr != PL_collation_ix) {
char *s, *xf;
STRLEN len, xlen;
@@ -3005,7 +3192,7 @@ sv_collxfrm(sv, nxp)
if (SvREADONLY(sv)) {
SAVEFREEPV(xf);
*nxp = xlen;
- return xf + sizeof(collation_ix);
+ return xf + sizeof(PL_collation_ix);
}
if (! mg) {
sv_magic(sv, 0, 'o', 0, 0);
@@ -3024,7 +3211,7 @@ sv_collxfrm(sv, nxp)
}
if (mg && mg->mg_ptr) {
*nxp = mg->mg_len;
- return mg->mg_ptr + sizeof(collation_ix);
+ return mg->mg_ptr + sizeof(PL_collation_ix);
}
else {
*nxp = 0;
@@ -3035,11 +3222,9 @@ sv_collxfrm(sv, nxp)
#endif /* USE_LOCALE_COLLATE */
char *
-sv_gets(sv,fp,append)
-register SV *sv;
-register PerlIO *fp;
-I32 append;
+sv_gets(register SV *sv, register PerlIO *fp, I32 append)
{
+ dTHR;
char *rsptr;
STRLEN rslen;
register STDCHAR rslast;
@@ -3047,29 +3232,44 @@ I32 append;
register I32 cnt;
I32 i;
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
- if (SvROK(sv))
- sv_unref(sv);
- }
- if (!SvUPGRADE(sv, SVt_PV))
- return 0;
+ SV_CHECK_THINKFIRST(sv);
+ (void)SvUPGRADE(sv, SVt_PV);
SvSCREAM_off(sv);
- if (RsSNARF(rs)) {
+ if (RsSNARF(PL_rs)) {
rsptr = NULL;
rslen = 0;
}
- else if (RsPARA(rs)) {
+ else if (RsRECORD(PL_rs)) {
+ I32 recsize, bytesread;
+ char *buffer;
+
+ /* Grab the size of the record we're getting */
+ recsize = SvIV(SvRV(PL_rs));
+ (void)SvPOK_only(sv); /* Validate pointer */
+ buffer = SvGROW(sv, recsize + 1);
+ /* Go yank in */
+#ifdef VMS
+ /* VMS wants read instead of fread, because fread doesn't respect */
+ /* RMS record boundaries. This is not necessarily a good thing to be */
+ /* doing, but we've got no other real choice */
+ bytesread = PerlLIO_read(PerlIO_fileno(fp), buffer, recsize);
+#else
+ bytesread = PerlIO_read(fp, buffer, recsize);
+#endif
+ SvCUR_set(sv, bytesread);
+ buffer[bytesread] = '\0';
+ return(SvCUR(sv) ? SvPVX(sv) : Nullch);
+ }
+ else if (RsPARA(PL_rs)) {
rsptr = "\n\n";
rslen = 2;
}
else
- rsptr = SvPV(rs, rslen);
+ rsptr = SvPV(PL_rs, rslen);
rslast = rslen ? rsptr[rslen - 1] : '\0';
- if (RsPARA(rs)) { /* have to do this both before and after */
+ if (RsPARA(PL_rs)) { /* have to do this both before and after */
do { /* to make sure file boundaries work right */
if (PerlIO_eof(fp))
return 0;
@@ -3266,7 +3466,7 @@ screamer2:
}
}
- if (RsPARA(rs)) { /* have to do this both before and after */
+ if (RsPARA(PL_rs)) { /* have to do this both before and after */
while (i != EOF) { /* to make sure file boundaries work right */
i = PerlIO_getc(fp);
if (i != '\n') {
@@ -3276,31 +3476,40 @@ screamer2:
}
}
+#ifdef WIN32
+ win32_strip_return(sv);
+#endif
+
return (SvCUR(sv) - append) ? SvPVX(sv) : Nullch;
}
void
-sv_inc(sv)
-register SV *sv;
+sv_inc(register SV *sv)
{
register char *d;
int flags;
if (!sv)
return;
+ if (SvGMAGICAL(sv))
+ mg_get(sv);
if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
+ if (SvREADONLY(sv)) {
+ dTHR;
+ if (PL_curcop != &PL_compiling)
+ croak(no_modify);
+ }
if (SvROK(sv)) {
+ IV i;
#ifdef OVERLOAD
- if (SvAMAGIC(sv) && AMG_CALLun(sv,inc)) return;
+ if (SvAMAGIC(sv) && AMG_CALLun(sv,inc)) return;
#endif /* OVERLOAD */
- sv_unref(sv);
+ i = (IV)SvRV(sv);
+ sv_unref(sv);
+ sv_setiv(sv, i);
}
}
- if (SvGMAGICAL(sv))
- mg_get(sv);
flags = SvFLAGS(sv);
if (flags & SVp_NOK) {
(void)SvNOK_only(sv);
@@ -3339,10 +3548,24 @@ register SV *sv;
*(d--) = '0';
}
else {
+#ifdef EBCDIC
+ /* MKS: The original code here died if letters weren't consecutive.
+ * at least it didn't have to worry about non-C locales. The
+ * new code assumes that ('z'-'a')==('Z'-'A'), letters are
+ * arranged in order (although not consecutively) and that only
+ * [A-Za-z] are accepted by isALPHA in the C locale.
+ */
+ if (*d != 'z' && *d != 'Z') {
+ do { ++*d; } while (!isALPHA(*d));
+ return;
+ }
+ *(d--) -= 'z' - 'a';
+#else
++*d;
if (isALPHA(*d))
return;
*(d--) -= 'z' - 'a' + 1;
+#endif
}
}
/* oh,oh, the number grew */
@@ -3357,25 +3580,30 @@ register SV *sv;
}
void
-sv_dec(sv)
-register SV *sv;
+sv_dec(register SV *sv)
{
int flags;
if (!sv)
return;
+ if (SvGMAGICAL(sv))
+ mg_get(sv);
if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
+ if (SvREADONLY(sv)) {
+ dTHR;
+ if (PL_curcop != &PL_compiling)
+ croak(no_modify);
+ }
if (SvROK(sv)) {
+ IV i;
#ifdef OVERLOAD
- if (SvAMAGIC(sv) && AMG_CALLun(sv,dec)) return;
+ if (SvAMAGIC(sv) && AMG_CALLun(sv,dec)) return;
#endif /* OVERLOAD */
- sv_unref(sv);
+ i = (IV)SvRV(sv);
+ sv_unref(sv);
+ sv_setiv(sv, i);
}
}
- if (SvGMAGICAL(sv))
- mg_get(sv);
flags = SvFLAGS(sv);
if (flags & SVp_NOK) {
SvNVX(sv) -= 1.0;
@@ -3407,17 +3635,18 @@ register SV *sv;
* hopefully we won't free it until it has been assigned to a
* permanent location. */
-static void
-sv_mortalgrow()
+STATIC void
+sv_mortalgrow(void)
{
- tmps_max += (tmps_max < 512) ? 128 : 512;
- Renew(tmps_stack, tmps_max, SV*);
+ dTHR;
+ PL_tmps_max += (PL_tmps_max < 512) ? 128 : 512;
+ Renew(PL_tmps_stack, PL_tmps_max, SV*);
}
SV *
-sv_mortalcopy(oldstr)
-SV *oldstr;
+sv_mortalcopy(SV *oldstr)
{
+ dTHR;
register SV *sv;
new_SV(sv);
@@ -3425,49 +3654,48 @@ SV *oldstr;
SvREFCNT(sv) = 1;
SvFLAGS(sv) = 0;
sv_setsv(sv,oldstr);
- if (++tmps_ix >= tmps_max)
+ if (++PL_tmps_ix >= PL_tmps_max)
sv_mortalgrow();
- tmps_stack[tmps_ix] = sv;
+ PL_tmps_stack[PL_tmps_ix] = sv;
SvTEMP_on(sv);
return sv;
}
SV *
-sv_newmortal()
+sv_newmortal(void)
{
+ dTHR;
register SV *sv;
new_SV(sv);
SvANY(sv) = 0;
SvREFCNT(sv) = 1;
SvFLAGS(sv) = SVs_TEMP;
- if (++tmps_ix >= tmps_max)
+ if (++PL_tmps_ix >= PL_tmps_max)
sv_mortalgrow();
- tmps_stack[tmps_ix] = sv;
+ PL_tmps_stack[PL_tmps_ix] = sv;
return sv;
}
/* same thing without the copying */
SV *
-sv_2mortal(sv)
-register SV *sv;
+sv_2mortal(register SV *sv)
{
+ dTHR;
if (!sv)
return sv;
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
- if (++tmps_ix >= tmps_max)
+ if (SvREADONLY(sv) && SvIMMORTAL(sv))
+ return sv;
+ if (++PL_tmps_ix >= PL_tmps_max)
sv_mortalgrow();
- tmps_stack[tmps_ix] = sv;
+ PL_tmps_stack[PL_tmps_ix] = sv;
SvTEMP_on(sv);
return sv;
}
SV *
-newSVpv(s,len)
-char *s;
-STRLEN len;
+newSVpv(char *s, STRLEN len)
{
register SV *sv;
@@ -3481,16 +3709,21 @@ STRLEN len;
return sv;
}
-#ifdef I_STDARG
SV *
-newSVpvf(const char* pat, ...)
-#else
-/*VARARGS0*/
+newSVpvn(char *s, STRLEN len)
+{
+ register SV *sv;
+
+ new_SV(sv);
+ SvANY(sv) = 0;
+ SvREFCNT(sv) = 1;
+ SvFLAGS(sv) = 0;
+ sv_setpvn(sv,s,len);
+ return sv;
+}
+
SV *
-newSVpvf(pat, va_alist)
-const char *pat;
-va_dcl
-#endif
+newSVpvf(const char* pat, ...)
{
register SV *sv;
va_list args;
@@ -3499,11 +3732,7 @@ va_dcl
SvANY(sv) = 0;
SvREFCNT(sv) = 1;
SvFLAGS(sv) = 0;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
va_end(args);
return sv;
@@ -3511,8 +3740,7 @@ va_dcl
SV *
-newSVnv(n)
-double n;
+newSVnv(double n)
{
register SV *sv;
@@ -3525,8 +3753,7 @@ double n;
}
SV *
-newSViv(i)
-IV i;
+newSViv(IV i)
{
register SV *sv;
@@ -3539,9 +3766,9 @@ IV i;
}
SV *
-newRV(ref)
-SV *ref;
+newRV_noinc(SV *tmpRef)
{
+ dTHR;
register SV *sv;
new_SV(sv);
@@ -3549,30 +3776,22 @@ SV *ref;
SvREFCNT(sv) = 1;
SvFLAGS(sv) = 0;
sv_upgrade(sv, SVt_RV);
- SvTEMP_off(ref);
- SvRV(sv) = SvREFCNT_inc(ref);
+ SvTEMP_off(tmpRef);
+ SvRV(sv) = tmpRef;
SvROK_on(sv);
return sv;
}
-#ifdef CRIPPLED_CC
SV *
-newRV_noinc(ref)
-SV *ref;
+newRV(SV *tmpRef)
{
- register SV *sv;
-
- sv = newRV(ref);
- SvREFCNT_dec(ref);
- return sv;
+ return newRV_noinc(SvREFCNT_inc(tmpRef));
}
-#endif /* CRIPPLED_CC */
/* make an exact duplicate of old */
SV *
-newSVsv(old)
-register SV *old;
+newSVsv(register SV *old)
{
register SV *sv;
@@ -3597,9 +3816,7 @@ register SV *old;
}
void
-sv_reset(s,stash)
-register char *s;
-HV *stash;
+sv_reset(register char *s, HV *stash)
{
register HE *entry;
register GV *gv;
@@ -3609,9 +3826,12 @@ HV *stash;
register I32 max;
char todo[256];
+ if (!stash)
+ return;
+
if (!*s) { /* reset ?? searches */
for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) {
- pm->op_pmflags &= ~PMf_USED;
+ pm->op_pmdynflags &= ~PMdf_USED;
}
return;
}
@@ -3633,12 +3853,18 @@ HV *stash;
}
for (i = 0; i <= (I32) HvMAX(stash); i++) {
for (entry = HvARRAY(stash)[i];
- entry;
- entry = HeNEXT(entry)) {
+ entry;
+ entry = HeNEXT(entry))
+ {
if (!todo[(U8)*HeKEY(entry)])
continue;
gv = (GV*)HeVAL(entry);
sv = GvSV(gv);
+ if (SvTHINKFIRST(sv)) {
+ if (!SvREADONLY(sv) && SvROK(sv))
+ sv_unref(sv);
+ continue;
+ }
(void)SvOK_off(sv);
if (SvTYPE(sv) >= SVt_PV) {
SvCUR_set(sv, 0);
@@ -3652,7 +3878,7 @@ HV *stash;
if (GvHV(gv) && !HvNAME(GvHV(gv))) {
hv_clear(GvHV(gv));
#ifndef VMS /* VMS has no environ array */
- if (gv == envgv)
+ if (gv == PL_envgv)
environ[0] = Nullch;
#endif
}
@@ -3662,11 +3888,11 @@ HV *stash;
}
IO*
-sv_2io(sv)
-SV *sv;
+sv_2io(SV *sv)
{
IO* io;
GV* gv;
+ STRLEN n_a;
switch (SvTYPE(sv)) {
case SVt_PVIO:
@@ -3683,27 +3909,24 @@ SV *sv;
croak(no_usym, "filehandle");
if (SvROK(sv))
return sv_2io(SvRV(sv));
- gv = gv_fetchpv(SvPV(sv,na), FALSE, SVt_PVIO);
+ gv = gv_fetchpv(SvPV(sv,n_a), FALSE, SVt_PVIO);
if (gv)
io = GvIO(gv);
else
io = 0;
if (!io)
- croak("Bad filehandle: %s", SvPV(sv,na));
+ croak("Bad filehandle: %s", SvPV(sv,n_a));
break;
}
return io;
}
CV *
-sv_2cv(sv, st, gvp, lref)
-SV *sv;
-HV **st;
-GV **gvp;
-I32 lref;
+sv_2cv(SV *sv, HV **st, GV **gvp, I32 lref)
{
GV *gv;
CV *cv;
+ STRLEN n_a;
if (!sv)
return *gvp = Nullgv, Nullcv;
@@ -3726,17 +3949,22 @@ I32 lref;
if (SvGMAGICAL(sv))
mg_get(sv);
if (SvROK(sv)) {
- cv = (CV*)SvRV(sv);
- if (SvTYPE(cv) != SVt_PVCV)
+ sv = SvRV(sv);
+ if (SvTYPE(sv) == SVt_PVCV) {
+ cv = (CV*)sv;
+ *gvp = Nullgv;
+ *st = CvSTASH(cv);
+ return cv;
+ }
+ else if(isGV(sv))
+ gv = (GV*)sv;
+ else
croak("Not a subroutine reference");
- *gvp = Nullgv;
- *st = CvSTASH(cv);
- return cv;
}
- if (isGV(sv))
+ else if (isGV(sv))
gv = (GV*)sv;
else
- gv = gv_fetchpv(SvPV(sv, na), lref, SVt_PVCV);
+ gv = gv_fetchpv(SvPV(sv, n_a), lref, SVt_PVCV);
*gvp = gv;
if (!gv)
return Nullcv;
@@ -3753,27 +3981,24 @@ I32 lref;
Nullop);
LEAVE;
if (!GvCVu(gv))
- croak("Unable to create sub named \"%s\"", SvPV(sv,na));
+ croak("Unable to create sub named \"%s\"", SvPV(sv,n_a));
}
return GvCVu(gv);
}
}
-#ifndef SvTRUE
I32
-SvTRUE(sv)
-register SV *sv;
+sv_true(register SV *sv)
{
+ dTHR;
if (!sv)
return 0;
- if (SvGMAGICAL(sv))
- mg_get(sv);
if (SvPOK(sv)) {
- register XPV* Xpv;
- if ((Xpv = (XPV*)SvANY(sv)) &&
- (*Xpv->xpv_pv > '0' ||
- Xpv->xpv_cur > 1 ||
- (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
+ register XPV* tXpv;
+ if ((tXpv = (XPV*)SvANY(sv)) &&
+ (*tXpv->xpv_pv > '0' ||
+ tXpv->xpv_cur > 1 ||
+ (tXpv->xpv_cur && *tXpv->xpv_pv != '0')))
return 1;
else
return 0;
@@ -3789,46 +4014,33 @@ register SV *sv;
}
}
}
-#endif /* !SvTRUE */
-#ifndef SvIV
IV
-SvIV(sv)
-register SV *sv;
+sv_iv(register SV *sv)
{
if (SvIOK(sv))
return SvIVX(sv);
return sv_2iv(sv);
}
-#endif /* !SvIV */
-#ifndef SvUV
UV
-SvUV(sv)
-register SV *sv;
+sv_uv(register SV *sv)
{
if (SvIOK(sv))
return SvUVX(sv);
return sv_2uv(sv);
}
-#endif /* !SvUV */
-#ifndef SvNV
double
-SvNV(sv)
-register SV *sv;
+sv_nv(register SV *sv)
{
if (SvNOK(sv))
return SvNVX(sv);
return sv_2nv(sv);
}
-#endif /* !SvNV */
-#ifdef CRIPPLED_CC
char *
-sv_pvn(sv, lp)
-SV *sv;
-STRLEN *lp;
+sv_pvn(SV *sv, STRLEN *lp)
{
if (SvPOK(sv)) {
*lp = SvCUR(sv);
@@ -3836,17 +4048,17 @@ STRLEN *lp;
}
return sv_2pv(sv, lp);
}
-#endif
char *
-sv_pvn_force(sv, lp)
-SV *sv;
-STRLEN *lp;
+sv_pvn_force(SV *sv, STRLEN *lp)
{
char *s;
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
+ if (SvREADONLY(sv)) {
+ dTHR;
+ if (PL_curcop != &PL_compiling)
+ croak(no_modify);
+ }
if (SvPOK(sv)) {
*lp = SvCUR(sv);
@@ -3858,9 +4070,11 @@ STRLEN *lp;
s = SvPVX(sv);
*lp = SvCUR(sv);
}
- else
+ else {
+ dTHR;
croak("Can't coerce %s to string in %s", sv_reftype(sv,0),
- op_name[op->op_type]);
+ op_name[PL_op->op_type]);
+ }
}
else
s = sv_2pv(sv, lp);
@@ -3886,9 +4100,7 @@ STRLEN *lp;
}
char *
-sv_reftype(sv, ob)
-SV* sv;
-int ob;
+sv_reftype(SV *sv, int ob)
{
if (ob && SvOBJECT(sv))
return HvNAME(SvSTASH(sv));
@@ -3912,15 +4124,14 @@ int ob;
case SVt_PVHV: return "HASH";
case SVt_PVCV: return "CODE";
case SVt_PVGV: return "GLOB";
- case SVt_PVFM: return "FORMLINE";
+ case SVt_PVFM: return "FORMAT";
default: return "UNKNOWN";
}
}
}
int
-sv_isobject(sv)
-SV *sv;
+sv_isobject(SV *sv)
{
if (!sv)
return 0;
@@ -3935,9 +4146,7 @@ SV *sv;
}
int
-sv_isa(sv, name)
-SV *sv;
-char *name;
+sv_isa(SV *sv, char *name)
{
if (!sv)
return 0;
@@ -3953,17 +4162,25 @@ char *name;
}
SV*
-newSVrv(rv, classname)
-SV *rv;
-char *classname;
+newSVrv(SV *rv, char *classname)
{
+ dTHR;
SV *sv;
new_SV(sv);
SvANY(sv) = 0;
SvREFCNT(sv) = 0;
SvFLAGS(sv) = 0;
- sv_upgrade(rv, SVt_RV);
+
+ SV_CHECK_THINKFIRST(rv);
+#ifdef OVERLOAD
+ SvAMAGIC_off(rv);
+#endif /* OVERLOAD */
+
+ if (SvTYPE(rv) < SVt_RV)
+ sv_upgrade(rv, SVt_RV);
+
+ (void)SvOK_off(rv);
SvRV(rv) = SvREFCNT_inc(sv);
SvROK_on(rv);
@@ -3975,72 +4192,60 @@ char *classname;
}
SV*
-sv_setref_pv(rv, classname, pv)
-SV *rv;
-char *classname;
-void* pv;
+sv_setref_pv(SV *rv, char *classname, void *pv)
{
- if (!pv)
- sv_setsv(rv, &sv_undef);
+ if (!pv) {
+ sv_setsv(rv, &PL_sv_undef);
+ SvSETMAGIC(rv);
+ }
else
sv_setiv(newSVrv(rv,classname), (IV)pv);
return rv;
}
SV*
-sv_setref_iv(rv, classname, iv)
-SV *rv;
-char *classname;
-IV iv;
+sv_setref_iv(SV *rv, char *classname, IV iv)
{
sv_setiv(newSVrv(rv,classname), iv);
return rv;
}
SV*
-sv_setref_nv(rv, classname, nv)
-SV *rv;
-char *classname;
-double nv;
+sv_setref_nv(SV *rv, char *classname, double nv)
{
sv_setnv(newSVrv(rv,classname), nv);
return rv;
}
SV*
-sv_setref_pvn(rv, classname, pv, n)
-SV *rv;
-char *classname;
-char* pv;
-I32 n;
+sv_setref_pvn(SV *rv, char *classname, char *pv, I32 n)
{
sv_setpvn(newSVrv(rv,classname), pv, n);
return rv;
}
SV*
-sv_bless(sv,stash)
-SV* sv;
-HV* stash;
+sv_bless(SV *sv, HV *stash)
{
- SV *ref;
+ dTHR;
+ SV *tmpRef;
if (!SvROK(sv))
croak("Can't bless non-reference value");
- ref = SvRV(sv);
- if (SvFLAGS(ref) & (SVs_OBJECT|SVf_READONLY)) {
- if (SvREADONLY(ref))
+ tmpRef = SvRV(sv);
+ if (SvFLAGS(tmpRef) & (SVs_OBJECT|SVf_READONLY)) {
+ if (SvREADONLY(tmpRef))
croak(no_modify);
- if (SvOBJECT(ref)) {
- if (SvTYPE(ref) != SVt_PVIO)
- --sv_objcount;
- SvREFCNT_dec(SvSTASH(ref));
+ if (SvOBJECT(tmpRef)) {
+ if (SvTYPE(tmpRef) != SVt_PVIO)
+ --PL_sv_objcount;
+ SvREFCNT_dec(SvSTASH(tmpRef));
}
}
- SvOBJECT_on(ref);
- if (SvTYPE(ref) != SVt_PVIO)
- ++sv_objcount;
- (void)SvUPGRADE(ref, SVt_PVMG);
- SvSTASH(ref) = (HV*)SvREFCNT_inc(stash);
+ SvOBJECT_on(tmpRef);
+ if (SvTYPE(tmpRef) != SVt_PVIO)
+ ++PL_sv_objcount;
+ (void)SvUPGRADE(tmpRef, SVt_PVMG);
+ SvSTASH(tmpRef) = (HV*)SvREFCNT_inc(stash);
#ifdef OVERLOAD
if (Gv_AMG(stash))
@@ -4052,14 +4257,17 @@ HV* stash;
return sv;
}
-static void
-sv_unglob(sv)
-SV* sv;
+STATIC void
+sv_unglob(SV *sv)
{
assert(SvTYPE(sv) == SVt_PVGV);
SvFAKE_off(sv);
if (GvGP(sv))
gp_free((GV*)sv);
+ if (GvSTASH(sv)) {
+ SvREFCNT_dec(GvSTASH(sv));
+ GvSTASH(sv) = Nullhv;
+ }
sv_unmagic(sv, '*');
Safefree(GvNAME(sv));
GvMULTI_off(sv);
@@ -4068,8 +4276,7 @@ SV* sv;
}
void
-sv_unref(sv)
-SV* sv;
+sv_unref(SV *sv)
{
SV* rv = SvRV(sv);
@@ -4082,15 +4289,13 @@ SV* sv;
}
void
-sv_taint(sv)
-SV *sv;
+sv_taint(SV *sv)
{
sv_magic((sv), Nullsv, 't', Nullch, 0);
}
void
-sv_untaint(sv)
-SV *sv;
+sv_untaint(SV *sv)
{
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
MAGIC *mg = mg_find(sv, 't');
@@ -4100,8 +4305,7 @@ SV *sv;
}
bool
-sv_tainted(sv)
-SV *sv;
+sv_tainted(SV *sv)
{
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
MAGIC *mg = mg_find(sv, 't');
@@ -4112,9 +4316,7 @@ SV *sv;
}
void
-sv_setpviv(sv, iv)
-SV *sv;
-IV iv;
+sv_setpviv(SV *sv, IV iv)
{
STRLEN len;
char buf[TYPE_DIGITS(UV)];
@@ -4146,74 +4348,64 @@ IV iv;
SvCUR(sv) = p - SvPVX(sv);
}
-#ifdef I_STDARG
+
+void
+sv_setpviv_mg(SV *sv, IV iv)
+{
+ sv_setpviv(sv,iv);
+ SvSETMAGIC(sv);
+}
+
void
sv_setpvf(SV *sv, const char* pat, ...)
-#else
-/*VARARGS0*/
+{
+ va_list args;
+ va_start(args, pat);
+ sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ va_end(args);
+}
+
+
void
-sv_setpvf(sv, pat, va_alist)
- SV *sv;
- const char *pat;
- va_dcl
-#endif
+sv_setpvf_mg(SV *sv, const char* pat, ...)
{
va_list args;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
va_end(args);
+ SvSETMAGIC(sv);
}
-#ifdef I_STDARG
void
sv_catpvf(SV *sv, const char* pat, ...)
-#else
-/*VARARGS0*/
+{
+ va_list args;
+ va_start(args, pat);
+ sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ va_end(args);
+}
+
void
-sv_catpvf(sv, pat, va_alist)
- SV *sv;
- const char *pat;
- va_dcl
-#endif
+sv_catpvf_mg(SV *sv, const char* pat, ...)
{
va_list args;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
va_end(args);
+ SvSETMAGIC(sv);
}
void
-sv_vsetpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
- SV *sv;
- const char *pat;
- STRLEN patlen;
- va_list *args;
- SV **svargs;
- I32 svmax;
- bool *used_locale;
+sv_vsetpvfn(SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *used_locale)
{
sv_setpvn(sv, "", 0);
sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale);
}
void
-sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
- SV *sv;
- const char *pat;
- STRLEN patlen;
- va_list *args;
- SV **svargs;
- I32 svmax;
- bool *used_locale;
+sv_vcatpvfn(SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *used_locale)
{
+ dTHR;
char *p;
char *q;
char *patend;
@@ -4266,8 +4458,10 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
STRLEN elen = 0;
char ebuf[TYPE_DIGITS(int) * 2 + 16]; /* large enough for "%#.#f" */
+#ifndef PERL_OBJECT
static char *efloatbuf = Nullch;
static STRLEN efloatsize = 0;
+#endif
char c;
int i;
@@ -4511,6 +4705,8 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
switch (base) {
unsigned dig;
case 16:
+ if (!uv)
+ alt = FALSE;
p = (c == 'X') ? "0123456789ABCDEF" : "0123456789abcdef";
do {
dig = uv & 15;
@@ -4537,8 +4733,12 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
break;
}
elen = (ebuf + sizeof ebuf) - eptr;
- if (has_precis && precis > elen)
- zeros = precis - elen;
+ if (has_precis) {
+ if (precis > elen)
+ zeros = precis - elen;
+ else if (precis == 0 && elen == 1 && *eptr == '0')
+ elen = 0;
+ }
break;
/* FLOATING POINT */
@@ -4636,11 +4836,11 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
default:
unknown:
- if (!args && dowarn &&
- (op->op_type == OP_PRTF || op->op_type == OP_SPRINTF)) {
+ if (!args && PL_dowarn &&
+ (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)) {
SV *msg = sv_newmortal();
sv_setpvf(msg, "Invalid conversion in %s: ",
- (op->op_type == OP_PRTF) ? "printf" : "sprintf");
+ (PL_op->op_type == OP_PRTF) ? "printf" : "sprintf");
if (c)
sv_catpvf(msg, isPRINT(c) ? "\"%%%c\"" : "\"%%\\%03o\"",
c & 0xFF);
@@ -4700,11 +4900,10 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
}
}
-#ifdef DEBUGGING
void
-sv_dump(sv)
-SV* sv;
+sv_dump(SV *sv)
{
+#ifdef DEBUGGING
SV *d = sv_newmortal();
char *s;
U32 flags;
@@ -4775,6 +4974,10 @@ SV* sv;
sv_catpv(d, " ),");
}
}
+ case SVt_PVBM:
+ if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
+ if (SvCOMPILED(sv)) sv_catpv(d, "COMPILED,");
+ break;
}
if (*(SvEND(d) - 1) == ',')
@@ -4874,7 +5077,7 @@ SV* sv;
case SVt_PVAV:
PerlIO_printf(Perl_debug_log, " ARRAY = 0x%lx\n", (long)AvARRAY(sv));
PerlIO_printf(Perl_debug_log, " ALLOC = 0x%lx\n", (long)AvALLOC(sv));
- PerlIO_printf(Perl_debug_log, " FILL = %ld\n", (long)AvFILL(sv));
+ PerlIO_printf(Perl_debug_log, " FILL = %ld\n", (long)AvFILLp(sv));
PerlIO_printf(Perl_debug_log, " MAX = %ld\n", (long)AvMAX(sv));
PerlIO_printf(Perl_debug_log, " ARYLEN = 0x%lx\n", (long)AvARYLEN(sv));
flags = AvFLAGS(sv);
@@ -4898,8 +5101,10 @@ SV* sv;
PerlIO_printf(Perl_debug_log, " NAME = \"%s\"\n", HvNAME(sv));
break;
case SVt_PVCV:
- if (SvPOK(sv))
- PerlIO_printf(Perl_debug_log, " PROTOTYPE = \"%s\"\n", SvPV(sv,na));
+ if (SvPOK(sv)) {
+ STRLEN n_a;
+ PerlIO_printf(Perl_debug_log, " PROTOTYPE = \"%s\"\n", SvPV(sv,n_a));
+ }
/* FALL THROUGH */
case SVt_PVFM:
PerlIO_printf(Perl_debug_log, " STASH = 0x%lx\n", (long)CvSTASH(sv));
@@ -4917,13 +5122,20 @@ SV* sv;
PerlIO_printf(Perl_debug_log, " DEPTH = %ld\n", (long)CvDEPTH(sv));
PerlIO_printf(Perl_debug_log, " PADLIST = 0x%lx\n", (long)CvPADLIST(sv));
PerlIO_printf(Perl_debug_log, " OUTSIDE = 0x%lx\n", (long)CvOUTSIDE(sv));
+#ifdef USE_THREADS
+ PerlIO_printf(Perl_debug_log, " MUTEXP = 0x%lx\n", (long)CvMUTEXP(sv));
+ PerlIO_printf(Perl_debug_log, " OWNER = 0x%lx\n", (long)CvOWNER(sv));
+#endif /* USE_THREADS */
+ PerlIO_printf(Perl_debug_log, " FLAGS = 0x%lx\n",
+ (unsigned long)CvFLAGS(sv));
if (type == SVt_PVFM)
PerlIO_printf(Perl_debug_log, " LINES = %ld\n", (long)FmLINES(sv));
break;
case SVt_PVGV:
PerlIO_printf(Perl_debug_log, " NAME = \"%s\"\n", GvNAME(sv));
PerlIO_printf(Perl_debug_log, " NAMELEN = %ld\n", (long)GvNAMELEN(sv));
- PerlIO_printf(Perl_debug_log, " STASH = \"%s\"\n", HvNAME(GvSTASH(sv)));
+ PerlIO_printf(Perl_debug_log, " STASH = \"%s\"\n",
+ SvTYPE(GvSTASH(sv)) == SVt_PVHV ? HvNAME(GvSTASH(sv)) : "(deleted)");
PerlIO_printf(Perl_debug_log, " GP = 0x%lx\n", (long)GvGP(sv));
PerlIO_printf(Perl_debug_log, " SV = 0x%lx\n", (long)GvSV(sv));
PerlIO_printf(Perl_debug_log, " REFCNT = %ld\n", (long)GvREFCNT(sv));
@@ -4957,11 +5169,5 @@ SV* sv;
PerlIO_printf(Perl_debug_log, " FLAGS = 0x%lx\n", (long)IoFLAGS(sv));
break;
}
+#endif /* DEBUGGING */
}
-#else
-void
-sv_dump(sv)
-SV* sv;
-{
-}
-#endif
diff --git a/gnu/usr.bin/perl/sv.h b/gnu/usr.bin/perl/sv.h
index cf180613814..7448b83788a 100644
--- a/gnu/usr.bin/perl/sv.h
+++ b/gnu/usr.bin/perl/sv.h
@@ -1,6 +1,6 @@
/* sv.h
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -70,17 +70,49 @@ struct io {
#define SvANY(sv) (sv)->sv_any
#define SvFLAGS(sv) (sv)->sv_flags
-
#define SvREFCNT(sv) (sv)->sv_refcnt
-#ifdef CRIPPLED_CC
-#define SvREFCNT_inc(sv) sv_newref((SV*)sv)
-#define SvREFCNT_dec(sv) sv_free((SV*)sv)
+
+#ifdef USE_THREADS
+
+# ifdef EMULATE_ATOMIC_REFCOUNTS
+# define ATOMIC_INC(count) STMT_START { \
+ MUTEX_LOCK(&PL_svref_mutex); \
+ ++count; \
+ MUTEX_UNLOCK(&PL_svref_mutex); \
+ } STMT_END
+# define ATOMIC_DEC_AND_TEST(res,count) STMT_START { \
+ MUTEX_LOCK(&PL_svref_mutex); \
+ res = (--count == 0); \
+ MUTEX_UNLOCK(&PL_svref_mutex); \
+ } STMT_END
+# else
+# define ATOMIC_INC(count) atomic_inc(&count)
+# define ATOMIC_DEC_AND_TEST(res,count) (res = atomic_dec_and_test(&count))
+# endif /* EMULATE_ATOMIC_REFCOUNTS */
#else
-#define SvREFCNT_inc(sv) ((Sv = (SV*)(sv)), \
- (Sv && ++SvREFCNT(Sv)), (SV*)Sv)
-#define SvREFCNT_dec(sv) sv_free((SV*)sv)
+# define ATOMIC_INC(count) (++count)
+# define ATOMIC_DEC_AND_TEST(res, count) (res = (--count == 0))
+#endif /* USE_THREADS */
+
+#ifdef __GNUC__
+# define SvREFCNT_inc(sv) \
+ ({ \
+ SV *nsv = (SV*)(sv); \
+ if (nsv) \
+ ATOMIC_INC(SvREFCNT(nsv)); \
+ nsv; \
+ })
+#else
+# if defined(CRIPPLED_CC) || defined(USE_THREADS)
+# define SvREFCNT_inc(sv) sv_newref((SV*)sv)
+# else
+# define SvREFCNT_inc(sv) \
+ ((PL_Sv=(SV*)(sv)), (PL_Sv && ATOMIC_INC(SvREFCNT(PL_Sv))), (SV*)PL_Sv)
+# endif
#endif
+#define SvREFCNT_dec(sv) sv_free((SV*)sv)
+
#define SVTYPEMASK 0xff
#define SvTYPE(sv) ((sv)->sv_flags & SVTYPEMASK)
@@ -117,6 +149,8 @@ struct io {
#ifdef OVERLOAD
#define SVf_AMAGIC 0x10000000 /* has magical overloaded methods */
+#else
+#define SVf_AMAGIC 0 /* can be or-ed without effect */
#endif /* OVERLOAD */
#define PRIVSHIFT 8
@@ -163,6 +197,7 @@ struct xpvnv {
double xnv_nv; /* numeric value, if any */
};
+/* These structure must match the beginning of struct xpvhv in hv.h. */
struct xpvmg {
char * xpv_pv; /* pointer to malloced string */
STRLEN xpv_cur; /* length of xpv_pv as a C string */
@@ -220,6 +255,8 @@ struct xpvbm {
/* This structure much match XPVCV */
+typedef U16 cv_flags_t;
+
struct xpvfm {
char * xpv_pv; /* pointer to malloced string */
STRLEN xpv_cur; /* length of xpv_pv as a C string */
@@ -232,14 +269,18 @@ struct xpvfm {
HV * xcv_stash;
OP * xcv_start;
OP * xcv_root;
- void (*xcv_xsub)_((CV*));
+ void (*xcv_xsub)_((CV* _CPERLproto));
ANY xcv_xsubany;
GV * xcv_gv;
GV * xcv_filegv;
long xcv_depth; /* >= 2 indicates recursive call */
AV * xcv_padlist;
CV * xcv_outside;
- U8 xcv_flags;
+#ifdef USE_THREADS
+ perl_mutex *xcv_mutexp; /* protects xcv_owner */
+ struct perl_thread *xcv_owner; /* current owner thread */
+#endif /* USE_THREADS */
+ cv_flags_t xcv_flags;
I32 xfm_lines;
};
@@ -275,7 +316,8 @@ struct xpvio {
#define IOf_START 2 /* check for null ARGV and substitute '-' */
#define IOf_FLUSH 4 /* this fp wants a flush after write op */
#define IOf_DIDTOP 8 /* just did top of form */
-#define IOf_UNTAINT 16 /* consider this fp (and it's data) "safe" */
+#define IOf_UNTAINT 16 /* consider this fp (and its data) "safe" */
+#define IOf_NOLINE 32 /* slurped a pseudo-line from empty file */
/* The following macros define implementation-independent predicates on SVs. */
@@ -285,13 +327,8 @@ struct xpvio {
SVp_IOK|SVp_NOK))
#define SvOK(sv) (SvFLAGS(sv) & SVf_OK)
-
-#ifdef OVERLOAD
#define SvOK_off(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC), \
SvOOK_off(sv))
-#else
-#define SvOK_off(sv) (SvFLAGS(sv) &= ~SVf_OK, SvOOK_off(sv))
-#endif /* OVERLOAD */
#define SvOKp(sv) (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK))
#define SvIOKp(sv) (SvFLAGS(sv) & SVp_IOK)
@@ -305,7 +342,7 @@ struct xpvio {
#define SvIOK_on(sv) (SvOOK_off(sv), \
SvFLAGS(sv) |= (SVf_IOK|SVp_IOK))
#define SvIOK_off(sv) (SvFLAGS(sv) &= ~(SVf_IOK|SVp_IOK))
-#define SvIOK_only(sv) (SvOOK_off(sv), SvOK_off(sv), \
+#define SvIOK_only(sv) (SvOK_off(sv), \
SvFLAGS(sv) |= (SVf_IOK|SVp_IOK))
#define SvNOK(sv) (SvFLAGS(sv) & SVf_NOK)
@@ -317,14 +354,8 @@ struct xpvio {
#define SvPOK(sv) (SvFLAGS(sv) & SVf_POK)
#define SvPOK_on(sv) (SvFLAGS(sv) |= (SVf_POK|SVp_POK))
#define SvPOK_off(sv) (SvFLAGS(sv) &= ~(SVf_POK|SVp_POK))
-
-#ifdef OVERLOAD
-#define SvPOK_only(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC), \
- SvFLAGS(sv) |= (SVf_POK|SVp_POK))
-#else
-#define SvPOK_only(sv) (SvFLAGS(sv) &= ~SVf_OK, \
+#define SvPOK_only(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC), \
SvFLAGS(sv) |= (SVf_POK|SVp_POK))
-#endif /* OVERLOAD */
#define SvOOK(sv) (SvFLAGS(sv) & SVf_OOK)
#define SvOOK_on(sv) (SvIOK_off(sv), SvFLAGS(sv) |= SVf_OOK)
@@ -336,12 +367,7 @@ struct xpvio {
#define SvROK(sv) (SvFLAGS(sv) & SVf_ROK)
#define SvROK_on(sv) (SvFLAGS(sv) |= SVf_ROK)
-
-#ifdef OVERLOAD
#define SvROK_off(sv) (SvFLAGS(sv) &= ~(SVf_ROK|SVf_AMAGIC))
-#else
-#define SvROK_off(sv) (SvFLAGS(sv) &= ~SVf_ROK)
-#endif /* OVERLOAD */
#define SvMAGICAL(sv) (SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG))
#define SvMAGICAL_on(sv) (SvFLAGS(sv) |= (SVs_GMG|SVs_SMG|SVs_RMG))
@@ -369,7 +395,7 @@ struct xpvio {
(HV_AMAGICmb(stash) && \
((!HV_AMAGICbad(stash) && HV_AMAGIC(stash)) || Gv_AMupdate(stash)))
*/
-#define Gv_AMG(stash) (amagic_generation && Gv_AMupdate(stash))
+#define Gv_AMG(stash) (PL_amagic_generation && Gv_AMupdate(stash))
#endif /* OVERLOAD */
#define SvTHINKFIRST(sv) (SvFLAGS(sv) & SVf_THINKFIRST)
@@ -426,7 +452,7 @@ struct xpvio {
#define SvLEN(sv) ((XPV*) SvANY(sv))->xpv_len
#define SvLENx(sv) SvLEN(sv)
#define SvEND(sv)(((XPV*) SvANY(sv))->xpv_pv + ((XPV*)SvANY(sv))->xpv_cur)
-#define SvENDx(sv) ((Sv = (sv)), SvEND(Sv))
+#define SvENDx(sv) ((PL_Sv = (sv)), SvEND(PL_Sv))
#define SvMAGIC(sv) ((XPVMG*) SvANY(sv))->xmg_magic
#define SvSTASH(sv) ((XPVMG*) SvANY(sv))->xmg_stash
@@ -478,29 +504,34 @@ struct xpvio {
#define IoFLAGS(sv) ((XPVIO*) SvANY(sv))->xio_flags
#define SvTAINTED(sv) (SvMAGICAL(sv) && sv_tainted(sv))
-#define SvTAINTED_on(sv) STMT_START{ if(tainting){sv_taint(sv);} }STMT_END
-#define SvTAINTED_off(sv) STMT_START{ if(tainting){sv_untaint(sv);} }STMT_END
-
-#define SvTAINT(sv) STMT_START{ if(tainted){SvTAINTED_on(sv);} }STMT_END
-
-#ifdef CRIPPLED_CC
+#define SvTAINTED_on(sv) STMT_START{ if(PL_tainting){sv_taint(sv);} }STMT_END
+#define SvTAINTED_off(sv) STMT_START{ if(PL_tainting){sv_untaint(sv);} }STMT_END
+
+#define SvTAINT(sv) \
+ STMT_START { \
+ if (PL_tainting) { \
+ dTHR; \
+ if (PL_tainted) \
+ SvTAINTED_on(sv); \
+ } \
+ } STMT_END
-IV SvIV _((SV* sv));
-UV SvUV _((SV* sv));
-double SvNV _((SV* sv));
#define SvPV_force(sv, lp) sv_pvn_force(sv, &lp)
#define SvPV(sv, lp) sv_pvn(sv, &lp)
-char *sv_pvn _((SV *, STRLEN *));
-I32 SvTRUE _((SV *));
-
-#define SvIVx(sv) SvIV(sv)
-#define SvUVx(sv) SvUV(sv)
-#define SvNVx(sv) SvNV(sv)
+#define SvIVx(sv) sv_iv(sv)
+#define SvUVx(sv) sv_uv(sv)
+#define SvNVx(sv) sv_nv(sv)
#define SvPVx(sv, lp) sv_pvn(sv, &lp)
#define SvPVx_force(sv, lp) sv_pvn_force(sv, &lp)
-#define SvTRUEx(sv) SvTRUE(sv)
+#define SvTRUEx(sv) sv_true(sv)
+
+#define SvIV(sv) SvIVx(sv)
+#define SvNV(sv) SvNVx(sv)
+#define SvUV(sv) SvIVx(sv)
+#define SvTRUE(sv) SvTRUEx(sv)
-#else /* !CRIPPLED_CC */
+#ifndef CRIPPLED_CC
+/* redefine some things to more efficient inlined versions */
#undef SvIV
#define SvIV(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv))
@@ -520,15 +551,26 @@ I32 SvTRUE _((SV *));
((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force(sv, &lp))
-#undef SvTRUE
-#define SvTRUE(sv) ( \
+#ifdef __GNUC__
+# undef SvIVx
+# undef SvUVx
+# undef SvNVx
+# undef SvPVx
+# undef SvTRUE
+# undef SvTRUEx
+# define SvIVx(sv) ({SV *nsv = (SV*)(sv); SvIV(nsv); })
+# define SvUVx(sv) ({SV *nsv = (SV*)(sv); SvUV(nsv); })
+# define SvNVx(sv) ({SV *nsv = (SV*)(sv); SvNV(nsv); })
+# define SvPVx(sv, lp) ({SV *nsv = (sv); SvPV(nsv, lp); })
+# define SvTRUE(sv) ( \
!sv \
? 0 \
: SvPOK(sv) \
- ? ((Xpv = (XPV*)SvANY(sv)) && \
- (*Xpv->xpv_pv > '0' || \
- Xpv->xpv_cur > 1 || \
- (Xpv->xpv_cur && *Xpv->xpv_pv != '0')) \
+ ? (({XPV *nxpv = (XPV*)SvANY(sv); \
+ nxpv && \
+ (*nxpv->xpv_pv > '0' || \
+ nxpv->xpv_cur > 1 || \
+ (nxpv->xpv_cur && *nxpv->xpv_pv != '0')); }) \
? 1 \
: 0) \
: \
@@ -537,39 +579,67 @@ I32 SvTRUE _((SV *));
: SvNOK(sv) \
? SvNVX(sv) != 0.0 \
: sv_2bool(sv) )
-
-#define SvIVx(sv) ((Sv = (sv)), SvIV(Sv))
-#define SvUVx(sv) ((Sv = (sv)), SvUV(Sv))
-#define SvNVx(sv) ((Sv = (sv)), SvNV(Sv))
-#define SvPVx(sv, lp) ((Sv = (sv)), SvPV(Sv, lp))
-#define SvTRUEx(sv) ((Sv = (sv)), SvTRUE(Sv))
-
-#endif /* CRIPPLED_CC */
+# define SvTRUEx(sv) ({SV *nsv = (sv); SvTRUE(nsv); })
+#else /* __GNUC__ */
+#ifndef USE_THREADS
+/* These inlined macros use globals, which will require a thread
+ * declaration in user code, so we avoid them under threads */
+
+# undef SvIVx
+# undef SvUVx
+# undef SvNVx
+# undef SvPVx
+# undef SvTRUE
+# undef SvTRUEx
+# define SvIVx(sv) ((PL_Sv = (sv)), SvIV(PL_Sv))
+# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
+# define SvNVx(sv) ((PL_Sv = (sv)), SvNV(PL_Sv))
+# define SvPVx(sv, lp) ((PL_Sv = (sv)), SvPV(PL_Sv, lp))
+# define SvTRUE(sv) ( \
+ !sv \
+ ? 0 \
+ : SvPOK(sv) \
+ ? ((PL_Xpv = (XPV*)SvANY(sv)) && \
+ (*PL_Xpv->xpv_pv > '0' || \
+ PL_Xpv->xpv_cur > 1 || \
+ (PL_Xpv->xpv_cur && *PL_Xpv->xpv_pv != '0')) \
+ ? 1 \
+ : 0) \
+ : \
+ SvIOK(sv) \
+ ? SvIVX(sv) != 0 \
+ : SvNOK(sv) \
+ ? SvNVX(sv) != 0.0 \
+ : sv_2bool(sv) )
+# define SvTRUEx(sv) ((PL_Sv = (sv)), SvTRUE(PL_Sv))
+#endif /* !USE_THREADS */
+#endif /* !__GNU__ */
+#endif /* !CRIPPLED_CC */
#define newRV_inc(sv) newRV(sv)
-#ifdef CRIPPLED_CC
-SV *newRV_noinc _((SV *));
-#else
-#define newRV_noinc(sv) ((Sv = newRV(sv)), --SvREFCNT(SvRV(Sv)), Sv)
-#endif
-/* the following macro updates any magic values this sv is associated with */
+/* the following macros update any magic values this sv is associated with */
-#define SvSETMAGIC(x) if (SvSMAGICAL(x)) mg_set(x)
+#define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
+#define SvSETMAGIC(x) STMT_START { if (SvSMAGICAL(x)) mg_set(x); } STMT_END
#define SvSetSV_and(dst,src,finally) \
+ STMT_START { \
if ((dst) != (src)) { \
sv_setsv(dst, src); \
finally; \
- }
+ } \
+ } STMT_END
#define SvSetSV_nosteal_and(dst,src,finally) \
+ STMT_START { \
if ((dst) != (src)) { \
U32 tMpF = SvFLAGS(src) & SVs_TEMP; \
SvTEMP_off(src); \
sv_setsv(dst, src); \
SvFLAGS(src) |= tMpF; \
finally; \
- }
+ } \
+ } STMT_END
#define SvSetSV(dst,src) \
SvSetSV_and(dst,src,/*nothing*/;)
@@ -583,9 +653,9 @@ SV *newRV_noinc _((SV *));
#define SvPEEK(sv) sv_peek(sv)
-#define SvIMMORTAL(sv) ((sv)==&sv_undef || (sv)==&sv_yes || (sv)==&sv_no)
+#define SvIMMORTAL(sv) ((sv)==&PL_sv_undef || (sv)==&PL_sv_yes || (sv)==&PL_sv_no)
-#define boolSV(b) ((b) ? &sv_yes : &sv_no)
+#define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
#define isGV(sv) (SvTYPE(sv) == SVt_PVGV)
diff --git a/gnu/usr.bin/perl/t/TEST b/gnu/usr.bin/perl/t/TEST
index cae81031c29..3685c2a45f0 100644
--- a/gnu/usr.bin/perl/t/TEST
+++ b/gnu/usr.bin/perl/t/TEST
@@ -17,6 +17,9 @@ chdir 't' if -f 't/TEST';
die "You need to run \"make test\" first to set things up.\n"
unless -e 'perl' or -e 'perl.exe';
+# check leakage for embedders
+$ENV{PERL_DESTRUCT_LEVEL} = 2 unless exists $ENV{PERL_DESTRUCT_LEVEL};
+
$ENV{EMXSHELL} = 'sh'; # For OS/2
if ($#ARGV == -1) {
@@ -24,121 +27,155 @@ if ($#ARGV == -1) {
`echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t pragma/*.t lib/*.t`);
}
-if ($^O eq 'os2' || $^O eq 'qnx') {
- $sharpbang = 0;
-}
-else {
- open(CONFIG, "../config.sh");
- while (<CONFIG>) {
- if (/sharpbang='(.*)'/) {
- $sharpbang = ($1 eq '#!');
- last;
- }
- }
- close(CONFIG);
-}
+%infinite = ( 'comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 );
+
+_testprogs('perl', @ARGV);
+_testprogs('compile', @ARGV) if (-e "../testcompile");
+
+sub _testprogs {
+ $type = shift @_;
+ @tests = @_;
+
-$bad = 0;
-$good = 0;
-$total = @ARGV;
-$files = 0;
-$totmax = 0;
-while ($test = shift) {
- if ($test =~ /^$/) {
- next;
+ print <<'EOT' if ($type eq 'compile');
+--------------------------------------------------------------------------------
+TESTING COMPILER
+--------------------------------------------------------------------------------
+EOT
+
+ $bad = 0;
+ $good = 0;
+ $total = @tests;
+ $files = 0;
+ $totmax = 0;
+ $maxlen = 0;
+ foreach (@tests) {
+ $len = length;
+ $maxlen = $len if $len > $maxlen;
}
- $te = $test;
- chop($te);
- print "$te" . '.' x (18 - length($te));
- if ($sharpbang) {
- -x $test || (print "isn't executable.\n");
- open(RESULTS,"./$test |") || (print "can't run.\n");
- } else {
- open(SCRIPT,"$test") || die "Can't run $test.\n";
+ # +3 : we want three dots between the test name and the "ok"
+ # -2 : the .t suffix
+ $dotdotdot = $maxlen + 3 - 2;
+ while ($test = shift @tests) {
+
+ if ( $infinite{$test} && $type eq 'compile' ) {
+ print STDERR "$test creates infinite loop! Skipping.\n";
+ next;
+ }
+ if ($test =~ /^$/) {
+ next;
+ }
+ $te = $test;
+ chop($te);
+ print "$te" . '.' x ($dotdotdot - length($te));
+
+ open(SCRIPT,"<$test") or die "Can't run $test.\n";
$_ = <SCRIPT>;
close(SCRIPT);
- if (/#!..perl(.*)/) {
+ if (/#!.*perl(.*)$/) {
$switch = $1;
if ($^O eq 'VMS') {
# Must protect uppercase switches with "" on command line
$switch =~ s/-([A-Z]\S*)/"-$1"/g;
}
- } else {
+ }
+ else {
$switch = '';
}
- open(RESULTS,"./perl$switch $test |") || (print "can't run.\n");
- }
- $ok = 0;
- $next = 0;
- while (<RESULTS>) {
- if ($verbose) {
- print $_;
+
+ if ($type eq 'perl') {
+ open(RESULTS,"./perl$switch $test |") or print "can't run.\n";
}
- unless (/^#/) {
- if (/^1\.\.([0-9]+)/) {
- $max = $1;
- $totmax += $max;
- $files += 1;
- $next = 1;
- $ok = 1;
- } else {
- $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
- if (/^ok (.*)/ && $1 == $next) {
- $next = $next + 1;
- } else {
- $ok = 0;
+ else {
+ open(RESULTS, "./perl -I../lib ../utils/perlcc ./$test "
+ ."-run -verbose dcf -log ../compilelog |")
+ or print "can't compile.\n";
+ }
+
+ $ok = 0;
+ $next = 0;
+ while (<RESULTS>) {
+ if ($verbose) {
+ print $_;
+ }
+ unless (/^#/) {
+ if (/^1\.\.([0-9]+)/) {
+ $max = $1;
+ $totmax += $max;
+ $files += 1;
+ $next = 1;
+ $ok = 1;
+ }
+ else {
+ $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
+ if (/^ok (\d+)(\s*#.*)?$/ && $1 == $next) {
+ $next = $next + 1;
+ }
+ else {
+ $ok = 0;
+ }
}
}
}
- }
- $next = $next - 1;
- if ($ok && $next == $max) {
- if ($max) {
- print "ok\n";
- $good = $good + 1;
- } else {
- print "skipping test on this platform\n";
- $files -= 1;
+ close RESULTS;
+ $next = $next - 1;
+ if ($ok && $next == $max) {
+ if ($max) {
+ print "ok\n";
+ $good = $good + 1;
+ }
+ else {
+ print "skipping test on this platform\n";
+ $files -= 1;
+ }
}
- } else {
- $next += 1;
- print "FAILED at test $next\n";
- $bad = $bad + 1;
- $_ = $test;
- if (/^base/) {
- die "Failed a basic test--cannot continue.\n";
+ else {
+ $next += 1;
+ print "FAILED at test $next\n";
+ $bad = $bad + 1;
+ $_ = $test;
+ if (/^base/) {
+ die "Failed a basic test--cannot continue.\n";
+ }
}
}
-}
-if ($bad == 0) {
- if ($ok) {
- print "All tests successful.\n";
- # XXX add mention of 'perlbug -ok' ?
- } else {
- die "FAILED--no tests were run for some reason.\n";
- }
-} else {
- $pct = sprintf("%.2f", $good / $total * 100);
- if ($bad == 1) {
- warn "Failed 1 test script out of $total, $pct% okay.\n";
- } else {
- warn "Failed $bad test scripts out of $total, $pct% okay.\n";
+ if ($bad == 0) {
+ if ($ok) {
+ print "All tests successful.\n";
+ # XXX add mention of 'perlbug -ok' ?
+ }
+ else {
+ die "FAILED--no tests were run for some reason.\n";
+ }
}
- warn <<'SHRDLU';
+ else {
+ $pct = sprintf("%.2f", $good / $total * 100);
+ if ($bad == 1) {
+ warn "Failed 1 test script out of $total, $pct% okay.\n";
+ }
+ else {
+ warn "Failed $bad test scripts out of $total, $pct% okay.\n";
+ }
+ warn <<'SHRDLU';
### Since not all tests were successful, you may want to run some
### of them individually and examine any diagnostic messages they
### produce. See the INSTALL document's section on "make test".
+ ### If you are testing the compiler, then ignore this message
+ ### and run
+ ### ./perl harness
+ ### in the directory ./t.
SHRDLU
- warn <<'SHRDLU' if $good / $total > 0.8;
+ warn <<'SHRDLU' if $good / $total > 0.8;
###
### Since most tests were successful, you have a good chance to
### get information with better granularity by running
- ### ./perl harness
+ ### ./perl harness
### in directory ./t.
SHRDLU
+ }
+ ($user,$sys,$cuser,$csys) = times;
+ print sprintf("u=%g s=%g cu=%g cs=%g scripts=%d tests=%d\n",
+ $user,$sys,$cuser,$csys,$files,$totmax);
}
-($user,$sys,$cuser,$csys) = times;
-print sprintf("u=%g s=%g cu=%g cs=%g scripts=%d tests=%d\n",
- $user,$sys,$cuser,$csys,$files,$totmax);
exit ($bad != 0);
diff --git a/gnu/usr.bin/perl/t/base/lex.t b/gnu/usr.bin/perl/t/base/lex.t
index 6d03b9e8df3..8e2452d8bba 100644
--- a/gnu/usr.bin/perl/t/base/lex.t
+++ b/gnu/usr.bin/perl/t/base/lex.t
@@ -1,8 +1,6 @@
#!./perl
-# $RCSfile: lex.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:04 $
-
-print "1..27\n";
+print "1..35\n";
$x = 'x';
@@ -104,4 +102,43 @@ print "FOO:" =~ /$foo[:]/ ? "ok 24\n" : "not ok 24\n";
print "ABC" =~ /^$ary[$A]$/ ? "ok 25\n" : "not ok 25\n";
print "FOOZ" =~ /^$foo[$A-Z]$/ ? "ok 26\n" : "not ok 26\n";
-print (((q{{\{\(}} . q{{\)\}}}) eq '{{\(}{\)}}') ? "ok 27\n" : "not ok 27\n");
+# MJD 19980425
+($X, @X) = qw(a b c d);
+print "d" =~ /^$X[-1]$/ ? "ok 27\n" : "not ok 27\n";
+print "a1" !~ /^$X[-1]$/ ? "ok 28\n" : "not ok 28\n";
+
+print (((q{{\{\(}} . q{{\)\}}}) eq '{{\(}{\)}}') ? "ok 29\n" : "not ok 29\n");
+
+
+$foo = "not ok 30\n";
+$foo =~ s/^not /substr(<<EOF, 0, 0)/e;
+ Ignored
+EOF
+print $foo;
+
+# see if eval '', s///e, and heredocs mix
+
+sub T {
+ my ($where, $num) = @_;
+ my ($p,$f,$l) = caller;
+ print "# $p:$f:$l vs /$where/\nnot " unless "$p:$f:$l" =~ /$where/;
+ print "ok $num\n";
+}
+
+my $test = 31;
+
+{
+# line 42 "plink"
+ local $_ = "not ok ";
+ eval q{
+ s/^not /<<EOT/e and T '^main:\(eval \d+\):2$', $test++;
+# fuggedaboudit
+EOT
+ print $_, $test++, "\n";
+ T('^main:\(eval \d+\):6$', $test++);
+# line 1 "plunk"
+ T('^main:plunk:1$', $test++);
+ };
+ print "# $@\nnot ok $test\n" if $@;
+ T '^main:plink:53$', $test++;
+}
diff --git a/gnu/usr.bin/perl/t/base/term.t b/gnu/usr.bin/perl/t/base/term.t
index 782ad397d33..e96313dec57 100644
--- a/gnu/usr.bin/perl/t/base/term.t
+++ b/gnu/usr.bin/perl/t/base/term.t
@@ -2,12 +2,22 @@
# $RCSfile: term.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:07 $
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Config;
+
print "1..7\n";
# check "" interpretation
$x = "\n";
-if ($x eq chr(10)) {print "ok 1\n";} else {print "not ok 1\n";}
+# 10 is ASCII/Iso Latin, 21 is EBCDIC.
+if ($x eq chr(10) ||
+ ($Config{ebcdic} eq 'define' && $x eq chr(21))) {print "ok 1\n";}
+else {print "not ok 1\n";}
# check `` processing
diff --git a/gnu/usr.bin/perl/t/cmd/for.t b/gnu/usr.bin/perl/t/cmd/for.t
index e45f05040bc..d70af579fc2 100644
--- a/gnu/usr.bin/perl/t/cmd/for.t
+++ b/gnu/usr.bin/perl/t/cmd/for.t
@@ -1,8 +1,6 @@
#!./perl
-# $RCSfile: for.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:09 $
-
-print "1..7\n";
+print "1..10\n";
for ($i = 0; $i <= 10; $i++) {
$x[$i] = $i;
@@ -47,3 +45,13 @@ if ($foo eq '3210abcde') {print "ok 5\n";} else {print "not ok 5 $foo\n";}
foreach $foo (("ok 6\n","ok 7\n")) {
print $foo;
}
+
+sub foo {
+ for $i (1..5) {
+ return $i if $_[0] == $i;
+ }
+}
+
+print foo(1) == 1 ? "ok" : "not ok", " 8\n";
+print foo(2) == 2 ? "ok" : "not ok", " 9\n";
+print foo(5) == 5 ? "ok" : "not ok", " 10\n";
diff --git a/gnu/usr.bin/perl/t/cmd/mod.t b/gnu/usr.bin/perl/t/cmd/mod.t
index b4f2731ffa2..e2ab7772464 100644
--- a/gnu/usr.bin/perl/t/cmd/mod.t
+++ b/gnu/usr.bin/perl/t/cmd/mod.t
@@ -2,7 +2,7 @@
# $RCSfile: mod.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:11 $
-print "1..11\n";
+print "1..12\n";
print "ok 1\n" if 1;
print "not ok 1\n" unless 1;
@@ -27,21 +27,28 @@ $x = 15;
$x = 10 while $x < 10;
if ($x == 15) {print "ok 6\n";} else {print "not ok 6\n";}
+$y[$_] = $_ * 2 foreach @x;
+if (join(' ',@y) eq '0 2 4 6 8 10 12 14 16 18 20') {
+ print "ok 7\n";
+} else {
+ print "not ok 7 @y\n";
+}
+
open(foo,'./TEST') || open(foo,'TEST') || open(foo,'t/TEST');
$x = 0;
$x++ while <foo>;
-print $x > 50 && $x < 1000 ? "ok 7\n" : "not ok 7\n";
+print $x > 50 && $x < 1000 ? "ok 8\n" : "not ok 8\n";
$x = -0.5;
print "not " if scalar($x) < 0 and $x >= 0;
-print "ok 8\n";
+print "ok 9\n";
print "not " unless (-(-$x) < 0) == ($x < 0);
-print "ok 9\n";
+print "ok 10\n";
-print "ok 10\n" if $x < 0;
-print "not ok 10\n" unless $x < 0;
+print "ok 11\n" if $x < 0;
+print "not ok 11\n" unless $x < 0;
-print "ok 11\n" unless $x > 0;
-print "not ok 11\n" if $x > 0;
+print "ok 12\n" unless $x > 0;
+print "not ok 12\n" if $x > 0;
diff --git a/gnu/usr.bin/perl/t/cmd/subval.t b/gnu/usr.bin/perl/t/cmd/subval.t
index 3c1ffb89ea7..3c60690ebf1 100644
--- a/gnu/usr.bin/perl/t/cmd/subval.t
+++ b/gnu/usr.bin/perl/t/cmd/subval.t
@@ -33,7 +33,7 @@ sub foo6 {
'true2' unless $_[0];
}
-print "1..34\n";
+print "1..36\n";
if (&foo1(0) eq '0') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
if (&foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";}
@@ -177,3 +177,10 @@ sub iseof {
eof UNIQ ? print "not ok $main'i\n" : print "ok $main'i\n";
}
}
+
+sub autov { $_[0] = 23 };
+
+my $href = {};
+print keys %$href ? 'not ' : '', "ok 35\n";
+autov($href->{b});
+print join(':', %$href) eq 'b:23' ? '' : 'not ', "ok 36\n";
diff --git a/gnu/usr.bin/perl/t/cmd/while.t b/gnu/usr.bin/perl/t/cmd/while.t
index c6e464d444a..392c13779f7 100644
--- a/gnu/usr.bin/perl/t/cmd/while.t
+++ b/gnu/usr.bin/perl/t/cmd/while.t
@@ -2,7 +2,7 @@
# $RCSfile: while.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:15 $
-print "1..10\n";
+print "1..15\n";
open (tmp,'>Cmd_while.tmp') || die "Can't create Cmd_while.tmp.";
print tmp "tvi925\n";
@@ -109,3 +109,22 @@ $i = 9;
$i++;
}
print "ok $i\n";
+
+# Check curpm is reset when jumping out of a scope
+'abc' =~ /b/;
+WHILE:
+while (1) {
+ $i++;
+ print "#$`,$&,$',\nnot " unless $` . $& . $' eq "abc";
+ print "ok $i\n";
+ { # Localize changes to $` and friends
+ 'end' =~ /end/;
+ redo WHILE if $i == 11;
+ next WHILE if $i == 12;
+ # 13 do a normal loop
+ last WHILE if $i == 14;
+ }
+}
+$i++;
+print "not " unless $` . $& . $' eq "abc";
+print "ok $i\n";
diff --git a/gnu/usr.bin/perl/t/comp/cpp.aux b/gnu/usr.bin/perl/t/comp/cpp.aux
index 377c74c6c61..a21344a2ac0 100644
--- a/gnu/usr.bin/perl/t/comp/cpp.aux
+++ b/gnu/usr.bin/perl/t/comp/cpp.aux
@@ -1,6 +1,6 @@
#!./perl -P
-# $RCSfile: cpp.aux,v $$Revision: 1.2 $$Date: 1997/11/30 08:00:02 $
+# $RCSfile: cpp.aux,v $$Revision: 1.3 $$Date: 1999/04/29 22:52:26 $
print "1..3\n";
diff --git a/gnu/usr.bin/perl/t/comp/cpp.t b/gnu/usr.bin/perl/t/comp/cpp.t
index b9693d060c8..6db8c37ea06 100644
--- a/gnu/usr.bin/perl/t/comp/cpp.t
+++ b/gnu/usr.bin/perl/t/comp/cpp.t
@@ -1,6 +1,6 @@
#!./perl
-# $RCSfile: cpp.t,v $$Revision: 1.2 $$Date: 1997/11/30 08:00:03 $
+# $RCSfile: cpp.t,v $$Revision: 1.3 $$Date: 1999/04/29 22:52:26 $
BEGIN {
chdir 't' if -d 't';
diff --git a/gnu/usr.bin/perl/t/comp/multiline.t b/gnu/usr.bin/perl/t/comp/multiline.t
index fc1eedc8d25..ed418b84fc1 100644
--- a/gnu/usr.bin/perl/t/comp/multiline.t
+++ b/gnu/usr.bin/perl/t/comp/multiline.t
@@ -9,11 +9,15 @@ open(try,'>Comp.try') || (die "Can't open temp file.");
$x = 'now is the time
for all good men
to come to.
+
+
+!
+
';
$y = 'now is the time' . "\n" .
'for all good men' . "\n" .
-'to come to.' . "\n";
+'to come to.' . "\n\n\n!\n\n";
if ($x eq $y) {print "ok 1\n";} else {print "not ok 1\n";}
@@ -30,7 +34,7 @@ while (<try>) {
if ($z eq $y) {print "ok 2\n";} else {print "not ok 2\n";}
-if ($count == 3) {print "ok 3\n";} else {print "not ok 3\n";}
+if ($count == 7) {print "ok 3\n";} else {print "not ok 3\n";}
$_ = ($^O eq 'MSWin32') ? `type Comp.try` : `cat Comp.try`;
diff --git a/gnu/usr.bin/perl/t/comp/package.t b/gnu/usr.bin/perl/t/comp/package.t
index cef02c5cb4f..4982256db78 100644
--- a/gnu/usr.bin/perl/t/comp/package.t
+++ b/gnu/usr.bin/perl/t/comp/package.t
@@ -1,6 +1,6 @@
#!./perl
-print "1..7\n";
+print "1..8\n";
$blurfl = 123;
$foo = 3;
@@ -23,7 +23,11 @@ $main = join(':', sort(keys %main::));
$xyz = join(':', sort(keys %xyz::));
$ABC = join(':', sort(keys %ABC::));
-print $xyz eq 'ABC:bar:main:xyz' ? "ok 1\n" : "not ok 1 '$xyz'\n";
+if ('a' lt 'A') {
+ print $xyz eq 'bar:main:xyz:ABC' ? "ok 1\n" : "not ok 1 '$xyz'\n";
+} else {
+ print $xyz eq 'ABC:bar:main:xyz' ? "ok 1\n" : "not ok 1 '$xyz'\n";
+}
print $ABC eq 'blurfl:dyick' ? "ok 2\n" : "not ok 2 '$ABC'\n";
print $main'blurfl == 123 ? "ok 3\n" : "not ok 3\n";
@@ -33,3 +37,17 @@ print $blurfl == 5 ? "ok 4\n" : "not ok 4\n";
eval 'print $blurfl == 5 ? "ok 5\n" : "not ok 5\n";';
eval 'package main; print $blurfl == 123 ? "ok 6\n" : "not ok 6\n";';
print $blurfl == 5 ? "ok 7\n" : "not ok 7\n";
+
+package main;
+
+sub c { caller(0) }
+
+sub foo {
+ my $s = shift;
+ if ($s) {
+ package PQR;
+ main::c();
+ }
+}
+
+print((foo(1))[0] eq 'PQR' ? "ok 8\n" : "not ok 8\n");
diff --git a/gnu/usr.bin/perl/t/comp/proto.t b/gnu/usr.bin/perl/t/comp/proto.t
index d1cfede8af9..db6a9b50817 100644
--- a/gnu/usr.bin/perl/t/comp/proto.t
+++ b/gnu/usr.bin/perl/t/comp/proto.t
@@ -16,7 +16,7 @@ BEGIN {
use strict;
-print "1..76\n";
+print "1..87\n";
my $i = 1;
@@ -362,20 +362,35 @@ printf "ok %d\n",$i++;
##
##
-testing \&an_array_ref, '\@';
+testing \&array_ref_plus, '\@@';
-sub an_array_ref (\@) {
+sub array_ref_plus (\@@) {
print "# \@_ = (",join(",",@_),")\n";
- print "not " unless ref($_[0]) && 1 == @{$_[0]};
+ print "not " unless @_ == 2 && ref($_[0]) && 1 == @{$_[0]} && $_[1] eq 'x';
printf "ok %d\n",$i++;
@{$_[0]} = (qw(ok)," ",$i++,"\n");
}
@array = ('a');
-an_array_ref @array;
+{ my @more = ('x');
+ array_ref_plus @array, @more; }
print "not " unless @array == 4;
print @array;
+my $p;
+print "not " if defined prototype('CORE::print');
+print "ok ", $i++, "\n";
+
+print "not " if defined prototype('CORE::system');
+print "ok ", $i++, "\n";
+
+print "# CORE::open => ($p)\nnot " if ($p = prototype('CORE::open')) ne '*;$';
+print "ok ", $i++, "\n";
+
+print "# CORE:Foo => ($p), \$@ => `$@'\nnot "
+ if defined ($p = eval { prototype('CORE::Foo') or 1 }) or $@ !~ /^Cannot find an opnumber/;
+print "ok ", $i++, "\n";
+
# correctly note too-short parameter lists that don't end with '$',
# a possible regression.
@@ -388,3 +403,23 @@ sub foo2 ($\%);
eval q{ foo2 "s" };
print "not " unless $@ =~ /^Not enough/;
print "ok ", $i++, "\n";
+
+sub X::foo3;
+*X::foo3 = sub {'ok'};
+print "# $@not " unless eval {X->foo3} eq 'ok';
+print "ok ", $i++, "\n";
+
+sub X::foo4 ($);
+*X::foo4 = sub ($) {'ok'};
+print "not " unless X->foo4 eq 'ok';
+print "ok ", $i++, "\n";
+
+# test if the (*) prototype allows barewords, constants, scalar expressions,
+# globs and globrefs (just as CORE::open() does), all under stricture
+sub star (*&) { &{$_[1]} }
+my $star = 'FOO';
+star FOO, sub { print "ok $i\n" if $_[0] eq 'FOO' }; $i++;
+star "FOO", sub { print "ok $i\n" if $_[0] eq 'FOO' }; $i++;
+star $star, sub { print "ok $i\n" if $_[0] eq 'FOO' }; $i++;
+star *FOO, sub { print "ok $i\n" if $_[0] eq \*FOO }; $i++;
+star \*FOO, sub { print "ok $i\n" if $_[0] eq \*FOO }; $i++;
diff --git a/gnu/usr.bin/perl/t/comp/script.t b/gnu/usr.bin/perl/t/comp/script.t
index 3731ca078ea..fa659009d9a 100644
--- a/gnu/usr.bin/perl/t/comp/script.t
+++ b/gnu/usr.bin/perl/t/comp/script.t
@@ -1,6 +1,6 @@
#!./perl
-# $RCSfile: script.t,v $$Revision: 1.2 $$Date: 1997/11/30 08:00:08 $
+# $RCSfile: script.t,v $$Revision: 1.3 $$Date: 1999/04/29 22:52:27 $
print "1..3\n";
diff --git a/gnu/usr.bin/perl/t/harness b/gnu/usr.bin/perl/t/harness
index fe64a046290..f6d94de90f2 100644
--- a/gnu/usr.bin/perl/t/harness
+++ b/gnu/usr.bin/perl/t/harness
@@ -6,6 +6,7 @@
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
+ $ENV{PERL5LIB} = '../lib'; # so children will see it too
}
use lib '../lib';
@@ -16,4 +17,17 @@ $Test::Harness::verbose = shift if @ARGV && $ARGV[0] eq '-v';
@tests = @ARGV;
@tests = <base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t lib/*.t> unless @tests;
+
Test::Harness::runtests @tests;
+
+%infinite = ('comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 );
+
+@tests = grep (!$infinite{$_}, @tests);
+
+if (-e "../testcompile")
+{
+ print "The tests ", join(' ', keys(%infinite)),
+ " generate infinite loops! Skipping!\n";
+
+ $ENV{'COMPILE_TEST'} = 1; Test::Harness::runtests @tests;
+}
diff --git a/gnu/usr.bin/perl/t/io/argv.t b/gnu/usr.bin/perl/t/io/argv.t
index d99865e142e..c6565dc9c78 100644
--- a/gnu/usr.bin/perl/t/io/argv.t
+++ b/gnu/usr.bin/perl/t/io/argv.t
@@ -1,10 +1,8 @@
#!./perl
-# $RCSfile: argv.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:25 $
+print "1..6\n";
-print "1..5\n";
-
-open(try, '>Io.argv.tmp') || (die "Can't open temp file.");
+open(try, '>Io.argv.tmp') || (die "Can't open temp file: $!");
print try "a line\n";
close try;
@@ -45,4 +43,17 @@ if ($y eq "1a line\n2a line\n3a line\n")
else
{print "not ok 5\n";}
-unlink 'Io.argv.tmp';
+open(try, '>Io.argv.tmp') or die "Can't open temp file: $!";
+close try;
+@ARGV = 'Io.argv.tmp';
+$^I = '.bak';
+$/ = undef;
+while (<>) {
+ s/^/ok 6\n/;
+ print;
+}
+open(try, '<Io.argv.tmp') or die "Can't open temp file: $!";
+print while <try>;
+close try;
+
+END { unlink 'Io.argv.tmp', 'Io.argv.tmp.bak' }
diff --git a/gnu/usr.bin/perl/t/io/fs.t b/gnu/usr.bin/perl/t/io/fs.t
index ca82689c6fe..f09d66c39e0 100644
--- a/gnu/usr.bin/perl/t/io/fs.t
+++ b/gnu/usr.bin/perl/t/io/fs.t
@@ -9,56 +9,78 @@ BEGIN {
use Config;
-# avoid win32 (for now)
-do { print "1..0\n"; exit(0); } if $^O eq 'MSWin32';
+$Is_Dosish = ($^O eq 'MSWin32' or $^O eq 'dos' or
+ $^O eq 'os2' or $^O eq 'mint');
-print "1..26\n";
+print "1..28\n";
$wd = (($^O eq 'MSWin32') ? `cd` : `pwd`);
chop($wd);
-if ($^O eq 'MSWin32') { `del tmp`; `mkdir tmp`; }
+if ($^O eq 'MSWin32') { `del tmp 2>nul`; `mkdir tmp`; }
else { `rm -f tmp 2>/dev/null; mkdir tmp 2>/dev/null`; }
chdir './tmp';
`/bin/rm -rf a b c x` if -x '/bin/rm';
umask(022);
-if ((umask(0)&0777) == 022) {print "ok 1\n";} else {print "not ok 1\n";}
+if ($^O eq 'MSWin32') { print "ok 1 # skipped: bogus umask()\n"; }
+elsif ((umask(0)&0777) == 022) {print "ok 1\n";} else {print "not ok 1\n";}
open(fh,'>x') || die "Can't create x";
close(fh);
open(fh,'>a') || die "Can't create a";
close(fh);
-if (eval {link('a','b')}) {print "ok 2\n";} else {print "not ok 2\n";}
+if ($Is_Dosish) {print "ok 2 # skipped: no link\n";}
+elsif (eval {link('a','b')}) {print "ok 2\n";}
+else {print "not ok 2\n";}
-if (eval {link('b','c')}) {print "ok 3\n";} else {print "not ok 3\n";}
+if ($Is_Dosish) {print "ok 3 # skipped: no link\n";}
+elsif (eval {link('b','c')}) {print "ok 3\n";}
+else {print "not ok 3\n";}
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat('c');
-if ($Config{dont_use_nlink} || $nlink == 3)
- {print "ok 4\n";} else {print "not ok 4\n";}
+if ($Config{dont_use_nlink} || $Is_Dosish)
+ {print "ok 4 # skipped: no link\n";}
+elsif ($nlink == 3)
+ {print "ok 4\n";}
+else {print "not ok 4\n";}
-if (($mode & 0777) == 0666 || $^O eq 'amigaos')
- {print "ok 5\n";} else {print "not ok 5\n";}
+if ($^O eq 'amigaos' || $Is_Dosish)
+ {print "ok 5 # skipped: no link\n";}
+elsif (($mode & 0777) == 0666)
+ {print "ok 5\n";}
+else {print "not ok 5\n";}
if ((chmod 0777,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";}
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat('c');
-if (($mode & 0777) == 0777) {print "ok 7\n";} else {print "not ok 7\n";}
+if ($Is_Dosish) {print "ok 7 # skipped: no link\n";}
+elsif (($mode & 0777) == 0777) {print "ok 7\n";}
+else {print "not ok 7\n";}
-if ((chmod 0700,'c','x') == 2) {print "ok 8\n";} else {print "not ok 8\n";}
+if ($Is_Dosish) {print "ok 8 # skipped: no link\n";}
+elsif ((chmod 0700,'c','x') == 2) {print "ok 8\n";}
+else {print "not ok 8\n";}
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat('c');
-if (($mode & 0777) == 0700) {print "ok 9\n";} else {print "not ok 9\n";}
+if ($Is_Dosish) {print "ok 9 # skipped: no link\n";}
+elsif (($mode & 0777) == 0700) {print "ok 9\n";}
+else {print "not ok 9\n";}
+
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat('x');
-if (($mode & 0777) == 0700) {print "ok 10\n";} else {print "not ok 10\n";}
+if ($Is_Dosish) {print "ok 10 # skipped: no link\n";}
+elsif (($mode & 0777) == 0700) {print "ok 10\n";}
+else {print "not ok 10\n";}
-if ((unlink 'b','x') == 2) {print "ok 11\n";} else {print "not ok 11\n";}
+if ($Is_Dosish) {print "ok 11 # skipped: no link\n"; unlink 'b','x'; }
+elsif ((unlink 'b','x') == 2) {print "ok 11\n";}
+else {print "not ok 11\n";}
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat('b');
if ($ino == 0) {print "ok 12\n";} else {print "not ok 12\n";}
@@ -70,13 +92,16 @@ if (rename('a','b')) {print "ok 14\n";} else {print "not ok 14\n";}
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat('a');
if ($ino == 0) {print "ok 15\n";} else {print "not ok 15\n";}
-$foo = (utime 500000000,500000001,'b');
+$delta = $Is_Dosish ? 2 : 1; # Granularity of time on the filesystem
+$foo = (utime 500000000,500000000 + $delta,'b');
if ($foo == 1) {print "ok 16\n";} else {print "not ok 16 $foo\n";}
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat('b');
-if ($ino) {print "ok 17\n";} else {print "not ok 17\n";}
-if (($atime == 500000000 && $mtime == 500000001)
- || $wd =~ m#/afs/# || $^O eq 'amigaos')
+if ($^O eq 'MSWin32') { print "ok 17 # skipped: bogus (stat)[1]\n"; }
+elsif ($ino) {print "ok 17\n";} else {print "not ok 17\n";}
+if ($wd =~ m#/afs/# || $^O eq 'amigaos' || $^O eq 'dos' || $^O eq 'MSWin32')
+ {print "ok 18 # skipped: granularity of the filetime\n";}
+elsif ($atime == 500000000 && $mtime == 500000000 + $delta)
{print "ok 18\n";}
else
{print "not ok 18 $atime $mtime\n";}
@@ -88,7 +113,6 @@ if ($ino == 0) {print "ok 20\n";} else {print "not ok 20\n";}
unlink 'c';
chdir $wd || die "Can't cd back to $wd";
-rmdir 'tmp';
unlink 'c';
if ($^O ne 'MSWin32' and `ls -l perl 2>/dev/null` =~ /^l.*->/) {
@@ -120,9 +144,22 @@ else {
{ select FH; $| = 1; select STDOUT }
print FH "helloworld\n";
truncate FH, 5;
+ if ($^O eq 'dos') {
+ close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
+ }
if (-s "Iofs.tmp" == 5) {print "ok 25\n"} else {print "not ok 25\n"}
truncate FH, 0;
+ if ($^O eq 'dos') {
+ close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
+ }
if (-z "Iofs.tmp") {print "ok 26\n"} else {print "not ok 26\n"}
close FH;
}
-unlink "Iofs.tmp";
+
+# check if rename() works on directories
+rename 'tmp', 'tmp1' or print "not ";
+print "ok 27\n";
+-d 'tmp1' or print "not ";
+print "ok 28\n";
+
+END { rmdir 'tmp1'; unlink "Iofs.tmp"; }
diff --git a/gnu/usr.bin/perl/t/io/inplace.t b/gnu/usr.bin/perl/t/io/inplace.t
index 2652c8bebef..ff410a7b5fc 100644
--- a/gnu/usr.bin/perl/t/io/inplace.t
+++ b/gnu/usr.bin/perl/t/io/inplace.t
@@ -1,6 +1,6 @@
#!./perl
-$^I = '.bak';
+$^I = $^O eq 'VMS' ? '_bak' : '.bak';
# $RCSfile: inplace.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:29 $
@@ -13,6 +13,12 @@ if ($^O eq 'MSWin32') {
`.\\perl -le "print 'foo'" > .b`;
`.\\perl -le "print 'foo'" > .c`;
}
+elsif ($^O eq 'VMS') {
+ $CAT = 'MCR []perl. -e "print<>"';
+ `MCR []perl. -le "print 'foo'" > ./.a`;
+ `MCR []perl. -le "print 'foo'" > ./.b`;
+ `MCR []perl. -le "print 'foo'" > ./.c`;
+}
else {
$CAT = 'cat';
`echo foo | tee .a .b .c`;
@@ -25,6 +31,6 @@ continue {
}
if (`$CAT .a .b .c` eq "bar\nbar\nbar\n") {print "ok 1\n";} else {print "not ok 1\n";}
-if (`$CAT .a.bak .b.bak .c.bak` eq "foo\nfoo\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";}
+if (`$CAT .a$^I .b$^I .c$^I` eq "foo\nfoo\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";}
-unlink '.a', '.b', '.c', '.a.bak', '.b.bak', '.c.bak';
+unlink '.a', '.b', '.c', ".a$^I", ".b$^I", ".c$^I";
diff --git a/gnu/usr.bin/perl/t/io/pipe.t b/gnu/usr.bin/perl/t/io/pipe.t
index ac149810ec9..ba7a9b093b6 100644
--- a/gnu/usr.bin/perl/t/io/pipe.t
+++ b/gnu/usr.bin/perl/t/io/pipe.t
@@ -13,7 +13,7 @@ BEGIN {
}
$| = 1;
-print "1..10\n";
+print "1..12\n";
open(PIPE, "|-") || (exec 'tr', 'YX', 'ko');
print PIPE "Xk 1\n";
@@ -25,6 +25,7 @@ if (open(PIPE, "-|")) {
s/^not //;
print;
}
+ close PIPE; # avoid zombies which disrupt test 12
}
else {
print STDOUT "not ok 3\n";
@@ -40,6 +41,7 @@ if ($pid = fork) {
y/A-Z/a-z/;
print;
}
+ close READER; # avoid zombies which disrupt test 12
}
else {
die "Couldn't fork" unless defined $pid;
@@ -57,27 +59,31 @@ close READER;
$SIG{'PIPE'} = 'broken_pipe';
sub broken_pipe {
+ $SIG{'PIPE'} = 'IGNORE'; # loop preventer
print "ok 7\n";
}
print WRITER "not ok 7\n";
close WRITER;
-
+sleep 1;
print "ok 8\n";
# VMS doesn't like spawning subprocesses that are still connected to
-# STDOUT. Someone should modify tests #9 and #10 to work with VMS.
+# STDOUT. Someone should modify tests #9 to #12 to work with VMS.
if ($^O eq 'VMS') {
print "ok 9\n";
print "ok 10\n";
+ print "ok 11\n";
+ print "ok 12\n";
exit;
}
-if ($Config{d_sfio} || $^O eq machten) {
+if ($Config{d_sfio} || $^O eq machten || $^O eq beos) {
# Sfio doesn't report failure when closing a broken pipe
# that has pending output. Go figure. MachTen doesn't either,
# but won't write to broken pipes, so nothing's pending at close.
+ # BeOS will not write to broken pipes, either.
print "ok 9\n";
}
else {
@@ -108,3 +114,22 @@ elsif ($? == 0) {
else {
print "ok 10\n";
}
+
+# check that status for the correct process is collected
+wait; # Collect from $pid
+my $zombie = fork or exit 37;
+my $pipe = open *FH, "sleep 2;exit 13|" or die "Open: $!\n";
+$SIG{ALRM} = sub { return };
+alarm(1);
+my $close = close FH;
+if ($? == 13*256 && ! length $close && ! $!) {
+ print "ok 11\n";
+} else {
+ print "not ok 11\n# close $close\$?=$? \$!=", $!+0, ":$!\n";
+};
+my $wait = wait;
+if ($? == 37*256 && $wait == $zombie && ! $!) {
+ print "ok 12\n";
+} else {
+ print "not ok 12\n# pid=$wait first=$pid pipe=$pipe zombie=$zombie me=$$ \$?=$? \$!=", $!+0, ":$!\n";
+}
diff --git a/gnu/usr.bin/perl/t/lib/anydbm.t b/gnu/usr.bin/perl/t/lib/anydbm.t
index a83da81e1c6..db10595e71e 100644
--- a/gnu/usr.bin/perl/t/lib/anydbm.t
+++ b/gnu/usr.bin/perl/t/lib/anydbm.t
@@ -1,6 +1,6 @@
#!./perl
-# $RCSfile: anydbm.t,v $$Revision: 1.2 $$Date: 1997/11/30 08:00:20 $
+# $RCSfile: anydbm.t,v $$Revision: 1.3 $$Date: 1999/04/29 22:52:28 $
BEGIN {
chdir 't' if -d 't';
@@ -12,18 +12,18 @@ use Fcntl;
print "1..12\n";
-unlink <Op.dbmx*>;
+unlink <Op_dbmx*>;
umask(0);
-print (tie(%h,AnyDBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640)
+print (tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640)
? "ok 1\n" : "not ok 1\n");
-$Dfile = "Op.dbmx.pag";
+$Dfile = "Op_dbmx.pag";
if (! -e $Dfile) {
- ($Dfile) = <Op.dbmx*>;
+ ($Dfile) = <Op_dbmx*>;
}
-if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') {
- print "ok 2\n";
+if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') {
+ print "ok 2 # Skipped: different file permission semantics\n";
}
else {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
@@ -33,7 +33,7 @@ else {
while (($key,$value) = each(%h)) {
$i++;
}
-print (!$i ? "ok 3\n" : "not ok 3\n");
+print (!$i ? "ok 3\n" : "not ok 3 # i=$i\n\n");
$h{'goner1'} = 'snork';
@@ -55,7 +55,7 @@ $h{'goner2'} = 'snork';
delete $h{'goner2'};
untie(%h);
-print (tie(%h,AnyDBM_File,'Op.dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
+print (tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
$h{'j'} = 'J';
$h{'k'} = 'K';
@@ -85,7 +85,7 @@ delete $h{'goner3'};
if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
-while (($key,$value) = each(h)) {
+while (($key,$value) = each(%h)) {
if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
$key =~ y/a-z/A-Z/;
$i++ if $key eq $value;
@@ -94,7 +94,7 @@ while (($key,$value) = each(h)) {
if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
-@keys = ('blurfl', keys(h), 'dyick');
+@keys = ('blurfl', keys(%h), 'dyick');
if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
$h{'foo'} = '';
@@ -118,4 +118,8 @@ print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
untie %h;
-unlink 'Op.dbmx.dir', $Dfile;
+if ($^O eq 'VMS') {
+ unlink 'Op_dbmx.sdbm_dir', $Dfile;
+} else {
+ unlink 'Op_dbmx.dir', $Dfile;
+}
diff --git a/gnu/usr.bin/perl/t/lib/basename.t b/gnu/usr.bin/perl/t/lib/basename.t
index 860b3379b43..a02aa32cb7a 100644
--- a/gnu/usr.bin/perl/t/lib/basename.t
+++ b/gnu/usr.bin/perl/t/lib/basename.t
@@ -1,4 +1,4 @@
-#!./perl
+#!./perl -T
BEGIN {
chdir 't' if -d 't';
@@ -7,7 +7,7 @@ BEGIN {
use File::Basename qw(fileparse basename dirname);
-print "1..34\n";
+print "1..36\n";
# import correctly?
print +(defined(&basename) && !defined(&fileparse_set_fstype) ?
@@ -119,3 +119,21 @@ File::Basename::fileparse_set_fstype 'UNIX';
print +(dirname('/perl/') eq '/' ? '' : 'not '), "ok 33\n";
# perl5.003_18 gives '/perl/lib'
print +(dirname('/perl/lib//') eq '/perl' ? '' : 'not '), "ok 34\n";
+
+# The empty tainted value, for tainting strings
+my $TAINT = substr($^X, 0, 0);
+# How to identify taint when you see it
+sub any_tainted (@) {
+ not eval { join("",@_), kill 0; 1 };
+}
+sub tainted ($) {
+ any_tainted @_;
+}
+sub all_tainted (@) {
+ for (@_) { return 0 unless tainted $_ }
+ 1;
+}
+
+print +(tainted(dirname($TAINT.'/perl/lib//')) ? '' : 'not '), "ok 35\n";
+print +(all_tainted(fileparse($TAINT.'/dir/draft.book7','\.book\d+'))
+ ? '' : 'not '), "ok 36\n";
diff --git a/gnu/usr.bin/perl/t/lib/bigintpm.t b/gnu/usr.bin/perl/t/lib/bigintpm.t
index ebaecac21af..e7cac26323d 100644
--- a/gnu/usr.bin/perl/t/lib/bigintpm.t
+++ b/gnu/usr.bin/perl/t/lib/bigintpm.t
@@ -5,12 +5,11 @@ BEGIN {
@INC = '../lib';
}
-use Config;
use Math::BigInt;
$test = 0;
$| = 1;
-print "1..246\n";
+print "1..247\n";
while (<DATA>) {
chop;
if (s/^&//) {
@@ -116,6 +115,7 @@ abc:+0:NaN
+124:+123:+1
-123:-124:+1
-124:-123:-1
++100:+5:+1
&badd
abc:abc:NaN
abc:+0:NaN
diff --git a/gnu/usr.bin/perl/t/lib/complex.t b/gnu/usr.bin/perl/t/lib/complex.t
index 2a01859b989..4fd46b091e6 100644
--- a/gnu/usr.bin/perl/t/lib/complex.t
+++ b/gnu/usr.bin/perl/t/lib/complex.t
@@ -3,13 +3,9 @@
# $RCSfile: complex.t,v $
#
# Regression tests for the Math::Complex pacakge
-# -- Raphael Manfredi September 1996
-# -- Jarkko Hietaniemi March-October 1997
-# -- Daniel S. Lewart September-October 1997
-
-$VERSION = '1.05';
-
-# $Id: complex.t,v 1.1 1997/11/30 08:00:23 millert Exp $
+# -- Raphael Manfredi since Sep 1996
+# -- Jarkko Hietaniemi since Mar 1997
+# -- Daniel S. Lewart since Sep 1997
BEGIN {
chdir 't' if -d 't';
@@ -18,6 +14,8 @@ BEGIN {
use Math::Complex;
+my $VERSION = sprintf("%s", q$Id: complex.t,v 1.2 1999/04/29 22:52:29 millert Exp $ =~ /(\d+\.d+)/);
+
my ($args, $op, $target, $test, $test_set, $try, $val, $zvalue, @set, @val);
$test = 0;
@@ -26,7 +24,12 @@ my @script = (
'my ($res, $s0,$s1,$s2,$s3,$s4,$s5,$s6,$s7,$s8,$s9,$s10, $z0,$z1,$z2);' .
"\n\n"
);
-my $eps = 1e-11;
+my $eps = 1e-13;
+
+if ($^O eq 'unicos') { # For some reason root() produces very inaccurate
+ $eps = 1e-11; # results in Cray UNICOS, and occasionally also
+} # cos(), sin(), cosh(), sinh(). The division
+ # of doubles is the current suspect.
while (<DATA>) {
s/^\s+//;
@@ -59,16 +62,70 @@ while (<DATA>) {
}
}
+#
+
+sub test_mutators {
+ my $op;
+
+ $test++;
+push(@script, <<'EOT');
+{
+ my $z = cplx( 1, 1);
+ $z->Re(2);
+ $z->Im(3);
+ print 'not ' unless Re($z) == 2 and Im($z) == 3;
+EOT
+ push(@script, qq(print "ok $test\\n"}\n));
+
+ $test++;
+push(@script, <<'EOT');
+{
+ my $z = cplx( 1, 1);
+ $z->abs(3 * sqrt(2));
+ print 'not ' unless (abs($z) - 3 * sqrt(2)) < $eps and
+ (arg($z) - pi / 4 ) < $eps and
+ (Re($z) - 3 ) < $eps and
+ (Im($z) - 3 ) < $eps;
+EOT
+ push(@script, qq(print "ok $test\\n"}\n));
+
+ $test++;
+push(@script, <<'EOT');
+{
+ my $z = cplx( 1, 1);
+ $z->arg(-3 / 4 * pi);
+ print 'not ' unless (arg($z) + 3 / 4 * pi) < $eps and
+ (abs($z) - sqrt(2) ) < $eps and
+ (Re($z) + 1 ) < $eps and
+ (Im($z) + 1 ) < $eps;
+EOT
+ push(@script, qq(print "ok $test\\n"}\n));
+}
+
+test_mutators();
+
+my $constants = '
+my $i = cplx(0, 1);
+my $pi = cplx(pi, 0);
+my $pii = cplx(0, pi);
+my $pip2 = cplx(pi/2, 0);
+my $zero = cplx(0, 0);
+';
+
+push(@script, $constants);
+
+
# test the divbyzeros
sub test_dbz {
for my $op (@_) {
$test++;
-# push(@script, qq(print "# '$op'\n";));
- push(@script, qq(eval '$op';));
- push(@script, qq(print 'not ' unless (\$@ =~ /Division by zero/);));
- push(@script, qq( print "ok $test\\n";\n));
+ push(@script, <<EOT);
+eval '$op';
+print 'not ' unless (\$@ =~ /Division by zero/);
+EOT
+ push(@script, qq(print "ok $test\\n";\n));
}
}
@@ -78,68 +135,55 @@ sub test_loz {
for my $op (@_) {
$test++;
-# push(@script, qq(print "# '$op'\n";));
- push(@script, qq(eval '$op';));
- push(@script, qq(print 'not ' unless (\$@ =~ /Logarithm of zero/);));
- push(@script, qq( print "ok $test\\n";\n));
+ push(@script, <<EOT);
+eval '$op';
+print 'not ' unless (\$@ =~ /Logarithm of zero/);
+EOT
+ push(@script, qq(print "ok $test\\n";\n));
}
}
-my $minusi = cplx(0, -1);
-
test_dbz(
'i/0',
-# 'tan(pi/2)', # may succeed thanks to floating point inaccuracies
-# 'sec(pi/2)', # may succeed thanks to floating point inaccuracies
- 'csc(0)',
- 'cot(0)',
- 'atan(i)',
- 'atan($minusi)',
- 'asec(0)',
+ 'acot(0)',
+ 'acot(+$i)',
+# 'acoth(-1)', # Log of zero.
+ 'acoth(0)',
+ 'acoth(+1)',
'acsc(0)',
- 'acot(i)',
- 'acot($minusi)',
-# 'tanh(pi/2)', # may succeed thanks to floating point inaccuracies
-# 'sech(pi/2)', # may succeed thanks to floating point inaccuracies
- 'csch(0)',
- 'coth(0)',
- 'atanh(1)',
- 'asech(0)',
'acsch(0)',
- 'acoth(1)',
+ 'asec(0)',
+ 'asech(0)',
+ 'atan(-$i)',
+ 'atan($i)',
+# 'atanh(-1)', # Log of zero.
+ 'atanh(+1)',
+ 'cot(0)',
+ 'coth(0)',
+ 'csc(0)',
+ 'tan($pip2)',
+ 'csch(0)',
+ 'tan($pip2)',
);
-my $zero = cplx(0, 0);
-
test_loz(
'log($zero)',
+ 'acot(-$i)',
'atanh(-1)',
'acoth(-1)',
);
-# test the 0**0
-
-sub test_ztz {
- $test++;
-
-# push(@script, qq(print "# 0**0\n";));
- push(@script, qq(eval 'cplx(0)**cplx(0)';));
- push(@script, qq(print 'not ' unless (\$@ =~ /zero raised to the/);));
- push(@script, qq( print "ok $test\\n";\n));
-}
-
-test_ztz;
-
# test the bad roots
sub test_broot {
for my $op (@_) {
$test++;
-# push(@script, qq(print "# root(2, $op)\n";));
- push(@script, qq(eval 'root(2, $op)';));
- push(@script, qq(print 'not ' unless (\$@ =~ /root must be/);));
- push(@script, qq( print "ok $test\\n";\n));
+ push(@script, <<EOT);
+eval 'root(2, $op)';
+print 'not ' unless (\$@ =~ /root must be/);
+EOT
+ push(@script, qq(print "ok $test\\n";\n));
}
}
@@ -200,7 +244,7 @@ EOB
$test++;
# check that the rhs has not changed
push @script, qq(print "not " unless (\$zbr == \$z1r and \$zbi == \$z1i););
- push @script, qq( print "ok $test\\n";\n);
+ push @script, qq(print "ok $test\\n";\n);
push @script, "}\n";
}
}
@@ -226,6 +270,9 @@ sub value {
if (/^\s*\((.*),(.*)\)/) {
return "cplx($1,$2)";
}
+ elsif (/^\s*([\-\+]?(?:\d+(\.\d+)?|\.\d+)(?:[e[\-\+]\d+])?)/) {
+ return "cplx($1,0)";
+ }
elsif (/^\s*\[(.*),(.*)\]/) {
return "cplxe($1,$2)";
}
@@ -326,6 +373,7 @@ __END__
(1,0):(2,3):(1,0)
(2,3):(0,0):(1,0)
(2,3):(1,0):(2,3)
+(0,0):(0,0):(1,0)
&Re
(3,4):3
@@ -815,4 +863,3 @@ __END__
( 2,-3):( 0.14694666622553, 0.23182380450040)
# eof
-
diff --git a/gnu/usr.bin/perl/t/lib/db-btree.t b/gnu/usr.bin/perl/t/lib/db-btree.t
index bebb63df8d0..bf739c81d5c 100644
--- a/gnu/usr.bin/perl/t/lib/db-btree.t
+++ b/gnu/usr.bin/perl/t/lib/db-btree.t
@@ -91,7 +91,7 @@ ok(19, $X = tie(%h, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE )) ;
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat($Dfile);
-ok(20, ($mode & 0777) == (($^O eq 'os2' || $^O eq 'MSWin32') ? 0666 : 0640) || $^O eq 'amigaos');
+ok(20, ($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos' || $^O eq 'MSWin32');
while (($key,$value) = each(%h)) {
$i++;
@@ -190,8 +190,9 @@ ok(30, ArrayCompare(\@b, \@c)) ;
$h{'foo'} = '';
ok(31, $h{'foo'} eq '' ) ;
-$h{''} = 'bar';
-ok(32, $h{''} eq 'bar' );
+#$h{''} = 'bar';
+#ok(32, $h{''} eq 'bar' );
+ok(32,1) ;
# check cache overflow and numeric keys and contents
$ok = 1;
@@ -234,8 +235,9 @@ ok(40, $value eq 'value' );
$status = $X->del('q') ;
ok(41, $status == 0 );
-$status = $X->del('') ;
-ok(42, $status == 0 );
+#$status = $X->del('') ;
+#ok(42, $status == 0 );
+ok(42,1) ;
# Make sure that the key deleted, cannot be retrieved
ok(43, ! defined $h{'q'}) ;
@@ -308,7 +310,8 @@ ok(62, $status == 0 );
ok(63, $key eq 'replace key' );
ok(64, $value eq 'replace value' );
$status = $X->get('y', $value) ;
-ok(65, $status == 1 );
+ok(65, 1) ; # hard-wire to always pass. the previous test ($status == 1)
+ # only worked because of a bug in 1.85/6
# use seq to walk forwards through a file
@@ -513,7 +516,6 @@ unlink $Dfile1 ;
unlink $filename ;
}
-
{
# sub-class test
@@ -573,7 +575,7 @@ EOM
close FILE ;
- BEGIN { push @INC, '.'; }
+ BEGIN { push @INC, '.'; }
eval 'use SubDB ; ';
main::ok(93, $@ eq "") ;
my %h ;
@@ -601,6 +603,8 @@ EOM
main::ok(101, $@ eq "") ;
main::ok(102, $ret eq "[[11]]") ;
+ undef $X;
+ untie(%h);
unlink "SubDB.pm", "dbbtree.tmp" ;
}
diff --git a/gnu/usr.bin/perl/t/lib/db-hash.t b/gnu/usr.bin/perl/t/lib/db-hash.t
index 9df918cce5a..e7484722631 100644
--- a/gnu/usr.bin/perl/t/lib/db-hash.t
+++ b/gnu/usr.bin/perl/t/lib/db-hash.t
@@ -70,7 +70,7 @@ ok(15, $X = tie(%h, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat($Dfile);
-ok(16, ($mode & 0777) == (($^O eq 'os2' || $^O eq 'MSWin32') ? 0666 : 0640) || $^O eq 'amigaos');
+ok(16, ($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos' || $^O eq 'MSWin32');
while (($key,$value) = each(%h)) {
$i++;
@@ -164,8 +164,9 @@ ok(25, $#keys == 31) ;
$h{'foo'} = '';
ok(26, $h{'foo'} eq '' );
-$h{''} = 'bar';
-ok(27, $h{''} eq 'bar' );
+#$h{''} = 'bar';
+#ok(27, $h{''} eq 'bar' );
+ok(27,1) ;
# check cache overflow and numeric keys and contents
$ok = 1;
@@ -379,7 +380,7 @@ EOM
close FILE ;
- BEGIN { push @INC, '.'; }
+ BEGIN { push @INC, '.'; }
eval 'use SubDB ; ';
main::ok(53, $@ eq "") ;
my %h ;
@@ -407,8 +408,9 @@ EOM
main::ok(61, $@ eq "") ;
main::ok(62, $ret eq "[[11]]") ;
+ undef $X;
+ untie(%h);
unlink "SubDB.pm", "dbhash.tmp" ;
}
-
exit ;
diff --git a/gnu/usr.bin/perl/t/lib/db-recno.t b/gnu/usr.bin/perl/t/lib/db-recno.t
index 9950741ffea..da703c95d05 100644
--- a/gnu/usr.bin/perl/t/lib/db-recno.t
+++ b/gnu/usr.bin/perl/t/lib/db-recno.t
@@ -12,7 +12,20 @@ BEGIN {
use DB_File;
use Fcntl;
use strict ;
-use vars qw($dbh $Dfile $bad_ones) ;
+use vars qw($dbh $Dfile $bad_ones $FA) ;
+
+# full tied array support started in Perl 5.004_57
+# Double check to see if it is available.
+
+{
+ sub try::TIEARRAY { bless [], "try" }
+ sub try::FETCHSIZE { $FA = 1 }
+ $FA = 0 ;
+ my @a ;
+ tie @a, 'try' ;
+ my $a = @a ;
+}
+
sub ok
{
@@ -29,19 +42,21 @@ sub bad_one
{
print STDERR <<EOM unless $bad_ones++ ;
#
-# Some older versions of Berkeley DB will fail tests 51, 53 and 55.
+# Some older versions of Berkeley DB version 1 will fail tests 51,
+# 53 and 55.
#
# You can safely ignore the errors if you're never going to use the
-# broken functionality (recno databases with a modified bval).
+# broken functionality (recno databases with a modified bval).
# Otherwise you'll have to upgrade your DB library.
#
-# If you want to upgrade Berkeley DB, the most recent version is 1.85.
-# Check out http://www.bostic.com/db for more details.
+# If you want to use Berkeley DB version 1, then 1.85 and 1.86 are the
+# last versions that were released. Berkeley DB version 2 is continually
+# being updated -- Check out http://www.sleepycat.com/ for more details.
#
EOM
}
-print "1..66\n";
+print "1..78\n";
my $Dfile = "recno.tmp";
unlink $Dfile ;
@@ -93,12 +108,12 @@ my $X ;
my @h ;
ok(17, $X = tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) ;
-ok(18, ((stat($Dfile))[2] & 0777) == (($^O eq 'os2' || $^O eq 'MSWin32') ? 0666 : 0640)
- || $^O eq 'amigaos') ;
+ok(18, ((stat($Dfile))[2] & 0777) == ($^O eq 'os2' ? 0666 : 0640)
+ || $^O eq 'MSWin32' || $^O eq 'amigaos') ;
#my $l = @h ;
my $l = $X->length ;
-ok(19, !$l );
+ok(19, ($FA ? @h == 0 : !$l) );
my @data = qw( a b c d ever f g h i j k longername m n o p) ;
@@ -113,7 +128,7 @@ unshift (@data, 'a') ;
ok(21, defined $h[1] );
ok(22, ! defined $h[16] );
-ok(23, $X->length == @data );
+ok(23, $FA ? @h == @data : $X->length == @data );
# Overwrite an entry & check fetch it
@@ -123,8 +138,7 @@ ok(24, $h[3] eq 'replaced' );
#PUSH
my @push_data = qw(added to the end) ;
-#my push (@h, @push_data) ;
-$X->push(@push_data) ;
+($FA ? push(@h, @push_data) : $X->push(@push_data)) ;
push (@data, @push_data) ;
ok(25, $h[++$i] eq 'added' );
ok(26, $h[++$i] eq 'to' );
@@ -133,27 +147,24 @@ ok(28, $h[++$i] eq 'end' );
# POP
my $popped = pop (@data) ;
-#my $value = pop(@h) ;
-my $value = $X->pop ;
+my $value = ($FA ? pop @h : $X->pop) ;
ok(29, $value eq $popped) ;
# SHIFT
-#$value = shift @h
-$value = $X->shift ;
+$value = ($FA ? shift @h : $X->shift) ;
my $shifted = shift @data ;
ok(30, $value eq $shifted );
# UNSHIFT
# empty list
-$X->unshift ;
-ok(31, $X->length == @data );
+($FA ? unshift @h : $X->unshift) ;
+ok(31, ($FA ? @h == @data : $X->length == @data ));
my @new_data = qw(add this to the start of the array) ;
-#unshift @h, @new_data ;
-$X->unshift (@new_data) ;
+$FA ? unshift (@h, @new_data) : $X->unshift (@new_data) ;
unshift (@data, @new_data) ;
-ok(32, $X->length == @data );
+ok(32, $FA ? @h == @data : $X->length == @data );
ok(33, $h[0] eq "add") ;
ok(34, $h[1] eq "this") ;
ok(35, $h[2] eq "to") ;
@@ -180,15 +191,15 @@ ok(42, $ok );
# get the last element of the array
ok(43, $h[-1] eq $data[-1] );
-ok(44, $h[-1] eq $h[$X->length -1] );
+ok(44, $h[-1] eq $h[ ($FA ? @h : $X->length) -1] );
# get the first element using a negative subscript
-eval '$h[ - ( $X->length)] = "abcd"' ;
+eval '$h[ - ( $FA ? @h : $X->length)] = "abcd"' ;
ok(45, $@ eq "" );
ok(46, $h[0] eq "abcd" );
# now try to read before the start of the array
-eval '$h[ - (1 + $X->length)] = 1234' ;
+eval '$h[ - (1 + ($FA ? @h : $X->length))] = 1234' ;
ok(47, $@ =~ '^Modification of non-creatable array value attempted' );
# IMPORTANT - $X must be undefined before the untie otherwise the
@@ -350,7 +361,7 @@ EOM
close FILE ;
- BEGIN { push @INC, '.'; }
+ BEGIN { push @INC, '.'; }
eval 'use SubDB ; ';
main::ok(57, $@ eq "") ;
my @h ;
@@ -378,8 +389,67 @@ EOM
main::ok(65, $@ eq "") ;
main::ok(66, $ret eq "[[11]]") ;
+ undef $X;
+ untie(@h);
unlink "SubDB.pm", "recno.tmp" ;
}
+{
+
+ # test $#
+ my $self ;
+ unlink $Dfile;
+ ok(67, $self = tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) ;
+ $h[0] = "abc" ;
+ $h[1] = "def" ;
+ $h[2] = "ghi" ;
+ $h[3] = "jkl" ;
+ ok(68, $FA ? $#h == 3 : $self->length() == 4) ;
+ undef $self ;
+ untie @h ;
+ my $x = docat($Dfile) ;
+ ok(69, $x eq "abc\ndef\nghi\njkl\n") ;
+
+ # $# sets array to same length
+ ok(70, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ;
+ if ($FA)
+ { $#h = 3 }
+ else
+ { $self->STORESIZE(4) }
+ ok(71, $FA ? $#h == 3 : $self->length() == 4) ;
+ undef $self ;
+ untie @h ;
+ $x = docat($Dfile) ;
+ ok(72, $x eq "abc\ndef\nghi\njkl\n") ;
+
+ # $# sets array to bigger
+ ok(73, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ;
+ if ($FA)
+ { $#h = 6 }
+ else
+ { $self->STORESIZE(7) }
+ ok(74, $FA ? $#h == 6 : $self->length() == 7) ;
+ undef $self ;
+ untie @h ;
+ $x = docat($Dfile) ;
+ ok(75, $x eq "abc\ndef\nghi\njkl\n\n\n\n") ;
+
+ # $# sets array smaller
+ ok(76, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ;
+ if ($FA)
+ { $#h = 2 }
+ else
+ { $self->STORESIZE(3) }
+ ok(77, $FA ? $#h == 2 : $self->length() == 3) ;
+ undef $self ;
+ untie @h ;
+ $x = docat($Dfile) ;
+ ok(78, $x eq "abc\ndef\nghi\n") ;
+
+ unlink $Dfile;
+
+
+}
+
exit ;
diff --git a/gnu/usr.bin/perl/t/lib/dosglob.t b/gnu/usr.bin/perl/t/lib/dosglob.t
index 7398a140652..577d4eac22b 100644
--- a/gnu/usr.bin/perl/t/lib/dosglob.t
+++ b/gnu/usr.bin/perl/t/lib/dosglob.t
@@ -9,7 +9,7 @@ BEGIN {
@INC = '../lib';
}
-print "1..9\n";
+print "1..10\n";
# override it in main::
use File::DosGlob 'glob';
@@ -92,3 +92,21 @@ while (<*/a*.t>) {
print "not " if "@r" ne "@s";
print "ok 9\n";
+# how about a global override, hm?
+eval <<'EOT';
+use File::DosGlob 'GLOBAL_glob';
+package Bar;
+@s = ();
+while (<*/a*.t>) {
+ my $i = 0;
+ print "# $_ <";
+ push @s, $_;
+ while (glob '*/b*.t') {
+ print " $_";
+ $i++;
+ }
+ print " >\n";
+}
+print "not " if "@r" ne "@s";
+print "ok 10\n";
+EOT
diff --git a/gnu/usr.bin/perl/t/lib/filecopy.t b/gnu/usr.bin/perl/t/lib/filecopy.t
index b718215a1e4..329931f4b41 100644
--- a/gnu/usr.bin/perl/t/lib/filecopy.t
+++ b/gnu/usr.bin/perl/t/lib/filecopy.t
@@ -13,6 +13,7 @@ use File::Copy;
# First we create a file
open(F, ">file-$$") or die;
+binmode F; # for DOSISH platforms, because test 3 copies to stdout
print F "ok 3\n";
close F;
@@ -28,6 +29,7 @@ print "ok 1\n";
print "not " unless $foo eq "ok 3\n";
print "ok 2\n";
+binmode STDOUT unless $^O eq 'VMS'; # Copy::copy works in binary mode
copy "copy-$$", \*STDOUT;
unlink "copy-$$" or die "unlink: $!";
diff --git a/gnu/usr.bin/perl/t/lib/filefind.t b/gnu/usr.bin/perl/t/lib/filefind.t
index 21e29a2d7fb..cd2e9771c7a 100644
--- a/gnu/usr.bin/perl/t/lib/filefind.t
+++ b/gnu/usr.bin/perl/t/lib/filefind.t
@@ -5,9 +5,10 @@ BEGIN {
@INC = '../lib';
}
-print "1..1\n";
+print "1..2\n";
use File::Find;
# hope we will eventually find ourself
find(sub { print "ok 1\n" if $_ eq 'filefind.t'; }, ".");
+finddepth(sub { print "ok 2\n" if $_ eq 'filefind.t'; }, ".");
diff --git a/gnu/usr.bin/perl/t/lib/filehand.t b/gnu/usr.bin/perl/t/lib/filehand.t
index cedc2ebcb82..b8ec95f320e 100644
--- a/gnu/usr.bin/perl/t/lib/filehand.t
+++ b/gnu/usr.bin/perl/t/lib/filehand.t
@@ -31,7 +31,7 @@ $buffer = <$fh>;
print $buffer eq "#!./perl\n" ? "ok 3\n" : "not ok 3\n";
-ungetc $fh 65;
+ungetc $fh ord 'A';
CORE::read($fh, $buf,1);
print $buf eq 'A' ? "ok 4\n" : "not ok 4\n";
@@ -64,6 +64,12 @@ autoflush STDOUT 1;
print "not " unless ($|);
print "ok 10\n";
+if ($^O eq 'dos')
+{
+ printf("ok %d\n",11);
+ exit(0);
+}
+
($rd,$wr) = FileHandle::pipe;
if ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'MSWin32') {
diff --git a/gnu/usr.bin/perl/t/lib/gdbm.t b/gnu/usr.bin/perl/t/lib/gdbm.t
index 53b0351ed3a..3aad81d5edf 100644
--- a/gnu/usr.bin/perl/t/lib/gdbm.t
+++ b/gnu/usr.bin/perl/t/lib/gdbm.t
@@ -1,6 +1,6 @@
#!./perl
-# $RCSfile: gdbm.t,v $$Revision: 1.2 $$Date: 1997/11/30 08:00:31 $
+# $RCSfile: gdbm.t,v $$Revision: 1.3 $$Date: 1999/04/29 22:52:30 $
BEGIN {
@INC = '../lib';
@@ -24,8 +24,8 @@ $Dfile = "Op.dbmx.pag";
if (! -e $Dfile) {
($Dfile) = <Op.dbmx*>;
}
-if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') {
- print "ok 2\n";
+if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') {
+ print "ok 2 # Skipped: different file permission semantics\n";
}
else {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
@@ -87,7 +87,7 @@ delete $h{'goner3'};
if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
-while (($key,$value) = each(h)) {
+while (($key,$value) = each(%h)) {
if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
$key =~ y/a-z/A-Z/;
$i++ if $key eq $value;
@@ -96,7 +96,7 @@ while (($key,$value) = each(h)) {
if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
-@keys = ('blurfl', keys(h), 'dyick');
+@keys = ('blurfl', keys(%h), 'dyick');
if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
$h{'foo'} = '';
@@ -201,6 +201,8 @@ EOM
main::ok(19, $@ eq "") ;
main::ok(20, $ret eq "[[5]]") ;
+ undef $X;
+ untie(%h);
unlink "SubDB.pm", <dbhash.tmp*> ;
}
diff --git a/gnu/usr.bin/perl/t/lib/io_pipe.t b/gnu/usr.bin/perl/t/lib/io_pipe.t
index eee374149ca..e617c92432f 100644
--- a/gnu/usr.bin/perl/t/lib/io_pipe.t
+++ b/gnu/usr.bin/perl/t/lib/io_pipe.t
@@ -41,6 +41,13 @@ print $pipe "not ok 3\n" ;
$pipe->close or print "# \$!=$!\nnot ";
print "ok 4\n";
+# Check if can fork with dynamic extensions (bug in CRT):
+if ($^O eq 'os2' and
+ system "$^X -I../lib -MOpcode -e 'defined fork or die' > /dev/null 2>&1") {
+ print "ok $_ # skipped: broken fork\n" for 5..10;
+ exit 0;
+}
+
$pipe = new IO::Pipe;
$pid = fork();
@@ -104,6 +111,7 @@ sub broken_pipe {
print $pipe "not ok 9\n";
$pipe->close;
+sleep 1;
print "ok 10\n";
diff --git a/gnu/usr.bin/perl/t/lib/io_sel.t b/gnu/usr.bin/perl/t/lib/io_sel.t
index b9c10974040..3dc651bbc24 100644
--- a/gnu/usr.bin/perl/t/lib/io_sel.t
+++ b/gnu/usr.bin/perl/t/lib/io_sel.t
@@ -49,7 +49,7 @@ $sel->remove([\*STDOUT, 5]);
print "not " unless $sel->count == 0 && !defined($sel->bits);
print "ok 9\n";
-if ($^O eq 'MSWin32') { # 4-arg select is only valid on sockets
+if ($^O eq 'MSWin32' || $^O eq 'dos') { # 4-arg select is only valid on sockets
print "# skipping tests 10..15\n";
for (10 .. 15) { print "ok $_\n" }
$sel->add(\*STDOUT); # update
diff --git a/gnu/usr.bin/perl/t/lib/io_sock.t b/gnu/usr.bin/perl/t/lib/io_sock.t
index 0971e7803f0..8fc52e4026b 100644
--- a/gnu/usr.bin/perl/t/lib/io_sock.t
+++ b/gnu/usr.bin/perl/t/lib/io_sock.t
@@ -32,6 +32,13 @@ $listen = IO::Socket::INET->new(Listen => 2,
print "ok 1\n";
+# Check if can fork with dynamic extensions (bug in CRT):
+if ($^O eq 'os2' and
+ system "$^X -I../lib -MOpcode -e 'defined fork or die' > /dev/null 2>&1") {
+ print "ok $_ # skipped: broken fork\n" for 2..5;
+ exit 0;
+}
+
$port = $listen->sockport;
if($pid = fork()) {
@@ -55,11 +62,14 @@ if($pid = fork()) {
# This can fail if localhost is undefined or the
# special 'loopback' address 127.0.0.1 is not configured
# on your system. (/etc/rc.config.d/netconfig on HP-UX.)
+ # As a shortcut (not recommended) you could change 'localhost'
+ # here to be the name of this machine eg 'myhost.mycompany.com'.
$sock = IO::Socket::INET->new(PeerPort => $port,
Proto => 'tcp',
PeerAddr => 'localhost'
- ) or die "$!";
+ )
+ or die "$! (maybe your system does not have the 'localhost' address defined)";
$sock->autoflush(1);
diff --git a/gnu/usr.bin/perl/t/lib/io_tell.t b/gnu/usr.bin/perl/t/lib/io_tell.t
index d8ebae24fd0..2009d610db0 100644
--- a/gnu/usr.bin/perl/t/lib/io_tell.t
+++ b/gnu/usr.bin/perl/t/lib/io_tell.t
@@ -27,7 +27,7 @@ print "1..13\n";
use IO::File;
$tst = IO::File->new("$tell_file","r") || die("Can't open $tell_file");
-binmode $tst if $^O eq 'MSWin32';
+binmode $tst if ($^O eq 'MSWin32' or $^O eq 'dos');
if ($tst->eof) { print "not ok 1\n"; } else { print "ok 1\n"; }
$firstline = <$tst>;
diff --git a/gnu/usr.bin/perl/t/lib/io_udp.t b/gnu/usr.bin/perl/t/lib/io_udp.t
index 3e167141182..ad2632d9812 100644
--- a/gnu/usr.bin/perl/t/lib/io_udp.t
+++ b/gnu/usr.bin/perl/t/lib/io_udp.t
@@ -13,7 +13,7 @@ BEGIN {
if(-d "lib" && -f "TEST") {
if ( ($Config{'extensions'} !~ /\bSocket\b/ ||
$Config{'extensions'} !~ /\bIO\b/ ||
- $^O eq 'os2') &&
+ ($^O eq 'os2') || $^O eq 'apollo') &&
!(($^O eq 'VMS') && $Config{d_socket})) {
print "1..0\n";
exit 0;
@@ -30,9 +30,13 @@ use IO::Socket qw(AF_INET SOCK_DGRAM INADDR_ANY);
# This can fail if localhost is undefined or the
# special 'loopback' address 127.0.0.1 is not configured
# on your system. (/etc/rc.config.d/netconfig on HP-UX.)
+ # As a shortcut (not recommended) you could change 'localhost'
+ # here to be the name of this machine eg 'myhost.mycompany.com'.
-$udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost');
-$udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost');
+$udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+ or die "$! (maybe your system does not have the 'localhost' address defined)";
+$udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+ or die "$! (maybe your system does not have the 'localhost' address defined)";
print "ok 1\n";
diff --git a/gnu/usr.bin/perl/t/lib/ndbm.t b/gnu/usr.bin/perl/t/lib/ndbm.t
index e9f88bcef51..a7a43d9f669 100644
--- a/gnu/usr.bin/perl/t/lib/ndbm.t
+++ b/gnu/usr.bin/perl/t/lib/ndbm.t
@@ -1,6 +1,6 @@
#!./perl
-# $RCSfile: ndbm.t,v $$Revision: 1.2 $$Date: 1997/11/30 08:04:58 $
+# $RCSfile: ndbm.t,v $$Revision: 1.3 $$Date: 1999/04/29 22:52:31 $
BEGIN {
chdir 't' if -d 't';
@@ -28,7 +28,7 @@ if (! -e $Dfile) {
($Dfile) = <Op.dbmx*>;
}
if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') {
- print "ok 2\n";
+ print "ok 2 # Skipped: different file permission semantics\n";
}
else {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
@@ -90,7 +90,7 @@ delete $h{'goner3'};
if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
-while (($key,$value) = each(h)) {
+while (($key,$value) = each(%h)) {
if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
$key =~ y/a-z/A-Z/;
$i++ if $key eq $value;
@@ -99,7 +99,7 @@ while (($key,$value) = each(h)) {
if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
-@keys = ('blurfl', keys(h), 'dyick');
+@keys = ('blurfl', keys(%h), 'dyick');
if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
$h{'foo'} = '';
@@ -200,6 +200,8 @@ EOM
main::ok(17, $@ eq "") ;
main::ok(18, $ret eq "[[5]]") ;
+ undef $X;
+ untie(%h);
unlink "SubDB.pm", <dbhash.tmp*> ;
}
diff --git a/gnu/usr.bin/perl/t/lib/odbm.t b/gnu/usr.bin/perl/t/lib/odbm.t
index da2f885bc7b..292e59b0cce 100644
--- a/gnu/usr.bin/perl/t/lib/odbm.t
+++ b/gnu/usr.bin/perl/t/lib/odbm.t
@@ -1,6 +1,6 @@
#!./perl
-# $RCSfile: odbm.t,v $$Revision: 1.2 $$Date: 1997/11/30 08:04:59 $
+# $RCSfile: odbm.t,v $$Revision: 1.3 $$Date: 1999/04/29 22:52:32 $
BEGIN {
chdir 't' if -d 't';
@@ -28,7 +28,7 @@ if (! -e $Dfile) {
($Dfile) = <Op.dbmx*>;
}
if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') {
- print "ok 2\n";
+ print "ok 2 # Skipped: different file permission semantics\n";
}
else {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
@@ -90,7 +90,7 @@ delete $h{'goner3'};
if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
-while (($key,$value) = each(h)) {
+while (($key,$value) = each(%h)) {
if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
$key =~ y/a-z/A-Z/;
$i++ if $key eq $value;
@@ -99,7 +99,7 @@ while (($key,$value) = each(h)) {
if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
-@keys = ('blurfl', keys(h), 'dyick');
+@keys = ('blurfl', keys(%h), 'dyick');
if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
$h{'foo'} = '';
@@ -200,6 +200,8 @@ EOM
main::ok(17, $@ eq "") ;
main::ok(18, $ret eq "[[5]]") ;
+ undef $X;
+ untie(%h);
unlink "SubDB.pm", <dbhash.tmp*> ;
}
diff --git a/gnu/usr.bin/perl/t/lib/open2.t b/gnu/usr.bin/perl/t/lib/open2.t
index a2e6a07a7b0..85b807c98aa 100644
--- a/gnu/usr.bin/perl/t/lib/open2.t
+++ b/gnu/usr.bin/perl/t/lib/open2.t
@@ -4,7 +4,10 @@ BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
- unless ($Config{'d_fork'}) {
+ if (!$Config{'d_fork'}
+ # open2/3 supported on win32 (but not Borland due to CRT bugs)
+ && ($^O ne 'MSWin32' || $Config{'cc'} =~ /^bcc/i))
+ {
print "1..0\n";
exit 0;
}
@@ -25,20 +28,30 @@ sub ok {
print "ok $n\n";
}
else {
- print "not ok $n\n";
+ print "not ok $n\n";
print "# $info\n" if $info;
}
}
+sub cmd_line {
+ if ($^O eq 'MSWin32') {
+ return qq/"$_[0]"/;
+ }
+ else {
+ return $_[0];
+ }
+}
+
my ($pid, $reaped_pid);
STDOUT->autoflush;
STDERR->autoflush;
print "1..7\n";
-ok 1, $pid = open2 'READ', 'WRITE', $perl, '-e', 'print scalar <STDIN>';
+ok 1, $pid = open2 'READ', 'WRITE', $perl, '-e',
+ cmd_line('print scalar <STDIN>');
ok 2, print WRITE "hi kid\n";
-ok 3, <READ> eq "hi kid\n";
+ok 3, <READ> =~ /^hi kid\r?\n$/;
ok 4, close(WRITE), $!;
ok 5, close(READ), $!;
$reaped_pid = waitpid $pid, 0;
diff --git a/gnu/usr.bin/perl/t/lib/open3.t b/gnu/usr.bin/perl/t/lib/open3.t
index 4258eec4018..b84dac9f141 100644
--- a/gnu/usr.bin/perl/t/lib/open3.t
+++ b/gnu/usr.bin/perl/t/lib/open3.t
@@ -4,7 +4,10 @@ BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
- unless ($Config{'d_fork'}) {
+ if (!$Config{'d_fork'}
+ # open2/3 supported on win32 (but not Borland due to CRT bugs)
+ && ($^O ne 'MSWin32' || $Config{'cc'} =~ /^bcc/i))
+ {
print "1..0\n";
exit 0;
}
@@ -25,11 +28,23 @@ sub ok {
print "ok $n\n";
}
else {
- print "not ok $n\n";
+ print "not ok $n\n";
print "# $info\n" if $info;
}
}
+sub cmd_line {
+ if ($^O eq 'MSWin32') {
+ my $cmd = shift;
+ $cmd =~ tr/\r\n//d;
+ $cmd =~ s/"/\\"/g;
+ return qq/"$cmd"/;
+ }
+ else {
+ return $_[0];
+ }
+}
+
my ($pid, $reaped_pid);
STDOUT->autoflush;
STDERR->autoflush;
@@ -37,14 +52,14 @@ STDERR->autoflush;
print "1..21\n";
# basic
-ok 1, $pid = open3 'WRITE', 'READ', 'ERROR', $perl, '-e', <<'EOF';
+ok 1, $pid = open3 'WRITE', 'READ', 'ERROR', $perl, '-e', cmd_line(<<'EOF');
$| = 1;
print scalar <STDIN>;
print STDERR "hi error\n";
EOF
ok 2, print WRITE "hi kid\n";
-ok 3, <READ> eq "hi kid\n";
-ok 4, <ERROR> eq "hi error\n";
+ok 3, <READ> =~ /^hi kid\r?\n$/;
+ok 4, <ERROR> =~ /^hi error\r?\n$/;
ok 5, close(WRITE), $!;
ok 6, close(READ), $!;
ok 7, close(ERROR), $!;
@@ -53,7 +68,7 @@ ok 8, $reaped_pid == $pid, $reaped_pid;
ok 9, $? == 0, $?;
# read and error together, both named
-$pid = open3 'WRITE', 'READ', 'READ', $perl, '-e', <<'EOF';
+$pid = open3 'WRITE', 'READ', 'READ', $perl, '-e', cmd_line(<<'EOF');
$| = 1;
print scalar <STDIN>;
print STDERR scalar <STDIN>;
@@ -65,7 +80,7 @@ print scalar <READ>;
waitpid $pid, 0;
# read and error together, error empty
-$pid = open3 'WRITE', 'READ', '', $perl, '-e', <<'EOF';
+$pid = open3 'WRITE', 'READ', '', $perl, '-e', cmd_line(<<'EOF');
$| = 1;
print scalar <STDIN>;
print STDERR scalar <STDIN>;
@@ -79,7 +94,7 @@ waitpid $pid, 0;
# dup writer
ok 14, pipe PIPE_READ, PIPE_WRITE;
$pid = open3 '<&PIPE_READ', 'READ', '',
- $perl, '-e', 'print scalar <STDIN>';
+ $perl, '-e', cmd_line('print scalar <STDIN>');
close PIPE_READ;
print PIPE_WRITE "ok 15\n";
close PIPE_WRITE;
@@ -88,7 +103,7 @@ waitpid $pid, 0;
# dup reader
$pid = open3 'WRITE', '>&STDOUT', 'ERROR',
- $perl, '-e', 'print scalar <STDIN>';
+ $perl, '-e', cmd_line('print scalar <STDIN>');
print WRITE "ok 16\n";
waitpid $pid, 0;
@@ -96,12 +111,12 @@ waitpid $pid, 0;
# stdout but putting stdout somewhere else, is a good case because it
# used not to work.
$pid = open3 'WRITE', 'READ', '>&STDOUT',
- $perl, '-e', 'print STDERR scalar <STDIN>';
+ $perl, '-e', cmd_line('print STDERR scalar <STDIN>');
print WRITE "ok 17\n";
waitpid $pid, 0;
# dup reader and error together, both named
-$pid = open3 'WRITE', '>&STDOUT', '>&STDOUT', $perl, '-e', <<'EOF';
+$pid = open3 'WRITE', '>&STDOUT', '>&STDOUT', $perl, '-e', cmd_line(<<'EOF');
$| = 1;
print STDOUT scalar <STDIN>;
print STDERR scalar <STDIN>;
@@ -111,7 +126,7 @@ print WRITE "ok 19\n";
waitpid $pid, 0;
# dup reader and error together, error empty
-$pid = open3 'WRITE', '>&STDOUT', '', $perl, '-e', <<'EOF';
+$pid = open3 'WRITE', '>&STDOUT', '', $perl, '-e', cmd_line(<<'EOF');
$| = 1;
print STDOUT scalar <STDIN>;
print STDERR scalar <STDIN>;
diff --git a/gnu/usr.bin/perl/t/lib/parsewords.t b/gnu/usr.bin/perl/t/lib/parsewords.t
index 47a75881dc7..3c5e75b187f 100644
--- a/gnu/usr.bin/perl/t/lib/parsewords.t
+++ b/gnu/usr.bin/perl/t/lib/parsewords.t
@@ -5,24 +5,104 @@ BEGIN {
@INC = '../lib';
}
-print "1..4\n";
-
use Text::ParseWords;
-@words = shellwords(qq(foo "bar quiz" zoo));
-#print join(";", @words), "\n";
+print "1..18\n";
+@words = shellwords(qq(foo "bar quiz" zoo));
print "not " if $words[0] ne 'foo';
print "ok 1\n";
-
print "not " if $words[1] ne 'bar quiz';
print "ok 2\n";
-
print "not " if $words[2] ne 'zoo';
print "ok 3\n";
-# Test quotewords() with other parameters
-@words = quotewords(":+", 1, qq(foo:::"bar:foo":zoo zoo:));
-#print join(";", @words), "\n";
-print "not " unless join(";", @words) eq qq(foo;"bar:foo";zoo zoo);
+# Gonna get some undefined things back
+local($^W) = 0;
+
+# Test quotewords() with other parameters and null last field
+@words = quotewords(':+', 1, 'foo:::"bar:foo":zoo zoo:');
+print "not " unless join(";", @words) eq qq(foo;"bar:foo";zoo zoo;);
print "ok 4\n";
+
+$^W = 1;
+
+# Test $keep eq 'delimiters' and last field zero
+@words = quotewords('\s+', 'delimiters', '4 3 2 1 0');
+print "not " unless join(";", @words) eq qq(4; ;3; ;2; ;1; ;0);
+print "ok 5\n";
+
+# Big ol' nasty test (thanks, Joerk!)
+$string = 'aaaa"bbbbb" cc\\ cc \\\\\\"dddd" eee\\\\\\"ffff" "gg"';
+
+# First with $keep == 1
+$result = join('|', parse_line('\s+', 1, $string));
+print "not " unless $result eq 'aaaa"bbbbb"|cc\\ cc|\\\\\\"dddd" eee\\\\\\"ffff"|"gg"';
+print "ok 6\n";
+
+# Now, $keep == 0
+$result = join('|', parse_line('\s+', 0, $string));
+print "not " unless $result eq 'aaaabbbbb|cc cc|\\"dddd eee\\"ffff|gg';
+print "ok 7\n";
+
+# Now test single quote behavior
+$string = 'aaaa"bbbbb" cc\\ cc \\\\\\"dddd\' eee\\\\\\"ffff\' gg';
+$result = join('|', parse_line('\s+', 0, $string));
+print "not " unless $result eq 'aaaabbbbb|cc cc|\\"dddd eee\\\\\\"ffff|gg';
+print "ok 8\n";
+
+# Make sure @nested_quotewords does the right thing
+@lists = nested_quotewords('\s+', 0, 'a b c', '1 2 3', 'x y z');
+print "not " unless (@lists == 3 && @{$lists[0]} == 3 && @{$lists[1]} == 3 && @{$lists[2]} == 3);
+print "ok 9\n";
+
+# Now test error return
+$string = 'foo bar baz"bach blech boop';
+
+@words = shellwords($string);
+print "not " if (@words);
+print "ok 10\n";
+
+@words = parse_line('s+', 0, $string);
+print "not " if (@words);
+print "ok 11\n";
+
+@words = quotewords('s+', 0, $string);
+print "not " if (@words);
+print "ok 12\n";
+
+# Gonna get some more undefined things back
+$^W = 0;
+
+@words = nested_quotewords('s+', 0, $string);
+print "not " if (@words);
+print "ok 13\n";
+
+# Now test empty fields
+$result = join('|', parse_line(':', 0, 'foo::0:"":::'));
+print "not " unless ($result eq 'foo||0||||');
+print "ok 14\n";
+
+# Test for 0 in quotes without $keep
+$result = join('|', parse_line(':', 0, ':"0":'));
+print "not " unless ($result eq '|0|');
+print "ok 15\n";
+
+# Test for \001 in quoted string
+$result = join('|', parse_line(':', 0, ':"' . "\001" . '":'));
+print "not " unless ($result eq "|\1|");
+print "ok 16\n";
+
+$^W = 1;
+
+# Now test perlish single quote behavior
+$Text::ParseWords::PERL_SINGLE_QUOTE = 1;
+$string = 'aaaa"bbbbb" cc\ cc \\\\\"dddd\' eee\\\\\"\\\'ffff\' gg';
+$result = join('|', parse_line('\s+', 0, $string));
+print "not " unless $result eq 'aaaabbbbb|cc cc|\"dddd eee\\\\"\'ffff|gg';
+print "ok 17\n";
+
+# test whitespace in the delimiters
+@words = quotewords(' ', 1, '4 3 2 1 0');
+print "not " unless join(";", @words) eq qq(4;3;2;1;0);
+print "ok 18\n";
diff --git a/gnu/usr.bin/perl/t/lib/posix.t b/gnu/usr.bin/perl/t/lib/posix.t
index 6ae88c0dd20..f6d8e9287b2 100644
--- a/gnu/usr.bin/perl/t/lib/posix.t
+++ b/gnu/usr.bin/perl/t/lib/posix.t
@@ -10,11 +10,13 @@ BEGIN {
}
}
-use POSIX qw(fcntl_h signal_h limits_h _exit getcwd open read write);
+use POSIX qw(fcntl_h signal_h limits_h _exit getcwd open read strftime write);
use strict subs;
$| = 1;
-print "1..17\n";
+print "1..18\n";
+
+$Is_W32 = $^O eq 'MSWin32';
$testfd = open("TEST", O_RDONLY, 0) and print "ok 1\n";
read($testfd, $buffer, 9) if $testfd > 2;
@@ -31,6 +33,12 @@ close $writer;
print <$reader>;
close $reader;
+if ($Is_W32) {
+ for (6..11) {
+ print "ok $_ # skipped, no sigaction support on win32\n";
+ }
+}
+else {
$sigset = new POSIX::SigSet 1,3;
delset $sigset 1;
if (!ismember $sigset 1) { print "ok 6\n" }
@@ -53,6 +61,7 @@ sub SigHUP {
sub SigINT {
print "ok 10\n";
}
+}
print &_POSIX_OPEN_MAX > $fds[1] ? "ok 12\n" : "not ok 12\n";
@@ -80,6 +89,13 @@ if ($Config{d_strtoul}) {
# Pick up whether we're really able to dynamically load everything.
print &POSIX::acos(1.0) == 0.0 ? "ok 17\n" : "not ok 17\n";
+# This can coredump if struct tm has a timezone field and we
+# didn't detect it. If this fails, try adding
+# -DSTRUCT_TM_HASZONE to your cflags when compiling ext/POSIX/POSIX.c.
+# See ext/POSIX/hints/sunos_4.pl and ext/POSIX/hints/linux.pl
+print POSIX::strftime("ok 18 # %H:%M, on %D\n", localtime());
+
$| = 0;
-print '@#!*$@(!@#$';
+# The following line assumes buffered output, which may be not true with EMX:
+print '@#!*$@(!@#$' unless ($^O eq 'os2' || $^O eq 'uwin' || $^O eq 'os390');
_exit(0);
diff --git a/gnu/usr.bin/perl/t/lib/safe2.t b/gnu/usr.bin/perl/t/lib/safe2.t
index 40c50980580..6afc1177292 100644
--- a/gnu/usr.bin/perl/t/lib/safe2.t
+++ b/gnu/usr.bin/perl/t/lib/safe2.t
@@ -8,8 +8,8 @@ BEGIN {
print "1..0\n";
exit 0;
}
- # test 30 rather naughtily expects English error messages
- $ENV{'LC_ALL'} = 'C';
+ # test 30 rather naughtily expects English error messages
+ $ENV{'LC_ALL'} = 'C';
}
# Tests Todo:
@@ -64,7 +64,8 @@ $glob = "ok 11\n";
sub sayok { print "ok @_\n" }
-$cpt->share(qw($foo %bar @baz *glob sayok $"));
+$cpt->share(qw($foo %bar @baz *glob sayok));
+$cpt->share('$"') unless $Config{archname} =~ /-thread$/;
$cpt->reval(q{
package other;
@@ -121,10 +122,9 @@ print $@ =~ /foo bar/ ? "ok 29\n" : "not ok 29\n";
my $t = 30;
$cpt->rdo('/non/existant/file.name');
-print +(($! =~ /No such file/ || $! =~ /file specification syntax error/) ||
- $! =~ /A file or directory in the path name does not exist/ ||
- $! =~ /Device not configured/ ?
- "ok $t\n" : "not ok $t # $!\n"); $t++;
+# The regexp is getting rather baroque.
+print $! =~ /No such file|file specification syntax error|A file or directory in the path name does not exist|Invalid argument|Device not configured|file not found/i ? "ok $t\n" : "not ok $t # $!\n"; $t++;
+# test #31 is gone.
print 1 ? "ok $t\n" : "not ok $t\n#$@/$!\n"; $t++;
#my $rdo_file = "tmp_rdo.tpl";
diff --git a/gnu/usr.bin/perl/t/lib/sdbm.t b/gnu/usr.bin/perl/t/lib/sdbm.t
index 7eda515adf2..6021988dc7d 100644
--- a/gnu/usr.bin/perl/t/lib/sdbm.t
+++ b/gnu/usr.bin/perl/t/lib/sdbm.t
@@ -1,12 +1,12 @@
#!./perl
-# $RCSfile: sdbm.t,v $$Revision: 1.2 $$Date: 1997/11/30 08:05:04 $
+# $RCSfile: sdbm.t,v $$Revision: 1.3 $$Date: 1999/04/29 22:52:32 $
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
- if ($Config{'extensions'} !~ /\bSDBM_File\b/) {
+ if (($Config{'extensions'} !~ /\bSDBM_File\b/) && ($^O ne 'VMS')){
print "1..0\n";
exit 0;
}
@@ -17,18 +17,18 @@ use Fcntl;
print "1..18\n";
-unlink <Op.dbmx*>;
+unlink <Op_dbmx.*>;
umask(0);
-print (tie(%h,SDBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640)
+print (tie(%h,SDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640)
? "ok 1\n" : "not ok 1\n");
-$Dfile = "Op.dbmx.pag";
+$Dfile = "Op_dbmx.pag";
if (! -e $Dfile) {
- ($Dfile) = <Op.dbmx*>;
+ ($Dfile) = <Op_dbmx.*>;
}
-if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') {
- print "ok 2\n";
+if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') {
+ print "ok 2 # Skipped: different file permission semantics\n";
}
else {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
@@ -60,7 +60,7 @@ $h{'goner2'} = 'snork';
delete $h{'goner2'};
untie(%h);
-print (tie(%h,SDBM_File,'Op.dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
+print (tie(%h,SDBM_File,'Op_dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
$h{'j'} = 'J';
$h{'k'} = 'K';
@@ -90,7 +90,7 @@ delete $h{'goner3'};
if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
-while (($key,$value) = each(h)) {
+while (($key,$value) = each(%h)) {
if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
$key =~ y/a-z/A-Z/;
$i++ if $key eq $value;
@@ -99,7 +99,7 @@ while (($key,$value) = each(h)) {
if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
-@keys = ('blurfl', keys(h), 'dyick');
+@keys = ('blurfl', keys(%h), 'dyick');
if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
$h{'foo'} = '';
@@ -123,7 +123,12 @@ print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
untie %h;
-unlink 'Op.dbmx.dir', $Dfile;
+if ($^O eq 'VMS') {
+ unlink 'Op_dbmx.sdbm_dir', $Dfile;
+} else {
+ unlink 'Op_dbmx.dir', $Dfile;
+}
+
sub ok
{
@@ -187,7 +192,7 @@ EOM
my %h ;
my $X ;
eval '
- $X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640 );
+ $X = tie(%h, "SubDB","dbhash_tmp", O_RDWR|O_CREAT, 0640 );
' ;
main::ok(14, $@ eq "") ;
@@ -200,6 +205,8 @@ EOM
main::ok(17, $@ eq "") ;
main::ok(18, $ret eq "[[5]]") ;
- unlink "SubDB.pm", <dbhash.tmp*> ;
+ undef $X;
+ untie(%h);
+ unlink "SubDB.pm", <dbhash_tmp.*> ;
}
diff --git a/gnu/usr.bin/perl/t/lib/searchdict.t b/gnu/usr.bin/perl/t/lib/searchdict.t
index 447c425b276..c36fdb8c34b 100644
--- a/gnu/usr.bin/perl/t/lib/searchdict.t
+++ b/gnu/usr.bin/perl/t/lib/searchdict.t
@@ -5,7 +5,7 @@ BEGIN {
@INC = '../lib';
}
-print "1..3\n";
+print "1..4\n";
$DICT = <<EOT;
Aarhus
@@ -44,22 +44,44 @@ open(DICT, "+>dict-$$") or die "Can't create dict-$$: $!";
binmode DICT; # To make length expected one.
print DICT $DICT;
-my $pos = look *DICT, "abash";
+my $pos = look *DICT, "Ababa";
chomp($word = <DICT>);
-print "not " if $pos < 0 || $word ne "abash";
+print "not " if $pos < 0 || $word ne "Ababa";
print "ok 1\n";
-$pos = look *DICT, "foo";
-chomp($word = <DICT>);
+if (ord('a') > ord('A') ) { # ASCII
+
+ $pos = look *DICT, "foo";
+ chomp($word = <DICT>);
+
+ print "not " if $pos != length($DICT); # will search to end of file
+ print "ok 2\n";
-print "not " if $pos != length($DICT); # will search to end of file
-print "ok 2\n";
+ my $pos = look *DICT, "abash";
+ chomp($word = <DICT>);
+ print "not " if $pos < 0 || $word ne "abash";
+ print "ok 3\n";
+
+}
+else { # EBCDIC systems e.g. os390
+
+ $pos = look *DICT, "FOO";
+ chomp($word = <DICT>);
+
+ print "not " if $pos != length($DICT); # will search to end of file
+ print "ok 2\n";
+
+ my $pos = look *DICT, "Abba";
+ chomp($word = <DICT>);
+ print "not " if $pos < 0 || $word ne "Abba";
+ print "ok 3\n";
+}
$pos = look *DICT, "aarhus", 1, 1;
chomp($word = <DICT>);
print "not " if $pos < 0 || $word ne "Aarhus";
-print "ok 3\n";
+print "ok 4\n";
close DICT or die "cannot close";
unlink "dict-$$";
diff --git a/gnu/usr.bin/perl/t/lib/soundex.t b/gnu/usr.bin/perl/t/lib/soundex.t
index 61fdad4d98d..9a2270b36a7 100644
--- a/gnu/usr.bin/perl/t/lib/soundex.t
+++ b/gnu/usr.bin/perl/t/lib/soundex.t
@@ -1,12 +1,12 @@
#!./perl
#
-# $Id: soundex.t,v 1.2 1997/11/30 08:05:07 millert Exp $
+# $Id: soundex.t,v 1.3 1999/04/29 22:52:33 millert Exp $
#
# test module for soundex.pl
#
# $Log: soundex.t,v $
-# Revision 1.2 1997/11/30 08:05:07 millert
-# perl 5.004_04
+# Revision 1.3 1999/04/29 22:52:33 millert
+# perl5.005_03 (stock)
#
# Revision 1.2 1994/03/24 00:30:27 mike
# Subtle bug (any excuse :-) spotted by Rich Pinder <rpinder@hsc.usc.edu>
diff --git a/gnu/usr.bin/perl/t/lib/textwrap.t b/gnu/usr.bin/perl/t/lib/textwrap.t
index 9c8d1b49756..c3a455b15b3 100644
--- a/gnu/usr.bin/perl/t/lib/textwrap.t
+++ b/gnu/usr.bin/perl/t/lib/textwrap.t
@@ -1,40 +1,128 @@
-#!./perl
+#!./perl -w
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
-print "1..5\n";
+@tests = (split(/\nEND\n/s, <<DONE));
+TEST1
+This
+is
+a
+test
+END
+ This
+ is
+ a
+ test
+END
+TEST2
+This is a test of a very long line. It should be broken up and put onto multiple lines.
+This is a test of a very long line. It should be broken up and put onto multiple lines.
-use Text::Wrap qw(wrap $columns);
+This is a test of a very long line. It should be broken up and put onto multiple lines.
+END
+ This is a test of a very long line. It should be broken up and put onto
+ multiple lines.
+ This is a test of a very long line. It should be broken up and put onto
+ multiple lines.
+
+ This is a test of a very long line. It should be broken up and put onto
+ multiple lines.
+END
+TEST3
+This is a test of a very long line. It should be broken up and put onto multiple lines.
+END
+ This is a test of a very long line. It should be broken up and put onto
+ multiple lines.
+END
+TEST4
+This is a test of a very long line. It should be broken up and put onto multiple lines.
-$columns = 30;
+END
+ This is a test of a very long line. It should be broken up and put onto
+ multiple lines.
-$text = <<'EOT';
-Text::Wrap is a very simple paragraph formatter. It formats a
-single paragraph at a time by breaking lines at word boundries.
-Indentation is controlled for the first line ($initial_tab) and
-all subsquent lines ($subsequent_tab) independently. $Text::Wrap::columns
-should be set to the full width of your output device.
-EOT
+END
+TEST5
+This is a test of a very long line. It should be broken up and put onto multiple This is a test of a very long line. It should be broken up and put
+END
+ This is a test of a very long line. It should be broken up and put onto
+ multiple This is a test of a very long line. It should be broken up and
+ put
+END
+TEST6
+11111111 22222222 33333333 44444444 55555555 66666666 77777777 888888888 999999999 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee ffffffff gggggggg hhhhhhhh iiiiiiii jjjjjjjj kkkkkkkk llllllll mmmmmmmmm nnnnnnnnn ooooooooo ppppppppp qqqqqqqqq rrrrrrrrr sssssssss
+END
+ 11111111 22222222 33333333 44444444 55555555 66666666 77777777 888888888
+ 999999999 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee ffffffff
+ gggggggg hhhhhhhh iiiiiiii jjjjjjjj kkkkkkkk llllllll mmmmmmmmm nnnnnnnnn
+ ooooooooo ppppppppp qqqqqqqqq rrrrrrrrr sssssssss
+END
+TEST7
+c3t1d0s6 c4t1d0s6 c5t1d0s6 c6t1d0s6 c7t1d0s6 c8t1d0s6 c9t1d0s6 c10t1d0s6 c11t1d0s6 c12t1d0s6 c13t1d0s6 c14t1d0s6 c15t1d0s6 c16t1d0s6 c3t1d0s0 c4t1d0s0 c5t1d0s0 c6t1d0s0 c7t1d0s0 c8t1d0s0 c9t1d0s0 c10t1d0s0 c11t1d0s0 c12t1d0s0 c13t1d0s0 c14t1d0s0 c15t1d0s0 c16t1d0s0
+END
+ c3t1d0s6 c4t1d0s6 c5t1d0s6 c6t1d0s6 c7t1d0s6 c8t1d0s6 c9t1d0s6 c10t1d0s6
+ c11t1d0s6 c12t1d0s6 c13t1d0s6 c14t1d0s6 c15t1d0s6 c16t1d0s6 c3t1d0s0
+ c4t1d0s0 c5t1d0s0 c6t1d0s0 c7t1d0s0 c8t1d0s0 c9t1d0s0 c10t1d0s0 c11t1d0s0
+ c12t1d0s0 c13t1d0s0 c14t1d0s0 c15t1d0s0 c16t1d0s0
+END
+TEST8
+A test of a very very long word.
+a123456789b123456789c123456789d123456789e123456789f123456789g123456789g1234567
+END
+ A test of a very very long word.
+ a123456789b123456789c123456789d123456789e123456789f123456789g123456789g123
+ 4567
+END
+TEST9
+A test of a very very long word. a123456789b123456789c123456789d123456789e123456789f123456789g123456789g1234567
+END
+ A test of a very very long word.
+ a123456789b123456789c123456789d123456789e123456789f123456789g123456789g123
+ 4567
+END
+DONE
-$text =~ s/\n/ /g;
-$_ = wrap "| ", "|", $text;
-#print "$_\n";
+$| = 1;
-print "not " unless /^\| Text::Wrap is/; # start is ok
-print "ok 1\n";
+print "1..", @tests/2, "\n";
-print "not " if /^.{31,}$/m; # no line longer than 30 chars
-print "ok 2\n";
+use Text::Wrap;
-print "not " unless /^\|\w/m; # other lines start with
-print "ok 3\n";
+$rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1;
-print "not " unless /\bsubsquent\b/; # look for a random word
-print "ok 4\n";
+$tn = 1;
+while (@tests) {
+ my $in = shift(@tests);
+ my $out = shift(@tests);
-print "not " unless /\bdevice\./; # look for last word
-print "ok 5\n";
+ $in =~ s/^TEST(\d+)?\n//;
+
+ my $back = wrap(' ', ' ', $in);
+
+ if ($back eq $out) {
+ print "ok $tn\n";
+ } elsif ($rerun) {
+ my $oi = $in;
+ foreach ($in, $back, $out) {
+ s/\t/^I\t/gs;
+ s/\n/\$\n/gs;
+ }
+ print "------------ input ------------\n";
+ print $in;
+ print "\n------------ output -----------\n";
+ print $back;
+ print "\n------------ expected ---------\n";
+ print $out;
+ print "\n-------------------------------\n";
+ $Text::Wrap::debug = 1;
+ wrap(' ', ' ', $oi);
+ exit(1);
+ } else {
+ print "not ok $tn\n";
+ }
+ $tn++;
+}
diff --git a/gnu/usr.bin/perl/t/lib/timelocal.t b/gnu/usr.bin/perl/t/lib/timelocal.t
index adc1b1b0615..100e0768aa4 100644
--- a/gnu/usr.bin/perl/t/lib/timelocal.t
+++ b/gnu/usr.bin/perl/t/lib/timelocal.t
@@ -11,7 +11,7 @@ use Time::Local;
@time =
(
#year,mon,day,hour,min,sec
- [1970, 1, 1, 00, 00, 00],
+ [1970, 1, 2, 00, 00, 00],
[1980, 2, 28, 12, 00, 00],
[1980, 2, 29, 12, 00, 00],
[1999, 12, 31, 23, 59, 59],
@@ -19,6 +19,9 @@ use Time::Local;
[2010, 10, 12, 14, 13, 12],
);
+# use vmsish 'time' makes for oddness around the Unix epoch
+if ($^O eq 'VMS') { $time[0][2]++ }
+
print "1..", @time * 2 + 5, "\n";
$count = 1;
diff --git a/gnu/usr.bin/perl/t/lib/trig.t b/gnu/usr.bin/perl/t/lib/trig.t
index c2bc2a8b5bc..3114176ab0b 100644
--- a/gnu/usr.bin/perl/t/lib/trig.t
+++ b/gnu/usr.bin/perl/t/lib/trig.t
@@ -21,11 +21,15 @@ use vars qw($x $y $z);
my $eps = 1e-11;
+if ($^O eq 'unicos') { # See lib/Math/Complex.pm and t/lib/complex.t.
+ $eps = 1e-10;
+}
+
sub near ($$;$) {
abs($_[0] - $_[1]) < (defined $_[2] ? $_[2] : $eps);
}
-print "1..7\n";
+print "1..20\n";
$x = 0.9;
print 'not ' unless (near(tan($x), sin($x) / cos($x)));
@@ -54,4 +58,103 @@ print "ok 6\n";
print 'not ' unless (near(rad2deg(pi), 180));
print "ok 7\n";
+use Math::Trig ':radial';
+
+{
+ my ($r,$t,$z) = cartesian_to_cylindrical(1,1,1);
+
+ print 'not ' unless (near($r, sqrt(2))) and
+ (near($t, deg2rad(45))) and
+ (near($z, 1));
+ print "ok 8\n";
+
+ ($x,$y,$z) = cylindrical_to_cartesian($r, $t, $z);
+
+ print 'not ' unless (near($x, 1)) and
+ (near($y, 1)) and
+ (near($z, 1));
+ print "ok 9\n";
+
+ ($r,$t,$z) = cartesian_to_cylindrical(1,1,0);
+
+ print 'not ' unless (near($r, sqrt(2))) and
+ (near($t, deg2rad(45))) and
+ (near($z, 0));
+ print "ok 10\n";
+
+ ($x,$y,$z) = cylindrical_to_cartesian($r, $t, $z);
+
+ print 'not ' unless (near($x, 1)) and
+ (near($y, 1)) and
+ (near($z, 0));
+ print "ok 11\n";
+}
+
+{
+ my ($r,$t,$f) = cartesian_to_spherical(1,1,1);
+
+ print 'not ' unless (near($r, sqrt(3))) and
+ (near($t, deg2rad(45))) and
+ (near($f, atan2(sqrt(2), 1)));
+ print "ok 12\n";
+
+ ($x,$y,$z) = spherical_to_cartesian($r, $t, $f);
+
+ print 'not ' unless (near($x, 1)) and
+ (near($y, 1)) and
+ (near($z, 1));
+ print "ok 13\n";
+
+ ($r,$t,$f) = cartesian_to_spherical(1,1,0);
+
+ print 'not ' unless (near($r, sqrt(2))) and
+ (near($t, deg2rad(45))) and
+ (near($f, deg2rad(90)));
+ print "ok 14\n";
+
+ ($x,$y,$z) = spherical_to_cartesian($r, $t, $f);
+
+ print 'not ' unless (near($x, 1)) and
+ (near($y, 1)) and
+ (near($z, 0));
+ print "ok 15\n";
+}
+
+{
+ my ($r,$t,$z) = cylindrical_to_spherical(spherical_to_cylindrical(1,1,1));
+
+ print 'not ' unless (near($r, 1)) and
+ (near($t, 1)) and
+ (near($z, 1));
+ print "ok 16\n";
+
+ ($r,$t,$z) = spherical_to_cylindrical(cylindrical_to_spherical(1,1,1));
+
+ print 'not ' unless (near($r, 1)) and
+ (near($t, 1)) and
+ (near($z, 1));
+ print "ok 17\n";
+}
+
+{
+ use Math::Trig 'great_circle_distance';
+
+ print 'not '
+ unless (near(great_circle_distance(0, 0, 0, pi/2), pi/2));
+ print "ok 18\n";
+
+ print 'not '
+ unless (near(great_circle_distance(0, 0, pi, pi), pi));
+ print "ok 19\n";
+
+ # London to Tokyo.
+ my @L = (deg2rad(-0.5), deg2rad(90 - 51.3));
+ my @T = (deg2rad(139.8),deg2rad(90 - 35.7));
+
+ my $km = great_circle_distance(@L, @T, 6378);
+
+ print 'not ' unless (near($km, 9605.26637021388));
+ print "ok 20\n";
+}
+
# eof
diff --git a/gnu/usr.bin/perl/t/op/array.t b/gnu/usr.bin/perl/t/op/array.t
index ed471b4c4d7..34095563967 100644
--- a/gnu/usr.bin/perl/t/op/array.t
+++ b/gnu/usr.bin/perl/t/op/array.t
@@ -1,8 +1,10 @@
#!./perl
-# $RCSfile: array.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:37 $
+print "1..65\n";
-print "1..36\n";
+#
+# @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
+#
@ary = (1,2,3,4,5);
if (join('',@ary) eq '12345') {print "ok 1\n";} else {print "not ok 1\n";}
@@ -118,3 +120,94 @@ print $foo eq 'e' ? "ok 35\n" : "not ok 35\n";
$foo = ('a','b','c','d','e','f')[1];
print $foo eq 'b' ? "ok 36\n" : "not ok 36\n";
+
+@foo = ( 'foo', 'bar', 'burbl');
+push(foo, 'blah');
+print $#foo == 3 ? "ok 37\n" : "not ok 37\n";
+
+# various AASSIGN_COMMON checks (see newASSIGNOP() in op.c)
+
+$test = 37;
+sub t { ++$test; print "not " unless $_[0]; print "ok $test\n"; }
+
+@foo = @foo;
+t("@foo" eq "foo bar burbl blah"); # 38
+
+(undef,@foo) = @foo;
+t("@foo" eq "bar burbl blah"); # 39
+
+@foo = ('XXX',@foo, 'YYY');
+t("@foo" eq "XXX bar burbl blah YYY"); # 40
+
+@foo = @foo = qw(foo bar burbl blah);
+t("@foo" eq "foo bar burbl blah"); # 41
+
+@bar = @foo = qw(foo bar); # 42
+t("@foo" eq "foo bar");
+t("@bar" eq "foo bar"); # 43
+
+# try the same with local
+# XXX tie-stdarray fails the tests involving local, so we use
+# different variable names to escape the 'tie'
+
+@bee = ( 'foo', 'bar', 'burbl', 'blah');
+{
+
+ local @bee = @bee;
+ t("@bee" eq "foo bar burbl blah"); # 44
+ {
+ local (undef,@bee) = @bee;
+ t("@bee" eq "bar burbl blah"); # 45
+ {
+ local @bee = ('XXX',@bee,'YYY');
+ t("@bee" eq "XXX bar burbl blah YYY"); # 46
+ {
+ local @bee = local(@bee) = qw(foo bar burbl blah);
+ t("@bee" eq "foo bar burbl blah"); # 47
+ {
+ local (@bim) = local(@bee) = qw(foo bar);
+ t("@bee" eq "foo bar"); # 48
+ t("@bim" eq "foo bar"); # 49
+ }
+ t("@bee" eq "foo bar burbl blah"); # 50
+ }
+ t("@bee" eq "XXX bar burbl blah YYY"); # 51
+ }
+ t("@bee" eq "bar burbl blah"); # 52
+ }
+ t("@bee" eq "foo bar burbl blah"); # 53
+}
+
+# try the same with my
+{
+
+ my @bee = @bee;
+ t("@bee" eq "foo bar burbl blah"); # 54
+ {
+ my (undef,@bee) = @bee;
+ t("@bee" eq "bar burbl blah"); # 55
+ {
+ my @bee = ('XXX',@bee,'YYY');
+ t("@bee" eq "XXX bar burbl blah YYY"); # 56
+ {
+ my @bee = my @bee = qw(foo bar burbl blah);
+ t("@bee" eq "foo bar burbl blah"); # 57
+ {
+ my (@bim) = my(@bee) = qw(foo bar);
+ t("@bee" eq "foo bar"); # 58
+ t("@bim" eq "foo bar"); # 59
+ }
+ t("@bee" eq "foo bar burbl blah"); # 60
+ }
+ t("@bee" eq "XXX bar burbl blah YYY"); # 61
+ }
+ t("@bee" eq "bar burbl blah"); # 62
+ }
+ t("@bee" eq "foo bar burbl blah"); # 63
+}
+
+# make sure reification behaves
+my $t = 63;
+sub reify { $_[1] = ++$t; print "@_\n"; }
+reify('ok');
+reify('ok');
diff --git a/gnu/usr.bin/perl/t/op/auto.t b/gnu/usr.bin/perl/t/op/auto.t
index 93a42f8472b..2eb00976509 100644
--- a/gnu/usr.bin/perl/t/op/auto.t
+++ b/gnu/usr.bin/perl/t/op/auto.t
@@ -2,7 +2,7 @@
# $RCSfile: auto.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:39 $
-print "1..34\n";
+print "1..37\n";
$x = 10000;
if (0 + ++$x - 1 == 10000) { print "ok 1\n";} else {print "not ok 1\n";}
@@ -46,3 +46,7 @@ if (++($foo = '99') eq '100') {print "ok 31\n";} else {print "not ok 31\n";}
if (++($foo = 'a0') eq 'a1') {print "ok 32\n";} else {print "not ok 32\n";}
if (++($foo = 'Az') eq 'Ba') {print "ok 33\n";} else {print "not ok 33\n";}
if (++($foo = 'zz') eq 'aaa') {print "ok 34\n";} else {print "not ok 34\n";}
+if (++($foo = 'A99') eq 'B00') {print "ok 35\n";} else {print "not ok 35\n";}
+# EBCDIC guards: i and j, r and s, are not contiguous.
+if (++($foo = 'zi') eq 'zj') {print "ok 36\n";} else {print "not ok 36\n";}
+if (++($foo = 'zr') eq 'zs') {print "ok 37\n";} else {print "not ok 37\n";}
diff --git a/gnu/usr.bin/perl/t/op/bop.t b/gnu/usr.bin/perl/t/op/bop.t
index 0c55029b931..b247341417c 100644
--- a/gnu/usr.bin/perl/t/op/bop.t
+++ b/gnu/usr.bin/perl/t/op/bop.t
@@ -42,14 +42,23 @@ print ((($cusp >> 1) == ($cusp / 2) &&
do { use integer; $cusp >> 1 } == -($cusp / 2))
? "ok 12\n" : "not ok 12\n");
+$Aaz = chr(ord("A") & ord("z"));
+$Aoz = chr(ord("A") | ord("z"));
+$Axz = chr(ord("A") ^ ord("z"));
+
# short strings
-print (("AAAAA" & "zzzzz") eq '@@@@@' ? "ok 13\n" : "not ok 13\n");
-print (("AAAAA" | "zzzzz") eq '{{{{{' ? "ok 14\n" : "not ok 14\n");
-print (("AAAAA" ^ "zzzzz") eq ';;;;;' ? "ok 15\n" : "not ok 15\n");
+print (("AAAAA" & "zzzzz") eq ($Aaz x 5) ? "ok 13\n" : "not ok 13\n");
+print (("AAAAA" | "zzzzz") eq ($Aoz x 5) ? "ok 14\n" : "not ok 14\n");
+print (("AAAAA" ^ "zzzzz") eq ($Axz x 5) ? "ok 15\n" : "not ok 15\n");
# long strings
$foo = "A" x 150;
$bar = "z" x 75;
-print (($foo & $bar) eq ('@'x75 ) ? "ok 16\n" : "not ok 16\n");
-print (($foo | $bar) eq ('{'x75 . 'A'x75) ? "ok 17\n" : "not ok 17\n");
-print (($foo ^ $bar) eq (';'x75 . 'A'x75) ? "ok 18\n" : "not ok 18\n");
+$zap = "A" x 75;
+# & truncates
+print (($foo & $bar) eq ($Aaz x 75 ) ? "ok 16\n" : "not ok 16\n");
+# | does not truncate
+print (($foo | $bar) eq ($Aoz x 75 . $zap) ? "ok 17\n" : "not ok 17\n");
+# ^ does not truncate
+print (($foo ^ $bar) eq ($Axz x 75 . $zap) ? "ok 18\n" : "not ok 18\n");
+
diff --git a/gnu/usr.bin/perl/t/op/closure.t b/gnu/usr.bin/perl/t/op/closure.t
index 1220998b6b6..95d44f51e3f 100644
--- a/gnu/usr.bin/perl/t/op/closure.t
+++ b/gnu/usr.bin/perl/t/op/closure.t
@@ -12,7 +12,7 @@ BEGIN {
use Config;
-print "1..167\n";
+print "1..169\n";
my $test = 1;
sub test (&) {
@@ -130,6 +130,33 @@ test {
&{$foo[4]}() == 0
};
+# test if closures get created in optimized for loops
+
+my %foo;
+for my $n ('A'..'E') {
+ $foo{$n} = sub { $n eq $_[0] };
+}
+
+test {
+ &{$foo{A}}('A') and
+ &{$foo{B}}('B') and
+ &{$foo{C}}('C') and
+ &{$foo{D}}('D') and
+ &{$foo{E}}('E')
+};
+
+for my $n (0..4) {
+ $foo[$n] = sub { $n == $_[0] };
+}
+
+test {
+ &{$foo[0]}(0) and
+ &{$foo[1]}(1) and
+ &{$foo[2]}(2) and
+ &{$foo[3]}(3) and
+ &{$foo[4]}(4)
+};
+
# Additional tests by Tom Phoenix <rootbeer@teleport.com>.
{
@@ -452,3 +479,4 @@ END
} # End of foreach $inner_type
}
+
diff --git a/gnu/usr.bin/perl/t/op/delete.t b/gnu/usr.bin/perl/t/op/delete.t
index 4e00566cd74..6cc447506ac 100644
--- a/gnu/usr.bin/perl/t/op/delete.t
+++ b/gnu/usr.bin/perl/t/op/delete.t
@@ -29,17 +29,17 @@ if ($foo{5} eq '') {print "ok 11\n";} else {print "not ok 11 $foo{5}\n";}
if ($foo{1} eq 'a') {print "ok 12\n";} else {print "not ok 12\n";}
if ($foo{3} eq 'c') {print "ok 13\n";} else {print "not ok 13\n";}
-$foo = join('',values(foo));
+$foo = join('',values(%foo));
if ($foo eq 'ac' || $foo eq 'ca') {print "ok 14\n";} else {print "not ok 14\n";}
-foreach $key (keys foo) {
+foreach $key (keys %foo) {
delete $foo{$key};
}
$foo{'foo'} = 'x';
$foo{'bar'} = 'y';
-$foo = join('',values(foo));
+$foo = join('',values(%foo));
print +($foo eq 'xy' || $foo eq 'yx') ? "ok 15\n" : "not ok 15\n";
$refhash{"top"}->{"foo"} = "FOO";
diff --git a/gnu/usr.bin/perl/t/op/do.t b/gnu/usr.bin/perl/t/op/do.t
index db4623720e0..87ec08d3001 100644
--- a/gnu/usr.bin/perl/t/op/do.t
+++ b/gnu/usr.bin/perl/t/op/do.t
@@ -10,7 +10,7 @@ sub foo1
sub foo2
{
- shift(_);
+ shift;
print $_[0];
$x = 'value';
$x;
diff --git a/gnu/usr.bin/perl/t/op/each.t b/gnu/usr.bin/perl/t/op/each.t
index b92dd1770c6..9063c2c3ed8 100644
--- a/gnu/usr.bin/perl/t/op/each.t
+++ b/gnu/usr.bin/perl/t/op/each.t
@@ -2,7 +2,7 @@
# $RCSfile: each.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:47 $
-print "1..14\n";
+print "1..16\n";
$h{'abc'} = 'ABC';
$h{'def'} = 'DEF';
@@ -43,7 +43,8 @@ if ($#keys == 29 && $#values == 29) {print "ok 1\n";} else {print "not ok 1\n";}
$i = 0; # stop -w complaints
while (($key,$value) = each(%h)) {
- if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
+ if ($key eq $keys[$i] && $value eq $values[$i]
+ && (('a' lt 'A' && $key lt $value) || $key gt $value)) {
$key =~ y/a-z/A-Z/;
$i++ if $key eq $value;
}
@@ -107,3 +108,15 @@ print "ok 13\n";
print "not " if keys(%hash) != 10;
print "ok 14\n";
+print keys(hash) != 10 ? "not ok 15\n" : "ok 15\n";
+
+$i = 0;
+%h = (a => A, b => B, c=> C, d => D, abc => ABC);
+@keys = keys(h);
+@values = values(h);
+while (($key, $value) = each(h)) {
+ if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
+ $i++;
+ }
+}
+if ($i == 5) { print "ok 16\n" } else { print "not ok\n" }
diff --git a/gnu/usr.bin/perl/t/op/eval.t b/gnu/usr.bin/perl/t/op/eval.t
index 6d0a67b5331..dc163e9e8f5 100644
--- a/gnu/usr.bin/perl/t/op/eval.t
+++ b/gnu/usr.bin/perl/t/op/eval.t
@@ -1,8 +1,6 @@
#!./perl
-# $RCSfile: eval.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:48 $
-
-print "1..16\n";
+print "1..36\n";
eval 'print "ok 1\n";';
@@ -54,4 +52,122 @@ eval {
1;
} || print "ok 15\n$@";
+# check whether eval EXPR determines value of EXPR correctly
+
+{
+ my @a = qw(a b c d);
+ my @b = eval @a;
+ print "@b" eq '4' ? "ok 17\n" : "not ok 17\n";
+ print $@ ? "not ok 18\n" : "ok 18\n";
+
+ my $a = q[defined(wantarray) ? (wantarray ? ($b='A') : ($b='S')) : ($b='V')];
+ my $b;
+ @a = eval $a;
+ print "@a" eq 'A' ? "ok 19\n" : "# $b\nnot ok 19\n";
+ print $b eq 'A' ? "ok 20\n" : "# $b\nnot ok 20\n";
+ $_ = eval $a;
+ print $b eq 'S' ? "ok 21\n" : "# $b\nnot ok 21\n";
+ eval $a;
+ print $b eq 'V' ? "ok 22\n" : "# $b\nnot ok 22\n";
+
+ $b = 'wrong';
+ $x = sub {
+ my $b = "right";
+ print eval('"$b"') eq $b ? "ok 23\n" : "not ok 23\n";
+ };
+ &$x();
+}
+
+my $b = 'wrong';
+my $X = sub {
+ my $b = "right";
+ print eval('"$b"') eq $b ? "ok 24\n" : "not ok 24\n";
+};
+&$X();
+
+
+# check navigation of multiple eval boundaries to find lexicals
+
+my $x = 25;
+eval <<'EOT'; die if $@;
+ print "# $x\n"; # clone into eval's pad
+ sub do_eval1 {
+ eval $_[0]; die if $@;
+ }
+EOT
+do_eval1('print "ok $x\n"');
+$x++;
+do_eval1('eval q[print "ok $x\n"]');
+$x++;
+do_eval1('sub { eval q[print "ok $x\n"] }->()');
+$x++;
+
+# calls from within eval'' should clone outer lexicals
+
+eval <<'EOT'; die if $@;
+ sub do_eval2 {
+ eval $_[0]; die if $@;
+ }
+do_eval2('print "ok $x\n"');
+$x++;
+do_eval2('eval q[print "ok $x\n"]');
+$x++;
+do_eval2('sub { eval q[print "ok $x\n"] }->()');
+$x++;
+EOT
+
+# calls outside eval'' should NOT clone lexicals from called context
+
+$main::x = 'ok';
+eval <<'EOT'; die if $@;
+ # $x unbound here
+ sub do_eval3 {
+ eval $_[0]; die if $@;
+ }
+EOT
+do_eval3('print "$x ' . $x . '\n"');
+$x++;
+do_eval3('eval q[print "$x ' . $x . '\n"]');
+$x++;
+do_eval3('sub { eval q[print "$x ' . $x . '\n"] }->()');
+$x++;
+
+# can recursive subroutine-call inside eval'' see its own lexicals?
+sub recurse {
+ my $l = shift;
+ if ($l < $x) {
+ ++$l;
+ eval 'print "# level $l\n"; recurse($l);';
+ die if $@;
+ }
+ else {
+ print "ok $l\n";
+ }
+}
+{
+ local $SIG{__WARN__} = sub { die "not ok $x\n" if $_[0] =~ /^Deep recurs/ };
+ recurse($x-5);
+}
+$x++;
+
+# do closures created within eval bind correctly?
+eval <<'EOT';
+ sub create_closure {
+ my $self = shift;
+ return sub {
+ print $self;
+ };
+ }
+EOT
+create_closure("ok $x\n")->();
+$x++;
+
+# does lexical search terminate correctly at subroutine boundary?
+$main::r = "ok $x\n";
+sub terminal { eval 'print $r' }
+{
+ my $r = "not ok $x\n";
+ eval 'terminal($r)';
+}
+$x++;
diff --git a/gnu/usr.bin/perl/t/op/exec.t b/gnu/usr.bin/perl/t/op/exec.t
index 7dfcd6177f9..098a455455d 100644
--- a/gnu/usr.bin/perl/t/op/exec.t
+++ b/gnu/usr.bin/perl/t/op/exec.t
@@ -6,16 +6,23 @@ $| = 1; # flush stdout
if ($^O eq 'MSWin32') {
print "# exec is unsupported on Win32\n";
+ # XXX the system tests could be written to use ./perl and so work on Win32
print "1..0\n";
exit(0);
}
print "1..8\n";
-print "not ok 1\n" if system "echo ok \\1"; # shell interpreted
+if ($^O ne 'os2') {
+ print "not ok 1\n" if system "echo ok \\1"; # shell interpreted
+}
+else {
+ print "ok 1 # skipped: bug/feature of pdksh\n"; # shell interpreted
+}
print "not ok 2\n" if system "echo ok 2"; # split and directly called
print "not ok 3\n" if system "echo", "ok", "3"; # directly called
+# these should probably be rewritten to match the examples in perlfunc.pod
if (system "true") {print "not ok 4\n";} else {print "ok 4\n";}
if ((system "/bin/sh -c 'exit 1'") != 256) { print "not "; }
diff --git a/gnu/usr.bin/perl/t/op/flip.t b/gnu/usr.bin/perl/t/op/flip.t
index 7852d0cee91..20167f3333b 100644
--- a/gnu/usr.bin/perl/t/op/flip.t
+++ b/gnu/usr.bin/perl/t/op/flip.t
@@ -6,7 +6,7 @@ print "1..9\n";
@a = (1,2,3,4,5,6,7,8,9,10,11,12);
-while ($_ = shift(a)) {
+while ($_ = shift(@a)) {
if ($x = /4/../8/) { $z = $x; print "ok ", $x + 0, "\n"; }
$y .= /1/../2/;
}
diff --git a/gnu/usr.bin/perl/t/op/goto.t b/gnu/usr.bin/perl/t/op/goto.t
index 1b34acda395..8096aff0f2f 100644
--- a/gnu/usr.bin/perl/t/op/goto.t
+++ b/gnu/usr.bin/perl/t/op/goto.t
@@ -1,10 +1,8 @@
#!./perl
-# $RCSfile: goto.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:56 $
-
# "This IS structured code. It's just randomly structured."
-print "1..9\n";
+print "1..13\n";
while ($?) {
$foo = 1;
@@ -56,7 +54,7 @@ sub bar {
exit;
FINALE:
-print "ok 9\n";
+print "ok 13\n";
exit;
bypass:
@@ -86,5 +84,22 @@ $wherever = NOWHERE;
eval { goto $wherever };
print $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n";
+# see if a modified @_ propagates
+{
+ package Foo;
+ sub DESTROY { my $s = shift; print "ok $s->[0]\n"; }
+ sub show { print "# @_\nnot ok $_[0][0]\n" if @_ != 5; }
+ sub start { push @_, 1, "foo", {}; goto &show; }
+ for (9..11) { start(bless([$_]), 'bar'); }
+}
+
+sub auto {
+ goto &loadit;
+}
+
+sub AUTOLOAD { print @_ }
+
+auto("ok 12\n");
+
$wherever = FINALE;
goto $wherever;
diff --git a/gnu/usr.bin/perl/t/op/gv.t b/gnu/usr.bin/perl/t/op/gv.t
index ece32d936cd..c253e4bd9d5 100644
--- a/gnu/usr.bin/perl/t/op/gv.t
+++ b/gnu/usr.bin/perl/t/op/gv.t
@@ -4,7 +4,7 @@
# various typeglob tests
#
-print "1..11\n";
+print "1..23\n";
# type coersion on assignment
$foo = 'foo';
@@ -57,3 +57,42 @@ if (defined $baa) {
print ref(\$baa) eq 'GLOB' ? "ok 11\n" : "not ok 11\n";
}
+# nested package globs
+# NOTE: It's probably OK if these semantics change, because the
+# fact that %X::Y:: is stored in %X:: isn't documented.
+# (I hope.)
+
+{ package Foo::Bar }
+print exists $Foo::{'Bar::'} ? "ok 12\n" : "not ok 12\n";
+print $Foo::{'Bar::'} eq '*Foo::Bar::' ? "ok 13\n" : "not ok 13\n";
+
+# test undef operator clearing out entire glob
+$foo = 'stuff';
+@foo = qw(more stuff);
+%foo = qw(even more random stuff);
+undef *foo;
+print +($foo || @foo || %foo) ? "not ok" : "ok", " 14\n";
+
+# test warnings from assignment of undef to glob
+{
+ my $msg;
+ local $SIG{__WARN__} = sub { $msg = $_[0] };
+ local $^W = 1;
+ *foo = 'bar';
+ print $msg ? "not ok" : "ok", " 15\n";
+ *foo = undef;
+ print $msg ? "ok" : "not ok", " 16\n";
+}
+
+# test *glob{THING} syntax
+$x = "ok 17\n";
+@x = ("ok 18\n");
+%x = ("ok 19" => "\n");
+sub x { "ok 20\n" }
+print ${*x{SCALAR}}, @{*x{ARRAY}}, %{*x{HASH}}, &{*x{CODE}};
+*x = *STDOUT;
+print *{*x{GLOB}} eq "*main::STDOUT" ? "ok 21\n" : "not ok 21\n";
+print {*x{IO}} "ok 22\n";
+print {*x{FILEHANDLE}} "ok 23\n";
+
+
diff --git a/gnu/usr.bin/perl/t/op/local.t b/gnu/usr.bin/perl/t/op/local.t
index f527c9c9a90..b478e01993f 100644
--- a/gnu/usr.bin/perl/t/op/local.t
+++ b/gnu/usr.bin/perl/t/op/local.t
@@ -1,8 +1,9 @@
#!./perl
-# $RCSfile: local.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:04 $
+print "1..69\n";
-print "1..23\n";
+# XXX known to leak scalars
+$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
sub foo {
local($a, $b) = @_;
@@ -52,3 +53,185 @@ print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 22\n";
eval 'local(%$e)';
print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 23\n";
+
+# Array and hash elements
+
+@a = ('a', 'b', 'c');
+{
+ local($a[1]) = 'foo';
+ local($a[2]) = $a[2];
+ print +($a[1] eq 'foo') ? "" : "not ", "ok 24\n";
+ print +($a[2] eq 'c') ? "" : "not ", "ok 25\n";
+ undef @a;
+}
+print +($a[1] eq 'b') ? "" : "not ", "ok 26\n";
+print +($a[2] eq 'c') ? "" : "not ", "ok 27\n";
+print +(!defined $a[0]) ? "" : "not ", "ok 28\n";
+
+@a = ('a', 'b', 'c');
+{
+ local($a[1]) = "X";
+ shift @a;
+}
+print +($a[0].$a[1] eq "Xb") ? "" : "not ", "ok 29\n";
+
+%h = ('a' => 1, 'b' => 2, 'c' => 3);
+{
+ local($h{'a'}) = 'foo';
+ local($h{'b'}) = $h{'b'};
+ print +($h{'a'} eq 'foo') ? "" : "not ", "ok 30\n";
+ print +($h{'b'} == 2) ? "" : "not ", "ok 31\n";
+ local($h{'c'});
+ delete $h{'c'};
+}
+print +($h{'a'} == 1) ? "" : "not ", "ok 32\n";
+print +($h{'b'} == 2) ? "" : "not ", "ok 33\n";
+print +($h{'c'} == 3) ? "" : "not ", "ok 34\n";
+
+# check for scope leakage
+$a = 'outer';
+if (1) { local $a = 'inner' }
+print +($a eq 'outer') ? "" : "not ", "ok 35\n";
+
+# see if localization works when scope unwinds
+local $m = 5;
+eval {
+ for $m (6) {
+ local $m = 7;
+ die "bye";
+ }
+};
+print $m == 5 ? "" : "not ", "ok 36\n";
+
+# see if localization works on tied arrays
+{
+ package TA;
+ sub TIEARRAY { bless [], $_[0] }
+ sub STORE { print "# STORE [@_]\n"; $_[0]->[$_[1]] = $_[2] }
+ sub FETCH { my $v = $_[0]->[$_[1]]; print "# FETCH [@_=$v]\n"; $v }
+ sub CLEAR { print "# CLEAR [@_]\n"; @{$_[0]} = (); }
+ sub FETCHSIZE { scalar(@{$_[0]}) }
+ sub SHIFT { shift (@{$_[0]}) }
+ sub EXTEND {}
+}
+
+tie @a, 'TA';
+@a = ('a', 'b', 'c');
+{
+ local($a[1]) = 'foo';
+ local($a[2]) = $a[2];
+ print +($a[1] eq 'foo') ? "" : "not ", "ok 37\n";
+ print +($a[2] eq 'c') ? "" : "not ", "ok 38\n";
+ @a = ();
+}
+print +($a[1] eq 'b') ? "" : "not ", "ok 39\n";
+print +($a[2] eq 'c') ? "" : "not ", "ok 40\n";
+print +(!defined $a[0]) ? "" : "not ", "ok 41\n";
+
+{
+ package TH;
+ sub TIEHASH { bless {}, $_[0] }
+ sub STORE { print "# STORE [@_]\n"; $_[0]->{$_[1]} = $_[2] }
+ sub FETCH { my $v = $_[0]->{$_[1]}; print "# FETCH [@_=$v]\n"; $v }
+ sub DELETE { print "# DELETE [@_]\n"; delete $_[0]->{$_[1]}; }
+ sub CLEAR { print "# CLEAR [@_]\n"; %{$_[0]} = (); }
+}
+
+# see if localization works on tied hashes
+tie %h, 'TH';
+%h = ('a' => 1, 'b' => 2, 'c' => 3);
+
+{
+ local($h{'a'}) = 'foo';
+ local($h{'b'}) = $h{'b'};
+ print +($h{'a'} eq 'foo') ? "" : "not ", "ok 42\n";
+ print +($h{'b'} == 2) ? "" : "not ", "ok 43\n";
+ local($h{'c'});
+ delete $h{'c'};
+}
+print +($h{'a'} == 1) ? "" : "not ", "ok 44\n";
+print +($h{'b'} == 2) ? "" : "not ", "ok 45\n";
+print +($h{'c'} == 3) ? "" : "not ", "ok 46\n";
+
+@a = ('a', 'b', 'c');
+{
+ local($a[1]) = "X";
+ shift @a;
+}
+print +($a[0].$a[1] eq "Xb") ? "" : "not ", "ok 47\n";
+
+# now try the same for %SIG
+
+$SIG{TERM} = 'foo';
+$SIG{INT} = \&foo;
+$SIG{__WARN__} = $SIG{INT};
+{
+ local($SIG{TERM}) = $SIG{TERM};
+ local($SIG{INT}) = $SIG{INT};
+ local($SIG{__WARN__}) = $SIG{__WARN__};
+ print +($SIG{TERM} eq 'main::foo') ? "" : "not ", "ok 48\n";
+ print +($SIG{INT} eq \&foo) ? "" : "not ", "ok 49\n";
+ print +($SIG{__WARN__} eq \&foo) ? "" : "not ", "ok 50\n";
+ local($SIG{INT});
+ delete $SIG{__WARN__};
+}
+print +($SIG{TERM} eq 'main::foo') ? "" : "not ", "ok 51\n";
+print +($SIG{INT} eq \&foo) ? "" : "not ", "ok 52\n";
+print +($SIG{__WARN__} eq \&foo) ? "" : "not ", "ok 53\n";
+
+# and for %ENV
+
+$ENV{_X_} = 'a';
+$ENV{_Y_} = 'b';
+$ENV{_Z_} = 'c';
+{
+ local($ENV{_X_}) = 'foo';
+ local($ENV{_Y_}) = $ENV{_Y_};
+ print +($ENV{_X_} eq 'foo') ? "" : "not ", "ok 54\n";
+ print +($ENV{_Y_} eq 'b') ? "" : "not ", "ok 55\n";
+ local($ENV{_Z_});
+ delete $ENV{_Z_};
+}
+print +($ENV{_X_} eq 'a') ? "" : "not ", "ok 56\n";
+print +($ENV{_Y_} eq 'b') ? "" : "not ", "ok 57\n";
+print +($ENV{_Z_} eq 'c') ? "" : "not ", "ok 58\n";
+
+# does implicit localization in foreach skip magic?
+
+$_ = "ok 59,ok 60,";
+my $iter = 0;
+while (/(o.+?),/gc) {
+ print "$1\n";
+ foreach (1..1) { $iter++ }
+ if ($iter > 2) { print "not ok 60\n"; last; }
+}
+
+{
+ package UnderScore;
+ sub TIESCALAR { bless \my $self, shift }
+ sub FETCH { die "read \$_ forbidden" }
+ sub STORE { die "write \$_ forbidden" }
+ tie $_, __PACKAGE__;
+ my $t = 61;
+ my @tests = (
+ "Nesting" => sub { print '#'; for (1..3) { print }
+ print "\n" }, 1,
+ "Reading" => sub { print }, 0,
+ "Matching" => sub { $x = /badness/ }, 0,
+ "Concat" => sub { $_ .= "a" }, 0,
+ "Chop" => sub { chop }, 0,
+ "Filetest" => sub { -x }, 0,
+ "Assignment" => sub { $_ = "Bad" }, 0,
+ # XXX whether next one should fail is debatable
+ "Local \$_" => sub { local $_ = 'ok?'; print }, 0,
+ "for local" => sub { for("#ok?\n"){ print } }, 1,
+ );
+ while ( ($name, $code, $ok) = splice(@tests, 0, 3) ) {
+ print "# Testing $name\n";
+ eval { &$code };
+ print(($ok xor $@) ? "ok $t\n" : "not ok $t\n");
+ ++$t;
+ }
+ untie $_;
+}
+
diff --git a/gnu/usr.bin/perl/t/op/magic.t b/gnu/usr.bin/perl/t/op/magic.t
index bddcd27679a..7f08e06f851 100644
--- a/gnu/usr.bin/perl/t/op/magic.t
+++ b/gnu/usr.bin/perl/t/op/magic.t
@@ -21,13 +21,14 @@ sub ok {
$Is_MSWin32 = $^O eq 'MSWin32';
$Is_VMS = $^O eq 'VMS';
+$Is_Dos = $^O eq 'dos';
$PERL = ($Is_MSWin32 ? '.\perl' : './perl');
-print "1..30\n";
+print "1..35\n";
-eval '$ENV{"foo"} = "hi there";'; # check that ENV is inited inside eval
-if ($Is_MSWin32) { ok 1, `cmd /x /c set foo` eq "foo=hi there\n"; }
-else { ok 1, `echo \$foo` eq "hi there\n"; }
+eval '$ENV{"FOO"} = "hi there";'; # check that ENV is inited inside eval
+if ($Is_MSWin32) { ok 1, `cmd /x /c set FOO` eq "FOO=hi there\n"; }
+else { ok 1, `echo \$FOO` eq "hi there\n"; }
unlink 'ajslkdfpqjsjfk';
$! = 0;
@@ -35,9 +36,9 @@ open(FOO,'ajslkdfpqjsjfk');
ok 2, $!, $!;
close FOO; # just mention it, squelch used-only-once
-if ($Is_MSWin32) {
- ok 3,1;
- ok 4,1;
+if ($Is_MSWin32 || $Is_Dos) {
+ ok "3 # skipped",1;
+ ok "4 # skipped",1;
}
else {
# the next tests are embedded inside system simply because sh spits out
@@ -46,9 +47,9 @@ else {
$| = 1; # command buffering
- $SIG{"INT"} = "ok3"; kill "INT",$$;
- $SIG{"INT"} = "IGNORE"; kill "INT",$$; print "ok 4\n";
- $SIG{"INT"} = "DEFAULT"; kill "INT",$$; print "not ok\n";
+ $SIG{"INT"} = "ok3"; kill "INT",$$; sleep 1;
+ $SIG{"INT"} = "IGNORE"; kill "INT",$$; sleep 1; print "ok 4\n";
+ $SIG{"INT"} = "DEFAULT"; kill "INT",$$; sleep 1; print "not ok\n";
sub ok3 {
if (($x = pop(@_)) eq "INT") {
@@ -108,7 +109,7 @@ ok 18, $$ > 0, $$;
# $^X and $0
{
if ($^O eq 'qnx') {
- chomp($wd = `pwd`);
+ chomp($wd = `/usr/bin/fullpath -t`);
}
else {
$wd = '.';
@@ -134,11 +135,13 @@ __END__
:endofperl
EOT
}
- $s1 = $s2 = "\$^X is $perl, \$0 is $script\n";
- if ($^O eq 'os2') {
- # Started by ksh, which adds suffixes '.exe' and '.' to perl and script
- $s2 = "\$^X is $wd/perl.exe, \$0 is $script.\n";
+ if ($^O eq 'os390') { # no shebang
+ $headmaybe = <<EOH ;
+ eval 'exec ./perl -S \$0 \${1+"\$\@"}'
+ if 0;
+EOH
}
+ $s1 = $s2 = "\$^X is $perl, \$0 is $script\n";
ok 19, open(SCRIPT, ">$script"), $!;
ok 20, print(SCRIPT $headmaybe . <<EOB . <<'EOF' . $tailmaybe), $!;
#!$wd/perl
@@ -148,10 +151,12 @@ EOF
ok 21, close(SCRIPT), $!;
ok 22, chmod(0755, $script), $!;
$_ = `$script`;
+ s/.exe//i if $Is_Dos;
s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl
s{is perl}{is $perl}; # for systems where $^X is only a basename
ok 23, ($Is_MSWin32 ? uc($_) eq uc($s2) : $_ eq $s2), ":$_:!=:$s2:";
$_ = `$perl $script`;
+ s/.exe//i if $Is_Dos;
ok 24, ($Is_MSWin32 ? uc($_) eq uc($s1) : $_ eq $s1), ":$_:!=:$s1: after `$perl $script`";
ok 25, unlink($script), $!;
}
@@ -161,9 +166,9 @@ ok 26, $] >= 5.00319, $];
ok 27, $^O;
ok 28, $^T > 850000000, $^T;
-if ($Is_VMS) {
- ok 29, 1;
- ok 30, 1;
+if ($Is_VMS || $Is_Dos) {
+ ok "29 # skipped", 1;
+ ok "30 # skipped", 1;
}
else {
$PATH = $ENV{PATH};
@@ -179,3 +184,26 @@ else {
: (`echo \$NoNeSuCh` eq "foo\n") );
}
+{
+ local $SIG{'__WARN__'} = sub { print "not " };
+ $! = undef;
+ print "ok 31\n";
+}
+
+# test case-insignificance of %ENV (these tests must be enabled only
+# when perl is compiled with -DENV_IS_CASELESS)
+if ($Is_MSWin32) {
+ %ENV = ();
+ $ENV{'Foo'} = 'bar';
+ $ENV{'fOo'} = 'baz';
+ ok 32, (scalar(keys(%ENV)) == 1);
+ ok 33, exists($ENV{'FOo'});
+ ok 34, (delete($ENV{'foO'}) eq 'baz');
+ ok 35, (scalar(keys(%ENV)) == 0);
+}
+else {
+ ok "32 # skipped",1;
+ ok "33 # skipped",1;
+ ok "34 # skipped",1;
+ ok "35 # skipped",1;
+}
diff --git a/gnu/usr.bin/perl/t/op/method.t b/gnu/usr.bin/perl/t/op/method.t
index d955705d1a1..f1b1888ef64 100644
--- a/gnu/usr.bin/perl/t/op/method.t
+++ b/gnu/usr.bin/perl/t/op/method.t
@@ -4,7 +4,7 @@
# test method calls and autoloading.
#
-print "1..24\n";
+print "1..26\n";
@A::ISA = 'B';
@B::ISA = 'C';
@@ -66,6 +66,12 @@ test (A->d, "B::d4"); # Update hash table;
delete $B::{d}; # Should work without any help too
test (A->d, "C::d");
+{
+ local *C::d;
+ test (eval { A->d } || "nope", "nope");
+}
+test (A->d, "C::d");
+
*A::x = *A::d; # See if cache incorrectly follows synonyms
A->d;
test (eval { A->x } || "nope", "nope");
diff --git a/gnu/usr.bin/perl/t/op/misc.t b/gnu/usr.bin/perl/t/op/misc.t
index 6156ac2f217..c9050ef58f2 100644
--- a/gnu/usr.bin/perl/t/op/misc.t
+++ b/gnu/usr.bin/perl/t/op/misc.t
@@ -36,6 +36,9 @@ for (@prgs){
$status = $?;
$results = `$CAT $tmpfile`;
$results =~ s/\n+$//;
+# bison says 'parse error' instead of 'syntax error',
+# various yaccs may or may not capitalize 'syntax'.
+ $results =~ s/^(syntax|parse) error/syntax error/mig;
$expected =~ s/\n+$//;
if ( $results ne $expected){
print STDERR "PROG: $switch\n$prog\n";
@@ -61,7 +64,7 @@ EXPECT
########
$foo=undef; $foo->go;
EXPECT
-Can't call method "go" without a package or object reference at - line 1.
+Can't call method "go" on an undefined value at - line 1.
########
BEGIN
{
@@ -336,11 +339,110 @@ sub foo { local $_ = shift; split; @_ }
@x = foo(' x y z ');
print "you die joe!\n" unless "@x" eq 'x y z';
########
-sub foo { local(@_) = ('p', 'q', 'r'); }
-sub bar { unshift @_, 'D'; @_ }
-sub baz { push @_, 'E'; return @_ }
-for (1..3) { print foo('a', 'b', 'c'), bar('d'), baz('e'), "\n" }
+/(?{"{"})/ # Check it outside of eval too
EXPECT
-pqrDdeE
-pqrDdeE
-pqrDdeE
+Sequence (?{...}) not terminated or not {}-balanced at - line 1, within pattern
+/(?{"{"})/: Sequence (?{...}) not terminated or not {}-balanced at - line 1.
+########
+/(?{"{"}})/ # Check it outside of eval too
+EXPECT
+Unmatched right bracket at (re_eval 1) line 1, at end of line
+syntax error at (re_eval 1) line 1, near ""{"}"
+Compilation failed in regexp at - line 1.
+########
+BEGIN { @ARGV = qw(a b c) }
+BEGIN { print "argv <@ARGV>\nbegin <",shift,">\n" }
+END { print "end <",shift,">\nargv <@ARGV>\n" }
+INIT { print "init <",shift,">\n" }
+EXPECT
+argv <a b c>
+begin <a>
+init <b>
+end <c>
+argv <>
+########
+-l
+# fdopen from a system descriptor to a system descriptor used to close
+# the former.
+open STDERR, '>&=STDOUT' or die $!;
+select STDOUT; $| = 1; print fileno STDOUT;
+select STDERR; $| = 1; print fileno STDERR;
+EXPECT
+1
+2
+########
+-w
+sub testme { my $a = "test"; { local $a = "new test"; print $a }}
+EXPECT
+Can't localize lexical variable $a at - line 2.
+########
+package X;
+sub ascalar { my $r; bless \$r }
+sub DESTROY { print "destroyed\n" };
+package main;
+*s = ascalar X;
+EXPECT
+destroyed
+########
+package X;
+sub anarray { bless [] }
+sub DESTROY { print "destroyed\n" };
+package main;
+*a = anarray X;
+EXPECT
+destroyed
+########
+package X;
+sub ahash { bless {} }
+sub DESTROY { print "destroyed\n" };
+package main;
+*h = ahash X;
+EXPECT
+destroyed
+########
+package X;
+sub aclosure { my $x; bless sub { ++$x } }
+sub DESTROY { print "destroyed\n" };
+package main;
+*c = aclosure X;
+EXPECT
+destroyed
+########
+package X;
+sub any { bless {} }
+my $f = "FH000"; # just to thwart any future optimisations
+sub afh { select select ++$f; my $r = *{$f}{IO}; delete $X::{$f}; bless $r }
+sub DESTROY { print "destroyed\n" }
+package main;
+$x = any X; # to bump sv_objcount. IO objs aren't counted??
+*f = afh X;
+EXPECT
+destroyed
+destroyed
+########
+BEGIN {
+ $| = 1;
+ $SIG{__WARN__} = sub {
+ eval { print $_[0] };
+ die "bar\n";
+ };
+ warn "foo\n";
+}
+EXPECT
+foo
+bar
+BEGIN failed--compilation aborted at - line 8.
+########
+use strict;
+my $foo = "ZZZ\n";
+END { print $foo }
+EXPECT
+ZZZ
+########
+eval '
+use strict;
+my $foo = "ZZZ\n";
+END { print $foo }
+';
+EXPECT
+ZZZ
diff --git a/gnu/usr.bin/perl/t/op/mkdir.t b/gnu/usr.bin/perl/t/op/mkdir.t
index 5ba0a0f18d1..acf16c14a42 100644
--- a/gnu/usr.bin/perl/t/op/mkdir.t
+++ b/gnu/usr.bin/perl/t/op/mkdir.t
@@ -15,4 +15,4 @@ print ($! =~ /exist|denied/ ? "ok 3\n" : "# $!\nnot ok 3\n");
print (-d 'blurfl' ? "ok 4\n" : "not ok 4\n");
print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n");
print (rmdir('blurfl') ? "not ok 6\n" : "ok 6\n");
-print ($! =~ /such|exist/ ? "ok 7\n" : "not ok 7\n");
+print ($! =~ /such|exist|not found/i ? "ok 7\n" : "not ok 7\n");
diff --git a/gnu/usr.bin/perl/t/op/my.t b/gnu/usr.bin/perl/t/op/my.t
index 06c69635346..1777e88266b 100644
--- a/gnu/usr.bin/perl/t/op/my.t
+++ b/gnu/usr.bin/perl/t/op/my.t
@@ -2,7 +2,7 @@
# $RCSfile: my.t,v $
-print "1..28\n";
+print "1..30\n";
sub foo {
my($a, $b) = @_;
@@ -10,7 +10,8 @@ sub foo {
my $d;
$c = "ok 3\n";
$d = "ok 4\n";
- { my($a,$c) = ("ok 9\n", "ok 10\n"); ($x, $y) = ($a, $c); }
+ { my($a, undef, $c) = ("ok 9\n", "not ok 10\n", "ok 10\n");
+ ($x, $y) = ($a, $c); }
print $a, $b;
$c . $d;
}
@@ -83,3 +84,11 @@ foreach my $i (26, 27) {
print "not " if $i ne "outer";
print "ok 28\n";
+
+# Ensure that C<my @y> (without parens) doesn't force scalar context.
+my @x;
+{ @x = my @y }
+print +(@x ? "not " : ""), "ok 29\n";
+{ @x = my %y }
+print +(@x ? "not " : ""), "ok 30\n";
+
diff --git a/gnu/usr.bin/perl/t/op/oct.t b/gnu/usr.bin/perl/t/op/oct.t
index 24b5c4309d4..66230898ab3 100644
--- a/gnu/usr.bin/perl/t/op/oct.t
+++ b/gnu/usr.bin/perl/t/op/oct.t
@@ -1,8 +1,6 @@
#!./perl
-# $RCSfile: oct.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:08 $
-
-print "1..8\n";
+print "1..9\n";
print +(oct('01234') == 01234) ? "ok" : "not ok", " 1\n";
print +(oct('0x1234') == 0x1234) ? "ok" : "not ok", " 2\n";
@@ -12,3 +10,4 @@ print +(oct('x80000000') == 0x80000000) ? "ok" : "not ok", " 5\n";
print +(hex('80000000') == 0x80000000) ? "ok" : "not ok", " 6\n";
print +(oct('1234') == 668) ? "ok" : "not ok", " 7\n";
print +(hex('1234') == 4660) ? "ok" : "not ok", " 8\n";
+print +(hex('0x1234') == 0x1234) ? "ok" : "not ok", " 9\n";
diff --git a/gnu/usr.bin/perl/t/op/ord.t b/gnu/usr.bin/perl/t/op/ord.t
index 37128382d86..ba943f4e8c2 100644
--- a/gnu/usr.bin/perl/t/op/ord.t
+++ b/gnu/usr.bin/perl/t/op/ord.t
@@ -6,11 +6,13 @@ print "1..3\n";
# compile time evaluation
-if (ord('A') == 65) {print "ok 1\n";} else {print "not ok 1\n";}
+# 65 ASCII
+# 193 EBCDIC
+if (ord('A') == 65 || ord('A') == 193) {print "ok 1\n";} else {print "not ok 1\n";}
# run time evaluation
$x = 'ABC';
-if (ord($x) == 65) {print "ok 2\n";} else {print "not ok 2\n";}
+if (ord($x) == 65 || ord($x) == 193) {print "ok 2\n";} else {print "not ok 2\n";}
-if (chr 65 == A) {print "ok 3\n";} else {print "not ok 3\n";}
+if (chr 65 == 'A' || chr 193 == 'A') {print "ok 3\n";} else {print "not ok 3\n";}
diff --git a/gnu/usr.bin/perl/t/op/pack.t b/gnu/usr.bin/perl/t/op/pack.t
index f9a89a3ec02..902fc28af07 100644
--- a/gnu/usr.bin/perl/t/op/pack.t
+++ b/gnu/usr.bin/perl/t/op/pack.t
@@ -1,8 +1,12 @@
#!./perl
-# $RCSfile: pack.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:11 $
+BEGIN {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ require Config; import Config;
+}
-print "1..29\n";
+print "1..142\n";
$format = "c2 x5 C C x s d i l a6";
# Need the expression in here to force ary[5] to be numeric. This avoids
@@ -30,7 +34,10 @@ print +($x = unpack("%32b69", "\001\002\004\010\020\040\100\200\017")) == 12
print +($x = unpack("%32B69", "\001\002\004\010\020\040\100\200\017")) == 9
? "ok 6\n" : "not ok 6 $x\n";
-print +($x = unpack("%32B*", "Now is the time for all good blurfl")) == 129
+my $sum = 129; # ASCII
+$sum = 103 if ($Config{ebcdic} eq 'define');
+
+print +($x = unpack("%32B*", "Now is the time for all good blurfl")) == $sum
? "ok 7\n" : "not ok 7 $x\n";
open(BIN, "./perl") || open(BIN, "./perl.exe")
@@ -100,3 +107,251 @@ sub foo { my $a = "a"; return $a . $a++ . $a++ }
# undef should give null pointer
print((pack("p", undef) =~ /^\0+/ ? "ok " : "not ok "),$test++,"\n");
+# Check for optimizer bug (e.g. Digital Unix GEM cc with -O4 on DU V4.0B gives
+# 4294967295 instead of -1)
+# see #ifdef __osf__ in pp.c pp_unpack
+# Test 30:
+print( ((unpack("i",pack("i",-1))) == -1 ? "ok " : "not ok "),$test++,"\n");
+
+# 31..36: test the pack lengths of s S i I l L
+print "not " unless length(pack("s", 0)) == 2;
+print "ok ", $test++, "\n";
+
+print "not " unless length(pack("S", 0)) == 2;
+print "ok ", $test++, "\n";
+
+print "not " unless length(pack("i", 0)) >= 4;
+print "ok ", $test++, "\n";
+
+print "not " unless length(pack("I", 0)) >= 4;
+print "ok ", $test++, "\n";
+
+print "not " unless length(pack("l", 0)) == 4;
+print "ok ", $test++, "\n";
+
+print "not " unless length(pack("L", 0)) == 4;
+print "ok ", $test++, "\n";
+
+# 37..40: test the pack lengths of n N v V
+
+print "not " unless length(pack("n", 0)) == 2;
+print "ok ", $test++, "\n";
+
+print "not " unless length(pack("N", 0)) == 4;
+print "ok ", $test++, "\n";
+
+print "not " unless length(pack("v", 0)) == 2;
+print "ok ", $test++, "\n";
+
+print "not " unless length(pack("V", 0)) == 4;
+print "ok ", $test++, "\n";
+
+# 41..56: test unpack-pack lengths
+
+my @templates = qw(c C i I s S l L n N v V f d);
+
+# quads not supported everywhere: if not, retest floats/doubles
+# to preserve the test count...
+eval { my $q = pack("q",0) };
+push @templates, $@ !~ /Invalid type in pack/ ? qw(q Q) : qw(f d);
+
+foreach my $t (@templates) {
+ my @t = unpack("$t*", pack("$t*", 12, 34));
+ print "not "
+ unless @t == 2 and (($t[0] == 12 and $t[1] == 34) or ($t =~ /[nv]/i));
+ print "ok ", $test++, "\n";
+}
+
+# 57..60: uuencode/decode
+
+# Note that first uuencoding known 'text' data and then checking the
+# binary values of the uuencoded version would not be portable between
+# character sets. Uuencoding is meant for encoding binary data, not
+# text data.
+
+$in = pack 'C*', 0 .. 255;
+
+# just to be anal, we do some random tr/`/ /
+$uu = <<'EOUU';
+M` $"`P0%!@<("0H+# T.#Q`1$A,4%187&!D:&QP='A\@(2(C)"4F)R@I*BLL
+M+2XO,#$R,S0U-C<X.3H[/#T^/T!!0D-$149'2$E*2TQ-3D]045)35%565UA9
+M6EM<75Y?8&%B8V1E9F=H:6IK;&UN;W!Q<G-T=79W>'EZ>WQ]?G^`@8*#A(6&
+MAXB)BHN,C8Z/D)&2DY25EI>8F9J;G)V>GZ"AHJ.DI::GJ*FJJZRMKJ^PL;*S
+MM+6VM[BYNKN\O;Z_P,'"P\3%QL?(R<K+S,W.S]#1TM/4U=;7V-G:V]S=WM_@
+?X>+CY.7FY^CIZNOL[>[O\/'R\_3U]O?X^?K[_/W^_P `
+EOUU
+
+$_ = $uu;
+tr/ /`/;
+print "not " unless pack('u', $in) eq $_;
+print "ok ", $test++, "\n";
+
+print "not " unless unpack('u', $uu) eq $in;
+print "ok ", $test++, "\n";
+
+$in = "\x1f\x8b\x08\x08\x58\xdc\xc4\x35\x02\x03\x4a\x41\x50\x55\x00\xf3\x2a\x2d\x2e\x51\x48\xcc\xcb\x2f\xc9\x48\x2d\x52\x08\x48\x2d\xca\x51\x28\x2d\x4d\xce\x4f\x49\x2d\xe2\x02\x00\x64\x66\x60\x5c\x1a\x00\x00\x00";
+$uu = <<'EOUU';
+M'XL("%C<Q#4"`TI!4%4`\RHM+E%(S,LOR4@M4@A(+<I1*"U-SD])+>("`&1F
+&8%P:````
+EOUU
+
+print "not " unless unpack('u', $uu) eq $in;
+print "ok ", $test++, "\n";
+
+# 60 identical to 59 except that backquotes have been changed to spaces
+
+$uu = <<'EOUU';
+M'XL("%C<Q#4" TI!4%4 \RHM+E%(S,LOR4@M4@A(+<I1*"U-SD])+>(" &1F
+&8%P:
+EOUU
+
+print "not " unless unpack('u', $uu) eq $in;
+print "ok ", $test++, "\n";
+
+# 61..72: test the ascii template types (A, a, Z)
+
+print "not " unless pack('A*', "foo\0bar\0 ") eq "foo\0bar\0 ";
+print "ok ", $test++, "\n";
+
+print "not " unless pack('A11', "foo\0bar\0 ") eq "foo\0bar\0 ";
+print "ok ", $test++, "\n";
+
+print "not " unless unpack('A*', "foo\0bar \0") eq "foo\0bar";
+print "ok ", $test++, "\n";
+
+print "not " unless unpack('A8', "foo\0bar \0") eq "foo\0bar";
+print "ok ", $test++, "\n";
+
+print "not " unless pack('a*', "foo\0bar\0 ") eq "foo\0bar\0 ";
+print "ok ", $test++, "\n";
+
+print "not " unless pack('a11', "foo\0bar\0 ") eq "foo\0bar\0 \0\0";
+print "ok ", $test++, "\n";
+
+print "not " unless unpack('a*', "foo\0bar \0") eq "foo\0bar \0";
+print "ok ", $test++, "\n";
+
+print "not " unless unpack('a8', "foo\0bar \0") eq "foo\0bar ";
+print "ok ", $test++, "\n";
+
+print "not " unless pack('Z*', "foo\0bar\0 ") eq "foo\0bar\0 ";
+print "ok ", $test++, "\n";
+
+print "not " unless pack('Z11', "foo\0bar\0 ") eq "foo\0bar\0 \0\0";
+print "ok ", $test++, "\n";
+
+print "not " unless unpack('Z*', "foo\0bar \0") eq "foo";
+print "ok ", $test++, "\n";
+
+print "not " unless unpack('Z8', "foo\0bar \0") eq "foo";
+print "ok ", $test++, "\n";
+
+# 73..78: packing native shorts/ints/longs
+
+# integrated from mainline and don't want to change numbers all the way
+# down. native ints are not supported in _0x so comment out checks
+#print "not " unless length(pack("s!", 0)) == $Config{shortsize};
+print "ok ", $test++, "\n";
+
+#print "not " unless length(pack("i!", 0)) == $Config{intsize};
+print "ok ", $test++, "\n";
+
+#print "not " unless length(pack("l!", 0)) == $Config{longsize};
+print "ok ", $test++, "\n";
+
+#print "not " unless length(pack("s!", 0)) <= length(pack("i!", 0));
+print "ok ", $test++, "\n";
+
+#print "not " unless length(pack("i!", 0)) <= length(pack("l!", 0));
+print "ok ", $test++, "\n";
+
+#print "not " unless length(pack("i!", 0)) == length(pack("i", 0));
+print "ok ", $test++, "\n";
+
+# 79..138: pack <-> unpack bijectionism
+
+# 79.. 83 c
+foreach my $c (-128, -1, 0, 1, 127) {
+ print "not " unless unpack("c", pack("c", $c)) == $c;
+ print "ok ", $test++, "\n";
+}
+
+# 84.. 88: C
+foreach my $C (0, 1, 127, 128, 255) {
+ print "not " unless unpack("C", pack("C", $C)) == $C;
+ print "ok ", $test++, "\n";
+}
+
+# 89.. 93: s
+foreach my $s (-32768, -1, 0, 1, 32767) {
+ print "not " unless unpack("s", pack("s", $s)) == $s;
+ print "ok ", $test++, "\n";
+}
+
+# 94.. 98: S
+foreach my $S (0, 1, 32767, 32768, 65535) {
+ print "not " unless unpack("S", pack("S", $S)) == $S;
+ print "ok ", $test++, "\n";
+}
+
+# 99..103: i
+foreach my $i (-2147483648, -1, 0, 1, 2147483647) {
+ print "not " unless unpack("i", pack("i", $i)) == $i;
+ print "ok ", $test++, "\n";
+}
+
+# 104..108: I
+foreach my $I (0, 1, 2147483647, 2147483648, 4294967295) {
+ print "not " unless unpack("I", pack("I", $I)) == $I;
+ print "ok ", $test++, "\n";
+}
+
+# 109..113: l
+foreach my $l (-2147483648, -1, 0, 1, 2147483647) {
+ print "not " unless unpack("l", pack("l", $l)) == $l;
+ print "ok ", $test++, "\n";
+}
+
+# 114..118: L
+foreach my $L (0, 1, 2147483647, 2147483648, 4294967295) {
+ print "not " unless unpack("L", pack("L", $L)) == $L;
+ print "ok ", $test++, "\n";
+}
+
+# 119..123: n
+foreach my $n (0, 1, 32767, 32768, 65535) {
+ print "not " unless unpack("n", pack("n", $n)) == $n;
+ print "ok ", $test++, "\n";
+}
+
+# 124..128: v
+foreach my $v (0, 1, 32767, 32768, 65535) {
+ print "not " unless unpack("v", pack("v", $v)) == $v;
+ print "ok ", $test++, "\n";
+}
+
+# 129..133: N
+foreach my $N (0, 1, 2147483647, 2147483648, 4294967295) {
+ print "not " unless unpack("N", pack("N", $N)) == $N;
+ print "ok ", $test++, "\n";
+}
+
+# 134..138: V
+foreach my $V (0, 1, 2147483647, 2147483648, 4294967295) {
+ print "not " unless unpack("V", pack("V", $V)) == $V;
+ print "ok ", $test++, "\n";
+}
+
+# 139..142: pack nvNV byteorders
+
+print "not " unless pack("n", 0xdead) eq "\xde\xad";
+print "ok ", $test++, "\n";
+
+print "not " unless pack("v", 0xdead) eq "\xad\xde";
+print "ok ", $test++, "\n";
+
+print "not " unless pack("N", 0xdeadbeef) eq "\xde\xad\xbe\xef";
+print "ok ", $test++, "\n";
+
+print "not " unless pack("V", 0xdeadbeef) eq "\xef\xbe\xad\xde";
+print "ok ", $test++, "\n";
diff --git a/gnu/usr.bin/perl/t/op/pat.t b/gnu/usr.bin/perl/t/op/pat.t
index 4f44fb09be3..ed8c778d644 100644
--- a/gnu/usr.bin/perl/t/op/pat.t
+++ b/gnu/usr.bin/perl/t/op/pat.t
@@ -1,8 +1,19 @@
#!./perl
+#
+# This is a home for regular expression tests that don't fit into
+# the format supported by op/regexp.t. If you want to add a test
+# that does fit that format, add it to op/re_tests, not here.
-# $RCSfile: pat.t,v $$Revision: 1.2 $$Date: 1997/11/30 08:05:33 $
+print "1..142\n";
-print "1..62\n";
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = "../lib" if -d "../lib";
+}
+eval 'use Config'; # Defaults assumed if this fails
+
+# XXX known to leak scalars
+$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
$x = "abc\ndef\n";
@@ -67,7 +78,7 @@ $XXX{234} = 234;
$XXX{345} = 345;
@XXX = ('ok 25','not ok 25', 'ok 26','not ok 26','not ok 27');
-while ($_ = shift(XXX)) {
+while ($_ = shift(@XXX)) {
?(.*)? && (print $1,"\n");
/not/ && reset;
/not ok 26/ && reset 'X';
@@ -217,3 +228,375 @@ print "ok 61\n";
/\Gc/g;
print "not " if defined pos $_;
print "ok 62\n";
+
+$out = 1;
+'abc' =~ m'a(?{ $out = 2 })b';
+print "not " if $out != 2;
+print "ok 63\n";
+
+$out = 1;
+'abc' =~ m'a(?{ $out = 3 })c';
+print "not " if $out != 1;
+print "ok 64\n";
+
+$_ = 'foobar1 bar2 foobar3 barfoobar5 foobar6';
+@out = /(?<!foo)bar./g;
+print "not " if "@out" ne 'bar2 barf';
+print "ok 65\n";
+
+# Tests which depend on REG_INFTY
+$reg_infty = defined $Config{reg_infty} ? $Config{reg_infty} : 32767;
+$reg_infty_m = $reg_infty - 1; $reg_infty_p = $reg_infty + 1;
+
+# As well as failing if the pattern matches do unexpected things, the
+# next three tests will fail if you should have picked up a lower-than-
+# default value for $reg_infty from Config.pm, but have not.
+
+undef $@;
+print "not " if eval q(('aaa' =~ /(a{1,$reg_infty_m})/)[0] ne 'aaa') || $@;
+print "ok 66\n";
+
+undef $@;
+print "not " if eval q(('a' x $reg_infty_m) !~ /a{$reg_infty_m}/) || $@;
+print "ok 67\n";
+
+undef $@;
+print "not " if eval q(('a' x ($reg_infty_m - 1)) =~ /a{$reg_infty_m}/) || $@;
+print "ok 68\n";
+
+undef $@;
+eval "'aaa' =~ /a{1,$reg_infty}/";
+print "not " if $@ !~ m%^\Q/a{1,$reg_infty}/: Quantifier in {,} bigger than%;
+print "ok 69\n";
+
+eval "'aaa' =~ /a{1,$reg_infty_p}/";
+print "not "
+ if $@ !~ m%^\Q/a{1,$reg_infty_p}/: Quantifier in {,} bigger than%;
+print "ok 70\n";
+undef $@;
+
+# Poke a couple more parse failures
+
+$context = 'x' x 256;
+eval qq("${context}y" =~ /(?<=$context)y/);
+print "not " if $@ !~ m%^\Q/(?<=\Ex+/: lookbehind longer than 255 not%;
+print "ok 71\n";
+
+# This one will fail when POSIX character classes do get implemented
+{
+ my $w;
+ local $^W = 1;
+ local $SIG{__WARN__} = sub{$w = shift};
+ eval q('a' =~ /[[:alpha:]]/);
+ print "not " if $w !~ /^\QCharacter class syntax [: :] is reserved/;
+}
+print "ok 72\n";
+
+# Long Monsters
+$test = 73;
+for $l (125, 140, 250, 270, 300000, 30) { # Ordered to free memory
+ $a = 'a' x $l;
+ print "# length=$l\nnot " unless "ba$a=" =~ /a$a=/;
+ print "ok $test\n";
+ $test++;
+
+ print "not " if "b$a=" =~ /a$a=/;
+ print "ok $test\n";
+ $test++;
+}
+
+# 20000 nodes, each taking 3 words per string, and 1 per branch
+$long_constant_len = join '|', 12120 .. 32645;
+$long_var_len = join '|', 8120 .. 28645;
+%ans = ( 'ax13876y25677lbc' => 1,
+ 'ax13876y25677mcb' => 0, # not b.
+ 'ax13876y35677nbc' => 0, # Num too big
+ 'ax13876y25677y21378obc' => 1,
+ 'ax13876y25677y21378zbc' => 0, # Not followed by [k-o]
+ 'ax13876y25677y21378y21378kbc' => 1,
+ 'ax13876y25677y21378y21378kcb' => 0, # Not b.
+ 'ax13876y25677y21378y21378y21378kbc' => 0, # 5 runs
+ );
+
+for ( keys %ans ) {
+ print "# const-len `$_' not => $ans{$_}\nnot "
+ if $ans{$_} xor /a(?=([yx]($long_constant_len)){2,4}[k-o]).*b./o;
+ print "ok $test\n";
+ $test++;
+ print "# var-len `$_' not => $ans{$_}\nnot "
+ if $ans{$_} xor /a(?=([yx]($long_var_len)){2,4}[k-o]).*b./o;
+ print "ok $test\n";
+ $test++;
+}
+
+$_ = " a (bla()) and x(y b((l)u((e))) and b(l(e)e)e";
+$expect = "(bla()) ((l)u((e))) (l(e)e)";
+
+sub matchit {
+ m/
+ (
+ \(
+ (?{ $c = 1 }) # Initialize
+ (?:
+ (?(?{ $c == 0 }) # PREVIOUS iteration was OK, stop the loop
+ (?!
+ ) # Fail: will unwind one iteration back
+ )
+ (?:
+ [^()]+ # Match a big chunk
+ (?=
+ [()]
+ ) # Do not try to match subchunks
+ |
+ \(
+ (?{ ++$c })
+ |
+ \)
+ (?{ --$c })
+ )
+ )+ # This may not match with different subblocks
+ )
+ (?(?{ $c != 0 })
+ (?!
+ ) # Fail
+ ) # Otherwise the chunk 1 may succeed with $c>0
+ /xg;
+}
+
+push @ans, $res while $res = matchit;
+
+print "# ans='@ans'\n# expect='$expect'\nnot " if "@ans" ne "1 1 1";
+print "ok $test\n";
+$test++;
+
+@ans = matchit;
+
+print "# ans='@ans'\n# expect='$expect'\nnot " if "@ans" ne $expect;
+print "ok $test\n";
+$test++;
+
+@ans = ('a/b' =~ m%(.*/)?(.*)%); # Stack may be bad
+print "not " if "@ans" ne 'a/ b';
+print "ok $test\n";
+$test++;
+
+$code = '{$blah = 45}';
+$blah = 12;
+eval { /(?$code)/ };
+print "not " unless $@ and $@ =~ /not allowed at runtime/ and $blah == 12;
+print "ok $test\n";
+$test++;
+
+for $code ('{$blah = 45}','=xx') {
+ $blah = 12;
+ $res = eval { "xx" =~ /(?$code)/o };
+ if ($code eq '=xx') {
+ print "#'$@','$res','$blah'\nnot " unless not $@ and $res;
+ } else {
+ print "#'$@','$res','$blah'\nnot " unless $@ and $@ =~ /not allowed at runtime/ and $blah == 12;
+ }
+ print "ok $test\n";
+ $test++;
+}
+
+$code = '{$blah = 45}';
+$blah = 12;
+eval "/(?$code)/";
+print "not " if $blah != 45;
+print "ok $test\n";
+$test++;
+
+$blah = 12;
+/(?{$blah = 45})/;
+print "not " if $blah != 45;
+print "ok $test\n";
+$test++;
+
+$x = 'banana';
+$x =~ /.a/g;
+print "not " unless pos($x) == 2;
+print "ok $test\n";
+$test++;
+
+$x =~ /.z/gc;
+print "not " unless pos($x) == 2;
+print "ok $test\n";
+$test++;
+
+sub f {
+ my $p = $_[0];
+ return $p;
+}
+
+$x =~ /.a/g;
+print "not " unless f(pos($x)) == 4;
+print "ok $test\n";
+$test++;
+
+$x = $^R = 67;
+'foot' =~ /foo(?{$x = 12; 75})[t]/;
+print "not " unless $^R eq '75';
+print "ok $test\n";
+$test++;
+
+$x = $^R = 67;
+'foot' =~ /foo(?{$x = 12; 75})[xy]/;
+print "not " unless $^R eq '67' and $x eq '12';
+print "ok $test\n";
+$test++;
+
+$x = $^R = 67;
+'foot' =~ /foo(?{ $^R + 12 })((?{ $x = 12; $^R + 17 })[xy])?/;
+print "not " unless $^R eq '79' and $x eq '12';
+print "ok $test\n";
+$test++;
+
+print "not " unless qr/\b\v$/i eq '(?i-xsm:\bv$)';
+print "ok $test\n";
+$test++;
+
+print "not " unless qr/\b\v$/s eq '(?s-xim:\bv$)';
+print "ok $test\n";
+$test++;
+
+print "not " unless qr/\b\v$/m eq '(?m-xis:\bv$)';
+print "ok $test\n";
+$test++;
+
+print "not " unless qr/\b\v$/x eq '(?x-ism:\bv$)';
+print "ok $test\n";
+$test++;
+
+print "not " unless qr/\b\v$/xism eq '(?msix:\bv$)';
+print "ok $test\n";
+$test++;
+
+print "not " unless qr/\b\v$/ eq '(?-xism:\bv$)';
+print "ok $test\n";
+$test++;
+
+$_ = 'xabcx';
+foreach $ans ('', 'c') {
+ /(?<=(?=a)..)((?=c)|.)/g;
+ print "not " unless $1 eq $ans;
+ print "ok $test\n";
+ $test++;
+}
+
+$_ = 'a';
+foreach $ans ('', 'a', '') {
+ /^|a|$/g;
+ print "not " unless $& eq $ans;
+ print "ok $test\n";
+ $test++;
+}
+
+sub prefixify {
+ my($v,$a,$b,$res) = @_;
+ $v =~ s/\Q$a\E/$b/;
+ print "not " unless $res eq $v;
+ print "ok $test\n";
+ $test++;
+}
+prefixify('/a/b/lib/arch', "/a/b/lib", 'X/lib', 'X/lib/arch');
+prefixify('/a/b/man/arch', "/a/b/man", 'X/man', 'X/man/arch');
+
+$_ = 'var="foo"';
+/(\")/;
+print "not " unless $1 and /$1/;
+print "ok $test\n";
+$test++;
+
+$a=qr/(?{++$b})/;
+$b = 7;
+/$a$a/;
+print "not " unless $b eq '9';
+print "ok $test\n";
+$test++;
+
+$c="$a";
+/$a$a/;
+print "not " unless $b eq '11';
+print "ok $test\n";
+$test++;
+
+{
+ use re "eval";
+ /$a$c$a/;
+ print "not " unless $b eq '14';
+ print "ok $test\n";
+ $test++;
+
+ no re "eval";
+ $match = eval { /$a$c$a/ };
+ print "not "
+ unless $b eq '14' and $@ =~ /Eval-group not allowed/ and not $match;
+ print "ok $test\n";
+ $test++;
+}
+
+{
+ package aa;
+ $c = 2;
+ $::c = 3;
+ '' =~ /(?{ $c = 4 })/;
+ print "not " unless $c == 4;
+}
+print "ok $test\n";
+$test++;
+print "not " unless $c == 3;
+print "ok $test\n";
+$test++;
+
+sub must_warn_pat {
+ my $warn_pat = shift;
+ return sub { print "not " unless $_[0] =~ /$warn_pat/ }
+}
+
+sub must_warn {
+ my ($warn_pat, $code) = @_;
+ local $^W; local %SIG;
+ eval 'BEGIN { $^W = 1; $SIG{__WARN__} = $warn_pat };' . $code;
+ print "ok $test\n";
+ $test++;
+}
+
+
+sub make_must_warn {
+ my $warn_pat = shift;
+ return sub { must_warn(must_warn_pat($warn_pat)) }
+}
+
+my $for_future = make_must_warn('reserved for future extensions');
+
+&$for_future('q(a:[b]:) =~ /[x[:foo:]]/');
+&$for_future('q(a=[b]=) =~ /[x[=foo=]]/');
+&$for_future('q(a.[b].) =~ /[x[.foo.]]/');
+
+# test if failure of patterns returns empty list
+$_ = 'aaa';
+@_ = /bbb/;
+print "not " if @_;
+print "ok $test\n";
+$test++;
+
+@_ = /bbb/g;
+print "not " if @_;
+print "ok $test\n";
+$test++;
+
+@_ = /(bbb)/;
+print "not " if @_;
+print "ok $test\n";
+$test++;
+
+@_ = /(bbb)/g;
+print "not " if @_;
+print "ok $test\n";
+$test++;
+
+# see if matching against temporaries (created via pp_helem()) is safe
+{ foo => "ok $test\n".$^X }->{foo} =~ /^(.*)\n/g;
+print "$1\n";
+$test++;
+
diff --git a/gnu/usr.bin/perl/t/op/push.t b/gnu/usr.bin/perl/t/op/push.t
index 68fab66af77..a67caed2b31 100644
--- a/gnu/usr.bin/perl/t/op/push.t
+++ b/gnu/usr.bin/perl/t/op/push.t
@@ -16,16 +16,22 @@
-4, 4 5 6 7, 0 1 2 3
EOF
-print "1..", 2 + @tests, "\n";
+print "1..", 4 + @tests, "\n";
die "blech" unless @tests;
@x = (1,2,3);
push(@x,@x);
if (join(':',@x) eq '1:2:3:1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
-push(x,4);
+push(@x,4);
if (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
-$test = 3;
+# test for push/pop intuiting @ on array
+push(x,3);
+if (join(':',@x) eq '1:2:3:1:2:3:4:3') {print "ok 3\n";} else {print "not ok 3\n";}
+pop(x);
+if (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 4\n";} else {print "not ok 4\n";}
+
+$test = 5;
foreach $line (@tests) {
($list,$get,$leave) = split(/,\t*/,$line);
($pos, $len, @list) = split(' ',$list);
@@ -47,3 +53,4 @@ foreach $line (@tests) {
}
}
+1; # this file is require'd by lib/tie-stdpush.t
diff --git a/gnu/usr.bin/perl/t/op/quotemeta.t b/gnu/usr.bin/perl/t/op/quotemeta.t
index 20dd312b316..913e07cdd6a 100644
--- a/gnu/usr.bin/perl/t/op/quotemeta.t
+++ b/gnu/usr.bin/perl/t/op/quotemeta.t
@@ -1,14 +1,26 @@
#!./perl
+
print "1..15\n";
-$_=join "", map chr($_), 32..127;
+if ($^O eq 'os390') { # An EBCDIC variant.
+ $_=join "", map chr($_), 129..233;
+
+ # 105 characters - 52 letters = 53 backslashes
+ # 105 characters + 53 backslashes = 158 characters
+ $_=quotemeta $_;
+ if ( length == 158 ){print "ok 1\n"} else {print "not ok 1\n"}
+ # 104 non-backslash characters
+ if (tr/\\//cd == 104){print "ok 2\n"} else {print "not ok 2\n"}
+} else { # some ASCII descendant, then.
+ $_=join "", map chr($_), 32..127;
-# 96 characters - 52 letters - 10 digits - 1 underscore = 33 backslashes
-# 96 characters + 33 backslashes = 129 characters
-$_=quotemeta $_;
-if ( length == 129 ){print "ok 1\n"} else {print "not ok 1\n"}
-# 95 non-backslash characters
-if (tr/\\//cd == 95){print "ok 2\n"} else {print "not ok 2\n"}
+ # 96 characters - 52 letters - 10 digits - 1 underscore = 33 backslashes
+ # 96 characters + 33 backslashes = 129 characters
+ $_=quotemeta $_;
+ if ( length == 129 ){print "ok 1\n"} else {print "not ok 1\n"}
+ # 95 non-backslash characters
+ if (tr/\\//cd == 95){print "ok 2\n"} else {print "not ok 2\n"}
+}
if (length quotemeta "" == 0){print "ok 3\n"} else {print "not ok 3\n"}
diff --git a/gnu/usr.bin/perl/t/op/range.t b/gnu/usr.bin/perl/t/op/range.t
index 746da468005..01f5f705687 100644
--- a/gnu/usr.bin/perl/t/op/range.t
+++ b/gnu/usr.bin/perl/t/op/range.t
@@ -1,8 +1,6 @@
#!./perl
-# $RCSfile: range.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:14 $
-
-print "1..8\n";
+print "1..12\n";
print join(':',1..5) eq '1:2:3:4:5' ? "ok 1\n" : "not ok 1\n";
@@ -34,3 +32,26 @@ print $x eq 'abcdefghijklmnopqrstuvwxyz' ? "ok 7\n" : "not ok 7 $x\n";
@x = 'A'..'ZZ';
print @x == 27 * 26 ? "ok 8\n" : "not ok 8\n";
+
+@x = '09' .. '08'; # should produce '09', '10',... '99' (strange but true)
+print "not " unless join(",", @x) eq
+ join(",", map {sprintf "%02d",$_} 9..99);
+print "ok 9\n";
+
+# same test with foreach (which is a separate implementation)
+@y = ();
+foreach ('09'..'08') {
+ push(@y, $_);
+}
+print "not " unless join(",", @y) eq join(",", @x);
+print "ok 10\n";
+
+# check bounds
+@a = 0x7ffffffe..0x7fffffff;
+print "not " unless "@a" eq "2147483646 2147483647";
+print "ok 11\n";
+
+@a = -0x7fffffff..-0x7ffffffe;
+print "not " unless "@a" eq "-2147483647 -2147483646";
+print "ok 12\n";
+
diff --git a/gnu/usr.bin/perl/t/op/re_tests b/gnu/usr.bin/perl/t/op/re_tests
index ce4c5a51a23..3471cc3451f 100644
--- a/gnu/usr.bin/perl/t/op/re_tests
+++ b/gnu/usr.bin/perl/t/op/re_tests
@@ -8,6 +8,8 @@ ab*c abc y $& abc
ab*bc abc y $& abc
ab*bc abbc y $& abbc
ab*bc abbbbc y $& abbbbc
+.{1} abbbbc y $& a
+.{3,4} abbbbc y $& abbb
ab{0,}bc abbbbc y $& abbbbc
ab+bc abbc y $& abbc
ab+bc abc n - -
@@ -29,6 +31,7 @@ ab{0,1}c abc y $& abc
^abc abcc y $& abc
^abc$ aabc n - -
abc$ aabc y $& abc
+abc$ aabcd n - -
^ abc y $&
$ abc y $&
a.c abc y $& abc
@@ -148,8 +151,8 @@ a[bcd]+dcdcde adcdcde n - -
(bc+d$|ef*g.|h?i(j|k)) reffgz y $&-$1-$2 effgz-effgz-
((((((((((a)))))))))) a y $10 a
((((((((((a))))))))))\10 aa y $& aa
-((((((((((a))))))))))\41 aa n - -
-((((((((((a))))))))))\41 a! y $& a!
+((((((((((a))))))))))${bang} aa n - -
+((((((((((a))))))))))${bang} a! y $& a!
(((((((((a))))))))) a y $& a
multiple words of text uh-uh n - -
multiple words multiple words, yeah y $& multiple words
@@ -161,6 +164,16 @@ a(bc)d abcd y $1-\$1-\\$1 bc-$1-\bc
a[-]?c ac y $& ac
(abc)\1 abcabc y $1 abc
([a-c]*)\1 abcabc y $1 abc
+\1 - c - /\1/: reference to nonexistent group
+\2 - c - /\2/: reference to nonexistent group
+(a)|\1 a y - -
+(a)|\1 x n - -
+(a)|\2 - c - /(a)|\2/: reference to nonexistent group
+(([a-c])b*?\2)* ababbbcbc y $&-$1-$2 ababb-bb-b
+(([a-c])b*?\2){3} ababbbcbc y $&-$1-$2 ababbbcbc-cbc-c
+((\3|b)\2(a)x)+ aaxabxbaxbbx n - -
+((\3|b)\2(a)x)+ aaaxabaxbaaxbbax y $&-$1-$2-$3 bbax-bbax-b-a
+((\3|b)\2(a)){2,} bbaababbabaaaaabbaaaabba y $&-$1-$2-$3 bbaaaabba-bba-b-a
'abc'i ABC y $& ABC
'abc'i XBC n - -
'abc'i AXC n - -
@@ -278,8 +291,8 @@ a[-]?c ac y $& ac
'(bc+d$|ef*g.|h?i(j|k))'i REFFGZ y $&-$1-$2 EFFGZ-EFFGZ-
'((((((((((a))))))))))'i A y $10 A
'((((((((((a))))))))))\10'i AA y $& AA
-'((((((((((a))))))))))\41'i AA n - -
-'((((((((((a))))))))))\41'i A! y $& A!
+'((((((((((a))))))))))${bang}'i AA n - -
+'((((((((((a))))))))))${bang}'i A! y $& A!
'(((((((((a)))))))))'i A y $& A
'(?:(?:(?:(?:(?:(?:(?:(?:(?:(a))))))))))'i A y $1 A
'(?:(?:(?:(?:(?:(?:(?:(?:(?:(a|b|c))))))))))'i C y $1 C
@@ -299,10 +312,180 @@ a(?=c|d). abad y $& ad
a(?:b|c|d)(.) ace y $1 e
a(?:b|c|d)*(.) ace y $1 e
a(?:b|c|d)+?(.) ace y $1 e
+a(?:b|c|d)+?(.) acdbcdbe y $1 d
+a(?:b|c|d)+(.) acdbcdbe y $1 e
+a(?:b|c|d){2}(.) acdbcdbe y $1 b
+a(?:b|c|d){4,5}(.) acdbcdbe y $1 b
+a(?:b|c|d){4,5}?(.) acdbcdbe y $1 d
+((foo)|(bar))* foobar y $1-$2-$3 bar-foo-bar
+:(?: - c - /(?/: Sequence (? incomplete
+a(?:b|c|d){6,7}(.) acdbcdbe y $1 e
+a(?:b|c|d){6,7}?(.) acdbcdbe y $1 e
+a(?:b|c|d){5,6}(.) acdbcdbe y $1 e
+a(?:b|c|d){5,6}?(.) acdbcdbe y $1 b
+a(?:b|c|d){5,7}(.) acdbcdbe y $1 e
+a(?:b|c|d){5,7}?(.) acdbcdbe y $1 b
a(?:b|(c|e){1,2}?|d)+?(.) ace y $1$2 ce
^(.+)?B AB y $1 A
-'([a-z]+)\s\1'i Aa aa y $&-$1 Aa aa-Aa
-'([a-z]+)\s\1'i Ab ab y $&-$1 Ab ab-Ab
+^([^a-z])|(\^)$ . y $1 .
+^[<>]& <&OUT y $& <&
+^(a\1?){4}$ aaaaaaaaaa y $1 aaaa
+^(a\1?){4}$ aaaaaaaaa n - -
+^(a\1?){4}$ aaaaaaaaaaa n - -
+^(a(?(1)\1)){4}$ aaaaaaaaaa y $1 aaaa
+^(a(?(1)\1)){4}$ aaaaaaaaa n - -
+^(a(?(1)\1)){4}$ aaaaaaaaaaa n - -
+((a{4})+) aaaaaaaaa y $1 aaaaaaaa
+(((aa){2})+) aaaaaaaaaa y $1 aaaaaaaa
+(((a{2}){2})+) aaaaaaaaaa y $1 aaaaaaaa
+(?:(f)(o)(o)|(b)(a)(r))* foobar y $1:$2:$3:$4:$5:$6 f:o:o:b:a:r
+(?<=a)b ab y $& b
+(?<=a)b cb n - -
+(?<=a)b b n - -
+(?<!c)b ab y $& b
+(?<!c)b cb n - -
+(?<!c)b b y - -
+(?<!c)b b y $& b
+(?<%)b - c - /(?<%)b/: Sequence (?%...) not recognized
+(?:..)*a aba y $& aba
+(?:..)*?a aba y $& a
+^(?:b|a(?=(.)))*\1 abc y $& ab
+^(){3,5} abc y a$1 a
+^(a+)*ax aax y $1 a
+^((a|b)+)*ax aax y $1 a
+^((a|bc)+)*ax aax y $1 a
+(a|x)*ab cab y y$1 y
+(a)*ab cab y y$1 y
+(?:(?i)a)b ab y $& ab
+((?i)a)b ab y $&:$1 ab:a
+(?:(?i)a)b Ab y $& Ab
+((?i)a)b Ab y $&:$1 Ab:A
+(?:(?i)a)b aB n - -
+((?i)a)b aB n - -
+(?i:a)b ab y $& ab
+((?i:a))b ab y $&:$1 ab:a
+(?i:a)b Ab y $& Ab
+((?i:a))b Ab y $&:$1 Ab:A
+(?i:a)b aB n - -
+((?i:a))b aB n - -
+'(?:(?-i)a)b'i ab y $& ab
+'((?-i)a)b'i ab y $&:$1 ab:a
+'(?:(?-i)a)b'i aB y $& aB
+'((?-i)a)b'i aB y $&:$1 aB:a
+'(?:(?-i)a)b'i Ab n - -
+'((?-i)a)b'i Ab n - -
+'(?:(?-i)a)b'i aB y $& aB
+'((?-i)a)b'i aB y $1 a
+'(?:(?-i)a)b'i AB n - -
+'((?-i)a)b'i AB n - -
+'(?-i:a)b'i ab y $& ab
+'((?-i:a))b'i ab y $&:$1 ab:a
+'(?-i:a)b'i aB y $& aB
+'((?-i:a))b'i aB y $&:$1 aB:a
+'(?-i:a)b'i Ab n - -
+'((?-i:a))b'i Ab n - -
+'(?-i:a)b'i aB y $& aB
+'((?-i:a))b'i aB y $1 a
+'(?-i:a)b'i AB n - -
+'((?-i:a))b'i AB n - -
+'((?-i:a.))b'i a\nB n - -
+'((?s-i:a.))b'i a\nB y $1 a\n
+'((?s-i:a.))b'i B\nB n - -
+(?:c|d)(?:)(?:a(?:)(?:b)(?:b(?:))(?:b(?:)(?:b))) cabbbb y $& cabbbb
+(?:c|d)(?:)(?:aaaaaaaa(?:)(?:bbbbbbbb)(?:bbbbbbbb(?:))(?:bbbbbbbb(?:)(?:bbbbbbbb))) caaaaaaaabbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb y $& caaaaaaaabbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+'(ab)\d\1'i Ab4ab y $1 Ab
+'(ab)\d\1'i ab4Ab y $1 ab
foo\w*\d{4}baz foobar1234baz y $& foobar1234baz
-((foo)|(bar))* foobar y $1-$2-$3 bar-foo-bar
-:(?: - c - Sequence (? incomplete
+a(?{})b cabd y $& ab
+a(?{)b - c - /a(?{)b/: Sequence (?{...}) not terminated or not {}-balanced
+a(?{{})b - c - /a(?{{})b/: Sequence (?{...}) not terminated or not {}-balanced
+a(?{}})b - c - /a(?{}})b/: Sequence (?{...}) not terminated or not {}-balanced
+a(?{"{"})b - c - /a(?{"{"})b/: Sequence (?{...}) not terminated or not {}-balanced
+a(?{"\{"})b cabd y $& ab
+a(?{"{"}})b - c - Unmatched right bracket
+a(?{$bl="\{"}).b caxbd y $bl {
+x(~~)*(?:(?:F)?)? x~~ y - -
+^a(?#xxx){3}c aaac y $& aaac
+'^a (?#xxx) (?#yyy) {3}c'x aaac y $& aaac
+(?<![cd])b dbcb n - -
+(?<![cd])[ab] dbaacb y $& a
+(?<!(c|d))b dbcb n - -
+(?<!(c|d))[ab] dbaacb y $& a
+(?<!cd)[ab] cdaccb y $& b
+^(?:a?b?)*$ a-- n - -
+((?s)^a(.))((?m)^b$) a\nb\nc\n y $1;$2;$3 a\n;\n;b
+((?m)^b$) a\nb\nc\n y $1 b
+(?m)^b a\nb\n y $& b
+(?m)^(b) a\nb\n y $1 b
+((?m)^b) a\nb\n y $1 b
+\n((?m)^b) a\nb\n y $1 b
+((?s).)c(?!.) a\nb\nc\n y $1 \n
+((?s).)c(?!.) a\nb\nc\n y $1:$& \n:\nc
+((?s)b.)c(?!.) a\nb\nc\n y $1 b\n
+((?s)b.)c(?!.) a\nb\nc\n y $1:$& b\n:b\nc
+^b a\nb\nc\n n - -
+()^b a\nb\nc\n n - -
+((?m)^b) a\nb\nc\n y $1 b
+(?(1)a|b) a n - -
+(?(1)b|a) a y $& a
+(x)?(?(1)a|b) a n - -
+(x)?(?(1)b|a) a y $& a
+()?(?(1)b|a) a y $& a
+()(?(1)b|a) a n - -
+()?(?(1)a|b) a y $& a
+^(\()?blah(?(1)(\)))$ (blah) y $2 )
+^(\()?blah(?(1)(\)))$ blah y ($2) ()
+^(\()?blah(?(1)(\)))$ blah) n - -
+^(\()?blah(?(1)(\)))$ (blah n - -
+^(\(+)?blah(?(1)(\)))$ (blah) y $2 )
+^(\(+)?blah(?(1)(\)))$ blah y ($2) ()
+^(\(+)?blah(?(1)(\)))$ blah) n - -
+^(\(+)?blah(?(1)(\)))$ (blah n - -
+(?(1?)a|b) a c - /(?(1?)a|b)/: Switch (?(number? not recognized
+(?(1)a|b|c) a c - /(?(1)a|b|c)/: Switch (?(condition)... contains too many branches
+(?(?{0})a|b) a n - -
+(?(?{0})b|a) a y $& a
+(?(?{1})b|a) a n - -
+(?(?{1})a|b) a y $& a
+(?(?!a)a|b) a n - -
+(?(?!a)b|a) a y $& a
+(?(?=a)b|a) a n - -
+(?(?=a)a|b) a y $& a
+(?=(a+?))(\1ab) aaab y $2 aab
+^(?=(a+?))\1ab aaab n - -
+(\w+:)+ one: y $1 one:
+$(?<=^(a)) a y $1 a
+(?=(a+?))(\1ab) aaab y $2 aab
+^(?=(a+?))\1ab aaab n - -
+([\w:]+::)?(\w+)$ abcd: n - -
+([\w:]+::)?(\w+)$ abcd y $1-$2 -abcd
+([\w:]+::)?(\w+)$ xy:z:::abcd y $1-$2 xy:z:::-abcd
+^[^bcd]*(c+) aexycd y $1 c
+(a*)b+ caab y $1 aa
+([\w:]+::)?(\w+)$ abcd: n - -
+([\w:]+::)?(\w+)$ abcd y $1-$2 -abcd
+([\w:]+::)?(\w+)$ xy:z:::abcd y $1-$2 xy:z:::-abcd
+^[^bcd]*(c+) aexycd y $1 c
+(?{$a=2})a*aa(?{local$a=$a+1})k*c(?{$b=$a}) yaaxxaaaacd y $b 3
+(?{$a=2})(a(?{local$a=$a+1}))*aak*c(?{$b=$a}) yaaxxaaaacd y $b 4
+(>a+)ab aaab n - -
+(?>a+)b aaab y - -
+([[:]+) a:[b]: y $1 :[
+([[=]+) a=[b]= y $1 =[
+([[.]+) a.[b]. y $1 .[
+[a[:xyz: - c - /[a[:xyz:/: unmatched [] in regexp
+[a[:xyz:] - c - /[a[:xyz:]/: unmatched [] in regexp
+([a[:xyz:]b]+) pbaq y $1 ba
+((?>a+)b) aaab y $1 aaab
+(?>(a+))b aaab y $1 aaa
+((?>[^()]+)|\([^()]*\))+ ((abc(ade)ufh()()x y $& abc(ade)ufh()()x
+(?<=x+)y - c - /(?<=x+)y/: variable length lookbehind not implemented
+a{37,17} - c - /a{37,17}/: Can't do {n,m} with n > m
+a\Z a\nb\n n - -
+b\Z a\nb\n y - -
+b\z a\nb\n n - -
+b\Z a\nb y - -
+b\z a\nb y - -
+(^|x)(c) ca y $2 c
+a*abc?xyz+pqr{3}ab{2,}xy{4,5}pq{0,6}AB{0,}zz x n - -
+round\(((?>[^()]+))\) _I(round(xs * sz),1) y $1 xs * sz
diff --git a/gnu/usr.bin/perl/t/op/ref.t b/gnu/usr.bin/perl/t/op/ref.t
index 9fcc8ac15ce..1d70f9fd4c8 100644
--- a/gnu/usr.bin/perl/t/op/ref.t
+++ b/gnu/usr.bin/perl/t/op/ref.t
@@ -1,6 +1,6 @@
#!./perl
-print "1..51\n";
+print "1..55\n";
# Test glob operations.
@@ -231,12 +231,54 @@ $bar = "ok 48";
local(*bar) = *bar;
print "$bar\n";
+$var = "ok 49";
+$_ = \$var;
+print $$_,"\n";
+
+# test if reblessing during destruction results in more destruction
+
+{
+ package A;
+ sub new { bless {}, shift }
+ DESTROY { print "# destroying 'A'\nok 51\n" }
+ package B;
+ sub new { bless {}, shift }
+ DESTROY { print "# destroying 'B'\nok 50\n"; bless shift, 'A' }
+ package main;
+ my $b = B->new;
+}
+
+# test if $_[0] is properly protected in DESTROY()
+
+{
+ my $i = 0;
+ local $SIG{'__DIE__'} = sub {
+ my $m = shift;
+ if ($i++ > 4) {
+ print "# infinite recursion, bailing\nnot ok 52\n";
+ exit 1;
+ }
+ print "# $m";
+ if ($m =~ /^Modification of a read-only/) { print "ok 52\n" }
+ };
+ package C;
+ sub new { bless {}, shift }
+ DESTROY { $_[0] = 'foo' }
+ {
+ print "# should generate an error...\n";
+ my $c = C->new;
+ }
+ print "# good, didn't recurse\n";
+}
+
+# test global destruction
+
package FINALE;
{
- $ref3 = bless ["ok 51\n"]; # package destruction
- my $ref2 = bless ["ok 50\n"]; # lexical destruction
- local $ref1 = bless ["ok 49\n"]; # dynamic destruction
+ $ref3 = bless ["ok 55\n"]; # package destruction
+ my $ref2 = bless ["ok 54\n"]; # lexical destruction
+ local $ref1 = bless ["ok 53\n"]; # dynamic destruction
1; # flush any temp values on stack
}
diff --git a/gnu/usr.bin/perl/t/op/regexp.t b/gnu/usr.bin/perl/t/op/regexp.t
index 803f1d0dabf..11b3ee31da2 100644
--- a/gnu/usr.bin/perl/t/op/regexp.t
+++ b/gnu/usr.bin/perl/t/op/regexp.t
@@ -1,5 +1,8 @@
#!./perl
+# XXX known to leak scalars
+$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
+
# The tests are in a separate file 't/op/re_tests'.
# Each line in that file is a separate test.
# There are five columns, separated by tabs.
@@ -19,35 +22,63 @@
# Column 4 contains a string, usually C<$&>.
#
# Column 5 contains the expected result of double-quote
-# interpolating that string after the match.
+# interpolating that string after the match, or start of error message.
+#
+# \n in the tests are interpolated, as are variables of the form ${\w+}.
+#
+# If you want to add a regular expression test that can't be expressed
+# in this format, don't add it here: put it in op/pat.t instead.
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib' if -d '../lib';
+}
-open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests')
- || die "Can't open re_tests";
+$iters = shift || 1; # Poor man performance suite, 10000 is OK.
+
+open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests') ||
+ die "Can't open re_tests";
while (<TESTS>) { }
$numtests = $.;
seek(TESTS,0,0);
$. = 0;
+$bang = sprintf "\\%03o", ord "!"; # \41 would not be portable.
+
$| = 1;
-print "1..$numtests\n";
+print "1..$numtests\n# $iters iterations\n";
TEST:
while (<TESTS>) {
- ($pat, $subject, $result, $repl, $expect) = split(/[\t\n]/,$_);
+ chomp;
+ s/\\n/\n/g;
+ ($pat, $subject, $result, $repl, $expect) = split(/\t/,$_);
$input = join(':',$pat,$subject,$result,$repl,$expect);
+ infty_subst(\$pat);
+ infty_subst(\$expect);
$pat = "'$pat'" unless $pat =~ /^[:']/;
+ $pat =~ s/\\n/\n/g;
+ $pat =~ s/(\$\{\w+\})/$1/eeg;
+ $subject =~ s/\\n/\n/g;
+ $expect =~ s/\\n/\n/g;
+ $expect = $repl = '-' if $skip_amp and $input =~ /\$[&\`\']/;
for $study ("", "study \$subject") {
- eval "$study; \$match = (\$subject =~ m$pat); \$got = \"$repl\";";
+ $c = $iters;
+ eval "$study; \$match = (\$subject =~ m$pat) while \$c--; \$got = \"$repl\";";
+ chomp( $err = $@ );
if ($result eq 'c') {
- if ($@ !~ m!^\Q$expect!) { print "not ok $.\n"; next TEST }
+ if ($err !~ m!^\Q$expect!) { print "not ok $. (compile) $input => `$err'\n"; next TEST }
last; # no need to study a syntax error
}
+ elsif ($@) {
+ print "not ok $. $input => error `$err'\n"; next TEST;
+ }
elsif ($result eq 'n') {
- if ($match) { print "not ok $. $input => $got\n"; next TEST }
+ if ($match) { print "not ok $. ($study) $input => false positive\n"; next TEST }
}
else {
if (!$match || $got ne $expect) {
- print "not ok $. $input => $got\n";
+ print "not ok $. ($study) $input => `$got', match=$match\n";
next TEST;
}
}
@@ -56,3 +87,11 @@ while (<TESTS>) {
}
close(TESTS);
+
+sub infty_subst # Special-case substitution
+{ # of $reg_infty and friends
+ my $tp = shift;
+ $$tp =~ s/,\$reg_infty_m}/,$reg_infty_m}/o;
+ $$tp =~ s/,\$reg_infty_p}/,$reg_infty_p}/o;
+ $$tp =~ s/,\$reg_infty}/,$reg_infty}/o;
+}
diff --git a/gnu/usr.bin/perl/t/op/repeat.t b/gnu/usr.bin/perl/t/op/repeat.t
index 54fa590836f..f935bf106fa 100644
--- a/gnu/usr.bin/perl/t/op/repeat.t
+++ b/gnu/usr.bin/perl/t/op/repeat.t
@@ -2,7 +2,7 @@
# $RCSfile: repeat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:21 $
-print "1..19\n";
+print "1..20\n";
# compile time
@@ -40,3 +40,54 @@ print join(':', () x 4) eq '' ? "ok 16\n" : "not ok 16\n";
print join(':', (9) x 4) eq '9:9:9:9' ? "ok 17\n" : "not ok 17\n";
print join(':', (9,9) x 4) eq '9:9:9:9:9:9:9:9' ? "ok 18\n" : "not ok 18\n";
print join('', (split(//,"123")) x 2) eq '123123' ? "ok 19\n" : "not ok 19\n";
+
+#
+# The test #20 is actually testing for Digital C compiler optimizer bug.
+#
+# Dec C versions 5.* and 6.0 (used in Digital UNIX and VMS) used
+# to produce (as of December 1998) broken code for util.c:repeatcpy()
+# (a utility function for the 'x' operator) in the case *all* these
+# four conditions held:
+#
+# (1) len == 1
+# (2) "from" had the 8th bit on in its single character
+# (3) count > 7 (the 'x' count > 16)
+# (4) the highest optimization level was used in compilation
+# (which is the default when compiling Perl)
+#
+# The bug looked like this (. being the eight-bit character and ? being \xff):
+#
+# 16 ................
+# 17 .........???????.
+# 18 .........???????..
+# 19 .........???????...
+# 20 .........???????....
+# 21 .........???????.....
+# 22 .........???????......
+# 23 .........???????.......
+# 24 .........???????.???????
+# 25 .........???????.???????.
+#
+# The bug could be (obscurely) avoided by changing "from" to
+# be an unsigned char pointer.
+#
+# The bug was triggered in the "if (len == 1)" branch. The fix
+# was to introduce a new temporary variable. In diff -u format:
+#
+# register char *frombase = from;
+#
+# if (len == 1) {
+#- todo = *from;
+#+ register char c = *from;
+# while (count-- > 0)
+#- *to++ = todo;
+#+ *to++ = c;
+# return;
+# }
+#
+# This obscure bug was not found by the then test suite but instead
+# by Mark.Martinec@nsc.ijs.si while trying to install Digest-MD5-2.00.
+#
+# jhi@iki.fi
+#
+print "\xdd" x 24 eq "\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd" ? "ok 20\n" : "not ok 20\n";
diff --git a/gnu/usr.bin/perl/t/op/runlevel.t b/gnu/usr.bin/perl/t/op/runlevel.t
index 6693a829a88..bff3c363ac6 100644
--- a/gnu/usr.bin/perl/t/op/runlevel.t
+++ b/gnu/usr.bin/perl/t/op/runlevel.t
@@ -1,17 +1,9 @@
#!./perl
##
-## all of these tests are from Michael Schroeder
+## Many of these tests are originally from Michael Schroeder
## <Michael.Schroeder@informatik.uni-erlangen.de>
-##
-## The more esoteric failure modes require Michael's
-## stack-of-stacks patch (so we don't test them here,
-## and they are commented out before the __END__).
-##
-## The remaining tests pass with a simpler fix
-## intended for 5.004
-##
-## Gurusamy Sarathy <gsar@umich.edu> 97-02-24
+## Adapted and expanded by Gurusamy Sarathy <gsar@umich.edu>
##
chdir 't' if -d 't';
@@ -31,7 +23,7 @@ $tmpfile = "runltmp000";
END { if ($tmpfile) { 1 while unlink $tmpfile; } }
for (@prgs){
- my $switch;
+ my $switch = "";
if (s/^\s*(-\w+)//){
$switch = $1;
}
@@ -59,138 +51,6 @@ for (@prgs){
print "ok ", ++$i, "\n";
}
-=head2 stay out of here (the real tests are after __END__)
-
-##
-## these tests don't pass yet (need the full stack-of-stacks patch)
-## GSAR 97-02-24
-##
-
-########
-# sort within sort
-sub sortfn {
- (split(/./, 'x'x10000))[0];
- my (@y) = ( 4, 6, 5);
- @y = sort { $a <=> $b } @y;
- print "sortfn ".join(', ', @y)."\n";
- return $_[0] <=> $_[1];
-}
-@x = ( 3, 2, 1 );
-@x = sort { &sortfn($a, $b) } @x;
-print "---- ".join(', ', @x)."\n";
-EXPECT
-sortfn 4, 5, 6
----- 1, 2, 3
-########
-# trapping eval within sort (doesn't work currently because
-# die does a SWITCHSTACK())
-@a = (3, 2, 1);
-@a = sort { eval('die("no way")') , $a <=> $b} @a;
-print join(", ", @a)."\n";
-EXPECT
-1, 2, 3
-########
-# this actually works fine, but results in a poor error message
-@a = (1, 2, 3);
-foo:
-{
- @a = sort { last foo; } @a;
-}
-EXPECT
-cannot reach destination block at - line 2.
-########
-package TEST;
-
-sub TIESCALAR {
- my $foo;
- return bless \$foo;
-}
-sub FETCH {
- next;
- return "ZZZ";
-}
-sub STORE {
-}
-
-package main;
-
-tie $bar, TEST;
-{
- print "- $bar\n";
-}
-print "OK\n";
-EXPECT
-cannot reach destination block at - line 8.
-########
-package TEST;
-
-sub TIESCALAR {
- my $foo;
- return bless \$foo;
-}
-sub FETCH {
- goto bbb;
- return "ZZZ";
-}
-
-package main;
-
-tie $bar, TEST;
-print "- $bar\n";
-exit;
-bbb:
-print "bbb\n";
-EXPECT
-bbb
-########
-# trapping eval within sort (doesn't work currently because
-# die does a SWITCHSTACK())
-sub foo {
- $a <=> $b unless eval('$a == 0 ? die("foo\n") : ($a <=> $b)');
-}
-@a = (3, 2, 0, 1);
-@a = sort foo @a;
-print join(', ', @a)."\n";
-EXPECT
-0, 1, 2, 3
-########
-package TEST;
-sub TIESCALAR {
- my $foo;
- next;
- return bless \$foo;
-}
-package main;
-{
-tie $bar, TEST;
-}
-EXPECT
-cannot reach destination block at - line 4.
-########
-# large stack extension causes realloc, and segfault
-package TEST;
-sub TIESCALAR {
- my $foo;
- return bless \$foo;
-}
-sub FETCH {
- return "fetch";
-}
-sub STORE {
-(split(/./, 'x'x10000))[0];
-}
-package main;
-tie $bar, TEST;
-$bar = "x";
-
-=cut
-
-##
-##
-## The real tests begin here
-##
-##
-
__END__
@a = (1, 2, 3);
{
@@ -315,3 +175,163 @@ bar:
print "bar reached\n";
EXPECT
Can't "goto" outside a block at - line 2.
+########
+sub sortfn {
+ (split(/./, 'x'x10000))[0];
+ my (@y) = ( 4, 6, 5);
+ @y = sort { $a <=> $b } @y;
+ print "sortfn ".join(', ', @y)."\n";
+ return $_[0] <=> $_[1];
+}
+@x = ( 3, 2, 1 );
+@x = sort { &sortfn($a, $b) } @x;
+print "---- ".join(', ', @x)."\n";
+EXPECT
+sortfn 4, 5, 6
+sortfn 4, 5, 6
+sortfn 4, 5, 6
+---- 1, 2, 3
+########
+@a = (3, 2, 1);
+@a = sort { eval('die("no way")') , $a <=> $b} @a;
+print join(", ", @a)."\n";
+EXPECT
+1, 2, 3
+########
+@a = (1, 2, 3);
+foo:
+{
+ @a = sort { last foo; } @a;
+}
+EXPECT
+Label not found for "last foo" at - line 2.
+########
+package TEST;
+
+sub TIESCALAR {
+ my $foo;
+ return bless \$foo;
+}
+sub FETCH {
+ next;
+ return "ZZZ";
+}
+sub STORE {
+}
+
+package main;
+
+tie $bar, TEST;
+{
+ print "- $bar\n";
+}
+print "OK\n";
+EXPECT
+Can't "next" outside a block at - line 8.
+########
+package TEST;
+
+sub TIESCALAR {
+ my $foo;
+ return bless \$foo;
+}
+sub FETCH {
+ goto bbb;
+ return "ZZZ";
+}
+
+package main;
+
+tie $bar, TEST;
+print "- $bar\n";
+exit;
+bbb:
+print "bbb\n";
+EXPECT
+Can't find label bbb at - line 8.
+########
+sub foo {
+ $a <=> $b unless eval('$a == 0 ? die("foo\n") : ($a <=> $b)');
+}
+@a = (3, 2, 0, 1);
+@a = sort foo @a;
+print join(', ', @a)."\n";
+EXPECT
+0, 1, 2, 3
+########
+package TEST;
+sub TIESCALAR {
+ my $foo;
+ return bless \$foo;
+}
+sub FETCH {
+ return "fetch";
+}
+sub STORE {
+(split(/./, 'x'x10000))[0];
+}
+package main;
+tie $bar, TEST;
+$bar = "x";
+########
+package TEST;
+sub TIESCALAR {
+ my $foo;
+ next;
+ return bless \$foo;
+}
+package main;
+{
+tie $bar, TEST;
+}
+EXPECT
+Can't "next" outside a block at - line 4.
+########
+@a = (1, 2, 3);
+foo:
+{
+ @a = sort { exit(0) } @a;
+}
+END { print "foobar\n" }
+EXPECT
+foobar
+########
+$SIG{__DIE__} = sub {
+ print "In DIE\n";
+ $i = 0;
+ while (($p,$f,$l,$s) = caller(++$i)) {
+ print "$p|$f|$l|$s\n";
+ }
+};
+eval { die };
+&{sub { eval 'die' }}();
+sub foo { eval { die } } foo();
+EXPECT
+In DIE
+main|-|8|(eval)
+In DIE
+main|-|9|(eval)
+main|-|9|main::__ANON__
+In DIE
+main|-|10|(eval)
+main|-|10|main::foo
+########
+package TEST;
+
+sub TIEARRAY {
+ return bless [qw(foo fee fie foe)], $_[0];
+}
+sub FETCH {
+ my ($s,$i) = @_;
+ if ($i) {
+ goto bbb;
+ }
+bbb:
+ return $s->[$i];
+}
+
+package main;
+tie my @bar, 'TEST';
+print join('|', @bar[0..3]), "\n";
+EXPECT
+foo|fee|fie|foe
diff --git a/gnu/usr.bin/perl/t/op/sort.t b/gnu/usr.bin/perl/t/op/sort.t
index c792bbb48e6..fdb4e347a54 100644
--- a/gnu/usr.bin/perl/t/op/sort.t
+++ b/gnu/usr.bin/perl/t/op/sort.t
@@ -1,25 +1,47 @@
#!./perl
-# $RCSfile: sort.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:24 $
+print "1..29\n";
-print "1..19\n";
+# XXX known to leak scalars
+$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
sub backwards { $a lt $b ? 1 : $a gt $b ? -1 : 0 }
+my $upperfirst = 'A' lt 'a';
+
+# Beware: in future this may become hairier because of possible
+# collation complications: qw(A a B c) can be sorted at least as
+# any of the following
+#
+# A a B b
+# A B a b
+# a b A B
+# a A b B
+#
+# All the above orders make sense.
+#
+# That said, EBCDIC sorts all small letters first, as opposed
+# to ASCII which sorts all big letters first.
+
@harry = ('dog','cat','x','Cain','Abel');
@george = ('gone','chased','yz','punished','Axed');
$x = join('', sort @harry);
-print ($x eq 'AbelCaincatdogx' ? "ok 1\n" : "not ok 1\n");
-print "# x = '$x'\n";
+$expected = $upperfirst ? 'AbelCaincatdogx' : 'catdogxAbelCain';
+print "# 1: x = '$x', expected = '$expected'\n";
+print ($x eq $expected ? "ok 1\n" : "not ok 1\n");
$x = join('', sort( backwards @harry));
-print ($x eq 'xdogcatCainAbel' ? "ok 2\n" : "not ok 2\n");
-print "# x = '$x'\n";
+$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat';
+print "# 2: x = '$x', expected = '$expected'\n";
+print ($x eq $expected ? "ok 2\n" : "not ok 2\n");
$x = join('', sort @george, 'to', @harry);
-print ($x eq 'AbelAxedCaincatchaseddoggonepunishedtoxyz'?"ok 3\n":"not ok 3\n");
-print "# x = '$x'\n";
+$expected = $upperfirst ?
+ 'AbelAxedCaincatchaseddoggonepunishedtoxyz' :
+ 'catchaseddoggonepunishedtoxyzAbelAxedCain' ;
+print "# 3: x = '$x', expected = '$expected'\n";
+print ($x eq $expected ?"ok 3\n":"not ok 3\n");
@a = ();
@b = reverse @a;
@@ -47,7 +69,9 @@ print ("@b" eq "2 3 4 10" ? "ok 9\n" : "not ok 9 (@b)\n");
$sub = 'backwards';
$x = join('', sort $sub @harry);
-print ($x eq 'xdogcatCainAbel' ? "ok 10\n" : "not ok 10\n");
+$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat';
+print "# 10: x = $x, expected = '$expected'\n";
+print ($x eq $expected ? "ok 10\n" : "not ok 10\n");
# literals, combinations
@@ -91,3 +115,45 @@ print ($@ =~ /redefine active sort/ ? "ok 18\n" : "not ok 18\n");
};
eval { @b = sort twoface 4,1 };
print $@ ? "$@" : "not ok 19\n";
+
+eval <<'CODE';
+ my @result = sort main'backwards 'one', 'two';
+CODE
+print $@ ? "not ok 20\n# $@" : "ok 20\n";
+
+eval <<'CODE';
+ # "sort 'one', 'two'" should not try to parse "'one" as a sort sub
+ my @result = sort 'one', 'two';
+CODE
+print $@ ? "not ok 21\n# $@" : "ok 21\n";
+
+{
+ my $sortsub = \&backwards;
+ my $sortglob = *backwards;
+ my $sortglobr = \*backwards;
+ my $sortname = 'backwards';
+ @b = sort $sortsub 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 22\n" : "not ok 22 |@b|\n");
+ @b = sort $sortglob 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 23\n" : "not ok 23 |@b|\n");
+ @b = sort $sortname 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 24\n" : "not ok 24 |@b|\n");
+ @b = sort $sortglobr 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 25\n" : "not ok 25 |@b|\n");
+}
+
+{
+ local $sortsub = \&backwards;
+ local $sortglob = *backwards;
+ local $sortglobr = \*backwards;
+ local $sortname = 'backwards';
+ @b = sort $sortsub 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 26\n" : "not ok 26 |@b|\n");
+ @b = sort $sortglob 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 27\n" : "not ok 27 |@b|\n");
+ @b = sort $sortname 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 28\n" : "not ok 28 |@b|\n");
+ @b = sort $sortglobr 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 29\n" : "not ok 29 |@b|\n");
+}
+
diff --git a/gnu/usr.bin/perl/t/op/split.t b/gnu/usr.bin/perl/t/op/split.t
index 07246522ee1..7f0accea5ee 100644
--- a/gnu/usr.bin/perl/t/op/split.t
+++ b/gnu/usr.bin/perl/t/op/split.t
@@ -2,7 +2,7 @@
# $RCSfile: split.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:26 $
-print "1..20\n";
+print "1..25\n";
$FS = ':';
@@ -90,3 +90,24 @@ print $_ eq "Z" ? "ok 19\n" : "#$_\nnot ok 19\n";
$_ = join('|', split(/.?/, '',-1), 'Z');
print $_ eq "Z" ? "ok 20\n" : "#$_\nnot ok 20\n";
+
+# Are /^/m patterns scanned?
+$_ = join '|', split(/^a/m, "a b a\na d a", 20);
+print $_ eq "| b a\n| d a" ? "ok 21\n" : "not ok 21\n# `$_'\n";
+
+# Are /$/m patterns scanned?
+$_ = join '|', split(/a$/m, "a b a\na d a", 20);
+print $_ eq "a b |\na d |" ? "ok 22\n" : "not ok 22\n# `$_'\n";
+
+# Are /^/m patterns scanned?
+$_ = join '|', split(/^aa/m, "aa b aa\naa d aa", 20);
+print $_ eq "| b aa\n| d aa" ? "ok 23\n" : "not ok 23\n# `$_'\n";
+
+# Are /$/m patterns scanned?
+$_ = join '|', split(/aa$/m, "aa b aa\naa d aa", 20);
+print $_ eq "aa b |\naa d |" ? "ok 24\n" : "not ok 24\n# `$_'\n";
+
+# Greedyness:
+$_ = "a : b :c: d";
+@ary = split(/\s*:\s*/);
+if (($res = join(".",@ary)) eq "a.b.c.d") {print "ok 25\n";} else {print "not ok 25\n# res=`$res' != `a.b.c.d'\n";}
diff --git a/gnu/usr.bin/perl/t/op/sprintf.t b/gnu/usr.bin/perl/t/op/sprintf.t
index 1450ae375f0..b9b4751c791 100644
--- a/gnu/usr.bin/perl/t/op/sprintf.t
+++ b/gnu/usr.bin/perl/t/op/sprintf.t
@@ -14,8 +14,8 @@ $SIG{__WARN__} = sub {
};
$w = 0;
-$x = sprintf("%3s %-4s%%foo %5d%c%3.1f","hi",123,456,65,3.0999);
-if ($x eq ' hi 123 %foo 456A3.1' && $w == 0) {
+$x = sprintf("%3s %-4s%%foo %.0d%5d %#x%c%3.1f","hi",123,0,456,0,ord('A'),3.0999);
+if ($x eq ' hi 123 %foo 456 0A3.1' && $w == 0) {
print "ok 1\n";
} else {
print "not ok 1 '$x'\n";
diff --git a/gnu/usr.bin/perl/t/op/stat.t b/gnu/usr.bin/perl/t/op/stat.t
index 97f81928856..2207b40e309 100644
--- a/gnu/usr.bin/perl/t/op/stat.t
+++ b/gnu/usr.bin/perl/t/op/stat.t
@@ -9,18 +9,20 @@ BEGIN {
use Config;
-print "1..56\n";
+print "1..58\n";
$Is_MSWin32 = $^O eq 'MSWin32';
+$Is_Dos = $^O eq 'dos';
+$Is_Dosish = $Is_Dos || $^O eq 'os2' || $Is_MSWin32;
chop($cwd = ($Is_MSWin32 ? `cd` : `pwd`));
-$DEV = `ls -l /dev` unless $Is_MSWin32;
+$DEV = `ls -l /dev` unless $Is_Dosish;
unlink "Op.stat.tmp";
open(FOO, ">Op.stat.tmp");
# hack to make Apollo update link count:
-$junk = `ls Op.stat.tmp` unless $Is_MSWin32;
+$junk = `ls Op.stat.tmp` unless ($Is_MSWin32 || $Is_Dos);
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat(FOO);
@@ -33,7 +35,7 @@ close(FOO);
sleep 2;
-if ($Is_MSWin32) { unlink "Op.stat.tmp2" }
+if ($Is_Dosish) { unlink "Op.stat.tmp2" }
else {
`rm -f Op.stat.tmp2;ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`;
}
@@ -41,10 +43,19 @@ else {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat('Op.stat.tmp');
-if ($Is_MSWin32 || $Config{dont_use_nlink} || $nlink == 2)
- {print "ok 3\n";} else {print "# \$nlink is |$nlink|\nnot ok 3\n";}
-
-if ($Is_MSWin32 || ($mtime && $mtime != $ctime) || $cwd =~ m#/afs/# || $^O eq 'amigaos') {
+if ($Is_Dosish || $Config{dont_use_nlink})
+ {print "ok 3 # skipped: no link count\n";}
+elsif ($nlink == 2)
+ {print "ok 3\n";}
+else {print "# \$nlink is |$nlink|\nnot ok 3\n";}
+
+if ( $Is_Dosish
+ || ($cwd =~ m#^/tmp# and $mtime && $mtime==$ctime) # Solaris tmpfs bug
+ || $cwd =~ m#/afs/#
+ || $^O eq 'amigaos') {
+ print "ok 4 # skipped: different semantic of mtime/ctime\n";
+}
+elsif ( ($mtime && $mtime != $ctime) ) {
print "ok 4\n";
}
else {
@@ -52,7 +63,7 @@ else {
print "#4 If test op/stat.t fails test 4, check if you are on a tmpfs\n";
print "#4 of some sort. Building in /tmp sometimes has this problem.\n";
}
-print "#4 :$mtime: != :$ctime:\n";
+print "#4 :$mtime: should != :$ctime:\n";
unlink "Op.stat.tmp";
if ($Is_MSWin32) { open F, '>Op.stat.tmp' and close F }
@@ -70,7 +81,7 @@ $olduid = $>; # can't test -r if uid == 0
$Is_MSWin32 ? `cmd /c echo hi > Op.stat.tmp` : `echo hi >Op.stat.tmp`;
chmod 0,'Op.stat.tmp';
eval '$> = 1;'; # so switch uid (may not be implemented)
-if (!$> || ! -r 'Op.stat.tmp') {print "ok 9\n";} else {print "not ok 9\n";}
+if (!$> || $Is_Dos || ! -r 'Op.stat.tmp') {print "ok 9\n";} else {print "not ok 9\n";}
if (!$> || ! -w 'Op.stat.tmp') {print "ok 10\n";} else {print "not ok 10\n";}
eval '$> = $olduid;'; # switch uid back (may not be implemented)
print "# olduid=$olduid, newuid=$>\n" unless ($> == $olduid);
@@ -85,7 +96,9 @@ foreach ((12,13,14,15,16,17)) {
chmod 0700,'Op.stat.tmp';
if (-r 'Op.stat.tmp') {print "ok 18\n";} else {print "not ok 18\n";}
if (-w 'Op.stat.tmp') {print "ok 19\n";} else {print "not ok 19\n";}
-if ($Is_MSWin32 or -x 'Op.stat.tmp') {print "ok 20\n";} else {print "not ok 20\n";}
+if ($Is_Dosish) {print "ok 20 # skipped: -x by extension\n";}
+elsif (-x 'Op.stat.tmp') {print "ok 20\n";}
+else {print "not ok 20\n";}
if (-f 'Op.stat.tmp') {print "ok 21\n";} else {print "not ok 21\n";}
if (! -d 'Op.stat.tmp') {print "ok 22\n";} else {print "not ok 22\n";}
@@ -93,7 +106,7 @@ if (! -d 'Op.stat.tmp') {print "ok 22\n";} else {print "not ok 22\n";}
if (-d '.') {print "ok 23\n";} else {print "not ok 23\n";}
if (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";}
-if (!$Is_MSWin32 and `ls -l perl` =~ /^l.*->/) {
+if (!$Is_Dosish and `ls -l perl` =~ /^l.*->/) {
if (-l 'perl') {print "ok 25\n";} else {print "not ok 25\n";}
}
else {
@@ -103,10 +116,10 @@ else {
if (-o 'Op.stat.tmp') {print "ok 26\n";} else {print "not ok 26\n";}
if (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";}
-unlink 'Op.stat.tmp', 'Op.stat.tmp2';
-if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";}
+unlink 'Op.stat.tmp2';
+if (! -e 'Op.stat.tmp2') {print "ok 28\n";} else {print "not ok 28\n";}
-if ($Is_MSWin32)
+if ($Is_MSWin32 || $Is_Dos)
{print "ok 29\n";}
elsif ($DEV !~ /\nc.* (\S+)\n/)
{print "ok 29\n";}
@@ -116,7 +129,7 @@ else
{print "not ok 29\n";}
if (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";}
-if ($Is_MSWin32)
+if ($Is_MSWin32 || $Is_Dos)
{print "ok 31\n";}
elsif ($DEV !~ /\ns.* (\S+)\n/)
{print "ok 31\n";}
@@ -126,7 +139,7 @@ else
{print "not ok 31\n";}
if (! -S '.') {print "ok 32\n";} else {print "not ok 32\n";}
-if ($Is_MSWin32)
+if ($Is_MSWin32 || $Is_Dos)
{print "ok 33\n";}
elsif ($DEV !~ /\nb.* (\S+)\n/)
{print "ok 33\n";}
@@ -136,7 +149,9 @@ else
{print "not ok 33\n";}
if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";}
-if ($^O eq 'amigaos' or $Is_MSWin32) {print "ok 35\n"; goto tty_test;}
+if ($^O eq 'amigaos' or $Is_Dosish) {
+ print "ok 35 # skipped: no -u\n"; goto tty_test;
+}
$cnt = $uid = 0;
@@ -228,3 +243,10 @@ close(FOO);
if (-T '/dev/null') {print "ok 55\n";} else {print "not ok 55\n";}
if (-B '/dev/null') {print "ok 56\n";} else {print "not ok 56\n";}
+
+# and now, a few parsing tests:
+$_ = 'Op.stat.tmp';
+if (-f) {print "ok 57\n";} else {print "not ok 57\n";}
+if (-f()) {print "ok 58\n";} else {print "not ok 58\n";}
+
+unlink 'Op.stat.tmp';
diff --git a/gnu/usr.bin/perl/t/op/subst.t b/gnu/usr.bin/perl/t/op/subst.t
index a3d132b8dbb..afa06ab7721 100644
--- a/gnu/usr.bin/perl/t/op/subst.t
+++ b/gnu/usr.bin/perl/t/op/subst.t
@@ -1,8 +1,6 @@
#!./perl
-# $RCSfile: subst.t,v $$Revision: 1.2 $$Date: 1997/11/30 08:05:45 $
-
-print "1..62\n";
+print "1..71\n";
$x = 'foo';
$_ = "x";
@@ -157,11 +155,11 @@ $x ne $x || s/bb/x/;
print $_ eq 'aaaXXXXxb' ? "ok 39\n" : "not ok 39\n";
$_ = 'abc123xyz';
-s/\d+/$&*2/e; # yields 'abc246xyz'
+s/(\d+)/$1*2/e; # yields 'abc246xyz'
print $_ eq 'abc246xyz' ? "ok 40\n" : "not ok 40\n";
-s/\d+/sprintf("%5d",$&)/e; # yields 'abc 246xyz'
+s/(\d+)/sprintf("%5d",$1)/e; # yields 'abc 246xyz'
print $_ eq 'abc 246xyz' ? "ok 41\n" : "not ok 41\n";
-s/\w/$& x 2/eg; # yields 'aabbcc 224466xxyyzz'
+s/(\w)/$1 x 2/eg; # yields 'aabbcc 224466xxyyzz'
print $_ eq 'aabbcc 224466xxyyzz' ? "ok 42\n" : "not ok 42\n";
$_ = "aaaaa";
@@ -183,13 +181,21 @@ tr/a-z/A-Z/;
print $_ eq 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789' ? "ok 52\n" : "not ok 52\n";
# same as tr/A-Z/a-z/;
-y[\101-\132][\141-\172];
+if ($^O eq 'os390') { # An EBCDIC variant.
+ y[\301-\351][\201-\251];
+} else { # Ye Olde ASCII. Or something like it.
+ y[\101-\132][\141-\172];
+}
print $_ eq 'abcdefghijklmnopqrstuvwxyz0123456789' ? "ok 53\n" : "not ok 53\n";
-$_ = '+,-';
-tr/+--/a-c/;
-print $_ eq 'abc' ? "ok 54\n" : "not ok 54\n";
+if (ord("+") == ord(",") - 1 && ord(",") == ord("-") - 1 &&
+ ord("a") == ord("b") - 1 && ord("b") == ord("c") - 1) {
+ $_ = '+,-';
+ tr/+--/a-c/;
+ print "not " unless $_ eq 'abc';
+}
+print "ok 54\n";
$_ = '+,-';
tr/+\--/a\/c/;
@@ -232,10 +238,73 @@ print exp_vars('foo $(DIR)/yyy bar',0) eq 'foo $(UNDEFINEDNAME)/xxx/yyy bar'
# a match nested in the RHS of a substitution:
$_ = "abcd";
-s/../$x = $&, m#.#/eg;
+s/(..)/$x = $1, m#.#/eg;
print $x eq "cd" ? "ok 61\n" : "not ok 61\n";
+# Subst and lookbehind
+
+$_="ccccc";
+s/(?<!x)c/x/g;
+print $_ eq "xxxxx" ? "ok 62\n" : "not ok 62 # `$_' ne `xxxxx'\n";
+
+$_="ccccc";
+s/(?<!x)(c)/x/g;
+print $_ eq "xxxxx" ? "ok 63\n" : "not ok 63 # `$_' ne `xxxxx'\n";
+
+$_="foobbarfoobbar";
+s/(?<!r)foobbar/foobar/g;
+print $_ eq "foobarfoobbar" ? "ok 64\n" : "not ok 64 # `$_' ne `foobarfoobbar'\n";
+
+$_="foobbarfoobbar";
+s/(?<!ar)(foobbar)/foobar/g;
+print $_ eq "foobarfoobbar" ? "ok 65\n" : "not ok 65 # `$_' ne `foobarfoobbar'\n";
+
+$_="foobbarfoobbar";
+s/(?<!ar)foobbar/foobar/g;
+print $_ eq "foobarfoobbar" ? "ok 66\n" : "not ok 66 # `$_' ne `foobarfoobbar'\n";
+
# check parsing of split subst with comment
eval 's{foo} # this is a comment, not a delimiter
{bar};';
-print @? ? "not ok 62\n" : "ok 62\n";
+print @? ? "not ok 67\n" : "ok 67\n";
+
+# check if squashing works at the end of string
+$_="baacbaa";
+tr/a/b/s;
+print $_ eq "bbcbb" ? "ok 68\n" : "not ok 68 # `$_' ne `bbcbb'\n";
+
+# XXX TODO: Most tests above don't test return values of the ops. They should.
+$_ = "ab";
+print (s/a/b/ == 1 ? "ok 69\n" : "not ok 69\n");
+
+$_ = <<'EOL';
+ $url = new URI::URL "http://www/"; die if $url eq "xXx";
+EOL
+$^R = 'junk';
+
+$foo = ' $@%#lowercase $@%# lowercase UPPERCASE$@%#UPPERCASE' .
+ ' $@%#lowercase$@%#lowercase$@%# lowercase lowercase $@%#lowercase' .
+ ' lowercase $@%#MiXeD$@%# ';
+
+s{ \d+ \b [,.;]? (?{ 'digits' })
+ |
+ [a-z]+ \b [,.;]? (?{ 'lowercase' })
+ |
+ [A-Z]+ \b [,.;]? (?{ 'UPPERCASE' })
+ |
+ [A-Z] [a-z]+ \b [,.;]? (?{ 'Capitalized' })
+ |
+ [A-Za-z]+ \b [,.;]? (?{ 'MiXeD' })
+ |
+ [A-Za-z0-9]+ \b [,.;]? (?{ 'alphanumeric' })
+ |
+ \s+ (?{ ' ' })
+ |
+ [^A-Za-z0-9\s]+ (?{ '$@%#' })
+}{$^R}xg;
+print ($_ eq $foo ? "ok 70\n" : "not ok 70\n#'$_'\n#'$foo'\n");
+
+$_ = 'x' x 20;
+s/\d*|x/<$&>/g;
+$foo = '<>' . ('<x><>' x 20) ;
+print ($_ eq $foo ? "ok 71\n" : "not ok 71\n#'$_'\n#'$foo'\n");
diff --git a/gnu/usr.bin/perl/t/op/substr.t b/gnu/usr.bin/perl/t/op/substr.t
index 7950474814a..87efcb45124 100644
--- a/gnu/usr.bin/perl/t/op/substr.t
+++ b/gnu/usr.bin/perl/t/op/substr.t
@@ -1,8 +1,6 @@
#!./perl
-# $RCSfile: substr.t,v $$Revision: 1.2 $$Date: 1997/11/30 08:05:45 $
-
-print "1..97\n";
+print "1..106\n";
#P = start of string Q = start of substr R = end of substr S = end of string
@@ -14,8 +12,10 @@ $SIG{__WARN__} = sub {
$w++;
} elsif ($_[0] =~ /^Attempt to use reference as lvalue in substr/) {
$w += 2;
+ } elsif ($_[0] =~ /^Use of uninitialized value/) {
+ $w += 3;
} else {
- warn @_;
+ warn $_[0];
}
};
@@ -178,3 +178,34 @@ for (0,1) {
# check no spurious warnings
print $w ? "not ok 97\n" : "ok 97\n";
+
+# check new 4 arg replacement syntax
+$a = "abcxyz";
+$w = 0;
+print "not " unless substr($a, 0, 3, "") eq "abc" && $a eq "xyz";
+print "ok 98\n";
+print "not " unless substr($a, 0, 0, "abc") eq "" && $a eq "abcxyz";
+print "ok 99\n";
+print "not " unless substr($a, 3, -1, "") eq "xy" && $a eq "abcz";
+print "ok 100\n";
+
+print "not " unless substr($a, 3, undef, "xy") eq "" && $a eq "abcxyz"
+ && $w == 3;
+print "ok 101\n";
+$w = 0;
+
+print "not " unless substr($a, 3, 9999999, "") eq "xyz" && $a eq "abc";
+print "ok 102\n";
+print "not " unless fail(substr($a, -99, 0, ""));
+print "ok 103\n";
+print "not " unless fail(substr($a, 99, 3, ""));
+print "ok 104\n";
+
+substr($a, 0, length($a), "foo");
+print "not " unless $a eq "foo" && !$w;
+print "ok 105\n";
+
+# using 4 arg substr as lvalue is a compile time error
+eval 'substr($a,0,0,"") = "abc"';
+print "not " unless $@ && $@ =~ /Can't modify substr/ && $a eq "foo";
+print "ok 106\n";
diff --git a/gnu/usr.bin/perl/t/op/sysio.t b/gnu/usr.bin/perl/t/op/sysio.t
index 0af333db848..22e60e30fcc 100644
--- a/gnu/usr.bin/perl/t/op/sysio.t
+++ b/gnu/usr.bin/perl/t/op/sysio.t
@@ -1,12 +1,13 @@
#!./perl
-print "1..36\n";
+print "1..39\n";
chdir('op') || die "sysio.t: cannot look for myself: $!";
open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!";
-$reopen = ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'MSWin32');
+$reopen = ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos' ||
+ $^O eq 'mpeix');
$x = 'abc';
@@ -151,6 +152,21 @@ if ($reopen) { # must close file to update EOF marker for stat
print 'not ' unless (-s $outfile == 7);
print "ok 28\n";
+# with implicit length argument
+print 'not ' unless (syswrite(O, $x) == 3);
+print "ok 29\n";
+
+# $a still intact
+print 'not ' unless ($x eq "abc");
+print "ok 30\n";
+
+# $outfile should have grown now
+if ($reopen) { # must close file to update EOF marker for stat
+ close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
+}
+print 'not ' unless (-s $outfile == 10);
+print "ok 31\n";
+
close(O);
open(I, $outfile) || die "sysio.t: cannot read $outfile: $!";
@@ -158,30 +174,30 @@ open(I, $outfile) || die "sysio.t: cannot read $outfile: $!";
$b = 'xyz';
# reading too much only return as much as available
-print 'not ' unless (sysread(I, $b, 100) == 7);
-print "ok 29\n";
+print 'not ' unless (sysread(I, $b, 100) == 10);
+print "ok 32\n";
# this we should have
-print 'not ' unless ($b eq '#!ererl');
-print "ok 30\n";
+print 'not ' unless ($b eq '#!ererlabc');
+print "ok 33\n";
# test sysseek
print 'not ' unless sysseek(I, 2, 0) == 2;
-print "ok 31\n";
+print "ok 34\n";
sysread(I, $b, 3);
print 'not ' unless $b eq 'ere';
-print "ok 32\n";
+print "ok 35\n";
print 'not ' unless sysseek(I, -2, 1) == 3;
-print "ok 33\n";
+print "ok 36\n";
sysread(I, $b, 4);
print 'not ' unless $b eq 'rerl';
-print "ok 34\n";
+print "ok 37\n";
print 'not ' unless sysseek(I, 0, 0) eq '0 but true';
-print "ok 35\n";
+print "ok 38\n";
print 'not ' if defined sysseek(I, -1, 1);
-print "ok 36\n";
+print "ok 39\n";
close(I);
diff --git a/gnu/usr.bin/perl/t/op/taint.t b/gnu/usr.bin/perl/t/op/taint.t
index 8437c43c453..379093f5872 100644
--- a/gnu/usr.bin/perl/t/op/taint.t
+++ b/gnu/usr.bin/perl/t/op/taint.t
@@ -15,8 +15,13 @@ BEGIN {
use strict;
use Config;
+# We do not want the whole taint.t to fail
+# just because Errno possibly failing.
+eval { require Errno; import Errno };
+
my $Is_VMS = $^O eq 'VMS';
my $Is_MSWin32 = $^O eq 'MSWin32';
+my $Is_Dos = $^O eq 'dos';
my $Invoke_Perl = $Is_VMS ? 'MCR Sys$Disk:[]Perl.' :
$Is_MSWin32 ? '.\perl' : './perl';
my @MoreEnv = qw/IFS CDPATH ENV BASH_ENV/;
@@ -82,7 +87,7 @@ print PROG 'print "@ARGV\n"', "\n";
close PROG;
my $echo = "$Invoke_Perl $ECHO";
-print "1..140\n";
+print "1..149\n";
# First, let's make sure that Perl is checking the dangerous
# environment variables. Maybe they aren't set yet, so we'll
@@ -96,7 +101,7 @@ print "1..140\n";
test 1, eval { `$echo 1` } eq "1\n";
- if ($Is_MSWin32 || $Is_VMS) {
+ if ($Is_MSWin32 || $Is_VMS || $Is_Dos) {
print "# Environment tainting tests skipped\n";
for (2..5) { print "ok $_\n" }
}
@@ -120,7 +125,7 @@ print "1..140\n";
}
my $tmp;
- if ($^O eq 'os2' || $^O eq 'amigaos' || $Is_MSWin32) {
+ if ($^O eq 'os2' || $^O eq 'amigaos' || $Is_MSWin32 || $Is_Dos) {
print "# all directories are writeable\n";
}
else {
@@ -136,7 +141,7 @@ print "1..140\n";
test 7, $@ =~ /^Insecure directory in \$ENV{PATH}/, $@;
}
else {
- for (6..7) { print "ok $_\n" }
+ for (6..7) { print "ok $_ # Skipped: all directories are writeable\n" }
}
if ($Is_VMS) {
@@ -149,14 +154,12 @@ print "1..140\n";
test 11, $@ =~ /^Insecure directory in \$ENV{DCL\$PATH}/, $@;
}
else {
- print "# can't find world-writeable directory to test DCL\$PATH\n";
- for (10..11) { print "ok $_\n" }
+ for (10..11) { print "ok $_ # Skipped: can't find world-writeable directory to test DCL\$PATH\n" }
}
$ENV{'DCL$PATH'} = '';
}
else {
- print "# This is not VMS\n";
- for (8..11) { print "ok $_\n"; }
+ for (8..11) { print "ok $_ # Skipped: This is not VMS\n"; }
}
}
@@ -188,12 +191,28 @@ print "1..140\n";
test 20, not tainted $foo;
test 21, $foo eq 'bar';
+ {
+ use re 'taint';
+
+ ($foo) = ('bar' . $TAINT) =~ /(.+)/;
+ test 22, tainted $foo;
+ test 23, $foo eq 'bar';
+
+ $foo = $1 if ('bar' . $TAINT) =~ /(.+)/;
+ test 24, tainted $foo;
+ test 25, $foo eq 'bar';
+ }
+
+ $foo = $1 if 'bar' =~ /(.+)$TAINT/;
+ test 26, tainted $foo;
+ test 27, $foo eq 'bar';
+
my $pi = 4 * atan2(1,1) + $TAINT0;
- test 22, tainted $pi;
+ test 28, tainted $pi;
($pi) = $pi =~ /(\d+\.\d+)/;
- test 23, not tainted $pi;
- test 24, sprintf("%.5f", $pi) eq '3.14159';
+ test 29, not tainted $pi;
+ test 30, sprintf("%.5f", $pi) eq '3.14159';
}
# How about command-line arguments? The problem is that we don't
@@ -209,150 +228,151 @@ print "1..140\n";
};
close PROG;
print `$Invoke_Perl "-T" $arg and some suspect arguments`;
- test 25, !$?, "Exited with status $?";
+ test 31, !$?, "Exited with status $?";
unlink $arg;
}
# Reading from a file should be tainted
{
my $file = './TEST';
- test 26, open(FILE, $file), "Couldn't open '$file': $!";
+ test 32, open(FILE, $file), "Couldn't open '$file': $!";
my $block;
sysread(FILE, $block, 100);
my $line = <FILE>;
close FILE;
- test 27, tainted $block;
- test 28, tainted $line;
+ test 33, tainted $block;
+ test 34, tainted $line;
}
# Globs should be forbidden, except under VMS,
# which doesn't spawn an external program.
if ($Is_VMS) {
- for (29..30) { print "ok $_\n"; }
+ for (35..36) { print "ok $_\n"; }
}
else {
my @globs = eval { <*> };
- test 29, @globs == 0 && $@ =~ /^Insecure dependency/;
+ test 35, @globs == 0 && $@ =~ /^Insecure dependency/;
@globs = eval { glob '*' };
- test 30, @globs == 0 && $@ =~ /^Insecure dependency/;
+ test 36, @globs == 0 && $@ =~ /^Insecure dependency/;
}
# Output of commands should be tainted
{
my $foo = `$echo abc`;
- test 31, tainted $foo;
+ test 37, tainted $foo;
}
# Certain system variables should be tainted
{
- test 32, all_tainted $^X, $0;
+ test 38, all_tainted $^X, $0;
}
# Results of matching should all be untainted
{
my $foo = "abcdefghi" . $TAINT;
- test 33, tainted $foo;
+ test 39, tainted $foo;
$foo =~ /def/;
- test 34, not any_tainted $`, $&, $';
+ test 40, not any_tainted $`, $&, $';
$foo =~ /(...)(...)(...)/;
- test 35, not any_tainted $1, $2, $3, $+;
+ test 41, not any_tainted $1, $2, $3, $+;
my @bar = $foo =~ /(...)(...)(...)/;
- test 36, not any_tainted @bar;
+ test 42, not any_tainted @bar;
- test 37, tainted $foo; # $foo should still be tainted!
- test 38, $foo eq "abcdefghi";
+ test 43, tainted $foo; # $foo should still be tainted!
+ test 44, $foo eq "abcdefghi";
}
# Operations which affect files can't use tainted data.
{
- test 39, eval { chmod 0, $TAINT } eq '', 'chmod';
- test 40, $@ =~ /^Insecure dependency/, $@;
+ test 45, eval { chmod 0, $TAINT } eq '', 'chmod';
+ test 46, $@ =~ /^Insecure dependency/, $@;
# There is no feature test in $Config{} for truncate,
# so we allow for the possibility that it's missing.
- test 41, eval { truncate 'NoSuChFiLe', $TAINT0 } eq '', 'truncate';
- test 42, $@ =~ /^(?:Insecure dependency|truncate not implemented)/, $@;
+ test 47, eval { truncate 'NoSuChFiLe', $TAINT0 } eq '', 'truncate';
+ test 48, $@ =~ /^(?:Insecure dependency|truncate not implemented)/, $@;
- test 43, eval { rename '', $TAINT } eq '', 'rename';
- test 44, $@ =~ /^Insecure dependency/, $@;
+ test 49, eval { rename '', $TAINT } eq '', 'rename';
+ test 50, $@ =~ /^Insecure dependency/, $@;
- test 45, eval { unlink $TAINT } eq '', 'unlink';
- test 46, $@ =~ /^Insecure dependency/, $@;
+ test 51, eval { unlink $TAINT } eq '', 'unlink';
+ test 52, $@ =~ /^Insecure dependency/, $@;
- test 47, eval { utime $TAINT } eq '', 'utime';
- test 48, $@ =~ /^Insecure dependency/, $@;
+ test 53, eval { utime $TAINT } eq '', 'utime';
+ test 54, $@ =~ /^Insecure dependency/, $@;
if ($Config{d_chown}) {
- test 49, eval { chown -1, -1, $TAINT } eq '', 'chown';
- test 50, $@ =~ /^Insecure dependency/, $@;
+ test 55, eval { chown -1, -1, $TAINT } eq '', 'chown';
+ test 56, $@ =~ /^Insecure dependency/, $@;
}
else {
- print "# chown() is not available\n";
- for (49..50) { print "ok $_\n" }
+ for (55..56) { print "ok $_ # Skipped: chown() is not available\n" }
}
if ($Config{d_link}) {
- test 51, eval { link $TAINT, '' } eq '', 'link';
- test 52, $@ =~ /^Insecure dependency/, $@;
+ test 57, eval { link $TAINT, '' } eq '', 'link';
+ test 58, $@ =~ /^Insecure dependency/, $@;
}
else {
- print "# link() is not available\n";
- for (51..52) { print "ok $_\n" }
+ for (57..58) { print "ok $_ # Skipped: link() is not available\n" }
}
if ($Config{d_symlink}) {
- test 53, eval { symlink $TAINT, '' } eq '', 'symlink';
- test 54, $@ =~ /^Insecure dependency/, $@;
+ test 59, eval { symlink $TAINT, '' } eq '', 'symlink';
+ test 60, $@ =~ /^Insecure dependency/, $@;
}
else {
- print "# symlink() is not available\n";
- for (53..54) { print "ok $_\n" }
+ for (59..60) { print "ok $_ # Skipped: symlink() is not available\n" }
}
}
# Operations which affect directories can't use tainted data.
{
- test 55, eval { mkdir $TAINT0, $TAINT } eq '', 'mkdir';
- test 56, $@ =~ /^Insecure dependency/, $@;
+ test 61, eval { mkdir $TAINT0, $TAINT } eq '', 'mkdir';
+ test 62, $@ =~ /^Insecure dependency/, $@;
- test 57, eval { rmdir $TAINT } eq '', 'rmdir';
- test 58, $@ =~ /^Insecure dependency/, $@;
+ test 63, eval { rmdir $TAINT } eq '', 'rmdir';
+ test 64, $@ =~ /^Insecure dependency/, $@;
- test 59, eval { chdir $TAINT } eq '', 'chdir';
- test 60, $@ =~ /^Insecure dependency/, $@;
+ test 65, eval { chdir $TAINT } eq '', 'chdir';
+ test 66, $@ =~ /^Insecure dependency/, $@;
if ($Config{d_chroot}) {
- test 61, eval { chroot $TAINT } eq '', 'chroot';
- test 62, $@ =~ /^Insecure dependency/, $@;
+ test 67, eval { chroot $TAINT } eq '', 'chroot';
+ test 68, $@ =~ /^Insecure dependency/, $@;
}
else {
- print "# chroot() is not available\n";
- for (61..62) { print "ok $_\n" }
+ for (67..68) { print "ok $_ # Skipped: chroot() is not available\n" }
}
}
# Some operations using files can't use tainted data.
{
my $foo = "imaginary library" . $TAINT;
- test 63, eval { require $foo } eq '', 'require';
- test 64, $@ =~ /^Insecure dependency/, $@;
+ test 69, eval { require $foo } eq '', 'require';
+ test 70, $@ =~ /^Insecure dependency/, $@;
my $filename = "./taintB$$"; # NB: $filename isn't tainted!
END { unlink $filename if defined $filename }
$foo = $filename . $TAINT;
unlink $filename; # in any case
- test 65, eval { open FOO, $foo } eq '', 'open for read';
- test 66, $@ eq '', $@; # NB: This should be allowed
- test 67, $! == 2; # File not found
+ test 71, eval { open FOO, $foo } eq '', 'open for read';
+ test 72, $@ eq '', $@; # NB: This should be allowed
+
+ # Try first new style but allow also old style.
+ test 73, $!{ENOENT} ||
+ $! == 2 || # File not found
+ ($Is_Dos && $! == 22) ||
+ ($^O eq 'mint' && $! == 33);
- test 68, eval { open FOO, "> $foo" } eq '', 'open for write';
- test 69, $@ =~ /^Insecure dependency/, $@;
+ test 74, eval { open FOO, "> $foo" } eq '', 'open for write';
+ test 75, $@ =~ /^Insecure dependency/, $@;
}
# Commands to the system can't use tainted data
@@ -360,71 +380,67 @@ else {
my $foo = $TAINT;
if ($^O eq 'amigaos') {
- print "# open(\"|\") is not available\n";
- for (70..73) { print "ok $_\n" }
+ for (76..79) { print "ok $_ # Skipped: open('|') is not available\n" }
}
else {
- test 70, eval { open FOO, "| $foo" } eq '', 'popen to';
- test 71, $@ =~ /^Insecure dependency/, $@;
+ test 76, eval { open FOO, "| $foo" } eq '', 'popen to';
+ test 77, $@ =~ /^Insecure dependency/, $@;
- test 72, eval { open FOO, "$foo |" } eq '', 'popen from';
- test 73, $@ =~ /^Insecure dependency/, $@;
+ test 78, eval { open FOO, "$foo |" } eq '', 'popen from';
+ test 79, $@ =~ /^Insecure dependency/, $@;
}
- test 74, eval { exec $TAINT } eq '', 'exec';
- test 75, $@ =~ /^Insecure dependency/, $@;
+ test 80, eval { exec $TAINT } eq '', 'exec';
+ test 81, $@ =~ /^Insecure dependency/, $@;
- test 76, eval { system $TAINT } eq '', 'system';
- test 77, $@ =~ /^Insecure dependency/, $@;
+ test 82, eval { system $TAINT } eq '', 'system';
+ test 83, $@ =~ /^Insecure dependency/, $@;
$foo = "*";
taint_these $foo;
- test 78, eval { `$echo 1$foo` } eq '', 'backticks';
- test 79, $@ =~ /^Insecure dependency/, $@;
+ test 84, eval { `$echo 1$foo` } eq '', 'backticks';
+ test 85, $@ =~ /^Insecure dependency/, $@;
if ($Is_VMS) { # wildcard expansion doesn't invoke shell, so is safe
- test 80, join('', eval { glob $foo } ) ne '', 'globbing';
- test 81, $@ eq '', $@;
+ test 86, join('', eval { glob $foo } ) ne '', 'globbing';
+ test 87, $@ eq '', $@;
}
else {
- for (80..81) { print "ok $_\n"; }
+ for (86..87) { print "ok $_ # Skipped: this is not VMS\n"; }
}
}
# Operations which affect processes can't use tainted data.
{
- test 82, eval { kill 0, $TAINT } eq '', 'kill';
- test 83, $@ =~ /^Insecure dependency/, $@;
+ test 88, eval { kill 0, $TAINT } eq '', 'kill';
+ test 89, $@ =~ /^Insecure dependency/, $@;
if ($Config{d_setpgrp}) {
- test 84, eval { setpgrp 0, $TAINT } eq '', 'setpgrp';
- test 85, $@ =~ /^Insecure dependency/, $@;
+ test 90, eval { setpgrp 0, $TAINT } eq '', 'setpgrp';
+ test 91, $@ =~ /^Insecure dependency/, $@;
}
else {
- print "# setpgrp() is not available\n";
- for (84..85) { print "ok $_\n" }
+ for (90..91) { print "ok $_ # Skipped: setpgrp() is not available\n" }
}
if ($Config{d_setprior}) {
- test 86, eval { setpriority 0, $TAINT, $TAINT } eq '', 'setpriority';
- test 87, $@ =~ /^Insecure dependency/, $@;
+ test 92, eval { setpriority 0, $TAINT, $TAINT } eq '', 'setpriority';
+ test 93, $@ =~ /^Insecure dependency/, $@;
}
else {
- print "# setpriority() is not available\n";
- for (86..87) { print "ok $_\n" }
+ for (92..93) { print "ok $_ # Skipped: setpriority() is not available\n" }
}
}
# Some miscellaneous operations can't use tainted data.
{
if ($Config{d_syscall}) {
- test 88, eval { syscall $TAINT } eq '', 'syscall';
- test 89, $@ =~ /^Insecure dependency/, $@;
+ test 94, eval { syscall $TAINT } eq '', 'syscall';
+ test 95, $@ =~ /^Insecure dependency/, $@;
}
else {
- print "# syscall() is not available\n";
- for (88..89) { print "ok $_\n" }
+ for (94..95) { print "ok $_ # Skipped: syscall() is not available\n" }
}
{
@@ -433,18 +449,17 @@ else {
local *FOO;
my $temp = "./taintC$$";
END { unlink $temp }
- test 90, open(FOO, "> $temp"), "Couldn't open $temp for write: $!";
+ test 96, open(FOO, "> $temp"), "Couldn't open $temp for write: $!";
- test 91, eval { ioctl FOO, $TAINT, $foo } eq '', 'ioctl';
- test 92, $@ =~ /^Insecure dependency/, $@;
+ test 97, eval { ioctl FOO, $TAINT, $foo } eq '', 'ioctl';
+ test 98, $@ =~ /^Insecure dependency/, $@;
if ($Config{d_fcntl}) {
- test 93, eval { fcntl FOO, $TAINT, $foo } eq '', 'fcntl';
- test 94, $@ =~ /^Insecure dependency/, $@;
+ test 99, eval { fcntl FOO, $TAINT, $foo } eq '', 'fcntl';
+ test 100, $@ =~ /^Insecure dependency/, $@;
}
else {
- print "# fcntl() is not available\n";
- for (93..94) { print "ok $_\n" }
+ for (99..100) { print "ok $_ # Skipped: fcntl() is not available\n" }
}
close FOO;
@@ -455,65 +470,65 @@ else {
{
my $foo = 'abc' . $TAINT;
my $fooref = \$foo;
- test 95, not tainted $fooref;
- test 96, tainted $$fooref;
- test 97, tainted $foo;
+ test 101, not tainted $fooref;
+ test 102, tainted $$fooref;
+ test 103, tainted $foo;
}
# Some tests involving assignment
{
my $foo = $TAINT0;
my $bar = $foo;
- test 98, all_tainted $foo, $bar;
- test 99, tainted($foo = $bar);
- test 100, tainted($bar = $bar);
- test 101, tainted($bar += $bar);
- test 102, tainted($bar -= $bar);
- test 103, tainted($bar *= $bar);
- test 104, tainted($bar++);
- test 105, tainted($bar /= $bar);
- test 106, tainted($bar += 0);
- test 107, tainted($bar -= 2);
- test 108, tainted($bar *= -1);
- test 109, tainted($bar /= 1);
- test 110, tainted($bar--);
- test 111, $bar == 0;
+ test 104, all_tainted $foo, $bar;
+ test 105, tainted($foo = $bar);
+ test 106, tainted($bar = $bar);
+ test 107, tainted($bar += $bar);
+ test 108, tainted($bar -= $bar);
+ test 109, tainted($bar *= $bar);
+ test 110, tainted($bar++);
+ test 111, tainted($bar /= $bar);
+ test 112, tainted($bar += 0);
+ test 113, tainted($bar -= 2);
+ test 114, tainted($bar *= -1);
+ test 115, tainted($bar /= 1);
+ test 116, tainted($bar--);
+ test 117, $bar == 0;
}
# Test assignment and return of lists
{
my @foo = ("A", "tainted" . $TAINT, "B");
- test 112, not tainted $foo[0];
- test 113, tainted $foo[1];
- test 114, not tainted $foo[2];
+ test 118, not tainted $foo[0];
+ test 119, tainted $foo[1];
+ test 120, not tainted $foo[2];
my @bar = @foo;
- test 115, not tainted $bar[0];
- test 116, tainted $bar[1];
- test 117, not tainted $bar[2];
+ test 121, not tainted $bar[0];
+ test 122, tainted $bar[1];
+ test 123, not tainted $bar[2];
my @baz = eval { "A", "tainted" . $TAINT, "B" };
- test 118, not tainted $baz[0];
- test 119, tainted $baz[1];
- test 120, not tainted $baz[2];
+ test 124, not tainted $baz[0];
+ test 125, tainted $baz[1];
+ test 126, not tainted $baz[2];
my @plugh = eval q[ "A", "tainted" . $TAINT, "B" ];
- test 121, not tainted $plugh[0];
- test 122, tainted $plugh[1];
- test 123, not tainted $plugh[2];
+ test 127, not tainted $plugh[0];
+ test 128, tainted $plugh[1];
+ test 129, not tainted $plugh[2];
my $nautilus = sub { "A", "tainted" . $TAINT, "B" };
- test 124, not tainted ((&$nautilus)[0]);
- test 125, tainted ((&$nautilus)[1]);
- test 126, not tainted ((&$nautilus)[2]);
+ test 130, not tainted ((&$nautilus)[0]);
+ test 131, tainted ((&$nautilus)[1]);
+ test 132, not tainted ((&$nautilus)[2]);
my @xyzzy = &$nautilus;
- test 127, not tainted $xyzzy[0];
- test 128, tainted $xyzzy[1];
- test 129, not tainted $xyzzy[2];
+ test 133, not tainted $xyzzy[0];
+ test 134, tainted $xyzzy[1];
+ test 135, not tainted $xyzzy[2];
my $red_october = sub { return "A", "tainted" . $TAINT, "B" };
- test 130, not tainted ((&$red_october)[0]);
- test 131, tainted ((&$red_october)[1]);
- test 132, not tainted ((&$red_october)[2]);
+ test 136, not tainted ((&$red_october)[0]);
+ test 137, tainted ((&$red_october)[1]);
+ test 138, not tainted ((&$red_october)[2]);
my @corge = &$red_october;
- test 133, not tainted $corge[0];
- test 134, tainted $corge[1];
- test 135, not tainted $corge[2];
+ test 139, not tainted $corge[0];
+ test 140, tainted $corge[1];
+ test 141, not tainted $corge[2];
}
# Test for system/library calls returning string data of dubious origin.
@@ -523,7 +538,7 @@ else {
setpwent();
my @getpwent = getpwent();
die "getpwent: $!\n" unless (@getpwent);
- test 136,( not tainted $getpwent[0]
+ test 142,( not tainted $getpwent[0]
and not tainted $getpwent[1]
and not tainted $getpwent[2]
and not tainted $getpwent[3]
@@ -534,19 +549,17 @@ else {
and not tainted $getpwent[8]);
endpwent();
} else {
- print "# getpwent() is not available\n";
- print "ok 136\n";
+ for (142) { print "ok $_ # Skipped: getpwent() is not available\n" }
}
if ($Config{d_readdir}) { # pretty hard to imagine not
local(*D);
opendir(D, "op") or die "opendir: $!\n";
my $readdir = readdir(D);
- test 137, tainted $readdir;
+ test 143, tainted $readdir;
closedir(OP);
} else {
- print "# readdir() is not available\n";
- print "ok 137\n";
+ for (143) { print "ok $_ # Skipped: readdir() is not available\n" }
}
if ($Config{d_readlink} && $Config{d_symlink}) {
@@ -554,11 +567,10 @@ else {
unlink($symlink);
symlink("/something/naughty", $symlink) or die "symlink: $!\n";
my $readlink = readlink($symlink);
- test 138, tainted $readlink;
+ test 144, tainted $readlink;
unlink($symlink);
} else {
- print "# readlink() or symlink() is not available\n";
- print "ok 138\n";
+ for (144) { print "ok $_ # Skipped: readlink() or symlink() is not available\n"; }
}
}
@@ -566,9 +578,22 @@ else {
{
my $why = "y";
my $j = "x" | $why;
- test 139, not tainted $j;
+ test 145, not tainted $j;
$why = $TAINT."y";
$j = "x" | $why;
- test 140, tainted $j;
+ test 146, tainted $j;
}
+# test target of substitution (regression bug)
+{
+ my $why = $TAINT."y";
+ $why =~ s/y/z/;
+ test 147, tainted $why;
+
+ my $z = "[z]";
+ $why =~ s/$z/zee/;
+ test 148, tainted $why;
+
+ $why =~ s/e/'-'.$$/ge;
+ test 149, tainted $why;
+}
diff --git a/gnu/usr.bin/perl/t/op/tie.t b/gnu/usr.bin/perl/t/op/tie.t
index 77e74db4e2c..472a6a7e36f 100644
--- a/gnu/usr.bin/perl/t/op/tie.t
+++ b/gnu/usr.bin/perl/t/op/tie.t
@@ -153,3 +153,16 @@ $C = $B = tied %H ;
}
untie %H;
EXPECT
+########
+
+# verify no leak when underlying object is selfsame tied variable
+my ($a, $b);
+sub Self::TIEHASH { bless $_[1], $_[0] }
+sub Self::DESTROY { $b = $_[0] + 0; }
+{
+ my %b5;
+ $a = \%b5 + 0;
+ tie %b5, 'Self', \%b5;
+}
+die unless $a == $b;
+EXPECT
diff --git a/gnu/usr.bin/perl/t/op/undef.t b/gnu/usr.bin/perl/t/op/undef.t
index 8ab2ec421f3..5b3c7ef0b97 100644
--- a/gnu/usr.bin/perl/t/op/undef.t
+++ b/gnu/usr.bin/perl/t/op/undef.t
@@ -1,8 +1,6 @@
#!./perl
-# $RCSfile: undef.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:34 $
-
-print "1..21\n";
+print "1..23\n";
print defined($a) ? "not ok 1\n" : "ok 1\n";
@@ -54,3 +52,10 @@ sub foo { print "ok 19\n"; }
print defined &foo ? "ok 20\n" : "not ok 20\n";
undef &foo;
print defined(&foo) ? "not ok 21\n" : "ok 21\n";
+
+eval { undef $1 };
+print $@ =~ /^Modification of a read/ ? "ok 22\n" : "not ok 22\n";
+
+eval { $1 = undef };
+print $@ =~ /^Modification of a read/ ? "ok 23\n" : "not ok 23\n";
+
diff --git a/gnu/usr.bin/perl/t/op/universal.t b/gnu/usr.bin/perl/t/op/universal.t
index bd6c73afe99..bde78fd04ce 100644
--- a/gnu/usr.bin/perl/t/op/universal.t
+++ b/gnu/usr.bin/perl/t/op/universal.t
@@ -75,7 +75,11 @@ test ! (eval { $a->VERSION(2.719) }) &&
test (eval { $a->VERSION(2.718) }) && ! $@;
my $subs = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::;
-test $subs eq "VERSION can isa";
+if ('a' lt 'A') {
+ test $subs eq "can isa VERSION";
+} else {
+ test $subs eq "VERSION can isa";
+}
test $a->isa("UNIVERSAL");
@@ -86,7 +90,11 @@ test $a->isa("UNIVERSAL");
my $sub2 = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::;
# XXX import being here is really a bug
-test $sub2 eq "VERSION can import isa";
+if ('a' lt 'A') {
+ test $sub2 eq "can import isa VERSION";
+} else {
+ test $sub2 eq "VERSION can import isa";
+}
eval 'sub UNIVERSAL::sleep {}';
test $a->can("sleep");
diff --git a/gnu/usr.bin/perl/t/op/vec.t b/gnu/usr.bin/perl/t/op/vec.t
index 97b6d60989e..71171447d6e 100644
--- a/gnu/usr.bin/perl/t/op/vec.t
+++ b/gnu/usr.bin/perl/t/op/vec.t
@@ -2,7 +2,7 @@
# $RCSfile: vec.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:36 $
-print "1..13\n";
+print "1..15\n";
print vec($foo,0,1) == 0 ? "ok 1\n" : "not ok 1\n";
print length($foo) == 0 ? "ok 2\n" : "not ok 2\n";
@@ -21,4 +21,7 @@ print vec($foo,1,8) == 0xf1 ? "ok 10\n" : "not ok 10\n";
print ((ord(substr($foo,1,1)) & 255) == 0xf1 ? "ok 11\n" : "not ok 11\n");
print vec($foo,2,4) == 1 ? "ok 12\n" : "not ok 12\n";
print vec($foo,3,4) == 15 ? "ok 13\n" : "not ok 13\n";
+vec($Vec, 0, 32) = 0xbaddacab;
+print $Vec eq "\xba\xdd\xac\xab" ? "ok 14\n" : "not ok 14\n";
+print vec($Vec, 0, 32) == 3135089835 ? "ok 15\n" : "not ok 15\n";
diff --git a/gnu/usr.bin/perl/t/op/write.t b/gnu/usr.bin/perl/t/op/write.t
index 705fa7977b3..9918b2f57f9 100644
--- a/gnu/usr.bin/perl/t/op/write.t
+++ b/gnu/usr.bin/perl/t/op/write.t
@@ -2,7 +2,7 @@
# $RCSfile: write.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:38 $
-print "1..5\n";
+print "1..6\n";
my $CAT = ($^O eq 'MSWin32') ? 'type' : 'cat';
@@ -167,3 +167,26 @@ for (0..10) {
print $was1 eq $mustbe ? "ok 4\n" : "not ok 4\n";
print $was2 eq $mustbe ? "ok 5\n" : "not ok 5\n";
+$^A = '';
+
+# more test
+
+format OUT3 =
+^<<<<<<...
+$foo
+.
+
+open(OUT3, '>Op_write.tmp') || die "Can't create Op_write.tmp";
+
+$foo = 'fit ';
+write(OUT3);
+close OUT3;
+
+$right =
+"fit\n";
+
+if (`$CAT Op_write.tmp` eq $right)
+ { print "ok 6\n"; unlink 'Op_write.tmp'; }
+else
+ { print "not ok 6\n"; }
+
diff --git a/gnu/usr.bin/perl/t/pragma/constant.t b/gnu/usr.bin/perl/t/pragma/constant.t
index 0095f3b627b..5b63dfacc29 100644
--- a/gnu/usr.bin/perl/t/pragma/constant.t
+++ b/gnu/usr.bin/perl/t/pragma/constant.t
@@ -14,7 +14,7 @@ END { print @warnings }
######################### We start with some black magic to print on failure.
-BEGIN { $| = 1; print "1..39\n"; }
+BEGIN { $| = 1; print "1..46\n"; }
END {print "not ok 1\n" unless $loaded;}
use constant;
$loaded = 1;
@@ -81,7 +81,7 @@ test 18, (COUNTLIST)[1] == 4;
use constant ABC => 'ABC';
test 19, "abc${\( ABC )}abc" eq "abcABCabc";
-use constant DEF => 'D', "\x45", chr 70;
+use constant DEF => 'D', 'E', chr ord 'F';
test 20, "d e f @{[ DEF ]} d e f" eq "d e f D E F d e f";
use constant SINGLE => "'";
@@ -139,3 +139,19 @@ test 37, @warnings &&
test 38, @warnings == 0, "unexpected warning";
test 39, $^W & 1, "Who disabled the warnings?";
+
+use constant CSCALAR => \"ok 40\n";
+use constant CHASH => { foo => "ok 41\n" };
+use constant CARRAY => [ undef, "ok 42\n" ];
+use constant CPHASH => [ { foo => 1 }, "ok 43\n" ];
+use constant CCODE => sub { "ok $_[0]\n" };
+
+print ${+CSCALAR};
+print CHASH->{foo};
+print CARRAY->[1];
+print CPHASH->{foo};
+eval q{ CPHASH->{bar} };
+test 44, scalar($@ =~ /^No such array/);
+print CCODE->(45);
+eval q{ CCODE->{foo} };
+test 46, scalar($@ =~ /^Constant is not a HASH/);
diff --git a/gnu/usr.bin/perl/t/pragma/locale.t b/gnu/usr.bin/perl/t/pragma/locale.t
index 8e296db8a7c..7e3df8c3f11 100644
--- a/gnu/usr.bin/perl/t/pragma/locale.t
+++ b/gnu/usr.bin/perl/t/pragma/locale.t
@@ -19,6 +19,13 @@ eval {
$have_setlocale++;
};
+# Visual C's CRT goes silly on strings of the form "en_US.ISO8859-1"
+# and mingw32 uses said silly CRT
+$have_setlocale = 0 if $^O eq 'MSWin32' && $Config{cc} =~ /^(cl|gcc)/i;
+
+# 103 (the last test) may fail but that is okay.
+# (It indicates something broken in the environment, not Perl)
+# Therefore .. only until 102, not 103.
print "1..", ($have_setlocale ? 102 : 98), "\n";
use vars qw($a
@@ -283,22 +290,26 @@ locatelocale(\$Spanish, \@Spanish,
# Select the largest of the alpha(num)bets.
($Locale, @Locale) = ($English, @English)
- if (length(@English) > length(@Locale));
+ if (@English > @Locale);
($Locale, @Locale) = ($German, @German)
- if (length(@German) > length(@Locale));
+ if (@German > @Locale);
($Locale, @Locale) = ($French, @French)
- if (length(@French) > length(@Locale));
+ if (@French > @Locale);
($Locale, @Locale) = ($Spanish, @Spanish)
- if (length(@Spanish) > length(@Locale));
-
-print "# Locale = $Locale\n";
-print "# Alnum_ = @Locale\n";
+ if (@Spanish > @Locale);
{
local $^W = 0;
setlocale(&LC_ALL, $Locale);
}
+# Sort it now that LC_ALL has been set.
+
+@Locale = sort @Locale;
+
+print "# Locale = $Locale\n";
+print "# Alnum_ = @Locale\n";
+
{
my $i = 0;
@@ -396,6 +407,7 @@ print "ok 101\n";
# Test for read-onlys.
+print "# testing 102\n";
{
no locale;
$a = "qwerty";
@@ -411,7 +423,7 @@ print "ok 102\n";
# Thanks to Hallvard Furuseth <h.b.furuseth@usit.uio.no>
# for inventing a way to test for ordering consistency
# without requiring any particular order.
-# ++$jhi;#@iki.fi
+# <jhi@iki.fi>
print "# testing 103\n";
{
diff --git a/gnu/usr.bin/perl/t/pragma/overload.t b/gnu/usr.bin/perl/t/pragma/overload.t
index 42d045741de..0682266ab49 100644
--- a/gnu/usr.bin/perl/t/pragma/overload.t
+++ b/gnu/usr.bin/perl/t/pragma/overload.t
@@ -5,8 +5,6 @@ BEGIN {
@INC = '../lib';
}
-use Config;
-
package Oscalar;
use overload (
# Anonymous subroutines:
@@ -48,7 +46,20 @@ $| = 1;
print "1..",&last,"\n";
sub test {
- $test++; if (shift) {print "ok $test\n";1} else {print "not ok $test\n";0}
+ $test++;
+ if (@_ > 1) {
+ if ($_[0] eq $_[1]) {
+ print "ok $test\n";
+ } else {
+ print "not ok $test: '$_[0]' ne '$_[1]'\n";
+ }
+ } else {
+ if (shift) {
+ print "ok $test\n";
+ } else {
+ print "not ok $test\n";
+ }
+ }
}
$a = new Oscalar "087";
@@ -359,5 +370,341 @@ test(($aI | 3) eq '_<<_xx_<<_'); # 114
# warn $aII << 3;
test(($aII << 3) eq '_<<_087_<<_'); # 115
+{
+ BEGIN { $int = 7; overload::constant 'integer' => sub {$int++; shift}; }
+ $out = 2**10;
+}
+test($int, 9); # 116
+test($out, 1024); # 117
+
+$foo = 'foo';
+$foo1 = 'f\'o\\o';
+{
+ BEGIN { $q = $qr = 7;
+ overload::constant 'q' => sub {$q++; push @q, shift, ($_[1] || 'none'); shift},
+ 'qr' => sub {$qr++; push @qr, shift, ($_[1] || 'none'); shift}; }
+ $out = 'foo';
+ $out1 = 'f\'o\\o';
+ $out2 = "a\a$foo,\,";
+ /b\b$foo.\./;
+}
+
+test($out, 'foo'); # 118
+test($out, $foo); # 119
+test($out1, 'f\'o\\o'); # 120
+test($out1, $foo1); # 121
+test($out2, "a\afoo,\,"); # 122
+test("@q", "foo q f'o\\\\o q a\\a qq ,\\, qq"); # 123
+test($q, 11); # 124
+test("@qr", "b\\b qq .\\. qq"); # 125
+test($qr, 9); # 126
+
+{
+ $_ = '!<b>!foo!<-.>!';
+ BEGIN { overload::constant 'q' => sub {push @q1, shift, ($_[1] || 'none'); "_<" . (shift) . ">_"},
+ 'qr' => sub {push @qr1, shift, ($_[1] || 'none'); "!<" . (shift) . ">!"}; }
+ $out = 'foo';
+ $out1 = 'f\'o\\o';
+ $out2 = "a\a$foo,\,";
+ $res = /b\b$foo.\./;
+ $a = <<EOF;
+oups
+EOF
+ $b = <<'EOF';
+oups1
+EOF
+ $c = bareword;
+ m'try it';
+ s'first part'second part';
+ s/yet another/tail here/;
+ tr/z-Z/z-Z/;
+}
+
+test($out, '_<foo>_'); # 117
+test($out1, '_<f\'o\\o>_'); # 128
+test($out2, "_<a\a>_foo_<,\,>_"); # 129
+test("@q1", "foo q f'o\\\\o q a\\a qq ,\\, qq oups
+ qq oups1
+ q second part q tail here s z-Z tr z-Z tr"); # 130
+test("@qr1", "b\\b qq .\\. qq try it q first part q yet another qq"); # 131
+test($res, 1); # 132
+test($a, "_<oups
+>_"); # 133
+test($b, "_<oups1
+>_"); # 134
+test($c, "bareword"); # 135
+
+{
+ package symbolic; # Primitive symbolic calculator
+ use overload nomethod => \&wrap, '""' => \&str, '0+' => \&num,
+ '=' => \&cpy, '++' => \&inc, '--' => \&dec;
+
+ sub new { shift; bless ['n', @_] }
+ sub cpy {
+ my $self = shift;
+ bless [@$self], ref $self;
+ }
+ sub inc { $_[0] = bless ['++', $_[0], 1]; }
+ sub dec { $_[0] = bless ['--', $_[0], 1]; }
+ sub wrap {
+ my ($obj, $other, $inv, $meth) = @_;
+ if ($meth eq '++' or $meth eq '--') {
+ @$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
+ return $obj;
+ }
+ ($obj, $other) = ($other, $obj) if $inv;
+ bless [$meth, $obj, $other];
+ }
+ sub str {
+ my ($meth, $a, $b) = @{+shift};
+ $a = 'u' unless defined $a;
+ if (defined $b) {
+ "[$meth $a $b]";
+ } else {
+ "[$meth $a]";
+ }
+ }
+ my %subr = ( 'n' => sub {$_[0]} );
+ foreach my $op (split " ", $overload::ops{with_assign}) {
+ $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
+ }
+ my @bins = qw(binary 3way_comparison num_comparison str_comparison);
+ foreach my $op (split " ", "@overload::ops{ @bins }") {
+ $subr{$op} = eval "sub {shift() $op shift()}";
+ }
+ foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
+ $subr{$op} = eval "sub {$op shift()}";
+ }
+ $subr{'++'} = $subr{'+'};
+ $subr{'--'} = $subr{'-'};
+
+ sub num {
+ my ($meth, $a, $b) = @{+shift};
+ my $subr = $subr{$meth}
+ or die "Do not know how to ($meth) in symbolic";
+ $a = $a->num if ref $a eq __PACKAGE__;
+ $b = $b->num if ref $b eq __PACKAGE__;
+ $subr->($a,$b);
+ }
+ sub TIESCALAR { my $pack = shift; $pack->new(@_) }
+ sub FETCH { shift }
+ sub nop { } # Around a bug
+ sub vars { my $p = shift; tie($_, $p), $_->nop foreach @_; }
+ sub STORE {
+ my $obj = shift;
+ $#$obj = 1;
+ @$obj->[0,1] = ('=', shift);
+ }
+}
+
+{
+ my $foo = new symbolic 11;
+ my $baz = $foo++;
+ test( (sprintf "%d", $foo), '12');
+ test( (sprintf "%d", $baz), '11');
+ my $bar = $foo;
+ $baz = ++$foo;
+ test( (sprintf "%d", $foo), '13');
+ test( (sprintf "%d", $bar), '12');
+ test( (sprintf "%d", $baz), '13');
+ my $ban = $foo;
+ $baz = ($foo += 1);
+ test( (sprintf "%d", $foo), '14');
+ test( (sprintf "%d", $bar), '12');
+ test( (sprintf "%d", $baz), '14');
+ test( (sprintf "%d", $ban), '13');
+ $baz = 0;
+ $baz = $foo++;
+ test( (sprintf "%d", $foo), '15');
+ test( (sprintf "%d", $baz), '14');
+ test( "$foo", '[++ [+= [++ [++ [n 11] 1] 1] 1] 1]');
+}
+
+{
+ my $iter = new symbolic 2;
+ my $side = new symbolic 1;
+ my $cnt = $iter;
+
+ while ($cnt) {
+ $cnt = $cnt - 1; # The "simple" way
+ $side = (sqrt(1 + $side**2) - 1)/$side;
+ }
+ my $pi = $side*(2**($iter+2));
+ test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
+ test( (sprintf "%f", $pi), '3.182598');
+}
+
+{
+ my $iter = new symbolic 2;
+ my $side = new symbolic 1;
+ my $cnt = $iter;
+
+ while ($cnt--) {
+ $side = (sqrt(1 + $side**2) - 1)/$side;
+ }
+ my $pi = $side*(2**($iter+2));
+ test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
+ test( (sprintf "%f", $pi), '3.182598');
+}
+
+{
+ my ($a, $b);
+ symbolic->vars($a, $b);
+ my $c = sqrt($a**2 + $b**2);
+ $a = 3; $b = 4;
+ test( (sprintf "%d", $c), '5');
+ $a = 12; $b = 5;
+ test( (sprintf "%d", $c), '13');
+}
+
+{
+ package symbolic1; # Primitive symbolic calculator
+ # Mutator inc/dec
+ use overload nomethod => \&wrap, '""' => \&str, '0+' => \&num, '=' => \&cpy;
+
+ sub new { shift; bless ['n', @_] }
+ sub cpy {
+ my $self = shift;
+ bless [@$self], ref $self;
+ }
+ sub wrap {
+ my ($obj, $other, $inv, $meth) = @_;
+ if ($meth eq '++' or $meth eq '--') {
+ @$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
+ return $obj;
+ }
+ ($obj, $other) = ($other, $obj) if $inv;
+ bless [$meth, $obj, $other];
+ }
+ sub str {
+ my ($meth, $a, $b) = @{+shift};
+ $a = 'u' unless defined $a;
+ if (defined $b) {
+ "[$meth $a $b]";
+ } else {
+ "[$meth $a]";
+ }
+ }
+ my %subr = ( 'n' => sub {$_[0]} );
+ foreach my $op (split " ", $overload::ops{with_assign}) {
+ $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
+ }
+ my @bins = qw(binary 3way_comparison num_comparison str_comparison);
+ foreach my $op (split " ", "@overload::ops{ @bins }") {
+ $subr{$op} = eval "sub {shift() $op shift()}";
+ }
+ foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
+ $subr{$op} = eval "sub {$op shift()}";
+ }
+ $subr{'++'} = $subr{'+'};
+ $subr{'--'} = $subr{'-'};
+
+ sub num {
+ my ($meth, $a, $b) = @{+shift};
+ my $subr = $subr{$meth}
+ or die "Do not know how to ($meth) in symbolic";
+ $a = $a->num if ref $a eq __PACKAGE__;
+ $b = $b->num if ref $b eq __PACKAGE__;
+ $subr->($a,$b);
+ }
+ sub TIESCALAR { my $pack = shift; $pack->new(@_) }
+ sub FETCH { shift }
+ sub nop { } # Around a bug
+ sub vars { my $p = shift; tie($_, $p), $_->nop foreach @_; }
+ sub STORE {
+ my $obj = shift;
+ $#$obj = 1;
+ @$obj->[0,1] = ('=', shift);
+ }
+}
+
+{
+ my $foo = new symbolic1 11;
+ my $baz = $foo++;
+ test( (sprintf "%d", $foo), '12');
+ test( (sprintf "%d", $baz), '11');
+ my $bar = $foo;
+ $baz = ++$foo;
+ test( (sprintf "%d", $foo), '13');
+ test( (sprintf "%d", $bar), '12');
+ test( (sprintf "%d", $baz), '13');
+ my $ban = $foo;
+ $baz = ($foo += 1);
+ test( (sprintf "%d", $foo), '14');
+ test( (sprintf "%d", $bar), '12');
+ test( (sprintf "%d", $baz), '14');
+ test( (sprintf "%d", $ban), '13');
+ $baz = 0;
+ $baz = $foo++;
+ test( (sprintf "%d", $foo), '15');
+ test( (sprintf "%d", $baz), '14');
+ test( "$foo", '[++ [+= [++ [++ [n 11] 1] 1] 1] 1]');
+}
+
+{
+ my $iter = new symbolic1 2;
+ my $side = new symbolic1 1;
+ my $cnt = $iter;
+
+ while ($cnt) {
+ $cnt = $cnt - 1; # The "simple" way
+ $side = (sqrt(1 + $side**2) - 1)/$side;
+ }
+ my $pi = $side*(2**($iter+2));
+ test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
+ test( (sprintf "%f", $pi), '3.182598');
+}
+
+{
+ my $iter = new symbolic1 2;
+ my $side = new symbolic1 1;
+ my $cnt = $iter;
+
+ while ($cnt--) {
+ $side = (sqrt(1 + $side**2) - 1)/$side;
+ }
+ my $pi = $side*(2**($iter+2));
+ test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
+ test( (sprintf "%f", $pi), '3.182598');
+}
+
+{
+ my ($a, $b);
+ symbolic1->vars($a, $b);
+ my $c = sqrt($a**2 + $b**2);
+ $a = 3; $b = 4;
+ test( (sprintf "%d", $c), '5');
+ $a = 12; $b = 5;
+ test( (sprintf "%d", $c), '13');
+}
+
+{
+ package two_face; # Scalars with separate string and
+ # numeric values.
+ sub new { my $p = shift; bless [@_], $p }
+ use overload '""' => \&str, '0+' => \&num, fallback => 1;
+ sub num {shift->[1]}
+ sub str {shift->[0]}
+}
+
+{
+ my $seven = new two_face ("vii", 7);
+ test( (sprintf "seven=$seven, seven=%d, eight=%d", $seven, $seven+1),
+ 'seven=vii, seven=7, eight=8');
+ test( scalar ($seven =~ /i/), '1')
+}
+
+{
+ package sorting;
+ use overload 'cmp' => \&comp;
+ sub new { my ($p, $v) = @_; bless \$v, $p }
+ sub comp { my ($x,$y) = @_; ($$x * 3 % 10) <=> ($$y * 3 % 10) or $$x cmp $$y }
+}
+{
+ my @arr = map sorting->new($_), 0..12;
+ my @sorted1 = sort @arr;
+ my @sorted2 = map $$_, @sorted1;
+ test "@sorted2", '0 10 7 4 1 11 8 5 12 2 9 6 3';
+}
# Last test is:
-sub last {115}
+sub last {174}
diff --git a/gnu/usr.bin/perl/t/pragma/strict-subs b/gnu/usr.bin/perl/t/pragma/strict-subs
index 43fce712d57..61ec286eb6d 100644
--- a/gnu/usr.bin/perl/t/pragma/strict-subs
+++ b/gnu/usr.bin/perl/t/pragma/strict-subs
@@ -81,7 +81,7 @@ use strict 'vars' ;
$joe = 1 ;
EXPECT
Variable "$joe" is not imported at - line 8.
-Global symbol "joe" requires explicit package name at - line 8.
+Global symbol "$joe" requires explicit package name at - line 8.
Execution of - aborted due to compilation errors.
########
@@ -93,7 +93,7 @@ no strict;
}
$joe = 1 ;
EXPECT
-Global symbol "joe" requires explicit package name at - line 6.
+Global symbol "$joe" requires explicit package name at - line 6.
Execution of - aborted due to compilation errors.
########
diff --git a/gnu/usr.bin/perl/t/pragma/strict-vars b/gnu/usr.bin/perl/t/pragma/strict-vars
index 7ca9843c2c0..42107fa8e10 100644
--- a/gnu/usr.bin/perl/t/pragma/strict-vars
+++ b/gnu/usr.bin/perl/t/pragma/strict-vars
@@ -40,7 +40,7 @@ EXPECT
use strict ;
$fred ;
EXPECT
-Global symbol "fred" requires explicit package name at - line 4.
+Global symbol "$fred" requires explicit package name at - line 4.
Execution of - aborted due to compilation errors.
########
@@ -48,7 +48,7 @@ Execution of - aborted due to compilation errors.
use strict 'vars' ;
$fred ;
EXPECT
-Global symbol "fred" requires explicit package name at - line 4.
+Global symbol "$fred" requires explicit package name at - line 4.
Execution of - aborted due to compilation errors.
########
@@ -56,7 +56,7 @@ Execution of - aborted due to compilation errors.
use strict 'vars' ;
local $fred ;
EXPECT
-Global symbol "fred" requires explicit package name at - line 4.
+Global symbol "$fred" requires explicit package name at - line 4.
Execution of - aborted due to compilation errors.
########
@@ -69,7 +69,7 @@ use strict 'vars' ;
$joe = 1 ;
EXPECT
Variable "$joe" is not imported at - line 8.
-Global symbol "joe" requires explicit package name at - line 8.
+Global symbol "$joe" requires explicit package name at - line 8.
Execution of - aborted due to compilation errors.
########
@@ -81,7 +81,7 @@ no strict;
}
$joe = 1 ;
EXPECT
-Global symbol "joe" requires explicit package name at - line 6.
+Global symbol "$joe" requires explicit package name at - line 6.
Execution of - aborted due to compilation errors.
########
@@ -114,7 +114,7 @@ $joe = 1 ;
require "./abc";
EXPECT
Variable "$joe" is not imported at ./abc line 2.
-Global symbol "joe" requires explicit package name at ./abc line 2.
+Global symbol "$joe" requires explicit package name at ./abc line 2.
Compilation failed in require at - line 2.
########
@@ -127,7 +127,7 @@ $joe = 1 ;
use abc;
EXPECT
Variable "$joe" is not imported at abc.pm line 2.
-Global symbol "joe" requires explicit package name at abc.pm line 2.
+Global symbol "$joe" requires explicit package name at abc.pm line 2.
Compilation failed in require at - line 2.
BEGIN failed--compilation aborted at - line 2.
########
@@ -152,7 +152,7 @@ eval {
print STDERR $@;
$joe = 1 ;
EXPECT
-Global symbol "joe" requires explicit package name at - line 6.
+Global symbol "$joe" requires explicit package name at - line 6.
Execution of - aborted due to compilation errors.
########
@@ -164,7 +164,7 @@ eval {
print STDERR $@;
$joe = 1 ;
EXPECT
-Global symbol "joe" requires explicit package name at - line 5.
+Global symbol "$joe" requires explicit package name at - line 5.
Execution of - aborted due to compilation errors.
########
@@ -178,7 +178,7 @@ print STDERR $@;
$joe = 1 ;
EXPECT
Variable "$joe" is not imported at - line 9.
-Global symbol "joe" requires explicit package name at - line 9.
+Global symbol "$joe" requires explicit package name at - line 9.
Execution of - aborted due to compilation errors.
########
@@ -199,7 +199,7 @@ eval q[
$joe = 1 ;
]; print STDERR $@;
EXPECT
-Global symbol "joe" requires explicit package name at (eval 1) line 3.
+Global symbol "$joe" requires explicit package name at (eval 1) line 3.
########
# Check scope of pragma with eval
@@ -208,7 +208,7 @@ eval '
$joe = 1 ;
'; print STDERR $@ ;
EXPECT
-Global symbol "joe" requires explicit package name at (eval 1) line 2.
+Global symbol "$joe" requires explicit package name at (eval 1) line 2.
########
# Check scope of pragma with eval
@@ -219,5 +219,5 @@ eval '
'; print STDERR $@;
$joe = 1 ;
EXPECT
-Global symbol "joe" requires explicit package name at - line 8.
+Global symbol "$joe" requires explicit package name at - line 8.
Execution of - aborted due to compilation errors.
diff --git a/gnu/usr.bin/perl/t/pragma/subs.t b/gnu/usr.bin/perl/t/pragma/subs.t
index 056c4bd7cf4..6ebbf78a465 100644
--- a/gnu/usr.bin/perl/t/pragma/subs.t
+++ b/gnu/usr.bin/perl/t/pragma/subs.t
@@ -55,6 +55,9 @@ for (@prgs){
# allow expected output to be written as if $prog is on STDIN
$results =~ s/tmp\d+/-/g;
$results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg
+# bison says 'parse error' instead of 'syntax error',
+# various yaccs may or may not capitalize 'syntax'.
+ $results =~ s/^(syntax|parse) error/syntax error/mig;
$expected =~ s/\n+$//;
my $prefix = ($results =~ s/^PREFIX\n//) ;
if ( $results =~ s/^SKIPPED\n//) {
diff --git a/gnu/usr.bin/perl/t/pragma/warn-1global b/gnu/usr.bin/perl/t/pragma/warn-1global
index 33252731b0e..a7ca6070778 100644
--- a/gnu/usr.bin/perl/t/pragma/warn-1global
+++ b/gnu/usr.bin/perl/t/pragma/warn-1global
@@ -12,12 +12,14 @@ EXPECT
$a =+ 3 ;
EXPECT
Reversed += operator at - line 3.
+Name "main::a" used only once: possible typo at - line 3.
########
#! perl -w
# warnable code, warnings enabled via #! line
$a =+ 3 ;
EXPECT
Reversed += operator at - line 3.
+Name "main::a" used only once: possible typo at - line 3.
########
# warnable code, warnings enabled via compile time $^W
@@ -25,6 +27,7 @@ BEGIN { $^W = 1 }
$a =+ 3 ;
EXPECT
Reversed += operator at - line 4.
+Name "main::a" used only once: possible typo at - line 4.
########
# compile-time warnable code, warnings enabled via runtime $^W
@@ -144,3 +147,13 @@ my $a ; chop $a ;
my $c ; chop $c ;
EXPECT
Use of uninitialized value at - line 5.
+########
+-w
+-e undef
+EXPECT
+Use of uninitialized value at - line 2.
+########
+BEGIN { $^W = 1 }
+for (@{[0]}) { "$_" } # check warning isn't duplicated
+EXPECT
+Useless use of string in void context at - line 2.
diff --git a/gnu/usr.bin/perl/t/pragma/warning.t b/gnu/usr.bin/perl/t/pragma/warning.t
index fa0301ea6a6..35d9d485e76 100644
--- a/gnu/usr.bin/perl/t/pragma/warning.t
+++ b/gnu/usr.bin/perl/t/pragma/warning.t
@@ -4,11 +4,12 @@ BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
$ENV{PERL5LIB} = '../lib';
+ require Config; import Config;
}
$| = 1;
-my $Is_VMS = $^O eq 'VMS';
+my $Is_VMS = $^O eq 'VMS';
my $Is_MSWin32 = $^O eq 'MSWin32';
my $tmpfile = "tmp0000";
my $i = 0 ;
@@ -19,6 +20,8 @@ my @prgs = () ;
foreach (sort glob("pragma/warn-*")) {
+ next if /\.orig$/ ;
+
next if /(~|\.orig)$/;
open F, "<$_" or die "Cannot open $_: $!\n" ;
@@ -76,13 +79,29 @@ for (@prgs){
# allow expected output to be written as if $prog is on STDIN
$results =~ s/tmp\d+/-/g;
$results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg
+# bison says 'parse error' instead of 'syntax error',
+# various yaccs may or may not capitalize 'syntax'.
+ $results =~ s/^(syntax|parse) error/syntax error/mig;
$expected =~ s/\n+$//;
my $prefix = ($results =~ s/^PREFIX\n//) ;
+ # any special options? (OPTIONS foo bar zap)
+ my $option_regex = 0;
+ if ($expected =~ s/^OPTIONS? (.+)\n//) {
+ foreach my $option (split(' ', $1)) {
+ if ($option eq 'regex') { # allow regular expressions
+ $option_regex = 1;
+ } else {
+ die "$0: Unknown OPTION '$option'\n";
+ }
+ }
+ }
if ( $results =~ s/^SKIPPED\n//) {
print "$results\n" ;
}
- elsif (($prefix and $results !~ /^\Q$expected/) or
- (!$prefix and $results ne $expected)){
+ elsif (($prefix && (( $option_regex && $results !~ /^$expected/) ||
+ (!$option_regex && $results !~ /^\Q$expected/))) or
+ (!$prefix && (( $option_regex && $results !~ /^$expected/) ||
+ (!$option_regex && $results ne $expected)))) {
print STDERR "PROG: $switch\n$prog\n";
print STDERR "EXPECTED:\n$expected\n";
print STDERR "GOT:\n$results\n";
diff --git a/gnu/usr.bin/perl/taint.c b/gnu/usr.bin/perl/taint.c
index cd3ec8e2813..d5f83399502 100644
--- a/gnu/usr.bin/perl/taint.c
+++ b/gnu/usr.bin/perl/taint.c
@@ -8,31 +8,32 @@
#include "perl.h"
void
-taint_proper(f, s)
-const char *f;
-char *s;
+taint_proper(const char *f, char *s)
{
+ dTHR; /* just for taint */
char *ug;
DEBUG_u(PerlIO_printf(Perl_debug_log,
- "%s %d %d %d\n", s, tainted, uid, euid));
+ "%s %d %d %d\n", s, PL_tainted, PL_uid, PL_euid));
- if (tainted) {
- if (euid != uid)
+ if (PL_tainted) {
+ if (!f)
+ f = no_security;
+ if (PL_euid != PL_uid)
ug = " while running setuid";
- else if (egid != gid)
+ else if (PL_egid != PL_gid)
ug = " while running setgid";
else
ug = " while running with -T switch";
- if (!unsafe)
+ if (!PL_unsafe)
croak(f, s, ug);
- else if (dowarn)
+ else if (PL_dowarn)
warn(f, s, ug);
}
}
void
-taint_env()
+taint_env(void)
{
SV** svp;
MAGIC* mg;
@@ -45,38 +46,44 @@ taint_env()
NULL
};
- if (!envgv)
+ if(!PL_envgv)
return;
#ifdef VMS
+ {
int i = 0;
char name[10 + TYPE_DIGITS(int)] = "DCL$PATH";
while (1) {
if (i)
(void)sprintf(name,"DCL$PATH;%d", i);
- svp = hv_fetch(GvHVn(envgv), name, strlen(name), FALSE);
- if (!svp || *svp == &sv_undef)
+ svp = hv_fetch(GvHVn(PL_envgv), name, strlen(name), FALSE);
+ if (!svp || *svp == &PL_sv_undef)
break;
if (SvTAINTED(*svp)) {
+ dTHR;
TAINT;
taint_proper("Insecure %s%s", "$ENV{DCL$PATH}");
}
if ((mg = mg_find(*svp, 'e')) && MgTAINTEDDIR(mg)) {
+ dTHR;
TAINT;
taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}");
}
i++;
}
+ }
#endif /* VMS */
- svp = hv_fetch(GvHVn(envgv),"PATH",4,FALSE);
+ svp = hv_fetch(GvHVn(PL_envgv),"PATH",4,FALSE);
if (svp && *svp) {
if (SvTAINTED(*svp)) {
+ dTHR;
TAINT;
taint_proper("Insecure %s%s", "$ENV{PATH}");
}
if ((mg = mg_find(*svp, 'e')) && MgTAINTEDDIR(mg)) {
+ dTHR;
TAINT;
taint_proper("Insecure directory in %s%s", "$ENV{PATH}");
}
@@ -84,12 +91,14 @@ taint_env()
#ifndef VMS
/* tainted $TERM is okay if it contains no metachars */
- svp = hv_fetch(GvHVn(envgv),"TERM",4,FALSE);
+ svp = hv_fetch(GvHVn(PL_envgv),"TERM",4,FALSE);
if (svp && *svp && SvTAINTED(*svp)) {
- bool was_tainted = tainted;
- char *t = SvPV(*svp, na);
- char *e = t + na;
- tainted = was_tainted;
+ dTHR; /* just for taint */
+ STRLEN n_a;
+ bool was_tainted = PL_tainted;
+ char *t = SvPV(*svp, n_a);
+ char *e = t + n_a;
+ PL_tainted = was_tainted;
if (t < e && isALNUM(*t))
t++;
while (t < e && (isALNUM(*t) || *t == '-' || *t == ':'))
@@ -102,8 +111,9 @@ taint_env()
#endif /* !VMS */
for (e = misc_env; *e; e++) {
- svp = hv_fetch(GvHVn(envgv), *e, strlen(*e), FALSE);
- if (svp && *svp != &sv_undef && SvTAINTED(*svp)) {
+ svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE);
+ if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) {
+ dTHR; /* just for taint */
TAINT;
taint_proper("Insecure $ENV{%s}%s", *e);
}
diff --git a/gnu/usr.bin/perl/toke.c b/gnu/usr.bin/perl/toke.c
index b2e8aac6d3e..52a42af1dbe 100644
--- a/gnu/usr.bin/perl/toke.c
+++ b/gnu/usr.bin/perl/toke.c
@@ -1,6 +1,6 @@
/* toke.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -14,18 +14,19 @@
#include "EXTERN.h"
#include "perl.h"
+#ifndef PERL_OBJECT
static void check_uni _((void));
static void force_next _((I32 type));
static char *force_version _((char *start));
static char *force_word _((char *start, int token, int check_keyword, int allow_pack, int allow_tick));
-static SV *q _((SV *sv));
+static SV *tokeq _((SV *sv));
static char *scan_const _((char *start));
static char *scan_formline _((char *s));
static char *scan_heredoc _((char *s));
static char *scan_ident _((char *s, char *send, char *dest, STRLEN destlen,
I32 ck_uni));
static char *scan_inputsymbol _((char *start));
-static char *scan_pat _((char *start));
+static char *scan_pat _((char *start, I32 type));
static char *scan_str _((char *start));
static char *scan_subst _((char *start));
static char *scan_trans _((char *start));
@@ -49,18 +50,15 @@ static int uni _((I32 f, char *s));
#endif
static char * filter_gets _((SV *sv, PerlIO *fp, STRLEN append));
static void restore_rsfp _((void *f));
+static SV *new_constant _((char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type));
+static void restore_expect _((void *e));
+static void restore_lex_expect _((void *e));
-static char ident_too_long[] = "Identifier too long";
-
-static char *linestart; /* beg. of most recently read line */
-
-static char pending_ident; /* pending identifier lookup */
+static char *PL_super_bufptr;
+static char *PL_super_bufend;
+#endif /* PERL_OBJECT */
-static struct {
- I32 super_state; /* lexer state to save */
- I32 sub_inwhat; /* "lex_inwhat" to use */
- OP *sub_op; /* "lex_op" to use */
-} sublex_info;
+static char ident_too_long[] = "Identifier too long";
/* The following are arranged oddly so that the guard on the switch statement
* can get by with a single comparison (if the compiler is smart enough).
@@ -102,53 +100,52 @@ static struct {
#ifdef CLINE
#undef CLINE
#endif
-#define CLINE (copline = (curcop->cop_line < copline ? curcop->cop_line : copline))
-
-#define TOKEN(retval) return (bufptr = s,(int)retval)
-#define OPERATOR(retval) return (expect = XTERM,bufptr = s,(int)retval)
-#define AOPERATOR(retval) return ao((expect = XTERM,bufptr = s,(int)retval))
-#define PREBLOCK(retval) return (expect = XBLOCK,bufptr = s,(int)retval)
-#define PRETERMBLOCK(retval) return (expect = XTERMBLOCK,bufptr = s,(int)retval)
-#define PREREF(retval) return (expect = XREF,bufptr = s,(int)retval)
-#define TERM(retval) return (CLINE, expect = XOPERATOR,bufptr = s,(int)retval)
-#define LOOPX(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LOOPEX)
-#define FTST(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)UNIOP)
-#define FUN0(f) return(yylval.ival = f,expect = XOPERATOR,bufptr = s,(int)FUNC0)
-#define FUN1(f) return(yylval.ival = f,expect = XOPERATOR,bufptr = s,(int)FUNC1)
-#define BOop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)BITOROP))
-#define BAop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)BITANDOP))
-#define SHop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)SHIFTOP))
-#define PWop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)POWOP))
-#define PMop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)MATCHOP)
-#define Aop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)ADDOP))
-#define Mop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)MULOP))
-#define Eop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)EQOP)
-#define Rop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)RELOP)
+#define CLINE (PL_copline = (PL_curcop->cop_line < PL_copline ? PL_curcop->cop_line : PL_copline))
+
+#define TOKEN(retval) return (PL_bufptr = s,(int)retval)
+#define OPERATOR(retval) return (PL_expect = XTERM,PL_bufptr = s,(int)retval)
+#define AOPERATOR(retval) return ao((PL_expect = XTERM,PL_bufptr = s,(int)retval))
+#define PREBLOCK(retval) return (PL_expect = XBLOCK,PL_bufptr = s,(int)retval)
+#define PRETERMBLOCK(retval) return (PL_expect = XTERMBLOCK,PL_bufptr = s,(int)retval)
+#define PREREF(retval) return (PL_expect = XREF,PL_bufptr = s,(int)retval)
+#define TERM(retval) return (CLINE, PL_expect = XOPERATOR,PL_bufptr = s,(int)retval)
+#define LOOPX(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LOOPEX)
+#define FTST(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)UNIOP)
+#define FUN0(f) return(yylval.ival = f,PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC0)
+#define FUN1(f) return(yylval.ival = f,PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC1)
+#define BOop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)BITOROP))
+#define BAop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)BITANDOP))
+#define SHop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)SHIFTOP))
+#define PWop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)POWOP))
+#define PMop(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)MATCHOP)
+#define Aop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)ADDOP))
+#define Mop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)MULOP))
+#define Eop(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)EQOP)
+#define Rop(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)RELOP)
/* This bit of chicanery makes a unary function followed by
* a parenthesis into a function with one argument, highest precedence.
*/
#define UNI(f) return(yylval.ival = f, \
- expect = XTERM, \
- bufptr = s, \
- last_uni = oldbufptr, \
- last_lop_op = f, \
+ PL_expect = XTERM, \
+ PL_bufptr = s, \
+ PL_last_uni = PL_oldbufptr, \
+ PL_last_lop_op = f, \
(*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
#define UNIBRACK(f) return(yylval.ival = f, \
- bufptr = s, \
- last_uni = oldbufptr, \
+ PL_bufptr = s, \
+ PL_last_uni = PL_oldbufptr, \
(*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
/* grandfather return to old style */
-#define OLDLOP(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LSTOP)
+#define OLDLOP(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP)
-static int
-ao(toketype)
-int toketype;
+STATIC int
+ao(int toketype)
{
- if (*bufptr == '=') {
- bufptr++;
+ if (*PL_bufptr == '=') {
+ PL_bufptr++;
if (toketype == ANDAND)
yylval.ival = OP_ANDASSIGN;
else if (toketype == OROR)
@@ -158,34 +155,31 @@ int toketype;
return toketype;
}
-static void
-no_op(what, s)
-char *what;
-char *s;
+STATIC void
+no_op(char *what, char *s)
{
- char *oldbp = bufptr;
- bool is_first = (oldbufptr == linestart);
+ char *oldbp = PL_bufptr;
+ bool is_first = (PL_oldbufptr == PL_linestart);
- bufptr = s;
+ PL_bufptr = s;
yywarn(form("%s found where operator expected", what));
if (is_first)
warn("\t(Missing semicolon on previous line?)\n");
- else if (oldoldbufptr && isIDFIRST(*oldoldbufptr)) {
+ else if (PL_oldoldbufptr && isIDFIRST(*PL_oldoldbufptr)) {
char *t;
- for (t = oldoldbufptr; *t && (isALNUM(*t) || *t == ':'); t++) ;
- if (t < bufptr && isSPACE(*t))
+ for (t = PL_oldoldbufptr; *t && (isALNUM(*t) || *t == ':'); t++) ;
+ if (t < PL_bufptr && isSPACE(*t))
warn("\t(Do you need to predeclare %.*s?)\n",
- t - oldoldbufptr, oldoldbufptr);
+ t - PL_oldoldbufptr, PL_oldoldbufptr);
}
else
warn("\t(Missing operator before %.*s?)\n", s - oldbp, oldbp);
- bufptr = oldbp;
+ PL_bufptr = oldbp;
}
-static void
-missingterm(s)
-char *s;
+STATIC void
+missingterm(char *s)
{
char tmpbuf[3];
char q;
@@ -194,15 +188,21 @@ char *s;
if (nl)
*nl = '\0';
}
- else if (multi_close < 32 || multi_close == 127) {
+ else if (
+#ifdef EBCDIC
+ iscntrl(PL_multi_close)
+#else
+ PL_multi_close < 32 || PL_multi_close == 127
+#endif
+ ) {
*tmpbuf = '^';
- tmpbuf[1] = toCTRL(multi_close);
+ tmpbuf[1] = toCTRL(PL_multi_close);
s = "\\n";
tmpbuf[2] = '\0';
s = tmpbuf;
}
else {
- *tmpbuf = multi_close;
+ *tmpbuf = PL_multi_close;
tmpbuf[1] = '\0';
s = tmpbuf;
}
@@ -211,112 +211,138 @@ char *s;
}
void
-deprecate(s)
-char *s;
+deprecate(char *s)
{
- if (dowarn)
+ if (PL_dowarn)
warn("Use of %s is deprecated", s);
}
-static void
-depcom()
+STATIC void
+depcom(void)
{
deprecate("comma-less variable list");
}
+#ifdef WIN32
+
+STATIC I32
+win32_textfilter(int idx, SV *sv, int maxlen)
+{
+ I32 count = FILTER_READ(idx+1, sv, maxlen);
+ if (count > 0 && !maxlen)
+ win32_strip_return(sv);
+ return count;
+}
+#endif
+
+
void
-lex_start(line)
-SV *line;
+lex_start(SV *line)
{
+ dTHR;
char *s;
STRLEN len;
- SAVEI32(lex_dojoin);
- SAVEI32(lex_brackets);
- SAVEI32(lex_fakebrack);
- SAVEI32(lex_casemods);
- SAVEI32(lex_starts);
- SAVEI32(lex_state);
- SAVESPTR(lex_inpat);
- SAVEI32(lex_inwhat);
- SAVEI16(curcop->cop_line);
- SAVEPPTR(bufptr);
- SAVEPPTR(bufend);
- SAVEPPTR(oldbufptr);
- SAVEPPTR(oldoldbufptr);
- SAVEPPTR(linestart);
- SAVESPTR(linestr);
- SAVEPPTR(lex_brackstack);
- SAVEPPTR(lex_casestack);
- SAVEDESTRUCTOR(restore_rsfp, rsfp);
-
- lex_state = LEX_NORMAL;
- lex_defer = 0;
- expect = XSTATE;
- lex_brackets = 0;
- lex_fakebrack = 0;
- New(899, lex_brackstack, 120, char);
- New(899, lex_casestack, 12, char);
- SAVEFREEPV(lex_brackstack);
- SAVEFREEPV(lex_casestack);
- lex_casemods = 0;
- *lex_casestack = '\0';
- lex_dojoin = 0;
- lex_starts = 0;
- if (lex_stuff)
- SvREFCNT_dec(lex_stuff);
- lex_stuff = Nullsv;
- if (lex_repl)
- SvREFCNT_dec(lex_repl);
- lex_repl = Nullsv;
- lex_inpat = 0;
- lex_inwhat = 0;
- linestr = line;
- if (SvREADONLY(linestr))
- linestr = sv_2mortal(newSVsv(linestr));
- s = SvPV(linestr, len);
+ SAVEI32(PL_lex_dojoin);
+ SAVEI32(PL_lex_brackets);
+ SAVEI32(PL_lex_fakebrack);
+ SAVEI32(PL_lex_casemods);
+ SAVEI32(PL_lex_starts);
+ SAVEI32(PL_lex_state);
+ SAVESPTR(PL_lex_inpat);
+ SAVEI32(PL_lex_inwhat);
+ SAVEI16(PL_curcop->cop_line);
+ SAVEPPTR(PL_bufptr);
+ SAVEPPTR(PL_bufend);
+ SAVEPPTR(PL_oldbufptr);
+ SAVEPPTR(PL_oldoldbufptr);
+ SAVEPPTR(PL_linestart);
+ SAVESPTR(PL_linestr);
+ SAVEPPTR(PL_lex_brackstack);
+ SAVEPPTR(PL_lex_casestack);
+ SAVEDESTRUCTOR(restore_rsfp, PL_rsfp);
+ SAVESPTR(PL_lex_stuff);
+ SAVEI32(PL_lex_defer);
+ SAVESPTR(PL_lex_repl);
+ SAVEDESTRUCTOR(restore_expect, PL_tokenbuf + PL_expect); /* encode as pointer */
+ SAVEDESTRUCTOR(restore_lex_expect, PL_tokenbuf + PL_expect);
+
+ PL_lex_state = LEX_NORMAL;
+ PL_lex_defer = 0;
+ PL_expect = XSTATE;
+ PL_lex_brackets = 0;
+ PL_lex_fakebrack = 0;
+ New(899, PL_lex_brackstack, 120, char);
+ New(899, PL_lex_casestack, 12, char);
+ SAVEFREEPV(PL_lex_brackstack);
+ SAVEFREEPV(PL_lex_casestack);
+ PL_lex_casemods = 0;
+ *PL_lex_casestack = '\0';
+ PL_lex_dojoin = 0;
+ PL_lex_starts = 0;
+ PL_lex_stuff = Nullsv;
+ PL_lex_repl = Nullsv;
+ PL_lex_inpat = 0;
+ PL_lex_inwhat = 0;
+ PL_linestr = line;
+ if (SvREADONLY(PL_linestr))
+ PL_linestr = sv_2mortal(newSVsv(PL_linestr));
+ s = SvPV(PL_linestr, len);
if (len && s[len-1] != ';') {
- if (!(SvFLAGS(linestr) & SVs_TEMP))
- linestr = sv_2mortal(newSVsv(linestr));
- sv_catpvn(linestr, "\n;", 2);
+ if (!(SvFLAGS(PL_linestr) & SVs_TEMP))
+ PL_linestr = sv_2mortal(newSVsv(PL_linestr));
+ sv_catpvn(PL_linestr, "\n;", 2);
}
- SvTEMP_off(linestr);
- oldoldbufptr = oldbufptr = bufptr = linestart = SvPVX(linestr);
- bufend = bufptr + SvCUR(linestr);
- SvREFCNT_dec(rs);
- rs = newSVpv("\n", 1);
- rsfp = 0;
+ SvTEMP_off(PL_linestr);
+ PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
+ PL_bufend = PL_bufptr + SvCUR(PL_linestr);
+ SvREFCNT_dec(PL_rs);
+ PL_rs = newSVpv("\n", 1);
+ PL_rsfp = 0;
}
void
-lex_end()
+lex_end(void)
{
- doextract = FALSE;
+ PL_doextract = FALSE;
}
-static void
-restore_rsfp(f)
-void *f;
+STATIC void
+restore_rsfp(void *f)
{
PerlIO *fp = (PerlIO*)f;
- if (rsfp == PerlIO_stdin())
- PerlIO_clearerr(rsfp);
- else if (rsfp && (rsfp != fp))
- PerlIO_close(rsfp);
- rsfp = fp;
+ if (PL_rsfp == PerlIO_stdin())
+ PerlIO_clearerr(PL_rsfp);
+ else if (PL_rsfp && (PL_rsfp != fp))
+ PerlIO_close(PL_rsfp);
+ PL_rsfp = fp;
+}
+
+STATIC void
+restore_expect(void *e)
+{
+ /* a safe way to store a small integer in a pointer */
+ PL_expect = (expectation)((char *)e - PL_tokenbuf);
+}
+
+STATIC void
+restore_lex_expect(void *e)
+{
+ /* a safe way to store a small integer in a pointer */
+ PL_lex_expect = (expectation)((char *)e - PL_tokenbuf);
}
-static void
-incline(s)
-char *s;
+STATIC void
+incline(char *s)
{
+ dTHR;
char *t;
char *n;
char ch;
int sawline = 0;
- curcop->cop_line++;
+ PL_curcop->cop_line++;
if (*s++ != '#')
return;
while (*s == ' ' || *s == '\t') s++;
@@ -341,87 +367,92 @@ char *s;
ch = *t;
*t = '\0';
if (t - s > 0)
- curcop->cop_filegv = gv_fetchfile(s);
+ PL_curcop->cop_filegv = gv_fetchfile(s);
else
- curcop->cop_filegv = gv_fetchfile(origfilename);
+ PL_curcop->cop_filegv = gv_fetchfile(PL_origfilename);
*t = ch;
- curcop->cop_line = atoi(n)-1;
+ PL_curcop->cop_line = atoi(n)-1;
}
-static char *
-skipspace(s)
-register char *s;
+STATIC char *
+skipspace(register char *s)
{
- if (lex_formbrack && lex_brackets <= lex_formbrack) {
- while (s < bufend && (*s == ' ' || *s == '\t'))
+ dTHR;
+ if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
+ while (s < PL_bufend && (*s == ' ' || *s == '\t'))
s++;
return s;
}
for (;;) {
STRLEN prevlen;
- while (s < bufend && isSPACE(*s))
- s++;
- if (s < bufend && *s == '#') {
- while (s < bufend && *s != '\n')
+ while (s < PL_bufend && isSPACE(*s)) {
+ if (*s++ == '\n' && PL_in_eval && !PL_rsfp)
+ incline(s);
+ }
+ if (s < PL_bufend && *s == '#') {
+ while (s < PL_bufend && *s != '\n')
s++;
- if (s < bufend)
+ if (s < PL_bufend) {
s++;
+ if (PL_in_eval && !PL_rsfp) {
+ incline(s);
+ continue;
+ }
+ }
}
- if (s < bufend || !rsfp || lex_state != LEX_NORMAL)
+ if (s < PL_bufend || !PL_rsfp || PL_lex_state != LEX_NORMAL)
return s;
- if ((s = filter_gets(linestr, rsfp, (prevlen = SvCUR(linestr)))) == Nullch) {
- if (minus_n || minus_p) {
- sv_setpv(linestr,minus_p ?
+ if ((s = filter_gets(PL_linestr, PL_rsfp, (prevlen = SvCUR(PL_linestr)))) == Nullch) {
+ if (PL_minus_n || PL_minus_p) {
+ sv_setpv(PL_linestr,PL_minus_p ?
";}continue{print or die qq(-p destination: $!\\n)" :
"");
- sv_catpv(linestr,";}");
- minus_n = minus_p = 0;
+ sv_catpv(PL_linestr,";}");
+ PL_minus_n = PL_minus_p = 0;
}
else
- sv_setpv(linestr,";");
- oldoldbufptr = oldbufptr = bufptr = s = linestart = SvPVX(linestr);
- bufend = SvPVX(linestr) + SvCUR(linestr);
- if (preprocess && !in_eval)
- (void)my_pclose(rsfp);
- else if ((PerlIO*)rsfp == PerlIO_stdin())
- PerlIO_clearerr(rsfp);
+ sv_setpv(PL_linestr,";");
+ PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart = SvPVX(PL_linestr);
+ PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+ if (PL_preprocess && !PL_in_eval)
+ (void)PerlProc_pclose(PL_rsfp);
+ else if ((PerlIO*)PL_rsfp == PerlIO_stdin())
+ PerlIO_clearerr(PL_rsfp);
else
- (void)PerlIO_close(rsfp);
- if (e_fp == rsfp)
- e_fp = Nullfp;
- rsfp = Nullfp;
+ (void)PerlIO_close(PL_rsfp);
+ PL_rsfp = Nullfp;
return s;
}
- linestart = bufptr = s + prevlen;
- bufend = s + SvCUR(linestr);
- s = bufptr;
+ PL_linestart = PL_bufptr = s + prevlen;
+ PL_bufend = s + SvCUR(PL_linestr);
+ s = PL_bufptr;
incline(s);
- if (PERLDB_LINE && curstash != debstash) {
+ if (PERLDB_LINE && PL_curstash != PL_debstash) {
SV *sv = NEWSV(85,0);
sv_upgrade(sv, SVt_PVMG);
- sv_setpvn(sv,bufptr,bufend-bufptr);
- av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv);
+ sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
+ av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
}
}
}
-static void
-check_uni() {
+STATIC void
+check_uni(void) {
char *s;
char ch;
char *t;
- if (oldoldbufptr != last_uni)
+ if (PL_oldoldbufptr != PL_last_uni)
return;
- while (isSPACE(*last_uni))
- last_uni++;
- for (s = last_uni; isALNUM(*s) || *s == '-'; s++) ;
- if ((t = strchr(s, '(')) && t < bufptr)
+ while (isSPACE(*PL_last_uni))
+ PL_last_uni++;
+ for (s = PL_last_uni; isALNUM(*s) || *s == '-'; s++) ;
+ if ((t = strchr(s, '(')) && t < PL_bufptr)
return;
ch = *s;
*s = '\0';
- warn("Warning: Use of \"%s\" without parens is ambiguous", last_uni);
+ warn("Warning: Use of \"%s\" without parens is ambiguous", PL_last_uni);
*s = ch;
}
@@ -430,16 +461,14 @@ check_uni() {
#undef UNI
#define UNI(f) return uni(f,s)
-static int
-uni(f,s)
-I32 f;
-char *s;
+STATIC int
+uni(I32 f, char *s)
{
yylval.ival = f;
- expect = XTERM;
- bufptr = s;
- last_uni = oldbufptr;
- last_lop_op = f;
+ PL_expect = XTERM;
+ PL_bufptr = s;
+ PL_last_uni = PL_oldbufptr;
+ PL_last_lop_op = f;
if (*s == '(')
return FUNC1;
s = skipspace(s);
@@ -453,24 +482,17 @@ char *s;
#define LOP(f,x) return lop(f,x,s)
-static I32
-lop
-#ifdef CAN_PROTOTYPE
- (I32 f, expectation x, char *s)
-#else
- (f,x,s)
-I32 f;
-expectation x;
-char *s;
-#endif /* CAN_PROTOTYPE */
+STATIC I32
+lop(I32 f, expectation x, char *s)
{
+ dTHR;
yylval.ival = f;
CLINE;
- expect = x;
- bufptr = s;
- last_lop = oldbufptr;
- last_lop_op = f;
- if (nexttoke)
+ PL_expect = x;
+ PL_bufptr = s;
+ PL_last_lop = PL_oldbufptr;
+ PL_last_lop_op = f;
+ if (PL_nexttoke)
return LSTOP;
if (*s == '(')
return FUNC;
@@ -481,26 +503,20 @@ char *s;
return LSTOP;
}
-static void
-force_next(type)
-I32 type;
+STATIC void
+force_next(I32 type)
{
- nexttype[nexttoke] = type;
- nexttoke++;
- if (lex_state != LEX_KNOWNEXT) {
- lex_defer = lex_state;
- lex_expect = expect;
- lex_state = LEX_KNOWNEXT;
+ PL_nexttype[PL_nexttoke] = type;
+ PL_nexttoke++;
+ if (PL_lex_state != LEX_KNOWNEXT) {
+ PL_lex_defer = PL_lex_state;
+ PL_lex_expect = PL_expect;
+ PL_lex_state = LEX_KNOWNEXT;
}
}
-static char *
-force_word(start,token,check_keyword,allow_pack,allow_tick)
-register char *start;
-int token;
-int check_keyword;
-int allow_pack;
-int allow_tick;
+STATIC char *
+force_word(register char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick)
{
register char *s;
STRLEN len;
@@ -509,43 +525,42 @@ int allow_tick;
s = start;
if (isIDFIRST(*s) ||
(allow_pack && *s == ':') ||
- (allow_tick && *s == '\'') )
+ (allow_initial_tick && *s == '\'') )
{
- s = scan_word(s, tokenbuf, sizeof tokenbuf, allow_pack, &len);
- if (check_keyword && keyword(tokenbuf, len))
+ s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, allow_pack, &len);
+ if (check_keyword && keyword(PL_tokenbuf, len))
return start;
if (token == METHOD) {
s = skipspace(s);
if (*s == '(')
- expect = XTERM;
+ PL_expect = XTERM;
else {
- expect = XOPERATOR;
+ PL_expect = XOPERATOR;
force_next(')');
force_next('(');
}
}
- nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST,0, newSVpv(tokenbuf,0));
- nextval[nexttoke].opval->op_private |= OPpCONST_BARE;
+ PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST,0, newSVpv(PL_tokenbuf,0));
+ PL_nextval[PL_nexttoke].opval->op_private |= OPpCONST_BARE;
force_next(token);
}
return s;
}
-static void
-force_ident(s, kind)
-register char *s;
-int kind;
+STATIC void
+force_ident(register char *s, int kind)
{
if (s && *s) {
- OP* op = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
- nextval[nexttoke].opval = op;
+ OP* o = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
+ PL_nextval[PL_nexttoke].opval = o;
force_next(WORD);
if (kind) {
- op->op_private = OPpCONST_ENTERED;
+ dTHR; /* just for in_eval */
+ o->op_private = OPpCONST_ENTERED;
/* XXX see note in pp_entereval() for why we forgo typo
warnings if the symbol must be introduced in an eval.
GSAR 96-10-12 */
- gv_fetchpv(s, in_eval ? GV_ADDMULTI : TRUE,
+ gv_fetchpv(s, PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : TRUE,
kind == '$' ? SVt_PV :
kind == '@' ? SVt_PVAV :
kind == '%' ? SVt_PVHV :
@@ -555,9 +570,8 @@ int kind;
}
}
-static char *
-force_version(s)
-char *s;
+STATIC char *
+force_version(char *s)
{
OP *version = Nullop;
@@ -577,33 +591,35 @@ char *s;
}
/* NOTE: The parser sees the package name and the VERSION swapped */
- nextval[nexttoke].opval = version;
+ PL_nextval[PL_nexttoke].opval = version;
force_next(WORD);
return (s);
}
-static SV *
-q(sv)
-SV *sv;
+STATIC SV *
+tokeq(SV *sv)
{
register char *s;
register char *send;
register char *d;
- STRLEN len;
+ STRLEN len = 0;
+ SV *pv = sv;
if (!SvLEN(sv))
- return sv;
+ goto finish;
s = SvPV_force(sv, len);
if (SvIVX(sv) == -1)
- return sv;
+ goto finish;
send = s + len;
while (s < send && *s != '\\')
s++;
if (s == send)
- return sv;
+ goto finish;
d = s;
+ if ( PL_hints & HINT_NEW_STRING )
+ pv = sv_2mortal(newSVpv(SvPVX(pv), len));
while (s < send) {
if (*s == '\\') {
if (s + 1 < send && (s[1] == '\\'))
@@ -613,239 +629,411 @@ SV *sv;
}
*d = '\0';
SvCUR_set(sv, d - SvPVX(sv));
-
+ finish:
+ if ( PL_hints & HINT_NEW_STRING )
+ return new_constant(NULL, 0, "q", sv, pv, "q");
return sv;
}
-static I32
-sublex_start()
+STATIC I32
+sublex_start(void)
{
register I32 op_type = yylval.ival;
if (op_type == OP_NULL) {
- yylval.opval = lex_op;
- lex_op = Nullop;
+ yylval.opval = PL_lex_op;
+ PL_lex_op = Nullop;
return THING;
}
if (op_type == OP_CONST || op_type == OP_READLINE) {
- SV *sv = q(lex_stuff);
- STRLEN len;
- char *p = SvPV(sv, len);
- yylval.opval = (OP*)newSVOP(op_type, 0, newSVpv(p, len));
- SvREFCNT_dec(sv);
- lex_stuff = Nullsv;
+ SV *sv = tokeq(PL_lex_stuff);
+
+ if (SvTYPE(sv) == SVt_PVIV) {
+ /* Overloaded constants, nothing fancy: Convert to SVt_PV: */
+ STRLEN len;
+ char *p;
+ SV *nsv;
+
+ p = SvPV(sv, len);
+ nsv = newSVpv(p, len);
+ SvREFCNT_dec(sv);
+ sv = nsv;
+ }
+ yylval.opval = (OP*)newSVOP(op_type, 0, sv);
+ PL_lex_stuff = Nullsv;
return THING;
}
- sublex_info.super_state = lex_state;
- sublex_info.sub_inwhat = op_type;
- sublex_info.sub_op = lex_op;
- lex_state = LEX_INTERPPUSH;
+ PL_sublex_info.super_state = PL_lex_state;
+ PL_sublex_info.sub_inwhat = op_type;
+ PL_sublex_info.sub_op = PL_lex_op;
+ PL_lex_state = LEX_INTERPPUSH;
- expect = XTERM;
- if (lex_op) {
- yylval.opval = lex_op;
- lex_op = Nullop;
+ PL_expect = XTERM;
+ if (PL_lex_op) {
+ yylval.opval = PL_lex_op;
+ PL_lex_op = Nullop;
return PMFUNC;
}
else
return FUNC;
}
-static I32
-sublex_push()
+STATIC I32
+sublex_push(void)
{
- push_scope();
-
- lex_state = sublex_info.super_state;
- SAVEI32(lex_dojoin);
- SAVEI32(lex_brackets);
- SAVEI32(lex_fakebrack);
- SAVEI32(lex_casemods);
- SAVEI32(lex_starts);
- SAVEI32(lex_state);
- SAVESPTR(lex_inpat);
- SAVEI32(lex_inwhat);
- SAVEI16(curcop->cop_line);
- SAVEPPTR(bufptr);
- SAVEPPTR(oldbufptr);
- SAVEPPTR(oldoldbufptr);
- SAVEPPTR(linestart);
- SAVESPTR(linestr);
- SAVEPPTR(lex_brackstack);
- SAVEPPTR(lex_casestack);
-
- linestr = lex_stuff;
- lex_stuff = Nullsv;
-
- bufend = bufptr = oldbufptr = oldoldbufptr = linestart = SvPVX(linestr);
- bufend += SvCUR(linestr);
- SAVEFREESV(linestr);
-
- lex_dojoin = FALSE;
- lex_brackets = 0;
- lex_fakebrack = 0;
- New(899, lex_brackstack, 120, char);
- New(899, lex_casestack, 12, char);
- SAVEFREEPV(lex_brackstack);
- SAVEFREEPV(lex_casestack);
- lex_casemods = 0;
- *lex_casestack = '\0';
- lex_starts = 0;
- lex_state = LEX_INTERPCONCAT;
- curcop->cop_line = multi_start;
-
- lex_inwhat = sublex_info.sub_inwhat;
- if (lex_inwhat == OP_MATCH || lex_inwhat == OP_SUBST)
- lex_inpat = sublex_info.sub_op;
+ dTHR;
+ ENTER;
+
+ PL_lex_state = PL_sublex_info.super_state;
+ SAVEI32(PL_lex_dojoin);
+ SAVEI32(PL_lex_brackets);
+ SAVEI32(PL_lex_fakebrack);
+ SAVEI32(PL_lex_casemods);
+ SAVEI32(PL_lex_starts);
+ SAVEI32(PL_lex_state);
+ SAVESPTR(PL_lex_inpat);
+ SAVEI32(PL_lex_inwhat);
+ SAVEI16(PL_curcop->cop_line);
+ SAVEPPTR(PL_bufptr);
+ SAVEPPTR(PL_oldbufptr);
+ SAVEPPTR(PL_oldoldbufptr);
+ SAVEPPTR(PL_linestart);
+ SAVESPTR(PL_linestr);
+ SAVEPPTR(PL_lex_brackstack);
+ SAVEPPTR(PL_lex_casestack);
+
+ PL_linestr = PL_lex_stuff;
+ PL_lex_stuff = Nullsv;
+
+ PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr);
+ PL_bufend += SvCUR(PL_linestr);
+ SAVEFREESV(PL_linestr);
+
+ PL_lex_dojoin = FALSE;
+ PL_lex_brackets = 0;
+ PL_lex_fakebrack = 0;
+ New(899, PL_lex_brackstack, 120, char);
+ New(899, PL_lex_casestack, 12, char);
+ SAVEFREEPV(PL_lex_brackstack);
+ SAVEFREEPV(PL_lex_casestack);
+ PL_lex_casemods = 0;
+ *PL_lex_casestack = '\0';
+ PL_lex_starts = 0;
+ PL_lex_state = LEX_INTERPCONCAT;
+ PL_curcop->cop_line = PL_multi_start;
+
+ PL_lex_inwhat = PL_sublex_info.sub_inwhat;
+ if (PL_lex_inwhat == OP_MATCH || PL_lex_inwhat == OP_QR || PL_lex_inwhat == OP_SUBST)
+ PL_lex_inpat = PL_sublex_info.sub_op;
else
- lex_inpat = Nullop;
+ PL_lex_inpat = Nullop;
return '(';
}
-static I32
-sublex_done()
+STATIC I32
+sublex_done(void)
{
- if (!lex_starts++) {
- expect = XOPERATOR;
+ if (!PL_lex_starts++) {
+ PL_expect = XOPERATOR;
yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv("",0));
return THING;
}
- if (lex_casemods) { /* oops, we've got some unbalanced parens */
- lex_state = LEX_INTERPCASEMOD;
+ if (PL_lex_casemods) { /* oops, we've got some unbalanced parens */
+ PL_lex_state = LEX_INTERPCASEMOD;
return yylex();
}
/* Is there a right-hand side to take care of? */
- if (lex_repl && (lex_inwhat == OP_SUBST || lex_inwhat == OP_TRANS)) {
- linestr = lex_repl;
- lex_inpat = 0;
- bufend = bufptr = oldbufptr = oldoldbufptr = linestart = SvPVX(linestr);
- bufend += SvCUR(linestr);
- SAVEFREESV(linestr);
- lex_dojoin = FALSE;
- lex_brackets = 0;
- lex_fakebrack = 0;
- lex_casemods = 0;
- *lex_casestack = '\0';
- lex_starts = 0;
- if (SvCOMPILED(lex_repl)) {
- lex_state = LEX_INTERPNORMAL;
- lex_starts++;
+ if (PL_lex_repl && (PL_lex_inwhat == OP_SUBST || PL_lex_inwhat == OP_TRANS)) {
+ PL_linestr = PL_lex_repl;
+ PL_lex_inpat = 0;
+ PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr);
+ PL_bufend += SvCUR(PL_linestr);
+ SAVEFREESV(PL_linestr);
+ PL_lex_dojoin = FALSE;
+ PL_lex_brackets = 0;
+ PL_lex_fakebrack = 0;
+ PL_lex_casemods = 0;
+ *PL_lex_casestack = '\0';
+ PL_lex_starts = 0;
+ if (SvCOMPILED(PL_lex_repl)) {
+ PL_lex_state = LEX_INTERPNORMAL;
+ PL_lex_starts++;
}
else
- lex_state = LEX_INTERPCONCAT;
- lex_repl = Nullsv;
+ PL_lex_state = LEX_INTERPCONCAT;
+ PL_lex_repl = Nullsv;
return ',';
}
else {
- pop_scope();
- bufend = SvPVX(linestr);
- bufend += SvCUR(linestr);
- expect = XOPERATOR;
+ LEAVE;
+ PL_bufend = SvPVX(PL_linestr);
+ PL_bufend += SvCUR(PL_linestr);
+ PL_expect = XOPERATOR;
return ')';
}
}
-static char *
-scan_const(start)
-char *start;
+/*
+ scan_const
+
+ Extracts a pattern, double-quoted string, or transliteration. This
+ is terrifying code.
+
+ It looks at lex_inwhat and PL_lex_inpat to find out whether it's
+ processing a pattern (PL_lex_inpat is true), a transliteration
+ (lex_inwhat & OP_TRANS is true), or a double-quoted string.
+
+ Returns a pointer to the character scanned up to. Iff this is
+ advanced from the start pointer supplied (ie if anything was
+ successfully parsed), will leave an OP for the substring scanned
+ in yylval. Caller must intuit reason for not parsing further
+ by looking at the next characters herself.
+
+ In patterns:
+ backslashes:
+ double-quoted style: \r and \n
+ regexp special ones: \D \s
+ constants: \x3
+ backrefs: \1 (deprecated in substitution replacements)
+ case and quoting: \U \Q \E
+ stops on @ and $, but not for $ as tail anchor
+
+ In transliterations:
+ characters are VERY literal, except for - not at the start or end
+ of the string, which indicates a range. scan_const expands the
+ range to the full set of intermediate characters.
+
+ In double-quoted strings:
+ backslashes:
+ double-quoted style: \r and \n
+ constants: \x3
+ backrefs: \1 (deprecated)
+ case and quoting: \U \Q \E
+ stops on @ and $
+
+ scan_const does *not* construct ops to handle interpolated strings.
+ It stops processing as soon as it finds an embedded $ or @ variable
+ and leaves it to the caller to work out what's going on.
+
+ @ in pattern could be: @foo, @{foo}, @$foo, @'foo, @:foo.
+
+ $ in pattern could be $foo or could be tail anchor. Assumption:
+ it's a tail anchor if $ is the last thing in the string, or if it's
+ followed by one of ")| \n\t"
+
+ \1 (backreferences) are turned into $1
+
+ The structure of the code is
+ while (there's a character to process) {
+ handle transliteration ranges
+ skip regexp comments
+ skip # initiated comments in //x patterns
+ check for embedded @foo
+ check for embedded scalars
+ if (backslash) {
+ leave intact backslashes from leave (below)
+ deprecate \1 in strings and sub replacements
+ handle string-changing backslashes \l \U \Q \E, etc.
+ switch (what was escaped) {
+ handle - in a transliteration (becomes a literal -)
+ handle \132 octal characters
+ handle 0x15 hex characters
+ handle \cV (control V)
+ handle printf backslashes (\f, \r, \n, etc)
+ } (end switch)
+ } (end if backslash)
+ } (end while character to read)
+
+*/
+
+STATIC char *
+scan_const(char *start)
{
- register char *send = bufend;
- SV *sv = NEWSV(93, send - start);
- register char *s = start;
- register char *d = SvPVX(sv);
- bool dorange = FALSE;
- I32 len;
- char *leave =
- lex_inpat
- ? "\\.^$@AGZdDwWsSbB+*?|()-nrtfeaxc0123456789[{]} \t\n\r\f\v#"
- : (lex_inwhat & OP_TRANS)
- ? ""
- : "";
+ register char *send = PL_bufend; /* end of the constant */
+ SV *sv = NEWSV(93, send - start); /* sv for the constant */
+ register char *s = start; /* start of the constant */
+ register char *d = SvPVX(sv); /* destination for copies */
+ bool dorange = FALSE; /* are we in a translit range? */
+ I32 len; /* ? */
+
+ /* leaveit is the set of acceptably-backslashed characters */
+ char *leaveit =
+ PL_lex_inpat
+ ? "\\.^$@AGZdDwWsSbB+*?|()-nrtfeaxcz0123456789[{]} \t\n\r\f\v#"
+ : "";
while (s < send || dorange) {
- if (lex_inwhat == OP_TRANS) {
+ /* get transliterations out of the way (they're most literal) */
+ if (PL_lex_inwhat == OP_TRANS) {
+ /* expand a range A-Z to the full set of characters. AIE! */
if (dorange) {
- I32 i;
- I32 max;
- i = d - SvPVX(sv);
- SvGROW(sv, SvLEN(sv) + 256);
- d = SvPVX(sv) + i;
- d -= 2;
- max = (U8)d[1];
- for (i = (U8)*d; i <= max; i++)
- *d++ = i;
+ I32 i; /* current expanded character */
+ I32 min; /* first character in range */
+ I32 max; /* last character in range */
+
+ i = d - SvPVX(sv); /* remember current offset */
+ SvGROW(sv, SvLEN(sv) + 256); /* expand the sv -- there'll never be more'n 256 chars in a range for it to grow by */
+ d = SvPVX(sv) + i; /* restore d after the grow potentially has changed the ptr */
+ d -= 2; /* eat the first char and the - */
+
+ min = (U8)*d; /* first char in range */
+ max = (U8)d[1]; /* last char in range */
+
+#ifndef ASCIIish
+ if ((isLOWER(min) && isLOWER(max)) ||
+ (isUPPER(min) && isUPPER(max))) {
+ if (isLOWER(min)) {
+ for (i = min; i <= max; i++)
+ if (isLOWER(i))
+ *d++ = i;
+ } else {
+ for (i = min; i <= max; i++)
+ if (isUPPER(i))
+ *d++ = i;
+ }
+ }
+ else
+#endif
+ for (i = min; i <= max; i++)
+ *d++ = i;
+
+ /* mark the range as done, and continue */
dorange = FALSE;
continue;
}
+
+ /* range begins (ignore - as first or last char) */
else if (*s == '-' && s+1 < send && s != start) {
dorange = TRUE;
s++;
}
}
- else if (*s == '(' && lex_inpat && s[1] == '?' && s[2] == '#') {
- while (s < send && *s != ')')
- *d++ = *s++;
+
+ /* if we get here, we're not doing a transliteration */
+
+ /* skip for regexp comments /(?#comment)/ */
+ else if (*s == '(' && PL_lex_inpat && s[1] == '?') {
+ if (s[2] == '#') {
+ while (s < send && *s != ')')
+ *d++ = *s++;
+ } else if (s[2] == '{') { /* This should march regcomp.c */
+ I32 count = 1;
+ char *regparse = s + 3;
+ char c;
+
+ while (count && (c = *regparse)) {
+ if (c == '\\' && regparse[1])
+ regparse++;
+ else if (c == '{')
+ count++;
+ else if (c == '}')
+ count--;
+ regparse++;
+ }
+ if (*regparse == ')')
+ regparse++;
+ else
+ yyerror("Sequence (?{...}) not terminated or not {}-balanced");
+ while (s < regparse && *s != ')')
+ *d++ = *s++;
+ }
}
- else if (*s == '#' && lex_inpat &&
- ((PMOP*)lex_inpat)->op_pmflags & PMf_EXTENDED) {
+
+ /* likewise skip #-initiated comments in //x patterns */
+ else if (*s == '#' && PL_lex_inpat &&
+ ((PMOP*)PL_lex_inpat)->op_pmflags & PMf_EXTENDED) {
while (s+1 < send && *s != '\n')
*d++ = *s++;
}
+
+ /* check for embedded arrays (@foo, @:foo, @'foo, @{foo}, @$foo) */
else if (*s == '@' && s[1] && (isALNUM(s[1]) || strchr(":'{$", s[1])))
break;
+
+ /* check for embedded scalars. only stop if we're sure it's a
+ variable.
+ */
else if (*s == '$') {
- if (!lex_inpat) /* not a regexp, so $ must be var */
+ if (!PL_lex_inpat) /* not a regexp, so $ must be var */
break;
- if (s + 1 < send && !strchr(")| \n\t", s[1]))
+ if (s + 1 < send && !strchr("()| \n\t", s[1]))
break; /* in regexp, $ might be tail anchor */
}
+
+ /* backslashes */
if (*s == '\\' && s+1 < send) {
s++;
- if (*s && strchr(leave, *s)) {
+
+ /* some backslashes we leave behind */
+ if (*s && strchr(leaveit, *s)) {
*d++ = '\\';
*d++ = *s++;
continue;
}
- if (lex_inwhat == OP_SUBST && !lex_inpat &&
+
+ /* deprecate \1 in strings and substitution replacements */
+ if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat &&
isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
{
- if (dowarn)
+ if (PL_dowarn)
warn("\\%c better written as $%c", *s, *s);
*--s = '$';
break;
}
- if (lex_inwhat != OP_TRANS && *s && strchr("lLuUEQ", *s)) {
+
+ /* string-change backslash escapes */
+ if (PL_lex_inwhat != OP_TRANS && *s && strchr("lLuUEQ", *s)) {
--s;
break;
}
+
+ /* if we get here, it's either a quoted -, or a digit */
switch (*s) {
+
+ /* quoted - in transliterations */
case '-':
- if (lex_inwhat == OP_TRANS) {
+ if (PL_lex_inwhat == OP_TRANS) {
*d++ = *s++;
continue;
}
/* FALL THROUGH */
+ /* default action is to copy the quoted character */
default:
*d++ = *s++;
continue;
+
+ /* \132 indicates an octal constant */
case '0': case '1': case '2': case '3':
case '4': case '5': case '6': case '7':
*d++ = scan_oct(s, 3, &len);
s += len;
continue;
+
+ /* \x24 indicates a hex constant */
case 'x':
*d++ = scan_hex(++s, 2, &len);
s += len;
continue;
+
+ /* \c is a control character */
case 'c':
s++;
+#ifdef EBCDIC
+ *d = *s++;
+ if (isLOWER(*d))
+ *d = toUPPER(*d);
+ *d++ = toCTRL(*d);
+#else
len = *s++;
*d++ = toCTRL(len);
+#endif
continue;
+
+ /* printf-style backslashes, formfeeds, newlines, etc */
case 'b':
*d++ = '\b';
break;
@@ -867,39 +1055,53 @@ char *start;
case 'a':
*d++ = '\007';
break;
- }
+ } /* end switch */
+
s++;
continue;
- }
+ } /* end if (backslash) */
+
*d++ = *s++;
- }
+ } /* while loop to process each character */
+
+ /* terminate the string and set up the sv */
*d = '\0';
SvCUR_set(sv, d - SvPVX(sv));
SvPOK_on(sv);
+ /* shrink the sv if we allocated more than we used */
if (SvCUR(sv) + 5 < SvLEN(sv)) {
SvLEN_set(sv, SvCUR(sv) + 1);
Renew(SvPVX(sv), SvLEN(sv), char);
}
- if (s > bufptr)
+
+ /* return the substring (via yylval) only if we parsed anything */
+ if (s > PL_bufptr) {
+ if ( PL_hints & ( PL_lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ) )
+ sv = new_constant(start, s - start, (PL_lex_inpat ? "qr" : "q"),
+ sv, Nullsv,
+ ( PL_lex_inwhat == OP_TRANS
+ ? "tr"
+ : ( (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat)
+ ? "s"
+ : "qq")));
yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
- else
+ } else
SvREFCNT_dec(sv);
return s;
}
/* This is the one truly awful dwimmer necessary to conflate C and sed. */
-static int
-intuit_more(s)
-register char *s;
+STATIC int
+intuit_more(register char *s)
{
- if (lex_brackets)
+ if (PL_lex_brackets)
return TRUE;
if (*s == '-' && s[1] == '>' && (s[2] == '[' || s[2] == '{'))
return TRUE;
if (*s != '{' && *s != '[')
return FALSE;
- if (!lex_inpat)
+ if (!PL_lex_inpat)
return TRUE;
/* In a pattern, so maybe we have {n,m}. */
@@ -927,9 +1129,9 @@ register char *s;
else {
int weight = 2; /* let's weigh the evidence */
char seen[256];
- unsigned char un_char = 0, last_un_char;
+ unsigned char un_char = 255, last_un_char;
char *send = strchr(s,']');
- char tmpbuf[sizeof tokenbuf * 4];
+ char tmpbuf[sizeof PL_tokenbuf * 4];
if (!send) /* has to be an expression */
return TRUE;
@@ -993,6 +1195,8 @@ register char *s;
weight += 30;
if (strchr("zZ79~",s[1]))
weight += 30;
+ if (last_un_char == 255 && (isDIGIT(s[1]) || s[1] == '$'))
+ weight -= 5; /* cope with negative subscript */
break;
default:
if (!isALNUM(last_un_char) && !strchr("$@&",last_un_char) &&
@@ -1018,62 +1222,74 @@ register char *s;
return TRUE;
}
-static int
-intuit_method(start,gv)
-char *start;
-GV *gv;
+STATIC int
+intuit_method(char *start, GV *gv)
{
char *s = start + (*start == '$');
- char tmpbuf[sizeof tokenbuf];
+ char tmpbuf[sizeof PL_tokenbuf];
STRLEN len;
GV* indirgv;
if (gv) {
+ CV *cv;
if (GvIO(gv))
return 0;
- if (!GvCVu(gv))
+ if ((cv = GvCVu(gv))) {
+ char *proto = SvPVX(cv);
+ if (proto) {
+ if (*proto == ';')
+ proto++;
+ if (*proto == '*')
+ return 0;
+ }
+ } else
gv = 0;
}
s = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
if (*start == '$') {
- if (gv || last_lop_op == OP_PRINT || isUPPER(*tokenbuf))
+ if (gv || PL_last_lop_op == OP_PRINT || isUPPER(*PL_tokenbuf))
return 0;
s = skipspace(s);
- bufptr = start;
- expect = XREF;
+ PL_bufptr = start;
+ PL_expect = XREF;
return *s == '(' ? FUNCMETH : METHOD;
}
if (!keyword(tmpbuf, len)) {
- indirgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVCV);
+ if (len > 2 && tmpbuf[len - 2] == ':' && tmpbuf[len - 1] == ':') {
+ len -= 2;
+ tmpbuf[len] = '\0';
+ goto bare_package;
+ }
+ indirgv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV);
if (indirgv && GvCVu(indirgv))
return 0;
/* filehandle or package name makes it a method */
if (!gv || GvIO(indirgv) || gv_stashpvn(tmpbuf, len, FALSE)) {
s = skipspace(s);
- if ((bufend - s) >= 2 && *s == '=' && *(s+1) == '>')
+ if ((PL_bufend - s) >= 2 && *s == '=' && *(s+1) == '>')
return 0; /* no assumptions -- "=>" quotes bearword */
- nextval[nexttoke].opval =
- (OP*)newSVOP(OP_CONST, 0,
- newSVpv(tmpbuf,0));
- nextval[nexttoke].opval->op_private =
- OPpCONST_BARE;
- expect = XTERM;
+ bare_package:
+ PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0,
+ newSVpv(tmpbuf,0));
+ PL_nextval[PL_nexttoke].opval->op_private = OPpCONST_BARE;
+ PL_expect = XTERM;
force_next(WORD);
- bufptr = s;
+ PL_bufptr = s;
return *s == '(' ? FUNCMETH : METHOD;
}
}
return 0;
}
-static char*
-incl_perldb()
+STATIC char*
+incl_perldb(void)
{
- if (perldb) {
- char *pdb = getenv("PERL5DB");
+ if (PL_perldb) {
+ char *pdb = PerlEnv_getenv("PERL5DB");
if (pdb)
return pdb;
+ SETERRNO(0,SS$_NORMAL);
return "BEGIN { require 'perl5db.pl' }";
}
return "";
@@ -1095,45 +1311,45 @@ incl_perldb()
* Note that IoTOP_NAME, IoFMT_NAME, IoBOTTOM_NAME, if set for
* private use must be set using malloc'd pointers.
*/
+#ifndef PERL_OBJECT
static int filter_debug = 0;
+#endif
SV *
-filter_add(funcp, datasv)
- filter_t funcp;
- SV *datasv;
+filter_add(filter_t funcp, SV *datasv)
{
if (!funcp){ /* temporary handy debugging hack to be deleted */
filter_debug = atoi((char*)datasv);
return NULL;
}
- if (!rsfp_filters)
- rsfp_filters = newAV();
+ if (!PL_rsfp_filters)
+ PL_rsfp_filters = newAV();
if (!datasv)
- datasv = newSV(0);
+ datasv = NEWSV(255,0);
if (!SvUPGRADE(datasv, SVt_PVIO))
die("Can't upgrade filter_add data to SVt_PVIO");
IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
- if (filter_debug)
- warn("filter_add func %p (%s)", funcp, SvPV(datasv,na));
- av_unshift(rsfp_filters, 1);
- av_store(rsfp_filters, 0, datasv) ;
+ if (filter_debug) {
+ STRLEN n_a;
+ warn("filter_add func %p (%s)", funcp, SvPV(datasv,n_a));
+ }
+ av_unshift(PL_rsfp_filters, 1);
+ av_store(PL_rsfp_filters, 0, datasv) ;
return(datasv);
}
/* Delete most recently added instance of this filter function. */
void
-filter_del(funcp)
- filter_t funcp;
+filter_del(filter_t funcp)
{
if (filter_debug)
warn("filter_del func %p", funcp);
- if (!rsfp_filters || AvFILL(rsfp_filters)<0)
+ if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
return;
/* if filter is on top of stack (usual case) just pop it off */
- if (IoDIRP(FILTER_DATA(0)) == (void*)funcp){
- /* sv_free(av_pop(rsfp_filters)); */
- sv_free(av_shift(rsfp_filters));
+ if (IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) == (DIR*)funcp){
+ sv_free(av_pop(PL_rsfp_filters));
return;
}
@@ -1144,17 +1360,17 @@ filter_del(funcp)
/* Invoke the n'th filter function for the current rsfp. */
I32
-filter_read(idx, buf_sv, maxlen)
- int idx;
- SV *buf_sv;
- int maxlen; /* 0 = read one text line */
+filter_read(int idx, SV *buf_sv, int maxlen)
+
+
+ /* 0 = read one text line */
{
filter_t funcp;
SV *datasv = NULL;
- if (!rsfp_filters)
+ if (!PL_rsfp_filters)
return -1;
- if (idx > AvFILL(rsfp_filters)){ /* Any more filters? */
+ if (idx > AvFILLp(PL_rsfp_filters)){ /* Any more filters? */
/* Provide a default input filter to make life easy. */
/* Note that we append to the line. This is handy. */
if (filter_debug)
@@ -1166,8 +1382,8 @@ filter_read(idx, buf_sv, maxlen)
/* ensure buf_sv is large enough */
SvGROW(buf_sv, old_len + maxlen) ;
- if ((len = PerlIO_read(rsfp, SvPVX(buf_sv) + old_len, maxlen)) <= 0){
- if (PerlIO_error(rsfp))
+ if ((len = PerlIO_read(PL_rsfp, SvPVX(buf_sv) + old_len, maxlen)) <= 0){
+ if (PerlIO_error(PL_rsfp))
return -1; /* error */
else
return 0 ; /* end of file */
@@ -1175,8 +1391,8 @@ filter_read(idx, buf_sv, maxlen)
SvCUR_set(buf_sv, old_len + len) ;
} else {
/* Want a line */
- if (sv_gets(buf_sv, rsfp, SvCUR(buf_sv)) == NULL) {
- if (PerlIO_error(rsfp))
+ if (sv_gets(buf_sv, PL_rsfp, SvCUR(buf_sv)) == NULL) {
+ if (PerlIO_error(PL_rsfp))
return -1; /* error */
else
return 0 ; /* end of file */
@@ -1185,29 +1401,33 @@ filter_read(idx, buf_sv, maxlen)
return SvCUR(buf_sv);
}
/* Skip this filter slot if filter has been deleted */
- if ( (datasv = FILTER_DATA(idx)) == &sv_undef){
+ if ( (datasv = FILTER_DATA(idx)) == &PL_sv_undef){
if (filter_debug)
warn("filter_read %d: skipped (filter deleted)\n", idx);
return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */
}
/* Get function pointer hidden within datasv */
funcp = (filter_t)IoDIRP(datasv);
- if (filter_debug)
+ if (filter_debug) {
+ STRLEN n_a;
warn("filter_read %d: via function %p (%s)\n",
- idx, funcp, SvPV(datasv,na));
+ idx, funcp, SvPV(datasv,n_a));
+ }
/* Call function. The function is expected to */
/* call "FILTER_READ(idx+1, buf_sv)" first. */
/* Return: <0:error, =0:eof, >0:not eof */
- return (*funcp)(idx, buf_sv, maxlen);
+ return (*funcp)(PERL_OBJECT_THIS_ idx, buf_sv, maxlen);
}
-static char *
-filter_gets(sv,fp, append)
-register SV *sv;
-register PerlIO *fp;
-STRLEN append;
+STATIC char *
+filter_gets(register SV *sv, register PerlIO *fp, STRLEN append)
{
- if (rsfp_filters) {
+#ifdef WIN32FILTER
+ if (!PL_rsfp_filters) {
+ filter_add(win32_textfilter,NULL);
+ }
+#endif
+ if (PL_rsfp_filters) {
if (!append)
SvCUR_set(sv, 0); /* start with empty line */
@@ -1216,9 +1436,8 @@ STRLEN append;
else
return Nullch ;
}
- else
+ else
return (sv_gets(sv, fp, append));
-
}
@@ -1229,142 +1448,220 @@ STRLEN append;
EXT int yychar; /* last token */
+/*
+ yylex
+
+ Works out what to call the token just pulled out of the input
+ stream. The yacc parser takes care of taking the ops we return and
+ stitching them into a tree.
+
+ Returns:
+ PRIVATEREF
+
+ Structure:
+ if read an identifier
+ if we're in a my declaration
+ croak if they tried to say my($foo::bar)
+ build the ops for a my() declaration
+ if it's an access to a my() variable
+ are we in a sort block?
+ croak if my($a); $a <=> $b
+ build ops for access to a my() variable
+ if in a dq string, and they've said @foo and we can't find @foo
+ croak
+ build ops for a bareword
+ if we already built the token before, use it.
+*/
+
int
-yylex()
+yylex(void)
{
+ dTHR;
register char *s;
register char *d;
register I32 tmp;
STRLEN len;
+ GV *gv = Nullgv;
+ GV **gvp = 0;
+
+ /* check if there's an identifier for us to look at */
+ if (PL_pending_ident) {
+ /* pit holds the identifier we read and pending_ident is reset */
+ char pit = PL_pending_ident;
+ PL_pending_ident = 0;
- if (pending_ident) {
- char pit = pending_ident;
- pending_ident = 0;
+ /* if we're in a my(), we can't allow dynamics here.
+ $foo'bar has already been turned into $foo::bar, so
+ just check for colons.
+
+ if it's a legal name, the OP is a PADANY.
+ */
+ if (PL_in_my) {
+ if (strchr(PL_tokenbuf,':'))
+ croak(no_myglob,PL_tokenbuf);
- if (in_my) {
- if (strchr(tokenbuf,':'))
- croak(no_myglob,tokenbuf);
yylval.opval = newOP(OP_PADANY, 0);
- yylval.opval->op_targ = pad_allocmy(tokenbuf);
+ yylval.opval->op_targ = pad_allocmy(PL_tokenbuf);
return PRIVATEREF;
}
- if (!strchr(tokenbuf,':') && (tmp = pad_findmy(tokenbuf))) {
- if (last_lop_op == OP_SORT &&
- tokenbuf[0] == '$' &&
- (tokenbuf[1] == 'a' || tokenbuf[1] == 'b')
- && !tokenbuf[2])
+ /*
+ build the ops for accesses to a my() variable.
+
+ Deny my($a) or my($b) in a sort block, *if* $a or $b is
+ then used in a comparison. This catches most, but not
+ all cases. For instance, it catches
+ sort { my($a); $a <=> $b }
+ but not
+ sort { my($a); $a < $b ? -1 : $a == $b ? 0 : 1; }
+ (although why you'd do that is anyone's guess).
+ */
+
+ if (!strchr(PL_tokenbuf,':')) {
+#ifdef USE_THREADS
+ /* Check for single character per-thread SVs */
+ if (PL_tokenbuf[0] == '$' && PL_tokenbuf[2] == '\0'
+ && !isALPHA(PL_tokenbuf[1]) /* Rule out obvious non-threadsvs */
+ && (tmp = find_threadsv(&PL_tokenbuf[1])) != NOT_IN_PAD)
{
- for (d = in_eval ? oldoldbufptr : linestart;
- d < bufend && *d != '\n';
- d++)
+ yylval.opval = newOP(OP_THREADSV, 0);
+ yylval.opval->op_targ = tmp;
+ return PRIVATEREF;
+ }
+#endif /* USE_THREADS */
+ if ((tmp = pad_findmy(PL_tokenbuf)) != NOT_IN_PAD) {
+ /* if it's a sort block and they're naming $a or $b */
+ if (PL_last_lop_op == OP_SORT &&
+ PL_tokenbuf[0] == '$' &&
+ (PL_tokenbuf[1] == 'a' || PL_tokenbuf[1] == 'b')
+ && !PL_tokenbuf[2])
{
- if (strnEQ(d,"<=>",3) || strnEQ(d,"cmp",3)) {
- croak("Can't use \"my %s\" in sort comparison",
- tokenbuf);
+ for (d = PL_in_eval ? PL_oldoldbufptr : PL_linestart;
+ d < PL_bufend && *d != '\n';
+ d++)
+ {
+ if (strnEQ(d,"<=>",3) || strnEQ(d,"cmp",3)) {
+ croak("Can't use \"my %s\" in sort comparison",
+ PL_tokenbuf);
+ }
}
}
- }
- yylval.opval = newOP(OP_PADANY, 0);
- yylval.opval->op_targ = tmp;
- return PRIVATEREF;
+ yylval.opval = newOP(OP_PADANY, 0);
+ yylval.opval->op_targ = tmp;
+ return PRIVATEREF;
+ }
}
- /* Force them to make up their mind on "@foo". */
- if (pit == '@' && lex_state != LEX_NORMAL && !lex_brackets) {
- GV *gv = gv_fetchpv(tokenbuf+1, FALSE, SVt_PVAV);
- if (!gv || ((tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
+ /*
+ Whine if they've said @foo in a doublequoted string,
+ and @foo isn't a variable we can find in the symbol
+ table.
+ */
+ if (pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) {
+ GV *gv = gv_fetchpv(PL_tokenbuf+1, FALSE, SVt_PVAV);
+ if (!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
yyerror(form("In string, %s now must be written as \\%s",
- tokenbuf, tokenbuf));
+ PL_tokenbuf, PL_tokenbuf));
}
- yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf+1, 0));
+ /* build ops for a bareword */
+ yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf+1, 0));
yylval.opval->op_private = OPpCONST_ENTERED;
- gv_fetchpv(tokenbuf+1, in_eval ? GV_ADDMULTI : TRUE,
- ((tokenbuf[0] == '$') ? SVt_PV
- : (tokenbuf[0] == '@') ? SVt_PVAV
+ gv_fetchpv(PL_tokenbuf+1, PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : TRUE,
+ ((PL_tokenbuf[0] == '$') ? SVt_PV
+ : (PL_tokenbuf[0] == '@') ? SVt_PVAV
: SVt_PVHV));
return WORD;
}
- switch (lex_state) {
+ /* no identifier pending identification */
+
+ switch (PL_lex_state) {
#ifdef COMMENTARY
case LEX_NORMAL: /* Some compilers will produce faster */
case LEX_INTERPNORMAL: /* code if we comment these out. */
break;
#endif
+ /* when we're already built the next token, just pull it out the queue */
case LEX_KNOWNEXT:
- nexttoke--;
- yylval = nextval[nexttoke];
- if (!nexttoke) {
- lex_state = lex_defer;
- expect = lex_expect;
- lex_defer = LEX_NORMAL;
- }
- return(nexttype[nexttoke]);
-
+ PL_nexttoke--;
+ yylval = PL_nextval[PL_nexttoke];
+ if (!PL_nexttoke) {
+ PL_lex_state = PL_lex_defer;
+ PL_expect = PL_lex_expect;
+ PL_lex_defer = LEX_NORMAL;
+ }
+ return(PL_nexttype[PL_nexttoke]);
+
+ /* interpolated case modifiers like \L \U, including \Q and \E.
+ when we get here, PL_bufptr is at the \
+ */
case LEX_INTERPCASEMOD:
#ifdef DEBUGGING
- if (bufptr != bufend && *bufptr != '\\')
+ if (PL_bufptr != PL_bufend && *PL_bufptr != '\\')
croak("panic: INTERPCASEMOD");
#endif
- if (bufptr == bufend || bufptr[1] == 'E') {
+ /* handle \E or end of string */
+ if (PL_bufptr == PL_bufend || PL_bufptr[1] == 'E') {
char oldmod;
- if (lex_casemods) {
- oldmod = lex_casestack[--lex_casemods];
- lex_casestack[lex_casemods] = '\0';
- if (bufptr != bufend && strchr("LUQ", oldmod)) {
- bufptr += 2;
- lex_state = LEX_INTERPCONCAT;
+
+ /* if at a \E */
+ if (PL_lex_casemods) {
+ oldmod = PL_lex_casestack[--PL_lex_casemods];
+ PL_lex_casestack[PL_lex_casemods] = '\0';
+
+ if (PL_bufptr != PL_bufend && strchr("LUQ", oldmod)) {
+ PL_bufptr += 2;
+ PL_lex_state = LEX_INTERPCONCAT;
}
return ')';
}
- if (bufptr != bufend)
- bufptr += 2;
- lex_state = LEX_INTERPCONCAT;
+ if (PL_bufptr != PL_bufend)
+ PL_bufptr += 2;
+ PL_lex_state = LEX_INTERPCONCAT;
return yylex();
}
else {
- s = bufptr + 1;
+ s = PL_bufptr + 1;
if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
tmp = *s, *s = s[2], s[2] = tmp; /* misordered... */
if (strchr("LU", *s) &&
- (strchr(lex_casestack, 'L') || strchr(lex_casestack, 'U')))
+ (strchr(PL_lex_casestack, 'L') || strchr(PL_lex_casestack, 'U')))
{
- lex_casestack[--lex_casemods] = '\0';
+ PL_lex_casestack[--PL_lex_casemods] = '\0';
return ')';
}
- if (lex_casemods > 10) {
- char* newlb = Renew(lex_casestack, lex_casemods + 2, char);
- if (newlb != lex_casestack) {
+ if (PL_lex_casemods > 10) {
+ char* newlb = Renew(PL_lex_casestack, PL_lex_casemods + 2, char);
+ if (newlb != PL_lex_casestack) {
SAVEFREEPV(newlb);
- lex_casestack = newlb;
+ PL_lex_casestack = newlb;
}
}
- lex_casestack[lex_casemods++] = *s;
- lex_casestack[lex_casemods] = '\0';
- lex_state = LEX_INTERPCONCAT;
- nextval[nexttoke].ival = 0;
+ PL_lex_casestack[PL_lex_casemods++] = *s;
+ PL_lex_casestack[PL_lex_casemods] = '\0';
+ PL_lex_state = LEX_INTERPCONCAT;
+ PL_nextval[PL_nexttoke].ival = 0;
force_next('(');
if (*s == 'l')
- nextval[nexttoke].ival = OP_LCFIRST;
+ PL_nextval[PL_nexttoke].ival = OP_LCFIRST;
else if (*s == 'u')
- nextval[nexttoke].ival = OP_UCFIRST;
+ PL_nextval[PL_nexttoke].ival = OP_UCFIRST;
else if (*s == 'L')
- nextval[nexttoke].ival = OP_LC;
+ PL_nextval[PL_nexttoke].ival = OP_LC;
else if (*s == 'U')
- nextval[nexttoke].ival = OP_UC;
+ PL_nextval[PL_nexttoke].ival = OP_UC;
else if (*s == 'Q')
- nextval[nexttoke].ival = OP_QUOTEMETA;
+ PL_nextval[PL_nexttoke].ival = OP_QUOTEMETA;
else
croak("panic: yylex");
- bufptr = s + 1;
+ PL_bufptr = s + 1;
force_next(FUNC);
- if (lex_starts) {
- s = bufptr;
- lex_starts = 0;
+ if (PL_lex_starts) {
+ s = PL_bufptr;
+ PL_lex_starts = 0;
Aop(OP_CONCAT);
}
else
@@ -1375,91 +1672,99 @@ yylex()
return sublex_push();
case LEX_INTERPSTART:
- if (bufptr == bufend)
+ if (PL_bufptr == PL_bufend)
return sublex_done();
- expect = XTERM;
- lex_dojoin = (*bufptr == '@');
- lex_state = LEX_INTERPNORMAL;
- if (lex_dojoin) {
- nextval[nexttoke].ival = 0;
+ PL_expect = XTERM;
+ PL_lex_dojoin = (*PL_bufptr == '@');
+ PL_lex_state = LEX_INTERPNORMAL;
+ if (PL_lex_dojoin) {
+ PL_nextval[PL_nexttoke].ival = 0;
force_next(',');
+#ifdef USE_THREADS
+ PL_nextval[PL_nexttoke].opval = newOP(OP_THREADSV, 0);
+ PL_nextval[PL_nexttoke].opval->op_targ = find_threadsv("\"");
+ force_next(PRIVATEREF);
+#else
force_ident("\"", '$');
- nextval[nexttoke].ival = 0;
+#endif /* USE_THREADS */
+ PL_nextval[PL_nexttoke].ival = 0;
force_next('$');
- nextval[nexttoke].ival = 0;
+ PL_nextval[PL_nexttoke].ival = 0;
force_next('(');
- nextval[nexttoke].ival = OP_JOIN; /* emulate join($", ...) */
+ PL_nextval[PL_nexttoke].ival = OP_JOIN; /* emulate join($", ...) */
force_next(FUNC);
}
- if (lex_starts++) {
- s = bufptr;
+ if (PL_lex_starts++) {
+ s = PL_bufptr;
Aop(OP_CONCAT);
}
return yylex();
case LEX_INTERPENDMAYBE:
- if (intuit_more(bufptr)) {
- lex_state = LEX_INTERPNORMAL; /* false alarm, more expr */
+ if (intuit_more(PL_bufptr)) {
+ PL_lex_state = LEX_INTERPNORMAL; /* false alarm, more expr */
break;
}
/* FALL THROUGH */
case LEX_INTERPEND:
- if (lex_dojoin) {
- lex_dojoin = FALSE;
- lex_state = LEX_INTERPCONCAT;
+ if (PL_lex_dojoin) {
+ PL_lex_dojoin = FALSE;
+ PL_lex_state = LEX_INTERPCONCAT;
return ')';
}
/* FALLTHROUGH */
case LEX_INTERPCONCAT:
#ifdef DEBUGGING
- if (lex_brackets)
+ if (PL_lex_brackets)
croak("panic: INTERPCONCAT");
#endif
- if (bufptr == bufend)
+ if (PL_bufptr == PL_bufend)
return sublex_done();
- if (SvIVX(linestr) == '\'') {
- SV *sv = newSVsv(linestr);
- if (!lex_inpat)
- sv = q(sv);
+ if (SvIVX(PL_linestr) == '\'') {
+ SV *sv = newSVsv(PL_linestr);
+ if (!PL_lex_inpat)
+ sv = tokeq(sv);
+ else if ( PL_hints & HINT_NEW_RE )
+ sv = new_constant(NULL, 0, "qr", sv, sv, "q");
yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
- s = bufend;
+ s = PL_bufend;
}
else {
- s = scan_const(bufptr);
+ s = scan_const(PL_bufptr);
if (*s == '\\')
- lex_state = LEX_INTERPCASEMOD;
+ PL_lex_state = LEX_INTERPCASEMOD;
else
- lex_state = LEX_INTERPSTART;
+ PL_lex_state = LEX_INTERPSTART;
}
- if (s != bufptr) {
- nextval[nexttoke] = yylval;
- expect = XTERM;
+ if (s != PL_bufptr) {
+ PL_nextval[PL_nexttoke] = yylval;
+ PL_expect = XTERM;
force_next(THING);
- if (lex_starts++)
+ if (PL_lex_starts++)
Aop(OP_CONCAT);
else {
- bufptr = s;
+ PL_bufptr = s;
return yylex();
}
}
return yylex();
case LEX_FORMLINE:
- lex_state = LEX_NORMAL;
- s = scan_formline(bufptr);
- if (!lex_formbrack)
+ PL_lex_state = LEX_NORMAL;
+ s = scan_formline(PL_bufptr);
+ if (!PL_lex_formbrack)
goto rightbracket;
OPERATOR(';');
}
- s = bufptr;
- oldoldbufptr = oldbufptr;
- oldbufptr = s;
+ s = PL_bufptr;
+ PL_oldoldbufptr = PL_oldbufptr;
+ PL_oldbufptr = s;
DEBUG_p( {
- PerlIO_printf(PerlIO_stderr(), "### Tokener expecting %s at %s\n", exp_name[expect], s);
+ PerlIO_printf(PerlIO_stderr(), "### Tokener expecting %s at %s\n", exp_name[PL_expect], s);
} )
retry:
@@ -1470,131 +1775,130 @@ yylex()
case 26:
goto fake_eof; /* emulate EOF on ^D or ^Z */
case 0:
- if (!rsfp) {
- last_uni = 0;
- last_lop = 0;
- if (lex_brackets)
+ if (!PL_rsfp) {
+ PL_last_uni = 0;
+ PL_last_lop = 0;
+ if (PL_lex_brackets)
yyerror("Missing right bracket");
TOKEN(0);
}
- if (s++ < bufend)
+ if (s++ < PL_bufend)
goto retry; /* ignore stray nulls */
- last_uni = 0;
- last_lop = 0;
- if (!in_eval && !preambled) {
- preambled = TRUE;
- sv_setpv(linestr,incl_perldb());
- if (SvCUR(linestr))
- sv_catpv(linestr,";");
- if (preambleav){
- while(AvFILL(preambleav) >= 0) {
- SV *tmpsv = av_shift(preambleav);
- sv_catsv(linestr, tmpsv);
- sv_catpv(linestr, ";");
+ PL_last_uni = 0;
+ PL_last_lop = 0;
+ if (!PL_in_eval && !PL_preambled) {
+ PL_preambled = TRUE;
+ sv_setpv(PL_linestr,incl_perldb());
+ if (SvCUR(PL_linestr))
+ sv_catpv(PL_linestr,";");
+ if (PL_preambleav){
+ while(AvFILLp(PL_preambleav) >= 0) {
+ SV *tmpsv = av_shift(PL_preambleav);
+ sv_catsv(PL_linestr, tmpsv);
+ sv_catpv(PL_linestr, ";");
sv_free(tmpsv);
}
- sv_free((SV*)preambleav);
- preambleav = NULL;
+ sv_free((SV*)PL_preambleav);
+ PL_preambleav = NULL;
}
- if (minus_n || minus_p) {
- sv_catpv(linestr, "LINE: while (<>) {");
- if (minus_l)
- sv_catpv(linestr,"chomp;");
- if (minus_a) {
+ if (PL_minus_n || PL_minus_p) {
+ sv_catpv(PL_linestr, "LINE: while (<>) {");
+ if (PL_minus_l)
+ sv_catpv(PL_linestr,"chomp;");
+ if (PL_minus_a) {
GV* gv = gv_fetchpv("::F", TRUE, SVt_PVAV);
if (gv)
GvIMPORTED_AV_on(gv);
- if (minus_F) {
- if (strchr("/'\"", *splitstr)
- && strchr(splitstr + 1, *splitstr))
- sv_catpvf(linestr, "@F=split(%s);", splitstr);
+ if (PL_minus_F) {
+ if (strchr("/'\"", *PL_splitstr)
+ && strchr(PL_splitstr + 1, *PL_splitstr))
+ sv_catpvf(PL_linestr, "@F=split(%s);", PL_splitstr);
else {
char delim;
s = "'~#\200\1'"; /* surely one char is unused...*/
- while (s[1] && strchr(splitstr, *s)) s++;
+ while (s[1] && strchr(PL_splitstr, *s)) s++;
delim = *s;
- sv_catpvf(linestr, "@F=split(%s%c",
+ sv_catpvf(PL_linestr, "@F=split(%s%c",
"q" + (delim == '\''), delim);
- for (s = splitstr; *s; s++) {
+ for (s = PL_splitstr; *s; s++) {
if (*s == '\\')
- sv_catpvn(linestr, "\\", 1);
- sv_catpvn(linestr, s, 1);
+ sv_catpvn(PL_linestr, "\\", 1);
+ sv_catpvn(PL_linestr, s, 1);
}
- sv_catpvf(linestr, "%c);", delim);
+ sv_catpvf(PL_linestr, "%c);", delim);
}
}
else
- sv_catpv(linestr,"@F=split(' ');");
+ sv_catpv(PL_linestr,"@F=split(' ');");
}
}
- sv_catpv(linestr, "\n");
- oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
- bufend = SvPVX(linestr) + SvCUR(linestr);
- if (PERLDB_LINE && curstash != debstash) {
+ sv_catpv(PL_linestr, "\n");
+ PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
+ PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+ if (PERLDB_LINE && PL_curstash != PL_debstash) {
SV *sv = NEWSV(85,0);
sv_upgrade(sv, SVt_PVMG);
- sv_setsv(sv,linestr);
- av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv);
+ sv_setsv(sv,PL_linestr);
+ av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
}
goto retry;
}
do {
- if ((s = filter_gets(linestr, rsfp, 0)) == Nullch) {
+ if ((s = filter_gets(PL_linestr, PL_rsfp, 0)) == Nullch) {
fake_eof:
- if (rsfp) {
- if (preprocess && !in_eval)
- (void)my_pclose(rsfp);
- else if ((PerlIO *)rsfp == PerlIO_stdin())
- PerlIO_clearerr(rsfp);
+ if (PL_rsfp) {
+ if (PL_preprocess && !PL_in_eval)
+ (void)PerlProc_pclose(PL_rsfp);
+ else if ((PerlIO *)PL_rsfp == PerlIO_stdin())
+ PerlIO_clearerr(PL_rsfp);
else
- (void)PerlIO_close(rsfp);
- if (e_fp == rsfp)
- e_fp = Nullfp;
- rsfp = Nullfp;
+ (void)PerlIO_close(PL_rsfp);
+ PL_rsfp = Nullfp;
+ PL_doextract = FALSE;
}
- if (!in_eval && (minus_n || minus_p)) {
- sv_setpv(linestr,minus_p ? ";}continue{print" : "");
- sv_catpv(linestr,";}");
- oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
- bufend = SvPVX(linestr) + SvCUR(linestr);
- minus_n = minus_p = 0;
+ if (!PL_in_eval && (PL_minus_n || PL_minus_p)) {
+ sv_setpv(PL_linestr,PL_minus_p ? ";}continue{print" : "");
+ sv_catpv(PL_linestr,";}");
+ PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
+ PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+ PL_minus_n = PL_minus_p = 0;
goto retry;
}
- oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
- sv_setpv(linestr,"");
+ PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
+ sv_setpv(PL_linestr,"");
TOKEN(';'); /* not infinite loop because rsfp is NULL now */
}
- if (doextract) {
+ if (PL_doextract) {
if (*s == '#' && s[1] == '!' && instr(s,"perl"))
- doextract = FALSE;
+ PL_doextract = FALSE;
/* Incest with pod. */
if (*s == '=' && strnEQ(s, "=cut", 4)) {
- sv_setpv(linestr, "");
- oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
- bufend = SvPVX(linestr) + SvCUR(linestr);
- doextract = FALSE;
+ sv_setpv(PL_linestr, "");
+ PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
+ PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+ PL_doextract = FALSE;
}
}
incline(s);
- } while (doextract);
- oldoldbufptr = oldbufptr = bufptr = linestart = s;
- if (PERLDB_LINE && curstash != debstash) {
+ } while (PL_doextract);
+ PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
+ if (PERLDB_LINE && PL_curstash != PL_debstash) {
SV *sv = NEWSV(85,0);
sv_upgrade(sv, SVt_PVMG);
- sv_setsv(sv,linestr);
- av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv);
+ sv_setsv(sv,PL_linestr);
+ av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
}
- bufend = SvPVX(linestr) + SvCUR(linestr);
- if (curcop->cop_line == 1) {
- while (s < bufend && isSPACE(*s))
+ PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+ if (PL_curcop->cop_line == 1) {
+ while (s < PL_bufend && isSPACE(*s))
s++;
if (*s == ':' && s[1] != ':') /* for csh execing sh scripts */
s++;
d = Nullch;
- if (!in_eval) {
+ if (!PL_in_eval) {
if (*s == '#' && *(s+1) == '!')
d = s + 2;
#ifdef ALTERNATE_SHEBANG
@@ -1626,7 +1930,7 @@ yylex()
*/
SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV));
assert(SvPOK(x) || SvGMAGICAL(x));
- if (sv_eq(x, GvSV(curcop->cop_filegv))) {
+ if (sv_eq(x, GvSV(PL_curcop->cop_filegv))) {
sv_setpvn(x, ipath, ipathend - ipath);
SvSETMAGIC(x);
}
@@ -1663,34 +1967,34 @@ yylex()
if (!d &&
*s == '#' &&
ipathend > ipath &&
- !minus_c &&
+ !PL_minus_c &&
!instr(s,"indir") &&
- instr(origargv[0],"perl"))
+ instr(PL_origargv[0],"perl"))
{
char **newargv;
*ipathend = '\0';
s = ipathend + 1;
- while (s < bufend && isSPACE(*s))
+ while (s < PL_bufend && isSPACE(*s))
s++;
- if (s < bufend) {
- Newz(899,newargv,origargc+3,char*);
+ if (s < PL_bufend) {
+ Newz(899,newargv,PL_origargc+3,char*);
newargv[1] = s;
- while (s < bufend && !isSPACE(*s))
+ while (s < PL_bufend && !isSPACE(*s))
s++;
*s = '\0';
- Copy(origargv+1, newargv+2, origargc+1, char*);
+ Copy(PL_origargv+1, newargv+2, PL_origargc+1, char*);
}
else
- newargv = origargv;
+ newargv = PL_origargv;
newargv[0] = ipath;
- execv(ipath, newargv);
+ PerlProc_execv(ipath, newargv);
croak("Can't exec %s", ipath);
}
if (d) {
- U32 oldpdb = perldb;
- bool oldn = minus_n;
- bool oldp = minus_p;
+ U32 oldpdb = PL_perldb;
+ bool oldn = PL_minus_n;
+ bool oldp = PL_minus_p;
while (*d && !isSPACE(*d)) d++;
while (*d == ' ' || *d == '\t') d++;
@@ -1706,73 +2010,72 @@ yylex()
d = moreswitches(d);
} while (d);
if (PERLDB_LINE && !oldpdb ||
- ( minus_n || minus_p ) && !(oldn || oldp) )
+ ( PL_minus_n || PL_minus_p ) && !(oldn || oldp) )
/* if we have already added "LINE: while (<>) {",
we must not do it again */
{
- sv_setpv(linestr, "");
- oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
- bufend = SvPVX(linestr) + SvCUR(linestr);
- preambled = FALSE;
+ sv_setpv(PL_linestr, "");
+ PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
+ PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+ PL_preambled = FALSE;
if (PERLDB_LINE)
- (void)gv_fetchfile(origfilename);
+ (void)gv_fetchfile(PL_origfilename);
goto retry;
}
}
}
}
}
- if (lex_formbrack && lex_brackets <= lex_formbrack) {
- bufptr = s;
- lex_state = LEX_FORMLINE;
+ if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
+ PL_bufptr = s;
+ PL_lex_state = LEX_FORMLINE;
return yylex();
}
goto retry;
case '\r':
+#ifdef PERL_STRICT_CR
warn("Illegal character \\%03o (carriage return)", '\r');
croak(
"(Maybe you didn't strip carriage returns after a network transfer?)\n");
+#endif
case ' ': case '\t': case '\f': case 013:
s++;
goto retry;
case '#':
case '\n':
- if (lex_state != LEX_NORMAL || (in_eval && !rsfp)) {
- d = bufend;
+ if (PL_lex_state != LEX_NORMAL || (PL_in_eval && !PL_rsfp)) {
+ d = PL_bufend;
while (s < d && *s != '\n')
s++;
if (s < d)
s++;
incline(s);
- if (lex_formbrack && lex_brackets <= lex_formbrack) {
- bufptr = s;
- lex_state = LEX_FORMLINE;
+ if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
+ PL_bufptr = s;
+ PL_lex_state = LEX_FORMLINE;
return yylex();
}
}
else {
*s = '\0';
- bufend = s;
+ PL_bufend = s;
}
goto retry;
case '-':
if (s[1] && isALPHA(s[1]) && !isALNUM(s[2])) {
s++;
- bufptr = s;
+ PL_bufptr = s;
tmp = *s++;
- while (s < bufend && (*s == ' ' || *s == '\t'))
+ while (s < PL_bufend && (*s == ' ' || *s == '\t'))
s++;
if (strnEQ(s,"=>",2)) {
- if (dowarn)
- warn("Ambiguous use of -%c => resolved to \"-%c\" =>",
- (int)tmp, (int)tmp);
- s = force_word(bufptr,WORD,FALSE,FALSE,FALSE);
+ s = force_word(PL_bufptr,WORD,FALSE,FALSE,FALSE);
OPERATOR('-'); /* unary minus */
}
- last_uni = oldbufptr;
- last_lop_op = OP_FTEREAD; /* good enough */
+ PL_last_uni = PL_oldbufptr;
+ PL_last_lop_op = OP_FTEREAD; /* good enough */
switch (tmp) {
case 'r': FTST(OP_FTEREAD);
case 'w': FTST(OP_FTEWRITE);
@@ -1809,7 +2112,7 @@ yylex()
tmp = *s++;
if (*s == tmp) {
s++;
- if (expect == XOPERATOR)
+ if (PL_expect == XOPERATOR)
TERM(POSTDEC);
else
OPERATOR(PREDEC);
@@ -1826,10 +2129,10 @@ yylex()
else
TERM(ARROW);
}
- if (expect == XOPERATOR)
+ if (PL_expect == XOPERATOR)
Aop(OP_SUBTRACT);
else {
- if (isSPACE(*s) || !isSPACE(*bufptr))
+ if (isSPACE(*s) || !isSPACE(*PL_bufptr))
check_uni();
OPERATOR('-'); /* unary minus */
}
@@ -1838,25 +2141,25 @@ yylex()
tmp = *s++;
if (*s == tmp) {
s++;
- if (expect == XOPERATOR)
+ if (PL_expect == XOPERATOR)
TERM(POSTINC);
else
OPERATOR(PREINC);
}
- if (expect == XOPERATOR)
+ if (PL_expect == XOPERATOR)
Aop(OP_ADD);
else {
- if (isSPACE(*s) || !isSPACE(*bufptr))
+ if (isSPACE(*s) || !isSPACE(*PL_bufptr))
check_uni();
OPERATOR('+');
}
case '*':
- if (expect != XOPERATOR) {
- s = scan_ident(s, bufend, tokenbuf, sizeof tokenbuf, TRUE);
- expect = XOPERATOR;
- force_ident(tokenbuf, '*');
- if (!*tokenbuf)
+ if (PL_expect != XOPERATOR) {
+ s = scan_ident(s, PL_bufend, PL_tokenbuf, sizeof PL_tokenbuf, TRUE);
+ PL_expect = XOPERATOR;
+ force_ident(PL_tokenbuf, '*');
+ if (!*PL_tokenbuf)
PREREF('*');
TERM('*');
}
@@ -1868,25 +2171,25 @@ yylex()
Mop(OP_MULTIPLY);
case '%':
- if (expect == XOPERATOR) {
+ if (PL_expect == XOPERATOR) {
++s;
Mop(OP_MODULO);
}
- tokenbuf[0] = '%';
- s = scan_ident(s, bufend, tokenbuf + 1, sizeof tokenbuf - 1, TRUE);
- if (!tokenbuf[1]) {
- if (s == bufend)
+ PL_tokenbuf[0] = '%';
+ s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, TRUE);
+ if (!PL_tokenbuf[1]) {
+ if (s == PL_bufend)
yyerror("Final % should be \\% or %name");
PREREF('%');
}
- pending_ident = '%';
+ PL_pending_ident = '%';
TERM('%');
case '^':
s++;
BOop(OP_BIT_XOR);
case '[':
- lex_brackets++;
+ PL_lex_brackets++;
/* FALL THROUGH */
case '~':
case ',':
@@ -1901,14 +2204,14 @@ yylex()
OPERATOR(':');
case '(':
s++;
- if (last_lop == oldoldbufptr || last_uni == oldoldbufptr)
- oldbufptr = oldoldbufptr; /* allow print(STDOUT 123) */
+ if (PL_last_lop == PL_oldoldbufptr || PL_last_uni == PL_oldoldbufptr)
+ PL_oldbufptr = PL_oldoldbufptr; /* allow print(STDOUT 123) */
else
- expect = XTERM;
+ PL_expect = XTERM;
TOKEN('(');
case ';':
- if (curcop->cop_line < copline)
- copline = curcop->cop_line;
+ if (PL_curcop->cop_line < PL_copline)
+ PL_copline = PL_curcop->cop_line;
tmp = *s++;
OPERATOR(tmp);
case ')':
@@ -1919,62 +2222,56 @@ yylex()
TERM(tmp);
case ']':
s++;
- if (lex_brackets <= 0)
+ if (PL_lex_brackets <= 0)
yyerror("Unmatched right bracket");
else
- --lex_brackets;
- if (lex_state == LEX_INTERPNORMAL) {
- if (lex_brackets == 0) {
+ --PL_lex_brackets;
+ if (PL_lex_state == LEX_INTERPNORMAL) {
+ if (PL_lex_brackets == 0) {
if (*s != '[' && *s != '{' && (*s != '-' || s[1] != '>'))
- lex_state = LEX_INTERPEND;
+ PL_lex_state = LEX_INTERPEND;
}
}
TERM(']');
case '{':
leftbracket:
s++;
- if (lex_brackets > 100) {
- char* newlb = Renew(lex_brackstack, lex_brackets + 1, char);
- if (newlb != lex_brackstack) {
+ if (PL_lex_brackets > 100) {
+ char* newlb = Renew(PL_lex_brackstack, PL_lex_brackets + 1, char);
+ if (newlb != PL_lex_brackstack) {
SAVEFREEPV(newlb);
- lex_brackstack = newlb;
+ PL_lex_brackstack = newlb;
}
}
- switch (expect) {
+ switch (PL_expect) {
case XTERM:
- if (lex_formbrack) {
+ if (PL_lex_formbrack) {
s--;
PRETERMBLOCK(DO);
}
- if (oldoldbufptr == last_lop)
- lex_brackstack[lex_brackets++] = XTERM;
+ if (PL_oldoldbufptr == PL_last_lop)
+ PL_lex_brackstack[PL_lex_brackets++] = XTERM;
else
- lex_brackstack[lex_brackets++] = XOPERATOR;
+ PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
OPERATOR(HASHBRACK);
case XOPERATOR:
- while (s < bufend && (*s == ' ' || *s == '\t'))
+ while (s < PL_bufend && (*s == ' ' || *s == '\t'))
s++;
d = s;
- tokenbuf[0] = '\0';
- if (d < bufend && *d == '-') {
- tokenbuf[0] = '-';
+ PL_tokenbuf[0] = '\0';
+ if (d < PL_bufend && *d == '-') {
+ PL_tokenbuf[0] = '-';
d++;
- while (d < bufend && (*d == ' ' || *d == '\t'))
+ while (d < PL_bufend && (*d == ' ' || *d == '\t'))
d++;
}
- if (d < bufend && isIDFIRST(*d)) {
- d = scan_word(d, tokenbuf + 1, sizeof tokenbuf - 1,
+ if (d < PL_bufend && isIDFIRST(*d)) {
+ d = scan_word(d, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1,
FALSE, &len);
- while (d < bufend && (*d == ' ' || *d == '\t'))
+ while (d < PL_bufend && (*d == ' ' || *d == '\t'))
d++;
if (*d == '}') {
- char minus = (tokenbuf[0] == '-');
- if (dowarn &&
- (keyword(tokenbuf + 1, len) ||
- (minus && len == 1 && isALPHA(tokenbuf[1])) ||
- perl_get_cv(tokenbuf + 1, FALSE) ))
- warn("Ambiguous use of {%s} resolved to {\"%s\"}",
- tokenbuf + !minus, tokenbuf + !minus);
+ char minus = (PL_tokenbuf[0] == '-');
s = force_word(s + minus, WORD, FALSE, TRUE, FALSE);
if (minus)
force_next('-');
@@ -1982,19 +2279,19 @@ yylex()
}
/* FALL THROUGH */
case XBLOCK:
- lex_brackstack[lex_brackets++] = XSTATE;
- expect = XSTATE;
+ PL_lex_brackstack[PL_lex_brackets++] = XSTATE;
+ PL_expect = XSTATE;
break;
case XTERMBLOCK:
- lex_brackstack[lex_brackets++] = XOPERATOR;
- expect = XSTATE;
+ PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
+ PL_expect = XSTATE;
break;
default: {
char *t;
- if (oldoldbufptr == last_lop)
- lex_brackstack[lex_brackets++] = XTERM;
+ if (PL_oldoldbufptr == PL_last_lop)
+ PL_lex_brackstack[PL_lex_brackets++] = XTERM;
else
- lex_brackstack[lex_brackets++] = XOPERATOR;
+ PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
s = skipspace(s);
if (*s == '}')
OPERATOR(HASHBRACK);
@@ -2016,21 +2313,21 @@ yylex()
t = s;
if (*s == '\'' || *s == '"' || *s == '`') {
/* common case: get past first string, handling escapes */
- for (t++; t < bufend && *t != *s;)
+ for (t++; t < PL_bufend && *t != *s;)
if (*t++ == '\\' && (*t == '\\' || *t == *s))
t++;
t++;
}
else if (*s == 'q') {
- if (++t < bufend
+ if (++t < PL_bufend
&& (!isALNUM(*t)
- || ((*t == 'q' || *t == 'x') && ++t < bufend
+ || ((*t == 'q' || *t == 'x') && ++t < PL_bufend
&& !isALNUM(*t)))) {
char *tmps;
char open, close, term;
I32 brackets = 1;
- while (t < bufend && isSPACE(*t))
+ while (t < PL_bufend && isSPACE(*t))
t++;
term = *t;
open = term;
@@ -2038,15 +2335,15 @@ yylex()
term = tmps[5];
close = term;
if (open == close)
- for (t++; t < bufend; t++) {
- if (*t == '\\' && t+1 < bufend && open != '\\')
+ for (t++; t < PL_bufend; t++) {
+ if (*t == '\\' && t+1 < PL_bufend && open != '\\')
t++;
else if (*t == open)
break;
}
else
- for (t++; t < bufend; t++) {
- if (*t == '\\' && t+1 < bufend)
+ for (t++; t < PL_bufend; t++) {
+ if (*t == '\\' && t+1 < PL_bufend)
t++;
else if (*t == close && --brackets <= 0)
break;
@@ -2057,53 +2354,53 @@ yylex()
t++;
}
else if (isALPHA(*s)) {
- for (t++; t < bufend && isALNUM(*t); t++) ;
+ for (t++; t < PL_bufend && isALNUM(*t); t++) ;
}
- while (t < bufend && isSPACE(*t))
+ while (t < PL_bufend && isSPACE(*t))
t++;
/* if comma follows first term, call it an anon hash */
/* XXX it could be a comma expression with loop modifiers */
- if (t < bufend && ((*t == ',' && (*s == 'q' || !isLOWER(*s)))
+ if (t < PL_bufend && ((*t == ',' && (*s == 'q' || !isLOWER(*s)))
|| (*t == '=' && t[1] == '>')))
OPERATOR(HASHBRACK);
- if (expect == XREF)
- expect = XTERM;
+ if (PL_expect == XREF)
+ PL_expect = XTERM;
else {
- lex_brackstack[lex_brackets-1] = XSTATE;
- expect = XSTATE;
+ PL_lex_brackstack[PL_lex_brackets-1] = XSTATE;
+ PL_expect = XSTATE;
}
}
break;
}
- yylval.ival = curcop->cop_line;
+ yylval.ival = PL_curcop->cop_line;
if (isSPACE(*s) || *s == '#')
- copline = NOLINE; /* invalidate current command line number */
+ PL_copline = NOLINE; /* invalidate current command line number */
TOKEN('{');
case '}':
rightbracket:
s++;
- if (lex_brackets <= 0)
+ if (PL_lex_brackets <= 0)
yyerror("Unmatched right bracket");
else
- expect = (expectation)lex_brackstack[--lex_brackets];
- if (lex_brackets < lex_formbrack)
- lex_formbrack = 0;
- if (lex_state == LEX_INTERPNORMAL) {
- if (lex_brackets == 0) {
- if (lex_fakebrack) {
- lex_state = LEX_INTERPEND;
- bufptr = s;
+ PL_expect = (expectation)PL_lex_brackstack[--PL_lex_brackets];
+ if (PL_lex_brackets < PL_lex_formbrack)
+ PL_lex_formbrack = 0;
+ if (PL_lex_state == LEX_INTERPNORMAL) {
+ if (PL_lex_brackets == 0) {
+ if (PL_lex_fakebrack) {
+ PL_lex_state = LEX_INTERPEND;
+ PL_bufptr = s;
return yylex(); /* ignore fake brackets */
}
if (*s == '-' && s[1] == '>')
- lex_state = LEX_INTERPENDMAYBE;
+ PL_lex_state = LEX_INTERPENDMAYBE;
else if (*s != '[' && *s != '{')
- lex_state = LEX_INTERPEND;
+ PL_lex_state = LEX_INTERPEND;
}
}
- if (lex_brackets < lex_fakebrack) {
- bufptr = s;
- lex_fakebrack = 0;
+ if (PL_lex_brackets < PL_lex_fakebrack) {
+ PL_bufptr = s;
+ PL_lex_fakebrack = 0;
return yylex(); /* ignore fake brackets */
}
force_next('}');
@@ -2114,19 +2411,19 @@ yylex()
if (tmp == '&')
AOPERATOR(ANDAND);
s--;
- if (expect == XOPERATOR) {
- if (dowarn && isALPHA(*s) && bufptr == linestart) {
- curcop->cop_line--;
+ if (PL_expect == XOPERATOR) {
+ if (PL_dowarn && isALPHA(*s) && PL_bufptr == PL_linestart) {
+ PL_curcop->cop_line--;
warn(warn_nosemi);
- curcop->cop_line++;
+ PL_curcop->cop_line++;
}
BAop(OP_BIT_AND);
}
- s = scan_ident(s - 1, bufend, tokenbuf, sizeof tokenbuf, TRUE);
- if (*tokenbuf) {
- expect = XOPERATOR;
- force_ident(tokenbuf, '&');
+ s = scan_ident(s - 1, PL_bufend, PL_tokenbuf, sizeof PL_tokenbuf, TRUE);
+ if (*PL_tokenbuf) {
+ PL_expect = XOPERATOR;
+ force_ident(PL_tokenbuf, '&');
}
else
PREREF('&');
@@ -2149,14 +2446,14 @@ yylex()
OPERATOR(',');
if (tmp == '~')
PMop(OP_MATCH);
- if (dowarn && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp))
+ if (PL_dowarn && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp))
warn("Reversed %c= operator",(int)tmp);
s--;
- if (expect == XSTATE && isALPHA(tmp) &&
- (s == linestart+1 || s[-2] == '\n') )
+ if (PL_expect == XSTATE && isALPHA(tmp) &&
+ (s == PL_linestart+1 || s[-2] == '\n') )
{
- if (in_eval && !rsfp) {
- d = bufend;
+ if (PL_in_eval && !PL_rsfp) {
+ d = PL_bufend;
while (s < d) {
if (*s++ == '\n') {
incline(s);
@@ -2173,16 +2470,20 @@ yylex()
}
goto retry;
}
- s = bufend;
- doextract = TRUE;
+ s = PL_bufend;
+ PL_doextract = TRUE;
goto retry;
}
- if (lex_brackets < lex_formbrack) {
+ if (PL_lex_brackets < PL_lex_formbrack) {
char *t;
+#ifdef PERL_STRICT_CR
for (t = s; *t == ' ' || *t == '\t'; t++) ;
+#else
+ for (t = s; *t == ' ' || *t == '\t' || *t == '\r'; t++) ;
+#endif
if (*t == '\n' || *t == '#') {
s--;
- expect = XBLOCK;
+ PL_expect = XBLOCK;
goto leftbracket;
}
}
@@ -2198,7 +2499,7 @@ yylex()
s--;
OPERATOR('!');
case '<':
- if (expect != XOPERATOR) {
+ if (PL_expect != XOPERATOR) {
if (s[1] != '<' && !strchr(s,'>'))
check_uni();
if (s[1] == '<')
@@ -2233,94 +2534,95 @@ yylex()
case '$':
CLINE;
- if (expect == XOPERATOR) {
- if (lex_formbrack && lex_brackets == lex_formbrack) {
- expect = XTERM;
+ if (PL_expect == XOPERATOR) {
+ if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
+ PL_expect = XTERM;
depcom();
return ','; /* grandfather non-comma-format format */
}
}
if (s[1] == '#' && (isALPHA(s[2]) || strchr("_{$:", s[2]))) {
- if (expect == XOPERATOR)
- no_op("Array length", bufptr);
- tokenbuf[0] = '@';
- s = scan_ident(s + 1, bufend, tokenbuf + 1, sizeof tokenbuf - 1,
+ if (PL_expect == XOPERATOR)
+ no_op("Array length", PL_bufptr);
+ PL_tokenbuf[0] = '@';
+ s = scan_ident(s + 1, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1,
FALSE);
- if (!tokenbuf[1])
+ if (!PL_tokenbuf[1])
PREREF(DOLSHARP);
- expect = XOPERATOR;
- pending_ident = '#';
+ PL_expect = XOPERATOR;
+ PL_pending_ident = '#';
TOKEN(DOLSHARP);
}
- if (expect == XOPERATOR)
- no_op("Scalar", bufptr);
- tokenbuf[0] = '$';
- s = scan_ident(s, bufend, tokenbuf + 1, sizeof tokenbuf - 1, FALSE);
- if (!tokenbuf[1]) {
- if (s == bufend)
+ if (PL_expect == XOPERATOR)
+ no_op("Scalar", PL_bufptr);
+ PL_tokenbuf[0] = '$';
+ s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE);
+ if (!PL_tokenbuf[1]) {
+ if (s == PL_bufend)
yyerror("Final $ should be \\$ or $name");
PREREF('$');
}
/* This kludge not intended to be bulletproof. */
- if (tokenbuf[1] == '[' && !tokenbuf[2]) {
+ if (PL_tokenbuf[1] == '[' && !PL_tokenbuf[2]) {
yylval.opval = newSVOP(OP_CONST, 0,
- newSViv((IV)compiling.cop_arybase));
+ newSViv((IV)PL_compiling.cop_arybase));
yylval.opval->op_private = OPpCONST_ARYBASE;
TERM(THING);
}
d = s;
- if (lex_state == LEX_NORMAL)
+ if (PL_lex_state == LEX_NORMAL)
s = skipspace(s);
- if ((expect != XREF || oldoldbufptr == last_lop) && intuit_more(s)) {
+ if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
char *t;
if (*s == '[') {
- tokenbuf[0] = '@';
- if (dowarn) {
+ PL_tokenbuf[0] = '@';
+ if (PL_dowarn) {
for(t = s + 1;
isSPACE(*t) || isALNUM(*t) || *t == '$';
t++) ;
if (*t++ == ',') {
- bufptr = skipspace(bufptr);
- while (t < bufend && *t != ']')
+ PL_bufptr = skipspace(PL_bufptr);
+ while (t < PL_bufend && *t != ']')
t++;
warn("Multidimensional syntax %.*s not supported",
- (t - bufptr) + 1, bufptr);
+ (t - PL_bufptr) + 1, PL_bufptr);
}
}
}
else if (*s == '{') {
- tokenbuf[0] = '%';
- if (dowarn && strEQ(tokenbuf+1, "SIG") &&
+ PL_tokenbuf[0] = '%';
+ if (PL_dowarn && strEQ(PL_tokenbuf+1, "SIG") &&
(t = strchr(s, '}')) && (t = strchr(t, '=')))
{
- char tmpbuf[sizeof tokenbuf];
+ char tmpbuf[sizeof PL_tokenbuf];
STRLEN len;
for (t++; isSPACE(*t); t++) ;
if (isIDFIRST(*t)) {
t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len);
- if (*t != '(' && perl_get_cv(tmpbuf, FALSE))
+ for (; isSPACE(*t); t++) ;
+ if (*t == ';' && perl_get_cv(tmpbuf, FALSE))
warn("You need to quote \"%s\"", tmpbuf);
}
}
}
}
- expect = XOPERATOR;
- if (lex_state == LEX_NORMAL && isSPACE(*d)) {
- bool islop = (last_lop == oldoldbufptr);
- if (!islop || last_lop_op == OP_GREPSTART)
- expect = XOPERATOR;
+ PL_expect = XOPERATOR;
+ if (PL_lex_state == LEX_NORMAL && isSPACE(*d)) {
+ bool islop = (PL_last_lop == PL_oldoldbufptr);
+ if (!islop || PL_last_lop_op == OP_GREPSTART)
+ PL_expect = XOPERATOR;
else if (strchr("$@\"'`q", *s))
- expect = XTERM; /* e.g. print $fh "foo" */
+ PL_expect = XTERM; /* e.g. print $fh "foo" */
else if (strchr("&*<%", *s) && isIDFIRST(s[1]))
- expect = XTERM; /* e.g. print $fh &sub */
+ PL_expect = XTERM; /* e.g. print $fh &sub */
else if (isIDFIRST(*s)) {
- char tmpbuf[sizeof tokenbuf];
+ char tmpbuf[sizeof PL_tokenbuf];
scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
if (tmp = keyword(tmpbuf, len)) {
/* binary operators exclude handle interpretations */
@@ -2335,67 +2637,71 @@ yylex()
case -KEY_cmp:
break;
default:
- expect = XTERM; /* e.g. print $fh length() */
+ PL_expect = XTERM; /* e.g. print $fh length() */
break;
}
}
else {
GV *gv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV);
if (gv && GvCVu(gv))
- expect = XTERM; /* e.g. print $fh subr() */
+ PL_expect = XTERM; /* e.g. print $fh subr() */
}
}
else if (isDIGIT(*s))
- expect = XTERM; /* e.g. print $fh 3 */
+ PL_expect = XTERM; /* e.g. print $fh 3 */
else if (*s == '.' && isDIGIT(s[1]))
- expect = XTERM; /* e.g. print $fh .3 */
- else if (strchr("/?-+", *s) && !isSPACE(s[1]))
- expect = XTERM; /* e.g. print $fh -1 */
- else if (*s == '<' && s[1] == '<' && !isSPACE(s[2]))
- expect = XTERM; /* print $fh <<"EOF" */
+ PL_expect = XTERM; /* e.g. print $fh .3 */
+ else if (strchr("/?-+", *s) && !isSPACE(s[1]) && s[1] != '=')
+ PL_expect = XTERM; /* e.g. print $fh -1 */
+ else if (*s == '<' && s[1] == '<' && !isSPACE(s[2]) && s[2] != '=')
+ PL_expect = XTERM; /* print $fh <<"EOF" */
}
- pending_ident = '$';
+ PL_pending_ident = '$';
TOKEN('$');
case '@':
- if (expect == XOPERATOR)
+ if (PL_expect == XOPERATOR)
no_op("Array", s);
- tokenbuf[0] = '@';
- s = scan_ident(s, bufend, tokenbuf + 1, sizeof tokenbuf - 1, FALSE);
- if (!tokenbuf[1]) {
- if (s == bufend)
+ PL_tokenbuf[0] = '@';
+ s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE);
+ if (!PL_tokenbuf[1]) {
+ if (s == PL_bufend)
yyerror("Final @ should be \\@ or @name");
PREREF('@');
}
- if (lex_state == LEX_NORMAL)
+ if (PL_lex_state == LEX_NORMAL)
s = skipspace(s);
- if ((expect != XREF || oldoldbufptr == last_lop) && intuit_more(s)) {
+ if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
if (*s == '{')
- tokenbuf[0] = '%';
+ PL_tokenbuf[0] = '%';
/* Warn about @ where they meant $. */
- if (dowarn) {
+ if (PL_dowarn) {
if (*s == '[' || *s == '{') {
char *t = s + 1;
while (*t && (isALNUM(*t) || strchr(" \t$#+-'\"", *t)))
t++;
if (*t == '}' || *t == ']') {
t++;
- bufptr = skipspace(bufptr);
+ PL_bufptr = skipspace(PL_bufptr);
warn("Scalar value %.*s better written as $%.*s",
- t-bufptr, bufptr, t-bufptr-1, bufptr+1);
+ t-PL_bufptr, PL_bufptr, t-PL_bufptr-1, PL_bufptr+1);
}
}
}
}
- pending_ident = '@';
+ PL_pending_ident = '@';
TERM('@');
case '/': /* may either be division or pattern */
case '?': /* may either be conditional or pattern */
- if (expect != XOPERATOR) {
- check_uni();
- s = scan_pat(s);
+ if (PL_expect != XOPERATOR) {
+ /* Disable warning on "study /blah/" */
+ if (PL_oldoldbufptr == PL_last_uni
+ && (*PL_last_uni != 's' || s - PL_last_uni < 5
+ || memNE(PL_last_uni, "study", 5) || isALNUM(PL_last_uni[5])))
+ check_uni();
+ s = scan_pat(s,OP_MATCH);
TERM(sublex_start());
}
tmp = *s++;
@@ -2404,13 +2710,19 @@ yylex()
OPERATOR(tmp);
case '.':
- if (lex_formbrack && lex_brackets == lex_formbrack && s[1] == '\n' &&
- (s == linestart || s[-1] == '\n') ) {
- lex_formbrack = 0;
- expect = XSTATE;
+ if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack
+#ifdef PERL_STRICT_CR
+ && s[1] == '\n'
+#else
+ && (s[1] == '\n' || (s[1] == '\r' && s[2] == '\n'))
+#endif
+ && (s == PL_linestart || s[-1] == '\n') )
+ {
+ PL_lex_formbrack = 0;
+ PL_expect = XSTATE;
goto rightbracket;
}
- if (expect == XOPERATOR || !isDIGIT(s[1])) {
+ if (PL_expect == XOPERATOR || !isDIGIT(s[1])) {
tmp = *s++;
if (*s == tmp) {
s++;
@@ -2422,7 +2734,7 @@ yylex()
yylval.ival = 0;
OPERATOR(DOTDOT);
}
- if (expect != XOPERATOR)
+ if (PL_expect != XOPERATOR)
check_uni();
Aop(OP_CONCAT);
}
@@ -2430,15 +2742,15 @@ yylex()
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
s = scan_num(s);
- if (expect == XOPERATOR)
+ if (PL_expect == XOPERATOR)
no_op("Number",s);
TERM(THING);
case '\'':
s = scan_str(s);
- if (expect == XOPERATOR) {
- if (lex_formbrack && lex_brackets == lex_formbrack) {
- expect = XTERM;
+ if (PL_expect == XOPERATOR) {
+ if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
+ PL_expect = XTERM;
depcom();
return ','; /* grandfather non-comma-format format */
}
@@ -2452,9 +2764,9 @@ yylex()
case '"':
s = scan_str(s);
- if (expect == XOPERATOR) {
- if (lex_formbrack && lex_brackets == lex_formbrack) {
- expect = XTERM;
+ if (PL_expect == XOPERATOR) {
+ if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
+ PL_expect = XTERM;
depcom();
return ','; /* grandfather non-comma-format format */
}
@@ -2464,7 +2776,7 @@ yylex()
if (!s)
missingterm((char*)0);
yylval.ival = OP_CONST;
- for (d = SvPV(lex_stuff, len); len; len--, d++) {
+ for (d = SvPV(PL_lex_stuff, len); len; len--, d++) {
if (*d == '$' || *d == '@' || *d == '\\') {
yylval.ival = OP_STRINGIFY;
break;
@@ -2474,7 +2786,7 @@ yylex()
case '`':
s = scan_str(s);
- if (expect == XOPERATOR)
+ if (PL_expect == XOPERATOR)
no_op("Backticks",s);
if (!s)
missingterm((char*)0);
@@ -2484,14 +2796,14 @@ yylex()
case '\\':
s++;
- if (dowarn && lex_inwhat && isDIGIT(*s))
+ if (PL_dowarn && PL_lex_inwhat && isDIGIT(*s))
warn("Can't use \\%c to mean $%c in expression", *s, *s);
- if (expect == XOPERATOR)
+ if (PL_expect == XOPERATOR)
no_op("Backslash",s);
OPERATOR(REFGEN);
case 'x':
- if (isDIGIT(s[1]) && expect == XOPERATOR) {
+ if (isDIGIT(s[1]) && PL_expect == XOPERATOR) {
s++;
Mop(OP_REPEAT);
}
@@ -2525,58 +2837,87 @@ yylex()
case 'y': case 'Y':
case 'z': case 'Z':
- keylookup:
- bufptr = s;
- s = scan_word(s, tokenbuf, sizeof tokenbuf, FALSE, &len);
+ keylookup: {
+ STRLEN n_a;
+ gv = Nullgv;
+ gvp = 0;
+
+ PL_bufptr = s;
+ s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
/* Some keywords can be followed by any delimiter, including ':' */
- tmp = (len == 1 && strchr("msyq", tokenbuf[0]) ||
- len == 2 && ((tokenbuf[0] == 't' && tokenbuf[1] == 'r') ||
- (tokenbuf[0] == 'q' &&
- strchr("qwx", tokenbuf[1]))));
+ tmp = (len == 1 && strchr("msyq", PL_tokenbuf[0]) ||
+ len == 2 && ((PL_tokenbuf[0] == 't' && PL_tokenbuf[1] == 'r') ||
+ (PL_tokenbuf[0] == 'q' &&
+ strchr("qwxr", PL_tokenbuf[1]))));
/* x::* is just a word, unless x is "CORE" */
- if (!tmp && *s == ':' && s[1] == ':' && strNE(tokenbuf, "CORE"))
+ if (!tmp && *s == ':' && s[1] == ':' && strNE(PL_tokenbuf, "CORE"))
goto just_a_word;
d = s;
- while (d < bufend && isSPACE(*d))
+ while (d < PL_bufend && isSPACE(*d))
d++; /* no comments skipped here, or s### is misparsed */
/* Is this a label? */
- if (!tmp && expect == XSTATE
- && d < bufend && *d == ':' && *(d + 1) != ':') {
+ if (!tmp && PL_expect == XSTATE
+ && d < PL_bufend && *d == ':' && *(d + 1) != ':') {
s = d + 1;
- yylval.pval = savepv(tokenbuf);
+ yylval.pval = savepv(PL_tokenbuf);
CLINE;
TOKEN(LABEL);
}
/* Check for keywords */
- tmp = keyword(tokenbuf, len);
+ tmp = keyword(PL_tokenbuf, len);
/* Is this a word before a => operator? */
if (strnEQ(d,"=>",2)) {
CLINE;
- if (dowarn && (tmp || perl_get_cv(tokenbuf, FALSE)))
- warn("Ambiguous use of %s => resolved to \"%s\" =>",
- tokenbuf, tokenbuf);
- yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
+ yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf,0));
yylval.opval->op_private = OPpCONST_BARE;
TERM(WORD);
}
if (tmp < 0) { /* second-class keyword? */
- GV* gv;
- if (expect != XOPERATOR &&
- (*s != ':' || s[1] != ':') &&
- (gv = gv_fetchpv(tokenbuf, FALSE, SVt_PVCV)) &&
- GvIMPORTED_CV(gv))
+ GV *ogv = Nullgv; /* override (winner) */
+ GV *hgv = Nullgv; /* hidden (loser) */
+ if (PL_expect != XOPERATOR && (*s != ':' || s[1] != ':')) {
+ CV *cv;
+ if ((gv = gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVCV)) &&
+ (cv = GvCVu(gv)))
+ {
+ if (GvIMPORTED_CV(gv))
+ ogv = gv;
+ else if (! CvMETHOD(cv))
+ hgv = gv;
+ }
+ if (!ogv &&
+ (gvp = (GV**)hv_fetch(PL_globalstash,PL_tokenbuf,len,FALSE)) &&
+ (gv = *gvp) != (GV*)&PL_sv_undef &&
+ GvCVu(gv) && GvIMPORTED_CV(gv))
+ {
+ ogv = gv;
+ }
+ }
+ if (ogv) {
+ tmp = 0; /* overridden by import or by GLOBAL */
+ }
+ else if (gv && !gvp
+ && -tmp==KEY_lock /* XXX generalizable kludge */
+ && !hv_fetch(GvHVn(PL_incgv), "Thread.pm", 9, FALSE))
{
- tmp = 0;
+ tmp = 0; /* any sub overrides "weak" keyword */
}
- else
+ else { /* no override */
tmp = -tmp;
+ gv = Nullgv;
+ gvp = 0;
+ if (PL_dowarn && hgv
+ && tmp != KEY_x && tmp != KEY_CORE) /* never ambiguous */
+ warn("Ambiguous call resolved as CORE::%s(), %s",
+ GvENAME(hgv), "qualify as such or use &");
+ }
}
reserved_word:
@@ -2584,47 +2925,83 @@ yylex()
default: /* not a keyword */
just_a_word: {
- GV *gv;
SV *sv;
- char lastchar = (bufptr == oldoldbufptr ? 0 : bufptr[-1]);
+ char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]);
/* Get the rest if it looks like a package qualifier */
if (*s == '\'' || *s == ':' && s[1] == ':') {
- s = scan_word(s, tokenbuf + len, sizeof tokenbuf - len,
- TRUE, &len);
- if (!len)
- croak("Bad name after %s::", tokenbuf);
+ STRLEN morelen;
+ s = scan_word(s, PL_tokenbuf + len, sizeof PL_tokenbuf - len,
+ TRUE, &morelen);
+ if (!morelen)
+ croak("Bad name after %s%s", PL_tokenbuf,
+ *s == '\'' ? "'" : "::");
+ len += morelen;
}
- if (expect == XOPERATOR) {
- if (bufptr == linestart) {
- curcop->cop_line--;
+ if (PL_expect == XOPERATOR) {
+ if (PL_bufptr == PL_linestart) {
+ PL_curcop->cop_line--;
warn(warn_nosemi);
- curcop->cop_line++;
+ PL_curcop->cop_line++;
}
else
no_op("Bareword",s);
}
- /* Look for a subroutine with this name in current package. */
+ /* Look for a subroutine with this name in current package,
+ unless name is "Foo::", in which case Foo is a bearword
+ (and a package name). */
+
+ if (len > 2 &&
+ PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':')
+ {
+ if (PL_dowarn && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
+ warn("Bareword \"%s\" refers to nonexistent package",
+ PL_tokenbuf);
+ len -= 2;
+ PL_tokenbuf[len] = '\0';
+ gv = Nullgv;
+ gvp = 0;
+ }
+ else {
+ len = 0;
+ if (!gv)
+ gv = gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVCV);
+ }
+
+ /* if we saw a global override before, get the right name */
- gv = gv_fetchpv(tokenbuf,FALSE, SVt_PVCV);
+ if (gvp) {
+ sv = newSVpv("CORE::GLOBAL::",14);
+ sv_catpv(sv,PL_tokenbuf);
+ }
+ else
+ sv = newSVpv(PL_tokenbuf,0);
/* Presume this is going to be a bareword of some sort. */
CLINE;
- yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
+ yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
yylval.opval->op_private = OPpCONST_BARE;
+ /* And if "Foo::", then that's what it certainly is. */
+
+ if (len)
+ goto safe_bareword;
+
/* See if it's the indirect object for a list operator. */
- if (oldoldbufptr &&
- oldoldbufptr < bufptr &&
- (oldoldbufptr == last_lop || oldoldbufptr == last_uni) &&
+ if (PL_oldoldbufptr &&
+ PL_oldoldbufptr < PL_bufptr &&
+ (PL_oldoldbufptr == PL_last_lop || PL_oldoldbufptr == PL_last_uni) &&
/* NO SKIPSPACE BEFORE HERE! */
- (expect == XREF ||
- (opargs[last_lop_op] >> OASHIFT & 7) == OA_FILEREF) )
+ (PL_expect == XREF
+ || ((opargs[PL_last_lop_op] >> OASHIFT)& 7) == OA_FILEREF
+ || (PL_last_lop_op == OP_ENTERSUB
+ && PL_last_proto
+ && PL_last_proto[PL_last_proto[0] == ';' ? 1 : 0] == '*')) )
{
bool immediate_paren = *s == '(';
@@ -2639,39 +3016,43 @@ yylex()
/* If not a declared subroutine, it's an indirect object. */
/* (But it's an indir obj regardless for sort.) */
- if ((last_lop_op == OP_SORT ||
+ if ((PL_last_lop_op == OP_SORT ||
(!immediate_paren && (!gv || !GvCVu(gv))) ) &&
- (last_lop_op != OP_MAPSTART && last_lop_op != OP_GREPSTART)){
- expect = (last_lop == oldoldbufptr) ? XTERM : XOPERATOR;
+ (PL_last_lop_op != OP_MAPSTART && PL_last_lop_op != OP_GREPSTART)){
+ PL_expect = (PL_last_lop == PL_oldoldbufptr) ? XTERM : XOPERATOR;
goto bareword;
}
}
/* If followed by a paren, it's certainly a subroutine. */
- expect = XOPERATOR;
+ PL_expect = XOPERATOR;
s = skipspace(s);
if (*s == '(') {
CLINE;
if (gv && GvCVu(gv)) {
+ CV *cv;
+ if ((cv = GvCV(gv)) && SvPOK(cv))
+ PL_last_proto = SvPV((SV*)cv, n_a);
for (d = s + 1; *d == ' ' || *d == '\t'; d++) ;
- if (*d == ')' && (sv = cv_const_sv(GvCV(gv)))) {
+ if (*d == ')' && (sv = cv_const_sv(cv))) {
s = d + 1;
goto its_constant;
}
}
- nextval[nexttoke].opval = yylval.opval;
- expect = XOPERATOR;
+ PL_nextval[PL_nexttoke].opval = yylval.opval;
+ PL_expect = XOPERATOR;
force_next(WORD);
yylval.ival = 0;
+ PL_last_lop_op = OP_ENTERSUB;
TOKEN('&');
}
/* If followed by var or block, call it a method (unless sub) */
if ((*s == '$' || *s == '{') && (!gv || !GvCVu(gv))) {
- last_lop = oldbufptr;
- last_lop_op = OP_METHOD;
+ PL_last_lop = PL_oldbufptr;
+ PL_last_lop_op = OP_METHOD;
PREBLOCK(METHOD);
}
@@ -2686,9 +3067,9 @@ yylex()
CV* cv;
if (lastchar == '-')
warn("Ambiguous use of -%s resolved as -&%s()",
- tokenbuf, tokenbuf);
- last_lop = oldbufptr;
- last_lop_op = OP_ENTERSUB;
+ PL_tokenbuf, PL_tokenbuf);
+ PL_last_lop = PL_oldbufptr;
+ PL_last_lop_op = OP_ENTERSUB;
/* Check for a constant sub */
cv = GvCV(gv);
if ((sv = cv_const_sv(cv))) {
@@ -2702,52 +3083,59 @@ yylex()
/* Resolve to GV now. */
op_free(yylval.opval);
yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
+ PL_last_lop_op = OP_ENTERSUB;
/* Is there a prototype? */
if (SvPOK(cv)) {
STRLEN len;
- char *proto = SvPV((SV*)cv, len);
+ PL_last_proto = SvPV((SV*)cv, len);
if (!len)
TERM(FUNC0SUB);
- if (strEQ(proto, "$"))
+ if (strEQ(PL_last_proto, "$"))
OPERATOR(UNIOPSUB);
- if (*proto == '&' && *s == '{') {
- sv_setpv(subname,"__ANON__");
+ if (*PL_last_proto == '&' && *s == '{') {
+ sv_setpv(PL_subname,"__ANON__");
PREBLOCK(LSTOPSUB);
}
- }
- nextval[nexttoke].opval = yylval.opval;
- expect = XTERM;
+ } else
+ PL_last_proto = NULL;
+ PL_nextval[PL_nexttoke].opval = yylval.opval;
+ PL_expect = XTERM;
force_next(WORD);
TOKEN(NOAMP);
}
- if (hints & HINT_STRICT_SUBS &&
+ if (PL_hints & HINT_STRICT_SUBS &&
lastchar != '-' &&
strnNE(s,"->",2) &&
- last_lop_op != OP_TRUNCATE && /* S/F prototype in opcode.pl */
- last_lop_op != OP_ACCEPT &&
- last_lop_op != OP_PIPE_OP &&
- last_lop_op != OP_SOCKPAIR)
+ PL_last_lop_op != OP_TRUNCATE && /* S/F prototype in opcode.pl */
+ PL_last_lop_op != OP_ACCEPT &&
+ PL_last_lop_op != OP_PIPE_OP &&
+ PL_last_lop_op != OP_SOCKPAIR &&
+ !(PL_last_lop_op == OP_ENTERSUB
+ && PL_last_proto
+ && PL_last_proto[PL_last_proto[0] == ';' ? 1 : 0] == '*'))
{
warn(
"Bareword \"%s\" not allowed while \"strict subs\" in use",
- tokenbuf);
- ++error_count;
+ PL_tokenbuf);
+ ++PL_error_count;
}
/* Call it a bare word */
bareword:
- if (dowarn) {
+ if (PL_dowarn) {
if (lastchar != '-') {
- for (d = tokenbuf; *d && isLOWER(*d); d++) ;
+ for (d = PL_tokenbuf; *d && isLOWER(*d); d++) ;
if (!*d)
- warn(warn_reserved, tokenbuf);
+ warn(warn_reserved, PL_tokenbuf);
}
}
+
+ safe_bareword:
if (lastchar && strchr("*%&", lastchar)) {
warn("Operator or semicolon missing before %c%s",
- lastchar, tokenbuf);
+ lastchar, PL_tokenbuf);
warn("Ambiguous use of %c resolved as operator %c",
lastchar, lastchar);
}
@@ -2756,19 +3144,19 @@ yylex()
case KEY___FILE__:
yylval.opval = (OP*)newSVOP(OP_CONST, 0,
- newSVsv(GvSV(curcop->cop_filegv)));
+ newSVsv(GvSV(PL_curcop->cop_filegv)));
TERM(THING);
case KEY___LINE__:
yylval.opval = (OP*)newSVOP(OP_CONST, 0,
- newSVpvf("%ld", (long)curcop->cop_line));
+ newSVpvf("%ld", (long)PL_curcop->cop_line));
TERM(THING);
case KEY___PACKAGE__:
yylval.opval = (OP*)newSVOP(OP_CONST, 0,
- (curstash
- ? newSVsv(curstname)
- : &sv_undef));
+ (PL_curstash
+ ? newSVsv(PL_curstname)
+ : &PL_sv_undef));
TERM(THING);
case KEY___DATA__:
@@ -2776,30 +3164,30 @@ yylex()
GV *gv;
/*SUPPRESS 560*/
- if (rsfp && (!in_eval || tokenbuf[2] == 'D')) {
+ if (PL_rsfp && (!PL_in_eval || PL_tokenbuf[2] == 'D')) {
char *pname = "main";
- if (tokenbuf[2] == 'D')
- pname = HvNAME(curstash ? curstash : defstash);
+ if (PL_tokenbuf[2] == 'D')
+ pname = HvNAME(PL_curstash ? PL_curstash : PL_defstash);
gv = gv_fetchpv(form("%s::DATA", pname), TRUE, SVt_PVIO);
GvMULTI_on(gv);
if (!GvIO(gv))
GvIOp(gv) = newIO();
- IoIFP(GvIOp(gv)) = rsfp;
+ IoIFP(GvIOp(gv)) = PL_rsfp;
#if defined(HAS_FCNTL) && defined(F_SETFD)
{
- int fd = PerlIO_fileno(rsfp);
+ int fd = PerlIO_fileno(PL_rsfp);
fcntl(fd,F_SETFD,fd >= 3);
}
#endif
/* Mark this internal pseudo-handle as clean */
IoFLAGS(GvIOp(gv)) |= IOf_UNTAINT;
- if (preprocess)
+ if (PL_preprocess)
IoTYPE(GvIOp(gv)) = '|';
- else if ((PerlIO*)rsfp == PerlIO_stdin())
+ else if ((PerlIO*)PL_rsfp == PerlIO_stdin())
IoTYPE(GvIOp(gv)) = '-';
else
IoTYPE(GvIOp(gv)) = '<';
- rsfp = Nullfp;
+ PL_rsfp = Nullfp;
}
goto fake_eof;
}
@@ -2808,8 +3196,9 @@ yylex()
case KEY_DESTROY:
case KEY_BEGIN:
case KEY_END:
- if (expect == XSTATE) {
- s = bufptr;
+ case KEY_INIT:
+ if (PL_expect == XSTATE) {
+ s = PL_bufptr;
goto really_sub;
}
goto just_a_word;
@@ -2818,8 +3207,8 @@ yylex()
if (*s == ':' && s[1] == ':') {
s += 2;
d = s;
- s = scan_word(s, tokenbuf, sizeof tokenbuf, FALSE, &len);
- tmp = keyword(tokenbuf, len);
+ s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
+ tmp = keyword(PL_tokenbuf, len);
if (tmp < 0)
tmp = -tmp;
goto reserved_word;
@@ -2874,14 +3263,14 @@ yylex()
case KEY_crypt:
#ifdef FCRYPT
- if (!cryptseen++)
+ if (!PL_cryptseen++)
init_des();
#endif
LOP(OP_CRYPT,XTERM);
case KEY_chmod:
- if (dowarn) {
- for (d = s; d < bufend && (isSPACE(*d) || *d == '('); d++) ;
+ if (PL_dowarn) {
+ for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
if (*d != '0' && isDIGIT(*d))
yywarn("chmod: mode argument is missing initial 0");
}
@@ -2911,7 +3300,7 @@ yylex()
OPERATOR(DO);
case KEY_die:
- hints |= HINT_BLOCK_SCOPE;
+ PL_hints |= HINT_BLOCK_SCOPE;
LOP(OP_DIE,XTERM);
case KEY_defined:
@@ -2935,7 +3324,7 @@ yylex()
PREBLOCK(ELSE);
case KEY_elsif:
- yylval.ival = curcop->cop_line;
+ yylval.ival = PL_curcop->cop_line;
OPERATOR(ELSIF);
case KEY_eq:
@@ -2949,7 +3338,7 @@ yylex()
case KEY_eval:
s = skipspace(s);
- expect = (*s == '{') ? XTERMBLOCK : XTERM;
+ PL_expect = (*s == '{') ? XTERMBLOCK : XTERM;
UNIBRACK(OP_ENTEREVAL);
case KEY_eof:
@@ -2985,11 +3374,11 @@ yylex()
case KEY_for:
case KEY_foreach:
- yylval.ival = curcop->cop_line;
+ yylval.ival = PL_curcop->cop_line;
s = skipspace(s);
- if (isIDFIRST(*s)) {
+ if (PL_expect == XSTATE && isIDFIRST(*s)) {
char *p = s;
- if ((bufend - p) >= 3 &&
+ if ((PL_bufend - p) >= 3 &&
strnEQ(p, "my", 2) && isSPACE(*(p + 2)))
p += 2;
p = skipspace(p);
@@ -3115,7 +3504,7 @@ yylex()
UNI(OP_HEX);
case KEY_if:
- yylval.ival = curcop->cop_line;
+ yylval.ival = PL_curcop->cop_line;
OPERATOR(IF);
case KEY_index:
@@ -3170,11 +3559,14 @@ yylex()
case KEY_listen:
LOP(OP_LISTEN,XTERM);
+ case KEY_lock:
+ UNI(OP_LOCK);
+
case KEY_lstat:
UNI(OP_LSTAT);
case KEY_m:
- s = scan_pat(s);
+ s = scan_pat(s,OP_MATCH);
TERM(sublex_start());
case KEY_map:
@@ -3196,7 +3588,18 @@ yylex()
LOP(OP_MSGSND,XTERM);
case KEY_my:
- in_my = TRUE;
+ PL_in_my = TRUE;
+ s = skipspace(s);
+ if (isIDFIRST(*s)) {
+ s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len);
+ PL_in_my_stash = gv_stashpv(PL_tokenbuf, FALSE);
+ if (!PL_in_my_stash) {
+ char tmpbuf[1024];
+ PL_bufptr = s;
+ sprintf(tmpbuf, "No such class %.1000s", PL_tokenbuf);
+ yyerror(tmpbuf);
+ }
+ }
OPERATOR(MY);
case KEY_next:
@@ -3207,7 +3610,7 @@ yylex()
Eop(OP_SNE);
case KEY_no:
- if (expect != XSTATE)
+ if (PL_expect != XSTATE)
yyerror("\"no\" not allowed in expression");
s = force_word(s,WORD,FALSE,TRUE,FALSE);
s = force_version(s);
@@ -3243,11 +3646,11 @@ yylex()
LOP(OP_OPEN_DIR,XTERM);
case KEY_print:
- checkcomma(s,tokenbuf,"filehandle");
+ checkcomma(s,PL_tokenbuf,"filehandle");
LOP(OP_PRINT,XREF);
case KEY_printf:
- checkcomma(s,tokenbuf,"filehandle");
+ checkcomma(s,PL_tokenbuf,"filehandle");
LOP(OP_PRTF,XREF);
case KEY_prototype:
@@ -3286,8 +3689,8 @@ yylex()
s = scan_str(s);
if (!s)
missingterm((char*)0);
- if (dowarn && SvLEN(lex_stuff)) {
- d = SvPV_force(lex_stuff, len);
+ if (PL_dowarn && SvLEN(PL_lex_stuff)) {
+ d = SvPV_force(PL_lex_stuff, len);
for (; len; --len, ++d) {
if (*d == ',') {
warn("Possible attempt to separate words with commas");
@@ -3300,19 +3703,19 @@ yylex()
}
}
force_next(')');
- nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, q(lex_stuff));
- lex_stuff = Nullsv;
+ PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, tokeq(PL_lex_stuff));
+ PL_lex_stuff = Nullsv;
force_next(THING);
force_next(',');
- nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(" ",1));
+ PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(" ",1));
force_next(THING);
force_next('(');
yylval.ival = OP_SPLIT;
CLINE;
- expect = XTERM;
- bufptr = s;
- last_lop = oldbufptr;
- last_lop_op = OP_SPLIT;
+ PL_expect = XTERM;
+ PL_bufptr = s;
+ PL_last_lop = PL_oldbufptr;
+ PL_last_lop_op = OP_SPLIT;
return FUNC;
case KEY_qq:
@@ -3320,8 +3723,12 @@ yylex()
if (!s)
missingterm((char*)0);
yylval.ival = OP_STRINGIFY;
- if (SvIVX(lex_stuff) == '\'')
- SvIVX(lex_stuff) = 0; /* qq'$foo' should intepolate */
+ if (SvIVX(PL_lex_stuff) == '\'')
+ SvIVX(PL_lex_stuff) = 0; /* qq'$foo' should intepolate */
+ TERM(sublex_start());
+
+ case KEY_qr:
+ s = scan_pat(s,OP_QR);
TERM(sublex_start());
case KEY_qx:
@@ -3336,10 +3743,10 @@ yylex()
OLDLOP(OP_RETURN);
case KEY_require:
- *tokenbuf = '\0';
+ *PL_tokenbuf = '\0';
s = force_word(s,WORD,TRUE,TRUE,FALSE);
- if (isIDFIRST(*tokenbuf))
- gv_stashpvn(tokenbuf, strlen(tokenbuf), TRUE);
+ if (isIDFIRST(*PL_tokenbuf))
+ gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf), TRUE);
else if (*s == '<')
yyerror("<> should be quotes");
UNI(OP_REQUIRE);
@@ -3484,12 +3891,12 @@ yylex()
LOP(OP_SOCKPAIR,XTERM);
case KEY_sort:
- checkcomma(s,tokenbuf,"subroutine name");
+ checkcomma(s,PL_tokenbuf,"subroutine name");
s = skipspace(s);
if (*s == ';' || *s == ')') /* probably a close */
croak("sort is now a reserved word");
- expect = XTERM;
- s = force_word(s,WORD,TRUE,TRUE,TRUE);
+ PL_expect = XTERM;
+ s = force_word(s,WORD,TRUE,TRUE,FALSE);
LOP(OP_SORT,XREF);
case KEY_split:
@@ -3511,7 +3918,7 @@ yylex()
UNI(OP_STAT);
case KEY_study:
- sawstudy++;
+ PL_sawstudy++;
UNI(OP_STUDY);
case KEY_substr:
@@ -3523,28 +3930,28 @@ yylex()
s = skipspace(s);
if (isIDFIRST(*s) || *s == '\'' || *s == ':') {
- char tmpbuf[sizeof tokenbuf];
- expect = XBLOCK;
+ char tmpbuf[sizeof PL_tokenbuf];
+ PL_expect = XBLOCK;
d = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
if (strchr(tmpbuf, ':'))
- sv_setpv(subname, tmpbuf);
+ sv_setpv(PL_subname, tmpbuf);
else {
- sv_setsv(subname,curstname);
- sv_catpvn(subname,"::",2);
- sv_catpvn(subname,tmpbuf,len);
+ sv_setsv(PL_subname,PL_curstname);
+ sv_catpvn(PL_subname,"::",2);
+ sv_catpvn(PL_subname,tmpbuf,len);
}
s = force_word(s,WORD,FALSE,TRUE,TRUE);
s = skipspace(s);
}
else {
- expect = XTERMBLOCK;
- sv_setpv(subname,"?");
+ PL_expect = XTERMBLOCK;
+ sv_setpv(PL_subname,"?");
}
if (tmp == KEY_format) {
s = skipspace(s);
if (*s == '=')
- lex_formbrack = lex_brackets + 1;
+ PL_lex_formbrack = PL_lex_brackets + 1;
OPERATOR(FORMAT);
}
@@ -3554,36 +3961,36 @@ yylex()
s = scan_str(s);
if (!s) {
- if (lex_stuff)
- SvREFCNT_dec(lex_stuff);
- lex_stuff = Nullsv;
+ if (PL_lex_stuff)
+ SvREFCNT_dec(PL_lex_stuff);
+ PL_lex_stuff = Nullsv;
croak("Prototype not terminated");
}
/* strip spaces */
- d = SvPVX(lex_stuff);
+ d = SvPVX(PL_lex_stuff);
tmp = 0;
for (p = d; *p; ++p) {
if (!isSPACE(*p))
d[tmp++] = *p;
}
d[tmp] = '\0';
- SvCUR(lex_stuff) = tmp;
-
- nexttoke++;
- nextval[1] = nextval[0];
- nexttype[1] = nexttype[0];
- nextval[0].opval = (OP*)newSVOP(OP_CONST, 0, lex_stuff);
- nexttype[0] = THING;
- if (nexttoke == 1) {
- lex_defer = lex_state;
- lex_expect = expect;
- lex_state = LEX_KNOWNEXT;
+ SvCUR(PL_lex_stuff) = tmp;
+
+ PL_nexttoke++;
+ PL_nextval[1] = PL_nextval[0];
+ PL_nexttype[1] = PL_nexttype[0];
+ PL_nextval[0].opval = (OP*)newSVOP(OP_CONST, 0, PL_lex_stuff);
+ PL_nexttype[0] = THING;
+ if (PL_nexttoke == 1) {
+ PL_lex_defer = PL_lex_state;
+ PL_lex_expect = PL_expect;
+ PL_lex_state = LEX_KNOWNEXT;
}
- lex_stuff = Nullsv;
+ PL_lex_stuff = Nullsv;
}
- if (*SvPV(subname,na) == '?') {
- sv_setpv(subname,"__ANON__");
+ if (*SvPV(PL_subname,n_a) == '?') {
+ sv_setpv(PL_subname,"__ANON__");
TOKEN(ANONSUB);
}
PREBLOCK(SUB);
@@ -3645,11 +4052,11 @@ yylex()
UNI(OP_UNTIE);
case KEY_until:
- yylval.ival = curcop->cop_line;
+ yylval.ival = PL_curcop->cop_line;
OPERATOR(UNTIL);
case KEY_unless:
- yylval.ival = curcop->cop_line;
+ yylval.ival = PL_curcop->cop_line;
OPERATOR(UNLESS);
case KEY_unlink:
@@ -3665,8 +4072,8 @@ yylex()
LOP(OP_UTIME,XTERM);
case KEY_umask:
- if (dowarn) {
- for (d = s; d < bufend && (isSPACE(*d) || *d == '('); d++) ;
+ if (PL_dowarn) {
+ for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
if (*d != '0' && isDIGIT(*d))
yywarn("umask: argument is missing initial 0");
}
@@ -3676,13 +4083,13 @@ yylex()
LOP(OP_UNSHIFT,XTERM);
case KEY_use:
- if (expect != XSTATE)
+ if (PL_expect != XSTATE)
yyerror("\"use\" not allowed in expression");
s = skipspace(s);
if(isDIGIT(*s)) {
s = force_version(s);
if(*s == ';' || (s = skipspace(s), *s == ';')) {
- nextval[nexttoke].opval = Nullop;
+ PL_nextval[PL_nexttoke].opval = Nullop;
force_next(WORD);
}
}
@@ -3697,15 +4104,15 @@ yylex()
UNI(OP_VALUES);
case KEY_vec:
- sawvec = TRUE;
+ PL_sawvec = TRUE;
LOP(OP_VEC,XTERM);
case KEY_while:
- yylval.ival = curcop->cop_line;
+ yylval.ival = PL_curcop->cop_line;
OPERATOR(WHILE);
case KEY_warn:
- hints |= HINT_BLOCK_SCOPE;
+ PL_hints |= HINT_BLOCK_SCOPE;
LOP(OP_WARN,XTERM);
case KEY_wait:
@@ -3718,11 +4125,21 @@ yylex()
FUN0(OP_WANTARRAY);
case KEY_write:
- gv_fetchpv("\f",TRUE, SVt_PV); /* Make sure $^L is defined */
+#ifdef EBCDIC
+ {
+ static char ctl_l[2];
+
+ if (ctl_l[0] == '\0')
+ ctl_l[0] = toCTRL('L');
+ gv_fetchpv(ctl_l,TRUE, SVt_PV);
+ }
+#else
+ gv_fetchpv("\f",TRUE, SVt_PV); /* Make sure $^L is defined */
+#endif
UNI(OP_ENTERWRITE);
case KEY_x:
- if (expect == XOPERATOR)
+ if (PL_expect == XOPERATOR)
Mop(OP_REPEAT);
check_uni();
goto just_a_word;
@@ -3735,13 +4152,11 @@ yylex()
s = scan_trans(s);
TERM(sublex_start());
}
- }
+ }}
}
I32
-keyword(d, len)
-register char *d;
-I32 len;
+keyword(register char *d, I32 len)
{
switch (*d) {
case '_':
@@ -3985,6 +4400,9 @@ I32 len;
case 'h':
if (strEQ(d,"hex")) return -KEY_hex;
break;
+ case 'I':
+ if (strEQ(d,"INIT")) return KEY_INIT;
+ break;
case 'i':
switch (len) {
case 2:
@@ -4027,6 +4445,7 @@ I32 len;
case 4:
if (strEQ(d,"last")) return KEY_last;
if (strEQ(d,"link")) return -KEY_link;
+ if (strEQ(d,"lock")) return -KEY_lock;
break;
case 5:
if (strEQ(d,"local")) return KEY_local;
@@ -4081,6 +4500,8 @@ I32 len;
case 3:
if (strEQ(d,"ord")) return -KEY_ord;
if (strEQ(d,"oct")) return -KEY_oct;
+ if (strEQ(d,"our")) { deprecate("reserved word \"our\"");
+ return 0;}
break;
case 4:
if (strEQ(d,"open")) return -KEY_open;
@@ -4117,6 +4538,7 @@ I32 len;
case 'q':
if (len <= 2) {
if (strEQ(d,"q")) return KEY_q;
+ if (strEQ(d,"qr")) return KEY_qr;
if (strEQ(d,"qq")) return KEY_qq;
if (strEQ(d,"qw")) return KEY_qw;
if (strEQ(d,"qx")) return KEY_qx;
@@ -4352,15 +4774,12 @@ I32 len;
return 0;
}
-static void
-checkcomma(s,name,what)
-register char *s;
-char *name;
-char *what;
+STATIC void
+checkcomma(register char *s, char *name, char *what)
{
char *w;
- if (dowarn && *s == ' ' && s[1] == '(') { /* XXX gotta be a better way */
+ if (PL_dowarn && *s == ' ' && s[1] == '(') { /* XXX gotta be a better way */
int level = 1;
for (w = s+2; *w && level; w++) {
if (*w == '(')
@@ -4373,17 +4792,17 @@ char *what;
if (!*w || !strchr(";|})]oaiuw!=", *w)) /* an advisory hack only... */
warn("%s (...) interpreted as function",name);
}
- while (s < bufend && isSPACE(*s))
+ while (s < PL_bufend && isSPACE(*s))
s++;
if (*s == '(')
s++;
- while (s < bufend && isSPACE(*s))
+ while (s < PL_bufend && isSPACE(*s))
s++;
if (isIDFIRST(*s)) {
w = s++;
while (isALNUM(*s))
s++;
- while (s < bufend && isSPACE(*s))
+ while (s < PL_bufend && isSPACE(*s))
s++;
if (*s == ',') {
int kw;
@@ -4397,13 +4816,77 @@ char *what;
}
}
-static char *
-scan_word(s, dest, destlen, allow_package, slp)
-register char *s;
-char *dest;
-STRLEN destlen;
-int allow_package;
-STRLEN *slp;
+STATIC SV *
+new_constant(char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type)
+{
+ dSP;
+ HV *table = GvHV(PL_hintgv); /* ^H */
+ BINOP myop;
+ SV *res;
+ bool oldcatch = CATCH_GET;
+ SV **cvp;
+ SV *cv, *typesv;
+ char buf[128];
+
+ if (!table) {
+ yyerror("%^H is not defined");
+ return sv;
+ }
+ cvp = hv_fetch(table, key, strlen(key), FALSE);
+ if (!cvp || !SvOK(*cvp)) {
+ sprintf(buf,"$^H{%s} is not defined", key);
+ yyerror(buf);
+ return sv;
+ }
+ sv_2mortal(sv); /* Parent created it permanently */
+ cv = *cvp;
+ if (!pv)
+ pv = sv_2mortal(newSVpv(s, len));
+ if (type)
+ typesv = sv_2mortal(newSVpv(type, 0));
+ else
+ typesv = &PL_sv_undef;
+ CATCH_SET(TRUE);
+ Zero(&myop, 1, BINOP);
+ myop.op_last = (OP *) &myop;
+ myop.op_next = Nullop;
+ myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED;
+
+ PUSHSTACKi(PERLSI_OVERLOAD);
+ ENTER;
+ SAVEOP();
+ PL_op = (OP *) &myop;
+ if (PERLDB_SUB && PL_curstash != PL_debstash)
+ PL_op->op_private |= OPpENTERSUB_DB;
+ PUTBACK;
+ pp_pushmark(ARGS);
+
+ EXTEND(sp, 4);
+ PUSHs(pv);
+ PUSHs(sv);
+ PUSHs(typesv);
+ PUSHs(cv);
+ PUTBACK;
+
+ if (PL_op = pp_entersub(ARGS))
+ CALLRUNOPS();
+ LEAVE;
+ SPAGAIN;
+
+ res = POPs;
+ PUTBACK;
+ CATCH_SET(oldcatch);
+ POPSTACK;
+
+ if (!SvOK(res)) {
+ sprintf(buf,"Call to &{$^H{%s}} did not return a defined value", key);
+ yyerror(buf);
+ }
+ return SvREFCNT_inc(res);
+}
+
+STATIC char *
+scan_word(register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
{
register char *d = dest;
register char *e = d + destlen - 3; /* two-character token, ending NUL */
@@ -4417,7 +4900,7 @@ STRLEN *slp;
*d++ = ':';
s++;
}
- else if (*s == ':' && s[1] == ':' && allow_package && isIDFIRST(s[2])) {
+ else if (*s == ':' && s[1] == ':' && allow_package && s[2] != '$') {
*d++ = *s++;
*d++ = *s++;
}
@@ -4429,21 +4912,16 @@ STRLEN *slp;
}
}
-static char *
-scan_ident(s, send, dest, destlen, ck_uni)
-register char *s;
-register char *send;
-char *dest;
-STRLEN destlen;
-I32 ck_uni;
+STATIC char *
+scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I32 ck_uni)
{
register char *d;
register char *e;
char *bracket = 0;
char funny = *s++;
- if (lex_brackets == 0)
- lex_fakebrack = 0;
+ if (PL_lex_brackets == 0)
+ PL_lex_fakebrack = 0;
if (isSPACE(*s))
s = skipspace(s);
d = dest;
@@ -4477,14 +4955,14 @@ I32 ck_uni;
*d = '\0';
d = dest;
if (*d) {
- if (lex_state != LEX_NORMAL)
- lex_state = LEX_INTERPENDMAYBE;
+ if (PL_lex_state != LEX_NORMAL)
+ PL_lex_state = LEX_INTERPENDMAYBE;
return s;
}
if (*s == '$' && s[1] &&
(isALNUM(s[1]) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
{
- if (isDIGIT(s[1]) && lex_state == LEX_INTERPNORMAL)
+ if (isDIGIT(s[1]) && PL_lex_state == LEX_INTERPNORMAL)
deprecate("\"$$<digit>\" to mean \"${$}<digit>\"");
else
return s;
@@ -4519,24 +4997,24 @@ I32 ck_uni;
*d = '\0';
while (s < send && (*s == ' ' || *s == '\t')) s++;
if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
- if (dowarn && keyword(dest, d - dest)) {
+ if (PL_dowarn && keyword(dest, d - dest)) {
char *brack = *s == '[' ? "[...]" : "{...}";
warn("Ambiguous use of %c{%s%s} resolved to %c%s%s",
funny, dest, brack, funny, dest, brack);
}
- lex_fakebrack = lex_brackets+1;
+ PL_lex_fakebrack = PL_lex_brackets+1;
bracket++;
- lex_brackstack[lex_brackets++] = XOPERATOR;
+ PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
return s;
}
}
if (*s == '}') {
s++;
- if (lex_state == LEX_INTERPNORMAL && !lex_brackets)
- lex_state = LEX_INTERPEND;
+ if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets)
+ PL_lex_state = LEX_INTERPEND;
if (funny == '#')
funny = '@';
- if (dowarn && lex_state == LEX_NORMAL &&
+ if (PL_dowarn && PL_lex_state == LEX_NORMAL &&
(keyword(dest, d - dest) || perl_get_cv(dest, FALSE)))
warn("Ambiguous use of %c{%s} resolved to %c%s",
funny, dest, funny, dest);
@@ -4546,14 +5024,12 @@ I32 ck_uni;
*dest = '\0';
}
}
- else if (lex_state == LEX_INTERPNORMAL && !lex_brackets && !intuit_more(s))
- lex_state = LEX_INTERPEND;
+ else if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets && !intuit_more(s))
+ PL_lex_state = LEX_INTERPEND;
return s;
}
-void pmflag(pmfl,ch)
-U16* pmfl;
-int ch;
+void pmflag(U16 *pmfl, int ch)
{
if (ch == 'i')
*pmfl |= PMf_FOLD;
@@ -4571,36 +5047,40 @@ int ch;
*pmfl |= PMf_EXTENDED;
}
-static char *
-scan_pat(start)
-char *start;
+STATIC char *
+scan_pat(char *start, I32 type)
{
PMOP *pm;
char *s;
s = scan_str(start);
if (!s) {
- if (lex_stuff)
- SvREFCNT_dec(lex_stuff);
- lex_stuff = Nullsv;
+ if (PL_lex_stuff)
+ SvREFCNT_dec(PL_lex_stuff);
+ PL_lex_stuff = Nullsv;
croak("Search pattern not terminated");
}
- pm = (PMOP*)newPMOP(OP_MATCH, 0);
- if (multi_open == '?')
+ pm = (PMOP*)newPMOP(type, 0);
+ if (PL_multi_open == '?')
pm->op_pmflags |= PMf_ONCE;
- while (*s && strchr("iogcmsx", *s))
- pmflag(&pm->op_pmflags,*s++);
+ if(type == OP_QR) {
+ while (*s && strchr("iomsx", *s))
+ pmflag(&pm->op_pmflags,*s++);
+ }
+ else {
+ while (*s && strchr("iogcmsx", *s))
+ pmflag(&pm->op_pmflags,*s++);
+ }
pm->op_pmpermflags = pm->op_pmflags;
- lex_op = (OP*)pm;
+ PL_lex_op = (OP*)pm;
yylval.ival = OP_MATCH;
return s;
}
-static char *
-scan_subst(start)
-char *start;
+STATIC char *
+scan_subst(char *start)
{
register char *s;
register PMOP *pm;
@@ -4612,156 +5092,120 @@ char *start;
s = scan_str(start);
if (!s) {
- if (lex_stuff)
- SvREFCNT_dec(lex_stuff);
- lex_stuff = Nullsv;
+ if (PL_lex_stuff)
+ SvREFCNT_dec(PL_lex_stuff);
+ PL_lex_stuff = Nullsv;
croak("Substitution pattern not terminated");
}
- if (s[-1] == multi_open)
+ if (s[-1] == PL_multi_open)
s--;
- first_start = multi_start;
+ first_start = PL_multi_start;
s = scan_str(s);
if (!s) {
- if (lex_stuff)
- SvREFCNT_dec(lex_stuff);
- lex_stuff = Nullsv;
- if (lex_repl)
- SvREFCNT_dec(lex_repl);
- lex_repl = Nullsv;
+ if (PL_lex_stuff)
+ SvREFCNT_dec(PL_lex_stuff);
+ PL_lex_stuff = Nullsv;
+ if (PL_lex_repl)
+ SvREFCNT_dec(PL_lex_repl);
+ PL_lex_repl = Nullsv;
croak("Substitution replacement not terminated");
}
- multi_start = first_start; /* so whole substitution is taken together */
+ PL_multi_start = first_start; /* so whole substitution is taken together */
pm = (PMOP*)newPMOP(OP_SUBST, 0);
- while (*s && strchr("iogcmsex", *s)) {
+ while (*s) {
if (*s == 'e') {
s++;
es++;
}
- else
+ else if (strchr("iogcmsx", *s))
pmflag(&pm->op_pmflags,*s++);
+ else
+ break;
}
if (es) {
SV *repl;
+ PL_super_bufptr = s;
+ PL_super_bufend = PL_bufend;
+ PL_multi_end = 0;
pm->op_pmflags |= PMf_EVAL;
repl = newSVpv("",0);
while (es-- > 0)
sv_catpv(repl, es ? "eval " : "do ");
sv_catpvn(repl, "{ ", 2);
- sv_catsv(repl, lex_repl);
+ sv_catsv(repl, PL_lex_repl);
sv_catpvn(repl, " };", 2);
SvCOMPILED_on(repl);
- SvREFCNT_dec(lex_repl);
- lex_repl = repl;
+ SvREFCNT_dec(PL_lex_repl);
+ PL_lex_repl = repl;
}
pm->op_pmpermflags = pm->op_pmflags;
- lex_op = (OP*)pm;
+ PL_lex_op = (OP*)pm;
yylval.ival = OP_SUBST;
return s;
}
-void
-hoistmust(pm)
-register PMOP *pm;
-{
- if (!pm->op_pmshort && pm->op_pmregexp->regstart &&
- (!pm->op_pmregexp->regmust || pm->op_pmregexp->reganch & ROPT_ANCH)
- ) {
- if (!(pm->op_pmregexp->reganch & ROPT_ANCH))
- pm->op_pmflags |= PMf_SCANFIRST;
- pm->op_pmshort = SvREFCNT_inc(pm->op_pmregexp->regstart);
- pm->op_pmslen = SvCUR(pm->op_pmshort);
- }
- else if (pm->op_pmregexp->regmust) {/* is there a better short-circuit? */
- if (pm->op_pmshort &&
- sv_eq(pm->op_pmshort,pm->op_pmregexp->regmust))
- {
- if (pm->op_pmflags & PMf_SCANFIRST) {
- SvREFCNT_dec(pm->op_pmshort);
- pm->op_pmshort = Nullsv;
- }
- else {
- SvREFCNT_dec(pm->op_pmregexp->regmust);
- pm->op_pmregexp->regmust = Nullsv;
- return;
- }
- }
- /* promote the better string */
- if ((!pm->op_pmshort &&
- !(pm->op_pmregexp->reganch & ROPT_ANCH_GPOS)) ||
- ((pm->op_pmflags & PMf_SCANFIRST) &&
- (SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)))) {
- SvREFCNT_dec(pm->op_pmshort); /* ok if null */
- pm->op_pmshort = pm->op_pmregexp->regmust;
- pm->op_pmslen = SvCUR(pm->op_pmshort);
- pm->op_pmregexp->regmust = Nullsv;
- pm->op_pmflags |= PMf_SCANFIRST;
- }
- }
-}
-
-static char *
-scan_trans(start)
-char *start;
+STATIC char *
+scan_trans(char *start)
{
register char* s;
- OP *op;
+ OP *o;
short *tbl;
I32 squash;
- I32 delete;
+ I32 Delete;
I32 complement;
yylval.ival = OP_NULL;
s = scan_str(start);
if (!s) {
- if (lex_stuff)
- SvREFCNT_dec(lex_stuff);
- lex_stuff = Nullsv;
- croak("Translation pattern not terminated");
+ if (PL_lex_stuff)
+ SvREFCNT_dec(PL_lex_stuff);
+ PL_lex_stuff = Nullsv;
+ croak("Transliteration pattern not terminated");
}
- if (s[-1] == multi_open)
+ if (s[-1] == PL_multi_open)
s--;
s = scan_str(s);
if (!s) {
- if (lex_stuff)
- SvREFCNT_dec(lex_stuff);
- lex_stuff = Nullsv;
- if (lex_repl)
- SvREFCNT_dec(lex_repl);
- lex_repl = Nullsv;
- croak("Translation replacement not terminated");
+ if (PL_lex_stuff)
+ SvREFCNT_dec(PL_lex_stuff);
+ PL_lex_stuff = Nullsv;
+ if (PL_lex_repl)
+ SvREFCNT_dec(PL_lex_repl);
+ PL_lex_repl = Nullsv;
+ croak("Transliteration replacement not terminated");
}
New(803,tbl,256,short);
- op = newPVOP(OP_TRANS, 0, (char*)tbl);
+ o = newPVOP(OP_TRANS, 0, (char*)tbl);
- complement = delete = squash = 0;
+ complement = Delete = squash = 0;
while (*s == 'c' || *s == 'd' || *s == 's') {
if (*s == 'c')
complement = OPpTRANS_COMPLEMENT;
else if (*s == 'd')
- delete = OPpTRANS_DELETE;
+ Delete = OPpTRANS_DELETE;
else
squash = OPpTRANS_SQUASH;
s++;
}
- op->op_private = delete|squash|complement;
+ o->op_private = Delete|squash|complement;
- lex_op = op;
+ PL_lex_op = o;
yylval.ival = OP_TRANS;
return s;
}
-static char *
-scan_heredoc(s)
-register char *s;
+STATIC char *
+scan_heredoc(register char *s)
{
+ dTHR;
SV *herewas;
I32 op_type = OP_SCALAR;
I32 len;
@@ -4770,20 +5214,20 @@ register char *s;
register char *d;
register char *e;
char *peek;
- int outer = (rsfp && !lex_inwhat);
+ int outer = (PL_rsfp && !(PL_lex_inwhat == OP_SCALAR));
s += 2;
- d = tokenbuf;
- e = tokenbuf + sizeof tokenbuf - 1;
+ d = PL_tokenbuf;
+ e = PL_tokenbuf + sizeof PL_tokenbuf - 1;
if (!outer)
*d++ = '\n';
for (peek = s; *peek == ' ' || *peek == '\t'; peek++) ;
if (*peek && strchr("`'\"",*peek)) {
s = peek;
term = *s++;
- s = delimcpy(d, e, s, bufend, term, &len);
+ s = delimcpy(d, e, s, PL_bufend, term, &len);
d += len;
- if (s < bufend)
+ if (s < PL_bufend)
s++;
}
else {
@@ -4798,19 +5242,43 @@ register char *s;
*d++ = *s;
}
}
- if (d >= tokenbuf + sizeof tokenbuf - 1)
+ if (d >= PL_tokenbuf + sizeof PL_tokenbuf - 1)
croak("Delimiter for here document is too long");
*d++ = '\n';
*d = '\0';
- len = d - tokenbuf;
+ len = d - PL_tokenbuf;
+#ifndef PERL_STRICT_CR
+ d = strchr(s, '\r');
+ if (d) {
+ char *olds = s;
+ s = d;
+ while (s < PL_bufend) {
+ if (*s == '\r') {
+ *d++ = '\n';
+ if (*++s == '\n')
+ s++;
+ }
+ else if (*s == '\n' && s[1] == '\r') { /* \015\013 on a mac? */
+ *d++ = *s++;
+ s++;
+ }
+ else
+ *d++ = *s++;
+ }
+ *d = '\0';
+ PL_bufend = d;
+ SvCUR_set(PL_linestr, PL_bufend - SvPVX(PL_linestr));
+ s = olds;
+ }
+#endif
d = "\n";
- if (outer || !(d=ninstr(s,bufend,d,d+1)))
- herewas = newSVpv(s,bufend-s);
+ if (outer || !(d=ninstr(s,PL_bufend,d,d+1)))
+ herewas = newSVpv(s,PL_bufend-s);
else
s--, herewas = newSVpv(s,d-s);
s += SvCUR(herewas);
- tmpstr = NEWSV(87,80);
+ tmpstr = NEWSV(87,79);
sv_upgrade(tmpstr, SVt_PVIV);
if (term == '\'') {
op_type = OP_CONST;
@@ -4822,354 +5290,679 @@ register char *s;
}
CLINE;
- multi_start = curcop->cop_line;
- multi_open = multi_close = '<';
- term = *tokenbuf;
- if (!outer) {
+ PL_multi_start = PL_curcop->cop_line;
+ PL_multi_open = PL_multi_close = '<';
+ term = *PL_tokenbuf;
+ if (PL_lex_inwhat == OP_SUBST && PL_in_eval && !PL_rsfp) {
+ char *bufptr = PL_super_bufptr;
+ char *bufend = PL_super_bufend;
+ char *olds = s - SvCUR(herewas);
+ s = strchr(bufptr, '\n');
+ if (!s)
+ s = bufend;
d = s;
while (s < bufend &&
- (*s != term || memNE(s,tokenbuf,len)) ) {
+ (*s != term || memNE(s,PL_tokenbuf,len)) ) {
if (*s++ == '\n')
- curcop->cop_line++;
+ PL_curcop->cop_line++;
}
if (s >= bufend) {
- curcop->cop_line = multi_start;
- missingterm(tokenbuf);
+ PL_curcop->cop_line = PL_multi_start;
+ missingterm(PL_tokenbuf);
}
+ sv_setpvn(herewas,bufptr,d-bufptr+1);
sv_setpvn(tmpstr,d+1,s-d);
s += len - 1;
sv_catpvn(herewas,s,bufend-s);
- sv_setsv(linestr,herewas);
- oldoldbufptr = oldbufptr = bufptr = s = linestart = SvPVX(linestr);
- bufend = SvPVX(linestr) + SvCUR(linestr);
+ (void)strcpy(bufptr,SvPVX(herewas));
+
+ s = olds;
+ goto retval;
+ }
+ else if (!outer) {
+ d = s;
+ while (s < PL_bufend &&
+ (*s != term || memNE(s,PL_tokenbuf,len)) ) {
+ if (*s++ == '\n')
+ PL_curcop->cop_line++;
+ }
+ if (s >= PL_bufend) {
+ PL_curcop->cop_line = PL_multi_start;
+ missingterm(PL_tokenbuf);
+ }
+ sv_setpvn(tmpstr,d+1,s-d);
+ s += len - 1;
+ PL_curcop->cop_line++; /* the preceding stmt passes a newline */
+
+ sv_catpvn(herewas,s,PL_bufend-s);
+ sv_setsv(PL_linestr,herewas);
+ PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart = SvPVX(PL_linestr);
+ PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
}
else
sv_setpvn(tmpstr,"",0); /* avoid "uninitialized" warning */
- while (s >= bufend) { /* multiple line string? */
+ while (s >= PL_bufend) { /* multiple line string? */
if (!outer ||
- !(oldoldbufptr = oldbufptr = s = linestart = filter_gets(linestr, rsfp, 0))) {
- curcop->cop_line = multi_start;
- missingterm(tokenbuf);
+ !(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) {
+ PL_curcop->cop_line = PL_multi_start;
+ missingterm(PL_tokenbuf);
+ }
+ PL_curcop->cop_line++;
+ PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+#ifndef PERL_STRICT_CR
+ if (PL_bufend - PL_linestart >= 2) {
+ if ((PL_bufend[-2] == '\r' && PL_bufend[-1] == '\n') ||
+ (PL_bufend[-2] == '\n' && PL_bufend[-1] == '\r'))
+ {
+ PL_bufend[-2] = '\n';
+ PL_bufend--;
+ SvCUR_set(PL_linestr, PL_bufend - SvPVX(PL_linestr));
+ }
+ else if (PL_bufend[-1] == '\r')
+ PL_bufend[-1] = '\n';
}
- curcop->cop_line++;
- if (PERLDB_LINE && curstash != debstash) {
+ else if (PL_bufend - PL_linestart == 1 && PL_bufend[-1] == '\r')
+ PL_bufend[-1] = '\n';
+#endif
+ if (PERLDB_LINE && PL_curstash != PL_debstash) {
SV *sv = NEWSV(88,0);
sv_upgrade(sv, SVt_PVMG);
- sv_setsv(sv,linestr);
- av_store(GvAV(curcop->cop_filegv),
- (I32)curcop->cop_line,sv);
+ sv_setsv(sv,PL_linestr);
+ av_store(GvAV(PL_curcop->cop_filegv),
+ (I32)PL_curcop->cop_line,sv);
}
- bufend = SvPVX(linestr) + SvCUR(linestr);
- if (*s == term && memEQ(s,tokenbuf,len)) {
- s = bufend - 1;
+ if (*s == term && memEQ(s,PL_tokenbuf,len)) {
+ s = PL_bufend - 1;
*s = ' ';
- sv_catsv(linestr,herewas);
- bufend = SvPVX(linestr) + SvCUR(linestr);
+ sv_catsv(PL_linestr,herewas);
+ PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
}
else {
- s = bufend;
- sv_catsv(tmpstr,linestr);
+ s = PL_bufend;
+ sv_catsv(tmpstr,PL_linestr);
}
}
- multi_end = curcop->cop_line;
s++;
+retval:
+ PL_multi_end = PL_curcop->cop_line;
if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
}
SvREFCNT_dec(herewas);
- lex_stuff = tmpstr;
+ PL_lex_stuff = tmpstr;
yylval.ival = op_type;
return s;
}
-static char *
-scan_inputsymbol(start)
-char *start;
+/* scan_inputsymbol
+ takes: current position in input buffer
+ returns: new position in input buffer
+ side-effects: yylval and lex_op are set.
+
+ This code handles:
+
+ <> read from ARGV
+ <FH> read from filehandle
+ <pkg::FH> read from package qualified filehandle
+ <pkg'FH> read from package qualified filehandle
+ <$fh> read from filehandle in $fh
+ <*.h> filename glob
+
+*/
+
+STATIC char *
+scan_inputsymbol(char *start)
{
- register char *s = start;
+ register char *s = start; /* current position in buffer */
register char *d;
register char *e;
I32 len;
- d = tokenbuf;
- e = tokenbuf + sizeof tokenbuf;
- s = delimcpy(d, e, s + 1, bufend, '>', &len);
- if (len >= sizeof tokenbuf)
+ d = PL_tokenbuf; /* start of temp holding space */
+ e = PL_tokenbuf + sizeof PL_tokenbuf; /* end of temp holding space */
+ s = delimcpy(d, e, s + 1, PL_bufend, '>', &len); /* extract until > */
+
+ /* die if we didn't have space for the contents of the <>,
+ or if it didn't end
+ */
+
+ if (len >= sizeof PL_tokenbuf)
croak("Excessively long <> operator");
- if (s >= bufend)
+ if (s >= PL_bufend)
croak("Unterminated <> operator");
+
s++;
+
+ /* check for <$fh>
+ Remember, only scalar variables are interpreted as filehandles by
+ this code. Anything more complex (e.g., <$fh{$num}>) will be
+ treated as a glob() call.
+ This code makes use of the fact that except for the $ at the front,
+ a scalar variable and a filehandle look the same.
+ */
if (*d == '$' && d[1]) d++;
+
+ /* allow <Pkg'VALUE> or <Pkg::VALUE> */
while (*d && (isALNUM(*d) || *d == '\'' || *d == ':'))
d++;
- if (d - tokenbuf != len) {
+
+ /* If we've tried to read what we allow filehandles to look like, and
+ there's still text left, then it must be a glob() and not a getline.
+ Use scan_str to pull out the stuff between the <> and treat it
+ as nothing more than a string.
+ */
+
+ if (d - PL_tokenbuf != len) {
yylval.ival = OP_GLOB;
set_csh();
s = scan_str(start);
if (!s)
- croak("Glob not terminated");
+ croak("Glob not terminated");
return s;
}
else {
- d = tokenbuf;
+ /* we're in a filehandle read situation */
+ d = PL_tokenbuf;
+
+ /* turn <> into <ARGV> */
if (!len)
(void)strcpy(d,"ARGV");
+
+ /* if <$fh>, create the ops to turn the variable into a
+ filehandle
+ */
if (*d == '$') {
I32 tmp;
- if (tmp = pad_findmy(d)) {
- OP *op = newOP(OP_PADSV, 0);
- op->op_targ = tmp;
- lex_op = (OP*)newUNOP(OP_READLINE, 0, newUNOP(OP_RV2GV, 0, op));
+
+ /* try to find it in the pad for this block, otherwise find
+ add symbol table ops
+ */
+ if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
+ OP *o = newOP(OP_PADSV, 0);
+ o->op_targ = tmp;
+ PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, newUNOP(OP_RV2GV, 0, o));
}
else {
GV *gv = gv_fetchpv(d+1,TRUE, SVt_PV);
- lex_op = (OP*)newUNOP(OP_READLINE, 0,
+ PL_lex_op = (OP*)newUNOP(OP_READLINE, 0,
newUNOP(OP_RV2GV, 0,
newUNOP(OP_RV2SV, 0,
newGVOP(OP_GV, 0, gv))));
}
+ /* we created the ops in lex_op, so make yylval.ival a null op */
yylval.ival = OP_NULL;
}
+
+ /* If it's none of the above, it must be a literal filehandle
+ (<Foo::BAR> or <FOO>) so build a simple readline OP */
else {
GV *gv = gv_fetchpv(d,TRUE, SVt_PVIO);
- lex_op = (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
+ PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
yylval.ival = OP_NULL;
}
}
+
return s;
}
-static char *
-scan_str(start)
-char *start;
-{
- SV *sv;
- char *tmps;
- register char *s = start;
- register char term;
- register char *to;
- I32 brackets = 1;
+/* scan_str
+ takes: start position in buffer
+ returns: position to continue reading from buffer
+ side-effects: multi_start, multi_close, lex_repl or lex_stuff, and
+ updates the read buffer.
+
+ This subroutine pulls a string out of the input. It is called for:
+ q single quotes q(literal text)
+ ' single quotes 'literal text'
+ qq double quotes qq(interpolate $here please)
+ " double quotes "interpolate $here please"
+ qx backticks qx(/bin/ls -l)
+ ` backticks `/bin/ls -l`
+ qw quote words @EXPORT_OK = qw( func() $spam )
+ m// regexp match m/this/
+ s/// regexp substitute s/this/that/
+ tr/// string transliterate tr/this/that/
+ y/// string transliterate y/this/that/
+ ($*@) sub prototypes sub foo ($)
+ <> readline or globs <FOO>, <>, <$fh>, or <*.c>
+
+ In most of these cases (all but <>, patterns and transliterate)
+ yylex() calls scan_str(). m// makes yylex() call scan_pat() which
+ calls scan_str(). s/// makes yylex() call scan_subst() which calls
+ scan_str(). tr/// and y/// make yylex() call scan_trans() which
+ calls scan_str().
+
+ It skips whitespace before the string starts, and treats the first
+ character as the delimiter. If the delimiter is one of ([{< then
+ the corresponding "close" character )]}> is used as the closing
+ delimiter. It allows quoting of delimiters, and if the string has
+ balanced delimiters ([{<>}]) it allows nesting.
+
+ The lexer always reads these strings into lex_stuff, except in the
+ case of the operators which take *two* arguments (s/// and tr///)
+ when it checks to see if lex_stuff is full (presumably with the 1st
+ arg to s or tr) and if so puts the string into lex_repl.
+
+*/
+
+STATIC char *
+scan_str(char *start)
+{
+ dTHR;
+ SV *sv; /* scalar value: string */
+ char *tmps; /* temp string, used for delimiter matching */
+ register char *s = start; /* current position in the buffer */
+ register char term; /* terminating character */
+ register char *to; /* current position in the sv's data */
+ I32 brackets = 1; /* bracket nesting level */
+
+ /* skip space before the delimiter */
if (isSPACE(*s))
s = skipspace(s);
+
+ /* mark where we are, in case we need to report errors */
CLINE;
+
+ /* after skipping whitespace, the next character is the terminator */
term = *s;
- multi_start = curcop->cop_line;
- multi_open = term;
+ /* mark where we are */
+ PL_multi_start = PL_curcop->cop_line;
+ PL_multi_open = term;
+
+ /* find corresponding closing delimiter */
if (term && (tmps = strchr("([{< )]}> )]}>",term)))
term = tmps[5];
- multi_close = term;
+ PL_multi_close = term;
- sv = NEWSV(87,80);
+ /* create a new SV to hold the contents. 87 is leak category, I'm
+ assuming. 79 is the SV's initial length. What a random number. */
+ sv = NEWSV(87,79);
sv_upgrade(sv, SVt_PVIV);
SvIVX(sv) = term;
(void)SvPOK_only(sv); /* validate pointer */
+
+ /* move past delimiter and try to read a complete string */
s++;
for (;;) {
- SvGROW(sv, SvCUR(sv) + (bufend - s) + 1);
+ /* extend sv if need be */
+ SvGROW(sv, SvCUR(sv) + (PL_bufend - s) + 1);
+ /* set 'to' to the next character in the sv's string */
to = SvPVX(sv)+SvCUR(sv);
- if (multi_open == multi_close) {
- for (; s < bufend; s++,to++) {
- if (*s == '\n' && !rsfp)
- curcop->cop_line++;
- if (*s == '\\' && s+1 < bufend && term != '\\') {
+
+ /* if open delimiter is the close delimiter read unbridle */
+ if (PL_multi_open == PL_multi_close) {
+ for (; s < PL_bufend; s++,to++) {
+ /* embedded newlines increment the current line number */
+ if (*s == '\n' && !PL_rsfp)
+ PL_curcop->cop_line++;
+ /* handle quoted delimiters */
+ if (*s == '\\' && s+1 < PL_bufend && term != '\\') {
if (s[1] == term)
s++;
+ /* any other quotes are simply copied straight through */
else
*to++ = *s++;
}
+ /* terminate when run out of buffer (the for() condition), or
+ have found the terminator */
else if (*s == term)
break;
*to = *s;
}
}
+
+ /* if the terminator isn't the same as the start character (e.g.,
+ matched brackets), we have to allow more in the quoting, and
+ be prepared for nested brackets.
+ */
else {
- for (; s < bufend; s++,to++) {
- if (*s == '\n' && !rsfp)
- curcop->cop_line++;
- if (*s == '\\' && s+1 < bufend) {
- if ((s[1] == multi_open) || (s[1] == multi_close))
+ /* read until we run out of string, or we find the terminator */
+ for (; s < PL_bufend; s++,to++) {
+ /* embedded newlines increment the line count */
+ if (*s == '\n' && !PL_rsfp)
+ PL_curcop->cop_line++;
+ /* backslashes can escape the open or closing characters */
+ if (*s == '\\' && s+1 < PL_bufend) {
+ if ((s[1] == PL_multi_open) || (s[1] == PL_multi_close))
s++;
else
*to++ = *s++;
}
- else if (*s == multi_close && --brackets <= 0)
+ /* allow nested opens and closes */
+ else if (*s == PL_multi_close && --brackets <= 0)
break;
- else if (*s == multi_open)
+ else if (*s == PL_multi_open)
brackets++;
*to = *s;
}
}
+ /* terminate the copied string and update the sv's end-of-string */
*to = '\0';
SvCUR_set(sv, to - SvPVX(sv));
- if (s < bufend) break; /* string ends on this line? */
+ /*
+ * this next chunk reads more into the buffer if we're not done yet
+ */
+
+ if (s < PL_bufend) break; /* handle case where we are done yet :-) */
- if (!rsfp ||
- !(oldoldbufptr = oldbufptr = s = linestart = filter_gets(linestr, rsfp, 0))) {
+#ifndef PERL_STRICT_CR
+ if (to - SvPVX(sv) >= 2) {
+ if ((to[-2] == '\r' && to[-1] == '\n') ||
+ (to[-2] == '\n' && to[-1] == '\r'))
+ {
+ to[-2] = '\n';
+ to--;
+ SvCUR_set(sv, to - SvPVX(sv));
+ }
+ else if (to[-1] == '\r')
+ to[-1] = '\n';
+ }
+ else if (to - SvPVX(sv) == 1 && to[-1] == '\r')
+ to[-1] = '\n';
+#endif
+
+ /* if we're out of file, or a read fails, bail and reset the current
+ line marker so we can report where the unterminated string began
+ */
+ if (!PL_rsfp ||
+ !(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) {
sv_free(sv);
- curcop->cop_line = multi_start;
+ PL_curcop->cop_line = PL_multi_start;
return Nullch;
}
- curcop->cop_line++;
- if (PERLDB_LINE && curstash != debstash) {
+ /* we read a line, so increment our line counter */
+ PL_curcop->cop_line++;
+
+ /* update debugger info */
+ if (PERLDB_LINE && PL_curstash != PL_debstash) {
SV *sv = NEWSV(88,0);
sv_upgrade(sv, SVt_PVMG);
- sv_setsv(sv,linestr);
- av_store(GvAV(curcop->cop_filegv),
- (I32)curcop->cop_line, sv);
+ sv_setsv(sv,PL_linestr);
+ av_store(GvAV(PL_curcop->cop_filegv),
+ (I32)PL_curcop->cop_line, sv);
}
- bufend = SvPVX(linestr) + SvCUR(linestr);
+
+ /* having changed the buffer, we must update PL_bufend */
+ PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
}
- multi_end = curcop->cop_line;
+
+ /* at this point, we have successfully read the delimited string */
+
+ PL_multi_end = PL_curcop->cop_line;
s++;
+
+ /* if we allocated too much space, give some back */
if (SvCUR(sv) + 5 < SvLEN(sv)) {
SvLEN_set(sv, SvCUR(sv) + 1);
Renew(SvPVX(sv), SvLEN(sv), char);
}
- if (lex_stuff)
- lex_repl = sv;
+
+ /* decide whether this is the first or second quoted string we've read
+ for this op
+ */
+
+ if (PL_lex_stuff)
+ PL_lex_repl = sv;
else
- lex_stuff = sv;
+ PL_lex_stuff = sv;
return s;
}
+/*
+ scan_num
+ takes: pointer to position in buffer
+ returns: pointer to new position in buffer
+ side-effects: builds ops for the constant in yylval.op
+
+ Read a number in any of the formats that Perl accepts:
+
+ 0(x[0-7A-F]+)|([0-7]+)
+ [\d_]+(\.[\d_]*)?[Ee](\d+)
+
+ Underbars (_) are allowed in decimal numbers. If -w is on,
+ underbars before a decimal point must be at three digit intervals.
+
+ Like most scan_ routines, it uses the PL_tokenbuf buffer to hold the
+ thing it reads.
+
+ If it reads a number without a decimal point or an exponent, it will
+ try converting the number to an integer and see if it can do so
+ without loss of precision.
+*/
+
char *
-scan_num(start)
-char *start;
+scan_num(char *start)
{
- register char *s = start;
- register char *d;
- register char *e;
- I32 tryiv;
- double value;
- SV *sv;
- I32 floatit;
- char *lastub = 0;
+ register char *s = start; /* current position in buffer */
+ register char *d; /* destination in temp buffer */
+ register char *e; /* end of temp buffer */
+ I32 tryiv; /* used to see if it can be an int */
+ double value; /* number read, as a double */
+ SV *sv; /* place to put the converted number */
+ I32 floatit; /* boolean: int or float? */
+ char *lastub = 0; /* position of last underbar */
static char number_too_long[] = "Number too long";
+ /* We use the first character to decide what type of number this is */
+
switch (*s) {
default:
- croak("panic: scan_num");
+ croak("panic: scan_num");
+
+ /* if it starts with a 0, it could be an octal number, a decimal in
+ 0.13 disguise, or a hexadecimal number.
+ */
case '0':
{
+ /* variables:
+ u holds the "number so far"
+ shift the power of 2 of the base (hex == 4, octal == 3)
+ overflowed was the number more than we can hold?
+
+ Shift is used when we add a digit. It also serves as an "are
+ we in octal or hex?" indicator to disallow hex characters when
+ in octal mode.
+ */
UV u;
I32 shift;
bool overflowed = FALSE;
+ /* check for hex */
if (s[1] == 'x') {
shift = 4;
s += 2;
}
+ /* check for a decimal in disguise */
else if (s[1] == '.')
goto decimal;
+ /* so it must be octal */
else
shift = 3;
u = 0;
+
+ /* read the rest of the octal number */
for (;;) {
- UV n, b;
+ UV n, b; /* n is used in the overflow test, b is the digit we're adding on */
switch (*s) {
+
+ /* if we don't mention it, we're done */
default:
goto out;
+
+ /* _ are ignored */
case '_':
s++;
break;
+
+ /* 8 and 9 are not octal */
case '8': case '9':
if (shift != 4)
yyerror("Illegal octal digit");
/* FALL THROUGH */
+
+ /* octal digits */
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7':
- b = *s++ & 15;
+ b = *s++ & 15; /* ASCII digit -> value of digit */
goto digit;
+
+ /* hex digits */
case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+ /* make sure they said 0x */
if (shift != 4)
goto out;
b = (*s++ & 7) + 9;
+
+ /* Prepare to put the digit we have onto the end
+ of the number so far. We check for overflows.
+ */
+
digit:
- n = u << shift;
- if (!overflowed && (n >> shift) != u) {
+ n = u << shift; /* make room for the digit */
+ if (!overflowed && (n >> shift) != u
+ && !(PL_hints & HINT_NEW_BINARY)) {
warn("Integer overflow in %s number",
(shift == 4) ? "hex" : "octal");
overflowed = TRUE;
}
- u = n | b;
+ u = n | b; /* add the digit to the end */
break;
}
}
+
+ /* if we get here, we had success: make a scalar value from
+ the number.
+ */
out:
sv = NEWSV(92,0);
sv_setuv(sv, u);
+ if ( PL_hints & HINT_NEW_BINARY)
+ sv = new_constant(start, s - start, "binary", sv, Nullsv, NULL);
}
break;
+
+ /*
+ handle decimal numbers.
+ we're also sent here when we read a 0 as the first digit
+ */
case '1': case '2': case '3': case '4': case '5':
case '6': case '7': case '8': case '9': case '.':
decimal:
- d = tokenbuf;
- e = tokenbuf + sizeof tokenbuf - 6; /* room for various punctuation */
+ d = PL_tokenbuf;
+ e = PL_tokenbuf + sizeof PL_tokenbuf - 6; /* room for various punctuation */
floatit = FALSE;
+
+ /* read next group of digits and _ and copy into d */
while (isDIGIT(*s) || *s == '_') {
+ /* skip underscores, checking for misplaced ones
+ if -w is on
+ */
if (*s == '_') {
- if (dowarn && lastub && s - lastub != 3)
+ if (PL_dowarn && lastub && s - lastub != 3)
warn("Misplaced _ in number");
lastub = ++s;
}
else {
+ /* check for end of fixed-length buffer */
if (d >= e)
croak(number_too_long);
+ /* if we're ok, copy the character */
*d++ = *s++;
}
}
- if (dowarn && lastub && s - lastub != 3)
+
+ /* final misplaced underbar check */
+ if (PL_dowarn && lastub && s - lastub != 3)
warn("Misplaced _ in number");
+
+ /* read a decimal portion if there is one. avoid
+ 3..5 being interpreted as the number 3. followed
+ by .5
+ */
if (*s == '.' && s[1] != '.') {
floatit = TRUE;
*d++ = *s++;
+
+ /* copy, ignoring underbars, until we run out of
+ digits. Note: no misplaced underbar checks!
+ */
for (; isDIGIT(*s) || *s == '_'; s++) {
+ /* fixed length buffer check */
if (d >= e)
croak(number_too_long);
if (*s != '_')
*d++ = *s;
}
}
+
+ /* read exponent part, if present */
if (*s && strchr("eE",*s) && strchr("+-0123456789",s[1])) {
floatit = TRUE;
s++;
+
+ /* regardless of whether user said 3E5 or 3e5, use lower 'e' */
*d++ = 'e'; /* At least some Mach atof()s don't grok 'E' */
+
+ /* allow positive or negative exponent */
if (*s == '+' || *s == '-')
*d++ = *s++;
+
+ /* read digits of exponent (no underbars :-) */
while (isDIGIT(*s)) {
if (d >= e)
croak(number_too_long);
*d++ = *s++;
}
}
+
+ /* terminate the string */
*d = '\0';
+
+ /* make an sv from the string */
sv = NEWSV(92,0);
+ /* reset numeric locale in case we were earlier left in Swaziland */
SET_NUMERIC_STANDARD();
- value = atof(tokenbuf);
+ value = atof(PL_tokenbuf);
+
+ /*
+ See if we can make do with an integer value without loss of
+ precision. We use I_V to cast to an int, because some
+ compilers have issues. Then we try casting it back and see
+ if it was the same. We only do this if we know we
+ specifically read an integer.
+
+ Note: if floatit is true, then we don't need to do the
+ conversion at all.
+ */
tryiv = I_V(value);
if (!floatit && (double)tryiv == value)
sv_setiv(sv, tryiv);
else
sv_setnv(sv, value);
+ if ( floatit ? (PL_hints & HINT_NEW_FLOAT) : (PL_hints & HINT_NEW_INTEGER) )
+ sv = new_constant(PL_tokenbuf, d - PL_tokenbuf,
+ (floatit ? "float" : "integer"), sv, Nullsv, NULL);
break;
}
+ /* make the op for the constant and return */
+
yylval.opval = newSVOP(OP_CONST, 0, sv);
return s;
}
-static char *
-scan_formline(s)
-register char *s;
+STATIC char *
+scan_formline(register char *s)
{
+ dTHR;
register char *eol;
register char *t;
SV *stuff = newSVpv("",0);
@@ -5178,17 +5971,21 @@ register char *s;
while (!needargs) {
if (*s == '.' || *s == '}') {
/*SUPPRESS 530*/
- for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
- if (*t == '\n')
+#ifdef PERL_STRICT_CR
+ for (t = s+1;*t == ' ' || *t == '\t'; t++) ;
+#else
+ for (t = s+1;*t == ' ' || *t == '\t' || *t == '\r'; t++) ;
+#endif
+ if (*t == '\n' || t == PL_bufend)
break;
}
- if (in_eval && !rsfp) {
+ if (PL_in_eval && !PL_rsfp) {
eol = strchr(s,'\n');
if (!eol++)
- eol = bufend;
+ eol = PL_bufend;
}
else
- eol = bufend = SvPVX(linestr) + SvCUR(linestr);
+ eol = PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
if (*s != '#') {
for (t = s; t < eol; t++) {
if (*t == '~' && t[1] == '~' && SvCUR(stuff)) {
@@ -5201,12 +5998,12 @@ register char *s;
sv_catpvn(stuff, s, eol-s);
}
s = eol;
- if (rsfp) {
- s = filter_gets(linestr, rsfp, 0);
- oldoldbufptr = oldbufptr = bufptr = linestart = SvPVX(linestr);
- bufend = bufptr + SvCUR(linestr);
+ if (PL_rsfp) {
+ s = filter_gets(PL_linestr, PL_rsfp, 0);
+ PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
+ PL_bufend = PL_bufptr + SvCUR(PL_linestr);
if (!s) {
- s = bufptr;
+ s = PL_bufptr;
yyerror("Format not terminated");
break;
}
@@ -5215,127 +6012,136 @@ register char *s;
}
enough:
if (SvCUR(stuff)) {
- expect = XTERM;
+ PL_expect = XTERM;
if (needargs) {
- lex_state = LEX_NORMAL;
- nextval[nexttoke].ival = 0;
+ PL_lex_state = LEX_NORMAL;
+ PL_nextval[PL_nexttoke].ival = 0;
force_next(',');
}
else
- lex_state = LEX_FORMLINE;
- nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, stuff);
+ PL_lex_state = LEX_FORMLINE;
+ PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, stuff);
force_next(THING);
- nextval[nexttoke].ival = OP_FORMLINE;
+ PL_nextval[PL_nexttoke].ival = OP_FORMLINE;
force_next(LSTOP);
}
else {
SvREFCNT_dec(stuff);
- lex_formbrack = 0;
- bufptr = s;
+ PL_lex_formbrack = 0;
+ PL_bufptr = s;
}
return s;
}
-static void
-set_csh()
+STATIC void
+set_csh(void)
{
#ifdef CSH
- if (!cshlen)
- cshlen = strlen(cshname);
+ if (!PL_cshlen)
+ PL_cshlen = strlen(PL_cshname);
#endif
}
I32
-start_subparse(is_format, flags)
-I32 is_format;
-U32 flags;
+start_subparse(I32 is_format, U32 flags)
{
- I32 oldsavestack_ix = savestack_ix;
- CV* outsidecv = compcv;
+ dTHR;
+ I32 oldsavestack_ix = PL_savestack_ix;
+ CV* outsidecv = PL_compcv;
AV* comppadlist;
- if (compcv) {
- assert(SvTYPE(compcv) == SVt_PVCV);
+ if (PL_compcv) {
+ assert(SvTYPE(PL_compcv) == SVt_PVCV);
}
- save_I32(&subline);
- save_item(subname);
- SAVEI32(padix);
- SAVESPTR(curpad);
- SAVESPTR(comppad);
- SAVESPTR(comppad_name);
- SAVESPTR(compcv);
- SAVEI32(comppad_name_fill);
- SAVEI32(min_intro_pending);
- SAVEI32(max_intro_pending);
- SAVEI32(pad_reset_pending);
-
- compcv = (CV*)NEWSV(1104,0);
- sv_upgrade((SV *)compcv, is_format ? SVt_PVFM : SVt_PVCV);
- CvFLAGS(compcv) |= flags;
-
- comppad = newAV();
- comppad_name = newAV();
- comppad_name_fill = 0;
- min_intro_pending = 0;
- av_push(comppad, Nullsv);
- curpad = AvARRAY(comppad);
- padix = 0;
- subline = curcop->cop_line;
+ save_I32(&PL_subline);
+ save_item(PL_subname);
+ SAVEI32(PL_padix);
+ SAVESPTR(PL_curpad);
+ SAVESPTR(PL_comppad);
+ SAVESPTR(PL_comppad_name);
+ SAVESPTR(PL_compcv);
+ SAVEI32(PL_comppad_name_fill);
+ SAVEI32(PL_min_intro_pending);
+ SAVEI32(PL_max_intro_pending);
+ SAVEI32(PL_pad_reset_pending);
+
+ PL_compcv = (CV*)NEWSV(1104,0);
+ sv_upgrade((SV *)PL_compcv, is_format ? SVt_PVFM : SVt_PVCV);
+ CvFLAGS(PL_compcv) |= flags;
+
+ PL_comppad = newAV();
+ av_push(PL_comppad, Nullsv);
+ PL_curpad = AvARRAY(PL_comppad);
+ PL_comppad_name = newAV();
+ PL_comppad_name_fill = 0;
+ PL_min_intro_pending = 0;
+ PL_padix = 0;
+ PL_subline = PL_curcop->cop_line;
+#ifdef USE_THREADS
+ av_store(PL_comppad_name, 0, newSVpv("@_", 2));
+ PL_curpad[0] = (SV*)newAV();
+ SvPADMY_on(PL_curpad[0]); /* XXX Needed? */
+#endif /* USE_THREADS */
comppadlist = newAV();
AvREAL_off(comppadlist);
- av_store(comppadlist, 0, (SV*)comppad_name);
- av_store(comppadlist, 1, (SV*)comppad);
+ av_store(comppadlist, 0, (SV*)PL_comppad_name);
+ av_store(comppadlist, 1, (SV*)PL_comppad);
- CvPADLIST(compcv) = comppadlist;
- CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)outsidecv);
+ CvPADLIST(PL_compcv) = comppadlist;
+ CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(outsidecv);
+#ifdef USE_THREADS
+ CvOWNER(PL_compcv) = 0;
+ New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);
+ MUTEX_INIT(CvMUTEXP(PL_compcv));
+#endif /* USE_THREADS */
return oldsavestack_ix;
}
int
-yywarn(s)
-char *s;
+yywarn(char *s)
{
- --error_count;
- in_eval |= 2;
+ dTHR;
+ --PL_error_count;
+ PL_in_eval |= 2;
yyerror(s);
- in_eval &= ~2;
+ PL_in_eval &= ~2;
return 0;
}
int
-yyerror(s)
-char *s;
+yyerror(char *s)
{
+ dTHR;
char *where = NULL;
char *context = NULL;
int contlen = -1;
SV *msg;
- if (!yychar || (yychar == ';' && !rsfp))
+ if (!yychar || (yychar == ';' && !PL_rsfp))
where = "at EOF";
- else if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
- oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
- while (isSPACE(*oldoldbufptr))
- oldoldbufptr++;
- context = oldoldbufptr;
- contlen = bufptr - oldoldbufptr;
+ else if (PL_bufptr > PL_oldoldbufptr && PL_bufptr - PL_oldoldbufptr < 200 &&
+ PL_oldoldbufptr != PL_oldbufptr && PL_oldbufptr != PL_bufptr) {
+ while (isSPACE(*PL_oldoldbufptr))
+ PL_oldoldbufptr++;
+ context = PL_oldoldbufptr;
+ contlen = PL_bufptr - PL_oldoldbufptr;
}
- else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
- oldbufptr != bufptr) {
- while (isSPACE(*oldbufptr))
- oldbufptr++;
- context = oldbufptr;
- contlen = bufptr - oldbufptr;
+ else if (PL_bufptr > PL_oldbufptr && PL_bufptr - PL_oldbufptr < 200 &&
+ PL_oldbufptr != PL_bufptr) {
+ while (isSPACE(*PL_oldbufptr))
+ PL_oldbufptr++;
+ context = PL_oldbufptr;
+ contlen = PL_bufptr - PL_oldbufptr;
}
else if (yychar > 255)
where = "next token ???";
else if ((yychar & 127) == 127) {
- if (lex_state == LEX_NORMAL ||
- (lex_state == LEX_KNOWNEXT && lex_defer == LEX_NORMAL))
+ if (PL_lex_state == LEX_NORMAL ||
+ (PL_lex_state == LEX_KNOWNEXT && PL_lex_defer == LEX_NORMAL))
where = "at end of line";
- else if (lex_inpat)
+ else if (PL_lex_inpat)
where = "within pattern";
else
where = "within string";
@@ -5352,25 +6158,28 @@ char *s;
}
msg = sv_2mortal(newSVpv(s, 0));
sv_catpvf(msg, " at %_ line %ld, ",
- GvSV(curcop->cop_filegv), (long)curcop->cop_line);
+ GvSV(PL_curcop->cop_filegv), (long)PL_curcop->cop_line);
if (context)
sv_catpvf(msg, "near \"%.*s\"\n", contlen, context);
else
sv_catpvf(msg, "%s\n", where);
- if (multi_start < multi_end && (U32)(curcop->cop_line - multi_end) <= 1) {
+ if (PL_multi_start < PL_multi_end && (U32)(PL_curcop->cop_line - PL_multi_end) <= 1) {
sv_catpvf(msg,
" (Might be a runaway multi-line %c%c string starting on line %ld)\n",
- (int)multi_open,(int)multi_close,(long)multi_start);
- multi_end = 0;
+ (int)PL_multi_open,(int)PL_multi_close,(long)PL_multi_start);
+ PL_multi_end = 0;
}
- if (in_eval & 2)
+ if (PL_in_eval & 2)
warn("%_", msg);
- else if (in_eval)
- sv_catsv(GvSV(errgv), msg);
+ else if (PL_in_eval)
+ sv_catsv(ERRSV, msg);
else
PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
- if (++error_count >= 10)
- croak("%_ has too many errors.\n", GvSV(curcop->cop_filegv));
- in_my = 0;
+ if (++PL_error_count >= 10)
+ croak("%_ has too many errors.\n", GvSV(PL_curcop->cop_filegv));
+ PL_in_my = 0;
+ PL_in_my_stash = Nullhv;
return 0;
}
+
+
diff --git a/gnu/usr.bin/perl/universal.c b/gnu/usr.bin/perl/universal.c
index d6689f8acf9..aba150e7f0a 100644
--- a/gnu/usr.bin/perl/universal.c
+++ b/gnu/usr.bin/perl/universal.c
@@ -1,18 +1,13 @@
#include "EXTERN.h"
#include "perl.h"
-#include "XSUB.h"
/*
* Contributed by Graham Barr <Graham.Barr@tiuk.ti.com>
* The main guts of traverse_isa was actually copied from gv_fetchmeth
*/
-static SV *
-isa_lookup(stash, name, len, level)
-HV *stash;
-char *name;
-int len;
-int level;
+STATIC SV *
+isa_lookup(HV *stash, char *name, int len, int level)
{
AV* av;
GV* gv;
@@ -20,26 +15,26 @@ int level;
HV* hv = Nullhv;
if (!stash)
- return &sv_undef;
+ return &PL_sv_undef;
if(strEQ(HvNAME(stash), name))
- return &sv_yes;
+ return &PL_sv_yes;
if (level > 100)
- croak("Recursive inheritance detected");
+ croak("Recursive inheritance detected in package '%s'", HvNAME(stash));
gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, FALSE);
- if (gvp && (gv = *gvp) != (GV*)&sv_undef && (hv = GvHV(gv))) {
+ if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (hv = GvHV(gv))) {
SV* sv;
SV** svp = (SV**)hv_fetch(hv, name, len, FALSE);
- if (svp && (sv = *svp) != (SV*)&sv_undef)
+ if (svp && (sv = *svp) != (SV*)&PL_sv_undef)
return sv;
}
gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
- if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
+ if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
if(!hv) {
gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, TRUE);
@@ -52,22 +47,23 @@ int level;
}
if(hv) {
SV** svp = AvARRAY(av);
- I32 items = AvFILL(av) + 1;
+ /* NOTE: No support for tied ISA */
+ I32 items = AvFILLp(av) + 1;
while (items--) {
SV* sv = *svp++;
HV* basestash = gv_stashsv(sv, FALSE);
if (!basestash) {
- if (dowarn)
+ if (PL_dowarn)
warn("Can't locate package %s for @%s::ISA",
SvPVX(sv), HvNAME(stash));
continue;
}
- if(&sv_yes == isa_lookup(basestash, name, len, level + 1)) {
- (void)hv_store(hv,name,len,&sv_yes,0);
- return &sv_yes;
+ if(&PL_sv_yes == isa_lookup(basestash, name, len, level + 1)) {
+ (void)hv_store(hv,name,len,&PL_sv_yes,0);
+ return &PL_sv_yes;
}
}
- (void)hv_store(hv,name,len,&sv_no,0);
+ (void)hv_store(hv,name,len,&PL_sv_no,0);
}
}
@@ -75,9 +71,7 @@ int level;
}
bool
-sv_derived_from(sv, name)
-SV * sv ;
-char * name ;
+sv_derived_from(SV *sv, char *name)
{
SV *rv;
char *type;
@@ -100,31 +94,35 @@ char * name ;
}
return (type && strEQ(type,name)) ||
- (stash && isa_lookup(stash, name, strlen(name), 0) == &sv_yes)
+ (stash && isa_lookup(stash, name, strlen(name), 0) == &PL_sv_yes)
? TRUE
: FALSE ;
}
+#ifdef PERL_OBJECT
+#define NO_XSLOCKS
+#endif /* PERL_OBJECT */
+
+#include "XSUB.h"
-static
XS(XS_UNIVERSAL_isa)
{
dXSARGS;
SV *sv;
char *name;
+ STRLEN n_a;
if (items != 2)
croak("Usage: UNIVERSAL::isa(reference, kind)");
sv = ST(0);
- name = (char *)SvPV(ST(1),na);
+ name = (char *)SvPV(ST(1),n_a);
ST(0) = boolSV(sv_derived_from(sv, name));
XSRETURN(1);
}
-static
XS(XS_UNIVERSAL_can)
{
dXSARGS;
@@ -132,13 +130,14 @@ XS(XS_UNIVERSAL_can)
char *name;
SV *rv;
HV *pkg = NULL;
+ STRLEN n_a;
if (items != 2)
croak("Usage: UNIVERSAL::can(object-ref, method)");
sv = ST(0);
- name = (char *)SvPV(ST(1),na);
- rv = &sv_undef;
+ name = (char *)SvPV(ST(1),n_a);
+ rv = &PL_sv_undef;
if(SvROK(sv)) {
sv = (SV*)SvRV(sv);
@@ -159,7 +158,6 @@ XS(XS_UNIVERSAL_can)
XSRETURN(1);
}
-static
XS(XS_UNIVERSAL_VERSION)
{
dXSARGS;
@@ -182,28 +180,36 @@ XS(XS_UNIVERSAL_VERSION)
gvp = pkg ? (GV**)hv_fetch(pkg,"VERSION",7,FALSE) : Null(GV**);
- if (gvp && (gv = *gvp) != (GV*)&sv_undef && (sv = GvSV(gv))) {
+ if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (sv = GvSV(gv))) {
SV *nsv = sv_newmortal();
sv_setsv(nsv, sv);
sv = nsv;
undef = Nullch;
}
else {
- sv = (SV*)&sv_undef;
+ sv = (SV*)&PL_sv_undef;
undef = "(undef)";
}
- if (items > 1 && (undef || (req = SvNV(ST(1)), req > SvNV(sv))))
+ if (items > 1 && (undef || (req = SvNV(ST(1)), req > SvNV(sv)))) {
+ STRLEN n_a;
croak("%s version %s required--this is only version %s",
- HvNAME(pkg), SvPV(ST(1),na), undef ? undef : SvPV(sv,na));
+ HvNAME(pkg), SvPV(ST(1),n_a), undef ? undef : SvPV(sv,n_a));
+ }
ST(0) = sv;
XSRETURN(1);
}
+#ifdef PERL_OBJECT
+#undef boot_core_UNIVERSAL
+#define boot_core_UNIVERSAL CPerlObj::Perl_boot_core_UNIVERSAL
+#define pPerl this
+#endif
+
void
-boot_core_UNIVERSAL()
+boot_core_UNIVERSAL(void)
{
char *file = __FILE__;
diff --git a/gnu/usr.bin/perl/unixish.h b/gnu/usr.bin/perl/unixish.h
index a13e2bd86a5..5bcff33242f 100644
--- a/gnu/usr.bin/perl/unixish.h
+++ b/gnu/usr.bin/perl/unixish.h
@@ -18,16 +18,16 @@
#define HAS_UTIME / **/
/* HAS_GROUP
- * This symbol, if defined, indicates that the getgrnam(),
- * getgrgid(), and getgrent() routines are available to
- * get group entries.
+ * This symbol, if defined, indicates that the getgrnam() and
+ * getgrgid() routines are available to get group entries.
+ * The getgrent() has a separate definition, HAS_GETGRENT.
*/
#define HAS_GROUP / **/
/* HAS_PASSWD
- * This symbol, if defined, indicates that the getpwnam(),
- * getpwuid(), and getpwent() routines are available to
- * get password entries.
+ * This symbol, if defined, indicates that the getpwnam() and
+ * getpwuid() routines are available to get password entries.
+ * The getpwent() has a separate definition, HAS_GETPWENT.
*/
#define HAS_PASSWD / **/
@@ -42,6 +42,14 @@
*/
#undef USEMYBINMODE
+/* Stat_t:
+ * This symbol holds the type used to declare buffers for information
+ * returned by stat(). It's usually just struct stat. It may be necessary
+ * to include <sys/stat.h> and <sys/types.h> to get any typedef'ed
+ * information.
+ */
+#define Stat_t struct stat
+
/* USE_STAT_RDEV:
* This symbol is defined if this system has a stat structure declaring
* st_rdev
@@ -81,7 +89,7 @@
*/
/* #define ALTERNATE_SHEBANG "#!" / **/
-#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) || defined(__NetBSD__)
# include <signal.h>
#endif
@@ -109,14 +117,14 @@
#ifndef PERL_SYS_INIT
#ifdef PERL_SCO5
/* this should be set in a hint file, not here */
-# define PERL_SYS_INIT(c,v) fpsetmask(0)
+# define PERL_SYS_INIT(c,v) fpsetmask(0); MALLOC_INIT
#else
-# define PERL_SYS_INIT(c,v)
+# define PERL_SYS_INIT(c,v) MALLOC_INIT
#endif
#endif
#ifndef PERL_SYS_TERM
-#define PERL_SYS_TERM()
+#define PERL_SYS_TERM() MALLOC_TERM
#endif
#define BIT_BUCKET "/dev/null"
diff --git a/gnu/usr.bin/perl/util.c b/gnu/usr.bin/perl/util.c
index 819ab4ec347..39f5f7a9ec6 100644
--- a/gnu/usr.bin/perl/util.c
+++ b/gnu/usr.bin/perl/util.c
@@ -1,6 +1,6 @@
/* util.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
@@ -53,7 +53,13 @@
#define FLUSH
#ifdef LEAKTEST
-static void xstat _((void));
+
+static void xstat _((int));
+long xcount[MAXXCOUNT];
+long lastxcount[MAXXCOUNT];
+long xycount[MAXXCOUNT][MAXYCOUNT];
+long lastxycount[MAXXCOUNT][MAXYCOUNT];
+
#endif
#ifndef MYMALLOC
@@ -67,8 +73,7 @@ static void xstat _((void));
*/
Malloc_t
-safemalloc(size)
-MEM_SIZE size;
+safemalloc(MEM_SIZE size)
{
Malloc_t ptr;
#ifdef HAS_64K_LIMIT
@@ -81,19 +86,20 @@ MEM_SIZE size;
if ((long)size < 0)
croak("panic: malloc");
#endif
- ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */
+ ptr = PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */
#if !(defined(I286) || defined(atarist))
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%x: (%05d) malloc %ld bytes\n",ptr,an++,(long)size));
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%x: (%05d) malloc %ld bytes\n",ptr,PL_an++,(long)size));
#else
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) malloc %ld bytes\n",ptr,an++,(long)size));
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) malloc %ld bytes\n",ptr,PL_an++,(long)size));
#endif
if (ptr != Nullch)
return ptr;
- else if (nomemok)
+ else if (PL_nomemok)
return Nullch;
else {
PerlIO_puts(PerlIO_stderr(),no_mem) FLUSH;
my_exit(1);
+ return Nullch;
}
/*NOTREACHED*/
}
@@ -101,13 +107,11 @@ MEM_SIZE size;
/* paranoid version of realloc */
Malloc_t
-saferealloc(where,size)
-Malloc_t where;
-MEM_SIZE size;
+saferealloc(Malloc_t where,MEM_SIZE size)
{
Malloc_t ptr;
#if !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE)
- Malloc_t realloc();
+ Malloc_t PerlMem_realloc();
#endif /* !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE) */
#ifdef HAS_64K_LIMIT
@@ -117,33 +121,39 @@ MEM_SIZE size;
my_exit(1);
}
#endif /* HAS_64K_LIMIT */
+ if (!size) {
+ safefree(where);
+ return NULL;
+ }
+
if (!where)
- croak("Null realloc");
+ return safemalloc(size);
#ifdef DEBUGGING
if ((long)size < 0)
croak("panic: realloc");
#endif
- ptr = realloc(where,size?size:1); /* realloc(0) is NASTY on our system */
+ ptr = PerlMem_realloc(where,size);
#if !(defined(I286) || defined(atarist))
DEBUG_m( {
- PerlIO_printf(Perl_debug_log, "0x%x: (%05d) rfree\n",where,an++);
- PerlIO_printf(Perl_debug_log, "0x%x: (%05d) realloc %ld bytes\n",ptr,an++,(long)size);
+ PerlIO_printf(Perl_debug_log, "0x%x: (%05d) rfree\n",where,PL_an++);
+ PerlIO_printf(Perl_debug_log, "0x%x: (%05d) realloc %ld bytes\n",ptr,PL_an++,(long)size);
} )
#else
DEBUG_m( {
- PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) rfree\n",where,an++);
- PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) realloc %ld bytes\n",ptr,an++,(long)size);
+ PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) rfree\n",where,PL_an++);
+ PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) realloc %ld bytes\n",ptr,PL_an++,(long)size);
} )
#endif
if (ptr != Nullch)
return ptr;
- else if (nomemok)
+ else if (PL_nomemok)
return Nullch;
else {
PerlIO_puts(PerlIO_stderr(),no_mem) FLUSH;
my_exit(1);
+ return Nullch;
}
/*NOTREACHED*/
}
@@ -151,26 +161,23 @@ MEM_SIZE size;
/* safe version of free */
Free_t
-safefree(where)
-Malloc_t where;
+safefree(Malloc_t where)
{
#if !(defined(I286) || defined(atarist))
- DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%x: (%05d) free\n",where,an++));
+ DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%x: (%05d) free\n",(char *) where,PL_an++));
#else
- DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) free\n",where,an++));
+ DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) free\n",(char *) where,PL_an++));
#endif
if (where) {
/*SUPPRESS 701*/
- free(where);
+ PerlMem_free(where);
}
}
/* safe version of calloc */
Malloc_t
-safecalloc(count, size)
-MEM_SIZE count;
-MEM_SIZE size;
+safecalloc(MEM_SIZE count, MEM_SIZE size)
{
Malloc_t ptr;
@@ -186,21 +193,22 @@ MEM_SIZE size;
croak("panic: calloc");
#endif
size *= count;
- ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */
+ ptr = PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */
#if !(defined(I286) || defined(atarist))
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%x: (%05d) calloc %ld x %ld bytes\n",ptr,an++,(long)count,(long)size));
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%x: (%05d) calloc %ld x %ld bytes\n",ptr,PL_an++,(long)count,(long)size));
#else
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) calloc %ld x %ld bytes\n",ptr,an++,(long)count,(long)size));
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) calloc %ld x %ld bytes\n",ptr,PL_an++,(long)count,(long)size));
#endif
if (ptr != Nullch) {
memset((void*)ptr, 0, size);
return ptr;
}
- else if (nomemok)
+ else if (PL_nomemok)
return Nullch;
else {
PerlIO_puts(PerlIO_stderr(),no_mem) FLUSH;
my_exit(1);
+ return Nullch;
}
/*NOTREACHED*/
}
@@ -209,71 +217,141 @@ MEM_SIZE size;
#ifdef LEAKTEST
-#define ALIGN sizeof(long)
+struct mem_test_strut {
+ union {
+ long type;
+ char c[2];
+ } u;
+ long size;
+};
+
+# define ALIGN sizeof(struct mem_test_strut)
+
+# define sizeof_chunk(ch) (((struct mem_test_strut*) (ch))->size)
+# define typeof_chunk(ch) \
+ (((struct mem_test_strut*) (ch))->u.c[0] + ((struct mem_test_strut*) (ch))->u.c[1]*100)
+# define set_typeof_chunk(ch,t) \
+ (((struct mem_test_strut*) (ch))->u.c[0] = t % 100, ((struct mem_test_strut*) (ch))->u.c[1] = t / 100)
+#define SIZE_TO_Y(size) ( (size) > MAXY_SIZE \
+ ? MAXYCOUNT - 1 \
+ : ( (size) > 40 \
+ ? ((size) - 1)/8 + 5 \
+ : ((size) - 1)/4))
Malloc_t
-safexmalloc(x,size)
-I32 x;
-MEM_SIZE size;
+safexmalloc(I32 x, MEM_SIZE size)
{
- register Malloc_t where;
+ register char* where = (char*)safemalloc(size + ALIGN);
- where = safemalloc(size + ALIGN);
- xcount[x]++;
- where[0] = x % 100;
- where[1] = x / 100;
- return where + ALIGN;
+ xcount[x] += size;
+ xycount[x][SIZE_TO_Y(size)]++;
+ set_typeof_chunk(where, x);
+ sizeof_chunk(where) = size;
+ return (Malloc_t)(where + ALIGN);
}
Malloc_t
-safexrealloc(where,size)
-Malloc_t where;
-MEM_SIZE size;
+safexrealloc(Malloc_t wh, MEM_SIZE size)
{
- register Malloc_t new = saferealloc(where - ALIGN, size + ALIGN);
- return new + ALIGN;
+ char *where = (char*)wh;
+
+ if (!wh)
+ return safexmalloc(0,size);
+
+ {
+ MEM_SIZE old = sizeof_chunk(where - ALIGN);
+ int t = typeof_chunk(where - ALIGN);
+ register char* new = (char*)saferealloc(where - ALIGN, size + ALIGN);
+
+ xycount[t][SIZE_TO_Y(old)]--;
+ xycount[t][SIZE_TO_Y(size)]++;
+ xcount[t] += size - old;
+ sizeof_chunk(new) = size;
+ return (Malloc_t)(new + ALIGN);
+ }
}
void
-safexfree(where)
-Malloc_t where;
+safexfree(Malloc_t wh)
{
I32 x;
-
+ char *where = (char*)wh;
+ MEM_SIZE size;
+
if (!where)
return;
where -= ALIGN;
+ size = sizeof_chunk(where);
x = where[0] + 100 * where[1];
- xcount[x]--;
+ xcount[x] -= size;
+ xycount[x][SIZE_TO_Y(size)]--;
safefree(where);
}
Malloc_t
-safexcalloc(x,count,size)
-I32 x;
-MEM_SIZE count;
-MEM_SIZE size;
+safexcalloc(I32 x,MEM_SIZE count, MEM_SIZE size)
{
- register Malloc_t where;
-
- where = safexmalloc(x, size * count + ALIGN);
- xcount[x]++;
- memset((void*)where + ALIGN, 0, size * count);
- where[0] = x % 100;
- where[1] = x / 100;
- return where + ALIGN;
+ register char * where = (char*)safexmalloc(x, size * count + ALIGN);
+ xcount[x] += size;
+ xycount[x][SIZE_TO_Y(size)]++;
+ memset((void*)(where + ALIGN), 0, size * count);
+ set_typeof_chunk(where, x);
+ sizeof_chunk(where) = size;
+ return (Malloc_t)(where + ALIGN);
}
static void
-xstat()
+xstat(int flag)
{
- register I32 i;
+ register I32 i, j, total = 0;
+ I32 subtot[MAXYCOUNT];
+ for (j = 0; j < MAXYCOUNT; j++) {
+ subtot[j] = 0;
+ }
+
+ PerlIO_printf(PerlIO_stderr(), " Id subtot 4 8 12 16 20 24 28 32 36 40 48 56 64 72 80 80+\n", total);
for (i = 0; i < MAXXCOUNT; i++) {
- if (xcount[i] > lastxcount[i]) {
- PerlIO_printf(PerlIO_stderr(),"%2d %2d\t%ld\n", i / 100, i % 100, xcount[i]);
+ total += xcount[i];
+ for (j = 0; j < MAXYCOUNT; j++) {
+ subtot[j] += xycount[i][j];
+ }
+ if (flag == 0
+ ? xcount[i] /* Have something */
+ : (flag == 2
+ ? xcount[i] != lastxcount[i] /* Changed */
+ : xcount[i] > lastxcount[i])) { /* Growed */
+ PerlIO_printf(PerlIO_stderr(),"%2d %02d %7ld ", i / 100, i % 100,
+ flag == 2 ? xcount[i] - lastxcount[i] : xcount[i]);
lastxcount[i] = xcount[i];
+ for (j = 0; j < MAXYCOUNT; j++) {
+ if ( flag == 0
+ ? xycount[i][j] /* Have something */
+ : (flag == 2
+ ? xycount[i][j] != lastxycount[i][j] /* Changed */
+ : xycount[i][j] > lastxycount[i][j])) { /* Growed */
+ PerlIO_printf(PerlIO_stderr(),"%3ld ",
+ flag == 2
+ ? xycount[i][j] - lastxycount[i][j]
+ : xycount[i][j]);
+ lastxycount[i][j] = xycount[i][j];
+ } else {
+ PerlIO_printf(PerlIO_stderr(), " . ", xycount[i][j]);
+ }
+ }
+ PerlIO_printf(PerlIO_stderr(), "\n");
+ }
+ }
+ if (flag != 2) {
+ PerlIO_printf(PerlIO_stderr(), "Total %7ld ", total);
+ for (j = 0; j < MAXYCOUNT; j++) {
+ if (subtot[j]) {
+ PerlIO_printf(PerlIO_stderr(), "%3ld ", subtot[j]);
+ } else {
+ PerlIO_printf(PerlIO_stderr(), " . ");
+ }
}
+ PerlIO_printf(PerlIO_stderr(), "\n");
}
}
@@ -282,13 +360,7 @@ xstat()
/* copy a string up to some (non-backslashed) delimiter, if any */
char *
-delimcpy(to, toend, from, fromend, delim, retlen)
-register char *to;
-register char *toend;
-register char *from;
-register char *fromend;
-register int delim;
-I32 *retlen;
+delimcpy(register char *to, register char *toend, register char *from, register char *fromend, register int delim, I32 *retlen)
{
register I32 tolen;
for (tolen = 0; from < fromend; from++, tolen++) {
@@ -317,9 +389,7 @@ I32 *retlen;
/* This routine was donated by Corey Satten. */
char *
-instr(big, little)
-register char *big;
-register char *little;
+instr(register char *big, register char *little)
{
register char *s, *x;
register I32 first;
@@ -349,11 +419,7 @@ register char *little;
/* same as instr but allow embedded nulls */
char *
-ninstr(big, bigend, little, lend)
-register char *big;
-register char *bigend;
-char *little;
-char *lend;
+ninstr(register char *big, register char *bigend, char *little, char *lend)
{
register char *s, *x;
register I32 first = *little;
@@ -382,11 +448,7 @@ char *lend;
/* reverse of the above--find last substring */
char *
-rninstr(big, bigend, little, lend)
-register char *big;
-char *bigend;
-char *little;
-char *lend;
+rninstr(register char *big, char *bigend, char *little, char *lend)
{
register char *bigbeg;
register char *s, *x;
@@ -416,8 +478,7 @@ char *lend;
* Set up for a new ctype locale.
*/
void
-perl_new_ctype(newctype)
- char *newctype;
+perl_new_ctype(char *newctype)
{
#ifdef USE_LOCALE_CTYPE
@@ -439,28 +500,27 @@ perl_new_ctype(newctype)
* Set up for a new collation locale.
*/
void
-perl_new_collate(newcoll)
- char *newcoll;
+perl_new_collate(char *newcoll)
{
#ifdef USE_LOCALE_COLLATE
if (! newcoll) {
- if (collation_name) {
- ++collation_ix;
- Safefree(collation_name);
- collation_name = NULL;
- collation_standard = TRUE;
- collxfrm_base = 0;
- collxfrm_mult = 2;
+ if (PL_collation_name) {
+ ++PL_collation_ix;
+ Safefree(PL_collation_name);
+ PL_collation_name = NULL;
+ PL_collation_standard = TRUE;
+ PL_collxfrm_base = 0;
+ PL_collxfrm_mult = 2;
}
return;
}
- if (! collation_name || strNE(collation_name, newcoll)) {
- ++collation_ix;
- Safefree(collation_name);
- collation_name = savepv(newcoll);
- collation_standard = (strEQ(newcoll, "C") || strEQ(newcoll, "POSIX"));
+ if (! PL_collation_name || strNE(PL_collation_name, newcoll)) {
+ ++PL_collation_ix;
+ Safefree(PL_collation_name);
+ PL_collation_name = savepv(newcoll);
+ PL_collation_standard = (strEQ(newcoll, "C") || strEQ(newcoll, "POSIX"));
{
/* 2: at most so many chars ('a', 'b'). */
@@ -472,8 +532,8 @@ perl_new_collate(newcoll)
SSize_t mult = fb - fa;
if (mult < 1)
croak("strxfrm() gets absurd");
- collxfrm_base = (fa > mult) ? (fa - mult) : 0;
- collxfrm_mult = mult;
+ PL_collxfrm_base = (fa > mult) ? (fa - mult) : 0;
+ PL_collxfrm_mult = mult;
}
}
@@ -484,54 +544,53 @@ perl_new_collate(newcoll)
* Set up for a new numeric locale.
*/
void
-perl_new_numeric(newnum)
- char *newnum;
+perl_new_numeric(char *newnum)
{
#ifdef USE_LOCALE_NUMERIC
if (! newnum) {
- if (numeric_name) {
- Safefree(numeric_name);
- numeric_name = NULL;
- numeric_standard = TRUE;
- numeric_local = TRUE;
+ if (PL_numeric_name) {
+ Safefree(PL_numeric_name);
+ PL_numeric_name = NULL;
+ PL_numeric_standard = TRUE;
+ PL_numeric_local = TRUE;
}
return;
}
- if (! numeric_name || strNE(numeric_name, newnum)) {
- Safefree(numeric_name);
- numeric_name = savepv(newnum);
- numeric_standard = (strEQ(newnum, "C") || strEQ(newnum, "POSIX"));
- numeric_local = TRUE;
+ if (! PL_numeric_name || strNE(PL_numeric_name, newnum)) {
+ Safefree(PL_numeric_name);
+ PL_numeric_name = savepv(newnum);
+ PL_numeric_standard = (strEQ(newnum, "C") || strEQ(newnum, "POSIX"));
+ PL_numeric_local = TRUE;
}
#endif /* USE_LOCALE_NUMERIC */
}
void
-perl_set_numeric_standard()
+perl_set_numeric_standard(void)
{
#ifdef USE_LOCALE_NUMERIC
- if (! numeric_standard) {
+ if (! PL_numeric_standard) {
setlocale(LC_NUMERIC, "C");
- numeric_standard = TRUE;
- numeric_local = FALSE;
+ PL_numeric_standard = TRUE;
+ PL_numeric_local = FALSE;
}
#endif /* USE_LOCALE_NUMERIC */
}
void
-perl_set_numeric_local()
+perl_set_numeric_local(void)
{
#ifdef USE_LOCALE_NUMERIC
- if (! numeric_local) {
- setlocale(LC_NUMERIC, numeric_name);
- numeric_standard = FALSE;
- numeric_local = TRUE;
+ if (! PL_numeric_local) {
+ setlocale(LC_NUMERIC, PL_numeric_name);
+ PL_numeric_standard = FALSE;
+ PL_numeric_local = TRUE;
}
#endif /* USE_LOCALE_NUMERIC */
@@ -542,8 +601,7 @@ perl_set_numeric_local()
* Initialize locale awareness.
*/
int
-perl_init_i18nl10n(printwarn)
- int printwarn;
+perl_init_i18nl10n(int printwarn)
{
int ok = 1;
/* returns
@@ -563,8 +621,11 @@ perl_init_i18nl10n(printwarn)
#ifdef USE_LOCALE_NUMERIC
char *curnum = NULL;
#endif /* USE_LOCALE_NUMERIC */
- char *lc_all = getenv("LC_ALL");
- char *lang = getenv("LANG");
+#ifdef __GLIBC__
+ char *language = PerlEnv_getenv("LANGUAGE");
+#endif
+ char *lc_all = PerlEnv_getenv("LC_ALL");
+ char *lang = PerlEnv_getenv("LANG");
bool setlocale_failure = FALSE;
#ifdef LOCALE_ENVIRON_REQUIRED
@@ -583,71 +644,59 @@ perl_init_i18nl10n(printwarn)
else
setlocale_failure = TRUE;
}
- if (!setlocale_failure)
-#endif /* LC_ALL */
- {
+ if (!setlocale_failure) {
#ifdef USE_LOCALE_CTYPE
- if (! (curctype = setlocale(LC_CTYPE,
- (!done && (lang || getenv("LC_CTYPE")))
+ if (! (curctype =
+ setlocale(LC_CTYPE,
+ (!done && (lang || PerlEnv_getenv("LC_CTYPE")))
? "" : Nullch)))
setlocale_failure = TRUE;
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
- if (! (curcoll = setlocale(LC_COLLATE,
- (!done && (lang || getenv("LC_COLLATE")))
+ if (! (curcoll =
+ setlocale(LC_COLLATE,
+ (!done && (lang || PerlEnv_getenv("LC_COLLATE")))
? "" : Nullch)))
setlocale_failure = TRUE;
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
- if (! (curnum = setlocale(LC_NUMERIC,
- (!done && (lang || getenv("LC_NUMERIC")))
+ if (! (curnum =
+ setlocale(LC_NUMERIC,
+ (!done && (lang || PerlEnv_getenv("LC_NUMERIC")))
? "" : Nullch)))
setlocale_failure = TRUE;
#endif /* USE_LOCALE_NUMERIC */
}
-#else /* !LOCALE_ENVIRON_REQUIRED */
+#endif /* LC_ALL */
-#ifdef LC_ALL
+#endif /* !LOCALE_ENVIRON_REQUIRED */
+#ifdef LC_ALL
if (! setlocale(LC_ALL, ""))
setlocale_failure = TRUE;
- else {
-#ifdef USE_LOCALE_CTYPE
- curctype = setlocale(LC_CTYPE, Nullch);
-#endif /* USE_LOCALE_CTYPE */
-#ifdef USE_LOCALE_COLLATE
- curcoll = setlocale(LC_COLLATE, Nullch);
-#endif /* USE_LOCALE_COLLATE */
-#ifdef USE_LOCALE_NUMERIC
- curnum = setlocale(LC_NUMERIC, Nullch);
-#endif /* USE_LOCALE_NUMERIC */
- }
-
-#else /* !LC_ALL */
+#endif /* LC_ALL */
+ if (!setlocale_failure) {
#ifdef USE_LOCALE_CTYPE
- if (! (curctype = setlocale(LC_CTYPE, "")))
- setlocale_failure = TRUE;
+ if (! (curctype = setlocale(LC_CTYPE, "")))
+ setlocale_failure = TRUE;
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
- if (! (curcoll = setlocale(LC_COLLATE, "")))
- setlocale_failure = TRUE;
+ if (! (curcoll = setlocale(LC_COLLATE, "")))
+ setlocale_failure = TRUE;
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
- if (! (curnum = setlocale(LC_NUMERIC, "")))
- setlocale_failure = TRUE;
+ if (! (curnum = setlocale(LC_NUMERIC, "")))
+ setlocale_failure = TRUE;
#endif /* USE_LOCALE_NUMERIC */
-
-#endif /* LC_ALL */
-
-#endif /* !LOCALE_ENVIRON_REQUIRED */
+ }
if (setlocale_failure) {
char *p;
bool locwarn = (printwarn > 1 ||
printwarn &&
- (!(p = getenv("PERL_BADLANG")) || atoi(p)));
+ (!(p = PerlEnv_getenv("PERL_BADLANG")) || atoi(p)));
if (locwarn) {
#ifdef LC_ALL
@@ -678,6 +727,14 @@ perl_init_i18nl10n(printwarn)
PerlIO_printf(PerlIO_stderr(),
"perl: warning: Please check that your locale settings:\n");
+#ifdef __GLIBC__
+ PerlIO_printf(PerlIO_stderr(),
+ "\tLANGUAGE = %c%s%c,\n",
+ language ? '"' : '(',
+ language ? language : "unset",
+ language ? '"' : ')');
+#endif
+
PerlIO_printf(PerlIO_stderr(),
"\tLC_ALL = %c%s%c,\n",
lc_all ? '"' : '(',
@@ -772,8 +829,7 @@ perl_init_i18nl10n(printwarn)
/* Backwards compatibility. */
int
-perl_init_i18nl14n(printwarn)
- int printwarn;
+perl_init_i18nl14n(int printwarn)
{
return perl_init_i18nl10n(printwarn);
}
@@ -788,35 +844,32 @@ perl_init_i18nl14n(printwarn)
* Please see sv_collxfrm() to see how this is used.
*/
char *
-mem_collxfrm(s, len, xlen)
- const char *s;
- STRLEN len;
- STRLEN *xlen;
+mem_collxfrm(const char *s, STRLEN len, STRLEN *xlen)
{
char *xbuf;
- STRLEN xalloc, xin, xout;
+ STRLEN xAlloc, xin, xout; /* xalloc is a reserved word in VC */
/* the first sizeof(collationix) bytes are used by sv_collxfrm(). */
/* the +1 is for the terminating NUL. */
- xalloc = sizeof(collation_ix) + collxfrm_base + (collxfrm_mult * len) + 1;
- New(171, xbuf, xalloc, char);
+ xAlloc = sizeof(PL_collation_ix) + PL_collxfrm_base + (PL_collxfrm_mult * len) + 1;
+ New(171, xbuf, xAlloc, char);
if (! xbuf)
goto bad;
- *(U32*)xbuf = collation_ix;
- xout = sizeof(collation_ix);
+ *(U32*)xbuf = PL_collation_ix;
+ xout = sizeof(PL_collation_ix);
for (xin = 0; xin < len; ) {
SSize_t xused;
for (;;) {
- xused = strxfrm(xbuf + xout, s + xin, xalloc - xout);
+ xused = strxfrm(xbuf + xout, s + xin, xAlloc - xout);
if (xused == -1)
goto bad;
- if (xused < xalloc - xout)
+ if (xused < xAlloc - xout)
break;
- xalloc = (2 * xalloc) + 1;
- Renew(xbuf, xalloc, char);
+ xAlloc = (2 * xAlloc) + 1;
+ Renew(xbuf, xAlloc, char);
if (! xbuf)
goto bad;
}
@@ -829,7 +882,7 @@ mem_collxfrm(s, len, xlen)
}
xbuf[xout] = '\0';
- *xlen = xout - sizeof(collation_ix);
+ *xlen = xout - sizeof(PL_collation_ix);
return xbuf;
bad:
@@ -841,32 +894,34 @@ mem_collxfrm(s, len, xlen)
#endif /* USE_LOCALE_COLLATE */
void
-fbm_compile(sv)
-SV *sv;
+fbm_compile(SV *sv, U32 flags /* not used yet */)
{
- register unsigned char *s;
- register unsigned char *table;
+ register U8 *s;
+ register U8 *table;
register U32 i;
- register U32 len = SvCUR(sv);
+ STRLEN len;
I32 rarest = 0;
U32 frequency = 256;
- if (len > 255)
+ s = (U8*)SvPV_force(sv, len);
+ (void)SvUPGRADE(sv, SVt_PVBM);
+ if (len > 255 || len == 0) /* TAIL might be on on a zero-length string. */
return; /* can't have offsets that big */
- Sv_Grow(sv,len+258);
- table = (unsigned char*)(SvPVX(sv) + len + 1);
- s = table - 2;
- for (i = 0; i < 256; i++) {
- table[i] = len;
- }
- i = 0;
- while (s >= (unsigned char*)(SvPVX(sv)))
- {
- if (table[*s] == len)
- table[*s] = i;
- s--,i++;
+ if (len > 2) {
+ Sv_Grow(sv,len + 258);
+ table = (unsigned char*)(SvPVX(sv) + len + 1);
+ s = table - 2;
+ for (i = 0; i < 256; i++) {
+ table[i] = len;
+ }
+ i = 0;
+ while (s >= (unsigned char*)(SvPVX(sv)))
+ {
+ if (table[*s] == len)
+ table[*s] = i;
+ s--,i++;
+ }
}
- sv_upgrade(sv, SVt_PVBM);
sv_magic(sv, Nullsv, 'B', Nullch, 0); /* deep magic */
SvVALID_on(sv);
@@ -883,10 +938,7 @@ SV *sv;
}
char *
-fbm_instr(big, bigend, littlestr)
-unsigned char *big;
-register unsigned char *bigend;
-SV *littlestr;
+fbm_instr(unsigned char *big, register unsigned char *bigend, SV *littlestr, U32 flags)
{
register unsigned char *s;
register I32 tmp;
@@ -899,24 +951,58 @@ SV *littlestr;
if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) {
STRLEN len;
char *l = SvPV(littlestr,len);
- if (!len)
+ if (!len) {
+ if (SvTAIL(littlestr)) { /* Can be only 0-len constant
+ substr => we can ignore SvVALID */
+ if (PL_multiline) {
+ char *t = "\n";
+ if ((s = (unsigned char*)ninstr((char*)big, (char*)bigend,
+ t, t + len))) {
+ return (char*)s;
+ }
+ }
+ if (bigend > big && bigend[-1] == '\n')
+ return (char *)(bigend - 1);
+ else
+ return (char *) bigend;
+ }
return (char*)big;
+ }
return ninstr((char*)big,(char*)bigend, l, l + len);
}
littlelen = SvCUR(littlestr);
- if (SvTAIL(littlestr) && !multiline) { /* tail anchored? */
+ if (SvTAIL(littlestr) && !PL_multiline) { /* tail anchored? */
if (littlelen > bigend - big)
return Nullch;
little = (unsigned char*)SvPVX(littlestr);
s = bigend - littlelen;
- if (*s == *little && memEQ((char*)s,(char*)little,littlelen))
+ if (s > big
+ && bigend[-1] == '\n'
+ && s[-1] == *little && memEQ((char*)s - 1,(char*)little,littlelen))
+ return (char*)s - 1; /* how sweet it is */
+ else if (*s == *little && memEQ((char*)s,(char*)little,littlelen))
return (char*)s; /* how sweet it is */
- else if (bigend[-1] == '\n' && little[littlelen-1] != '\n'
- && s > big) {
- s--;
- if (*s == *little && memEQ((char*)s,(char*)little,littlelen))
+ return Nullch;
+ }
+ if (littlelen <= 2) {
+ unsigned char c1 = (unsigned char)SvPVX(littlestr)[0];
+ unsigned char c2 = (unsigned char)SvPVX(littlestr)[1];
+ /* This may do extra comparisons if littlelen == 2, but this
+ should be hidden in the noise since we do less indirection. */
+
+ s = big;
+ bigend -= littlelen;
+ while (s <= bigend) {
+ if (s[0] == c1
+ && (littlelen == 1 || s[1] == c2)
+ && (!SvTAIL(littlestr)
+ || s == bigend
+ || s[littlelen] == '\n')) /* Automatically multiline */
+ {
return (char*)s;
+ }
+ s++;
}
return Nullch;
}
@@ -946,83 +1032,106 @@ SV *littlestr;
while (tmp--) {
if (*--s == *--little)
continue;
+ differ:
s = olds + 1; /* here we pay the price for failure */
little = oldlittle;
if (s < bigend) /* fake up continue to outer loop */
goto top2;
return Nullch;
}
+ if (SvTAIL(littlestr) /* automatically multiline */
+ && olds + 1 != bigend
+ && olds[1] != '\n')
+ goto differ;
return (char *)s;
}
}
return Nullch;
}
+/* start_shift, end_shift are positive quantities which give offsets
+ of ends of some substring of bigstr.
+ If `last' we want the last occurence.
+ old_posp is the way of communication between consequent calls if
+ the next call needs to find the .
+ The initial *old_posp should be -1.
+ Note that we do not take into account SvTAIL, so it may give wrong
+ positives if _ALL flag is set.
+ */
+
char *
-screaminstr(bigstr, littlestr)
-SV *bigstr;
-SV *littlestr;
+screaminstr(SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift, I32 *old_posp, I32 last)
{
+ dTHR;
register unsigned char *s, *x;
register unsigned char *big;
register I32 pos;
register I32 previous;
register I32 first;
register unsigned char *little;
- register unsigned char *bigend;
+ register I32 stop_pos;
register unsigned char *littleend;
+ I32 found = 0;
- if ((pos = screamfirst[BmRARE(littlestr)]) < 0)
+ if (*old_posp == -1
+ ? (pos = PL_screamfirst[BmRARE(littlestr)]) < 0
+ : (((pos = *old_posp), pos += PL_screamnext[pos]) == 0))
return Nullch;
little = (unsigned char *)(SvPVX(littlestr));
littleend = little + SvCUR(littlestr);
first = *little++;
+ /* The value of pos we can start at: */
previous = BmPREVIOUS(littlestr);
big = (unsigned char *)(SvPVX(bigstr));
- bigend = big + SvCUR(bigstr);
- while (pos < previous) {
- if (!(pos += screamnext[pos]))
+ /* The value of pos we can stop at: */
+ stop_pos = SvCUR(bigstr) - end_shift - (SvCUR(littlestr) - 1 - previous);
+ if (previous + start_shift > stop_pos) return Nullch;
+ while (pos < previous + start_shift) {
+ if (!(pos += PL_screamnext[pos]))
return Nullch;
}
#ifdef POINTERRIGOR
do {
+ if (pos >= stop_pos) break;
if (big[pos-previous] != first)
continue;
for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
- if (x >= bigend)
- return Nullch;
if (*s++ != *x++) {
s--;
break;
}
}
- if (s == littleend)
- return (char *)(big+pos-previous);
- } while ( pos += screamnext[pos] );
+ if (s == littleend) {
+ *old_posp = pos;
+ if (!last) return (char *)(big+pos-previous);
+ found = 1;
+ }
+ } while ( pos += PL_screamnext[pos] );
+ return (last && found) ? (char *)(big+(*old_posp)-previous) : Nullch;
#else /* !POINTERRIGOR */
big -= previous;
do {
+ if (pos >= stop_pos) break;
if (big[pos] != first)
continue;
for (x=big+pos+1,s=little; s < littleend; /**/ ) {
- if (x >= bigend)
- return Nullch;
if (*s++ != *x++) {
s--;
break;
}
}
- if (s == littleend)
- return (char *)(big+pos);
- } while ( pos += screamnext[pos] );
+ if (s == littleend) {
+ *old_posp = pos;
+ if (!last) return (char *)(big+pos);
+ found = 1;
+ }
+ } while ( pos += PL_screamnext[pos] );
+ return (last && found) ? (char *)(big+(*old_posp)) : Nullch;
#endif /* POINTERRIGOR */
- return Nullch;
}
I32
-ibcmp(s1, s2, len)
-char *s1, *s2;
-register I32 len;
+ibcmp(char *s1, char *s2, register I32 len)
{
register U8 *a = (U8 *)s1;
register U8 *b = (U8 *)s2;
@@ -1035,9 +1144,7 @@ register I32 len;
}
I32
-ibcmp_locale(s1, s2, len)
-char *s1, *s2;
-register I32 len;
+ibcmp_locale(char *s1, char *s2, register I32 len)
{
register U8 *a = (U8 *)s1;
register U8 *b = (U8 *)s2;
@@ -1052,8 +1159,7 @@ register I32 len;
/* copy a string to a safe spot */
char *
-savepv(sv)
-char *sv;
+savepv(char *sv)
{
register char *newaddr;
@@ -1065,9 +1171,7 @@ char *sv;
/* same thing but with a known length */
char *
-savepvn(sv, len)
-char *sv;
-register I32 len;
+savepvn(char *sv, register I32 len)
{
register char *newaddr;
@@ -1079,8 +1183,8 @@ register I32 len;
/* the SV for form() and mess() is not kept in an arena */
-static SV *
-mess_alloc()
+STATIC SV *
+mess_alloc(void)
{
SV *sv;
XPVMG *any;
@@ -1094,56 +1198,43 @@ mess_alloc()
return sv;
}
-#ifdef I_STDARG
char *
form(const char* pat, ...)
-#else
-/*VARARGS0*/
-char *
-form(pat, va_alist)
- const char *pat;
- va_dcl
-#endif
{
va_list args;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
- if (!mess_sv)
- mess_sv = mess_alloc();
- sv_vsetpvfn(mess_sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ if (!PL_mess_sv)
+ PL_mess_sv = mess_alloc();
+ sv_vsetpvfn(PL_mess_sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
va_end(args);
- return SvPVX(mess_sv);
+ return SvPVX(PL_mess_sv);
}
char *
-mess(pat, args)
- const char *pat;
- va_list *args;
+mess(const char *pat, va_list *args)
{
SV *sv;
static char dgd[] = " during global destruction.\n";
- if (!mess_sv)
- mess_sv = mess_alloc();
- sv = mess_sv;
+ if (!PL_mess_sv)
+ PL_mess_sv = mess_alloc();
+ sv = PL_mess_sv;
sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
- if (dirty)
+ dTHR;
+ if (PL_dirty)
sv_catpv(sv, dgd);
else {
- if (curcop->cop_line)
+ if (PL_curcop->cop_line)
sv_catpvf(sv, " at %_ line %ld",
- GvSV(curcop->cop_filegv), (long)curcop->cop_line);
- if (GvIO(last_in_gv) && IoLINES(GvIOp(last_in_gv))) {
- bool line_mode = (RsSIMPLE(rs) &&
- SvLEN(rs) == 1 && *SvPVX(rs) == '\n');
+ GvSV(PL_curcop->cop_filegv), (long)PL_curcop->cop_line);
+ if (GvIO(PL_last_in_gv) && IoLINES(GvIOp(PL_last_in_gv))) {
+ bool line_mode = (RsSIMPLE(PL_rs) &&
+ SvLEN(PL_rs) == 1 && *SvPVX(PL_rs) == '\n');
sv_catpvf(sv, ", <%s> %s %ld",
- last_in_gv == argvgv ? "" : GvNAME(last_in_gv),
+ PL_last_in_gv == PL_argvgv ? "" : GvNAME(PL_last_in_gv),
line_mode ? "line" : "chunk",
- (long)IoLINES(GvIOp(last_in_gv)));
+ (long)IoLINES(GvIOp(PL_last_in_gv)));
}
sv_catpv(sv, ".\n");
}
@@ -1151,47 +1242,34 @@ mess(pat, args)
return SvPVX(sv);
}
-#ifdef I_STDARG
OP *
die(const char* pat, ...)
-#else
-/*VARARGS0*/
-OP *
-die(pat, va_alist)
- const char *pat;
- va_dcl
-#endif
{
+ dTHR;
va_list args;
char *message;
- I32 oldrunlevel = runlevel;
- int was_in_eval = in_eval;
+ int was_in_eval = PL_in_eval;
HV *stash;
GV *gv;
CV *cv;
- /* We have to switch back to mainstack or die_where may try to pop
- * the eval block from the wrong stack if die is being called from a
- * signal handler. - dkindred@cs.cmu.edu */
- if (curstack != mainstack) {
- dSP;
- SWITCHSTACK(curstack, mainstack);
- }
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ "%p: die: curstack = %p, mainstack = %p\n",
+ thr, PL_curstack, PL_mainstack));
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
- message = mess(pat, &args);
+ message = pat ? mess(pat, &args) : Nullch;
va_end(args);
- if (diehook) {
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ "%p: die: message = %s\ndiehook = %p\n",
+ thr, message, PL_diehook));
+ if (PL_diehook) {
/* sv_2cv might call croak() */
- SV *olddiehook = diehook;
+ SV *olddiehook = PL_diehook;
ENTER;
- SAVESPTR(diehook);
- diehook = Nullsv;
+ SAVESPTR(PL_diehook);
+ PL_diehook = Nullsv;
cv = sv_2cv(olddiehook, &stash, &gv, 0);
LEAVE;
if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
@@ -1199,55 +1277,54 @@ die(pat, va_alist)
SV *msg;
ENTER;
- msg = newSVpv(message, 0);
- SvREADONLY_on(msg);
- SAVEFREESV(msg);
+ if(message) {
+ msg = newSVpv(message, 0);
+ SvREADONLY_on(msg);
+ SAVEFREESV(msg);
+ }
+ else {
+ msg = ERRSV;
+ }
- PUSHMARK(sp);
+ PUSHSTACKi(PERLSI_DIEHOOK);
+ PUSHMARK(SP);
XPUSHs(msg);
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
-
+ POPSTACK;
LEAVE;
}
}
- restartop = die_where(message);
- if ((!restartop && was_in_eval) || oldrunlevel > 1)
+ PL_restartop = die_where(message);
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ "%p: die: restartop = %p, was_in_eval = %d, top_env = %p\n",
+ thr, PL_restartop, was_in_eval, PL_top_env));
+ if ((!PL_restartop && was_in_eval) || PL_top_env->je_prev)
JMPENV_JUMP(3);
- return restartop;
+ return PL_restartop;
}
-#ifdef I_STDARG
void
croak(const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-croak(pat, va_alist)
- char *pat;
- va_dcl
-#endif
{
+ dTHR;
va_list args;
char *message;
HV *stash;
GV *gv;
CV *cv;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
message = mess(pat, &args);
va_end(args);
- if (diehook) {
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(), "croak: 0x%lx %s", (unsigned long) thr, message));
+ if (PL_diehook) {
/* sv_2cv might call croak() */
- SV *olddiehook = diehook;
+ SV *olddiehook = PL_diehook;
ENTER;
- SAVESPTR(diehook);
- diehook = Nullsv;
+ SAVESPTR(PL_diehook);
+ PL_diehook = Nullsv;
cv = sv_2cv(olddiehook, &stash, &gv, 0);
LEAVE;
if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
@@ -1259,16 +1336,17 @@ croak(pat, va_alist)
SvREADONLY_on(msg);
SAVEFREESV(msg);
- PUSHMARK(sp);
+ PUSHSTACKi(PERLSI_DIEHOOK);
+ PUSHMARK(SP);
XPUSHs(msg);
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
-
+ POPSTACK;
LEAVE;
}
}
- if (in_eval) {
- restartop = die_where(message);
+ if (PL_in_eval) {
+ PL_restartop = die_where(message);
JMPENV_JUMP(3);
}
PerlIO_puts(PerlIO_stderr(),message);
@@ -1277,14 +1355,7 @@ croak(pat, va_alist)
}
void
-#ifdef I_STDARG
warn(const char* pat,...)
-#else
-/*VARARGS0*/
-warn(pat,va_alist)
- const char *pat;
- va_dcl
-#endif
{
va_list args;
char *message;
@@ -1292,20 +1363,17 @@ warn(pat,va_alist)
GV *gv;
CV *cv;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
message = mess(pat, &args);
va_end(args);
- if (warnhook) {
+ if (PL_warnhook) {
/* sv_2cv might call warn() */
- SV *oldwarnhook = warnhook;
+ dTHR;
+ SV *oldwarnhook = PL_warnhook;
ENTER;
- SAVESPTR(warnhook);
- warnhook = Nullsv;
+ SAVESPTR(PL_warnhook);
+ PL_warnhook = Nullsv;
cv = sv_2cv(oldwarnhook, &stash, &gv, 0);
LEAVE;
if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
@@ -1317,18 +1385,24 @@ warn(pat,va_alist)
SvREADONLY_on(msg);
SAVEFREESV(msg);
- PUSHMARK(sp);
+ PUSHSTACKi(PERLSI_WARNHOOK);
+ PUSHMARK(SP);
XPUSHs(msg);
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
-
+ POPSTACK;
LEAVE;
return;
}
}
PerlIO_puts(PerlIO_stderr(),message);
#ifdef LEAKTEST
- DEBUG_L(xstat());
+ DEBUG_L(*message == '!'
+ ? (xstat(message[1]=='!'
+ ? (message[2]=='!' ? 2 : 1)
+ : 0)
+ , 0)
+ : 0);
#endif
(void)PerlIO_flush(PerlIO_stderr());
}
@@ -1336,12 +1410,11 @@ warn(pat,va_alist)
#ifndef VMS /* VMS' my_setenv() is in VMS.c */
#ifndef WIN32
void
-my_setenv(nam,val)
-char *nam, *val;
+my_setenv(char *nam, char *val)
{
register I32 i=setenv_getix(nam); /* where does it go? */
- if (environ == origenviron) { /* need we copy environment? */
+ if (environ == PL_origenviron) { /* need we copy environment? */
I32 j;
I32 max;
char **tmpenv;
@@ -1385,8 +1458,7 @@ char *nam, *val;
#else /* if WIN32 */
void
-my_setenv(nam,val)
-char *nam, *val;
+my_setenv(char *nam,char *val)
{
#ifdef USE_WIN32_RTL_ENV
@@ -1420,7 +1492,7 @@ char *nam, *val;
vallen = strlen(val);
New(904, envstr, namlen + vallen + 3, char);
(void)sprintf(envstr,"%s=%s",nam,val);
- (void)putenv(envstr);
+ (void)PerlEnv_putenv(envstr);
if (oldstr)
Safefree(oldstr);
#ifdef _MSC_VER
@@ -1429,21 +1501,16 @@ char *nam, *val;
#else /* !USE_WIN32_RTL_ENV */
- /* The sane way to deal with the environment.
- * Has these advantages over putenv() & co.:
- * * enables us to store a truly empty value in the
- * environment (like in UNIX).
- * * we don't have to deal with RTL globals, bugs and leaks.
- * * Much faster.
- * Why you may want to enable USE_WIN32_RTL_ENV:
- * * environ[] and RTL functions will not reflect changes,
- * which might be an issue if extensions want to access
- * the env. via RTL. This cuts both ways, since RTL will
- * not see changes made by extensions that call the Win32
- * functions directly, either.
- * GSAR 97-06-07
- */
- SetEnvironmentVariable(nam,val);
+ register char *envstr;
+ STRLEN len = strlen(nam) + 3;
+ if (!val) {
+ val = "";
+ }
+ len += strlen(val);
+ New(904, envstr, len, char);
+ (void)sprintf(envstr,"%s=%s",nam,val);
+ (void)PerlEnv_putenv(envstr);
+ Safefree(envstr);
#endif
}
@@ -1451,8 +1518,7 @@ char *nam, *val;
#endif /* WIN32 */
I32
-setenv_getix(nam)
-char *nam;
+setenv_getix(char *nam)
{
register I32 i, len = strlen(nam);
@@ -1478,17 +1544,14 @@ char *f;
{
I32 i;
- for (i = 0; unlink(f) >= 0; i++) ;
+ for (i = 0; PerlLIO_unlink(f) >= 0; i++) ;
return i ? 0 : -1;
}
#endif
#if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
char *
-my_bcopy(from,to,len)
-register char *from;
-register char *to;
-register I32 len;
+my_bcopy(register char *from,register char *to,register I32 len)
{
char *retval = to;
@@ -1554,7 +1617,6 @@ register I32 len;
}
#endif /* !HAS_MEMCMP || !HAS_SANE_MEMCMP */
-#if defined(I_STDARG) || defined(I_VARARGS)
#ifndef HAS_VPRINTF
#ifdef USE_CHAR_VSPRINTF
@@ -1585,17 +1647,11 @@ char *args;
}
#endif /* HAS_VPRINTF */
-#endif /* I_VARARGS || I_STDARGS */
#ifdef MYSWAP
#if BYTEORDER != 0x4321
short
-#ifndef CAN_PROTOTYPE
-my_swap(s)
-short s;
-#else
my_swap(short s)
-#endif
{
#if (BYTEORDER & 1) == 0
short result;
@@ -1608,12 +1664,7 @@ my_swap(short s)
}
long
-#ifndef CAN_PROTOTYPE
-my_htonl(l)
-register long l;
-#else
my_htonl(long l)
-#endif
{
union {
long result;
@@ -1642,12 +1693,7 @@ my_htonl(long l)
}
long
-#ifndef CAN_PROTOTYPE
-my_ntohl(l)
-register long l;
-#else
my_ntohl(long l)
-#endif
{
union {
long l;
@@ -1740,12 +1786,10 @@ VTOH(vtohl,long)
/* VMS' my_popen() is in VMS.c, same with OS/2. */
#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS)
PerlIO *
-my_popen(cmd,mode)
-char *cmd;
-char *mode;
+my_popen(char *cmd, char *mode)
{
int p[2];
- register I32 this, that;
+ register I32 This, that;
register I32 pid;
SV *sv;
I32 doexec = strNE(cmd,"-");
@@ -1755,17 +1799,17 @@ char *mode;
return my_syspopen(cmd,mode);
}
#endif
- if (pipe(p) < 0)
- return Nullfp;
- this = (*mode == 'w');
- that = !this;
- if (doexec && tainting) {
+ This = (*mode == 'w');
+ that = !This;
+ if (doexec && PL_tainting) {
taint_env();
taint_proper("Insecure %s%s", "EXEC");
}
+ if (PerlProc_pipe(p) < 0)
+ return Nullfp;
while ((pid = (doexec?vfork():fork())) < 0) {
if (errno != EAGAIN) {
- close(p[this]);
+ PerlLIO_close(p[This]);
if (!doexec)
croak("Can't fork");
return Nullfp;
@@ -1775,12 +1819,14 @@ char *mode;
if (pid == 0) {
GV* tmpgv;
+#undef THIS
+#undef THAT
#define THIS that
-#define THAT this
- close(p[THAT]);
+#define THAT This
+ PerlLIO_close(p[THAT]);
if (p[THIS] != (*mode == 'r')) {
- dup2(p[THIS], *mode == 'r');
- close(p[THIS]);
+ PerlLIO_dup2(p[THIS], *mode == 'r');
+ PerlLIO_close(p[THIS]);
}
if (doexec) {
#if !defined(HAS_FCNTL) || !defined(F_SETFD)
@@ -1789,33 +1835,33 @@ char *mode;
#ifndef NOFILE
#define NOFILE 20
#endif
- for (fd = maxsysfd + 1; fd < NOFILE; fd++)
- close(fd);
+ for (fd = PL_maxsysfd + 1; fd < NOFILE; fd++)
+ PerlLIO_close(fd);
#endif
do_exec(cmd); /* may or may not use the shell */
- _exit(1);
+ PerlProc__exit(1);
}
/*SUPPRESS 560*/
if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
sv_setiv(GvSV(tmpgv), (IV)getpid());
- forkprocess = 0;
- hv_clear(pidstatus); /* we have no children */
+ PL_forkprocess = 0;
+ hv_clear(PL_pidstatus); /* we have no children */
return Nullfp;
#undef THIS
#undef THAT
}
do_execfree(); /* free any memory malloced by child on vfork */
- close(p[that]);
- if (p[that] < p[this]) {
- dup2(p[this], p[that]);
- close(p[this]);
- p[this] = p[that];
+ PerlLIO_close(p[that]);
+ if (p[that] < p[This]) {
+ PerlLIO_dup2(p[This], p[that]);
+ PerlLIO_close(p[This]);
+ p[This] = p[that];
}
- sv = *av_fetch(fdpid,p[this],TRUE);
+ sv = *av_fetch(PL_fdpid,p[This],TRUE);
(void)SvUPGRADE(sv,SVt_IV);
SvIVX(sv) = pid;
- forkprocess = pid;
- return PerlIO_fdopen(p[this], mode);
+ PL_forkprocess = pid;
+ return PerlIO_fdopen(p[This], mode);
}
#else
#if defined(atarist) || defined(DJGPP)
@@ -1834,20 +1880,20 @@ char *mode;
#endif /* !DOSISH */
#ifdef DUMP_FDS
-dump_fds(s)
-char *s;
+void
+dump_fds(char *s)
{
int fd;
struct stat tmpstatbuf;
PerlIO_printf(PerlIO_stderr(),"%s", s);
for (fd = 0; fd < 32; fd++) {
- if (Fstat(fd,&tmpstatbuf) >= 0)
+ if (PerlLIO_fstat(fd,&tmpstatbuf) >= 0)
PerlIO_printf(PerlIO_stderr()," %d",fd);
}
PerlIO_printf(PerlIO_stderr(),"\n");
}
-#endif
+#endif /* DUMP_FDS */
#ifndef HAS_DUP2
int
@@ -1858,7 +1904,7 @@ int newfd;
#if defined(HAS_FCNTL) && defined(F_DUPFD)
if (oldfd == newfd)
return oldfd;
- close(newfd);
+ PerlLIO_close(newfd);
return fcntl(oldfd, F_DUPFD, newfd);
#else
#define DUP2_MAX_FDS 256
@@ -1868,18 +1914,18 @@ int newfd;
if (oldfd == newfd)
return oldfd;
- close(newfd);
+ PerlLIO_close(newfd);
/* good enough for low fd's... */
- while ((fd = dup(oldfd)) != newfd && fd >= 0) {
+ while ((fd = PerlLIO_dup(oldfd)) != newfd && fd >= 0) {
if (fdx >= DUP2_MAX_FDS) {
- close(fd);
+ PerlLIO_close(fd);
fd = -1;
break;
}
fdtmp[fdx++] = fd;
}
while (fdx > 0)
- close(fdtmp[--fdx]);
+ PerlLIO_close(fdtmp[--fdx]);
return fd;
#endif
}
@@ -1889,9 +1935,7 @@ int newfd;
#ifdef HAS_SIGACTION
Sighandler_t
-rsignal(signo, handler)
-int signo;
-Sighandler_t handler;
+rsignal(int signo, Sighandler_t handler)
{
struct sigaction act, oact;
@@ -1901,6 +1945,10 @@ Sighandler_t handler;
#ifdef SA_RESTART
act.sa_flags |= SA_RESTART; /* SVR4, 4.3+BSD */
#endif
+#ifdef SA_NOCLDWAIT
+ if (signo == SIGCHLD && handler == (Sighandler_t)SIG_IGN)
+ act.sa_flags |= SA_NOCLDWAIT;
+#endif
if (sigaction(signo, &act, &oact) == -1)
return SIG_ERR;
else
@@ -1908,8 +1956,7 @@ Sighandler_t handler;
}
Sighandler_t
-rsignal_state(signo)
-int signo;
+rsignal_state(int signo)
{
struct sigaction oact;
@@ -1920,10 +1967,7 @@ int signo;
}
int
-rsignal_save(signo, handler, save)
-int signo;
-Sighandler_t handler;
-Sigsave_t *save;
+rsignal_save(int signo, Sighandler_t handler, Sigsave_t *save)
{
struct sigaction act;
@@ -1933,13 +1977,15 @@ Sigsave_t *save;
#ifdef SA_RESTART
act.sa_flags |= SA_RESTART; /* SVR4, 4.3+BSD */
#endif
+#ifdef SA_NOCLDWAIT
+ if (signo == SIGCHLD && handler == (Sighandler_t)SIG_IGN)
+ act.sa_flags |= SA_NOCLDWAIT;
+#endif
return sigaction(signo, &act, save);
}
int
-rsignal_restore(signo, save)
-int signo;
-Sigsave_t *save;
+rsignal_restore(int signo, Sigsave_t *save)
{
return sigaction(signo, save, (struct sigaction *)NULL);
}
@@ -1947,53 +1993,44 @@ Sigsave_t *save;
#else /* !HAS_SIGACTION */
Sighandler_t
-rsignal(signo, handler)
-int signo;
-Sighandler_t handler;
+rsignal(int signo, Sighandler_t handler)
{
- return signal(signo, handler);
+ return PerlProc_signal(signo, handler);
}
static int sig_trapped;
static
Signal_t
-sig_trap(signo)
-int signo;
+sig_trap(int signo)
{
sig_trapped++;
}
Sighandler_t
-rsignal_state(signo)
-int signo;
+rsignal_state(int signo)
{
Sighandler_t oldsig;
sig_trapped = 0;
- oldsig = signal(signo, sig_trap);
- signal(signo, oldsig);
+ oldsig = PerlProc_signal(signo, sig_trap);
+ PerlProc_signal(signo, oldsig);
if (sig_trapped)
- kill(getpid(), signo);
+ PerlProc_kill(getpid(), signo);
return oldsig;
}
int
-rsignal_save(signo, handler, save)
-int signo;
-Sighandler_t handler;
-Sigsave_t *save;
+rsignal_save(int signo, Sighandler_t handler, Sigsave_t *save)
{
- *save = signal(signo, handler);
+ *save = PerlProc_signal(signo, handler);
return (*save == SIG_ERR) ? -1 : 0;
}
int
-rsignal_restore(signo, save)
-int signo;
-Sigsave_t *save;
+rsignal_restore(int signo, Sigsave_t *save)
{
- return (signal(signo, *save) == SIG_ERR) ? -1 : 0;
+ return (PerlProc_signal(signo, *save) == SIG_ERR) ? -1 : 0;
}
#endif /* !HAS_SIGACTION */
@@ -2001,23 +2038,26 @@ Sigsave_t *save;
/* VMS' my_pclose() is in VMS.c; same with OS/2 */
#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS)
I32
-my_pclose(ptr)
-PerlIO *ptr;
+my_pclose(PerlIO *ptr)
{
Sigsave_t hstat, istat, qstat;
int status;
SV **svp;
int pid;
+ int pid2;
bool close_failed;
int saved_errno;
#ifdef VMS
int saved_vaxc_errno;
#endif
+#ifdef WIN32
+ int saved_win32_errno;
+#endif
- svp = av_fetch(fdpid,PerlIO_fileno(ptr),TRUE);
+ svp = av_fetch(PL_fdpid,PerlIO_fileno(ptr),TRUE);
pid = (int)SvIVX(*svp);
SvREFCNT_dec(*svp);
- *svp = &sv_undef;
+ *svp = &PL_sv_undef;
#ifdef OS2
if (pid == -1) { /* Opened by popen. */
return my_syspclose(ptr);
@@ -2028,16 +2068,19 @@ PerlIO *ptr;
#ifdef VMS
saved_vaxc_errno = vaxc$errno;
#endif
+#ifdef WIN32
+ saved_win32_errno = GetLastError();
+#endif
}
#ifdef UTS
- if(kill(pid, 0) < 0) { return(pid); } /* HOM 12/23/91 */
+ if(PerlProc_kill(pid, 0) < 0) { return(pid); } /* HOM 12/23/91 */
#endif
rsignal_save(SIGHUP, SIG_IGN, &hstat);
rsignal_save(SIGINT, SIG_IGN, &istat);
rsignal_save(SIGQUIT, SIG_IGN, &qstat);
do {
- pid = wait4pid(pid, &status, 0);
- } while (pid == -1 && errno == EINTR);
+ pid2 = wait4pid(pid, &status, 0);
+ } while (pid2 == -1 && errno == EINTR);
rsignal_restore(SIGHUP, &hstat);
rsignal_restore(SIGINT, &istat);
rsignal_restore(SIGQUIT, &qstat);
@@ -2045,16 +2088,13 @@ PerlIO *ptr;
SETERRNO(saved_errno, saved_vaxc_errno);
return -1;
}
- return(pid < 0 ? pid : status == 0 ? 0 : (errno = 0, status));
+ return(pid2 < 0 ? pid2 : status == 0 ? 0 : (errno = 0, status));
}
#endif /* !DOSISH */
-#if !defined(DOSISH) || defined(OS2)
+#if !defined(DOSISH) || defined(OS2) || defined(WIN32)
I32
-wait4pid(pid,statusp,flags)
-int pid;
-int *statusp;
-int flags;
+wait4pid(int pid, int *statusp, int flags)
{
SV *sv;
SV** svp;
@@ -2064,23 +2104,23 @@ int flags;
return -1;
if (pid > 0) {
sprintf(spid, "%d", pid);
- svp = hv_fetch(pidstatus,spid,strlen(spid),FALSE);
- if (svp && *svp != &sv_undef) {
+ svp = hv_fetch(PL_pidstatus,spid,strlen(spid),FALSE);
+ if (svp && *svp != &PL_sv_undef) {
*statusp = SvIVX(*svp);
- (void)hv_delete(pidstatus,spid,strlen(spid),G_DISCARD);
+ (void)hv_delete(PL_pidstatus,spid,strlen(spid),G_DISCARD);
return pid;
}
}
else {
HE *entry;
- hv_iterinit(pidstatus);
- if (entry = hv_iternext(pidstatus)) {
+ hv_iterinit(PL_pidstatus);
+ if (entry = hv_iternext(PL_pidstatus)) {
pid = atoi(hv_iterkey(entry,(I32*)statusp));
- sv = hv_iterval(pidstatus,entry);
+ sv = hv_iterval(PL_pidstatus,entry);
*statusp = SvIVX(sv);
sprintf(spid, "%d", pid);
- (void)hv_delete(pidstatus,spid,strlen(spid),G_DISCARD);
+ (void)hv_delete(PL_pidstatus,spid,strlen(spid),G_DISCARD);
return pid;
}
}
@@ -2089,7 +2129,7 @@ int flags;
if (!HAS_WAITPID_RUNTIME)
goto hard_way;
# endif
- return waitpid(pid,statusp,flags);
+ return PerlProc_waitpid(pid,statusp,flags);
#endif
#if !defined(HAS_WAITPID) && defined(HAS_WAIT4)
return wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
@@ -2101,7 +2141,7 @@ int flags;
if (flags)
croak("Can't do waitpid with flags");
else {
- while ((result = wait(statusp)) != pid && pid > 0 && result >= 0)
+ while ((result = PerlProc_wait(statusp)) != pid && pid > 0 && result >= 0)
pidgone(result,*statusp);
if (result < 0)
*statusp = -1;
@@ -2110,19 +2150,17 @@ int flags;
}
#endif
}
-#endif /* !DOSISH */
+#endif /* !DOSISH || OS2 || WIN32 */
void
/*SUPPRESS 590*/
-pidgone(pid,status)
-int pid;
-int status;
+pidgone(int pid, int status)
{
register SV *sv;
char spid[TYPE_CHARS(int)];
sprintf(spid, "%d", pid);
- sv = *hv_fetch(pidstatus,spid,strlen(spid),TRUE);
+ sv = *hv_fetch(PL_pidstatus,spid,strlen(spid),TRUE);
(void)SvUPGRADE(sv,SVt_IV);
SvIVX(sv) = status;
return;
@@ -2149,19 +2187,15 @@ PerlIO *ptr;
#endif
void
-repeatcpy(to,from,len,count)
-register char *to;
-register char *from;
-I32 len;
-register I32 count;
+repeatcpy(register char *to, register char *from, I32 len, register I32 count)
{
register I32 todo;
register char *frombase = from;
if (len == 1) {
- todo = *from;
+ register char c = *from;
while (count-- > 0)
- *to++ = todo;
+ *to++ = c;
return;
}
while (count-- > 0) {
@@ -2273,13 +2307,13 @@ char *b;
sv_setpv(tmpsv, ".");
else
sv_setpvn(tmpsv, a, fa - a);
- if (Stat(SvPVX(tmpsv), &tmpstatbuf1) < 0)
+ if (PerlLIO_stat(SvPVX(tmpsv), &tmpstatbuf1) < 0)
return FALSE;
if (fb == b)
sv_setpv(tmpsv, ".");
else
sv_setpvn(tmpsv, b, fb - b);
- if (Stat(SvPVX(tmpsv), &tmpstatbuf2) < 0)
+ if (PerlLIO_stat(SvPVX(tmpsv), &tmpstatbuf2) < 0)
return FALSE;
return tmpstatbuf1.st_dev == tmpstatbuf2.st_dev &&
tmpstatbuf1.st_ino == tmpstatbuf2.st_ino;
@@ -2287,10 +2321,7 @@ char *b;
#endif /* !HAS_RENAME */
UV
-scan_oct(start, len, retlen)
-char *start;
-I32 len;
-I32 *retlen;
+scan_oct(char *start, I32 len, I32 *retlen)
{
register char *s = start;
register UV retval = 0;
@@ -2305,36 +2336,513 @@ I32 *retlen;
retval = n | (*s++ - '0');
len--;
}
- if (dowarn && len && (*s == '8' || *s == '9'))
+ if (PL_dowarn && len && (*s == '8' || *s == '9'))
warn("Illegal octal digit ignored");
*retlen = s - start;
return retval;
}
UV
-scan_hex(start, len, retlen)
-char *start;
-I32 len;
-I32 *retlen;
+scan_hex(char *start, I32 len, I32 *retlen)
{
register char *s = start;
register UV retval = 0;
bool overflowed = FALSE;
- char *tmp;
-
- while (len-- && *s && (tmp = strchr(hexdigit, *s))) {
- register UV n = retval << 4;
+ char *tmp = s;
+ register UV n;
+
+ while (len-- && *s) {
+ tmp = strchr((char *) PL_hexdigit, *s++);
+ if (!tmp) {
+ if (*(s-1) == '_' || (*(s-1) == 'x' && retval == 0))
+ continue;
+ else {
+ --s;
+ if (PL_dowarn)
+ warn("Illegal hex digit ignored");
+ break;
+ }
+ }
+ n = retval << 4;
if (!overflowed && (n >> 4) != retval) {
warn("Integer overflow in hex number");
overflowed = TRUE;
}
- retval = n | (tmp - hexdigit) & 15;
- s++;
+ retval = n | ((tmp - PL_hexdigit) & 15);
}
*retlen = s - start;
return retval;
}
+char*
+find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags)
+{
+ dTHR;
+ char *xfound = Nullch;
+ char *xfailed = Nullch;
+ char tmpbuf[512];
+ register char *s;
+ I32 len;
+ int retval;
+#if defined(DOSISH) && !defined(OS2) && !defined(atarist)
+# define SEARCH_EXTS ".bat", ".cmd", NULL
+# define MAX_EXT_LEN 4
+#endif
+#ifdef OS2
+# define SEARCH_EXTS ".cmd", ".btm", ".bat", ".pl", NULL
+# define MAX_EXT_LEN 4
+#endif
+#ifdef VMS
+# define SEARCH_EXTS ".pl", ".com", NULL
+# define MAX_EXT_LEN 4
+#endif
+ /* additional extensions to try in each dir if scriptname not found */
+#ifdef SEARCH_EXTS
+ char *exts[] = { SEARCH_EXTS };
+ char **ext = search_ext ? search_ext : exts;
+ int extidx = 0, i = 0;
+ char *curext = Nullch;
+#else
+# define MAX_EXT_LEN 0
+#endif
+
+ /*
+ * If dosearch is true and if scriptname does not contain path
+ * delimiters, search the PATH for scriptname.
+ *
+ * If SEARCH_EXTS is also defined, will look for each
+ * scriptname{SEARCH_EXTS} whenever scriptname is not found
+ * while searching the PATH.
+ *
+ * Assuming SEARCH_EXTS is C<".foo",".bar",NULL>, PATH search
+ * proceeds as follows:
+ * If DOSISH or VMSISH:
+ * + look for ./scriptname{,.foo,.bar}
+ * + search the PATH for scriptname{,.foo,.bar}
+ *
+ * If !DOSISH:
+ * + look *only* in the PATH for scriptname{,.foo,.bar} (note
+ * this will not look in '.' if it's not in the PATH)
+ */
+ tmpbuf[0] = '\0';
+
+#ifdef VMS
+# ifdef ALWAYS_DEFTYPES
+ len = strlen(scriptname);
+ if (!(len == 1 && *scriptname == '-') && scriptname[len-1] != ':') {
+ int hasdir, idx = 0, deftypes = 1;
+ bool seen_dot = 1;
+
+ hasdir = !dosearch || (strpbrk(scriptname,":[</") != Nullch) ;
+# else
+ if (dosearch) {
+ int hasdir, idx = 0, deftypes = 1;
+ bool seen_dot = 1;
+
+ hasdir = (strpbrk(scriptname,":[</") != Nullch) ;
+# endif
+ /* The first time through, just add SEARCH_EXTS to whatever we
+ * already have, so we can check for default file types. */
+ while (deftypes ||
+ (!hasdir && my_trnlnm("DCL$PATH",tmpbuf,idx++)) )
+ {
+ if (deftypes) {
+ deftypes = 0;
+ *tmpbuf = '\0';
+ }
+ if ((strlen(tmpbuf) + strlen(scriptname)
+ + MAX_EXT_LEN) >= sizeof tmpbuf)
+ continue; /* don't search dir with too-long name */
+ strcat(tmpbuf, scriptname);
+#else /* !VMS */
+
+#ifdef DOSISH
+ if (strEQ(scriptname, "-"))
+ dosearch = 0;
+ if (dosearch) { /* Look in '.' first. */
+ char *cur = scriptname;
+#ifdef SEARCH_EXTS
+ if ((curext = strrchr(scriptname,'.'))) /* possible current ext */
+ while (ext[i])
+ if (strEQ(ext[i++],curext)) {
+ extidx = -1; /* already has an ext */
+ break;
+ }
+ do {
+#endif
+ DEBUG_p(PerlIO_printf(Perl_debug_log,
+ "Looking for %s\n",cur));
+ if (PerlLIO_stat(cur,&PL_statbuf) >= 0
+ && !S_ISDIR(PL_statbuf.st_mode)) {
+ dosearch = 0;
+ scriptname = cur;
+#ifdef SEARCH_EXTS
+ break;
+#endif
+ }
+#ifdef SEARCH_EXTS
+ if (cur == scriptname) {
+ len = strlen(scriptname);
+ if (len+MAX_EXT_LEN+1 >= sizeof(tmpbuf))
+ break;
+ cur = strcpy(tmpbuf, scriptname);
+ }
+ } while (extidx >= 0 && ext[extidx] /* try an extension? */
+ && strcpy(tmpbuf+len, ext[extidx++]));
+#endif
+ }
+#endif
+
+ if (dosearch && !strchr(scriptname, '/')
+#ifdef DOSISH
+ && !strchr(scriptname, '\\')
+#endif
+ && (s = PerlEnv_getenv("PATH"))) {
+ bool seen_dot = 0;
+
+ PL_bufend = s + strlen(s);
+ while (s < PL_bufend) {
+#if defined(atarist) || defined(DOSISH)
+ for (len = 0; *s
+# ifdef atarist
+ && *s != ','
+# endif
+ && *s != ';'; len++, s++) {
+ if (len < sizeof tmpbuf)
+ tmpbuf[len] = *s;
+ }
+ if (len < sizeof tmpbuf)
+ tmpbuf[len] = '\0';
+#else /* ! (atarist || DOSISH) */
+ s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf, s, PL_bufend,
+ ':',
+ &len);
+#endif /* ! (atarist || DOSISH) */
+ if (s < PL_bufend)
+ s++;
+ if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tmpbuf)
+ continue; /* don't search dir with too-long name */
+ if (len
+#if defined(atarist) || defined(DOSISH)
+ && tmpbuf[len - 1] != '/'
+ && tmpbuf[len - 1] != '\\'
+#endif
+ )
+ tmpbuf[len++] = '/';
+ if (len == 2 && tmpbuf[0] == '.')
+ seen_dot = 1;
+ (void)strcpy(tmpbuf + len, scriptname);
+#endif /* !VMS */
+
+#ifdef SEARCH_EXTS
+ len = strlen(tmpbuf);
+ if (extidx > 0) /* reset after previous loop */
+ extidx = 0;
+ do {
+#endif
+ DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tmpbuf));
+ retval = PerlLIO_stat(tmpbuf,&PL_statbuf);
+ if (S_ISDIR(PL_statbuf.st_mode)) {
+ retval = -1;
+ }
+#ifdef SEARCH_EXTS
+ } while ( retval < 0 /* not there */
+ && extidx>=0 && ext[extidx] /* try an extension? */
+ && strcpy(tmpbuf+len, ext[extidx++])
+ );
+#endif
+ if (retval < 0)
+ continue;
+ if (S_ISREG(PL_statbuf.st_mode)
+ && cando(S_IRUSR,TRUE,&PL_statbuf)
+#ifndef DOSISH
+ && cando(S_IXUSR,TRUE,&PL_statbuf)
+#endif
+ )
+ {
+ xfound = tmpbuf; /* bingo! */
+ break;
+ }
+ if (!xfailed)
+ xfailed = savepv(tmpbuf);
+ }
+#ifndef DOSISH
+ if (!xfound && !seen_dot && !xfailed &&
+ (PerlLIO_stat(scriptname,&PL_statbuf) < 0
+ || S_ISDIR(PL_statbuf.st_mode)))
+#endif
+ seen_dot = 1; /* Disable message. */
+ if (!xfound) {
+ if (flags & 1) { /* do or die? */
+ croak("Can't %s %s%s%s",
+ (xfailed ? "execute" : "find"),
+ (xfailed ? xfailed : scriptname),
+ (xfailed ? "" : " on PATH"),
+ (xfailed || seen_dot) ? "" : ", '.' not in PATH");
+ }
+ scriptname = Nullch;
+ }
+ if (xfailed)
+ Safefree(xfailed);
+ scriptname = xfound;
+ }
+ return (scriptname ? savepv(scriptname) : Nullch);
+}
+
+
+#ifdef USE_THREADS
+#ifdef FAKE_THREADS
+/* Very simplistic scheduler for now */
+void
+schedule(void)
+{
+ thr = thr->i.next_run;
+}
+
+void
+perl_cond_init(cp)
+perl_cond *cp;
+{
+ *cp = 0;
+}
+
+void
+perl_cond_signal(cp)
+perl_cond *cp;
+{
+ perl_os_thread t;
+ perl_cond cond = *cp;
+
+ if (!cond)
+ return;
+ t = cond->thread;
+ /* Insert t in the runnable queue just ahead of us */
+ t->i.next_run = thr->i.next_run;
+ thr->i.next_run->i.prev_run = t;
+ t->i.prev_run = thr;
+ thr->i.next_run = t;
+ thr->i.wait_queue = 0;
+ /* Remove from the wait queue */
+ *cp = cond->next;
+ Safefree(cond);
+}
+
+void
+perl_cond_broadcast(cp)
+perl_cond *cp;
+{
+ perl_os_thread t;
+ perl_cond cond, cond_next;
+
+ for (cond = *cp; cond; cond = cond_next) {
+ t = cond->thread;
+ /* Insert t in the runnable queue just ahead of us */
+ t->i.next_run = thr->i.next_run;
+ thr->i.next_run->i.prev_run = t;
+ t->i.prev_run = thr;
+ thr->i.next_run = t;
+ thr->i.wait_queue = 0;
+ /* Remove from the wait queue */
+ cond_next = cond->next;
+ Safefree(cond);
+ }
+ *cp = 0;
+}
+
+void
+perl_cond_wait(cp)
+perl_cond *cp;
+{
+ perl_cond cond;
+
+ if (thr->i.next_run == thr)
+ croak("panic: perl_cond_wait called by last runnable thread");
+
+ New(666, cond, 1, struct perl_wait_queue);
+ cond->thread = thr;
+ cond->next = *cp;
+ *cp = cond;
+ thr->i.wait_queue = cond;
+ /* Remove ourselves from runnable queue */
+ thr->i.next_run->i.prev_run = thr->i.prev_run;
+ thr->i.prev_run->i.next_run = thr->i.next_run;
+}
+#endif /* FAKE_THREADS */
+
+#ifdef OLD_PTHREADS_API
+struct perl_thread *
+getTHR _((void))
+{
+ pthread_addr_t t;
+
+ if (pthread_getspecific(PL_thr_key, &t))
+ croak("panic: pthread_getspecific");
+ return (struct perl_thread *) t;
+}
+#endif /* OLD_PTHREADS_API */
+
+MAGIC *
+condpair_magic(SV *sv)
+{
+ MAGIC *mg;
+
+ SvUPGRADE(sv, SVt_PVMG);
+ mg = mg_find(sv, 'm');
+ if (!mg) {
+ condpair_t *cp;
+
+ New(53, cp, 1, condpair_t);
+ MUTEX_INIT(&cp->mutex);
+ COND_INIT(&cp->owner_cond);
+ COND_INIT(&cp->cond);
+ cp->owner = 0;
+ LOCK_SV_MUTEX;
+ mg = mg_find(sv, 'm');
+ if (mg) {
+ /* someone else beat us to initialising it */
+ UNLOCK_SV_MUTEX;
+ MUTEX_DESTROY(&cp->mutex);
+ COND_DESTROY(&cp->owner_cond);
+ COND_DESTROY(&cp->cond);
+ Safefree(cp);
+ }
+ else {
+ sv_magic(sv, Nullsv, 'm', 0, 0);
+ mg = SvMAGIC(sv);
+ mg->mg_ptr = (char *)cp;
+ mg->mg_len = sizeof(cp);
+ UNLOCK_SV_MUTEX;
+ DEBUG_S(WITH_THR(PerlIO_printf(PerlIO_stderr(),
+ "%p: condpair_magic %p\n", thr, sv));)
+ }
+ }
+ return mg;
+}
+
+/*
+ * Make a new perl thread structure using t as a prototype. Some of the
+ * fields for the new thread are copied from the prototype thread, t,
+ * so t should not be running in perl at the time this function is
+ * called. The use by ext/Thread/Thread.xs in core perl (where t is the
+ * thread calling new_struct_thread) clearly satisfies this constraint.
+ */
+struct perl_thread *
+new_struct_thread(struct perl_thread *t)
+{
+ struct perl_thread *thr;
+ SV *sv;
+ SV **svp;
+ I32 i;
+
+ sv = newSVpv("", 0);
+ SvGROW(sv, sizeof(struct perl_thread) + 1);
+ SvCUR_set(sv, sizeof(struct perl_thread));
+ thr = (Thread) SvPVX(sv);
+#ifdef DEBUGGING
+ memset(thr, 0xab, sizeof(struct perl_thread));
+ PL_markstack = 0;
+ PL_scopestack = 0;
+ PL_savestack = 0;
+ PL_retstack = 0;
+ PL_dirty = 0;
+ PL_localizing = 0;
+ Zero(&PL_hv_fetch_ent_mh, 1, HE);
+#else
+ Zero(thr, 1, struct perl_thread);
+#endif
+
+ thr->oursv = sv;
+ init_stacks(ARGS);
+
+ PL_curcop = &PL_compiling;
+ thr->cvcache = newHV();
+ thr->threadsv = newAV();
+ thr->specific = newAV();
+ thr->errsv = newSVpv("", 0);
+ thr->errhv = newHV();
+ thr->flags = THRf_R_JOINABLE;
+ MUTEX_INIT(&thr->mutex);
+
+
+ /* top_env needs to be non-zero. It points to an area
+ in which longjmp() stuff is stored, as C callstack
+ info there at least is thread specific this has to
+ be per-thread. Otherwise a 'die' in a thread gives
+ that thread the C stack of last thread to do an eval {}!
+ See comments in scope.h
+ Initialize top entry (as in perl.c for main thread)
+ */
+ PL_start_env.je_prev = NULL;
+ PL_start_env.je_ret = -1;
+ PL_start_env.je_mustcatch = TRUE;
+ PL_top_env = &PL_start_env;
+
+ PL_in_eval = FALSE;
+ PL_restartop = 0;
+
+ PL_statname = NEWSV(66,0);
+ PL_maxscream = -1;
+ PL_regcompp = FUNC_NAME_TO_PTR(pregcomp);
+ PL_regexecp = FUNC_NAME_TO_PTR(regexec_flags);
+ PL_regindent = 0;
+ PL_reginterp_cnt = 0;
+ PL_lastscream = Nullsv;
+ PL_screamfirst = 0;
+ PL_screamnext = 0;
+ PL_reg_start_tmp = 0;
+ PL_reg_start_tmpl = 0;
+
+ /* parent thread's data needs to be locked while we make copy */
+ MUTEX_LOCK(&t->mutex);
+
+ PL_curcop = t->Tcurcop; /* XXX As good a guess as any? */
+ PL_defstash = t->Tdefstash; /* XXX maybe these should */
+ PL_curstash = t->Tcurstash; /* always be set to main? */
+
+ PL_tainted = t->Ttainted;
+ PL_curpm = t->Tcurpm; /* XXX No PMOP ref count */
+ PL_nrs = newSVsv(t->Tnrs);
+ PL_rs = SvREFCNT_inc(PL_nrs);
+ PL_last_in_gv = Nullgv;
+ PL_ofslen = t->Tofslen;
+ PL_ofs = savepvn(t->Tofs, PL_ofslen);
+ PL_defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv);
+ PL_chopset = t->Tchopset;
+ PL_formtarget = newSVsv(t->Tformtarget);
+ PL_bodytarget = newSVsv(t->Tbodytarget);
+ PL_toptarget = newSVsv(t->Ttoptarget);
+
+ /* Initialise all per-thread SVs that the template thread used */
+ svp = AvARRAY(t->threadsv);
+ for (i = 0; i <= AvFILLp(t->threadsv); i++, svp++) {
+ if (*svp && *svp != &PL_sv_undef) {
+ SV *sv = newSVsv(*svp);
+ av_store(thr->threadsv, i, sv);
+ sv_magic(sv, 0, 0, &PL_threadsv_names[i], 1);
+ DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ "new_struct_thread: copied threadsv %d %p->%p\n",i, t, thr));
+ }
+ }
+ thr->threadsvp = AvARRAY(thr->threadsv);
+
+ MUTEX_LOCK(&PL_threads_mutex);
+ PL_nthreads++;
+ thr->tid = ++PL_threadnum;
+ thr->next = t->next;
+ thr->prev = t;
+ t->next = thr;
+ thr->next->prev = thr;
+ MUTEX_UNLOCK(&PL_threads_mutex);
+
+ /* done copying parent's state */
+ MUTEX_UNLOCK(&t->mutex);
+
+#ifdef HAVE_THREAD_INTERN
+ init_thread_intern(thr);
+#endif /* HAVE_THREAD_INTERN */
+ return thr;
+}
+#endif /* USE_THREADS */
#ifdef HUGE_VAL
/*
@@ -2343,8 +2851,144 @@ I32 *retlen;
* Needed for SunOS with Sun's 'acc' for example.
*/
double
-Perl_huge()
+Perl_huge(void)
{
return HUGE_VAL;
}
#endif
+
+#ifdef PERL_GLOBAL_STRUCT
+struct perl_vars *
+Perl_GetVars(void)
+{
+ return &PL_Vars;
+}
+#endif
+
+char **
+get_op_names(void)
+{
+ return op_name;
+}
+
+char **
+get_op_descs(void)
+{
+ return op_desc;
+}
+
+char *
+get_no_modify(void)
+{
+ return (char*)no_modify;
+}
+
+U32 *
+get_opargs(void)
+{
+ return opargs;
+}
+
+
+SV **
+get_specialsv_list(void)
+{
+ return PL_specialsv_list;
+}
+
+
+MGVTBL*
+get_vtbl(int vtbl_id)
+{
+ MGVTBL* result = Null(MGVTBL*);
+
+ switch(vtbl_id) {
+ case want_vtbl_sv:
+ result = &vtbl_sv;
+ break;
+ case want_vtbl_env:
+ result = &vtbl_env;
+ break;
+ case want_vtbl_envelem:
+ result = &vtbl_envelem;
+ break;
+ case want_vtbl_sig:
+ result = &vtbl_sig;
+ break;
+ case want_vtbl_sigelem:
+ result = &vtbl_sigelem;
+ break;
+ case want_vtbl_pack:
+ result = &vtbl_pack;
+ break;
+ case want_vtbl_packelem:
+ result = &vtbl_packelem;
+ break;
+ case want_vtbl_dbline:
+ result = &vtbl_dbline;
+ break;
+ case want_vtbl_isa:
+ result = &vtbl_isa;
+ break;
+ case want_vtbl_isaelem:
+ result = &vtbl_isaelem;
+ break;
+ case want_vtbl_arylen:
+ result = &vtbl_arylen;
+ break;
+ case want_vtbl_glob:
+ result = &vtbl_glob;
+ break;
+ case want_vtbl_mglob:
+ result = &vtbl_mglob;
+ break;
+ case want_vtbl_nkeys:
+ result = &vtbl_nkeys;
+ break;
+ case want_vtbl_taint:
+ result = &vtbl_taint;
+ break;
+ case want_vtbl_substr:
+ result = &vtbl_substr;
+ break;
+ case want_vtbl_vec:
+ result = &vtbl_vec;
+ break;
+ case want_vtbl_pos:
+ result = &vtbl_pos;
+ break;
+ case want_vtbl_bm:
+ result = &vtbl_bm;
+ break;
+ case want_vtbl_fm:
+ result = &vtbl_fm;
+ break;
+ case want_vtbl_uvar:
+ result = &vtbl_uvar;
+ break;
+#ifdef USE_THREADS
+ case want_vtbl_mutex:
+ result = &vtbl_mutex;
+ break;
+#endif
+ case want_vtbl_defelem:
+ result = &vtbl_defelem;
+ break;
+ case want_vtbl_regexp:
+ result = &vtbl_regexp;
+ break;
+#ifdef USE_LOCALE_COLLATE
+ case want_vtbl_collxfrm:
+ result = &vtbl_collxfrm;
+ break;
+#endif
+ case want_vtbl_amagic:
+ result = &vtbl_amagic;
+ break;
+ case want_vtbl_amagicelem:
+ result = &vtbl_amagicelem;
+ break;
+ }
+ return result;
+}
+
diff --git a/gnu/usr.bin/perl/util.h b/gnu/usr.bin/perl/util.h
index 7dcf9ceab51..3082a20213d 100644
--- a/gnu/usr.bin/perl/util.h
+++ b/gnu/usr.bin/perl/util.h
@@ -1,6 +1,6 @@
/* util.h
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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/gnu/usr.bin/perl/utils/Makefile b/gnu/usr.bin/perl/utils/Makefile
index 3c343c82b70..2df16d8060f 100644
--- a/gnu/usr.bin/perl/utils/Makefile
+++ b/gnu/usr.bin/perl/utils/Makefile
@@ -1,13 +1,18 @@
PERL = ../miniperl
+REALPERL = ../perl
# Files to be built with variable substitution after miniperl is
# available. Dependencies handled manually below (for now).
-pl = c2ph.PL h2ph.PL h2xs.PL perlbug.PL perldoc.PL pl2pm.PL splain.PL
-plextract = c2ph h2ph h2xs perlbug perldoc pl2pm splain
+pl = c2ph.PL h2ph.PL h2xs.PL perlbug.PL perldoc.PL pl2pm.PL splain.PL perlcc.PL
+plextract = c2ph h2ph h2xs perlbug perldoc pl2pm splain perlcc
+plextractexe = c2ph.exe h2ph.exe h2xs.exe perlbug.exe perldoc.exe pl2pm.exe splain.exe perlcc.exe
-all: $(plextract)
+all: $(plextract)
+
+compile: all
+ $(REALPERL) -I../lib perlcc -regex 's/$$/.exe/' $(plextract) -prog -verbose dcf -log ../compilelog;
$(plextract):
$(PERL) -I../lib $@.PL
@@ -26,10 +31,12 @@ pl2pm: pl2pm.PL ../config.sh
splain: splain.PL ../config.sh ../lib/diagnostics.pm
+perlcc: perlcc.PL ../config.sh
+
clean:
realclean:
- rm -rf $(plextract) pstruct
+ rm -rf $(plextract) pstruct $(plextractexe)
clobber: realclean
diff --git a/gnu/usr.bin/perl/utils/c2ph.PL b/gnu/usr.bin/perl/utils/c2ph.PL
index e732d4d52ae..38b259f0db1 100644
--- a/gnu/usr.bin/perl/utils/c2ph.PL
+++ b/gnu/usr.bin/perl/utils/c2ph.PL
@@ -2,6 +2,7 @@
use Config;
use File::Basename qw(&basename &dirname);
+use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
@@ -12,6 +13,7 @@ use File::Basename qw(&basename &dirname);
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
@@ -1398,3 +1400,4 @@ if (defined $Config{d_link}) {
File::Copy::syscopy('c2ph', 'pstruct');
}
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;
diff --git a/gnu/usr.bin/perl/utils/h2ph.PL b/gnu/usr.bin/perl/utils/h2ph.PL
index 8edad81f155..6011d98f1f1 100644
--- a/gnu/usr.bin/perl/utils/h2ph.PL
+++ b/gnu/usr.bin/perl/utils/h2ph.PL
@@ -1,7 +1,8 @@
#!/usr/local/bin/perl
use Config;
-use File::Basename qw(&basename &dirname);
+use File::Basename qw(basename dirname);
+use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
@@ -13,6 +14,7 @@ use File::Basename qw(&basename &dirname);
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
@@ -36,12 +38,15 @@ print OUT <<'!NO!SUBS!';
use Config;
use File::Path qw(mkpath);
+use Getopt::Std;
+
+getopts('Dd:rlhaQ');
+die "-r and -a options are mutually exclusive\n" if ($opt_r and $opt_a);
+@inc_dirs = inc_dirs() if $opt_a;
my $Exit = 0;
-my $Dest_dir = (@ARGV && $ARGV[0] =~ s/^-d//)
- ? shift || shift
- : $Config{installsitearch};
+my $Dest_dir = $opt_d || $Config{installsitearch};
die "Destination directory $Dest_dir doesn't exist or isn't a directory\n"
unless -d $Dest_dir;
@@ -58,25 +63,44 @@ $inif = 0;
@ARGV = ('-') unless @ARGV;
-foreach $file (@ARGV) {
+build_preamble_if_necessary();
+
+while (defined ($file = next_file())) {
+ if (-l $file and -d $file) {
+ link_if_possible($file) if ($opt_l);
+ next;
+ }
+
# Recover from header files with unbalanced cpp directives
$t = '';
$tab = 0;
+ # $eval_index goes into ``#line'' directives, to help locate syntax errors:
+ $eval_index = 1;
+
if ($file eq '-') {
open(IN, "-");
open(OUT, ">-");
- }
- else {
+ } else {
($outfile = $file) =~ s/\.h$/.ph/ || next;
- print "$file -> $outfile\n";
+ print "$file -> $outfile\n" unless $opt_Q;
if ($file =~ m|^(.*)/|) {
$dir = $1;
mkpath "$Dest_dir/$dir";
}
+
+ if ($opt_a) { # automagic mode: locate header file in @inc_dirs
+ foreach (@inc_dirs) {
+ chdir $_;
+ last if -f $file;
+ }
+ }
+
open(IN,"$file") || (($Exit = 1),(warn "Can't open $file: $!\n"),next);
open(OUT,">$Dest_dir/$outfile") || die "Can't create $outfile: $!\n";
}
+
+ print OUT "require '_h2ph_pre.ph';\n\n";
while (<IN>) {
chop;
while (/\\$/) {
@@ -84,6 +108,8 @@ foreach $file (@ARGV) {
$_ .= <IN>;
chop;
}
+ print OUT "# $_\n" if $opt_D;
+
if (s:/\*:\200:g) {
s:\*/:\201:g;
s/\200[^\201]*\201//g; # delete single line comments
@@ -93,7 +119,7 @@ foreach $file (@ARGV) {
redo;
}
}
- if (s/^#\s*//) {
+ if (s/^\s*\#\s*//) {
if (s/^define\s+(\w+)//) {
$name = $1;
$new = '';
@@ -112,95 +138,177 @@ foreach $file (@ARGV) {
}
s/^\s+//;
expr();
- $new =~ s/(["\\])/\\$1/g;
+ $new =~ s/(["\\])/\\$1/g; #"]);
+ $new = reindent($new);
+ $args = reindent($args);
if ($t ne '') {
- $new =~ s/(['\\])/\\$1/g;
- print OUT $t,
- "eval 'sub $name $proto\{\n$t ${args}eval \"$new\";\n$t}' unless defined(\&$name);\n";
- }
- else {
- print OUT "unless(defined(\&$name)) {\nsub $name $proto\{\n ${args}eval \"$new\";\n}\n}\n";
+ $new =~ s/(['\\])/\\$1/g; #']);
+ if ($opt_h) {
+ print OUT $t,
+ "eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name $proto\{\n$t ${args}eval q($new);\n$t}' unless defined(\&$name);\n";
+ $eval_index++;
+ } else {
+ print OUT $t,
+ "eval 'sub $name $proto\{\n$t ${args}eval q($new);\n$t}' unless defined(\&$name);\n";
+ }
+ } else {
+ print OUT "unless(defined(\&$name)) {\n sub $name $proto\{\n\t${args}eval q($new);\n }\n}\n";
}
%curargs = ();
- }
- else {
+ } else {
s/^\s+//;
expr();
$new = 1 if $new eq '';
+ $new = reindent($new);
+ $args = reindent($args);
if ($t ne '') {
- $new =~ s/(['\\])/\\$1/g;
- print OUT $t,"eval 'sub $name () {",$new,";}' unless defined(\&$name);\n";
- }
- else {
- print OUT $t,"unless(defined(\&$name)) {\nsub $name () {",$new,";}\n}\n";
+ $new =~ s/(['\\])/\\$1/g; #']);
+
+ if ($opt_h) {
+ print OUT $t,"eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name () {",$new,";}' unless defined(\&$name);\n";
+ $eval_index++;
+ } else {
+ print OUT $t,"eval 'sub $name () {",$new,";}' unless defined(\&$name);\n";
+ }
+ } else {
+ # Shunt around such directives as `#define FOO FOO':
+ next if " \&$name" eq $new;
+
+ print OUT $t,"unless(defined(\&$name)) {\n sub $name () {\t",$new,";}\n}\n";
}
}
- }
- elsif (/^include\s*<(.*)>/) {
- ($incl = $1) =~ s/\.h$/.ph/;
+ } elsif (/^(include|import)\s*[<"](.*)[>"]/) {
+ ($incl = $2) =~ s/\.h$/.ph/;
print OUT $t,"require '$incl';\n";
- }
- elsif (/^ifdef\s+(\w+)/) {
- print OUT $t,"if (defined &$1) {\n";
+ } elsif(/^include_next\s*[<"](.*)[>"]/) {
+ ($incl = $1) =~ s/\.h$/.ph/;
+ print OUT ($t,
+ "eval {\n");
+ $tab += 4;
+ $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+ print OUT ($t,
+ "my(\%INCD) = map { \$INC{\$_} => 1 } ",
+ "(grep { \$_ eq \"$incl\" } keys(\%INC));\n");
+ print OUT ($t,
+ "my(\@REM) = map { \"\$_/$incl\" } ",
+ "(grep { not exists(\$INCD{\"\$_/$incl\"})",
+ "and -f \"\$_/$incl\" } \@INC);\n");
+ print OUT ($t,
+ "require \"\$REM[0]\" if \@REM;\n");
+ $tab -= 4;
+ $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+ print OUT ($t,
+ "};\n");
+ print OUT ($t,
+ "warn(\$\@) if \$\@;\n");
+ } elsif (/^ifdef\s+(\w+)/) {
+ print OUT $t,"if(defined(&$1)) {\n";
$tab += 4;
$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- }
- elsif (/^ifndef\s+(\w+)/) {
- print OUT $t,"if (!defined &$1) {\n";
+ } elsif (/^ifndef\s+(\w+)/) {
+ print OUT $t,"unless(defined(&$1)) {\n";
$tab += 4;
$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- }
- elsif (s/^if\s+//) {
+ } elsif (s/^if\s+//) {
$new = '';
$inif = 1;
expr();
$inif = 0;
- print OUT $t,"if ($new) {\n";
+ print OUT $t,"if($new) {\n";
$tab += 4;
$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- }
- elsif (s/^elif\s+//) {
+ } elsif (s/^elif\s+//) {
$new = '';
$inif = 1;
expr();
$inif = 0;
$tab -= 4;
$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- print OUT $t,"}\n${t}elsif ($new) {\n";
+ print OUT $t,"}\n elsif($new) {\n";
$tab += 4;
$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- }
- elsif (/^else/) {
+ } elsif (/^else/) {
$tab -= 4;
$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- print OUT $t,"}\n${t}else {\n";
+ print OUT $t,"} else {\n";
$tab += 4;
$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- }
- elsif (/^endif/) {
+ } elsif (/^endif/) {
$tab -= 4;
$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
print OUT $t,"}\n";
+ } elsif(/^undef\s+(\w+)/) {
+ print OUT $t, "undef(&$1) if defined(&$1);\n";
+ } elsif(/^error\s+(".*")/) {
+ print OUT $t, "die($1);\n";
+ } elsif(/^error\s+(.*)/) {
+ print OUT $t, "die(\"", quotemeta($1), "\");\n";
+ } elsif(/^warning\s+(.*)/) {
+ print OUT $t, "warn(\"", quotemeta($1), "\");\n";
+ } elsif(/^ident\s+(.*)/) {
+ print OUT $t, "# $1\n";
+ }
+ } elsif(/^\s*(typedef\s*)?enum\s*(\s+[a-zA-Z_]\w*\s*)?\{/) {
+ until(/\}.*?;/) {
+ chomp($next = <IN>);
+ $_ .= $next;
+ print OUT "# $next\n" if $opt_D;
+ }
+ s@/\*.*?\*/@@g;
+ s/\s+/ /g;
+ /^\s?(typedef\s?)?enum\s?([a-zA-Z_]\w*)?\s?\{(.*)\}\s?([a-zA-Z_]\w*)?\s?;/;
+ ($enum_subs = $3) =~ s/\s//g;
+ @enum_subs = split(/,/, $enum_subs);
+ $enum_val = -1;
+ for $enum (@enum_subs) {
+ ($enum_name, $enum_value) = $enum =~ /^([a-zA-Z_]\w*)(=.+)?$/;
+ $enum_value =~ s/^=//;
+ $enum_val = (length($enum_value) ? $enum_value : $enum_val + 1);
+ if ($opt_h) {
+ print OUT ($t,
+ "eval(\"\\n#line $eval_index $outfile\\n",
+ "sub $enum_name () \{ $enum_val; \}\") ",
+ "unless defined(\&$enum_name);\n");
+ ++ $eval_index;
+ } else {
+ print OUT ($t,
+ "eval(\"sub $enum_name () \{ $enum_val; \}\") ",
+ "unless defined(\&$enum_name);\n");
+ }
}
}
}
print OUT "1;\n";
+
+ $is_converted{$file} = 1;
+ queue_includes_from($file) if ($opt_a);
}
exit $Exit;
+sub reindent($) {
+ my($text) = shift;
+ $text =~ s/\n/\n /g;
+ $text =~ s/ /\t/g;
+ $text;
+}
+
sub expr {
+ if(keys(%curargs)) {
+ my($joined_args) = join('|', keys(%curargs));
+ }
while ($_ ne '') {
- s/^\&//; # hack for things that take the address of
- s/^(\s+)// && do {$new .= ' '; next;};
- s/^(0x[0-9a-fA-F]+)\s*[LlUu]*// && do {$new .= $1; next;};
- s/^(\d+([Ee][\+-]\d+)?)\s*[fFLlUu]*// && do {$new .= $1; next;};
- s/^("(\\"|[^"])*")// && do {$new .= $1; next;};
- s/^'((\\"|[^"])*)'// && do {
+ s/^\&\&// && do { $new .= " &&"; next;}; # handle && operator
+ s/^\&([\(a-z\)]+)/$1/i; # hack for things that take the address of
+ s/^(\s+)// && do {$new .= ' '; next;};
+ s/^(0X[0-9A-F]+)[UL]*//i && do {$new .= lc($1); next;};
+ s/^(-?\d+\.\d+E[-+]\d+)F?//i && do {$new .= $1; next;};
+ s/^(\d+)\s*[LU]*//i && do {$new .= $1; next;};
+ s/^("(\\"|[^"])*")// && do {$new .= $1; next;};
+ s/^'((\\"|[^"])*)'// && do {
if ($curargs{$1}) {
$new .= "ord('\$$1')";
- }
- else {
+ } else {
$new .= "ord('$1')";
}
next;
@@ -230,48 +338,63 @@ sub expr {
substr($_, 0, $index - 1) =~ s/\*//g;
next;
};
+ # Eliminate typedefs
+ /\(([\w\s]+)[\*\s]*\)\s*[\w\(]/ && do {
+ foreach (split /\s+/, $1) { # Make sure all the words are types,
+ last unless ($isatype{$_} or $_ eq 'struct');
+ }
+ s/\([\w\s]+[\*\s]*\)// && next; # then eliminate them.
+ };
+ # struct/union member, including arrays:
+ s/^([_A-Z]\w*(\[[^\]]+\])?((\.|->)[_A-Z]\w*(\[[^\]]+\])?)+)//i && do {
+ $id = $1;
+ $id =~ s/(\.|(->))([^\.\-]*)/->\{$3\}/g;
+ $id =~ s/\b([^\$])($joined_args)/$1\$$2/g if length($joined_args);
+ while($id =~ /\[\s*([^\$\&\d\]]+)\]/) {
+ my($index) = $1;
+ $index =~ s/\s//g;
+ if(exists($curargs{$index})) {
+ $index = "\$$index";
+ } else {
+ $index = "&$index";
+ }
+ $id =~ s/\[\s*([^\$\&\d\]]+)\]/[$index]/;
+ }
+ $new .= " (\$$id)";
+ };
s/^([_a-zA-Z]\w*)// && do {
$id = $1;
if ($id eq 'struct') {
s/^\s+(\w+)//;
$id .= ' ' . $1;
$isatype{$id} = 1;
- }
- elsif ($id eq 'unsigned' || $id eq 'long') {
- s/^\s+(\w+)//;
- $id .= ' ' . $1;
+ } elsif ($id =~ /^((un)?signed)|(long)|(short)$/) {
+ while (s/^\s+(\w+)//) { $id .= ' ' . $1; }
$isatype{$id} = 1;
}
if ($curargs{$id}) {
- $new .= '$' . $id;
- }
- elsif ($id eq 'defined') {
+ $new .= "\$$id";
+ $new .= '->' if /^[\[\{]/;
+ } elsif ($id eq 'defined') {
$new .= 'defined';
- }
- elsif (/^\(/) {
+ } elsif (/^\(/) {
s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i; # cheat
$new .= " &$id";
- }
- elsif ($isatype{$id}) {
+ } elsif ($isatype{$id}) {
if ($new =~ /{\s*$/) {
$new .= "'$id'";
- }
- elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
+ } elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
$new =~ s/\(\s*$//;
s/^[\s*]*\)//;
- }
- else {
+ } else {
$new .= q(').$id.q(');
}
- }
- else {
+ } else {
if ($inif && $new !~ /defined\s*\($/) {
$new .= '(defined(&' . $id . ') ? &' . $id . ' : 0)';
- }
- elsif (/^\[/) {
- $new .= ' $' . $id;
- }
- else {
+ } elsif (/^\[/) {
+ $new .= " \$$id";
+ } else {
$new .= ' &' . $id;
}
}
@@ -280,6 +403,193 @@ sub expr {
s/^(.)// && do { if ($1 ne '#') { $new .= $1; } next;};
}
}
+
+
+# Handle recursive subdirectories without getting a grotesquely big stack.
+# Could this be implemented using File::Find?
+sub next_file
+{
+ my $file;
+
+ while (@ARGV) {
+ $file = shift @ARGV;
+
+ if ($file eq '-' or -f $file or -l $file) {
+ return $file;
+ } elsif (-d $file) {
+ if ($opt_r) {
+ expand_glob($file);
+ } else {
+ print STDERR "Skipping directory `$file'\n";
+ }
+ } elsif ($opt_a) {
+ return $file;
+ } else {
+ print STDERR "Skipping `$file': not a file or directory\n";
+ }
+ }
+
+ return undef;
+}
+
+
+# Put all the files in $directory into @ARGV for processing.
+sub expand_glob
+{
+ my ($directory) = @_;
+
+ $directory =~ s:/$::;
+
+ opendir DIR, $directory;
+ foreach (readdir DIR) {
+ next if ($_ eq '.' or $_ eq '..');
+
+ # expand_glob() is going to be called until $ARGV[0] isn't a
+ # directory; so push directories, and unshift everything else.
+ if (-d "$directory/$_") { push @ARGV, "$directory/$_" }
+ else { unshift @ARGV, "$directory/$_" }
+ }
+ closedir DIR;
+}
+
+
+# Given $file, a symbolic link to a directory in the C include directory,
+# make an equivalent symbolic link in $Dest_dir, if we can figure out how.
+# Otherwise, just duplicate the file or directory.
+sub link_if_possible
+{
+ my ($dirlink) = @_;
+ my $target = eval 'readlink($dirlink)';
+
+ if ($target =~ m:^\.\./: or $target =~ m:^/:) {
+ # The target of a parent or absolute link could leave the $Dest_dir
+ # hierarchy, so let's put all of the contents of $dirlink (actually,
+ # the contents of $target) into @ARGV; as a side effect down the
+ # line, $dirlink will get created as an _actual_ directory.
+ expand_glob($dirlink);
+ } else {
+ if (-l "$Dest_dir/$dirlink") {
+ unlink "$Dest_dir/$dirlink" or
+ print STDERR "Could not remove link $Dest_dir/$dirlink: $!\n";
+ }
+
+ if (eval 'symlink($target, "$Dest_dir/$dirlink")') {
+ print "Linking $target -> $Dest_dir/$dirlink\n";
+
+ # Make sure that the link _links_ to something:
+ if (! -e "$Dest_dir/$target") {
+ mkpath("$Dest_dir/$target", 0755) or
+ print STDERR "Could not create $Dest_dir/$target/\n";
+ }
+ } else {
+ print STDERR "Could not symlink $target -> $Dest_dir/$dirlink: $!\n";
+ }
+ }
+}
+
+
+# Push all #included files in $file onto our stack, except for STDIN
+# and files we've already processed.
+sub queue_includes_from
+{
+ my ($file) = @_;
+ my $line;
+
+ return if ($file eq "-");
+
+ open HEADER, $file or return;
+ while (defined($line = <HEADER>)) {
+ while (/\\$/) { # Handle continuation lines
+ chop $line;
+ $line .= <HEADER>;
+ }
+
+ if ($line =~ /^#\s*include\s+<(.*?)>/) {
+ push(@ARGV, $1) unless $is_converted{$1};
+ }
+ }
+ close HEADER;
+}
+
+
+# Determine include directories; $Config{usrinc} should be enough for (all
+# non-GCC?) C compilers, but gcc uses an additional include directory.
+sub inc_dirs
+{
+ my $from_gcc = `$Config{cc} -v 2>&1`;
+ $from_gcc =~ s:^Reading specs from (.*?)/specs\b.*:$1/include:s;
+
+ length($from_gcc) ? ($from_gcc, $Config{usrinc}) : ($Config{usrinc});
+}
+
+
+# Create "_h2ph_pre.ph", if it doesn't exist or was built by a different
+# version of h2ph.
+sub build_preamble_if_necessary
+{
+ # Increment $VERSION every time this function is modified:
+ my $VERSION = 1;
+ my $preamble = "$Dest_dir/_h2ph_pre.ph";
+
+ # Can we skip building the preamble file?
+ if (-r $preamble) {
+ # Extract version number from first line of preamble:
+ open PREAMBLE, $preamble or die "Cannot open $preamble: $!";
+ my $line = <PREAMBLE>;
+ $line =~ /(\b\d+\b)/;
+ close PREAMBLE or die "Cannot close $preamble: $!";
+
+ # Don't build preamble if a compatible preamble exists:
+ return if $1 == $VERSION;
+ }
+
+ my (%define) = _extract_cc_defines();
+
+ open PREAMBLE, ">$preamble" or die "Cannot open $preamble: $!";
+ print PREAMBLE "# This file was created by h2ph version $VERSION\n";
+
+ foreach (sort keys %define) {
+ if ($opt_D) {
+ print PREAMBLE "# $_=$define{$_}\n";
+ }
+
+ if ($define{$_} =~ /^\d+$/) {
+ print PREAMBLE
+ "unless (defined &$_) { sub $_() { $define{$_} } }\n\n";
+ } else {
+ print PREAMBLE
+ "unless (defined &$_) { sub $_() { \"",
+ quotemeta($define{$_}), "\" } }\n\n";
+ }
+ }
+ close PREAMBLE or die "Cannot close $preamble: $!";
+}
+
+
+# %Config contains information on macros that are pre-defined by the
+# system's compiler. We need this information to make the .ph files
+# function with perl as the .h files do with cc.
+sub _extract_cc_defines
+{
+ my %define;
+ my $allsymbols = join " ", @Config{ccsymbols, cppsymbols, cppccsymbols};
+
+ # Split compiler pre-definitions into `key=value' pairs:
+ foreach (split /\s+/, $allsymbols) {
+ /(.*?)=(.*)/;
+ $define{$1} = $2;
+
+ if ($opt_D) {
+ print STDERR "$_: $1 -> $2\n";
+ }
+ }
+
+ return %define;
+}
+
+
+1;
+
##############################################################################
__END__
@@ -289,7 +599,7 @@ h2ph - convert .h C header files to .ph Perl header files
=head1 SYNOPSIS
-B<h2ph [headerfiles]>
+B<h2ph [-d destination directory] [-r | -a] [-l] [headerfiles]>
=head1 DESCRIPTION
@@ -300,12 +610,68 @@ It is most easily run while in /usr/include:
cd /usr/include; h2ph * sys/*
+or
+
+ cd /usr/include; h2ph -r -l .
+
The output files are placed in the hierarchy rooted at Perl's
architecture dependent library directory. You can specify a different
hierarchy with a B<-d> switch.
If run with no arguments, filters standard input to standard output.
+=head1 OPTIONS
+
+=over 4
+
+=item -d destination_dir
+
+Put the resulting B<.ph> files beneath B<destination_dir>, instead of
+beneath the default Perl library location (C<$Config{'installsitsearch'}>).
+
+=item -r
+
+Run recursively; if any of B<headerfiles> are directories, then run I<h2ph>
+on all files in those directories (and their subdirectories, etc.). B<-r>
+and B<-a> are mutually exclusive.
+
+=item -a
+
+Run automagically; convert B<headerfiles>, as well as any B<.h> files
+which they include. This option will search for B<.h> files in all
+directories which your C compiler ordinarily uses. B<-a> and B<-r> are
+mutually exclusive.
+
+=item -l
+
+Symbolic links will be replicated in the destination directory. If B<-l>
+is not specified, then links are skipped over.
+
+=item -h
+
+Put ``hints'' in the .ph files which will help in locating problems with
+I<h2ph>. In those cases when you B<require> a B<.ph> file containing syntax
+errors, instead of the cryptic
+
+ [ some error condition ] at (eval mmm) line nnn
+
+you will see the slightly more helpful
+
+ [ some error condition ] at filename.ph line nnn
+
+However, the B<.ph> files almost double in size when built using B<-h>.
+
+=item -D
+
+Include the code from the B<.h> file as a comment in the B<.ph> file.
+This is primarily used for debugging I<h2ph>.
+
+=item -Q
+
+``Quiet'' mode; don't print out the names of the files being converted.
+
+=back
+
=head1 ENVIRONMENT
No environment variables are used.
@@ -340,6 +706,24 @@ that it can translate.
It's only intended as a rough tool.
You may need to dicker with the files produced.
+Doesn't run with C<use strict>
+
+You have to run this program by hand; it's not run as part of the Perl
+installation.
+
+Doesn't handle complicated expressions built piecemeal, a la:
+
+ enum {
+ FIRST_VALUE,
+ SECOND_VALUE,
+ #ifdef ABC
+ THIRD_VALUE
+ #endif
+ };
+
+Doesn't necessarily locate all of your C compiler's internally-defined
+symbols.
+
=cut
!NO!SUBS!
@@ -347,3 +731,4 @@ You may need to dicker with the files produced.
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;
diff --git a/gnu/usr.bin/perl/utils/h2xs.PL b/gnu/usr.bin/perl/utils/h2xs.PL
index b736e410ead..129b01b81bf 100644
--- a/gnu/usr.bin/perl/utils/h2xs.PL
+++ b/gnu/usr.bin/perl/utils/h2xs.PL
@@ -2,6 +2,7 @@
use Config;
use File::Basename qw(&basename &dirname);
+use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
@@ -12,6 +13,7 @@ use File::Basename qw(&basename &dirname);
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
@@ -39,19 +41,19 @@ h2xs - convert .h C header files to Perl extensions
=head1 SYNOPSIS
-B<h2xs> [B<-AOPXcdf>] [B<-v> version] [B<-n> module_name] [B<-p> prefix] [B<-s> sub] [headerfile [extra_libraries]]
+B<h2xs> [B<-AOPXcdf>] [B<-v> version] [B<-n> module_name] [B<-p> prefix] [B<-s> sub] [headerfile ... [extra_libraries]]
B<h2xs> B<-h>
=head1 DESCRIPTION
-I<h2xs> builds a Perl extension from any C header file. The extension will
-include functions which can be used to retrieve the value of any #define
-statement which was in the C header.
+I<h2xs> builds a Perl extension from C header files. The extension
+will include functions which can be used to retrieve the value of any
+#define statement which was in the C header files.
The I<module_name> will be used for the name of the extension. If
-module_name is not supplied then the name of the header file will be used,
-with the first character capitalized.
+module_name is not supplied then the name of the first header file
+will be used, with the first character capitalized.
If the extension might need extra libraries, they should be included
here. The extension Makefile.PL will take care of checking whether
@@ -209,7 +211,7 @@ The usual warnings if it cannot read or write the files involved.
=cut
-my( $H2XS_VERSION ) = ' $Revision: 1.18 $ ' =~ /\$Revision:\s+([^\s]+)/;
+my( $H2XS_VERSION ) = ' $Revision: 1.19 $ ' =~ /\$Revision:\s+([^\s]+)/;
my $TEMPLATE_VERSION = '0.01';
use Getopt::Std;
@@ -249,15 +251,21 @@ if( $opt_v ){
$opt_c = 1 if $opt_A;
%const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s;
-$path_h = shift;
-$extralibs = "@ARGV";
+while (my $arg = shift) {
+ if ($arg =~ /^-l/i) {
+ $extralibs = "$arg @ARGV";
+ last;
+ }
+ push(@path_h, $arg);
+}
usage "Must supply header file or module name\n"
- unless ($path_h or $opt_n);
+ unless (@path_h or $opt_n);
-if( $path_h ){
- $name = $path_h;
+if( @path_h ){
+ foreach my $path_h (@path_h) {
+ $name ||= $path_h;
if( $path_h =~ s#::#/#g && $opt_n ){
warn "Nesting of headerfile ignored with -n\n";
}
@@ -288,7 +296,7 @@ if( $path_h ){
die "Can't find $path_h\n" if ( ! $opt_f && ! -f $path_h );
# Scan the header file (we should deal with nested header files)
# Record the names of simple #define constants into const_names
- # Function prototypes are not (currently) processed.
+ # Function prototypes are processed below.
open(CH, "<$path_h") || die "Can't open $path_h: $!\n";
while (<CH>) {
if (/^#[ \t]*define\s+([\$\w]+)\b\s*[^("]/) {
@@ -307,8 +315,9 @@ if( $path_h ){
}
}
close(CH);
- @const_names = sort keys %const_names;
}
+ }
+ @const_names = sort keys %const_names;
}
@@ -365,7 +374,8 @@ if( ! $opt_X ){ # use XS, unless it was disabled
get_typemap();
my $c;
my $filter;
- my $filename = $path_h;
+ my @fdecls;
+ foreach my $filename (@path_h) {
my $addflags = $opt_F || '';
if ($fullpath =~ /,/) {
$filename = $`;
@@ -377,7 +387,9 @@ if( ! $opt_X ){ # use XS, unless it was disabled
$c->set('includeDirs' => ["$Config::Config{archlib}/CORE"]);
$fdecls_parsed = $c->get('parsed_fdecls');
- $fdecls = $c->get('fdecls');
+ push(@fdecls, @{$c->get('fdecls')});
+ }
+ $fdecls = [ @fdecls ];
}
}
@@ -476,6 +488,7 @@ sub AUTOLOAD {
my \$constname;
(\$constname = \$AUTOLOAD) =~ s/.*:://;
+ croak "&$module::constant not defined" if \$constname eq 'constant';
my \$val = constant(\$constname, \@_ ? \$_[0] : 0);
if (\$! != 0) {
if (\$! =~ /Invalid/) {
@@ -486,7 +499,8 @@ sub AUTOLOAD {
croak "Your vendor has not defined $module macro \$constname";
}
}
- eval "sub \$AUTOLOAD { \$val }";
+ no strict 'refs';
+ *\$AUTOLOAD = sub () { \$val };
goto &\$AUTOLOAD;
}
@@ -578,41 +592,32 @@ if( ! $opt_X ){ # print XS, unless it is disabled
warn "Writing $ext$modpname/$modfname.xs\n";
print XS <<"END";
-#ifdef __cplusplus
-extern "C" {
-#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
-#ifdef __cplusplus
-}
-#endif
END
-if( $path_h ){
+if( @path_h ){
+ foreach my $path_h (@path_h) {
my($h) = $path_h;
$h =~ s#^/usr/include/##;
if ($^O eq 'VMS') { $h =~ s#.*vms\]#sys/# or $h =~ s#.*[:>\]]##; }
-print XS <<"END";
-#include <$h>
-
-END
+ print XS qq{#include <$h>\n};
+ }
+ print XS "\n";
}
if( ! $opt_c ){
print XS <<"END";
static int
-not_here(s)
-char *s;
+not_here(char *s)
{
croak("$module::%s not implemented on this architecture", s);
return -1;
}
static double
-constant(name, arg)
-char *name;
-int arg;
+constant(char *name, int arg)
{
errno = 0;
switch (*name) {
@@ -889,3 +894,4 @@ close MANI;
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;
diff --git a/gnu/usr.bin/perl/utils/perlbug.PL b/gnu/usr.bin/perl/utils/perlbug.PL
index 724df6b449b..6f8758919f6 100644
--- a/gnu/usr.bin/perl/utils/perlbug.PL
+++ b/gnu/usr.bin/perl/utils/perlbug.PL
@@ -2,6 +2,7 @@
use Config;
use File::Basename qw(&basename &dirname);
+use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
@@ -13,11 +14,12 @@ use File::Basename qw(&basename &dirname);
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
-open OUT,">$file" or die "Can't create $file: $!";
+open OUT, ">$file" or die "Can't create $file: $!";
# extract patchlevel.h information
@@ -27,7 +29,7 @@ my $patchlevel_date = (stat PATCH_LEVEL)[9];
while (<PATCH_LEVEL>) {
last if $_ =~ /^\s*static\s+char.*?local_patches\[\]\s*=\s*{\s*$/;
-};
+}
my @patches;
while (<PATCH_LEVEL>) {
@@ -37,11 +39,9 @@ while (<PATCH_LEVEL>) {
s/"?,?$//;
s/(['\\])/\\$1/g;
push @patches, $_ unless $_ eq 'NULL';
-};
-my $patch_desc = "'" . join("',\n\t'", @patches) . "'";
-my @patch_tags = map { my $p=$_; $p=~s/\s.*//; $p } @patches;
-my $patch_tags = join " ", map { "+$_" } @patch_tags;
-$patch_tags .= " " if $patch_tags;
+}
+my $patch_desc = "'" . join("',\n '", @patches) . "'";
+my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches;
close PATCH_LEVEL;
@@ -65,7 +65,7 @@ my \$config_tag1 = '$] - $Config{cf_time}';
my \$patchlevel_date = $patchlevel_date;
my \$patch_tags = '$patch_tags';
my \@patches = (
- $patch_desc
+ $patch_desc
);
!GROK!THIS!
@@ -75,21 +75,18 @@ print OUT <<'!NO!SUBS!';
use Config;
use Getopt::Std;
-
-BEGIN {
- eval "use Mail::Send;";
- $::HaveSend = ($@ eq "");
- eval "use Mail::Util;";
- $::HaveUtil = ($@ eq "");
-};
-
-
use strict;
sub paraprint;
+BEGIN {
+ eval "use Mail::Send;";
+ $::HaveSend = ($@ eq "");
+ eval "use Mail::Util;";
+ $::HaveUtil = ($@ eq "");
+};
-my($Version) = "1.20";
+my $Version = "1.26";
# Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
# Changed in 1.07 to see more sendmail execs, and added pipe output.
@@ -114,144 +111,160 @@ my($Version) = "1.20";
# add local patch information
# warn on '-ok' if this is an old system; add '-okay'
# Changed in 1.20 Added patchlevel.h reading and version/config checks
+# Changed in 1.21 Added '-nok' for reporting build failure DFD 98-05-05
+# Changed in 1.22 Heavy reformatting & minor bugfixes HVDS 98-05-10
+# Changed in 1.23 Restore -ok(ay): say 'success'; don't prompt
+# Changed in 1.24 Added '-F<file>' to save report HVDS 98-07-01
+# Changed in 1.25 Warn on failure to open save file. HVDS 98-07-12
+# Changed in 1.26 Don't require -t STDIN for -ok. HVDS 98-07-15
# TODO: - Allow the user to re-name the file on mail failure, and
-# make sure failure (transmission-wise) of Mail::Send is
+# make sure failure (transmission-wise) of Mail::Send is
# accounted for.
# - Test -b option
my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename,
- $subject, $from, $verbose, $ed,
+ $subject, $from, $verbose, $ed, $outfile,
$fh, $me, $Is_MSWin32, $Is_VMS, $msg, $body, $andcc, %REP, $ok);
my $config_tag2 = "$] - $Config{cf_time}";
Init();
-if($::opt_h) { Help(); exit; }
-
-if($::opt_d) { Dump(*STDOUT); exit; }
-
-if(!-t STDIN) {
- paraprint <<EOF;
-Please use perlbug interactively. If you want to
+if ($::opt_h) { Help(); exit; }
+if ($::opt_d) { Dump(*STDOUT); exit; }
+if (!-t STDIN && !($ok and not $::opt_n)) {
+ paraprint <<EOF;
+Please use perlbug interactively. If you want to
include a file, you can use the -f switch.
EOF
- die "\n";
+ die "\n";
}
-
-if(!-t STDOUT) { Dump(*STDOUT); exit; }
+if (!-t STDOUT && !$outfile) { Dump(*STDOUT); exit; }
Query();
-Edit() unless $usefile;
+Edit() unless $usefile || ($ok and not $::opt_n);
NowWhat();
Send();
exit;
sub Init {
-
- # -------- Setup --------
-
- $Is_MSWin32 = $^O eq 'MSWin32';
- $Is_VMS = $^O eq 'VMS';
-
- getopts("dhva:s:b:f:r:e:SCc:to:");
-
-
- # This comment is needed to notify metaconfig that we are
- # using the $perladmin, $cf_by, and $cf_time definitions.
-
-
- # -------- Configuration ---------
-
- # perlbug address
- $perlbug = 'perlbug@perl.com';
-
-
- # Test address
- $testaddress = 'perlbug-test@perl.com';
-
- # Target address
- $address = $::opt_a || ($::opt_t ? $testaddress : $perlbug);
-
- # Users address, used in message and in Reply-To header
- $from = $::opt_r || "";
-
- # Include verbose configuration information
- $verbose = $::opt_v || 0;
-
- # Subject of bug-report message
- $subject = $::opt_s || "";
-
- # Send a file
- $usefile = ($::opt_f || 0);
-
- # File to send as report
- $file = $::opt_f || "";
-
- # Body of report
- $body = $::opt_b || "";
-
- # Editor
- $ed = ( $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT} ||
- ($Is_VMS ? "edit/tpu" : $Is_MSWin32 ? "notepad" : "vi")
- );
-
- # OK - send "OK" report for build on this system
- $ok = 0;
- if ( $::opt_o ) {
- if ( $::opt_o eq 'k' or $::opt_o eq 'kay' ) {
- my $age = time - $patchlevel_date;
- if ( $::opt_o eq 'k' and $age > 60 * 24 * 60 * 60 ) {
- my $date = localtime $patchlevel_date;
- print <<"EOF";
-\"perlbug -ok\" does not report on Perl versions which are more than
-60 days old. This Perl version was constructed on $date.
-If you really want to report this, use \"perlbug -okay\".
+ # -------- Setup --------
+
+ $Is_MSWin32 = $^O eq 'MSWin32';
+ $Is_VMS = $^O eq 'VMS';
+
+ if (!getopts("dhva:s:b:f:F:r:e:SCc:to:n:")) { Help(); exit; };
+
+ # This comment is needed to notify metaconfig that we are
+ # using the $perladmin, $cf_by, and $cf_time definitions.
+
+ # -------- Configuration ---------
+
+ # perlbug address
+ $perlbug = 'perlbug@perl.com';
+
+ # Test address
+ $testaddress = 'perlbug-test@perl.com';
+
+ # Target address
+ $address = $::opt_a || ($::opt_t ? $testaddress : $perlbug);
+
+ # Users address, used in message and in Reply-To header
+ $from = $::opt_r || "";
+
+ # Include verbose configuration information
+ $verbose = $::opt_v || 0;
+
+ # Subject of bug-report message
+ $subject = $::opt_s || "";
+
+ # Send a file
+ $usefile = ($::opt_f || 0);
+
+ # File to send as report
+ $file = $::opt_f || "";
+
+ # File to output to
+ $outfile = $::opt_F || "";
+
+ # Body of report
+ $body = $::opt_b || "";
+
+ # Editor
+ $ed = $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
+ || ($Is_VMS && "edit/tpu")
+ || ($Is_MSWin32 && "notepad")
+ || "vi";
+
+ # Not OK - provide build failure template by finessing OK report
+ if ($::opt_n) {
+ if (substr($::opt_n, 0, 2) eq 'ok' ) {
+ $::opt_o = substr($::opt_n, 1);
+ } else {
+ Help();
+ exit();
+ }
+ }
+
+ # OK - send "OK" report for build on this system
+ $ok = 0;
+ if ($::opt_o) {
+ if ($::opt_o eq 'k' or $::opt_o eq 'kay') {
+ my $age = time - $patchlevel_date;
+ if ($::opt_o eq 'k' and $age > 60 * 24 * 60 * 60 ) {
+ my $date = localtime $patchlevel_date;
+ print <<"EOF";
+"perlbug -ok" and "perlbug -nok" do not report on Perl versions which
+are more than 60 days old. This Perl version was constructed on
+$date. If you really want to report this, use
+"perlbug -okay" or "perlbug -nokay".
EOF
- exit();
- };
- # force these options
- $::opt_S = 1; # don't prompt for send
- $::opt_C = 1; # don't send a copy to the local admin
- $::opt_s = 1;
- $subject = "OK: perl $] ${patch_tags}on"
- ." $::Config{'archname'} $::Config{'osvers'} $subject";
- $::opt_b = 1;
- $body = "Perl reported to build OK on this system.\n";
- $ok = 1;
- }
- else {
- Help();
exit();
}
+ # force these options
+ unless ($::opt_n) {
+ $::opt_S = 1; # don't prompt for send
+ $::opt_b = 1; # we have a body
+ $body = "Perl reported to build OK on this system.\n";
+ }
+ $::opt_C = 1; # don't send a copy to the local admin
+ $::opt_s = 1; # we have a subject line
+ $subject = ($::opt_n ? 'Not ' : '')
+ . "OK: perl $] ${patch_tags}on"
+ ." $::Config{'archname'} $::Config{'osvers'} $subject";
+ $ok = 1;
+ } else {
+ Help();
+ exit();
}
-
- # Possible administrator addresses, in order of confidence
- # (Note that cf_email is not mentioned to metaconfig, since
- # we don't really want it. We'll just take it if we have to.)
- #
- # This has to be after the $ok stuff above because of the way
- # that $::opt_C is forced.
- $cc = ($::opt_C ? "" : (
- $::opt_c || $::Config{perladmin} || $::Config{cf_email} || $::Config{cf_by}
- ));
-
- # My username
- $me = ( $Is_MSWin32
- ? $ENV{'USERNAME'}
- : ( $^O eq 'os2'
- ? $ENV{'USER'} || $ENV{'LOGNAME'}
- : eval { getpwuid($<) }) ); # May be missing
-
-}
+ }
+ # Possible administrator addresses, in order of confidence
+ # (Note that cf_email is not mentioned to metaconfig, since
+ # we don't really want it. We'll just take it if we have to.)
+ #
+ # This has to be after the $ok stuff above because of the way
+ # that $::opt_C is forced.
+ $cc = $::opt_C ? "" : (
+ $::opt_c || $::Config{'perladmin'}
+ || $::Config{'cf_email'} || $::Config{'cf_by'}
+ );
+
+ # My username
+ $me = $Is_MSWin32 ? $ENV{'USERNAME'}
+ : $^O eq 'os2' ? $ENV{'USER'} || $ENV{'LOGNAME'}
+ : eval { getpwuid($<) }; # May be missing
+
+ $from = $::Config{'cf_email'}
+ if !$from && $::Config{'cf_email'} && $::Config{'cf_by'} && $me &&
+ ($me eq $::Config{'cf_by'});
+} # sub Init
sub Query {
-
- # Explain what perlbug is
- if ( ! $ok ) {
+ # Explain what perlbug is
+ unless ($ok) {
paraprint <<EOF;
This program provides an easy way to create a message reporting a bug
in perl, and e-mail it to $address. It is *NOT* intended for
@@ -263,156 +276,121 @@ and any solutions to such problems, to the people who maintain perl.
If you're just looking for help with perl, try posting to the Usenet
newsgroup comp.lang.perl.misc. If you're looking for help with using
perl with CGI, try posting to comp.infosystems.www.programming.cgi.
-
EOF
}
-
- # Prompt for subject of message, if needed
- if(! $subject) {
- paraprint <<EOF;
-First of all, please provide a subject for the
-message. It should be a concise description of
+ # Prompt for subject of message, if needed
+ unless ($subject) {
+ paraprint <<EOF;
+First of all, please provide a subject for the
+message. It should be a concise description of
the bug or problem. "perl bug" or "perl problem"
is not a concise description.
-
EOF
- print "Subject: ";
-
- $subject = <>;
- chop $subject;
-
- my($err)=0;
- while( $subject =~ /^\s*$/ ) {
- print "\nPlease enter a subject: ";
- $subject = <>;
- chop $subject;
- if($err++>5) {
- die "Aborting.\n";
- }
- }
+ print "Subject: ";
+ $subject = <>;
+
+ my $err = 0;
+ while ($subject !~ /\S/) {
+ print "\nPlease enter a subject: ";
+ $subject = <>;
+ if ($err++ > 5) {
+ die "Aborting.\n";
+ }
}
-
-
- # Prompt for return address, if needed
- if( !$from) {
-
- # Try and guess return address
- my($domain);
-
- if($::HaveUtil) {
- $domain = Mail::Util::maildomain();
- } elsif ($Is_MSWin32) {
- $domain = $ENV{'USERDOMAIN'};
+ chop $subject;
+ }
+
+ # Prompt for return address, if needed
+ unless ($from) {
+ # Try and guess return address
+ my $guess;
+
+ $guess = $ENV{'REPLY-TO'} || $ENV{'REPLYTO'} || '';
+ unless ($guess) {
+ my $domain;
+ if ($::HaveUtil) {
+ $domain = Mail::Util::maildomain();
+ } elsif ($Is_MSWin32) {
+ $domain = $ENV{'USERDOMAIN'};
+ } else {
+ require Sys::Hostname;
+ $domain = Sys::Hostname::hostname();
+ }
+ if ($domain) {
+ if ($Is_VMS && !$::Config{'d_socket'}) {
+ $guess = "$domain\:\:$me";
} else {
- require Sys::Hostname;
- $domain = Sys::Hostname::hostname();
+ $guess = "$me\@$domain" if $domain;
}
-
- my($guess);
-
- if( !$domain) {
- $guess = "";
- } elsif ($Is_VMS && !$::Config{'d_socket'}) {
- $guess = "$domain\:\:$me";
- } else {
- $guess = "$me\@$domain" if $domain;
- $guess = "$me\@unknown.addresss" unless $domain;
- }
-
- $guess = $ENV{'REPLYTO'} if defined($ENV{'REPLYTO'});
- $guess = $ENV{"REPLY-TO"} if defined($ENV{'REPLY-TO'});
-
- if( $guess ) {
- if ( ! $ok ) {
- paraprint <<EOF;
-
+ }
+ }
+ if ($guess) {
+ unless ($ok) {
+ paraprint <<EOF;
Your e-mail address will be useful if you need to be contacted. If the
default shown is not your full internet e-mail address, please correct it.
-
EOF
- }
- } else {
- paraprint <<EOF;
-
-So that you may be contacted if necessary, please enter
+ }
+ } else {
+ paraprint <<EOF;
+So that you may be contacted if necessary, please enter
your full internet e-mail address here.
-
EOF
- }
-
- if ( $ok && $guess ne '' ) {
- # use it
- $from = $guess;
- }
- else {
- # verify it
- print "Your address [$guess]: ";
-
- $from = <>;
- chop $from;
-
- if($from eq "") { $from = $guess }
- }
-
}
-
- #if( $from =~ /^(.*)\@(.*)$/ ) {
- # $mailname = $1;
- # $maildomain = $2;
- #}
-
- if( $from eq $cc or $me eq $cc ) {
- # Try not to copy ourselves
- $cc = "yourself";
- }
-
- # Prompt for administrator address, unless an override was given
- if( !$::opt_C and !$::opt_c ) {
- paraprint <<EOF;
+ if ($ok && $guess) {
+ # use it
+ $from = $guess;
+ } else {
+ # verify it
+ print "Your address [$guess]: ";
+ $from = <>;
+ chop $from;
+ $from = $guess if $from eq '';
+ }
+ }
+ if ($from eq $cc or $me eq $cc) {
+ # Try not to copy ourselves
+ $cc = "yourself";
+ }
+ # Prompt for administrator address, unless an override was given
+ if( !$::opt_C and !$::opt_c ) {
+ paraprint <<EOF;
A copy of this report can be sent to your local
-perl administrator. If the address is wrong, please
+perl administrator. If the address is wrong, please
correct it, or enter 'none' or 'yourself' to not send
a copy.
-
EOF
+ print "Local perl administrator [$cc]: ";
+ my $entry = scalar <>;
+ chop $entry;
- print "Local perl administrator [$cc]: ";
-
- my($entry) = scalar(<>);
- chop $entry;
-
- if($entry ne "") {
- $cc = $entry;
- if($me eq $cc) { $cc = "" }
- }
-
+ if ($entry ne "") {
+ $cc = $entry;
+ $cc = '' if $me eq $cc;
}
+ }
- if($cc =~ /^(none|yourself|me|myself|ourselves)$/i) { $cc = "" }
-
- $andcc = " and $cc" if $cc;
+ $cc = '' if $cc =~ /^(none|yourself|me|myself|ourselves)$/i;
+ $andcc = " and $cc" if $cc;
+ # Prompt for editor, if no override is given
editor:
-
- # Prompt for editor, if no override is given
- if(! $::opt_e and ! $::opt_f and ! $::opt_b) {
- paraprint <<EOF;
-
-
+ unless ($::opt_e || $::opt_f || $::opt_b) {
+ paraprint <<EOF;
Now you need to supply the bug report. Try to make
-the report concise but descriptive. Include any
+the report concise but descriptive. Include any
relevant detail. If you are reporting something
that does not work as you think it should, please
-try to include example of both the actual
+try to include example of both the actual
result, and what you expected.
Some information about your local
-perl configuration will automatically be included
+perl configuration will automatically be included
at the end of the report. If you are using any
unusual version of perl, please try and confirm
exactly which versions are relevant.
@@ -424,96 +402,71 @@ the name of the editor you would like to use.
If you would like to use a prepared file, type
"file", and you will be asked for the filename.
-
EOF
-
- print "Editor [$ed]: ";
-
- my($entry) =scalar(<>);
- chop $entry;
-
- $usefile = 0;
- if($entry eq "file") {
- $usefile = 1;
- } elsif($entry ne "") {
- $ed = $entry;
- }
+ print "Editor [$ed]: ";
+ my $entry =scalar <>;
+ chop $entry;
+
+ $usefile = 0;
+ if ($entry eq "file") {
+ $usefile = 1;
+ } elsif ($entry ne "") {
+ $ed = $entry;
}
+ }
+ # Generate scratch file to edit report in
+ $filename = filename();
- # Generate scratch file to edit report in
-
- {
- my($dir) = ($Is_VMS ? 'sys$scratch:' :
- (($Is_MSWin32 && $ENV{'TEMP'}) ? $ENV{'TEMP'} : '/tmp/'));
- $filename = "bugrep0$$";
- $dir .= "\\" if $Is_MSWin32 and $dir !~ m|[\\/]$|;
- $filename++ while -e "$dir$filename";
- $filename = "$dir$filename";
- }
-
-
- # Prompt for file to read report from, if needed
-
- if( $usefile and ! $file) {
+ # Prompt for file to read report from, if needed
+ if ($usefile and !$file) {
filename:
- paraprint <<EOF;
-
+ paraprint <<EOF;
What is the name of the file that contains your report?
-
EOF
+ print "Filename: ";
+ my $entry = scalar <>;
+ chop $entry;
- print "Filename: ";
-
- my($entry) = scalar(<>);
- chop($entry);
-
- if($entry eq "") {
- paraprint <<EOF;
-
-No filename? I'll let you go back and choose an editor again.
-
+ if ($entry eq "") {
+ paraprint <<EOF;
+No filename? I'll let you go back and choose an editor again.
EOF
- goto editor;
- }
-
- if(!-f $entry or !-r $entry) {
- paraprint <<EOF;
-
+ goto editor;
+ }
+
+ unless (-f $entry and -r $entry) {
+ paraprint <<EOF;
I'm sorry, but I can't read from `$entry'. Maybe you mistyped the name of
the file? If you don't want to send a file, just enter a blank line and you
can get back to the editor selection.
-
EOF
- goto filename;
- }
- $file = $entry;
-
+ goto filename;
}
+ $file = $entry;
+ }
+ # Generate report
+ open(REP,">$filename");
+ my $reptype = !$ok ? "bug" : $::opt_n ? "build failure" : "success";
- # Generate report
-
- open(REP,">$filename");
-
- my $reptype = $ok ? "success" : "bug";
-
- print REP <<EOF;
+ print REP <<EOF;
This is a $reptype report for perl from $from,
generated with the help of perlbug $Version running under perl $].
EOF
- if($body) {
- print REP $body;
- } elsif($usefile) {
- open(F,"<$file") or die "Unable to read report file from `$file': $!\n";
- while(<F>) {
- print REP $_
- }
- close(F);
- } else {
- print REP <<EOF;
+ if ($body) {
+ print REP $body;
+ } elsif ($usefile) {
+ open(F, "<$file")
+ or die "Unable to read report file from `$file': $!\n";
+ while (<F>) {
+ print REP $_
+ }
+ close(F);
+ } else {
+ print REP <<EOF;
-----------------------------------------------------------------
[Please enter your report here]
@@ -523,164 +476,138 @@ EOF
[Please do not change anything below this line]
-----------------------------------------------------------------
EOF
- }
-
- Dump(*REP);
- close(REP);
-
- # read in the report template once so that
- # we can track whether the user does any editing.
- # yes, *all* whitespace is ignored.
- open(REP, "<$filename");
- while (<REP>) {
- s/\s+//g;
- $REP{$_}++;
- }
- close(REP);
-
-}
+ }
+ Dump(*REP);
+ close(REP);
+
+ # read in the report template once so that
+ # we can track whether the user does any editing.
+ # yes, *all* whitespace is ignored.
+ open(REP, "<$filename");
+ while (<REP>) {
+ s/\s+//g;
+ $REP{$_}++;
+ }
+ close(REP);
+} # sub Query
sub Dump {
- local(*OUT) = @_;
-
- print REP "\n---\n";
+ local(*OUT) = @_;
- print REP "This perlbug was built using Perl $config_tag1\n",
- "It is being executed now by Perl $config_tag2.\n\n"
- if $config_tag2 ne $config_tag1;
+ print REP "\n---\n";
+ print REP "This perlbug was built using Perl $config_tag1\n",
+ "It is being executed now by Perl $config_tag2.\n\n"
+ if $config_tag2 ne $config_tag1;
- print OUT <<EOF;
+ print OUT <<EOF;
Site configuration information for perl $]:
EOF
+ if ($::Config{cf_by} and $::Config{cf_time}) {
+ print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
+ }
+ print OUT Config::myconfig;
- if( $::Config{cf_by} and $::Config{cf_time}) {
- print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
- }
-
- print OUT Config::myconfig;
-
- if (@patches) {
- print OUT join "\n\t", "Locally applied patches:", @patches;
- print OUT "\n";
- };
+ if (@patches) {
+ print OUT join "\n ", "Locally applied patches:", @patches;
+ print OUT "\n";
+ };
- print OUT <<EOF;
+ print OUT <<EOF;
---
\@INC for perl $]:
EOF
- for my $i (@INC) {
- print OUT "\t$i\n";
- }
+ for my $i (@INC) {
+ print OUT " $i\n";
+ }
- print OUT <<EOF;
+ print OUT <<EOF;
---
Environment for perl $]:
EOF
- for my $env (sort
- (qw(PATH LD_LIBRARY_PATH
- LANG PERL_BADLANG
- SHELL HOME LOGDIR),
- grep { /^(?:PERL|LC_)/ } keys %ENV)) {
- print OUT " $env",
- exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)',
- "\n";
- }
- if($verbose) {
- print OUT "\nComplete configuration data for perl $]:\n\n";
- my($value);
- foreach (sort keys %::Config) {
- $value = $::Config{$_};
- $value =~ s/'/\\'/g;
- print OUT "$_='$value'\n";
- }
+ for my $env (sort
+ (qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR LANGUAGE),
+ grep /^(?:PERL|LC_)/, keys %ENV)
+ ) {
+ print OUT " $env",
+ exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)',
+ "\n";
+ }
+ if ($verbose) {
+ print OUT "\nComplete configuration data for perl $]:\n\n";
+ my $value;
+ foreach (sort keys %::Config) {
+ $value = $::Config{$_};
+ $value =~ s/'/\\'/g;
+ print OUT "$_='$value'\n";
}
-}
+ }
+} # sub Dump
sub Edit {
- # Edit the report
-
- if($usefile) {
- $usefile = 0;
- paraprint <<EOF;
-
+ # Edit the report
+ if ($usefile || $body) {
+ paraprint <<EOF;
Please make sure that the name of the editor you want to use is correct.
-
EOF
- print "Editor [$ed]: ";
-
- my($entry) =scalar(<>);
- chop $entry;
-
- if($entry ne "") {
- $ed = $entry;
- }
- }
-
-tryagain:
- if(!$usefile and !$body) {
- my $sts = system("$ed $filename");
- if($sts) {
- #print "\nUnable to run editor!\n";
- paraprint <<EOF;
+ print "Editor [$ed]: ";
+ my $entry =scalar <>;
+ chop $entry;
+ $ed = $entry unless $entry eq '';
+ }
+tryagain:
+ my $sts = system("$ed $filename");
+ if ($sts) {
+ paraprint <<EOF;
The editor you chose (`$ed') could apparently not be run!
Did you mistype the name of your editor? If so, please
-correct it here, otherwise just press Enter.
-
+correct it here, otherwise just press Enter.
EOF
- print "Editor [$ed]: ";
-
- my($entry) =scalar(<>);
- chop $entry;
-
- if($entry ne "") {
- $ed = $entry;
- goto tryagain;
- } else {
-
- paraprint <<EOF;
+ print "Editor [$ed]: ";
+ my $entry =scalar <>;
+ chop $entry;
+ if ($entry ne "") {
+ $ed = $entry;
+ goto tryagain;
+ } else {
+ paraprint <<EOF;
You may want to save your report to a file, so you can edit and mail it
yourself.
EOF
- }
- }
- }
-
- return if $ok;
- # Check that we have a report that has some, eh, report in it.
-
- my $unseen = 0;
-
- open(REP, "<$filename");
- # a strange way to check whether any significant editing
- # have been done: check whether any new non-empty lines
- # have been added. Yes, the below code ignores *any* space
- # in *any* line.
- while (<REP>) {
- s/\s+//g;
- $unseen++ if ($_ ne '' and not exists $REP{$_});
}
+ }
- while ($unseen == 0) {
- paraprint <<EOF;
+ return if ($ok and not $::opt_n) || $body;
+ # Check that we have a report that has some, eh, report in it.
+ my $unseen = 0;
+
+ open(REP, "<$filename");
+ # a strange way to check whether any significant editing
+ # have been done: check whether any new non-empty lines
+ # have been added. Yes, the below code ignores *any* space
+ # in *any* line.
+ while (<REP>) {
+ s/\s+//g;
+ $unseen++ if $_ ne '' and not exists $REP{$_};
+ }
+ while ($unseen == 0) {
+ paraprint <<EOF;
I am sorry but it looks like you did not report anything.
-
EOF
- print "Action (Retry Edit/Cancel) ";
- my ($action) = scalar(<>);
- if ($action =~ /^[re]/i) { # <R>etry <E>dit
- goto tryagain;
- } elsif ($action =~ /^[cq]/i) { # <C>ancel, <Q>uit
- Cancel();
- }
- }
-
-}
+ print "Action (Retry Edit/Cancel) ";
+ my ($action) = scalar(<>);
+ if ($action =~ /^[re]/i) { # <R>etry <E>dit
+ goto tryagain;
+ } elsif ($action =~ /^[cq]/i) { # <C>ancel, <Q>uit
+ Cancel();
+ }
+ }
+} # sub Edit
sub Cancel {
1 while unlink($filename); # remove all versions under VMS
@@ -689,227 +616,221 @@ sub Cancel {
}
sub NowWhat {
-
- # Report is done, prompt for further action
- if( !$::opt_S ) {
- while(1) {
-
- paraprint <<EOF;
-
-
-Now that you have completed your report, would you like to send
-the message to $address$andcc, display the message on
+ # Report is done, prompt for further action
+ if( !$::opt_S ) {
+ while(1) {
+ paraprint <<EOF;
+Now that you have completed your report, would you like to send
+the message to $address$andcc, display the message on
the screen, re-edit it, or cancel without sending anything?
You may also save the message as a file to mail at another time.
-
EOF
-
- print "Action (Send/Display/Edit/Cancel/Save to File): ";
- my($action) = scalar(<>);
- chop $action;
-
- if( $action =~ /^(f|sa)/i ) { # <F>ile/<Sa>ve
- print "\n\nName of file to save message in [perlbug.rep]: ";
- my($file) = scalar(<>);
- chop $file;
- if($file eq "") { $file = "perlbug.rep" }
-
- open(FILE,">$file");
- open(REP,"<$filename");
- print FILE "To: $address\nSubject: $subject\n";
- print FILE "Cc: $cc\n" if $cc;
- print FILE "Reply-To: $from\n" if $from;
- print FILE "\n";
- while(<REP>) { print FILE }
- close(REP);
- close(FILE);
-
- print "\nMessage saved in `$file'.\n";
- exit;
-
- } elsif( $action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
- # Display the message
- open(REP,"<$filename");
- while(<REP>) { print $_ }
- close(REP);
- } elsif( $action =~ /^se/i ) { # <S>end
- # Send the message
- print "\
-Are you certain you want to send this message?
-Please type \"yes\" if you are: ";
- my($reply) = scalar(<STDIN>);
- chop($reply);
- if( $reply eq "yes" ) {
- last;
- } else {
- paraprint <<EOF;
-
+ retry:
+ print "Action (Send/Display/Edit/Cancel/Save to File): ";
+ my $action = scalar <>;
+ chop $action;
+
+ if ($action =~ /^(f|sa)/i) { # <F>ile/<Sa>ve
+ print "\n\nName of file to save message in [perlbug.rep]: ";
+ my $file = scalar <>;
+ chop $file;
+ $file = "perlbug.rep" if $file eq "";
+
+ unless (open(FILE, ">$file")) {
+ print "\nError opening $file: $!\n\n";
+ goto retry;
+ }
+ open(REP, "<$filename");
+ print FILE "To: $address\nSubject: $subject\n";
+ print FILE "Cc: $cc\n" if $cc;
+ print FILE "Reply-To: $from\n" if $from;
+ print FILE "\n";
+ while (<REP>) { print FILE }
+ close(REP);
+ close(FILE);
+
+ print "\nMessage saved in `$file'.\n";
+ exit;
+ } elsif ($action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
+ # Display the message
+ open(REP, "<$filename");
+ while (<REP>) { print $_ }
+ close(REP);
+ } elsif ($action =~ /^se/i) { # <S>end
+ # Send the message
+ print "Are you certain you want to send this message?\n"
+ . 'Please type "yes" if you are: ';
+ my $reply = scalar <STDIN>;
+ chop $reply;
+ if ($reply eq "yes") {
+ last;
+ } else {
+ paraprint <<EOF;
That wasn't a clear "yes", so I won't send your message. If you are sure
your message should be sent, type in "yes" (without the quotes) at the
confirmation prompt.
-
EOF
-
- }
- } elsif( $action =~ /^[er]/i ) { # <E>dit, <R>e-edit
- # edit the message
- Edit();
- #system("$ed $filename");
- } elsif( $action =~ /^[qc]/i ) { # <C>ancel, <Q>uit
- Cancel();
- } elsif( $action =~ /^s/ ) {
- paraprint <<EOF;
-
+ }
+ } elsif ($action =~ /^[er]/i) { # <E>dit, <R>e-edit
+ # edit the message
+ Edit();
+ } elsif ($action =~ /^[qc]/i) { # <C>ancel, <Q>uit
+ Cancel();
+ } elsif ($action =~ /^s/) {
+ paraprint <<EOF;
I'm sorry, but I didn't understand that. Please type "send" or "save".
EOF
- }
-
- }
+ }
}
-}
-
+ }
+} # sub NowWhat
sub Send {
+ # Message has been accepted for transmission -- Send the message
+ if ($outfile) {
+ open SENDMAIL, ">$outfile" or die "Couldn't open '$outfile': $!\n";
+ goto sendout;
+ }
+ if ($::HaveSend) {
+ $msg = new Mail::Send Subject => $subject, To => $address;
+ $msg->cc($cc) if $cc;
+ $msg->add("Reply-To",$from) if $from;
+
+ $fh = $msg->open;
+ open(REP, "<$filename");
+ while (<REP>) { print $fh $_ }
+ close(REP);
+ $fh->close;
+
+ print "\nMessage sent.\n";
+ } elsif ($Is_VMS) {
+ if ( ($address =~ /@/ and $address !~ /^\w+%"/) or
+ ($cc =~ /@/ and $cc !~ /^\w+%"/) ) {
+ my $prefix;
+ foreach (qw[ IN MX SMTP UCX PONY WINS ], '') {
+ $prefix = "$_%", last if $ENV{"MAIL\$PROTOCOL_$_"};
+ }
+ $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
+ $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
+ }
+ $subject =~ s/"/""/g; $address =~ s/"/""/g; $cc =~ s/"/""/g;
+ my $sts = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
+ if ($sts) {
+ die <<EOF;
+Can't spawn off mail
+ (leaving bug report in $filename): $sts
+EOF
+ }
+ } else {
+ my $sendmail = "";
+ for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) {
+ $sendmail = $_, last if -e $_;
+ }
+ if ($^O eq 'os2' and $sendmail eq "") {
+ my $path = $ENV{PATH};
+ $path =~ s:\\:/: ;
+ my @path = split /$Config{'path_sep'}/, $path;
+ for (@path) {
+ $sendmail = "$_/sendmail", last if -e "$_/sendmail";
+ $sendmail = "$_/sendmail.exe", last if -e "$_/sendmail.exe";
+ }
+ }
- # Message has been accepted for transmission -- Send the message
-
- if($::HaveSend) {
-
- $msg = new Mail::Send Subject => $subject, To => $address;
-
- $msg->cc($cc) if $cc;
- $msg->add("Reply-To",$from) if $from;
-
- $fh = $msg->open;
-
- open(REP,"<$filename");
- while(<REP>) { print $fh $_ }
- close(REP);
-
- $fh->close;
-
- print "\nMessage sent.\n";
- } else {
- if ($Is_VMS) {
- if ( ($address =~ /@/ and $address !~ /^\w+%"/) or
- ($cc =~ /@/ and $cc !~ /^\w+%"/) ){
- my($prefix);
- foreach (qw[ IN MX SMTP UCX PONY WINS ],'') {
- $prefix = "$_%",last if $ENV{"MAIL\$PROTOCOL_$_"};
- }
- $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
- $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
- }
- $subject =~ s/"/""/g; $address =~ s/"/""/g; $cc =~ s/"/""/g;
- my($sts) = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
- if ($sts) { die "Can't spawn off mail\n\t(leaving bug report in $filename): $sts\n;" }
- } else {
- my($sendmail) = "";
-
- foreach (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail))
- {
- $sendmail = $_, last if -e $_;
- }
-
- if ($^O eq 'os2' and $sendmail eq "") {
- my $path = $ENV{PATH};
- $path =~ s:\\:/: ;
- my @path = split /$Config{path_sep}/, $path;
- for (@path) {
- $sendmail = "$_/sendmail", last
- if -e "$_/sendmail";
- $sendmail = "$_/sendmail.exe", last
- if -e "$_/sendmail.exe";
- }
- }
-
- paraprint(<<"EOF"), die "\n" if $sendmail eq "";
-
+ paraprint(<<"EOF"), die "\n" if $sendmail eq "";
I am terribly sorry, but I cannot find sendmail, or a close equivalent, and
the perl package Mail::Send has not been installed, so I can't send your bug
report. We apologize for the inconvenience.
So you may attempt to find some way of sending your message, it has
been left in the file `$filename'.
-
EOF
-
- open(SENDMAIL,"|$sendmail -t") || die "'|$sendmail -t' failed: $|";
- print SENDMAIL "To: $address\n";
- print SENDMAIL "Subject: $subject\n";
- print SENDMAIL "Cc: $cc\n" if $cc;
- print SENDMAIL "Reply-To: $from\n" if $from;
- print SENDMAIL "\n\n";
- open(REP,"<$filename");
- while(<REP>) { print SENDMAIL $_ }
- close(REP);
-
- if (close(SENDMAIL)) {
- print "\nMessage sent.\n";
- } else {
- warn "\nSendmail returned status '",$?>>8,"'\n";
- }
- }
-
- }
-
- 1 while unlink($filename); # remove all versions under VMS
+ open(SENDMAIL, "|$sendmail -t") || die "'|$sendmail -t' failed: $!";
+sendout:
+ print SENDMAIL "To: $address\n";
+ print SENDMAIL "Subject: $subject\n";
+ print SENDMAIL "Cc: $cc\n" if $cc;
+ print SENDMAIL "Reply-To: $from\n" if $from;
+ print SENDMAIL "\n\n";
+ open(REP, "<$filename");
+ while (<REP>) { print SENDMAIL $_ }
+ close(REP);
-}
+ if (close(SENDMAIL)) {
+ printf "\nMessage %s.\n", $outfile ? "saved" : "sent";
+ } else {
+ warn "\nSendmail returned status '", $? >> 8, "'\n";
+ }
+ }
+ 1 while unlink($filename); # remove all versions under VMS
+} # sub Send
sub Help {
- print <<EOF;
+ print <<EOF;
-A program to help generate bug reports about perl5, and mail them.
+A program to help generate bug reports about perl5, and mail them.
It is designed to be used interactively. Normally no arguments will
be needed.
-
+
Usage:
-$0 [-v] [-a address] [-s subject] [-b body | -f file ]
+$0 [-v] [-a address] [-s subject] [-b body | -f inpufile ] [ -F outputfile ]
[-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t] [-h]
-
+$0 [-v] [-r returnaddress] [-ok | -okay | -nok | -nokay]
+
Simplest usage: run "$0", and follow the prompts.
Options:
-v Include Verbose configuration data in the report
- -f File containing the body of the report. Use this to
+ -f File containing the body of the report. Use this to
quickly send a prepared message.
+ -F File to output the resulting mail message to, instead of mailing.
-S Send without asking for confirmation.
-a Address to send the report to. Defaults to `$address'.
-c Address to send copy of report to. Defaults to `$cc'.
-C Don't send copy to administrator.
- -s Subject to include with the message. You will be prompted
+ -s Subject to include with the message. You will be prompted
if you don't supply one on the command line.
-b Body of the report. If not included on the command line, or
in a file with -f, you will get a chance to edit the message.
-r Your return address. The program will ask you to confirm
this if you don't give it here.
- -e Editor to use.
+ -e Editor to use.
-t Test mode. The target address defaults to `$testaddress'.
- -d Data mode (the default if you redirect or pipe output.)
+ -d Data mode (the default if you redirect or pipe output.)
This prints out your configuration data, without mailing
anything. You can use this with -v to get more complete data.
-ok Report successful build on this system to perl porters
- (use alone or with -v). Only use -ok if *everything* was ok.
- If there were *any* problems at all then don't use -ok.
+ (use alone or with -v). Only use -ok if *everything* was ok:
+ if there were *any* problems at all, use -nok.
-okay As -ok but allow report from old builds.
- -h Print this help message.
-
+ -nok Report unsuccessful build on this system to perl porters
+ (use alone or with -v). You must describe what went wrong
+ in the body of the report which you will be asked to edit.
+ -nokay As -nok but allow report from old builds.
+ -h Print this help message.
+
EOF
}
+sub filename {
+ my $dir = $Is_VMS ? 'sys$scratch:'
+ : ($Is_MSWin32 && $ENV{'TEMP'}) ? $ENV{'TEMP'}
+ : '/tmp/';
+ $filename = "bugrep0$$";
+ $dir .= "\\" if $Is_MSWin32 and $dir !~ m|[\\/]$|;
+ $filename++ while -e "$dir$filename";
+ $filename = "$dir$filename";
+}
+
sub paraprint {
my @paragraphs = split /\n{2,}/, "@_";
print "\n\n";
for (@paragraphs) { # implicit local $_
- s/(\S)\s*\n/$1 /g;
- write;
- print "\n";
+ s/(\S)\s*\n/$1 /g;
+ write;
+ print "\n";
}
-
}
-
format STDOUT =
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
@@ -925,16 +846,18 @@ perlbug - how to submit bug reports on Perl
=head1 SYNOPSIS
B<perlbug> S<[ B<-v> ]> S<[ B<-a> I<address> ]> S<[ B<-s> I<subject> ]>
-S<[ B<-b> I<body> | B<-f> I<file> ]> S<[ B<-r> I<returnaddress> ]>
+S<[ B<-b> I<body> | B<-f> I<inputfile> ]> S<[ B<-F> I<outputfile> ]>
+S<[ B<-r> I<returnaddress> ]>
S<[ B<-e> I<editor> ]> S<[ B<-c> I<adminaddress> | B<-C> ]>
S<[ B<-S> ]> S<[ B<-t> ]> S<[ B<-d> ]> S<[ B<-h> ]>
-B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]> S<[ B<-ok> | B<okay> ]>
+B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]>
+S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
=head1 DESCRIPTION
A program to help generate bug reports about perl or the modules that
-come with it, and mail them.
+come with it, and mail them.
If you have found a bug with a non-standard port (one that was not part
of the I<standard distribution>), a binary distribution, or a
@@ -978,6 +901,13 @@ it all, but at least have a look at the sections that I<seem> relevant).
Be aware of the familiar traps that perl programmers of various hues
fall into. See L<perltrap>.
+Check in L<perldiag> to see what any Perl error message(s) mean.
+If message isn't in perldiag, it probably isn't generated by Perl.
+Consult your operating system documentation instead.
+
+If you are on a non-UNIX platform check also L<perlport>, some
+features may not be implemented or work differently.
+
Try to study the problem under the perl debugger, if necessary.
See L<perldebug>.
@@ -993,6 +923,17 @@ A good test case is almost always a good candidate to be on the perl
test suite. If you have the time, consider making your test case so
that it will readily fit into the standard test suite.
+Remember also to include the B<exact> error messages, if any.
+"Perl complained something" is not an exact error message.
+
+If you get a core dump (or equivalent), you may use a debugger
+(B<dbx>, B<gdb>, etc) to produce a stack trace to include in the bug
+report. NOTE: unless your Perl has been compiled with debug info
+(often B<-g>), the stack trace is likely to be somewhat hard to use
+because it will most probably contain only the function names, not
+their arguments. If possible, recompile your Perl with debug info and
+reproduce the dump and the stack trace.
+
=item Can you describe the bug in plain English?
The easier it is to understand a reproducible bug, the more likely it
@@ -1031,6 +972,11 @@ it to B<perlbug@perl.com>. If, for some reason, you cannot run
C<perlbug> at all on your system, be sure to include the entire output
produced by running C<perl -V> (note the uppercase V).
+Whether you use C<perlbug> or send the email manually, please make
+your subject informative. "a bug" not informative. Neither is "perl
+crashes" nor "HELP!!!", these all are null information. A compact
+description of what's wrong is fine.
+
=back
Having done your bit, please be prepared to wait, to be told the bug
@@ -1073,13 +1019,19 @@ with B<-v> to get more complete data.
=item B<-e>
-Editor to use.
+Editor to use.
=item B<-f>
File containing the body of the report. Use this to quickly send a
prepared message.
+=item B<-F>
+
+File to output the results to instead of sending as an email. Useful
+particularly when running perlbug on a machine with no direct internet
+connection.
+
=item B<-h>
Prints a brief summary of the options.
@@ -1097,6 +1049,21 @@ system is less than 60 days old.
As B<-ok> except it will report on older systems.
+=item B<-nok>
+
+Report unsuccessful build on this system. Forces B<-C>. Forces and
+supplies a value for B<-s>, then requires you to edit the report
+and say what went wrong. Alternatively, a prepared report may be
+supplied using B<-f>. Only prompts for a return address if it
+cannot guess it (for use with B<make>). Honors return address
+specified with B<-r>. You can use this with B<-v> to get more
+complete data. Only makes a report if this system is less than 60
+days old.
+
+=item B<-nokay>
+
+As B<-nok> except it will report on older systems.
+
=item B<-r>
Your return address. The program will ask you to confirm its default
@@ -1126,12 +1093,15 @@ Include verbose configuration data in the report.
Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently I<doc>tored
by Gurusamy Sarathy (E<lt>gsar@umich.eduE<gt>), Tom Christiansen
(E<lt>tchrist@perl.comE<gt>), Nathan Torkington (E<lt>gnat@frii.comE<gt>),
-Charles F. Randall (E<lt>cfr@pobox.comE<gt>) and
-Mike Guy (E<lt>mjtg@cam.a.ukE<gt>).
+Charles F. Randall (E<lt>cfr@pobox.comE<gt>), Mike Guy
+(E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop (E<lt>domo@computer.orgE<gt>),
+Hugo van der Sanden (E<lt>hv@crypt0.demon.co.ukE<gt>), and
+Jarkko Hietaniemi (E<lt>jhi@iki.fiE<gt>).
=head1 SEE ALSO
-perl(1), perldebug(1), perltrap(1), diff(1), patch(1)
+perl(1), perldebug(1), perldiag(1), perlport(1), perltrap(1),
+diff(1), patch(1), dbx(1), gdb(1)
=head1 BUGS
@@ -1144,4 +1114,4 @@ None known (guess what must have been used to report them?)
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
-
+chdir $origdir;
diff --git a/gnu/usr.bin/perl/utils/perldoc.PL b/gnu/usr.bin/perl/utils/perldoc.PL
index d223a9aaf90..26335101c01 100644
--- a/gnu/usr.bin/perl/utils/perldoc.PL
+++ b/gnu/usr.bin/perl/utils/perldoc.PL
@@ -2,6 +2,7 @@
use Config;
use File::Basename qw(&basename &dirname);
+use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
@@ -12,6 +13,7 @@ use File::Basename qw(&basename &dirname);
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
@@ -26,9 +28,10 @@ print "Extracting $file (with variable substitutions)\n";
print OUT <<"!GROK!THIS!";
$Config{startperl}
eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
- if \$running_under_some_shell;
+ if 0;
-\@pagers = ();
+use strict;
+my \@pagers = ();
push \@pagers, "$Config{'pager'}" if -x "$Config{'pager'}";
!GROK!THIS!
@@ -45,25 +48,27 @@ print OUT <<'!NO!SUBS!';
# the perl manuals, though it too is written in perl.
if(@ARGV<1) {
- $me = $0; # Editing $0 is unportable
+ my $me = $0; # Editing $0 is unportable
$me =~ s,.*/,,;
die <<EOF;
-Usage: $me [-h] [-v] [-t] [-u] [-m] [-l] PageName|ModuleName|ProgramName
+Usage: $me [-h] [-r] [-i] [-v] [-t] [-u] [-m] [-l] [-F] [-X] PageName|ModuleName|ProgramName
$me -f PerlFunc
+ $me -q FAQKeywords
-We suggest you use "perldoc perldoc" to get aquainted
-with the system.
+The -h option prints more help. Also try "perldoc perldoc" to get
+aquainted with the system.
EOF
}
use Getopt::Std;
use Config '%Config';
-@global_found = ();
-$global_target = "";
+my @global_found = ();
+my $global_target = "";
-$Is_VMS = $^O eq 'VMS';
-$Is_MSWin32 = $^O eq 'MSWin32';
+my $Is_VMS = $^O eq 'VMS';
+my $Is_MSWin32 = $^O eq 'MSWin32';
+my $Is_Dos = $^O eq 'dos';
sub usage{
warn "@_\n" if @_;
@@ -72,15 +77,21 @@ sub usage{
die <<EOF;
perldoc [options] PageName|ModuleName|ProgramName...
perldoc [options] -f BuiltinFunction
+perldoc [options] -q FAQRegex
Options:
-h Display this help message
+ -r Recursive search (slow)
+ -i Ignore case
-t Display pod using pod2text instead of pod2man and nroff
(-t is the default on win32)
-u Display unformatted pod text
- -m Display modules file in its entirety
- -l Display the modules file name
+ -m Display module's file in its entirety
+ -l Display the module's file name
+ -F Arguments are file names, not modules
-v Verbosely describe what's going on
+ -X use index if present (looks for pod.idx at $Config{archlib})
+ -q Search the text of questions (not answers) in perlfaq[1-9]
PageName|ModuleName...
is the name of a piece of documentation that you want to look at. You
@@ -92,32 +103,55 @@ PageName|ModuleName...
BuiltinFunction
is the name of a perl function. Will extract documentation from
`perlfunc'.
-
+
+FAQRegex
+ is a regex. Will search perlfaq[1-9] for and extract any
+ questions that match.
+
Any switches in the PERLDOC environment variable will be used before the
-command line arguments.
+command line arguments. The optional pod index file contains a list of
+filenames, one per line.
EOF
}
-use Text::ParseWords;
+if( defined $ENV{"PERLDOC"} ) {
+ require Text::ParseWords;
+ unshift(@ARGV, Text::ParseWords::shellwords($ENV{"PERLDOC"}));
+}
+!NO!SUBS!
+my $getopts = "mhtluvriFf:Xq:";
+print OUT <<"!GET!OPTS!";
-unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
+use vars qw( @{[map "\$opt_$_", ($getopts =~ /\w/g)]} );
-getopts("mhtluvf:") || usage;
+getopts("$getopts") || usage;
+!GET!OPTS!
-usage if $opt_h || $opt_h; # avoid -w warning
+print OUT <<'!NO!SUBS!';
-if ($opt_t + $opt_u + $opt_m + $opt_l > 1) {
+usage if $opt_h;
+
+my $podidx;
+if( $opt_X ) {
+ $podidx = "$Config{'archlib'}/pod.idx";
+ $podidx = "" unless -f $podidx && -r _ && -M _ <= 7;
+}
+
+if( (my $opts = do{ local $^W; $opt_t + $opt_u + $opt_m + $opt_l }) > 1) {
usage("only one of -t, -u, -m or -l")
-} elsif ($Is_MSWin32) {
- $opt_t = 1 unless $opt_t + $opt_u + $opt_m + $opt_l;
+} elsif ($Is_MSWin32 || $Is_Dos) {
+ $opt_t = 1 unless $opts
}
if ($opt_t) { require Pod::Text; import Pod::Text; }
+my @pages;
if ($opt_f) {
@pages = ("perlfunc");
+} elsif ($opt_q) {
+ @pages = ("perlfaq1" .. "perlfaq9");
} else {
@pages = @ARGV;
}
@@ -148,23 +182,26 @@ sub containspod {
}
sub minus_f_nocase {
- my($file) = @_;
- # on a case-forgiving file system we can simply use -f $file
- if ($Is_VMS or $Is_MSWin32 or $^O eq 'os2') {
- return $file if -f $file and -r _;
- warn "Ignored $file: unreadable\n" unless -r _;
+ my($dir,$file) = @_;
+ my $path = join('/',$dir,$file);
+ return $path if -f $path and -r _;
+ if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') {
+ # on a case-forgiving file system or if case is important
+ # that is it all we can do
+ warn "Ignored $path: unreadable\n" if -f _;
return '';
}
local *DIR;
local($")="/";
- my(@p,$p,$cip);
+ my @p = ($dir);
+ my($p,$cip);
foreach $p (split(/\//, $file)){
my $try = "@p/$p";
stat $try;
if (-d _){
push @p, $p;
if ( $p eq $global_target) {
- $tmp_path = join ('/', @p);
+ my $tmp_path = join ('/', @p);
my $path_f = 0;
for (@global_found) {
$path_f = 1 if $_ eq $tmp_path;
@@ -190,16 +227,22 @@ sub minus_f_nocase {
return "" unless $found;
push @p, $cip;
return "@p" if -f "@p" and -r _;
- warn "Ignored $file: unreadable\n" if -f _;
+ warn "Ignored @p: unreadable\n" if -f _;
}
}
- return; # is not a file
+ return "";
}
sub check_file {
- my($file) = @_;
- return minus_f_nocase($file) && containspod($file) ? $file : "";
+ my($dir,$file) = @_;
+ if ($opt_m) {
+ return minus_f_nocase($dir,$file);
+ } else {
+ my $path = minus_f_nocase($dir,$file);
+ return $path if length $path and containspod($path);
+ }
+ return "";
}
@@ -216,17 +259,17 @@ sub searchfor {
for ($i=0; $i<@dirs; $i++) {
$dir = $dirs[$i];
($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
- if ( ( $ret = check_file "$dir/$s.pod")
- or ( $ret = check_file "$dir/$s.pm")
- or ( $ret = check_file "$dir/$s")
+ if ( ( $ret = check_file $dir,"$s.pod")
+ or ( $ret = check_file $dir,"$s.pm")
+ or ( $ret = check_file $dir,$s)
or ( $Is_VMS and
- $ret = check_file "$dir/$s.com")
+ $ret = check_file $dir,"$s.com")
or ( $^O eq 'os2' and
- $ret = check_file "$dir/$s.cmd")
- or ( ($Is_MSWin32 or $^O eq 'os2') and
- $ret = check_file "$dir/$s.bat")
- or ( $ret = check_file "$dir/pod/$s.pod")
- or ( $ret = check_file "$dir/pod/$s")
+ $ret = check_file $dir,"$s.cmd")
+ or ( ($Is_MSWin32 or $Is_Dos or $^O eq 'os2') and
+ $ret = check_file $dir,"$s.bat")
+ or ( $ret = check_file "$dir/pod","$s.pod")
+ or ( $ret = check_file "$dir/pod",$s)
) {
return $ret;
}
@@ -248,24 +291,42 @@ sub searchfor {
return ();
}
-
+my @found;
foreach (@pages) {
+ if ($podidx && open(PODIDX, $podidx)) {
+ my $searchfor = $_;
+ local($_);
+ $searchfor =~ s,::,/,g;
+ print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v;
+ while (<PODIDX>) {
+ chomp;
+ push(@found, $_) if m,/$searchfor(?:\.(?:pod|pm))?$,i;
+ }
+ close(PODIDX);
+ next;
+ }
print STDERR "Searching for $_\n" if $opt_v;
# We must look both in @INC for library modules and in PATH
# for executables, like h2xs or perldoc itself.
- @searchdirs = @INC;
+ my @searchdirs = @INC;
+ if ($opt_F) {
+ next unless -r;
+ push @found, $_ if $opt_m or containspod($_);
+ next;
+ }
unless ($opt_m) {
if ($Is_VMS) {
my($i,$trn);
for ($i = 0; $trn = $ENV{'DCL$PATH'.$i}; $i++) {
push(@searchdirs,$trn);
}
+ push(@searchdirs,'perl_root:[lib.pod]') # installed pods
} else {
push(@searchdirs, grep(-d, split($Config{path_sep},
$ENV{'PATH'})));
}
- @files= searchfor(0,$_,@searchdirs);
}
+ my @files = searchfor(0,$_,@searchdirs);
if( @files ) {
print STDERR "Found as @files\n" if $opt_v;
} else {
@@ -273,17 +334,16 @@ foreach (@pages) {
@searchdirs = grep(!/^\.$/,@INC);
- @files= searchfor(1,$_,@searchdirs);
+ @files= searchfor(1,$_,@searchdirs) if $opt_r;
if( @files ) {
print STDERR "Loosely found as @files\n" if $opt_v;
} else {
print STDERR "No documentation found for \"$_\".\n";
if (@global_found) {
print STDERR "However, try\n";
- my $dir = $file = "";
- for $dir (@global_found) {
+ for my $dir (@global_found) {
opendir(DIR, $dir) or die "$!";
- while ($file = readdir(DIR)) {
+ while (my $file = readdir(DIR)) {
next if ($file =~ /^\./);
$file =~ s/\.(pm|pod)$//;
print STDERR "\tperldoc $_\::$file\n";
@@ -305,8 +365,12 @@ if ($opt_l) {
exit;
}
+my $lines = $ENV{LINES} || 24;
+
+my $no_tty;
if( ! -t STDOUT ) { $no_tty = 1 }
+my $tmp;
if ($Is_MSWin32) {
$tmp = "$ENV{TEMP}\\perldoc1.$$";
push @pagers, qw( more< less notepad );
@@ -314,10 +378,16 @@ if ($Is_MSWin32) {
} elsif ($Is_VMS) {
$tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
push @pagers, qw( most more less type/page );
+} elsif ($Is_Dos) {
+ $tmp = "$ENV{TEMP}/perldoc1.$$";
+ $tmp =~ tr!\\/!//!s;
+ push @pagers, qw( less.exe more.com< );
+ unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
} else {
if ($^O eq 'os2') {
require POSIX;
$tmp = POSIX::tmpnam();
+ unshift @pagers, 'less', 'cmd /c more <';
} else {
$tmp = "/tmp/perldoc1.$$";
}
@@ -327,7 +397,7 @@ if ($Is_MSWin32) {
unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
if ($opt_m) {
- foreach $pager (@pagers) {
+ foreach my $pager (@pagers) {
system("$pager @found") or exit;
}
if ($Is_VMS) { eval 'use vmsish qw(status exit); exit $?' }
@@ -338,6 +408,9 @@ if ($opt_f) {
my $perlfunc = shift @found;
open(PFUNC, $perlfunc) or die "Can't open $perlfunc: $!";
+ # Functions like -r, -e, etc. are listed under `-X'.
+ my $search_string = ($opt_f =~ /^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/) ? 'I<-X' : $opt_f ;
+
# Skip introduction
while (<PFUNC>) {
last if /^=head2 Alphabetical Listing of Perl Functions/;
@@ -347,7 +420,7 @@ if ($opt_f) {
my $found = 0;
my @pod;
while (<PFUNC>) {
- if (/^=item\s+\Q$opt_f\E\b/o) {
+ if (/^=item\s+\Q$search_string\E\b/o) {
$found = 1;
} elsif (/^=item/) {
last if $found > 1;
@@ -363,8 +436,15 @@ if ($opt_f) {
print FORMATTER @pod;
print FORMATTER "=back\n";
close(FORMATTER);
- } else {
+ } elsif (@pod < $lines-2) {
print @pod;
+ } else {
+ foreach my $pager (@pagers) {
+ open (PAGER, "| $pager") or next;
+ print PAGER @pod ;
+ close(PAGER) or next;
+ last;
+ }
}
} else {
die "No documentation for perl function `$opt_f' found\n";
@@ -372,8 +452,49 @@ if ($opt_f) {
exit;
}
+if ($opt_q) {
+ local @ARGV = @found; # I'm lazy, sue me.
+ my $found = 0;
+ my %found_in;
+ my @pod;
+
+ while (<>) {
+ if (/^=head2\s+.*(?:$opt_q)/oi) {
+ $found = 1;
+ push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++;
+ } elsif (/^=head2/) {
+ $found = 0;
+ }
+ next unless $found;
+ push @pod, $_;
+ }
+
+ if (@pod) {
+ if ($opt_t) {
+ open(FORMATTER, "| pod2text") || die "Can't start filter";
+ print FORMATTER "=over 8\n\n";
+ print FORMATTER @pod;
+ print FORMATTER "=back\n";
+ close(FORMATTER);
+ } elsif (@pod < $lines-2) {
+ print @pod;
+ } else {
+ foreach my $pager (@pagers) {
+ open (PAGER, "| $pager") or next;
+ print PAGER @pod ;
+ close(PAGER) or next;
+ last;
+ }
+ }
+ } else {
+ die "No documentation for perl FAQ keyword `$opt_q' found\n";
+ }
+ exit;
+}
+
foreach (@found) {
+ my $err;
if($opt_t) {
open(TMP,">>$tmp");
Pod::Text::pod2text($_,*TMP);
@@ -381,7 +502,7 @@ foreach (@found) {
} elsif(not $opt_u) {
my $cmd = "pod2man --lax $_ | nroff -man";
$cmd .= " | col -x" if $^O =~ /hpux/;
- $rslt = `$cmd`;
+ my $rslt = `$cmd`;
unless(($err = $?)) {
open(TMP,">>$tmp");
print TMP $rslt;
@@ -392,7 +513,7 @@ foreach (@found) {
if( $opt_u or $err or -z $tmp) {
open(OUT,">>$tmp");
open(IN,"<$_");
- $cut = 1;
+ my $cut = 1;
while (<IN>) {
$cut = $1 eq 'cut' if /^=(\w+)/;
next if $cut;
@@ -408,7 +529,7 @@ if( $no_tty ) {
print while <TMP>;
close(TMP);
} else {
- foreach $pager (@pagers) {
+ foreach my $pager (@pagers) {
system("$pager $tmp") or last;
}
}
@@ -425,10 +546,12 @@ perldoc - Look up Perl documentation in pod format.
=head1 SYNOPSIS
-B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] PageName|ModuleName|ProgramName
+B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] [B<-F>] [B<-X>] PageName|ModuleName|ProgramName
B<perldoc> B<-f> BuiltinFunction
+B<perldoc> B<-q> FAQ Keyword
+
=head1 DESCRIPTION
I<perldoc> looks up a piece of documentation in .pod format that is embedded
@@ -472,11 +595,27 @@ the file for you and simply hand it off for display.
Display the file name of the module found.
+=item B<-F> file names
+
+Consider arguments as file names, no search in directories will be performed.
+
=item B<-f> perlfunc
The B<-f> option followed by the name of a perl built in function will
extract the documentation of this function from L<perlfunc>.
+=item B<-q> perlfaq
+
+The B<-q> option takes a regular expression as an argument. It will search
+the question headings in perlfaq[1-9] and print the entries matching
+the regular expression.
+
+=item B<-X> use an index if present
+
+The B<-X> option looks for a entry whose basename matches the name given on the
+command line in the file C<$Config{archlib}/pod.idx>. The pod.idx file should
+contain fully qualified filenames, one per line.
+
=item B<PageName|ModuleName|ProgramName>
The item you want to look up. Nested modules (such as C<File::Basename>)
@@ -495,7 +634,10 @@ command line arguments. C<perldoc> also searches directories
specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
defined) and C<PATH> environment variables.
(The latter is so that embedded pods for executables, such as
-C<perldoc> itself, are available.)
+C<perldoc> itself, are available.) C<perldoc> will use, in order of
+preference, the pager defined in C<PERLDOC_PAGER>, C<MANPAGER>, or
+C<PAGER> before trying to find a pager on its own. (C<MANPAGER> is not
+used if C<perldoc> was told to display plain text or unformatted pod.)
=head1 AUTHOR
@@ -506,6 +648,12 @@ Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
=cut
#
+# Version 1.14: Wed Jul 15 01:50:20 EST 1998
+# Robin Barker <rmb1@cise.npl.co.uk>
+# -strict, -w cleanups
+# Version 1.13: Fri Feb 27 16:20:50 EST 1997
+# Gurusamy Sarathy <gsar@umich.edu>
+# -doc tweaks for -F and -X options
# Version 1.12: Sat Apr 12 22:41:09 EST 1997
# Gurusamy Sarathy <gsar@umich.edu>
# -various fixes for win32
@@ -539,3 +687,4 @@ Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;
diff --git a/gnu/usr.bin/perl/utils/pl2pm.PL b/gnu/usr.bin/perl/utils/pl2pm.PL
index 55a8d2ea353..48e281d1a57 100644
--- a/gnu/usr.bin/perl/utils/pl2pm.PL
+++ b/gnu/usr.bin/perl/utils/pl2pm.PL
@@ -2,6 +2,7 @@
use Config;
use File::Basename qw(&basename &dirname);
+use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
@@ -12,6 +13,7 @@ use File::Basename qw(&basename &dirname);
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
@@ -384,3 +386,4 @@ y
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;
diff --git a/gnu/usr.bin/perl/utils/splain.PL b/gnu/usr.bin/perl/utils/splain.PL
index 75b5e2f3f61..a638dbae717 100644
--- a/gnu/usr.bin/perl/utils/splain.PL
+++ b/gnu/usr.bin/perl/utils/splain.PL
@@ -2,6 +2,7 @@
use Config;
use File::Basename qw(&basename &dirname);
+use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
@@ -13,6 +14,7 @@ use File::Basename qw(&basename &dirname);
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
@@ -44,3 +46,4 @@ close IN;
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;
diff --git a/gnu/usr.bin/perl/vms/ext/DCLsym/DCLsym.xs b/gnu/usr.bin/perl/vms/ext/DCLsym/DCLsym.xs
index 3918eb11e57..35cabc525ea 100644
--- a/gnu/usr.bin/perl/vms/ext/DCLsym/DCLsym.xs
+++ b/gnu/usr.bin/perl/vms/ext/DCLsym/DCLsym.xs
@@ -54,7 +54,7 @@ _getsym(name)
_ckvmssts(lib$sfree1_dd(&valdsc));
}
else {
- ST(0) = &sv_undef; /* error - we're returning undef, if anything */
+ ST(0) = &PL_sv_undef; /* error - we're returning undef, if anything */
switch (retsts) {
case LIB$_NOSUCHSYM:
break; /* nobody home */;
diff --git a/gnu/usr.bin/perl/vms/ext/DCLsym/Makefile.PL b/gnu/usr.bin/perl/vms/ext/DCLsym/Makefile.PL
index 8e6f5bce40a..84ab2be2b52 100644
--- a/gnu/usr.bin/perl/vms/ext/DCLsym/Makefile.PL
+++ b/gnu/usr.bin/perl/vms/ext/DCLsym/Makefile.PL
@@ -1,3 +1,4 @@
use ExtUtils::MakeMaker;
-WriteMakefile( 'VERSION_FROM' => 'DCLsym.pm' );
+WriteMakefile( 'VERSION_FROM' => 'DCLsym.pm',
+ 'MAN3PODS' => ' ');
diff --git a/gnu/usr.bin/perl/vms/ext/Filespec.pm b/gnu/usr.bin/perl/vms/ext/Filespec.pm
index db3283c5713..4a539c27016 100644
--- a/gnu/usr.bin/perl/vms/ext/Filespec.pm
+++ b/gnu/usr.bin/perl/vms/ext/Filespec.pm
@@ -12,7 +12,7 @@ VMS::Filespec - convert between VMS and Unix file specification syntax
=head1 SYNOPSIS
use VMS::Filespec;
-$fullspec = rmsexpand('[.VMS]file.specification');
+$fullspec = rmsexpand('[.VMS]file.specification'[, 'default:[file.spec]']);
$vmsspec = vmsify('/my/Unix/file/specification');
$unixspec = unixify('my:[VMS]file.specification');
$path = pathify('my:[VMS.or.Unix.directory]specification.dir');
@@ -65,9 +65,11 @@ The routines provided are:
=head2 rmsexpand
Uses the RMS $PARSE and $SEARCH services to expand the input
-specification to its fully qualified form. (If the file does
-not exist, the input specification is expanded as much as
-possible.) If an error occurs, returns C<undef> and sets C<$!>
+specification to its fully qualified form, except that a null type
+or version is not added unless it was present in either the original
+file specification or the default specification passed to C<rmsexpand>.
+(If the file does not exist, the input specification is expanded as much
+as possible.) If an error occurs, returns C<undef> and sets C<$!>
and C<$^E>.
=head2 vmsify
@@ -264,6 +266,7 @@ sub fileify ($) {
my($path) = @_;
if (!$path) { return undef }
+ if ($path eq '/') { return 'sys$disk:[000000]'; }
if ($path =~ /(.+)\.([^:>\]]*)$/) {
$path = $1;
if ($2 !~ /^dir(?:;1)?$/i) { return undef }
diff --git a/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.pm b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.pm
index 218c406fa44..04b339725fb 100644
--- a/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.pm
+++ b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.pm
@@ -1,8 +1,9 @@
# VMS::Stdio - VMS extensions to Perl's stdio calls
#
# Author: Charles Bailey bailey@genetics.upenn.edu
-# Version: 2.02
-# Revised: 15-Feb-1997
+# Version: 2.1
+# Revised: 24-Mar-1998
+# Docs revised: 13-Oct-1998 Dan Sugalski <sugalskd@ous.edu>
package VMS::Stdio;
@@ -12,17 +13,18 @@ use Carp '&croak';
use DynaLoader ();
use Exporter ();
-$VERSION = '2.02';
+$VERSION = '2.1';
@ISA = qw( Exporter DynaLoader IO::File );
@EXPORT = qw( &O_APPEND &O_CREAT &O_EXCL &O_NDELAY &O_NOWAIT
&O_RDONLY &O_RDWR &O_TRUNC &O_WRONLY );
-@EXPORT_OK = qw( &flush &getname &remove &rewind &sync &tmpnam
- &vmsopen &vmssysopen &waitfh );
+@EXPORT_OK = qw( &flush &getname &remove &rewind &sync &setdef &tmpnam
+ &vmsopen &vmssysopen &waitfh &writeof );
%EXPORT_TAGS = ( CONSTANTS => [ qw( &O_APPEND &O_CREAT &O_EXCL &O_NDELAY
&O_NOWAIT &O_RDONLY &O_RDWR &O_TRUNC
&O_WRONLY ) ],
- FUNCTIONS => [ qw( &flush &getname &remove &rewind &sync
- &tmpnam &vmsopen &vmssysopen &waitfh ) ] );
+ FUNCTIONS => [ qw( &flush &getname &remove &rewind &setdef
+ &sync &tmpnam &vmsopen &vmssysopen
+ &waitfh &writeof ) ] );
bootstrap VMS::Stdio $VERSION;
@@ -32,7 +34,7 @@ sub AUTOLOAD {
if ($constname =~ /^O_/) {
my($val) = constant($constname);
defined $val or croak("Unknown VMS::Stdio constant $constname");
- *$AUTOLOAD = sub { val; }
+ *$AUTOLOAD = sub { $val; }
}
else { # We don't know about it; hand off to IO::File
require IO::File;
@@ -80,22 +82,24 @@ VMS::Stdio - standard I/O functions via VMS extensions
=head1 SYNOPSIS
-use VMS::Stdio qw( &flush &getname &remove &rewind &sync &tmpnam
- &vmsopen &vmssysopen &waitfh );
-$uniquename = tmpnam;
-$fh = vmsopen("my.file","rfm=var","alq=100",...) or die $!;
-$name = getname($fh);
-print $fh "Hello, world!\n";
-flush($fh);
-sync($fh);
-rewind($fh);
-$line = <$fh>;
-undef $fh; # closes file
-$fh = vmssysopen("another.file", O_RDONLY | O_NDELAY, 0, "ctx=bin");
-sysread($fh,$data,128);
-waitfh($fh);
-close($fh);
-remove("another.file");
+ use VMS::Stdio qw( &flush &getname &remove &rewind &setdef &sync &tmpnam
+ &vmsopen &vmssysopen &waitfh &writeof );
+ setdef("new:[default.dir]");
+ $uniquename = tmpnam;
+ $fh = vmsopen("my.file","rfm=var","alq=100",...) or die $!;
+ $name = getname($fh);
+ print $fh "Hello, world!\n";
+ flush($fh);
+ sync($fh);
+ rewind($fh);
+ $line = <$fh>;
+ undef $fh; # closes file
+ $fh = vmssysopen("another.file", O_RDONLY | O_NDELAY, 0, "ctx=bin");
+ sysread($fh,$data,128);
+ waitfh($fh);
+ close($fh);
+ remove("another.file");
+ writeof($pipefh);
=head1 DESCRIPTION
@@ -175,6 +179,13 @@ to the beginning of the file. It's really just a convenience
method equivalent in effect to C<seek($fh,0,0)>. It returns a
true value if successful, and C<undef> if it fails.
+=item setdef
+
+This function sets the default device and directory for the process.
+It is identical to the built-in chdir() operator, except that the change
+persists after Perl exits. It returns a true value on success, and
+C<undef> if it encounters and error.
+
=item sync
This function flushes buffered data for the specified file handle
@@ -212,6 +223,373 @@ as a normal Perl file handle only. When the scalar containing
a VMS::Stdio file handle is overwritten, C<undef>d, or goes
out of scope, the associated file is closed automatically.
+=over 4
+
+=head2 File characteristic options
+
+=over 2
+
+=item alq=INTEGER
+
+Sets the allocation quantity for this file
+
+=item bls=INTEGER
+
+File blocksize
+
+=item ctx=STRING
+
+Sets the context for the file. Takes one of these arguments:
+
+=over 4
+
+=item bin
+
+Disables LF to CRLF translation
+
+=item cvt
+
+Negates previous setting of C<ctx=noctx>
+
+=item nocvt
+
+Disables conversion of FORTRAN carriage control
+
+=item rec
+
+Force record-mode access
+
+=item stm
+
+Force stream mode
+
+=item xplct
+
+Causes records to be flushed I<only> when the file is closed, or when an
+explicit flush is done
+
+=back
+
+=item deq=INTEGER
+
+Sets the default extension quantity
+
+=item dna=FILESPEC
+
+Sets the default filename string. Used to fill in any missing pieces of the
+filename passed.
+
+=item fop=STRING
+
+File processing option. Takes one or more of the following (in a
+comma-separated list if there's more than one)
+
+=over 4
+
+=item ctg
+
+Contiguous.
+
+=item cbt
+
+Contiguous-best-try.
+
+=item dfw
+
+Deferred write; only applicable to files opened for shared access.
+
+=item dlt
+
+Delete file on close.
+
+=item tef
+
+Truncate at end-of-file.
+
+=item cif
+
+Create if nonexistent.
+
+=item sup
+
+Supersede.
+
+=item scf
+
+Submit as command file on close.
+
+=item spl
+
+Spool to system printer on close.
+
+=item tmd
+
+Temporary delete.
+
+=item tmp
+
+Temporary (no file directory).
+
+=item nef
+
+Not end-of-file.
+
+=item rck
+
+Read check compare operation.
+
+=item wck
+
+Write check compare operation.
+
+=item mxv
+
+Maximize version number.
+
+=item rwo
+
+Rewind file on open.
+
+=item pos
+
+Current position.
+
+=item rwc
+
+Rewind file on close.
+
+=item sqo
+
+File can only be processed in a sequential manner.
+
+=back
+
+=item fsz=INTEGER
+
+Fixed header size
+
+=item gbc=INTEGER
+
+Global buffers requested for the file
+
+=item mbc=INTEGER
+
+Multiblock count
+
+=item mbf=INTEGER
+
+Bultibuffer count
+
+=item mrs=INTEGER
+
+Maximum record size
+
+=item rat=STRING
+
+File record attributes. Takes one of the following:
+
+=over 4
+
+=item cr
+
+Carriage-return control.
+
+=item blk
+
+Disallow records to span block boundaries.
+
+=item ftn
+
+FORTRAN print control.
+
+=item none
+
+Explicitly forces no carriage control.
+
+=item prn
+
+Print file format.
+
+=back
+
+=item rfm=STRING
+
+File record format. Takes one of the following:
+
+=over 4
+
+=item fix
+
+Fixed-length record format.
+
+=item stm
+
+RMS stream record format.
+
+=item stmlf
+
+Stream format with line-feed terminator.
+
+=item stmcr
+
+Stream format with carriage-return terminator.
+
+=item var
+
+Variable-length record format.
+
+=item vfc
+
+Variable-length record with fixed control.
+
+=item udf
+
+Undefined format
+
+=back
+
+=item rop=STRING
+
+Record processing operations. Takes one or more of the following in a
+comma-separated list:
+
+=over 4
+
+=item asy
+
+Asynchronous I/O.
+
+=item cco
+
+Cancel Ctrl/O (used with Terminal I/O).
+
+=item cvt
+
+Capitalizes characters on a read from the terminal.
+
+=item eof
+
+Positions the record stream to the end-of-file for the connect operation
+only.
+
+=item nlk
+
+Do not lock record.
+
+=item pmt
+
+Enables use of the prompt specified by pmt=usr-prmpt on input from the
+terminal.
+
+=item pta
+
+Eliminates any information in the type-ahead buffer on a read from the
+terminal.
+
+=item rea
+
+Locks record for a read operation for this process, while allowing other
+accessors to read the record.
+
+=item rlk
+
+Locks record for write.
+
+=item rne
+
+Suppresses echoing of input data on the screen as it is entered on the
+keyboard.
+
+=item rnf
+
+Indicates that Ctrl/U, Ctrl/R, and DELETE are not to be considered control
+commands on terminal input, but are to be passed to the application
+program.
+
+=item rrl
+
+Reads regardless of lock.
+
+=item syncsts
+
+Returns success status of RMS$_SYNCH if the requested service completes its
+task immediately.
+
+=item tmo
+
+Timeout I/O.
+
+=item tpt
+
+Allows put/write services using sequential record access mode to occur at
+any point in the file, truncating the file at that point.
+
+=item ulk
+
+Prohibits RMS from automatically unlocking records.
+
+=item wat
+
+Wait until record is available, if currently locked by another stream.
+
+=item rah
+
+Read ahead.
+
+=item wbh
+
+Write behind.
+
+=back
+
+=item rtv=INTEGER
+
+The number of retrieval pointers that RMS has to maintain (0 to 127255)
+
+=item shr=STRING
+
+File sharing options. Choose one of the following:
+
+=over 4
+
+=item del
+
+Allows users to delete.
+
+=item get
+
+Allows users to read.
+
+=item mse
+
+Allows mainstream access.
+
+=item nil
+
+Prohibits file sharing.
+
+=item put
+
+Allows users to write.
+
+=item upd
+
+Allows users to update.
+
+=item upi
+
+Allows one or more writers.
+
+=back
+
+=item tmo=INTEGER
+
+I/O timeout value
+
+=back
+
+=back
+
=item vmssysopen
This function bears the same relationship to the CORE function
@@ -231,8 +609,17 @@ operation on the file handle specified as its argument. It is
used with handles opened for asynchronous I/O, and performs its
task by calling the CRTL routine fwait().
+=item writeof
+
+This function writes an EOF to a file handle, if the device driver
+supports this operation. Its primary use is to send an EOF to a
+subprocess through a pipe opened for writing without closing the
+pipe. It returns a true value if successful, and C<undef> if
+it encounters an error.
+
=head1 REVISION
-This document was last revised on 10-Dec-1996, for Perl 5.004.
+This document was last revised on 13-Oct-1998, for Perl 5.004, 5.005, and
+5.006.
=cut
diff --git a/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.xs b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.xs
index b10fec0d485..53b491575dc 100644
--- a/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.xs
+++ b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.xs
@@ -1,8 +1,8 @@
/* VMS::Stdio - VMS extensions to stdio routines
*
- * Version: 2.02
+ * Version: 2.1
* Author: Charles Bailey bailey@genetics.upenn.edu
- * Revised: 15-Feb-1997
+ * Revised: 24-Mar-1998
*
*/
@@ -10,6 +10,9 @@
#include "perl.h"
#include "XSUB.h"
#include <file.h>
+#include <iodef.h>
+#include <rms.h>
+#include <starlet.h>
static bool
constant(name, pval)
@@ -84,16 +87,17 @@ newFH(FILE *fp, char type) {
HV *stash;
IO *io;
+ dTHR;
/* Find stash for VMS::Stdio. We don't do this once at boot
* to allow for possibility of threaded Perl with per-thread
* symbol tables. This code (through io = ...) is really
* equivalent to gv_fetchpv("VMS::Stdio::__FH__",TRUE,SVt_PVIO),
* with a little less overhead, and good exercise for me. :-) */
- stashp = (GV **)hv_fetch(defstash,"VMS::",5,TRUE);
- if (!stashp || *stashp == (GV *)&sv_undef) return Nullsv;
+ stashp = (GV **)hv_fetch(PL_defstash,"VMS::",5,TRUE);
+ if (!stashp || *stashp == (GV *)&PL_sv_undef) return Nullsv;
if (!(stash = GvHV(*stashp))) stash = GvHV(*stashp) = newHV();
stashp = (GV **)hv_fetch(GvHV(*stashp),"Stdio::",7,TRUE);
- if (!stashp || *stashp == (GV *)&sv_undef) return Nullsv;
+ if (!stashp || *stashp == (GV *)&PL_sv_undef) return Nullsv;
if (!(stash = GvHV(*stashp))) stash = GvHV(*stashp) = newHV();
/* Set up GV to point to IO, and then take reference */
@@ -118,24 +122,22 @@ constant(name)
if (constant(name, &i))
ST(0) = sv_2mortal(newSViv(i));
else
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
void
-flush(sv)
- SV * sv
+flush(fp)
+ FILE * fp
PROTOTYPE: $
CODE:
- FILE *fp = Nullfp;
- if (SvOK(sv)) fp = IoIFP(sv_2io(sv));
- if (fflush(fp)) { ST(0) = &sv_undef; }
- else { clearerr(fp); ST(0) = &sv_yes; }
+ if (fflush(fp)) { ST(0) = &PL_sv_undef; }
+ else { clearerr(fp); ST(0) = &PL_sv_yes; }
char *
getname(fp)
FILE * fp
PROTOTYPE: $
CODE:
- char fname[257];
+ char fname[NAM$C_MAXRSS+1];
ST(0) = sv_newmortal();
if (fgetname(fp,fname) != NULL) sv_setpv(ST(0),fname);
@@ -144,22 +146,76 @@ rewind(fp)
FILE * fp
PROTOTYPE: $
CODE:
- ST(0) = rewind(fp) ? &sv_undef : &sv_yes;
+ ST(0) = rewind(fp) ? &PL_sv_undef : &PL_sv_yes;
void
remove(name)
char *name
PROTOTYPE: $
CODE:
- ST(0) = remove(name) ? &sv_undef : &sv_yes;
+ ST(0) = remove(name) ? &PL_sv_undef : &PL_sv_yes;
+
+void
+setdef(...)
+ PROTOTYPE: @
+ CODE:
+ char vmsdef[NAM$C_MAXRSS+1], es[NAM$C_MAXRSS], sep;
+ unsigned long int retsts;
+ struct FAB deffab = cc$rms_fab;
+ struct NAM defnam = cc$rms_nam;
+ struct dsc$descriptor_s dirdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+ STRLEN n_a;
+ if (items) {
+ SV *defsv = ST(items-1); /* mimic chdir() */
+ ST(0) = &PL_sv_undef;
+ if (!SvPOK(defsv)) { SETERRNO(EINVAL,LIB$_INVARG); XSRETURN(1); }
+ if (tovmsspec(SvPV(defsv,n_a),vmsdef) == NULL) { XSRETURN(1); }
+ deffab.fab$l_fna = vmsdef; deffab.fab$b_fns = strlen(vmsdef);
+ }
+ else {
+ deffab.fab$l_fna = "SYS$LOGIN"; deffab.fab$b_fns = 9;
+ EXTEND(sp,1); ST(0) = &PL_sv_undef;
+ }
+ defnam.nam$l_esa = es; defnam.nam$b_ess = sizeof es;
+ deffab.fab$l_nam = &defnam;
+ retsts = sys$parse(&deffab,0,0);
+ if (retsts & 1) {
+ if (defnam.nam$v_wildcard) retsts = RMS$_WLD;
+ else if (defnam.nam$b_name || defnam.nam$b_type > 1 ||
+ defnam.nam$b_ver > 1) retsts = RMS$_DIR;
+ }
+ defnam.nam$b_nop |= NAM$M_SYNCHK; defnam.nam$l_rlf = NULL; deffab.fab$b_dns = 0;
+ if (!(retsts & 1)) {
+ set_vaxc_errno(retsts);
+ switch (retsts) {
+ case RMS$_DNF:
+ set_errno(ENOENT); break;
+ case RMS$_SYN: case RMS$_DIR: case RMS$_DEV:
+ set_errno(EINVAL); break;
+ case RMS$_PRV:
+ set_errno(EACCES); break;
+ default:
+ set_errno(EVMSERR); break;
+ }
+ (void) sys$parse(&deffab,0,0); /* free up context */
+ XSRETURN(1);
+ }
+ sep = *defnam.nam$l_dir;
+ *defnam.nam$l_dir = '\0';
+ my_setenv("SYS$DISK",defnam.nam$b_node ? defnam.nam$l_node : defnam.nam$l_dev);
+ *defnam.nam$l_dir = sep;
+ dirdsc.dsc$a_pointer = defnam.nam$l_dir; dirdsc.dsc$w_length = defnam.nam$b_dir;
+ if ((retsts = sys$setddir(&dirdsc,0,0)) & 1) ST(0) = &PL_sv_yes;
+ else { set_errno(EVMSERR); set_vaxc_errno(retsts); }
+ (void) sys$parse(&deffab,0,0); /* free up context */
void
sync(fp)
FILE * fp
PROTOTYPE: $
CODE:
- if (fsync(fileno(fp))) { ST(0) = &sv_undef; }
- else { clearerr(fp); ST(0) = &sv_yes; }
+ if (fsync(fileno(fp))) { ST(0) = &PL_sv_undef; }
+ else { clearerr(fp); ST(0) = &PL_sv_yes; }
char *
tmpnam()
@@ -177,6 +233,7 @@ vmsopen(spec,...)
char *args[8],mode[3] = {'r','\0','\0'}, type = '<';
register int i, myargc;
FILE *fp;
+ STRLEN n_a;
if (!spec || !*spec) {
SETERRNO(EINVAL,LIB$_INVARG);
@@ -195,7 +252,7 @@ vmsopen(spec,...)
}
else if (*spec == '<') spec++;
myargc = items - 1;
- for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),na);
+ for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),n_a);
/* This hack brought to you by C's opaque arglist management */
switch (myargc) {
case 0:
@@ -228,9 +285,9 @@ vmsopen(spec,...)
}
if (fp != Nullfp) {
SV *fh = newFH(fp,(mode[1] ? '+' : (mode[0] == 'r' ? '<' : (mode[0] == 'a' ? 'a' : '>'))));
- ST(0) = (fh ? sv_2mortal(fh) : &sv_undef);
+ ST(0) = (fh ? sv_2mortal(fh) : &PL_sv_undef);
}
- else { ST(0) = &sv_undef; }
+ else { ST(0) = &PL_sv_undef; }
void
vmssysopen(spec,mode,perm,...)
@@ -243,13 +300,14 @@ vmssysopen(spec,mode,perm,...)
int i, myargc, fd;
FILE *fp;
SV *fh;
+ STRLEN n_a;
if (!spec || !*spec) {
SETERRNO(EINVAL,LIB$_INVARG);
XSRETURN_UNDEF;
}
if (items > 11) croak("too many args");
myargc = items - 3;
- for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+3),na);
+ for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+3),n_a);
/* More fun with C calls; can't combine with above because
args 2,3 of different types in fopen() and open() */
switch (myargc) {
@@ -285,13 +343,53 @@ vmssysopen(spec,mode,perm,...)
if (fd >= 0 &&
((fp = fdopen(fd, &("r\000w\000r+"[2*i]))) != Nullfp)) {
SV *fh = newFH(fp,"<>++"[i]);
- ST(0) = (fh ? sv_2mortal(fh) : &sv_undef);
+ ST(0) = (fh ? sv_2mortal(fh) : &PL_sv_undef);
}
- else { ST(0) = &sv_undef; }
+ else { ST(0) = &PL_sv_undef; }
void
waitfh(fp)
FILE * fp
PROTOTYPE: $
CODE:
- ST(0) = fwait(fp) ? &sv_undef : &sv_yes;
+ ST(0) = fwait(fp) ? &PL_sv_undef : &PL_sv_yes;
+
+void
+writeof(mysv)
+ SV * mysv
+ PROTOTYPE: $
+ CODE:
+ char devnam[257], *cp;
+ unsigned long int chan, iosb[2], retsts, retsts2;
+ struct dsc$descriptor devdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, devnam};
+ IO *io = sv_2io(mysv);
+ FILE *fp = io ? IoOFP(io) : NULL;
+ if (fp == NULL || strchr(">was+-|",IoTYPE(io)) == Nullch) {
+ set_errno(EBADF); set_vaxc_errno(SS$_IVCHAN);
+ ST(0) = &PL_sv_undef; XSRETURN(1);
+ }
+ if (fgetname(fp,devnam) == Nullch) { ST(0) = &PL_sv_undef; XSRETURN(1); }
+ if ((cp = strrchr(devnam,':')) != NULL) *(cp+1) = '\0';
+ devdsc.dsc$w_length = strlen(devnam);
+ retsts = sys$assign(&devdsc,&chan,0,0);
+ if (retsts & 1) retsts = sys$qiow(0,chan,IO$_WRITEOF,iosb,0,0,0,0,0,0,0,0);
+ if (retsts & 1) retsts = iosb[0];
+ retsts2 = sys$dassgn(chan); /* Be sure to deassign the channel */
+ if (retsts & 1) retsts = retsts2;
+ if (retsts & 1) { ST(0) = &PL_sv_yes; }
+ else {
+ set_vaxc_errno(retsts);
+ switch (retsts) {
+ case SS$_EXQUOTA: case SS$_INSFMEM: case SS$_MBFULL:
+ case SS$_MBTOOSML: case SS$_NOIOCHAN: case SS$_NOLINKS:
+ case SS$_BUFFEROVF:
+ set_errno(ENOSPC); break;
+ case SS$_ILLIOFUNC: case SS$_DEVOFFLINE: case SS$_NOSUCHDEV:
+ set_errno(EBADF); break;
+ case SS$_NOPRIV:
+ set_errno(EACCES); break;
+ default: /* Includes "shouldn't happen" cases that might map */
+ set_errno(EVMSERR); break; /* to other errno values */
+ }
+ ST(0) = &PL_sv_undef;
+ }
diff --git a/gnu/usr.bin/perl/vms/ext/Stdio/test.pl b/gnu/usr.bin/perl/vms/ext/Stdio/test.pl
index 0b50d63e3aa..37131deb01e 100644
--- a/gnu/usr.bin/perl/vms/ext/Stdio/test.pl
+++ b/gnu/usr.bin/perl/vms/ext/Stdio/test.pl
@@ -1,8 +1,8 @@
-# Tests for VMS::Stdio v2.01
+# Tests for VMS::Stdio v2.1
use VMS::Stdio;
-import VMS::Stdio qw(&flush &getname &rewind &sync);
+import VMS::Stdio qw(&flush &getname &rewind &sync &tmpnam);
-print "1..14\n";
+print "1..18\n";
print +(defined(&getname) ? '' : 'not '), "ok 1\n";
$name = "test$$";
@@ -42,3 +42,29 @@ undef $sfh;
print +(stat("$name.tmp") ? 'not ' : ''),"ok 13\n";
print +(&VMS::Stdio::tmpnam ? '' : 'not '),"ok 14\n";
+
+#if (open(P, qq[| MCR $^X -e "1 while (<STDIN>);print 'Foo';1 while (<STDIN>); print 'Bar'" >$name.tmp])) {
+# print P "Baz\nQuux\n";
+# print +(VMS::Stdio::writeof(P) ? '' : 'not '),"ok 15\n";
+# print P "Baz\nQuux\n";
+# print +(close(P) ? '' : ''),"ok 16\n";
+# $fh = VMS::Stdio::vmsopen("$name.tmp");
+# chomp($line = <$fh>);
+# close $fh;
+# unlink("$name.tmp");
+# print +($line eq 'FooBar' ? '' : 'not '),"ok 17\n";
+#}
+#else {
+print "ok 15\nok 16\nok 17\n";
+#}
+
+$sfh = VMS::Stdio::vmsopen(">$name.tmp");
+$setuperl = "\$ MCR $^X\nBEGIN { \@INC = qw(@INC) };\nuse VMS::Stdio qw(&setdef);";
+print $sfh qq[\$ here = F\$Environment("Default")\n];
+print $sfh "$setuperl\nsetdef();\n\$ Show Default\n\$ Set Default 'here'\n";
+print $sfh "$setuperl\nsetdef('..');\n\$ Show Default\n";
+close $sfh;
+@defs = map { /(\S+)/ && $1 } `\@$name.tmp`;
+unlink("$name.tmp");
+print +($defs[0] eq uc($ENV{'SYS$LOGIN'}) ? '' : "not ($defs[0]) "),"ok 18\n";
+#print +($defs[1] eq VMS::Filespec::rmsexpand('[-]') ? '' : "not ($defs[1]) "),"ok 19\n";
diff --git a/gnu/usr.bin/perl/vms/ext/filespec.t b/gnu/usr.bin/perl/vms/ext/filespec.t
index 6201a42dc69..779396be731 100644
--- a/gnu/usr.bin/perl/vms/ext/filespec.t
+++ b/gnu/usr.bin/perl/vms/ext/filespec.t
@@ -10,7 +10,7 @@ foreach (<DATA>) {
next if /^\s*$/;
push(@tests,$_);
}
-print '1..',scalar(@tests)+3,"\n";
+print '1..',scalar(@tests)+6,"\n";
foreach $test (@tests) {
($arg,$func,$expect) = split(/\t+/,$test);
@@ -25,14 +25,17 @@ foreach $test (@tests) {
}
}
+$defwarn = <<'EOW';
+# Note: This failure may have occurred because your default device
+# was set using a non-concealed logical name. If this is the case,
+# you will need to determine by inspection that the two resultant
+# file specifications shwn above are in fact equivalent.
+EOW
+
if (rmsexpand('[]') eq "\U$ENV{DEFAULT}") { print 'ok ',++$idx,"\n"; }
else {
print 'not ok ', ++$idx, ": rmsexpand('[]') = |", rmsexpand('[]'),
- "|, \$ENV{DEFAULT} = |\U$ENV{DEFAULT}|\n";
- print "# Note: This failure may have occurred because your default device\n";
- print "# was set using a non-concealed logical name. If this is the case,\n";
- print "# you will need to determine by inspection that the two resultant\n";
- print "# file specifications shwn above are in fact equivalent.\n";
+ "|, \$ENV{DEFAULT} = |\U$ENV{DEFAULT}|\n$defwarn";
}
if (rmsexpand('from.here') eq "\L$ENV{DEFAULT}from.here") {
print 'ok ', ++$idx, "\n";
@@ -40,11 +43,15 @@ if (rmsexpand('from.here') eq "\L$ENV{DEFAULT}from.here") {
else {
print 'not ok ', ++$idx, ": rmsexpand('from.here') = |",
rmsexpand('from.here'),
- "|, \$ENV{DEFAULT}from.here = |\L$ENV{DEFAULT}from.here|\n";
- print "# Note: This failure may have occurred because your default device\n";
- print "# was set using a non-concealed logical name. If this is the case,\n";
- print "# you will need to determine by inspection that the two resultant\n";
- print "# file specifications shwn above are in fact equivalent.\n";
+ "|, \$ENV{DEFAULT}from.here = |\L$ENV{DEFAULT}from.here|\n$defwarn";
+}
+if (rmsexpand('from') eq "\L$ENV{DEFAULT}from") {
+ print 'ok ', ++$idx, "\n";
+}
+else {
+ print 'not ok ', ++$idx, ": rmsexpand('from') = |",
+ rmsexpand('from'),
+ "|, \$ENV{DEFAULT}from = |\L$ENV{DEFAULT}from|\n$defwarn";
}
if (rmsexpand('from.here','cant:[get.there];2') eq
'cant:[get.there]from.here;2') { print 'ok ',++$idx,"\n"; }
@@ -53,6 +60,11 @@ else {
rmsexpand('from.here','cant:[get.there];2'),"|\n";
}
+# Make sure we're using redirected mkdir, which strips trailing '/', since
+# the CRTL's mkdir can't handle this.
+print +(mkdir('testdir/',0777) ? 'ok ' : 'not ok '),++$idx,"\n";
+print +(rmdir('testdir/') ? 'ok ' : 'not ok '),++$idx,"\n";
+
__DATA__
# Basic VMS to Unix filespecs
@@ -84,6 +96,7 @@ some/where/... vmsify [.some.where...]
.. vmsify [-]
../.. vmsify [--]
.../ vmsify [...]
+/ vmsify sys$disk:[000000]
# Fileifying directory specs
down:[the.garden.path] fileify down:[the.garden]path.dir;1
@@ -123,6 +136,7 @@ down:[the.garden.path...] unixpath /down/the/garden/path/.../
[.down.the.garden]path.dir unixpath down/the/garden/path/
down/the/garden/path vmspath [.down.the.garden.path]
path vmspath [.path]
+/ vmspath sys$disk:[000000]
# Redundant characters in Unix paths
//some/where//over/../the.rainbow vmsify some:[where]the.rainbow
diff --git a/gnu/usr.bin/perl/vms/gen_shrfls.pl b/gnu/usr.bin/perl/vms/gen_shrfls.pl
index e451e1826b6..43029692b2b 100644
--- a/gnu/usr.bin/perl/vms/gen_shrfls.pl
+++ b/gnu/usr.bin/perl/vms/gen_shrfls.pl
@@ -39,7 +39,7 @@ require 5.000;
$debug = $ENV{'GEN_SHRFLS_DEBUG'};
-print "gen_shrfls.pl Rev. 14-Dec-1996\n" if $debug;
+print "gen_shrfls.pl Rev. 14-Dec-1997\n" if $debug;
if ($ARGV[0] eq '-f') {
open(INP,$ARGV[1]) or die "Can't read input file $ARGV[1]: $!\n";
@@ -64,10 +64,24 @@ $docc = ($cc_cmd !~ /^~~/);
print "\$docc = $docc\n" if $debug;
if ($docc) {
+ if (-f 'perl.h') { $dir = '[]'; }
+ elsif (-f '[-]perl.h') { $dir = '[-]'; }
+ else { die "$0: Can't find perl.h\n"; }
+
+ # Go see if debugging is enabled in config.h
+ $config = $dir . "config.h";
+ open CONFIG, "< $config";
+ while(<CONFIG>) {
+ $debugging_enabled++ if /define\s+DEBUGGING/;
+ $hide_mymalloc++ if /define\s+EMBEDMYMALLOC/;
+ $use_mymalloc++ if /define\s+MYMALLOC/;
+ }
+
# put quotes back onto defines - they were removed by DCL on the way in
if (($prefix,$defines,$suffix) =
($cc_cmd =~ m#(.*)/Define=(.*?)([/\s].*)#i)) {
$defines =~ s/^\((.*)\)$/$1/;
+ $debugging_enabled ||= $defines =~ /\bDEBUGGING\b/;
@defines = split(/,/,$defines);
$cc_cmd = "$prefix/Define=(" . join(',',grep($_ = "\"$_\"",@defines))
. ')' . $suffix;
@@ -85,10 +99,8 @@ if ($docc) {
or 0; # again, make debug output nice
print "\$isgcc: $isgcc\n" if $debug;
print "\$isvaxc: $isvaxc\n" if $debug;
+ print "\$debugging_enabled: $debugging_enabled\n" if $debug;
- if (-f 'perl.h') { $dir = '[]'; }
- elsif (-f '[-]perl.h') { $dir = '[-]'; }
- else { die "$0: Can't find perl.h\n"; }
}
else {
($junk,$junk,$cpp_file,$cc_cmd) = split(/~~/,$cc_cmd,4);
@@ -96,8 +108,10 @@ else {
or 0; # for nice debug output
$isvaxc = (!$isgcc && $cc_cmd !~ /standard=/i)
or 0; # again, for nice debug output
+ $debugging_enabled = $cc_cmd =~ /\bdebugging\b/i;
print "\$isgcc: \\$isgcc\\\n" if $debug;
print "\$isvaxc: \\$isvaxc\\\n" if $debug;
+ print "\$debugging_enabled: \\$debugging_enabled\\\n" if $debug;
print "Not running cc, preprocesor output in \\$cpp_file\\\n" if $debug;
}
@@ -150,6 +164,7 @@ sub scan_var {
$line =~ s/\[.*//;
$line =~ s/=.*//;
$line =~ s/\W*;?\s*$//;
+ $line =~ s/\W*\)\s*\(.*$//; # closing paren for args stripped in previous stmt
print "\tfiltered to \\$line\\\n" if $debug > 1;
if ($line =~ /(\w+)$/) {
print "\tvar name is \\$1\\" . ($const ? ' (const)' : '') . "\n" if $debug > 1;
@@ -183,6 +198,14 @@ sub scan_func {
}
}
+# Go add some right up front if we need 'em
+if ($use_mymalloc) {
+ $fcns{'Perl_malloc'}++;
+ $fcns{'Perl_calloc'}++;
+ $fcns{'Perl_realloc'}++;
+ $fcns{'Perl_myfree'}++;
+}
+
$used_expectation_enum = $used_opcode_enum = 0; # avoid warnings
if ($docc) {
open(CPP,"${cc_cmd}/NoObj/PreProc=Sys\$Output ${dir}perl.h|")
@@ -191,38 +214,51 @@ if ($docc) {
else {
open(CPP,"$cpp_file") or die "$0: Can't read preprocessed file $cpp_file: $!\n";
}
+%checkh = map { $_,1 } qw( thread bytecode byterun proto );
+$ckfunc = 0;
LINE: while (<CPP>) {
while (/^#.*vmsish\.h/i .. /^#.*perl\.h/i) {
while (/__VMS_PROTOTYPES__/i .. /__VMS_SEPYTOTORP__/i) {
print "vms_proto>> $_" if $debug > 2;
if (/^\s*EXT/) { &scan_var($_); }
else { &scan_func($_); }
- last LINE unless $_ = <CPP>;
+ last LINE unless defined($_ = <CPP>);
}
print "vmsish.h>> $_" if $debug > 2;
if (/^\s*EXT/) { &scan_var($_); }
- last LINE unless $_ = <CPP>;
+ last LINE unless defined($_ = <CPP>);
}
while (/^#.*opcode\.h/i .. /^#.*perl\.h/i) {
print "opcode.h>> $_" if $debug > 2;
if (/^OP \*\s/) { &scan_func($_); }
if (/^\s*EXT/) { &scan_var($_); }
if (/^\s+OP_/) { &scan_enum($_); }
- last LINE unless $_ = <CPP>;
+ last LINE unless defined($_ = <CPP>);
}
- while (/^typedef enum/ .. /^\}/) {
+ while (/^typedef enum/ .. /^\s*\}/) {
print "global enum>> $_" if $debug > 2;
&scan_enum($_);
- last LINE unless $_ = <CPP>;
+ last LINE unless defined($_ = <CPP>);
+ }
+ # Check for transition to new header file
+ if (/^# \d+ "(\S+)"/) {
+ my $spec = $1;
+ # Pull name from library module or header filespec
+ $spec =~ /^(\w+)$/ or $spec =~ /(\w+)\.h/i;
+ my $name = lc $1;
+ $ckfunc = exists $checkh{$name} ? 1 : 0;
+ $scanname = $name if $ckfunc;
+ print "Header file transition: ckfunc = $ckfunc for $name.h\n" if $debug > 1;
}
- while (/^#.*proto\.h/i .. /^#.*perl\.h/i) {
- print "proto.h>> $_" if $debug > 2;
+ if ($ckfunc) {
+ print "$scanname>> $_" if $debug > 2;
if (/\s*^EXT/) { &scan_var($_); }
- else { &scan_func($_); }
- last LINE unless $_ = <CPP>;
+ else { &scan_func($_); }
+ }
+ else {
+ print $_ if $debug > 3 && ($debug > 5 || length($_));
+ if (/^\s*EXT/) { &scan_var($_); }
}
- print $_ if $debug > 3 && ($debug > 5 || length($_));
- if (/^\s*EXT/) { &scan_var($_); }
}
close CPP;
@@ -241,6 +277,7 @@ while (<DATA>) {
print "Adding $key to \%$array list\n" if $debug > 1;
${$array}{$key}++;
}
+if ($debugging_enabled and $isgcc) { $vars{'colors'}++ }
foreach (split /\s+/, $extnames) {
my($pkgname) = $_;
$pkgname =~ s/::/__/g;
@@ -371,9 +408,8 @@ if ($ENV{PERLSHR_USE_GSMATCH}) {
my $major = int($] * 1000) & 0xFF; # range 0..255
my $minor = int(($] * 1000 - $major) * 100 + 0.5) & 0xFF; # range 0..255
print OPTBLD "GSMATCH=LEQUAL,$major,$minor\n";
- foreach (@symfiles) {
- print OPTBLD "CLUSTER=\$\$TRANSFER_VECTOR,,,$_.$objsuffix\n";
- }
+ print OPTBLD 'CLUSTER=$$TRANSFER_VECTOR,,',
+ map(",$_$objsuffix",@symfiles), "\n";
}
elsif (@symfiles) { $incstr .= ',' . join(',',@symfiles); }
# Include object modules and RTLs in options file
@@ -391,9 +427,6 @@ exec "\$ \@$drvrname" if $isvax;
__END__
# Oddball cases, so we can keep the perl.h scan above simple
-rcsid=vars # declared in perl.c
-regarglen=vars # declared in regcomp.h
-regdummy=vars # declared in regcomp.h
regkind=vars # declared in regcomp.h
simple=vars # declared in regcomp.h
varies=vars # declared in regcomp.h
diff --git a/gnu/usr.bin/perl/vms/genconfig.pl b/gnu/usr.bin/perl/vms/genconfig.pl
index d2e514b1c9e..45f50cad5fe 100644
--- a/gnu/usr.bin/perl/vms/genconfig.pl
+++ b/gnu/usr.bin/perl/vms/genconfig.pl
@@ -6,7 +6,7 @@
# that went into your perl binary. In addition, values which change from run
# to run may be supplied on the command line as key=val pairs.
#
-# Rev. 3-Dec-1996 Charles Bailey bailey@genetics.upenn.edu
+# Rev. 16-Feb-1998 Charles Bailey bailey@newman.upenn.edu
#
#==== Locations of installed Perl components
@@ -26,6 +26,7 @@ if ($ARGV[0] eq '-f') {
open(ARGS,$ARGV[1]) or die "Can't read data from $ARGV[1]: $!\n";
@ARGV = ();
while (<ARGS>) {
+ chomp;
push(@ARGV,split(/\|/,$_));
}
close ARGS;
@@ -67,21 +68,20 @@ package='perl5'
CONFIG='true'
cf_time='$time'
cf_by='$cf_by'
-ccdlflags=''
-cccdlflags=''
-mab=''
+ccdlflags='undef'
+cccdlflags='undef'
+mab='undef'
libpth='/sys\$share /sys\$library'
ld='Link'
lddlflags='/Share'
-ranlib=''
-ar=''
+ranlib='undef'
+ar='undef'
eunicefix=':'
hint='none'
-hintfile=''
-shrplib='define'
+hintfile='undef'
+useshrplib='define'
usemymalloc='n'
usevfork='true'
-useposix='false'
spitshell='write sys\$output '
dlsrc='dl_vms.c'
binexp='$installbin'
@@ -89,6 +89,8 @@ man1ext='rno'
man3ext='rno'
arch='VMS_$archsufx'
archname='VMS_$archsufx'
+bincompat3='undef'
+d_bincompat3='undef'
osvers='$osvers'
prefix='$prefix'
builddir='$builddir'
@@ -146,24 +148,91 @@ foreach (@ARGV) {
# object file suffix if it's not .obj.
$ccflags =~ s#/obj(?:ect)?=[^/\s]+##i;
}
+ $debug = $optimize = '';
+ while ( ($qual) = $ccflags =~ m|(/(No)?Deb[^/]*)|i ) {
+ $debug = $qual;
+ $ccflags =~ s/$qual//;
+ }
+ while ( ($qual) = $ccflags =~ m|(/(No)?Opt[^/]*)|i ) {
+ $optimize = $qual;
+ $ccflags =~ s/$qual//;
+ }
+ $usethreads = ($ccflags =~ m!/DEF[^/]+USE_THREADS!i and
+ $ccflags !~ m!/UND[^/]+USE_THREADS!i);
+ print OUT "usethreads='",($usethreads ? 'define' : 'undef'),"'\n";;
+ $optimize = "$debug$optimize";
print OUT "ccflags='$ccflags'\n";
+ print OUT "optimize='$optimize'\n";
$dosock = ($ccflags =~ m!/DEF[^/]+VMS_DO_SOCKETS!i and
$ccflags !~ m!/UND[^/]+VMS_DO_SOCKETS!i);
print OUT "d_vms_do_sockets=",$dosock ? "'define'\n" : "'undef'\n";
print OUT "d_socket=",$dosock ? "'define'\n" : "'undef'\n";
print OUT "d_sockpair=",$dosock ? "'define'\n" : "'undef'\n";
print OUT "d_gethent=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_sethent=",$dosock ? "'define'\n" : "'undef'\n";
print OUT "d_select=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "i_netdb=",$dosock ? "'define'\n" : "'undef'\n";
print OUT "i_niin=",$dosock ? "'define'\n" : "'undef'\n";
print OUT "i_neterrno=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_gethbyname=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_gethbyaddr=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_getpbyname=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_getpbynumber=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_getsbyname=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_getsbyport=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_endhent=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_getpent=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_setpent=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_endpent=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_getsent=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_setsent=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_endsent=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "netdb_name_type=",$dosock ? "'char *'\n" : "'undef'\n";
+ print OUT "netdb_host_type=",$dosock ? "'char *'\n" : "'undef'\n";
+ print OUT "netdb_hlen_type=",$dosock ? "'int'\n" : "'undef'\n";
+ print OUT "d_gethostprotos=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_getnetprotos=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_getservprotos=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_getprotoprotos=",$dosock ? "'define'\n" : "'undef'\n";
+
+ if ($dosock and $cctype eq 'decc' and $ccflags =~ /DECCRTL_SOCKETS/) {
+ print OUT "selecttype='fd_set'\n";
+ print OUT "d_getnbyaddr='define'\n";
+ print OUT "d_getnbyname='define'\n";
+ print OUT "d_getnent='define'\n";
+ print OUT "d_setnent='define'\n";
+ print OUT "d_endnent='define'\n";
+ print OUT "netdb_net_type='long'\n";
+ }
+ else {
+ print OUT "selecttype='int'\n";
+ print OUT "d_getnybname='undef'\n";
+ print OUT "d_getnybaddr='undef'\n";
+ print OUT "d_getnent='undef'\n";
+ print OUT "d_setnent='undef'\n";
+ print OUT "d_endnent='undef'\n";
+ print OUT "netdb_net_type='undef'\n";
+ }
- if ($cctype eq 'decc') { $rtlhas = 'define'; }
- else { $rtlhas = 'undef'; }
+ if ($cctype eq 'decc') {
+ $rtlhas = 'define';
+ print OUT "useposix='true'\n";
+ ($ccver,$vmsver) = `$cc/VERSION` =~ /V(\S+) on .*V(\S+)$/;
+ # Best guess; the may be wrong on systems which have separately
+ # installed the new CRTL.
+ if ($ccver >= 5.2 and $vmsver >= 7) { $rtlnew = 'define'; }
+ else { $rtlnew = 'undef'; }
+ }
+ else { $rtlhas = $rtlnew = 'undef'; print OUT "useposix='false'\n"; }
foreach (qw[ d_stdstdio d_stdio_ptr_lval d_stdio_cnt_lval d_stdiobase
d_locconv d_setlocale i_locale d_mbstowcs d_mbtowc
d_wcstombs d_wctomb d_mblen d_mktime d_strcoll d_strxfrm ]) {
print OUT "$_='$rtlhas'\n";
}
+ foreach (qw[ d_gettimeod d_uname d_truncate d_wait4 d_index
+ d_pathconf d_fpathconf d_sysconf d_sigsetjmp ]) {
+ print OUT "$_='$rtlnew'\n";
+ }
next;
}
elsif ($key eq 'exe_ext') {
@@ -296,6 +365,9 @@ close IN;
# as the manifest for the obsolete variable $d_eunice.
print OUT "d_eunice='undef'\n"; delete $pp_vars{VMS};
+# XXX temporary -- USE_THREADS is currently on CC command line
+delete $pp_vars{'USE_THREADS'};
+
foreach (sort keys %pp_vars) {
warn "Didn't see $_ in $infile\n";
}
diff --git a/gnu/usr.bin/perl/vms/perlvms.pod b/gnu/usr.bin/perl/vms/perlvms.pod
index c599e5834cd..89c4bbf6231 100644
--- a/gnu/usr.bin/perl/vms/perlvms.pod
+++ b/gnu/usr.bin/perl/vms/perlvms.pod
@@ -329,7 +329,12 @@ undefined behavior (rarely, we hope):
getgrnam, setgrent, endgrent, ioctl, link, lstat,
msgctl, msgget, msgsend, msgrcv, readlink, semctl,
semget, semop, setpgrp, setpriority, shmctl, shmget,
- shmread, shmwrite, socketpair, symlink, syscall, truncate
+ shmread, shmwrite, socketpair, symlink, syscall
+
+The following functions are available on Perls compiled with Dec C 5.2 or
+greater and running VMS 7.0 or greater
+
+ truncate
The following functions may or may not be implemented,
depending on what type of socket support you've built into
@@ -658,12 +663,20 @@ list logical names. For instance, if you say
Perl will print C<ONCE UPON A TIME THERE WAS>.
-The %ENV keys C<home>, C<path>,C<term>, and C<user>
-return the CRTL "environment variables" of the same
-names, if these logical names are not defined. The
-key C<default> returns the current default device
+The key C<default> returns the current default device
and directory specification, regardless of whether
-there is a logical name DEFAULT defined..
+there is a logical name DEFAULT defined. If you try to
+read an element of %ENV for which there is no corresponding
+logical name, and for which no corresponding CLI symbol
+exists (this is to identify "blocking" symbols only; to
+manipulate CLI symbols, see L<VMS::DCLSym>) then the key
+will be looked up in the CRTL-local environment array, and
+the corresponding value, if any returned. This lets you
+get at C-specific keys like C<home>, C<path>,C<term>, and
+C<user>, as well as other keys which may have been passed
+directly into the C-specific array if Perl was called from
+another C program using the version of execve() or execle()
+present in recent revisions of the DECCRTL.
Setting an element of %ENV defines a supervisor-mode logical
name in the process logical name table. C<Undef>ing or
@@ -675,6 +688,23 @@ logical name translation after the deletion, so an inner-mode
logical name or a name in another logical name table will
replace the logical name just deleted. It is not possible
at present to define a search list logical name via %ENV.
+It is also not possible to delete an element from the
+C-local environ array.
+
+Note that if you want to pass on any elements of the
+C-local environ array to a subprocess which isn't
+started by fork/exec, or isn't running a C program, you
+can "promote" them to logical names in the current
+process, which will then be inherited by all subprocesses,
+by saying
+
+ foreach my $key (qw[C-local keys you want promoted]) {
+ my $temp = $ENV{$key}; # read from C-local array
+ $ENV{$key} = $temp; # and define as logical name
+ }
+
+(You can't just say C<$ENV{$key} = $ENV{$key}>, since the
+Perl optimizer is smart enough to elide the expression.)
At present, the first time you iterate over %ENV using
C<keys>, or C<values>, you will incur a time penalty as all
@@ -749,12 +779,23 @@ it's equivalent to calling fflush() and fsync() from C.
=back
+=head1 Standard modules with VMS-specific differences
+
+=head2 SDBM_File
+
+SDBM_File works peroperly on VMS. It has, however, one minor
+difference. The database directory file created has a L<.sdbm_dir>
+extension rather than a L<.dir> extension. L<.dir> files are VMS filesystem
+directory files, and using them for other purposes could cause unacceptable
+problems.
+
=head1 Revision date
-This document was last updated on 28-Feb-1996, for Perl 5,
-patchlevel 2.
+This document was last updated on 26-Feb-1998, for Perl 5,
+patchlevel 5.
=head1 AUTHOR
-Charles Bailey bailey@genetics.upenn.edu
+Charles Bailey bailey@cor.newman.upenn.edu
+Last revision by Dan Sugalski sugalskd@ous.edu
diff --git a/gnu/usr.bin/perl/vms/perly_c.vms b/gnu/usr.bin/perl/vms/perly_c.vms
index ded0cf419c8..f263439e851 100644
--- a/gnu/usr.bin/perl/vms/perly_c.vms
+++ b/gnu/usr.bin/perl/vms/perly_c.vms
@@ -7,1061 +7,1058 @@ static char yysccsid[] = "@(#)yaccpar 1.8 (Berkeley) 01/20/91";
#include "EXTERN.h"
#include "perl.h"
+#ifdef PERL_OBJECT
static void
-dep()
+Dep(CPerlObj *pPerl)
+{
+ pPerl->deprecate("\"do\" to call subroutines");
+}
+#define dep() Dep(this)
+#else
+static void
+dep(void)
{
deprecate("\"do\" to call subroutines");
}
+#endif
#line 16 "perly.c"
#define YYERRCODE 256
dEXT short yylhs[] = { -1,
45, 0, 9, 7, 10, 8, 11, 11, 11, 12,
- 12, 12, 12, 24, 24, 24, 24, 24, 24, 15,
- 15, 15, 14, 14, 42, 42, 13, 13, 13, 13,
- 13, 13, 13, 26, 26, 27, 27, 28, 29, 30,
- 31, 32, 44, 44, 1, 1, 1, 1, 3, 38,
- 38, 46, 4, 5, 6, 39, 40, 40, 41, 41,
- 47, 47, 49, 48, 16, 16, 16, 25, 25, 25,
- 36, 36, 36, 36, 36, 36, 36, 50, 36, 37,
- 37, 17, 17, 17, 17, 17, 17, 17, 17, 17,
+ 12, 12, 12, 24, 24, 24, 24, 24, 24, 24,
+ 15, 15, 15, 14, 14, 42, 42, 13, 13, 13,
+ 13, 13, 13, 13, 26, 26, 27, 27, 28, 29,
+ 30, 31, 32, 44, 44, 1, 1, 1, 1, 3,
+ 38, 38, 46, 4, 5, 6, 39, 40, 40, 41,
+ 41, 47, 47, 49, 48, 16, 16, 16, 25, 25,
+ 25, 36, 36, 36, 36, 36, 36, 36, 50, 36,
+ 37, 37, 17, 17, 17, 17, 17, 17, 17, 17,
17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
- 17, 17, 17, 17, 17, 17, 17, 33, 33, 34,
- 34, 34, 2, 2, 43, 23, 18, 19, 20, 21,
- 22, 35, 35, 35, 35,
+ 17, 17, 17, 17, 17, 17, 17, 17, 33, 33,
+ 34, 34, 34, 2, 2, 43, 23, 18, 19, 20,
+ 21, 22, 35, 35, 35, 35,
};
dEXT short yylen[] = { 2,
0, 2, 4, 0, 4, 0, 0, 2, 2, 2,
- 1, 2, 3, 1, 1, 3, 3, 3, 3, 0,
- 2, 6, 7, 7, 0, 2, 8, 8, 10, 9,
- 8, 11, 3, 0, 1, 0, 1, 1, 1, 1,
- 1, 1, 0, 1, 1, 1, 1, 1, 4, 1,
- 0, 5, 0, 0, 0, 1, 0, 1, 1, 1,
- 3, 2, 0, 7, 3, 3, 1, 2, 3, 1,
- 3, 5, 6, 3, 5, 2, 4, 0, 5, 1,
- 1, 3, 3, 3, 3, 3, 3, 3, 3, 3,
- 3, 3, 3, 5, 3, 2, 2, 2, 2, 2,
- 2, 2, 2, 2, 2, 3, 2, 3, 2, 4,
- 3, 4, 1, 5, 1, 4, 5, 4, 1, 1,
- 1, 5, 6, 5, 6, 5, 4, 5, 1, 1,
- 3, 4, 3, 2, 2, 4, 5, 4, 5, 4,
- 5, 1, 2, 2, 1, 2, 2, 2, 1, 3,
- 1, 3, 4, 4, 6, 1, 1, 0, 1, 0,
- 1, 2, 1, 1, 1, 2, 2, 2, 2, 2,
- 2, 1, 1, 1, 1,
+ 1, 2, 3, 1, 1, 3, 3, 3, 3, 3,
+ 0, 2, 6, 7, 7, 0, 2, 8, 8, 10,
+ 9, 8, 11, 3, 0, 1, 0, 1, 1, 1,
+ 1, 1, 1, 0, 1, 1, 1, 1, 1, 4,
+ 1, 0, 5, 0, 0, 0, 1, 0, 1, 1,
+ 1, 3, 2, 0, 7, 3, 3, 1, 2, 3,
+ 1, 3, 5, 6, 3, 5, 2, 4, 0, 5,
+ 1, 1, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 5, 3, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 3, 2, 3, 2,
+ 4, 3, 4, 1, 5, 1, 4, 5, 4, 1,
+ 1, 1, 5, 6, 5, 6, 5, 4, 5, 1,
+ 1, 3, 4, 3, 2, 2, 4, 5, 4, 5,
+ 4, 5, 1, 2, 2, 1, 2, 2, 2, 1,
+ 3, 1, 3, 4, 4, 6, 1, 1, 0, 1,
+ 0, 1, 2, 1, 1, 1, 2, 2, 2, 2,
+ 2, 2, 1, 1, 1, 1,
};
dEXT short yydefred[] = { 1,
- 0, 7, 0, 44, 55, 53, 0, 53, 8, 45,
- 9, 11, 0, 46, 47, 48, 0, 0, 0, 62,
- 63, 14, 4, 156, 0, 0, 129, 0, 151, 0,
- 54, 54, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 163, 164, 0,
+ 0, 7, 0, 45, 56, 54, 0, 54, 8, 46,
+ 9, 11, 0, 47, 48, 49, 0, 0, 0, 63,
+ 64, 14, 4, 157, 0, 0, 130, 0, 152, 0,
+ 55, 55, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 164, 165, 0,
0, 0, 0, 0, 0, 0, 0, 12, 0, 0,
0, 0, 0, 0, 0, 0, 0, 10, 0, 0,
- 0, 0, 119, 121, 0, 0, 0, 0, 157, 50,
- 0, 56, 0, 61, 0, 7, 172, 175, 174, 173,
+ 0, 0, 120, 122, 0, 0, 0, 0, 158, 51,
+ 0, 57, 0, 62, 0, 7, 173, 176, 175, 174,
0, 0, 0, 0, 0, 0, 4, 4, 4, 4,
- 4, 4, 0, 0, 0, 0, 0, 146, 0, 0,
- 0, 0, 76, 0, 170, 0, 135, 0, 0, 0,
- 0, 0, 166, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 109, 0, 167, 168, 169, 171, 0,
- 0, 33, 0, 0, 0, 0, 0, 0, 0, 0,
+ 4, 4, 0, 0, 0, 0, 0, 147, 0, 0,
+ 0, 0, 77, 0, 171, 0, 136, 0, 0, 0,
+ 0, 0, 167, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 110, 0, 168, 169, 170, 172, 0,
+ 0, 34, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 101, 102, 0, 0, 0, 0, 0,
- 0, 0, 0, 13, 0, 49, 58, 0, 0, 0,
- 74, 0, 0, 78, 0, 0, 0, 0, 0, 0,
- 0, 4, 150, 152, 0, 0, 0, 0, 0, 0,
- 0, 111, 0, 133, 0, 0, 108, 26, 0, 0,
- 19, 0, 0, 0, 65, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 102, 103, 0, 0, 0, 0,
+ 0, 0, 0, 0, 13, 0, 50, 59, 0, 0,
+ 0, 75, 0, 0, 79, 0, 0, 0, 0, 0,
+ 0, 0, 4, 151, 153, 0, 0, 0, 0, 0,
+ 0, 0, 112, 0, 134, 0, 0, 109, 27, 0,
+ 0, 19, 0, 0, 0, 0, 66, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 80, 0, 0, 81, 0, 0, 0, 0, 0,
- 0, 0, 131, 0, 0, 60, 59, 52, 0, 3,
- 0, 154, 0, 0, 112, 0, 41, 0, 42, 0,
- 0, 0, 0, 165, 0, 0, 35, 40, 0, 0,
- 0, 153, 162, 77, 0, 136, 0, 138, 0, 110,
- 0, 0, 0, 0, 0, 140, 0, 0, 0, 118,
- 0, 116, 0, 127, 0, 132, 0, 75, 0, 79,
- 0, 0, 0, 0, 0, 0, 0, 0, 72, 137,
- 139, 126, 0, 124, 0, 0, 141, 117, 0, 122,
- 128, 114, 64, 155, 6, 0, 0, 0, 0, 0,
- 0, 0, 0, 125, 123, 73, 7, 27, 28, 0,
- 0, 23, 24, 0, 31, 0, 0, 0, 21, 0,
- 0, 0, 30, 5, 0, 29, 0, 0, 32, 0,
- 22,
+ 0, 0, 0, 81, 0, 0, 82, 0, 0, 0,
+ 0, 0, 0, 0, 132, 0, 0, 61, 60, 53,
+ 0, 3, 0, 155, 0, 0, 113, 0, 42, 0,
+ 43, 0, 0, 0, 0, 166, 0, 0, 36, 41,
+ 0, 0, 0, 154, 163, 78, 0, 137, 0, 139,
+ 0, 111, 0, 0, 0, 0, 0, 141, 0, 0,
+ 0, 119, 0, 117, 0, 128, 0, 133, 0, 76,
+ 0, 80, 0, 0, 0, 0, 0, 0, 0, 0,
+ 73, 138, 140, 127, 0, 125, 0, 0, 142, 118,
+ 0, 123, 129, 115, 65, 156, 6, 0, 0, 0,
+ 0, 0, 0, 0, 0, 126, 124, 74, 7, 28,
+ 29, 0, 0, 24, 25, 0, 32, 0, 0, 0,
+ 22, 0, 0, 0, 31, 5, 0, 30, 0, 0,
+ 33, 0, 23,
};
dEXT short yydgoto[] = { 1,
- 9, 66, 10, 18, 95, 17, 86, 337, 89, 326,
- 3, 11, 12, 68, 342, 261, 70, 71, 72, 73,
- 74, 75, 76, 267, 78, 268, 257, 259, 262, 270,
- 258, 260, 113, 197, 91, 79, 236, 81, 83, 178,
- 248, 142, 265, 13, 2, 14, 15, 16, 85, 254,
+ 9, 66, 10, 18, 95, 17, 86, 339, 89, 328,
+ 3, 11, 12, 68, 344, 263, 70, 71, 72, 73,
+ 74, 75, 76, 269, 78, 270, 259, 261, 264, 272,
+ 260, 262, 113, 198, 91, 79, 238, 81, 83, 179,
+ 250, 142, 267, 13, 2, 14, 15, 16, 85, 256,
};
dEXT short yysindex[] = { 0,
- 0, 0, -120, 0, 0, 0, -50, 0, 0, 0,
- 0, 0, 661, 0, 0, 0, -240, -238, -29, 0,
- 0, 0, 0, 0, -32, -32, 0, -8, 0, 2115,
- 0, 0, -4, 31, 32, 35, -35, 2115, 56, 57,
- 61, 1037, 981, -32, 1100, 1364, -218, 0, 0, -32,
- 2115, 2115, 2115, 2115, 2115, 2115, 1420, 0, 2115, 2115,
- 1476, -32, -32, -32, -32, 2115, -205, 0, 201, 306,
- -63, -62, 0, 0, -24, 67, 45, 65, 0, 0,
- -15, 0, -149, 0, -144, 0, 0, 0, 0, 0,
- 2115, 80, 2115, 841, -15, -149, 0, 0, 0, 0,
- 0, 0, 85, 306, 86, 1535, 981, 0, 841, 0,
- -63, 65, 0, 2115, 0, 88, 0, 841, -28, 4,
- -51, 2115, 0, 65, 340, 340, 340, -76, -76, 49,
- -31, 340, 340, 0, -82, 0, 0, 0, 0, 841,
- -15, 0, 2115, 2115, 2115, 2115, 2115, 2115, 2115, 2115,
- 2115, 2115, 2115, 2115, 2115, 2115, 2115, 2115, 2115, 2115,
- 2115, 2115, 2115, 0, 0, 48, 2115, 2115, 2115, 2115,
- 2115, 2115, 1710, 0, 2115, 0, 0, -43, -116, 241,
- 0, 2115, 1193, 0, -15, 2115, 2115, 2115, 2115, 106,
- 1769, 0, 0, 0, -23, 20, 104, 2115, 65, 1825,
- 1881, 0, 36, 0, 2115, 62, 0, 0, -232, -232,
- 0, -232, -232, -134, 0, -46, 1131, 841, 689, 316,
- 859, 306, 3778, 1980, 3652, 1299, 480, 396, 340, 340,
- 2115, 0, 1944, 2115, 0, 128, -58, 22, -56, 24,
- 33, 28, 0, -19, 306, 0, 0, 0, 2115, 0,
- 134, 0, 2115, 2115, 0, -232, 0, 142, 0, 148,
- -232, 149, 150, 0, 153, 201, 0, 0, 154, 138,
- 2115, 0, 0, 0, -7, 0, 2, 0, 16, 0,
- 70, 2115, 73, 2115, 30, 0, 18, 101, 2115, 0,
- 75, 0, 78, 0, 81, 0, 151, 0, 1247, 0,
- 90, 90, 90, 90, 2115, 90, 2115, 167, 0, 0,
- 0, 0, 103, 0, 3869, 84, 0, 0, 170, 0,
- 0, 0, 0, 0, 0, -205, -205, -207, -207, 176,
- -205, 168, 90, 0, 0, 0, 0, 0, 0, 90,
- 192, 0, 0, 90, 0, 1769, -205, 402, 0, 2115,
- -205, 207, 0, 0, 208, 0, 90, 90, 0, -207,
- 0,
+ 0, 0, -66, 0, 0, 0, -48, 0, 0, 0,
+ 0, 0, 645, 0, 0, 0, -232, -227, -27, 0,
+ 0, 0, 0, 0, -23, -23, 0, -6, 0, 2099,
+ 0, 0, 13, 20, 24, 25, -34, 2099, 27, 28,
+ 29, 1021, 965, -23, 1084, 1348, -217, 0, 0, -23,
+ 2099, 2099, 2099, 2099, 2099, 2099, 1404, 0, 2099, 2099,
+ 1460, -23, -23, -23, -23, 2099, -206, 0, 335, 3814,
+ -73, -68, 0, 0, -47, 40, 32, 61, 0, 0,
+ -39, 0, -157, 0, -145, 0, 0, 0, 0, 0,
+ 2099, 73, 2099, 825, -39, -157, 0, 0, 0, 0,
+ 0, 0, 75, 3814, 78, 1519, 965, 0, 825, 0,
+ -73, 61, 0, 2099, 0, 77, 0, 825, -16, -9,
+ -51, 2099, 0, 61, 87, 87, 87, -86, -86, 33,
+ -40, 87, 87, 0, -81, 0, 0, 0, 0, 825,
+ -39, 0, 2099, 2099, 2099, 2099, 2099, 2099, 2099, 2099,
+ 2099, 2099, 2099, 2099, 2099, 2099, 2099, 2099, 2099, 2099,
+ 2099, 2099, 2099, 2099, 0, 0, 30, 2099, 2099, 2099,
+ 2099, 2099, 2099, 1694, 0, 2099, 0, 0, -49, -118,
+ 189, 0, 2099, 353, 0, -39, 2099, 2099, 2099, 2099,
+ 104, 1753, 0, 0, 0, -24, 8, 85, 2099, 61,
+ 1809, 1865, 0, 23, 0, 2099, 54, 0, 0, -269,
+ -269, 0, -269, -269, -269, -151, 0, -43, 1121, 825,
+ 673, 50, 363, 3814, 1233, 2459, 3640, 2309, 266, -82,
+ 87, 87, 2099, 0, 1928, 2099, 0, 111, 51, 12,
+ 76, 14, 90, 39, 0, -22, 3814, 0, 0, 0,
+ 2099, 0, 121, 0, 2099, 2099, 0, -269, 0, 124,
+ 0, 125, -269, 126, 130, 0, 112, 335, 0, 0,
+ 131, 136, 2099, 0, 0, 0, -14, 0, 1, 0,
+ 4, 0, 133, 2099, 55, 2099, 49, 0, 6, 197,
+ 2099, 0, 89, 0, 94, 0, 100, 0, 144, 0,
+ 1175, 0, 92, 92, 92, 92, 2099, 92, 2099, 171,
+ 0, 0, 0, 0, 202, 0, 3900, 108, 0, 0,
+ 188, 0, 0, 0, 0, 0, 0, -206, -206, -238,
+ -238, 199, -206, 211, 92, 0, 0, 0, 0, 0,
+ 0, 92, 241, 0, 0, 92, 0, 1753, -206, 326,
+ 0, 2099, -206, 256, 0, 0, 259, 0, 92, 92,
+ 0, -238, 0,
};
dEXT short yyrindex[] = { 0,
- 0, 0, 265, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 131, 0, 0, 0,
+ 0, 0, 249, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 184, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 2156, -17, 0,
- 0, 2675, 2720, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 2228, 426, 0,
+ 0, 2833, 2876, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 79, 0, -3, 108,
- 2774, 2860, 0, 0, 2034, 121, 0, 140, 0, 0,
- 0, 0, -33, 0, 0, 0, 0, 0, 0, 0,
- 2203, 0, 0, 3504, 0, 145, 0, 0, 0, 0,
- 0, 0, 0, 3772, 0, 0, 252, 0, 3551, 541,
- 602, 2270, 0, 0, 0, 442, 0, 3587, 2774, 0,
- 0, 2203, 0, 2324, 3010, 3049, 3096, 2911, 2972, 2439,
- 0, 3147, 3193, 0, 0, 0, 0, 0, 0, 3633,
+ 0, 0, 0, 0, 0, 0, 59, 0, -10, 2038,
+ 2952, 2995, 0, 0, 2274, 2140, 0, 200, 0, 0,
+ 0, 0, -44, 0, 0, 0, 0, 0, 0, 0,
+ 2421, 0, 0, 105, 0, 198, 0, 0, 0, 0,
+ 0, 0, 0, 3753, 0, 0, 319, 0, 3505, 525,
+ 586, 2510, 0, 0, 0, 2185, 0, 3541, 2952, 0,
+ 0, 2421, 0, 2553, 3112, 3150, 3188, -37, 3069, 2597,
+ 0, 3231, 3269, 0, 0, 0, 0, 0, 0, 3584,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 2522, 0, 0, 0, 0, 925,
- 0, 252, 0, 0, 0, 263, 0, 0, 0, 0,
- 223, 0, 0, 0, 0, 282, 0, 0, 2576, 0,
- 0, 0, 0, 0, 0, 2624, 0, 0, -1, 26,
- 0, 27, 51, 718, 0, 0, 3752, 1576, 1632, 3368,
- 3413, 3799, 0, -38, 3710, 3678, 3060, 3459, 3285, 3332,
+ 0, 0, 0, 0, 0, 2673, 0, 0, 0, 0,
+ 909, 0, 319, 0, 0, 0, 320, 0, 0, 0,
+ 0, 306, 0, 0, 0, 0, 325, 0, 0, 2789,
+ 0, 0, 0, 0, 0, 0, 2716, 0, 0, -5,
+ 22, 0, 68, 69, 70, 702, 0, 0, 3741, 1296,
+ 1560, 3386, 3424, 3796, 0, 3703, 3660, 3622, 1616, 3467,
+ 3305, 3348, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 3809, 0, 0, 0,
+ 309, 0, 0, 0, 0, 2421, 0, 79, 0, 0,
+ 0, 0, 330, 0, 0, 0, 0, 84, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 3835, 0, 0, 0, 273, 0,
- 0, 0, 0, 2203, 0, 59, 0, 0, 0, 0,
- 293, 0, 0, 0, 0, 64, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 252, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 296, 0, 0, 0,
- 0, 0, 0, 0, 2380, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 79, 79, 186, 186, 0,
- 79, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 300, 79, 925, 0, 0,
- 79, 0, 0, 0, 0, 0, 0, 0, 0, 186,
- 0,
+ 319, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 317, 0,
+ 0, 0, 0, 0, 0, 0, 1982, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 59, 59, 154,
+ 154, 0, 59, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 340, 59, 909,
+ 0, 0, 59, 0, 0, 0, 0, 0, 0, 0,
+ 0, 154, 0,
};
dEXT short yygindex[] = { 0,
- 0, 0, 0, 349, 328, 0, -48, 0, 679, 378,
- -84, 0, 0, 0, -298, -13, 4075, 2485, 0, 0,
- 0, 0, 0, 363, 908, 0, 0, 233, -168, 38,
- 72, 196, -77, -175, 999, 0, 0, 0, 0, 290,
- 0, -249, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 374, 351, 0, -12, 0, 946, 413,
+ -83, 0, 0, 0, -311, -13, 4007, 2893, 0, 0,
+ 0, 0, 0, 372, -8, 0, 0, 246, -131, 43,
+ 86, 208, -45, -169, 987, 0, 0, 0, 0, 308,
+ 0, -271, 0, 0, 0, 0, 0, 0, 0, 0,
};
-#define YYTABLESIZE 4359
+#define YYTABLESIZE 4293
dEXT short yytable[] = { 69,
- 62, 180, 93, 62, 102, 93, 251, 203, 20, 206,
- 207, 201, 283, 181, 167, 246, 80, 272, 82, 93,
- 93, 296, 269, 149, 93, 57, 149, 169, 171, 84,
- 343, 93, 121, 309, 290, 97, 292, 15, 122, 18,
- 149, 149, 310, 131, 204, 149, 149, 135, 186, 187,
- 188, 189, 190, 191, 93, 15, 311, 18, 317, 168,
- 170, 361, 169, 273, 147, 148, 38, 16, 340, 341,
- 98, 99, 141, 149, 100, 149, 338, 339, 25, 23,
- 291, 345, 293, 62, 38, 16, 295, 233, 316, 57,
- 23, 17, 195, 196, 168, 105, 106, 353, 172, 37,
- 107, 356, 308, 174, 39, 149, 173, 23, 175, 17,
- 177, 25, 179, 319, 25, 25, 25, 37, 25, 182,
- 25, 25, 15, 25, 192, 294, 193, 200, 202, 209,
- 210, 212, 213, 214, 215, 216, 330, 25, 234, 205,
- 249, 62, 25, 271, 274, 4, 5, 6, 70, 7,
- 8, 70, 282, 237, 238, 239, 240, 241, 242, 244,
- 280, 130, 312, 148, 130, 70, 70, 289, 196, 25,
- 231, 297, 256, 210, 298, 210, 300, 266, 130, 130,
- 67, 355, 301, 130, 275, 20, 277, 279, 302, 303,
- 304, 281, 305, 318, 306, 334, 307, 314, 67, 320,
- 70, 25, 321, 25, 25, 322, 19, 333, 335, 323,
- 336, 130, 325, 130, 147, 148, 344, 285, 20, 287,
- 288, 20, 20, 20, 87, 20, 346, 20, 20, 88,
- 20, 350, 67, 93, 93, 93, 93, 166, 147, 148,
- 147, 148, 93, 130, 20, 147, 148, 357, 358, 20,
- 147, 148, 348, 51, 149, 149, 149, 149, 93, 93,
- 101, 93, 93, 149, 2, 147, 148, 57, 313, 149,
- 149, 149, 149, 147, 148, 196, 20, 147, 148, 149,
- 149, 34, 149, 149, 149, 149, 149, 149, 149, 147,
- 148, 149, 160, 256, 149, 149, 149, 43, 147, 148,
- 43, 43, 43, 36, 43, 232, 43, 43, 20, 43,
- 20, 20, 147, 148, 147, 148, 147, 148, 147, 148,
- 147, 148, 161, 43, 147, 148, 147, 148, 43, 147,
- 148, 158, 69, 39, 25, 25, 25, 25, 25, 25,
- 34, 25, 25, 25, 25, 25, 25, 25, 25, 25,
- 25, 25, 25, 25, 36, 43, 21, 25, 25, 96,
- 25, 25, 25, 25, 25, 250, 147, 148, 156, 25,
- 25, 25, 25, 25, 25, 77, 211, 25, 332, 70,
- 70, 70, 70, 352, 263, 185, 25, 43, 25, 25,
- 43, 0, 130, 130, 130, 130, 167, 147, 148, 147,
- 148, 130, 0, 0, 70, 70, 167, 130, 130, 130,
- 130, 67, 67, 67, 67, 0, 0, 130, 130, 0,
- 130, 130, 130, 130, 130, 130, 130, 0, 149, 130,
- 167, 0, 130, 130, 130, 0, 67, 67, 149, 0,
- 0, 20, 20, 20, 20, 20, 20, 0, 20, 20,
- 20, 20, 20, 20, 20, 20, 20, 20, 20, 20,
- 20, 0, 149, 0, 20, 20, 0, 20, 20, 20,
- 20, 20, 143, 144, 145, 146, 20, 20, 20, 20,
- 20, 20, 156, 0, 20, 156, 167, 0, 0, 0,
- 0, 0, 0, 20, 0, 20, 20, 147, 148, 156,
- 156, 0, 0, 0, 156, 0, 4, 5, 6, 0,
- 7, 8, 0, 0, 0, 0, 0, 0, 149, 0,
- 43, 43, 43, 43, 43, 43, 354, 43, 43, 43,
- 0, 0, 156, 43, 156, 0, 43, 43, 43, 43,
- 0, 0, 0, 43, 43, 0, 43, 43, 43, 43,
- 43, 0, 0, 0, 0, 43, 43, 43, 43, 43,
- 43, 0, 0, 43, 156, 0, 0, 0, 0, 0,
- 167, 0, 43, 172, 43, 43, 172, 172, 172, 0,
- 172, 156, 172, 172, 156, 172, 150, 0, 0, 0,
- 0, 0, 151, 152, 153, 154, 0, 0, 156, 156,
- 0, 0, 149, 156, 172, 155, 157, 158, 159, 160,
- 161, 162, 0, 0, 163, 0, 0, 164, 165, 166,
- 0, 162, 0, 0, 163, 0, 0, 164, 165, 166,
- 0, 156, 0, 156, 173, 0, 0, 173, 173, 173,
- 0, 173, 113, 173, 173, 113, 173, 0, 163, 0,
- 0, 164, 165, 166, 0, 0, 0, 0, 0, 113,
- 113, 0, 0, 156, 113, 173, 172, 4, 5, 6,
- 0, 7, 8, 0, 0, 0, 0, 0, 0, 327,
- 328, 329, 0, 331, 153, 154, 0, 0, 0, 0,
- 0, 67, 0, 52, 113, 0, 62, 64, 50, 0,
- 57, 162, 65, 60, 163, 59, 0, 164, 165, 166,
- 347, 0, 0, 156, 156, 156, 156, 349, 0, 58,
- 108, 351, 156, 117, 63, 0, 0, 173, 156, 156,
- 156, 156, 0, 0, 359, 360, 0, 0, 156, 156,
- 0, 156, 156, 156, 156, 156, 156, 156, 0, 0,
- 156, 61, 0, 156, 156, 156, 0, 0, 66, 176,
- 0, 66, 0, 0, 0, 0, 151, 152, 153, 154,
- 0, 0, 0, 184, 0, 0, 66, 0, 0, 167,
- 0, 0, 0, 23, 161, 162, 53, 0, 163, 0,
- 0, 164, 165, 166, 0, 0, 0, 172, 172, 172,
- 172, 172, 0, 172, 172, 172, 0, 0, 0, 172,
- 66, 149, 156, 156, 156, 156, 0, 0, 0, 208,
- 172, 156, 172, 172, 172, 172, 172, 156, 156, 156,
- 156, 172, 172, 172, 172, 172, 172, 156, 156, 172,
- 156, 156, 156, 156, 156, 156, 156, 0, 172, 156,
- 172, 172, 156, 156, 156, 0, 247, 0, 173, 173,
- 173, 173, 173, 255, 173, 173, 173, 0, 0, 0,
- 173, 0, 0, 113, 113, 113, 113, 0, 0, 0,
- 0, 173, 113, 173, 173, 173, 173, 173, 113, 113,
- 113, 113, 173, 173, 173, 173, 173, 173, 113, 113,
- 173, 113, 113, 113, 113, 113, 113, 113, 0, 173,
- 113, 173, 173, 113, 113, 113, 22, 24, 25, 26,
- 27, 28, 0, 29, 30, 31, 0, 0, 0, 32,
- 0, 167, 33, 34, 35, 36, 0, 0, 0, 37,
- 38, 0, 39, 40, 41, 42, 43, 0, 0, 167,
- 112, 44, 45, 46, 47, 48, 49, 43, 124, 51,
- 43, 43, 43, 149, 43, 0, 43, 43, 54, 43,
- 55, 56, 0, 0, 0, 151, 0, 153, 154, 0,
- 0, 149, 0, 43, 0, 0, 0, 0, 43, 66,
- 66, 66, 66, 161, 162, 0, 0, 163, 112, 0,
- 164, 165, 166, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 52, 66, 43, 62, 64, 50, 0,
- 57, 199, 65, 60, 92, 59, 0, 0, 0, 112,
+ 207, 62, 181, 104, 168, 102, 104, 204, 168, 248,
+ 20, 208, 62, 253, 58, 285, 274, 170, 298, 345,
+ 104, 104, 172, 202, 80, 104, 311, 148, 149, 82,
+ 15, 84, 121, 93, 112, 18, 150, 342, 343, 122,
+ 150, 312, 124, 131, 313, 182, 319, 135, 15, 169,
+ 363, 275, 97, 18, 171, 104, 340, 341, 26, 98,
+ 271, 347, 39, 99, 100, 62, 105, 106, 107, 235,
+ 293, 141, 295, 23, 170, 173, 205, 355, 58, 174,
+ 39, 358, 112, 23, 187, 188, 189, 190, 191, 192,
+ 175, 26, 196, 197, 26, 26, 26, 297, 26, 23,
+ 26, 26, 178, 26, 176, 200, 169, 318, 16, 17,
+ 20, 180, 183, 112, 193, 203, 201, 26, 194, 38,
+ 236, 321, 26, 206, 40, 276, 16, 17, 20, 210,
+ 211, 213, 214, 215, 216, 217, 218, 38, 251, 62,
+ 168, 310, 15, 292, 284, 149, 149, 282, 149, 26,
+ 291, 307, 233, 21, 239, 240, 241, 242, 243, 244,
+ 246, 300, 149, 149, 303, 304, 305, 149, 294, 197,
+ 306, 308, 150, 258, 211, 332, 211, 168, 268, 316,
+ 273, 26, 296, 26, 26, 277, 21, 279, 281, 21,
+ 21, 21, 283, 21, 309, 21, 21, 149, 21, 4,
+ 5, 6, 325, 7, 8, 299, 154, 155, 19, 150,
+ 302, 335, 21, 322, 327, 148, 149, 21, 323, 287,
+ 357, 289, 290, 163, 324, 314, 164, 167, 338, 165,
+ 166, 167, 337, 87, 104, 104, 104, 104, 88, 346,
+ 68, 104, 112, 104, 21, 148, 149, 112, 2, 104,
+ 104, 104, 104, 148, 149, 350, 148, 149, 68, 104,
+ 104, 101, 104, 104, 104, 104, 104, 104, 104, 348,
+ 315, 104, 148, 149, 148, 149, 21, 197, 21, 21,
+ 352, 44, 148, 149, 44, 44, 44, 234, 44, 320,
+ 44, 44, 68, 44, 336, 258, 359, 148, 149, 360,
+ 148, 149, 148, 149, 148, 149, 52, 44, 148, 149,
+ 148, 149, 44, 252, 26, 26, 26, 26, 26, 26,
+ 58, 26, 26, 26, 26, 26, 26, 26, 26, 26,
+ 26, 26, 26, 26, 69, 148, 149, 26, 26, 44,
+ 26, 26, 26, 26, 26, 148, 149, 148, 149, 26,
+ 26, 26, 26, 26, 26, 163, 168, 26, 164, 161,
+ 37, 165, 166, 167, 35, 162, 26, 159, 26, 26,
+ 40, 44, 148, 149, 44, 37, 149, 149, 149, 149,
+ 35, 21, 96, 149, 77, 149, 148, 149, 150, 212,
+ 354, 149, 149, 254, 334, 164, 255, 265, 165, 166,
+ 167, 149, 149, 186, 149, 149, 149, 149, 149, 21,
+ 21, 21, 21, 21, 21, 157, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 148,
+ 149, 0, 21, 21, 0, 21, 21, 21, 21, 21,
+ 0, 0, 0, 168, 21, 21, 21, 21, 21, 21,
+ 356, 0, 21, 168, 4, 5, 6, 0, 7, 8,
+ 0, 21, 0, 21, 21, 0, 150, 0, 0, 150,
+ 0, 68, 68, 68, 68, 150, 0, 0, 68, 0,
+ 0, 0, 0, 150, 150, 150, 0, 0, 150, 0,
+ 0, 0, 0, 148, 149, 0, 68, 68, 148, 149,
+ 0, 0, 0, 0, 44, 44, 44, 44, 44, 44,
+ 0, 44, 44, 44, 0, 0, 150, 44, 150, 0,
+ 44, 44, 44, 44, 0, 0, 0, 44, 44, 0,
+ 44, 44, 44, 44, 44, 0, 0, 0, 0, 44,
+ 44, 44, 44, 44, 44, 0, 0, 44, 150, 0,
+ 0, 0, 152, 153, 154, 155, 44, 173, 44, 44,
+ 173, 173, 173, 0, 173, 157, 173, 173, 157, 173,
+ 162, 163, 0, 0, 164, 0, 0, 165, 166, 167,
+ 0, 0, 157, 157, 0, 0, 0, 157, 173, 0,
+ 0, 4, 5, 6, 0, 7, 8, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 143, 144, 145, 146,
+ 0, 0, 0, 147, 0, 157, 0, 157, 174, 0,
+ 0, 174, 174, 174, 0, 174, 114, 174, 174, 114,
+ 174, 148, 149, 151, 0, 0, 0, 0, 0, 152,
+ 153, 154, 155, 114, 114, 0, 0, 157, 114, 174,
+ 173, 154, 156, 158, 159, 160, 161, 162, 163, 0,
+ 0, 164, 0, 0, 165, 166, 167, 0, 163, 0,
+ 0, 164, 0, 0, 165, 166, 167, 52, 114, 0,
+ 62, 64, 50, 0, 57, 0, 65, 60, 0, 59,
+ 0, 0, 0, 0, 0, 0, 0, 150, 150, 150,
+ 150, 0, 0, 58, 150, 0, 150, 0, 63, 0,
+ 0, 174, 150, 150, 150, 150, 329, 330, 331, 0,
+ 333, 0, 150, 150, 0, 150, 150, 150, 150, 150,
+ 150, 150, 0, 0, 150, 61, 0, 150, 150, 150,
+ 0, 0, 67, 0, 0, 67, 0, 349, 0, 0,
+ 0, 0, 0, 0, 351, 0, 0, 0, 353, 0,
+ 67, 0, 0, 168, 0, 0, 0, 23, 0, 0,
+ 53, 361, 362, 0, 0, 0, 0, 0, 0, 0,
+ 0, 173, 173, 173, 173, 173, 0, 173, 173, 173,
+ 0, 0, 0, 173, 67, 150, 157, 157, 157, 157,
+ 0, 0, 0, 157, 173, 157, 173, 173, 173, 173,
+ 173, 157, 157, 157, 157, 173, 173, 173, 173, 173,
+ 173, 157, 157, 173, 157, 157, 157, 157, 157, 157,
+ 157, 0, 173, 157, 173, 173, 157, 157, 157, 0,
+ 0, 0, 174, 174, 174, 174, 174, 0, 174, 174,
+ 174, 0, 0, 0, 174, 0, 0, 114, 114, 114,
+ 114, 0, 0, 0, 114, 174, 114, 174, 174, 174,
+ 174, 174, 114, 114, 114, 114, 174, 174, 174, 174,
+ 174, 174, 114, 114, 174, 114, 114, 114, 114, 114,
+ 114, 114, 0, 174, 114, 174, 174, 114, 114, 114,
+ 22, 24, 25, 26, 27, 28, 0, 29, 30, 31,
+ 0, 0, 0, 32, 0, 168, 33, 34, 35, 36,
+ 0, 0, 0, 37, 38, 0, 39, 40, 41, 42,
+ 43, 0, 0, 0, 0, 44, 45, 46, 47, 48,
+ 49, 44, 0, 51, 44, 44, 44, 150, 44, 0,
+ 44, 44, 54, 44, 55, 56, 0, 0, 67, 152,
+ 0, 154, 155, 0, 0, 0, 0, 44, 0, 0,
+ 0, 0, 44, 67, 67, 67, 67, 162, 163, 0,
+ 67, 164, 0, 0, 165, 166, 167, 108, 0, 0,
+ 117, 0, 0, 0, 0, 0, 0, 52, 67, 44,
+ 62, 64, 50, 0, 57, 0, 65, 60, 0, 59,
+ 0, 0, 92, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 177, 0, 63, 114,
+ 115, 44, 0, 0, 44, 0, 123, 0, 0, 0,
+ 185, 0, 0, 0, 0, 0, 0, 0, 136, 137,
+ 138, 139, 0, 52, 0, 61, 62, 64, 50, 0,
+ 57, 0, 65, 60, 0, 59, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 114, 115, 0, 63, 0, 0, 43, 123, 0,
- 43, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 136, 137, 138, 139, 0, 0, 0, 0, 0, 52,
- 0, 61, 62, 64, 50, 0, 57, 0, 65, 60,
- 0, 59, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 63, 0, 209, 23, 0, 0,
+ 53, 0, 0, 199, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 63, 0, 0, 23, 0, 198, 53, 0, 0, 0,
+ 0, 61, 0, 154, 155, 0, 52, 0, 0, 62,
+ 64, 50, 0, 57, 249, 65, 60, 0, 59, 162,
+ 163, 257, 0, 164, 0, 0, 165, 166, 167, 0,
+ 0, 0, 0, 23, 0, 0, 53, 63, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 61, 0, 153,
- 154, 0, 52, 0, 0, 62, 64, 50, 0, 57,
- 0, 65, 60, 0, 59, 161, 162, 153, 0, 163,
- 0, 0, 164, 165, 166, 0, 112, 0, 0, 23,
- 0, 112, 53, 63, 162, 0, 0, 163, 0, 0,
- 164, 165, 166, 0, 0, 0, 0, 0, 0, 0,
- 43, 43, 43, 43, 43, 43, 0, 43, 43, 43,
- 61, 0, 0, 43, 0, 0, 43, 43, 43, 43,
- 0, 0, 0, 43, 43, 0, 43, 43, 43, 43,
- 43, 0, 0, 0, 0, 43, 43, 43, 43, 43,
- 43, 167, 23, 43, 0, 53, 0, 0, 0, 0,
- 0, 0, 43, 252, 43, 43, 253, 110, 25, 26,
- 27, 28, 88, 29, 30, 31, 0, 0, 0, 32,
- 0, 0, 0, 149, 0, 156, 0, 0, 0, 0,
+ 0, 0, 0, 0, 44, 44, 44, 44, 44, 44,
+ 0, 44, 44, 44, 61, 0, 0, 44, 0, 0,
+ 44, 44, 44, 44, 0, 0, 0, 44, 44, 0,
+ 44, 44, 44, 44, 44, 0, 0, 0, 0, 44,
+ 44, 44, 44, 44, 44, 0, 23, 44, 0, 53,
+ 0, 168, 0, 0, 0, 326, 44, 0, 44, 44,
+ 0, 110, 25, 26, 27, 28, 88, 29, 30, 31,
+ 0, 0, 0, 32, 0, 0, 0, 157, 0, 0,
+ 0, 0, 0, 150, 38, 0, 39, 40, 41, 42,
+ 43, 0, 0, 0, 0, 44, 45, 46, 47, 48,
+ 49, 0, 0, 51, 0, 168, 0, 0, 0, 0,
+ 0, 0, 54, 0, 55, 56, 0, 24, 25, 26,
+ 27, 28, 0, 29, 30, 31, 0, 0, 0, 32,
+ 286, 0, 0, 0, 0, 157, 0, 150, 0, 0,
38, 0, 39, 40, 41, 42, 43, 0, 0, 0,
0, 44, 45, 46, 47, 48, 49, 0, 0, 51,
- 0, 0, 0, 167, 0, 0, 0, 324, 54, 0,
- 55, 56, 0, 24, 25, 26, 27, 28, 0, 29,
- 30, 31, 0, 0, 0, 32, 0, 0, 0, 156,
- 0, 0, 0, 0, 0, 149, 38, 0, 39, 40,
- 41, 42, 43, 0, 0, 0, 0, 44, 45, 46,
- 47, 48, 49, 0, 0, 51, 0, 167, 0, 0,
- 0, 0, 0, 0, 54, 0, 55, 56, 0, 0,
- 0, 0, 0, 0, 0, 0, 116, 25, 26, 27,
- 28, 0, 29, 30, 31, 0, 0, 0, 32, 149,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 38,
- 0, 39, 40, 41, 42, 43, 0, 0, 0, 167,
- 44, 45, 46, 47, 48, 49, 52, 0, 51, 62,
- 64, 50, 0, 57, 0, 65, 60, 54, 59, 55,
- 56, 0, 0, 0, 0, 0, 0, 151, 152, 153,
- 154, 149, 120, 0, 0, 0, 0, 63, 0, 0,
- 0, 157, 158, 159, 160, 161, 162, 0, 0, 163,
- 0, 0, 164, 165, 166, 0, 0, 0, 0, 0,
+ 0, 0, 0, 168, 0, 0, 0, 0, 54, 0,
+ 55, 56, 0, 0, 0, 0, 88, 0, 0, 88,
+ 116, 25, 26, 27, 28, 0, 29, 30, 31, 0,
+ 0, 0, 32, 88, 88, 150, 0, 0, 88, 0,
+ 0, 0, 0, 38, 0, 39, 40, 41, 42, 43,
+ 0, 0, 0, 0, 44, 45, 46, 47, 48, 49,
+ 52, 0, 51, 62, 64, 50, 0, 57, 88, 65,
+ 60, 54, 59, 55, 56, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 120, 152, 153, 154,
+ 155, 63, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 158, 159, 160, 161, 162, 163, 0, 0, 164,
+ 0, 0, 165, 166, 167, 0, 52, 0, 61, 62,
+ 64, 50, 0, 57, 130, 65, 60, 0, 59, 0,
+ 0, 0, 0, 0, 0, 151, 0, 0, 0, 0,
+ 0, 152, 153, 154, 155, 0, 0, 63, 0, 0,
+ 0, 0, 0, 53, 156, 158, 159, 160, 161, 162,
+ 163, 0, 0, 164, 0, 0, 165, 166, 167, 0,
0, 0, 52, 0, 61, 62, 64, 50, 0, 57,
- 130, 65, 60, 0, 59, 0, 0, 0, 0, 0,
- 0, 0, 0, 150, 0, 0, 0, 0, 0, 151,
- 152, 153, 154, 63, 0, 0, 0, 0, 0, 53,
- 0, 0, 155, 157, 158, 159, 160, 161, 162, 0,
- 0, 163, 0, 0, 164, 165, 166, 0, 52, 0,
- 61, 62, 64, 50, 0, 57, 0, 65, 60, 0,
- 59, 0, 0, 0, 0, 0, 0, 150, 0, 0,
- 0, 0, 0, 151, 152, 153, 154, 0, 0, 63,
- 0, 0, 0, 0, 0, 53, 155, 157, 158, 159,
- 160, 161, 162, 0, 0, 163, 0, 0, 164, 165,
- 166, 0, 0, 0, 0, 0, 61, 52, 134, 0,
- 62, 64, 50, 0, 57, 194, 65, 60, 0, 59,
- 0, 0, 0, 0, 0, 151, 152, 153, 154, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 63, 0,
- 0, 53, 160, 161, 162, 0, 0, 163, 0, 0,
- 164, 165, 166, 0, 0, 0, 87, 0, 0, 87,
- 24, 25, 26, 27, 28, 61, 29, 30, 31, 0,
- 0, 0, 32, 87, 87, 0, 0, 0, 87, 0,
+ 0, 65, 60, 0, 59, 0, 0, 0, 0, 0,
+ 0, 0, 0, 151, 0, 0, 0, 0, 0, 152,
+ 153, 154, 155, 63, 0, 0, 0, 0, 0, 53,
+ 0, 0, 156, 158, 159, 160, 161, 162, 163, 0,
+ 0, 164, 0, 0, 165, 166, 167, 0, 0, 0,
+ 61, 52, 134, 0, 62, 64, 50, 0, 57, 195,
+ 65, 60, 0, 59, 0, 0, 0, 88, 88, 88,
+ 88, 0, 0, 0, 88, 0, 88, 0, 0, 0,
+ 0, 0, 63, 88, 0, 53, 0, 0, 0, 0,
+ 0, 0, 88, 88, 0, 88, 88, 88, 88, 88,
+ 89, 0, 0, 89, 24, 25, 26, 27, 28, 61,
+ 29, 30, 31, 0, 0, 0, 32, 89, 89, 0,
+ 0, 0, 89, 0, 0, 0, 0, 38, 0, 39,
+ 40, 41, 42, 43, 0, 0, 0, 0, 44, 45,
+ 46, 47, 48, 49, 53, 0, 51, 0, 0, 0,
+ 0, 0, 89, 0, 0, 54, 90, 55, 56, 90,
+ 24, 25, 26, 27, 28, 0, 29, 30, 31, 0,
+ 0, 0, 32, 90, 90, 0, 0, 0, 90, 0,
0, 0, 0, 38, 0, 39, 40, 41, 42, 43,
0, 0, 0, 0, 44, 45, 46, 47, 48, 49,
- 53, 0, 51, 0, 0, 0, 0, 0, 87, 0,
- 0, 54, 88, 55, 56, 88, 24, 25, 26, 27,
- 28, 0, 29, 30, 31, 0, 0, 0, 32, 88,
- 88, 0, 0, 0, 88, 0, 0, 0, 0, 38,
+ 0, 0, 51, 0, 0, 0, 0, 0, 90, 0,
+ 0, 54, 0, 55, 56, 0, 24, 25, 26, 27,
+ 28, 0, 29, 30, 31, 0, 52, 0, 32, 62,
+ 64, 50, 0, 57, 245, 65, 60, 0, 59, 38,
0, 39, 40, 41, 42, 43, 0, 0, 0, 0,
- 44, 45, 46, 47, 48, 49, 0, 0, 51, 0,
- 0, 0, 0, 0, 88, 0, 0, 54, 0, 55,
- 56, 0, 24, 25, 26, 27, 28, 0, 29, 30,
- 31, 0, 52, 0, 32, 62, 64, 50, 0, 57,
- 243, 65, 60, 0, 59, 38, 0, 39, 40, 41,
- 42, 43, 0, 0, 0, 0, 44, 45, 46, 47,
- 48, 49, 0, 63, 51, 0, 0, 0, 0, 0,
- 0, 0, 0, 54, 0, 55, 56, 0, 0, 0,
- 0, 24, 25, 26, 27, 28, 0, 29, 30, 31,
- 61, 52, 0, 32, 62, 64, 50, 0, 57, 0,
- 65, 60, 0, 59, 38, 0, 39, 40, 41, 42,
- 43, 0, 0, 0, 0, 44, 45, 46, 47, 48,
- 49, 0, 63, 51, 0, 53, 0, 0, 0, 0,
- 0, 0, 54, 0, 55, 56, 0, 87, 87, 87,
- 87, 0, 0, 0, 0, 0, 87, 52, 0, 61,
- 62, 64, 50, 87, 57, 276, 65, 60, 0, 59,
- 0, 0, 87, 87, 0, 87, 87, 87, 87, 87,
- 0, 0, 0, 0, 0, 0, 0, 0, 63, 0,
- 0, 0, 0, 0, 53, 0, 0, 0, 0, 0,
- 0, 0, 0, 88, 88, 88, 88, 0, 0, 0,
- 0, 0, 88, 52, 0, 61, 62, 64, 50, 0,
- 57, 278, 65, 60, 0, 59, 0, 0, 88, 88,
- 0, 88, 88, 88, 88, 88, 0, 0, 0, 0,
- 0, 0, 0, 0, 63, 0, 0, 0, 0, 0,
- 53, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 24, 25, 26, 27,
- 28, 61, 29, 30, 31, 0, 52, 0, 32, 62,
- 64, 50, 0, 57, 286, 65, 60, 0, 59, 38,
- 0, 39, 40, 41, 42, 43, 0, 0, 0, 0,
- 44, 45, 46, 47, 48, 49, 53, 63, 51, 0,
+ 44, 45, 46, 47, 48, 49, 0, 63, 51, 0,
0, 0, 0, 0, 0, 0, 0, 54, 0, 55,
- 56, 0, 0, 0, 22, 24, 25, 26, 27, 28,
- 0, 29, 30, 31, 61, 0, 0, 32, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 38, 0,
+ 56, 0, 0, 0, 0, 24, 25, 26, 27, 28,
+ 0, 29, 30, 31, 61, 52, 0, 32, 62, 64,
+ 50, 0, 57, 0, 65, 60, 0, 59, 38, 0,
39, 40, 41, 42, 43, 0, 0, 0, 0, 44,
- 45, 46, 47, 48, 49, 0, 0, 51, 0, 53,
- 167, 0, 0, 0, 115, 0, 54, 115, 55, 56,
- 0, 24, 25, 26, 27, 28, 0, 29, 30, 31,
- 0, 115, 115, 32, 0, 0, 115, 0, 0, 0,
- 0, 0, 149, 0, 38, 0, 39, 40, 41, 42,
- 43, 0, 0, 0, 0, 44, 45, 46, 47, 48,
- 49, 0, 0, 51, 115, 0, 115, 0, 0, 0,
- 0, 0, 54, 0, 55, 56, 0, 24, 25, 26,
- 27, 28, 0, 29, 30, 31, 0, 52, 0, 32,
- 62, 64, 50, 0, 57, 0, 65, 60, 0, 59,
- 38, 0, 39, 40, 41, 42, 43, 0, 0, 0,
- 0, 44, 45, 46, 47, 48, 49, 0, 63, 51,
- 0, 0, 0, 0, 0, 0, 0, 0, 54, 0,
- 55, 56, 0, 0, 0, 0, 142, 0, 0, 142,
+ 45, 46, 47, 48, 49, 0, 63, 51, 0, 53,
+ 0, 0, 0, 0, 0, 0, 54, 0, 55, 56,
+ 0, 89, 89, 89, 89, 0, 0, 0, 89, 0,
+ 89, 52, 0, 61, 62, 64, 50, 0, 57, 278,
+ 65, 60, 0, 59, 0, 0, 89, 89, 0, 89,
+ 89, 89, 89, 89, 0, 0, 0, 0, 0, 0,
+ 0, 0, 63, 0, 0, 0, 0, 0, 53, 0,
+ 0, 0, 0, 0, 0, 0, 0, 90, 90, 90,
+ 90, 0, 0, 0, 90, 0, 90, 52, 0, 61,
+ 62, 64, 50, 0, 57, 280, 65, 60, 0, 59,
+ 0, 0, 90, 90, 0, 90, 90, 90, 90, 90,
+ 0, 0, 0, 0, 0, 0, 0, 0, 63, 0,
+ 0, 0, 0, 0, 53, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
24, 25, 26, 27, 28, 61, 29, 30, 31, 0,
- 0, 0, 32, 142, 142, 0, 0, 0, 142, 0,
- 0, 0, 0, 38, 0, 39, 40, 41, 42, 43,
+ 52, 0, 32, 62, 64, 50, 0, 57, 288, 65,
+ 60, 0, 59, 38, 0, 39, 40, 41, 42, 43,
0, 0, 0, 0, 44, 45, 46, 47, 48, 49,
- 53, 0, 51, 158, 0, 0, 158, 0, 142, 0,
- 0, 54, 0, 55, 56, 0, 0, 0, 0, 0,
- 158, 158, 0, 0, 0, 158, 151, 152, 153, 154,
- 0, 0, 0, 0, 0, 0, 0, 0, 142, 0,
- 0, 158, 159, 160, 161, 162, 0, 0, 163, 0,
- 0, 164, 165, 166, 0, 158, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 115, 115, 115, 115, 0,
- 159, 0, 0, 0, 115, 0, 0, 0, 0, 0,
- 115, 115, 115, 115, 0, 158, 0, 159, 159, 0,
- 115, 115, 159, 115, 115, 115, 115, 115, 115, 115,
- 0, 0, 115, 0, 0, 115, 115, 115, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 159, 0, 159, 0, 144, 0, 0, 0, 0, 0,
+ 53, 63, 51, 0, 0, 0, 0, 0, 0, 0,
+ 0, 54, 0, 55, 56, 0, 0, 0, 22, 24,
+ 25, 26, 27, 28, 0, 29, 30, 31, 61, 0,
+ 0, 32, 95, 0, 0, 95, 0, 0, 0, 0,
+ 0, 0, 38, 0, 39, 40, 41, 42, 43, 95,
+ 95, 0, 0, 44, 45, 46, 47, 48, 49, 0,
+ 0, 51, 0, 53, 0, 0, 0, 0, 0, 0,
+ 54, 0, 55, 56, 0, 24, 25, 26, 27, 28,
+ 0, 29, 30, 31, 95, 0, 0, 32, 71, 0,
+ 0, 71, 0, 0, 0, 0, 0, 0, 38, 0,
+ 39, 40, 41, 42, 43, 71, 71, 0, 0, 44,
+ 45, 46, 47, 48, 49, 0, 0, 51, 0, 0,
+ 0, 0, 0, 0, 0, 0, 54, 0, 55, 56,
0, 24, 25, 26, 27, 28, 0, 29, 30, 31,
- 0, 144, 144, 32, 0, 0, 144, 0, 0, 0,
- 0, 0, 159, 0, 38, 0, 39, 40, 41, 42,
+ 71, 52, 0, 32, 62, 64, 50, 0, 57, 0,
+ 65, 60, 0, 59, 38, 0, 39, 40, 41, 42,
43, 0, 0, 0, 0, 44, 45, 46, 47, 48,
- 49, 0, 0, 51, 144, 0, 144, 0, 0, 0,
- 94, 0, 54, 94, 55, 56, 0, 142, 142, 142,
- 142, 0, 0, 0, 0, 0, 142, 94, 94, 0,
- 0, 0, 142, 142, 142, 142, 144, 0, 0, 0,
- 0, 0, 142, 142, 0, 142, 142, 142, 142, 142,
- 142, 142, 0, 0, 142, 0, 0, 142, 142, 142,
- 0, 0, 94, 0, 158, 158, 158, 158, 0, 107,
- 0, 0, 107, 158, 0, 0, 0, 0, 0, 158,
- 158, 158, 158, 0, 0, 0, 107, 107, 0, 158,
- 158, 107, 158, 158, 158, 158, 158, 158, 158, 90,
- 90, 158, 0, 0, 158, 158, 158, 0, 0, 0,
- 0, 103, 0, 0, 0, 0, 0, 111, 90, 119,
- 0, 107, 0, 0, 90, 0, 0, 0, 0, 0,
- 0, 159, 159, 159, 159, 0, 90, 90, 90, 90,
- 159, 0, 0, 0, 0, 0, 159, 159, 159, 159,
- 0, 107, 68, 0, 0, 68, 159, 159, 0, 159,
- 159, 159, 159, 159, 159, 159, 0, 0, 159, 68,
- 68, 159, 159, 159, 68, 0, 0, 0, 0, 0,
- 0, 111, 0, 0, 0, 144, 144, 144, 144, 0,
- 0, 0, 0, 0, 144, 0, 0, 0, 0, 0,
- 144, 144, 144, 144, 68, 0, 71, 0, 0, 0,
- 144, 144, 0, 144, 144, 144, 144, 144, 144, 144,
- 0, 0, 144, 71, 71, 144, 144, 144, 71, 0,
- 0, 0, 0, 0, 68, 0, 0, 0, 0, 0,
- 235, 94, 94, 94, 94, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 106, 0, 71, 106, 71, 0,
- 0, 0, 0, 0, 264, 0, 94, 94, 0, 94,
- 0, 106, 106, 0, 0, 0, 106, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 71, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 107, 107, 107, 107, 0, 145, 106, 0, 145, 107,
- 0, 0, 0, 0, 0, 107, 107, 107, 107, 0,
- 0, 0, 145, 145, 0, 107, 107, 145, 107, 107,
- 107, 107, 107, 107, 107, 0, 106, 107, 0, 0,
- 107, 107, 107, 0, 0, 0, 0, 0, 0, 0,
- 158, 0, 0, 158, 0, 0, 0, 145, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 158, 158, 0,
- 0, 0, 158, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 68, 68, 68, 68, 0, 0, 0,
- 0, 0, 68, 0, 0, 0, 0, 0, 68, 68,
- 68, 68, 158, 0, 113, 0, 0, 113, 68, 68,
- 0, 68, 68, 68, 68, 68, 68, 68, 0, 0,
- 68, 113, 113, 68, 68, 68, 113, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 71, 71, 71,
- 71, 0, 0, 0, 0, 0, 71, 0, 0, 0,
- 0, 0, 71, 71, 71, 71, 113, 0, 0, 0,
- 0, 0, 71, 71, 0, 71, 71, 71, 71, 71,
- 71, 71, 0, 0, 71, 0, 0, 71, 71, 71,
- 0, 0, 0, 0, 0, 106, 106, 106, 106, 0,
- 120, 0, 0, 120, 106, 0, 0, 0, 0, 0,
- 106, 106, 106, 106, 0, 0, 0, 120, 120, 0,
- 106, 106, 120, 106, 106, 106, 106, 106, 106, 106,
- 0, 0, 106, 0, 0, 106, 106, 106, 0, 0,
- 0, 0, 0, 0, 0, 0, 145, 145, 145, 145,
- 0, 103, 120, 0, 103, 145, 0, 0, 0, 0,
- 0, 145, 145, 145, 145, 0, 0, 0, 103, 103,
- 0, 145, 145, 103, 145, 145, 145, 145, 145, 145,
- 145, 0, 0, 145, 0, 0, 145, 145, 145, 0,
- 0, 158, 158, 158, 158, 0, 0, 0, 0, 0,
- 158, 0, 0, 103, 0, 0, 158, 158, 158, 158,
- 0, 0, 104, 0, 0, 104, 158, 158, 0, 158,
- 158, 158, 158, 158, 158, 158, 0, 0, 158, 104,
- 104, 158, 158, 158, 104, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 113, 113, 113, 113, 0,
- 98, 0, 0, 98, 113, 0, 0, 0, 0, 0,
- 113, 113, 113, 113, 104, 0, 0, 98, 98, 0,
- 113, 113, 98, 113, 113, 113, 113, 113, 113, 113,
- 0, 0, 113, 0, 0, 113, 113, 113, 0, 99,
- 0, 0, 99, 0, 0, 0, 0, 0, 0, 0,
- 89, 0, 98, 89, 0, 0, 99, 99, 0, 0,
- 0, 99, 0, 0, 0, 0, 0, 89, 89, 0,
- 0, 0, 89, 0, 0, 0, 0, 0, 0, 0,
- 0, 120, 120, 120, 120, 0, 100, 0, 0, 100,
- 120, 99, 0, 0, 0, 0, 120, 120, 120, 120,
- 0, 0, 89, 100, 100, 0, 120, 120, 100, 120,
- 120, 120, 120, 120, 120, 120, 0, 0, 120, 0,
- 0, 120, 120, 120, 0, 0, 0, 0, 0, 0,
- 0, 0, 103, 103, 103, 103, 0, 96, 100, 0,
- 96, 103, 0, 0, 0, 0, 0, 103, 103, 103,
- 103, 0, 0, 0, 96, 96, 0, 103, 103, 96,
- 103, 103, 103, 103, 103, 103, 103, 0, 0, 103,
+ 49, 0, 63, 51, 0, 0, 0, 0, 0, 0,
+ 0, 0, 54, 0, 55, 56, 0, 0, 0, 0,
+ 131, 0, 0, 131, 24, 25, 26, 27, 28, 61,
+ 29, 30, 31, 0, 0, 0, 32, 131, 131, 0,
+ 0, 0, 131, 0, 0, 0, 0, 38, 0, 39,
+ 40, 41, 42, 43, 0, 0, 0, 0, 44, 45,
+ 46, 47, 48, 49, 53, 157, 51, 0, 157, 0,
+ 131, 0, 131, 0, 0, 54, 0, 55, 56, 0,
+ 0, 0, 157, 157, 0, 0, 0, 157, 0, 0,
+ 0, 0, 0, 95, 95, 95, 95, 0, 0, 0,
+ 95, 0, 131, 0, 0, 0, 0, 0, 143, 0,
+ 0, 143, 0, 0, 0, 157, 0, 157, 95, 95,
+ 0, 95, 0, 0, 0, 143, 143, 0, 0, 0,
+ 143, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 157, 0, 71,
+ 71, 71, 71, 0, 116, 0, 71, 116, 0, 0,
+ 143, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 116, 116, 0, 71, 71, 116, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 97, 0, 0, 97, 0, 0, 96,
- 0, 0, 0, 104, 104, 104, 104, 0, 0, 0,
- 97, 97, 104, 0, 0, 97, 0, 0, 104, 104,
- 104, 104, 0, 0, 0, 0, 0, 0, 104, 104,
- 0, 104, 104, 104, 104, 104, 104, 104, 0, 0,
- 104, 98, 98, 98, 98, 97, 0, 0, 0, 0,
- 98, 0, 0, 0, 0, 0, 98, 98, 98, 98,
- 0, 0, 0, 0, 0, 0, 98, 98, 0, 98,
- 98, 98, 98, 98, 98, 98, 0, 0, 0, 0,
- 99, 99, 99, 99, 0, 95, 0, 0, 95, 99,
- 0, 89, 89, 89, 89, 99, 99, 99, 99, 0,
- 89, 0, 95, 95, 0, 99, 99, 95, 99, 99,
- 99, 99, 99, 99, 99, 0, 89, 89, 0, 89,
- 89, 89, 89, 89, 0, 0, 0, 100, 100, 100,
- 100, 0, 83, 0, 0, 83, 100, 95, 0, 0,
- 0, 0, 100, 100, 100, 100, 0, 0, 0, 83,
- 83, 0, 100, 100, 83, 100, 100, 100, 100, 100,
- 100, 100, 0, 0, 0, 0, 0, 0, 84, 0,
- 0, 84, 0, 0, 0, 0, 0, 0, 96, 96,
- 96, 96, 0, 0, 83, 84, 84, 96, 0, 0,
- 84, 0, 0, 96, 96, 96, 96, 0, 0, 0,
- 0, 0, 0, 96, 96, 0, 96, 96, 96, 96,
- 96, 96, 96, 85, 0, 0, 85, 0, 0, 0,
- 84, 0, 0, 0, 97, 97, 97, 97, 0, 0,
- 85, 85, 0, 97, 0, 85, 0, 0, 0, 97,
- 97, 97, 97, 0, 0, 0, 0, 0, 0, 97,
- 97, 0, 97, 97, 97, 97, 97, 97, 97, 86,
- 0, 0, 86, 0, 0, 85, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 86, 86, 0, 0,
- 0, 86, 0, 0, 0, 0, 0, 0, 0, 0,
+ 143, 0, 0, 0, 0, 24, 25, 26, 27, 28,
+ 0, 29, 30, 31, 116, 0, 116, 32, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 38, 0,
+ 39, 40, 41, 42, 43, 0, 0, 0, 0, 44,
+ 45, 46, 47, 48, 49, 0, 0, 51, 0, 168,
+ 0, 0, 0, 0, 0, 0, 54, 0, 55, 56,
+ 0, 131, 131, 131, 131, 0, 0, 0, 131, 0,
+ 131, 0, 0, 0, 0, 0, 131, 131, 131, 131,
+ 0, 150, 0, 0, 0, 0, 131, 131, 0, 131,
+ 131, 131, 131, 131, 131, 131, 0, 0, 131, 0,
+ 0, 131, 131, 131, 0, 0, 157, 157, 157, 157,
+ 0, 159, 0, 157, 159, 157, 0, 0, 0, 0,
+ 0, 157, 157, 157, 157, 0, 0, 0, 159, 159,
+ 0, 157, 157, 159, 157, 157, 157, 157, 157, 157,
+ 157, 0, 0, 157, 0, 0, 157, 157, 157, 143,
+ 143, 143, 143, 0, 0, 0, 143, 0, 143, 0,
+ 0, 0, 0, 159, 143, 143, 143, 143, 0, 0,
+ 0, 0, 0, 0, 143, 143, 0, 143, 143, 143,
+ 143, 143, 143, 143, 0, 0, 143, 0, 0, 143,
+ 143, 143, 0, 159, 0, 116, 116, 116, 116, 168,
+ 160, 0, 116, 0, 116, 0, 0, 0, 0, 0,
+ 116, 116, 116, 116, 0, 0, 0, 160, 160, 0,
+ 116, 116, 160, 116, 116, 116, 116, 116, 116, 116,
+ 0, 150, 116, 0, 0, 116, 116, 116, 0, 0,
+ 0, 0, 0, 145, 0, 152, 153, 154, 155, 0,
+ 160, 0, 160, 0, 0, 0, 0, 0, 0, 0,
+ 145, 145, 161, 162, 163, 145, 0, 164, 0, 0,
+ 165, 166, 167, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 160, 0, 0, 0, 0, 108, 0, 0,
+ 108, 0, 0, 145, 0, 145, 0, 0, 0, 0,
+ 0, 0, 0, 0, 108, 108, 0, 0, 0, 108,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 148, 0, 0, 148, 0, 0,
- 0, 86, 0, 0, 0, 0, 95, 95, 95, 95,
- 0, 148, 148, 0, 0, 95, 148, 0, 0, 0,
- 0, 95, 95, 95, 95, 0, 0, 0, 0, 0,
- 0, 95, 95, 0, 95, 95, 95, 95, 95, 95,
- 95, 147, 0, 0, 147, 0, 148, 0, 0, 0,
- 0, 0, 0, 83, 83, 83, 83, 0, 147, 147,
- 0, 0, 83, 147, 0, 0, 0, 0, 83, 83,
- 83, 83, 0, 0, 0, 0, 0, 134, 83, 83,
- 134, 83, 83, 83, 83, 83, 83, 83, 0, 84,
- 84, 84, 84, 147, 134, 134, 0, 0, 84, 134,
- 0, 0, 0, 0, 84, 84, 84, 84, 0, 0,
- 0, 0, 0, 0, 84, 84, 0, 84, 84, 84,
- 84, 84, 84, 105, 0, 0, 105, 0, 0, 134,
- 0, 0, 0, 0, 85, 85, 85, 85, 0, 0,
- 105, 105, 0, 85, 0, 105, 0, 0, 0, 85,
- 85, 0, 85, 0, 0, 0, 0, 0, 0, 85,
- 85, 0, 85, 85, 85, 85, 85, 85, 90, 0,
- 0, 90, 0, 0, 0, 105, 0, 0, 0, 0,
- 86, 86, 86, 86, 0, 90, 90, 0, 0, 86,
- 90, 0, 167, 0, 0, 86, 86, 0, 0, 0,
- 92, 0, 0, 92, 0, 86, 86, 0, 86, 86,
- 86, 86, 86, 86, 0, 0, 0, 92, 92, 0,
- 90, 0, 92, 0, 149, 148, 148, 148, 148, 0,
- 0, 0, 0, 0, 148, 0, 0, 0, 0, 0,
- 148, 148, 91, 0, 0, 91, 0, 0, 0, 0,
- 148, 148, 92, 148, 148, 148, 148, 148, 0, 91,
- 91, 0, 143, 0, 91, 143, 0, 0, 0, 0,
- 0, 0, 147, 147, 147, 147, 0, 0, 0, 143,
- 143, 147, 0, 0, 0, 284, 0, 147, 147, 82,
- 156, 0, 82, 0, 91, 0, 0, 147, 147, 0,
- 147, 147, 147, 147, 147, 0, 82, 82, 134, 134,
- 134, 134, 0, 0, 143, 0, 0, 134, 167, 0,
- 0, 0, 0, 134, 134, 69, 0, 0, 69, 0,
- 0, 0, 0, 134, 134, 0, 134, 134, 134, 134,
- 134, 82, 69, 69, 0, 0, 0, 0, 0, 0,
- 149, 0, 0, 0, 105, 105, 105, 105, 0, 0,
- 0, 0, 0, 105, 0, 0, 0, 0, 0, 105,
- 105, 0, 0, 0, 0, 0, 0, 69, 0, 105,
- 105, 156, 105, 105, 105, 105, 105, 0, 151, 152,
- 153, 154, 0, 0, 0, 0, 0, 0, 0, 90,
- 90, 90, 90, 0, 159, 160, 161, 162, 90, 167,
- 163, 0, 0, 164, 165, 166, 0, 0, 0, 0,
- 0, 0, 0, 0, 90, 90, 0, 90, 90, 90,
- 90, 92, 92, 92, 92, 0, 0, 0, 0, 0,
- 92, 149, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 92, 92, 0, 92,
- 92, 92, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 145, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 108,
+ 0, 0, 159, 159, 159, 159, 0, 0, 0, 159,
+ 0, 159, 0, 0, 0, 0, 0, 159, 159, 159,
+ 159, 0, 0, 69, 0, 0, 69, 159, 159, 108,
+ 159, 159, 159, 159, 159, 159, 159, 0, 0, 159,
+ 69, 69, 159, 159, 159, 69, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 152, 153, 154, 155, 0,
+ 0, 0, 0, 0, 0, 0, 107, 0, 0, 107,
+ 159, 160, 161, 162, 163, 69, 0, 164, 0, 0,
+ 165, 166, 167, 107, 107, 0, 0, 0, 107, 0,
+ 0, 160, 160, 160, 160, 0, 0, 0, 160, 0,
+ 160, 0, 0, 0, 0, 69, 160, 160, 160, 160,
+ 0, 0, 0, 0, 0, 0, 160, 160, 107, 160,
+ 160, 160, 160, 160, 160, 160, 0, 0, 160, 0,
+ 0, 160, 160, 160, 145, 145, 145, 145, 0, 72,
+ 0, 145, 0, 145, 0, 0, 0, 0, 107, 145,
+ 145, 145, 145, 0, 0, 0, 72, 72, 0, 145,
+ 145, 72, 145, 145, 145, 145, 145, 145, 145, 0,
+ 0, 145, 0, 0, 145, 145, 145, 0, 108, 108,
+ 108, 108, 0, 146, 0, 108, 146, 108, 0, 72,
+ 0, 72, 0, 108, 108, 108, 108, 0, 0, 0,
+ 146, 146, 0, 108, 108, 146, 108, 108, 108, 108,
+ 108, 108, 108, 0, 0, 108, 0, 0, 108, 108,
+ 108, 72, 0, 0, 0, 0, 159, 90, 90, 159,
+ 0, 0, 0, 0, 0, 146, 0, 0, 0, 103,
+ 0, 0, 0, 159, 159, 111, 90, 119, 159, 0,
+ 0, 0, 90, 0, 69, 69, 69, 69, 0, 0,
+ 0, 69, 0, 69, 90, 90, 90, 90, 0, 69,
+ 69, 69, 69, 0, 0, 0, 0, 0, 159, 69,
+ 69, 0, 69, 69, 69, 69, 69, 69, 69, 0,
+ 0, 69, 0, 0, 69, 69, 69, 107, 107, 107,
+ 107, 0, 114, 0, 107, 114, 107, 0, 0, 111,
+ 0, 0, 107, 107, 107, 107, 0, 0, 0, 114,
+ 114, 0, 107, 107, 114, 107, 107, 107, 107, 107,
+ 107, 107, 0, 0, 107, 0, 0, 107, 107, 107,
+ 0, 0, 0, 0, 0, 121, 0, 0, 121, 0,
+ 0, 0, 0, 0, 114, 0, 0, 0, 0, 0,
+ 0, 0, 121, 121, 0, 0, 0, 121, 0, 237,
+ 72, 72, 72, 72, 0, 0, 0, 72, 0, 72,
+ 0, 0, 0, 0, 0, 72, 72, 72, 72, 0,
+ 0, 0, 0, 266, 0, 72, 72, 121, 72, 72,
+ 72, 72, 72, 72, 72, 0, 0, 72, 0, 0,
+ 72, 72, 72, 0, 146, 146, 146, 146, 0, 105,
+ 0, 146, 105, 146, 0, 0, 0, 0, 0, 146,
+ 146, 146, 146, 0, 0, 0, 105, 105, 0, 146,
+ 146, 105, 146, 146, 146, 146, 146, 146, 146, 0,
+ 0, 146, 0, 0, 146, 146, 146, 159, 159, 159,
+ 159, 0, 99, 0, 159, 99, 159, 0, 0, 0,
+ 0, 105, 159, 159, 159, 159, 0, 0, 0, 99,
+ 99, 0, 159, 159, 99, 159, 159, 159, 159, 159,
+ 159, 159, 0, 0, 159, 0, 0, 159, 159, 159,
+ 100, 0, 0, 100, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 99, 0, 0, 100, 100, 0,
+ 0, 0, 100, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 114, 114, 114, 114, 0, 101, 0,
+ 114, 101, 114, 0, 0, 0, 0, 0, 114, 114,
+ 114, 114, 100, 0, 0, 101, 101, 0, 114, 114,
+ 101, 114, 114, 114, 114, 114, 114, 114, 0, 0,
+ 114, 0, 0, 114, 114, 114, 121, 121, 121, 121,
+ 0, 97, 0, 121, 97, 121, 0, 0, 0, 0,
+ 101, 121, 121, 121, 121, 0, 0, 0, 97, 97,
+ 0, 121, 121, 97, 121, 121, 121, 121, 121, 121,
+ 121, 0, 0, 121, 0, 0, 121, 121, 121, 98,
+ 0, 0, 98, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 97, 0, 0, 98, 98, 0, 0,
+ 0, 98, 0, 0, 0, 0, 0, 0, 0, 0,
+ 105, 105, 105, 105, 0, 96, 0, 105, 96, 105,
+ 0, 0, 0, 0, 0, 105, 105, 105, 105, 0,
+ 0, 98, 96, 96, 0, 105, 105, 96, 105, 105,
+ 105, 105, 105, 105, 105, 0, 0, 105, 0, 0,
+ 0, 0, 0, 99, 99, 99, 99, 0, 84, 0,
+ 99, 84, 99, 0, 0, 0, 0, 96, 99, 99,
+ 99, 99, 0, 0, 0, 84, 84, 0, 99, 99,
+ 84, 99, 99, 99, 99, 99, 99, 99, 0, 0,
+ 0, 100, 100, 100, 100, 0, 85, 0, 100, 85,
+ 100, 0, 0, 0, 0, 0, 100, 100, 100, 100,
+ 84, 0, 0, 85, 85, 0, 100, 100, 85, 100,
+ 100, 100, 100, 100, 100, 100, 0, 0, 0, 101,
+ 101, 101, 101, 0, 86, 0, 101, 86, 101, 0,
+ 0, 0, 0, 0, 101, 101, 101, 101, 85, 0,
+ 0, 86, 86, 0, 101, 101, 86, 101, 101, 101,
+ 101, 101, 101, 101, 0, 0, 0, 0, 0, 0,
+ 0, 0, 97, 97, 97, 97, 0, 87, 0, 97,
+ 87, 97, 0, 0, 0, 0, 86, 97, 97, 97,
+ 97, 0, 0, 0, 87, 87, 0, 97, 97, 87,
+ 97, 97, 97, 97, 97, 97, 97, 0, 0, 0,
+ 98, 98, 98, 98, 0, 148, 0, 98, 148, 98,
+ 0, 0, 0, 0, 0, 98, 98, 98, 98, 87,
+ 0, 0, 148, 148, 0, 98, 98, 148, 98, 98,
+ 98, 98, 98, 98, 98, 0, 96, 96, 96, 96,
+ 0, 135, 0, 96, 135, 96, 0, 0, 0, 0,
+ 0, 96, 96, 96, 96, 0, 0, 148, 135, 135,
+ 0, 96, 96, 135, 96, 96, 96, 96, 96, 96,
+ 96, 0, 0, 0, 0, 0, 0, 0, 0, 84,
+ 84, 84, 84, 0, 106, 0, 84, 106, 84, 0,
+ 0, 0, 0, 135, 84, 84, 84, 84, 0, 0,
+ 0, 106, 106, 0, 84, 84, 106, 84, 84, 84,
+ 84, 84, 84, 84, 0, 0, 0, 85, 85, 85,
+ 85, 0, 91, 0, 85, 91, 85, 0, 0, 0,
+ 0, 0, 85, 85, 85, 85, 106, 0, 0, 91,
+ 91, 0, 85, 85, 91, 85, 85, 85, 85, 85,
+ 85, 0, 0, 0, 0, 86, 86, 86, 86, 0,
+ 93, 0, 86, 93, 86, 0, 0, 0, 0, 0,
+ 86, 86, 0, 86, 91, 0, 0, 93, 93, 0,
+ 86, 86, 93, 86, 86, 86, 86, 86, 86, 0,
+ 168, 0, 0, 0, 0, 0, 0, 0, 87, 87,
+ 87, 87, 0, 94, 0, 87, 94, 87, 0, 0,
+ 0, 0, 93, 87, 87, 0, 0, 0, 0, 0,
+ 94, 94, 150, 87, 87, 94, 87, 87, 87, 87,
+ 87, 87, 0, 0, 0, 0, 148, 148, 148, 148,
+ 0, 92, 0, 148, 92, 148, 0, 0, 0, 0,
+ 0, 148, 148, 144, 0, 94, 144, 0, 92, 92,
+ 0, 148, 148, 92, 148, 148, 148, 148, 148, 0,
+ 144, 144, 135, 135, 135, 135, 0, 0, 0, 135,
+ 0, 135, 0, 0, 0, 0, 0, 135, 135, 0,
+ 0, 0, 0, 92, 0, 0, 83, 135, 135, 83,
+ 135, 135, 135, 135, 135, 144, 0, 0, 0, 70,
+ 0, 0, 70, 83, 83, 106, 106, 106, 106, 0,
+ 0, 0, 106, 0, 106, 0, 70, 70, 0, 0,
+ 106, 106, 0, 0, 0, 0, 157, 0, 0, 0,
+ 106, 106, 0, 106, 106, 106, 106, 106, 83, 0,
0, 0, 0, 91, 91, 91, 91, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 143, 143, 143, 143, 0, 91, 91,
- 0, 91, 0, 0, 0, 0, 0, 0, 150, 0,
- 0, 0, 0, 0, 151, 152, 153, 154, 143, 143,
- 82, 82, 82, 82, 0, 0, 0, 155, 157, 158,
- 159, 160, 161, 162, 0, 0, 163, 0, 0, 164,
- 165, 166, 0, 0, 0, 82, 82, 0, 0, 0,
- 0, 0, 0, 0, 94, 0, 69, 69, 69, 69,
- 0, 0, 104, 0, 0, 0, 109, 0, 0, 118,
- 0, 0, 0, 0, 0, 0, 125, 126, 127, 128,
- 129, 69, 69, 132, 133, 0, 0, 0, 0, 0,
- 140, 0, 0, 0, 0, 0, 0, 0, 0, 150,
- 0, 0, 0, 0, 0, 151, 152, 153, 154, 0,
- 0, 0, 0, 0, 0, 0, 0, 183, 0, 157,
- 158, 159, 160, 161, 162, 0, 0, 163, 0, 0,
- 164, 165, 166, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 217, 218, 219, 220, 221, 222,
- 223, 224, 225, 226, 227, 228, 229, 230, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 245,
+ 91, 70, 91, 0, 168, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 91, 91,
+ 0, 91, 91, 91, 91, 0, 152, 153, 154, 155,
+ 0, 93, 93, 93, 93, 0, 150, 0, 93, 0,
+ 93, 0, 160, 161, 162, 163, 0, 0, 164, 0,
+ 0, 165, 166, 167, 0, 0, 93, 93, 0, 93,
+ 93, 93, 157, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 94, 94, 94, 94, 0, 0,
+ 0, 94, 0, 94, 0, 0, 0, 0, 0, 0,
+ 168, 0, 0, 0, 0, 0, 0, 0, 0, 94,
+ 94, 0, 94, 94, 0, 0, 0, 0, 0, 0,
+ 0, 0, 92, 92, 92, 92, 0, 0, 0, 92,
+ 0, 0, 150, 0, 144, 144, 144, 144, 0, 0,
+ 0, 144, 0, 0, 0, 0, 94, 92, 92, 0,
+ 92, 0, 0, 0, 104, 0, 0, 0, 109, 144,
+ 144, 118, 0, 0, 0, 0, 0, 0, 125, 126,
+ 127, 128, 129, 0, 0, 132, 133, 83, 83, 83,
+ 83, 0, 140, 0, 83, 0, 0, 0, 0, 0,
+ 70, 70, 70, 70, 0, 0, 0, 70, 0, 0,
+ 0, 0, 83, 83, 151, 0, 0, 0, 0, 184,
+ 152, 153, 154, 155, 0, 70, 70, 0, 0, 0,
+ 0, 0, 0, 156, 158, 159, 160, 161, 162, 163,
+ 0, 0, 164, 0, 0, 165, 166, 167, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 219, 220, 221,
+ 222, 223, 224, 225, 226, 227, 228, 229, 230, 231,
+ 232, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 151, 0, 247, 0, 0, 0, 152, 153, 154, 155,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 158, 159, 160, 161, 162, 163, 0, 0, 164, 0,
+ 0, 165, 166, 167, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 299, 0, 0,
+ 0, 301, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 315,
+ 0, 0, 317,
};
dEXT short yycheck[] = { 13,
- 36, 86, 41, 36, 40, 44, 182, 59, 59, 41,
- 93, 40, 59, 91, 91, 59, 257, 41, 257, 58,
- 59, 41, 191, 41, 63, 59, 44, 91, 91, 59,
- 329, 40, 46, 41, 93, 40, 93, 41, 257, 41,
- 58, 59, 41, 57, 122, 63, 123, 61, 97, 98,
- 99, 100, 101, 102, 93, 59, 41, 59, 41, 123,
- 123, 360, 91, 44, 297, 298, 41, 41, 276, 277,
- 40, 40, 278, 91, 40, 93, 326, 327, 0, 123,
- 59, 331, 59, 36, 59, 59, 59, 40, 59, 123,
- 123, 41, 106, 107, 123, 40, 40, 347, 123, 41,
- 40, 351, 271, 59, 41, 123, 40, 123, 44, 59,
- 260, 33, 257, 289, 36, 37, 38, 59, 40, 40,
- 42, 43, 59, 45, 40, 93, 41, 40, 125, 143,
- 144, 145, 146, 147, 148, 149, 305, 59, 91, 91,
- 257, 36, 64, 192, 41, 266, 267, 268, 41, 270,
- 271, 44, 91, 167, 168, 169, 170, 171, 172, 173,
- 125, 41, 93, 298, 44, 58, 59, 40, 182, 91,
- 123, 249, 186, 187, 41, 189, 254, 191, 58, 59,
- 41, 350, 41, 63, 198, 0, 200, 201, 41, 41,
- 41, 205, 40, 93, 41, 93, 59, 125, 59, 125,
- 93, 123, 125, 125, 126, 125, 257, 41, 125, 59,
- 41, 91, 123, 93, 297, 298, 41, 231, 33, 233,
- 234, 36, 37, 38, 257, 40, 59, 42, 43, 262,
- 45, 40, 93, 272, 273, 274, 275, 314, 297, 298,
- 297, 298, 281, 123, 59, 297, 298, 41, 41, 64,
- 297, 298, 337, 123, 272, 273, 274, 275, 297, 298,
- 296, 300, 301, 281, 0, 297, 298, 123, 282, 287,
- 288, 289, 290, 297, 298, 289, 91, 297, 298, 297,
- 298, 59, 300, 301, 302, 303, 304, 305, 306, 297,
- 298, 309, 41, 307, 312, 313, 314, 33, 297, 298,
- 36, 37, 38, 41, 40, 258, 42, 43, 123, 45,
- 125, 126, 297, 298, 297, 298, 297, 298, 297, 298,
- 297, 298, 41, 59, 297, 298, 297, 298, 64, 297,
- 298, 59, 346, 41, 256, 257, 258, 259, 260, 261,
- 41, 263, 264, 265, 266, 267, 268, 269, 270, 271,
- 272, 273, 274, 275, 59, 91, 8, 279, 280, 32,
- 282, 283, 284, 285, 286, 125, 297, 298, 63, 291,
- 292, 293, 294, 295, 296, 13, 144, 299, 307, 272,
- 273, 274, 275, 346, 189, 96, 308, 123, 310, 311,
- 126, -1, 272, 273, 274, 275, 91, 297, 298, 297,
- 298, 281, -1, -1, 297, 298, 91, 287, 288, 289,
- 290, 272, 273, 274, 275, -1, -1, 297, 298, -1,
- 300, 301, 302, 303, 304, 305, 306, -1, 123, 309,
- 91, -1, 312, 313, 314, -1, 297, 298, 123, -1,
- -1, 256, 257, 258, 259, 260, 261, -1, 263, 264,
- 265, 266, 267, 268, 269, 270, 271, 272, 273, 274,
- 275, -1, 123, -1, 279, 280, -1, 282, 283, 284,
- 285, 286, 272, 273, 274, 275, 291, 292, 293, 294,
- 295, 296, 41, -1, 299, 44, 91, -1, -1, -1,
- -1, -1, -1, 308, -1, 310, 311, 297, 298, 58,
- 59, -1, -1, -1, 63, -1, 266, 267, 268, -1,
- 270, 271, -1, -1, -1, -1, -1, -1, 123, -1,
- 256, 257, 258, 259, 260, 261, 125, 263, 264, 265,
- -1, -1, 91, 269, 93, -1, 272, 273, 274, 275,
+ 41, 36, 86, 41, 91, 40, 44, 59, 91, 59,
+ 59, 93, 36, 183, 59, 59, 41, 91, 41, 331,
+ 58, 59, 91, 40, 257, 63, 41, 297, 298, 257,
+ 41, 59, 46, 40, 43, 41, 123, 276, 277, 257,
+ 123, 41, 51, 57, 41, 91, 41, 61, 59, 123,
+ 362, 44, 40, 59, 123, 93, 328, 329, 0, 40,
+ 192, 333, 41, 40, 40, 36, 40, 40, 40, 40,
+ 59, 278, 59, 123, 91, 123, 122, 349, 123, 40,
+ 59, 353, 91, 123, 97, 98, 99, 100, 101, 102,
+ 59, 33, 106, 107, 36, 37, 38, 59, 40, 123,
+ 42, 43, 260, 45, 44, 114, 123, 59, 41, 41,
+ 41, 257, 40, 122, 40, 125, 40, 59, 41, 41,
+ 91, 291, 64, 91, 41, 41, 59, 59, 59, 143,
+ 144, 145, 146, 147, 148, 149, 150, 59, 257, 36,
+ 91, 273, 59, 93, 91, 41, 298, 125, 44, 91,
+ 40, 40, 123, 0, 168, 169, 170, 171, 172, 173,
+ 174, 41, 58, 59, 41, 41, 41, 63, 93, 183,
+ 41, 41, 123, 187, 188, 307, 190, 91, 192, 125,
+ 193, 123, 93, 125, 126, 199, 33, 201, 202, 36,
+ 37, 38, 206, 40, 59, 42, 43, 93, 45, 266,
+ 267, 268, 59, 270, 271, 251, 289, 290, 257, 123,
+ 256, 41, 59, 125, 123, 297, 298, 64, 125, 233,
+ 352, 235, 236, 306, 125, 93, 309, 314, 41, 312,
+ 313, 314, 125, 257, 272, 273, 274, 275, 262, 41,
+ 41, 279, 251, 281, 91, 297, 298, 256, 0, 287,
+ 288, 289, 290, 297, 298, 339, 297, 298, 59, 297,
+ 298, 296, 300, 301, 302, 303, 304, 305, 306, 59,
+ 284, 309, 297, 298, 297, 298, 123, 291, 125, 126,
+ 40, 33, 297, 298, 36, 37, 38, 258, 40, 93,
+ 42, 43, 93, 45, 93, 309, 41, 297, 298, 41,
+ 297, 298, 297, 298, 297, 298, 123, 59, 297, 298,
+ 297, 298, 64, 125, 256, 257, 258, 259, 260, 261,
+ 123, 263, 264, 265, 266, 267, 268, 269, 270, 271,
+ 272, 273, 274, 275, 348, 297, 298, 279, 280, 91,
+ 282, 283, 284, 285, 286, 297, 298, 297, 298, 291,
+ 292, 293, 294, 295, 296, 306, 91, 299, 309, 41,
+ 41, 312, 313, 314, 59, 41, 308, 59, 310, 311,
+ 41, 123, 297, 298, 126, 59, 272, 273, 274, 275,
+ 41, 8, 32, 279, 13, 281, 297, 298, 123, 144,
+ 348, 287, 288, 41, 309, 309, 44, 190, 312, 313,
+ 314, 297, 298, 96, 300, 301, 302, 303, 304, 256,
+ 257, 258, 259, 260, 261, 63, 263, 264, 265, 266,
+ 267, 268, 269, 270, 271, 272, 273, 274, 275, 297,
+ 298, -1, 279, 280, -1, 282, 283, 284, 285, 286,
+ -1, -1, -1, 91, 291, 292, 293, 294, 295, 296,
+ 125, -1, 299, 91, 266, 267, 268, -1, 270, 271,
+ -1, 308, -1, 310, 311, -1, 41, -1, -1, 44,
+ -1, 272, 273, 274, 275, 123, -1, -1, 279, -1,
+ -1, -1, -1, 58, 59, 123, -1, -1, 63, -1,
+ -1, -1, -1, 297, 298, -1, 297, 298, 297, 298,
+ -1, -1, -1, -1, 256, 257, 258, 259, 260, 261,
+ -1, 263, 264, 265, -1, -1, 91, 269, 93, -1,
+ 272, 273, 274, 275, -1, -1, -1, 279, 280, -1,
+ 282, 283, 284, 285, 286, -1, -1, -1, -1, 291,
+ 292, 293, 294, 295, 296, -1, -1, 299, 123, -1,
+ -1, -1, 287, 288, 289, 290, 308, 33, 310, 311,
+ 36, 37, 38, -1, 40, 41, 42, 43, 44, 45,
+ 305, 306, -1, -1, 309, -1, -1, 312, 313, 314,
+ -1, -1, 58, 59, -1, -1, -1, 63, 64, -1,
+ -1, 266, 267, 268, -1, 270, 271, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, 272, 273, 274, 275,
+ -1, -1, -1, 279, -1, 91, -1, 93, 33, -1,
+ -1, 36, 37, 38, -1, 40, 41, 42, 43, 44,
+ 45, 297, 298, 281, -1, -1, -1, -1, -1, 287,
+ 288, 289, 290, 58, 59, -1, -1, 123, 63, 64,
+ 126, 289, 300, 301, 302, 303, 304, 305, 306, -1,
+ -1, 309, -1, -1, 312, 313, 314, -1, 306, -1,
+ -1, 309, -1, -1, 312, 313, 314, 33, 93, -1,
+ 36, 37, 38, -1, 40, -1, 42, 43, -1, 45,
+ -1, -1, -1, -1, -1, -1, -1, 272, 273, 274,
+ 275, -1, -1, 59, 279, -1, 281, -1, 64, -1,
+ -1, 126, 287, 288, 289, 290, 304, 305, 306, -1,
+ 308, -1, 297, 298, -1, 300, 301, 302, 303, 304,
+ 305, 306, -1, -1, 309, 91, -1, 312, 313, 314,
+ -1, -1, 41, -1, -1, 44, -1, 335, -1, -1,
+ -1, -1, -1, -1, 342, -1, -1, -1, 346, -1,
+ 59, -1, -1, 91, -1, -1, -1, 123, -1, -1,
+ 126, 359, 360, -1, -1, -1, -1, -1, -1, -1,
+ -1, 257, 258, 259, 260, 261, -1, 263, 264, 265,
+ -1, -1, -1, 269, 93, 123, 272, 273, 274, 275,
+ -1, -1, -1, 279, 280, 281, 282, 283, 284, 285,
+ 286, 287, 288, 289, 290, 291, 292, 293, 294, 295,
+ 296, 297, 298, 299, 300, 301, 302, 303, 304, 305,
+ 306, -1, 308, 309, 310, 311, 312, 313, 314, -1,
+ -1, -1, 257, 258, 259, 260, 261, -1, 263, 264,
+ 265, -1, -1, -1, 269, -1, -1, 272, 273, 274,
+ 275, -1, -1, -1, 279, 280, 281, 282, 283, 284,
+ 285, 286, 287, 288, 289, 290, 291, 292, 293, 294,
+ 295, 296, 297, 298, 299, 300, 301, 302, 303, 304,
+ 305, 306, -1, 308, 309, 310, 311, 312, 313, 314,
+ 256, 257, 258, 259, 260, 261, -1, 263, 264, 265,
+ -1, -1, -1, 269, -1, 91, 272, 273, 274, 275,
-1, -1, -1, 279, 280, -1, 282, 283, 284, 285,
286, -1, -1, -1, -1, 291, 292, 293, 294, 295,
- 296, -1, -1, 299, 123, -1, -1, -1, -1, -1,
- 91, -1, 308, 33, 310, 311, 36, 37, 38, -1,
- 40, 41, 42, 43, 44, 45, 281, -1, -1, -1,
- -1, -1, 287, 288, 289, 290, -1, -1, 58, 59,
- -1, -1, 123, 63, 64, 300, 301, 302, 303, 304,
- 305, 306, -1, -1, 309, -1, -1, 312, 313, 314,
- -1, 306, -1, -1, 309, -1, -1, 312, 313, 314,
- -1, 91, -1, 93, 33, -1, -1, 36, 37, 38,
- -1, 40, 41, 42, 43, 44, 45, -1, 309, -1,
- -1, 312, 313, 314, -1, -1, -1, -1, -1, 58,
- 59, -1, -1, 123, 63, 64, 126, 266, 267, 268,
- -1, 270, 271, -1, -1, -1, -1, -1, -1, 302,
- 303, 304, -1, 306, 289, 290, -1, -1, -1, -1,
- -1, 13, -1, 33, 93, -1, 36, 37, 38, -1,
- 40, 306, 42, 43, 309, 45, -1, 312, 313, 314,
- 333, -1, -1, 272, 273, 274, 275, 340, -1, 59,
- 42, 344, 281, 45, 64, -1, -1, 126, 287, 288,
- 289, 290, -1, -1, 357, 358, -1, -1, 297, 298,
- -1, 300, 301, 302, 303, 304, 305, 306, -1, -1,
- 309, 91, -1, 312, 313, 314, -1, -1, 41, 81,
- -1, 44, -1, -1, -1, -1, 287, 288, 289, 290,
- -1, -1, -1, 95, -1, -1, 59, -1, -1, 91,
- -1, -1, -1, 123, 305, 306, 126, -1, 309, -1,
- -1, 312, 313, 314, -1, -1, -1, 257, 258, 259,
- 260, 261, -1, 263, 264, 265, -1, -1, -1, 269,
- 93, 123, 272, 273, 274, 275, -1, -1, -1, 141,
- 280, 281, 282, 283, 284, 285, 286, 287, 288, 289,
- 290, 291, 292, 293, 294, 295, 296, 297, 298, 299,
- 300, 301, 302, 303, 304, 305, 306, -1, 308, 309,
- 310, 311, 312, 313, 314, -1, 178, -1, 257, 258,
- 259, 260, 261, 185, 263, 264, 265, -1, -1, -1,
- 269, -1, -1, 272, 273, 274, 275, -1, -1, -1,
- -1, 280, 281, 282, 283, 284, 285, 286, 287, 288,
- 289, 290, 291, 292, 293, 294, 295, 296, 297, 298,
- 299, 300, 301, 302, 303, 304, 305, 306, -1, 308,
- 309, 310, 311, 312, 313, 314, 256, 257, 258, 259,
- 260, 261, -1, 263, 264, 265, -1, -1, -1, 269,
- -1, 91, 272, 273, 274, 275, -1, -1, -1, 279,
- 280, -1, 282, 283, 284, 285, 286, -1, -1, 91,
- 43, 291, 292, 293, 294, 295, 296, 33, 51, 299,
- 36, 37, 38, 123, 40, -1, 42, 43, 308, 45,
- 310, 311, -1, -1, -1, 287, -1, 289, 290, -1,
- -1, 123, -1, 59, -1, -1, -1, -1, 64, 272,
- 273, 274, 275, 305, 306, -1, -1, 309, 91, -1,
- 312, 313, 314, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, 33, 297, 91, 36, 37, 38, -1,
- 40, 114, 42, 43, 26, 45, -1, -1, -1, 122,
+ 296, 33, -1, 299, 36, 37, 38, 123, 40, -1,
+ 42, 43, 308, 45, 310, 311, -1, -1, 13, 287,
+ -1, 289, 290, -1, -1, -1, -1, 59, -1, -1,
+ -1, -1, 64, 272, 273, 274, 275, 305, 306, -1,
+ 279, 309, -1, -1, 312, 313, 314, 42, -1, -1,
+ 45, -1, -1, -1, -1, -1, -1, 33, 297, 91,
+ 36, 37, 38, -1, 40, -1, 42, 43, -1, 45,
+ -1, -1, 26, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, 81, -1, 64, 43,
+ 44, 123, -1, -1, 126, -1, 50, -1, -1, -1,
+ 95, -1, -1, -1, -1, -1, -1, -1, 62, 63,
+ 64, 65, -1, 33, -1, 91, 36, 37, 38, -1,
+ 40, -1, 42, 43, -1, 45, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, 43, 44, -1, 64, -1, -1, 123, 50, -1,
- 126, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- 62, 63, 64, 65, -1, -1, -1, -1, -1, 33,
- -1, 91, 36, 37, 38, -1, 40, -1, 42, 43,
- -1, 45, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, 64, -1, 141, 123, -1, -1,
+ 126, -1, -1, 107, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- 64, -1, -1, 123, -1, 107, 126, -1, -1, -1,
+ -1, 91, -1, 289, 290, -1, 33, -1, -1, 36,
+ 37, 38, -1, 40, 179, 42, 43, -1, 45, 305,
+ 306, 186, -1, 309, -1, -1, 312, 313, 314, -1,
+ -1, -1, -1, 123, -1, -1, 126, 64, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, 91, -1, 289,
- 290, -1, 33, -1, -1, 36, 37, 38, -1, 40,
- -1, 42, 43, -1, 45, 305, 306, 289, -1, 309,
- -1, -1, 312, 313, 314, -1, 249, -1, -1, 123,
- -1, 254, 126, 64, 306, -1, -1, 309, -1, -1,
- 312, 313, 314, -1, -1, -1, -1, -1, -1, -1,
- 256, 257, 258, 259, 260, 261, -1, 263, 264, 265,
- 91, -1, -1, 269, -1, -1, 272, 273, 274, 275,
- -1, -1, -1, 279, 280, -1, 282, 283, 284, 285,
+ -1, -1, -1, -1, 256, 257, 258, 259, 260, 261,
+ -1, 263, 264, 265, 91, -1, -1, 269, -1, -1,
+ 272, 273, 274, 275, -1, -1, -1, 279, 280, -1,
+ 282, 283, 284, 285, 286, -1, -1, -1, -1, 291,
+ 292, 293, 294, 295, 296, -1, 123, 299, -1, 126,
+ -1, 91, -1, -1, -1, 41, 308, -1, 310, 311,
+ -1, 257, 258, 259, 260, 261, 262, 263, 264, 265,
+ -1, -1, -1, 269, -1, -1, -1, 63, -1, -1,
+ -1, -1, -1, 123, 280, -1, 282, 283, 284, 285,
286, -1, -1, -1, -1, 291, 292, 293, 294, 295,
- 296, 91, 123, 299, -1, 126, -1, -1, -1, -1,
- -1, -1, 308, 41, 310, 311, 44, 257, 258, 259,
- 260, 261, 262, 263, 264, 265, -1, -1, -1, 269,
- -1, -1, -1, 123, -1, 63, -1, -1, -1, -1,
+ 296, -1, -1, 299, -1, 91, -1, -1, -1, -1,
+ -1, -1, 308, -1, 310, 311, -1, 257, 258, 259,
+ 260, 261, -1, 263, 264, 265, -1, -1, -1, 269,
+ 58, -1, -1, -1, -1, 63, -1, 123, -1, -1,
280, -1, 282, 283, 284, 285, 286, -1, -1, -1,
-1, 291, 292, 293, 294, 295, 296, -1, -1, 299,
- -1, -1, -1, 91, -1, -1, -1, 41, 308, -1,
- 310, 311, -1, 257, 258, 259, 260, 261, -1, 263,
- 264, 265, -1, -1, -1, 269, -1, -1, -1, 63,
- -1, -1, -1, -1, -1, 123, 280, -1, 282, 283,
- 284, 285, 286, -1, -1, -1, -1, 291, 292, 293,
- 294, 295, 296, -1, -1, 299, -1, 91, -1, -1,
- -1, -1, -1, -1, 308, -1, 310, 311, -1, -1,
- -1, -1, -1, -1, -1, -1, 257, 258, 259, 260,
- 261, -1, 263, 264, 265, -1, -1, -1, 269, 123,
- -1, -1, -1, -1, -1, -1, -1, -1, -1, 280,
- -1, 282, 283, 284, 285, 286, -1, -1, -1, 91,
- 291, 292, 293, 294, 295, 296, 33, -1, 299, 36,
- 37, 38, -1, 40, -1, 42, 43, 308, 45, 310,
- 311, -1, -1, -1, -1, -1, -1, 287, 288, 289,
- 290, 123, 59, -1, -1, -1, -1, 64, -1, -1,
+ -1, -1, -1, 91, -1, -1, -1, -1, 308, -1,
+ 310, 311, -1, -1, -1, -1, 41, -1, -1, 44,
+ 257, 258, 259, 260, 261, -1, 263, 264, 265, -1,
+ -1, -1, 269, 58, 59, 123, -1, -1, 63, -1,
+ -1, -1, -1, 280, -1, 282, 283, 284, 285, 286,
+ -1, -1, -1, -1, 291, 292, 293, 294, 295, 296,
+ 33, -1, 299, 36, 37, 38, -1, 40, 93, 42,
+ 43, 308, 45, 310, 311, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, 59, 287, 288, 289,
+ 290, 64, -1, -1, -1, -1, -1, -1, -1, -1,
-1, 301, 302, 303, 304, 305, 306, -1, -1, 309,
- -1, -1, 312, 313, 314, -1, -1, -1, -1, -1,
+ -1, -1, 312, 313, 314, -1, 33, -1, 91, 36,
+ 37, 38, -1, 40, 41, 42, 43, -1, 45, -1,
+ -1, -1, -1, -1, -1, 281, -1, -1, -1, -1,
+ -1, 287, 288, 289, 290, -1, -1, 64, -1, -1,
+ -1, -1, -1, 126, 300, 301, 302, 303, 304, 305,
+ 306, -1, -1, 309, -1, -1, 312, 313, 314, -1,
-1, -1, 33, -1, 91, 36, 37, 38, -1, 40,
- 41, 42, 43, -1, 45, -1, -1, -1, -1, -1,
+ -1, 42, 43, -1, 45, -1, -1, -1, -1, -1,
-1, -1, -1, 281, -1, -1, -1, -1, -1, 287,
288, 289, 290, 64, -1, -1, -1, -1, -1, 126,
-1, -1, 300, 301, 302, 303, 304, 305, 306, -1,
- -1, 309, -1, -1, 312, 313, 314, -1, 33, -1,
- 91, 36, 37, 38, -1, 40, -1, 42, 43, -1,
- 45, -1, -1, -1, -1, -1, -1, 281, -1, -1,
- -1, -1, -1, 287, 288, 289, 290, -1, -1, 64,
- -1, -1, -1, -1, -1, 126, 300, 301, 302, 303,
- 304, 305, 306, -1, -1, 309, -1, -1, 312, 313,
- 314, -1, -1, -1, -1, -1, 91, 33, 93, -1,
- 36, 37, 38, -1, 40, 41, 42, 43, -1, 45,
- -1, -1, -1, -1, -1, 287, 288, 289, 290, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, 64, -1,
- -1, 126, 304, 305, 306, -1, -1, 309, -1, -1,
- 312, 313, 314, -1, -1, -1, 41, -1, -1, 44,
- 257, 258, 259, 260, 261, 91, 263, 264, 265, -1,
+ -1, 309, -1, -1, 312, 313, 314, -1, -1, -1,
+ 91, 33, 93, -1, 36, 37, 38, -1, 40, 41,
+ 42, 43, -1, 45, -1, -1, -1, 272, 273, 274,
+ 275, -1, -1, -1, 279, -1, 281, -1, -1, -1,
+ -1, -1, 64, 288, -1, 126, -1, -1, -1, -1,
+ -1, -1, 297, 298, -1, 300, 301, 302, 303, 304,
+ 41, -1, -1, 44, 257, 258, 259, 260, 261, 91,
+ 263, 264, 265, -1, -1, -1, 269, 58, 59, -1,
+ -1, -1, 63, -1, -1, -1, -1, 280, -1, 282,
+ 283, 284, 285, 286, -1, -1, -1, -1, 291, 292,
+ 293, 294, 295, 296, 126, -1, 299, -1, -1, -1,
+ -1, -1, 93, -1, -1, 308, 41, 310, 311, 44,
+ 257, 258, 259, 260, 261, -1, 263, 264, 265, -1,
-1, -1, 269, 58, 59, -1, -1, -1, 63, -1,
-1, -1, -1, 280, -1, 282, 283, 284, 285, 286,
-1, -1, -1, -1, 291, 292, 293, 294, 295, 296,
- 126, -1, 299, -1, -1, -1, -1, -1, 93, -1,
- -1, 308, 41, 310, 311, 44, 257, 258, 259, 260,
- 261, -1, 263, 264, 265, -1, -1, -1, 269, 58,
- 59, -1, -1, -1, 63, -1, -1, -1, -1, 280,
- -1, 282, 283, 284, 285, 286, -1, -1, -1, -1,
- 291, 292, 293, 294, 295, 296, -1, -1, 299, -1,
- -1, -1, -1, -1, 93, -1, -1, 308, -1, 310,
- 311, -1, 257, 258, 259, 260, 261, -1, 263, 264,
- 265, -1, 33, -1, 269, 36, 37, 38, -1, 40,
- 41, 42, 43, -1, 45, 280, -1, 282, 283, 284,
- 285, 286, -1, -1, -1, -1, 291, 292, 293, 294,
- 295, 296, -1, 64, 299, -1, -1, -1, -1, -1,
- -1, -1, -1, 308, -1, 310, 311, -1, -1, -1,
- -1, 257, 258, 259, 260, 261, -1, 263, 264, 265,
- 91, 33, -1, 269, 36, 37, 38, -1, 40, -1,
- 42, 43, -1, 45, 280, -1, 282, 283, 284, 285,
- 286, -1, -1, -1, -1, 291, 292, 293, 294, 295,
- 296, -1, 64, 299, -1, 126, -1, -1, -1, -1,
- -1, -1, 308, -1, 310, 311, -1, 272, 273, 274,
- 275, -1, -1, -1, -1, -1, 281, 33, -1, 91,
- 36, 37, 38, 288, 40, 41, 42, 43, -1, 45,
- -1, -1, 297, 298, -1, 300, 301, 302, 303, 304,
- -1, -1, -1, -1, -1, -1, -1, -1, 64, -1,
- -1, -1, -1, -1, 126, -1, -1, -1, -1, -1,
- -1, -1, -1, 272, 273, 274, 275, -1, -1, -1,
- -1, -1, 281, 33, -1, 91, 36, 37, 38, -1,
- 40, 41, 42, 43, -1, 45, -1, -1, 297, 298,
- -1, 300, 301, 302, 303, 304, -1, -1, -1, -1,
- -1, -1, -1, -1, 64, -1, -1, -1, -1, -1,
- 126, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, 257, 258, 259, 260,
- 261, 91, 263, 264, 265, -1, 33, -1, 269, 36,
+ -1, -1, 299, -1, -1, -1, -1, -1, 93, -1,
+ -1, 308, -1, 310, 311, -1, 257, 258, 259, 260,
+ 261, -1, 263, 264, 265, -1, 33, -1, 269, 36,
37, 38, -1, 40, 41, 42, 43, -1, 45, 280,
-1, 282, 283, 284, 285, 286, -1, -1, -1, -1,
- 291, 292, 293, 294, 295, 296, 126, 64, 299, -1,
+ 291, 292, 293, 294, 295, 296, -1, 64, 299, -1,
-1, -1, -1, -1, -1, -1, -1, 308, -1, 310,
- 311, -1, -1, -1, 256, 257, 258, 259, 260, 261,
- -1, 263, 264, 265, 91, -1, -1, 269, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, 280, -1,
+ 311, -1, -1, -1, -1, 257, 258, 259, 260, 261,
+ -1, 263, 264, 265, 91, 33, -1, 269, 36, 37,
+ 38, -1, 40, -1, 42, 43, -1, 45, 280, -1,
282, 283, 284, 285, 286, -1, -1, -1, -1, 291,
- 292, 293, 294, 295, 296, -1, -1, 299, -1, 126,
- 91, -1, -1, -1, 41, -1, 308, 44, 310, 311,
- -1, 257, 258, 259, 260, 261, -1, 263, 264, 265,
- -1, 58, 59, 269, -1, -1, 63, -1, -1, -1,
- -1, -1, 123, -1, 280, -1, 282, 283, 284, 285,
- 286, -1, -1, -1, -1, 291, 292, 293, 294, 295,
- 296, -1, -1, 299, 91, -1, 93, -1, -1, -1,
- -1, -1, 308, -1, 310, 311, -1, 257, 258, 259,
- 260, 261, -1, 263, 264, 265, -1, 33, -1, 269,
- 36, 37, 38, -1, 40, -1, 42, 43, -1, 45,
- 280, -1, 282, 283, 284, 285, 286, -1, -1, -1,
- -1, 291, 292, 293, 294, 295, 296, -1, 64, 299,
- -1, -1, -1, -1, -1, -1, -1, -1, 308, -1,
- 310, 311, -1, -1, -1, -1, 41, -1, -1, 44,
+ 292, 293, 294, 295, 296, -1, 64, 299, -1, 126,
+ -1, -1, -1, -1, -1, -1, 308, -1, 310, 311,
+ -1, 272, 273, 274, 275, -1, -1, -1, 279, -1,
+ 281, 33, -1, 91, 36, 37, 38, -1, 40, 41,
+ 42, 43, -1, 45, -1, -1, 297, 298, -1, 300,
+ 301, 302, 303, 304, -1, -1, -1, -1, -1, -1,
+ -1, -1, 64, -1, -1, -1, -1, -1, 126, -1,
+ -1, -1, -1, -1, -1, -1, -1, 272, 273, 274,
+ 275, -1, -1, -1, 279, -1, 281, 33, -1, 91,
+ 36, 37, 38, -1, 40, 41, 42, 43, -1, 45,
+ -1, -1, 297, 298, -1, 300, 301, 302, 303, 304,
+ -1, -1, -1, -1, -1, -1, -1, -1, 64, -1,
+ -1, -1, -1, -1, 126, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
257, 258, 259, 260, 261, 91, 263, 264, 265, -1,
- -1, -1, 269, 58, 59, -1, -1, -1, 63, -1,
- -1, -1, -1, 280, -1, 282, 283, 284, 285, 286,
+ 33, -1, 269, 36, 37, 38, -1, 40, 41, 42,
+ 43, -1, 45, 280, -1, 282, 283, 284, 285, 286,
-1, -1, -1, -1, 291, 292, 293, 294, 295, 296,
- 126, -1, 299, 41, -1, -1, 44, -1, 93, -1,
- -1, 308, -1, 310, 311, -1, -1, -1, -1, -1,
- 58, 59, -1, -1, -1, 63, 287, 288, 289, 290,
- -1, -1, -1, -1, -1, -1, -1, -1, 123, -1,
- -1, 302, 303, 304, 305, 306, -1, -1, 309, -1,
- -1, 312, 313, 314, -1, 93, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, 272, 273, 274, 275, -1,
- 41, -1, -1, -1, 281, -1, -1, -1, -1, -1,
- 287, 288, 289, 290, -1, 123, -1, 58, 59, -1,
- 297, 298, 63, 300, 301, 302, 303, 304, 305, 306,
- -1, -1, 309, -1, -1, 312, 313, 314, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- 91, -1, 93, -1, 41, -1, -1, -1, -1, -1,
+ 126, 64, 299, -1, -1, -1, -1, -1, -1, -1,
+ -1, 308, -1, 310, 311, -1, -1, -1, 256, 257,
+ 258, 259, 260, 261, -1, 263, 264, 265, 91, -1,
+ -1, 269, 41, -1, -1, 44, -1, -1, -1, -1,
+ -1, -1, 280, -1, 282, 283, 284, 285, 286, 58,
+ 59, -1, -1, 291, 292, 293, 294, 295, 296, -1,
+ -1, 299, -1, 126, -1, -1, -1, -1, -1, -1,
+ 308, -1, 310, 311, -1, 257, 258, 259, 260, 261,
+ -1, 263, 264, 265, 93, -1, -1, 269, 41, -1,
+ -1, 44, -1, -1, -1, -1, -1, -1, 280, -1,
+ 282, 283, 284, 285, 286, 58, 59, -1, -1, 291,
+ 292, 293, 294, 295, 296, -1, -1, 299, -1, -1,
+ -1, -1, -1, -1, -1, -1, 308, -1, 310, 311,
-1, 257, 258, 259, 260, 261, -1, 263, 264, 265,
- -1, 58, 59, 269, -1, -1, 63, -1, -1, -1,
- -1, -1, 123, -1, 280, -1, 282, 283, 284, 285,
+ 93, 33, -1, 269, 36, 37, 38, -1, 40, -1,
+ 42, 43, -1, 45, 280, -1, 282, 283, 284, 285,
286, -1, -1, -1, -1, 291, 292, 293, 294, 295,
- 296, -1, -1, 299, 91, -1, 93, -1, -1, -1,
- 41, -1, 308, 44, 310, 311, -1, 272, 273, 274,
- 275, -1, -1, -1, -1, -1, 281, 58, 59, -1,
- -1, -1, 287, 288, 289, 290, 123, -1, -1, -1,
- -1, -1, 297, 298, -1, 300, 301, 302, 303, 304,
- 305, 306, -1, -1, 309, -1, -1, 312, 313, 314,
- -1, -1, 93, -1, 272, 273, 274, 275, -1, 41,
- -1, -1, 44, 281, -1, -1, -1, -1, -1, 287,
- 288, 289, 290, -1, -1, -1, 58, 59, -1, 297,
- 298, 63, 300, 301, 302, 303, 304, 305, 306, 25,
- 26, 309, -1, -1, 312, 313, 314, -1, -1, -1,
- -1, 37, -1, -1, -1, -1, -1, 43, 44, 45,
- -1, 93, -1, -1, 50, -1, -1, -1, -1, -1,
- -1, 272, 273, 274, 275, -1, 62, 63, 64, 65,
- 281, -1, -1, -1, -1, -1, 287, 288, 289, 290,
- -1, 123, 41, -1, -1, 44, 297, 298, -1, 300,
- 301, 302, 303, 304, 305, 306, -1, -1, 309, 58,
- 59, 312, 313, 314, 63, -1, -1, -1, -1, -1,
- -1, 107, -1, -1, -1, 272, 273, 274, 275, -1,
- -1, -1, -1, -1, 281, -1, -1, -1, -1, -1,
- 287, 288, 289, 290, 93, -1, 41, -1, -1, -1,
- 297, 298, -1, 300, 301, 302, 303, 304, 305, 306,
- -1, -1, 309, 58, 59, 312, 313, 314, 63, -1,
- -1, -1, -1, -1, 123, -1, -1, -1, -1, -1,
- 166, 272, 273, 274, 275, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, 41, -1, 91, 44, 93, -1,
- -1, -1, -1, -1, 190, -1, 297, 298, -1, 300,
- -1, 58, 59, -1, -1, -1, 63, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, 123, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- 272, 273, 274, 275, -1, 41, 93, -1, 44, 281,
- -1, -1, -1, -1, -1, 287, 288, 289, 290, -1,
- -1, -1, 58, 59, -1, 297, 298, 63, 300, 301,
- 302, 303, 304, 305, 306, -1, 123, 309, -1, -1,
- 312, 313, 314, -1, -1, -1, -1, -1, -1, -1,
- 41, -1, -1, 44, -1, -1, -1, 93, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, 58, 59, -1,
- -1, -1, 63, -1, -1, -1, -1, -1, -1, -1,
+ 296, -1, 64, 299, -1, -1, -1, -1, -1, -1,
+ -1, -1, 308, -1, 310, 311, -1, -1, -1, -1,
+ 41, -1, -1, 44, 257, 258, 259, 260, 261, 91,
+ 263, 264, 265, -1, -1, -1, 269, 58, 59, -1,
+ -1, -1, 63, -1, -1, -1, -1, 280, -1, 282,
+ 283, 284, 285, 286, -1, -1, -1, -1, 291, 292,
+ 293, 294, 295, 296, 126, 41, 299, -1, 44, -1,
+ 91, -1, 93, -1, -1, 308, -1, 310, 311, -1,
+ -1, -1, 58, 59, -1, -1, -1, 63, -1, -1,
-1, -1, -1, 272, 273, 274, 275, -1, -1, -1,
- -1, -1, 281, -1, -1, -1, -1, -1, 287, 288,
- 289, 290, 93, -1, 41, -1, -1, 44, 297, 298,
- -1, 300, 301, 302, 303, 304, 305, 306, -1, -1,
- 309, 58, 59, 312, 313, 314, 63, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, 272, 273, 274,
- 275, -1, -1, -1, -1, -1, 281, -1, -1, -1,
- -1, -1, 287, 288, 289, 290, 93, -1, -1, -1,
- -1, -1, 297, 298, -1, 300, 301, 302, 303, 304,
- 305, 306, -1, -1, 309, -1, -1, 312, 313, 314,
- -1, -1, -1, -1, -1, 272, 273, 274, 275, -1,
- 41, -1, -1, 44, 281, -1, -1, -1, -1, -1,
- 287, 288, 289, 290, -1, -1, -1, 58, 59, -1,
- 297, 298, 63, 300, 301, 302, 303, 304, 305, 306,
- -1, -1, 309, -1, -1, 312, 313, 314, -1, -1,
- -1, -1, -1, -1, -1, -1, 272, 273, 274, 275,
- -1, 41, 93, -1, 44, 281, -1, -1, -1, -1,
+ 279, -1, 123, -1, -1, -1, -1, -1, 41, -1,
+ -1, 44, -1, -1, -1, 91, -1, 93, 297, 298,
+ -1, 300, -1, -1, -1, 58, 59, -1, -1, -1,
+ 63, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, 123, -1, 272,
+ 273, 274, 275, -1, 41, -1, 279, 44, -1, -1,
+ 93, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, 58, 59, -1, 297, 298, 63, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ 123, -1, -1, -1, -1, 257, 258, 259, 260, 261,
+ -1, 263, 264, 265, 91, -1, 93, 269, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, 280, -1,
+ 282, 283, 284, 285, 286, -1, -1, -1, -1, 291,
+ 292, 293, 294, 295, 296, -1, -1, 299, -1, 91,
+ -1, -1, -1, -1, -1, -1, 308, -1, 310, 311,
+ -1, 272, 273, 274, 275, -1, -1, -1, 279, -1,
+ 281, -1, -1, -1, -1, -1, 287, 288, 289, 290,
+ -1, 123, -1, -1, -1, -1, 297, 298, -1, 300,
+ 301, 302, 303, 304, 305, 306, -1, -1, 309, -1,
+ -1, 312, 313, 314, -1, -1, 272, 273, 274, 275,
+ -1, 41, -1, 279, 44, 281, -1, -1, -1, -1,
-1, 287, 288, 289, 290, -1, -1, -1, 58, 59,
-1, 297, 298, 63, 300, 301, 302, 303, 304, 305,
- 306, -1, -1, 309, -1, -1, 312, 313, 314, -1,
- -1, 272, 273, 274, 275, -1, -1, -1, -1, -1,
- 281, -1, -1, 93, -1, -1, 287, 288, 289, 290,
- -1, -1, 41, -1, -1, 44, 297, 298, -1, 300,
- 301, 302, 303, 304, 305, 306, -1, -1, 309, 58,
- 59, 312, 313, 314, 63, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, 272, 273, 274, 275, -1,
- 41, -1, -1, 44, 281, -1, -1, -1, -1, -1,
- 287, 288, 289, 290, 93, -1, -1, 58, 59, -1,
+ 306, -1, -1, 309, -1, -1, 312, 313, 314, 272,
+ 273, 274, 275, -1, -1, -1, 279, -1, 281, -1,
+ -1, -1, -1, 93, 287, 288, 289, 290, -1, -1,
+ -1, -1, -1, -1, 297, 298, -1, 300, 301, 302,
+ 303, 304, 305, 306, -1, -1, 309, -1, -1, 312,
+ 313, 314, -1, 123, -1, 272, 273, 274, 275, 91,
+ 41, -1, 279, -1, 281, -1, -1, -1, -1, -1,
+ 287, 288, 289, 290, -1, -1, -1, 58, 59, -1,
297, 298, 63, 300, 301, 302, 303, 304, 305, 306,
- -1, -1, 309, -1, -1, 312, 313, 314, -1, 41,
- -1, -1, 44, -1, -1, -1, -1, -1, -1, -1,
- 41, -1, 93, 44, -1, -1, 58, 59, -1, -1,
- -1, 63, -1, -1, -1, -1, -1, 58, 59, -1,
- -1, -1, 63, -1, -1, -1, -1, -1, -1, -1,
- -1, 272, 273, 274, 275, -1, 41, -1, -1, 44,
- 281, 93, -1, -1, -1, -1, 287, 288, 289, 290,
- -1, -1, 93, 58, 59, -1, 297, 298, 63, 300,
- 301, 302, 303, 304, 305, 306, -1, -1, 309, -1,
- -1, 312, 313, 314, -1, -1, -1, -1, -1, -1,
- -1, -1, 272, 273, 274, 275, -1, 41, 93, -1,
- 44, 281, -1, -1, -1, -1, -1, 287, 288, 289,
- 290, -1, -1, -1, 58, 59, -1, 297, 298, 63,
- 300, 301, 302, 303, 304, 305, 306, -1, -1, 309,
+ -1, 123, 309, -1, -1, 312, 313, 314, -1, -1,
+ -1, -1, -1, 41, -1, 287, 288, 289, 290, -1,
+ 91, -1, 93, -1, -1, -1, -1, -1, -1, -1,
+ 58, 59, 304, 305, 306, 63, -1, 309, -1, -1,
+ 312, 313, 314, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, 123, -1, -1, -1, -1, 41, -1, -1,
+ 44, -1, -1, 91, -1, 93, -1, -1, -1, -1,
+ -1, -1, -1, -1, 58, 59, -1, -1, -1, 63,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, 41, -1, -1, 44, -1, -1, 93,
- -1, -1, -1, 272, 273, 274, 275, -1, -1, -1,
- 58, 59, 281, -1, -1, 63, -1, -1, 287, 288,
- 289, 290, -1, -1, -1, -1, -1, -1, 297, 298,
- -1, 300, 301, 302, 303, 304, 305, 306, -1, -1,
- 309, 272, 273, 274, 275, 93, -1, -1, -1, -1,
- 281, -1, -1, -1, -1, -1, 287, 288, 289, 290,
- -1, -1, -1, -1, -1, -1, 297, 298, -1, 300,
- 301, 302, 303, 304, 305, 306, -1, -1, -1, -1,
- 272, 273, 274, 275, -1, 41, -1, -1, 44, 281,
- -1, 272, 273, 274, 275, 287, 288, 289, 290, -1,
- 281, -1, 58, 59, -1, 297, 298, 63, 300, 301,
- 302, 303, 304, 305, 306, -1, 297, 298, -1, 300,
- 301, 302, 303, 304, -1, -1, -1, 272, 273, 274,
- 275, -1, 41, -1, -1, 44, 281, 93, -1, -1,
+ -1, -1, -1, -1, -1, 123, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, 93,
+ -1, -1, 272, 273, 274, 275, -1, -1, -1, 279,
+ -1, 281, -1, -1, -1, -1, -1, 287, 288, 289,
+ 290, -1, -1, 41, -1, -1, 44, 297, 298, 123,
+ 300, 301, 302, 303, 304, 305, 306, -1, -1, 309,
+ 58, 59, 312, 313, 314, 63, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, 287, 288, 289, 290, -1,
+ -1, -1, -1, -1, -1, -1, 41, -1, -1, 44,
+ 302, 303, 304, 305, 306, 93, -1, 309, -1, -1,
+ 312, 313, 314, 58, 59, -1, -1, -1, 63, -1,
+ -1, 272, 273, 274, 275, -1, -1, -1, 279, -1,
+ 281, -1, -1, -1, -1, 123, 287, 288, 289, 290,
+ -1, -1, -1, -1, -1, -1, 297, 298, 93, 300,
+ 301, 302, 303, 304, 305, 306, -1, -1, 309, -1,
+ -1, 312, 313, 314, 272, 273, 274, 275, -1, 41,
+ -1, 279, -1, 281, -1, -1, -1, -1, 123, 287,
+ 288, 289, 290, -1, -1, -1, 58, 59, -1, 297,
+ 298, 63, 300, 301, 302, 303, 304, 305, 306, -1,
+ -1, 309, -1, -1, 312, 313, 314, -1, 272, 273,
+ 274, 275, -1, 41, -1, 279, 44, 281, -1, 91,
+ -1, 93, -1, 287, 288, 289, 290, -1, -1, -1,
+ 58, 59, -1, 297, 298, 63, 300, 301, 302, 303,
+ 304, 305, 306, -1, -1, 309, -1, -1, 312, 313,
+ 314, 123, -1, -1, -1, -1, 41, 25, 26, 44,
+ -1, -1, -1, -1, -1, 93, -1, -1, -1, 37,
+ -1, -1, -1, 58, 59, 43, 44, 45, 63, -1,
+ -1, -1, 50, -1, 272, 273, 274, 275, -1, -1,
+ -1, 279, -1, 281, 62, 63, 64, 65, -1, 287,
+ 288, 289, 290, -1, -1, -1, -1, -1, 93, 297,
+ 298, -1, 300, 301, 302, 303, 304, 305, 306, -1,
+ -1, 309, -1, -1, 312, 313, 314, 272, 273, 274,
+ 275, -1, 41, -1, 279, 44, 281, -1, -1, 107,
-1, -1, 287, 288, 289, 290, -1, -1, -1, 58,
59, -1, 297, 298, 63, 300, 301, 302, 303, 304,
- 305, 306, -1, -1, -1, -1, -1, -1, 41, -1,
- -1, 44, -1, -1, -1, -1, -1, -1, 272, 273,
- 274, 275, -1, -1, 93, 58, 59, 281, -1, -1,
- 63, -1, -1, 287, 288, 289, 290, -1, -1, -1,
- -1, -1, -1, 297, 298, -1, 300, 301, 302, 303,
- 304, 305, 306, 41, -1, -1, 44, -1, -1, -1,
- 93, -1, -1, -1, 272, 273, 274, 275, -1, -1,
- 58, 59, -1, 281, -1, 63, -1, -1, -1, 287,
- 288, 289, 290, -1, -1, -1, -1, -1, -1, 297,
- 298, -1, 300, 301, 302, 303, 304, 305, 306, 41,
- -1, -1, 44, -1, -1, 93, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, 58, 59, -1, -1,
+ 305, 306, -1, -1, 309, -1, -1, 312, 313, 314,
+ -1, -1, -1, -1, -1, 41, -1, -1, 44, -1,
+ -1, -1, -1, -1, 93, -1, -1, -1, -1, -1,
+ -1, -1, 58, 59, -1, -1, -1, 63, -1, 167,
+ 272, 273, 274, 275, -1, -1, -1, 279, -1, 281,
+ -1, -1, -1, -1, -1, 287, 288, 289, 290, -1,
+ -1, -1, -1, 191, -1, 297, 298, 93, 300, 301,
+ 302, 303, 304, 305, 306, -1, -1, 309, -1, -1,
+ 312, 313, 314, -1, 272, 273, 274, 275, -1, 41,
+ -1, 279, 44, 281, -1, -1, -1, -1, -1, 287,
+ 288, 289, 290, -1, -1, -1, 58, 59, -1, 297,
+ 298, 63, 300, 301, 302, 303, 304, 305, 306, -1,
+ -1, 309, -1, -1, 312, 313, 314, 272, 273, 274,
+ 275, -1, 41, -1, 279, 44, 281, -1, -1, -1,
+ -1, 93, 287, 288, 289, 290, -1, -1, -1, 58,
+ 59, -1, 297, 298, 63, 300, 301, 302, 303, 304,
+ 305, 306, -1, -1, 309, -1, -1, 312, 313, 314,
+ 41, -1, -1, 44, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, 93, -1, -1, 58, 59, -1,
+ -1, -1, 63, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, 272, 273, 274, 275, -1, 41, -1,
+ 279, 44, 281, -1, -1, -1, -1, -1, 287, 288,
+ 289, 290, 93, -1, -1, 58, 59, -1, 297, 298,
+ 63, 300, 301, 302, 303, 304, 305, 306, -1, -1,
+ 309, -1, -1, 312, 313, 314, 272, 273, 274, 275,
+ -1, 41, -1, 279, 44, 281, -1, -1, -1, -1,
+ 93, 287, 288, 289, 290, -1, -1, -1, 58, 59,
+ -1, 297, 298, 63, 300, 301, 302, 303, 304, 305,
+ 306, -1, -1, 309, -1, -1, 312, 313, 314, 41,
+ -1, -1, 44, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, 93, -1, -1, 58, 59, -1, -1,
-1, 63, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, 41, -1, -1, 44, -1, -1,
- -1, 93, -1, -1, -1, -1, 272, 273, 274, 275,
- -1, 58, 59, -1, -1, 281, 63, -1, -1, -1,
- -1, 287, 288, 289, 290, -1, -1, -1, -1, -1,
- -1, 297, 298, -1, 300, 301, 302, 303, 304, 305,
- 306, 41, -1, -1, 44, -1, 93, -1, -1, -1,
- -1, -1, -1, 272, 273, 274, 275, -1, 58, 59,
- -1, -1, 281, 63, -1, -1, -1, -1, 287, 288,
- 289, 290, -1, -1, -1, -1, -1, 41, 297, 298,
- 44, 300, 301, 302, 303, 304, 305, 306, -1, 272,
- 273, 274, 275, 93, 58, 59, -1, -1, 281, 63,
- -1, -1, -1, -1, 287, 288, 289, 290, -1, -1,
- -1, -1, -1, -1, 297, 298, -1, 300, 301, 302,
- 303, 304, 305, 41, -1, -1, 44, -1, -1, 93,
- -1, -1, -1, -1, 272, 273, 274, 275, -1, -1,
- 58, 59, -1, 281, -1, 63, -1, -1, -1, 287,
- 288, -1, 290, -1, -1, -1, -1, -1, -1, 297,
- 298, -1, 300, 301, 302, 303, 304, 305, 41, -1,
- -1, 44, -1, -1, -1, 93, -1, -1, -1, -1,
- 272, 273, 274, 275, -1, 58, 59, -1, -1, 281,
- 63, -1, 91, -1, -1, 287, 288, -1, -1, -1,
- 41, -1, -1, 44, -1, 297, 298, -1, 300, 301,
- 302, 303, 304, 305, -1, -1, -1, 58, 59, -1,
- 93, -1, 63, -1, 123, 272, 273, 274, 275, -1,
- -1, -1, -1, -1, 281, -1, -1, -1, -1, -1,
- 287, 288, 41, -1, -1, 44, -1, -1, -1, -1,
- 297, 298, 93, 300, 301, 302, 303, 304, -1, 58,
- 59, -1, 41, -1, 63, 44, -1, -1, -1, -1,
- -1, -1, 272, 273, 274, 275, -1, -1, -1, 58,
- 59, 281, -1, -1, -1, 58, -1, 287, 288, 41,
- 63, -1, 44, -1, 93, -1, -1, 297, 298, -1,
- 300, 301, 302, 303, 304, -1, 58, 59, 272, 273,
- 274, 275, -1, -1, 93, -1, -1, 281, 91, -1,
- -1, -1, -1, 287, 288, 41, -1, -1, 44, -1,
- -1, -1, -1, 297, 298, -1, 300, 301, 302, 303,
- 304, 93, 58, 59, -1, -1, -1, -1, -1, -1,
- 123, -1, -1, -1, 272, 273, 274, 275, -1, -1,
- -1, -1, -1, 281, -1, -1, -1, -1, -1, 287,
- 288, -1, -1, -1, -1, -1, -1, 93, -1, 297,
- 298, 63, 300, 301, 302, 303, 304, -1, 287, 288,
- 289, 290, -1, -1, -1, -1, -1, -1, -1, 272,
- 273, 274, 275, -1, 303, 304, 305, 306, 281, 91,
- 309, -1, -1, 312, 313, 314, -1, -1, -1, -1,
- -1, -1, -1, -1, 297, 298, -1, 300, 301, 302,
- 303, 272, 273, 274, 275, -1, -1, -1, -1, -1,
- 281, 123, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, 297, 298, -1, 300,
- 301, 302, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, 272, 273, 274, 275, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, 272, 273, 274, 275, -1, 297, 298,
- -1, 300, -1, -1, -1, -1, -1, -1, 281, -1,
- -1, -1, -1, -1, 287, 288, 289, 290, 297, 298,
- 272, 273, 274, 275, -1, -1, -1, 300, 301, 302,
- 303, 304, 305, 306, -1, -1, 309, -1, -1, 312,
- 313, 314, -1, -1, -1, 297, 298, -1, -1, -1,
- -1, -1, -1, -1, 30, -1, 272, 273, 274, 275,
- -1, -1, 38, -1, -1, -1, 42, -1, -1, 45,
- -1, -1, -1, -1, -1, -1, 52, 53, 54, 55,
- 56, 297, 298, 59, 60, -1, -1, -1, -1, -1,
- 66, -1, -1, -1, -1, -1, -1, -1, -1, 281,
+ 272, 273, 274, 275, -1, 41, -1, 279, 44, 281,
-1, -1, -1, -1, -1, 287, 288, 289, 290, -1,
- -1, -1, -1, -1, -1, -1, -1, 93, -1, 301,
+ -1, 93, 58, 59, -1, 297, 298, 63, 300, 301,
302, 303, 304, 305, 306, -1, -1, 309, -1, -1,
- 312, 313, 314, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, 150, 151, 152, 153, 154, 155,
- 156, 157, 158, 159, 160, 161, 162, 163, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, -1, 175,
+ -1, -1, -1, 272, 273, 274, 275, -1, 41, -1,
+ 279, 44, 281, -1, -1, -1, -1, 93, 287, 288,
+ 289, 290, -1, -1, -1, 58, 59, -1, 297, 298,
+ 63, 300, 301, 302, 303, 304, 305, 306, -1, -1,
+ -1, 272, 273, 274, 275, -1, 41, -1, 279, 44,
+ 281, -1, -1, -1, -1, -1, 287, 288, 289, 290,
+ 93, -1, -1, 58, 59, -1, 297, 298, 63, 300,
+ 301, 302, 303, 304, 305, 306, -1, -1, -1, 272,
+ 273, 274, 275, -1, 41, -1, 279, 44, 281, -1,
+ -1, -1, -1, -1, 287, 288, 289, 290, 93, -1,
+ -1, 58, 59, -1, 297, 298, 63, 300, 301, 302,
+ 303, 304, 305, 306, -1, -1, -1, -1, -1, -1,
+ -1, -1, 272, 273, 274, 275, -1, 41, -1, 279,
+ 44, 281, -1, -1, -1, -1, 93, 287, 288, 289,
+ 290, -1, -1, -1, 58, 59, -1, 297, 298, 63,
+ 300, 301, 302, 303, 304, 305, 306, -1, -1, -1,
+ 272, 273, 274, 275, -1, 41, -1, 279, 44, 281,
+ -1, -1, -1, -1, -1, 287, 288, 289, 290, 93,
+ -1, -1, 58, 59, -1, 297, 298, 63, 300, 301,
+ 302, 303, 304, 305, 306, -1, 272, 273, 274, 275,
+ -1, 41, -1, 279, 44, 281, -1, -1, -1, -1,
+ -1, 287, 288, 289, 290, -1, -1, 93, 58, 59,
+ -1, 297, 298, 63, 300, 301, 302, 303, 304, 305,
+ 306, -1, -1, -1, -1, -1, -1, -1, -1, 272,
+ 273, 274, 275, -1, 41, -1, 279, 44, 281, -1,
+ -1, -1, -1, 93, 287, 288, 289, 290, -1, -1,
+ -1, 58, 59, -1, 297, 298, 63, 300, 301, 302,
+ 303, 304, 305, 306, -1, -1, -1, 272, 273, 274,
+ 275, -1, 41, -1, 279, 44, 281, -1, -1, -1,
+ -1, -1, 287, 288, 289, 290, 93, -1, -1, 58,
+ 59, -1, 297, 298, 63, 300, 301, 302, 303, 304,
+ 305, -1, -1, -1, -1, 272, 273, 274, 275, -1,
+ 41, -1, 279, 44, 281, -1, -1, -1, -1, -1,
+ 287, 288, -1, 290, 93, -1, -1, 58, 59, -1,
+ 297, 298, 63, 300, 301, 302, 303, 304, 305, -1,
+ 91, -1, -1, -1, -1, -1, -1, -1, 272, 273,
+ 274, 275, -1, 41, -1, 279, 44, 281, -1, -1,
+ -1, -1, 93, 287, 288, -1, -1, -1, -1, -1,
+ 58, 59, 123, 297, 298, 63, 300, 301, 302, 303,
+ 304, 305, -1, -1, -1, -1, 272, 273, 274, 275,
+ -1, 41, -1, 279, 44, 281, -1, -1, -1, -1,
+ -1, 287, 288, 41, -1, 93, 44, -1, 58, 59,
+ -1, 297, 298, 63, 300, 301, 302, 303, 304, -1,
+ 58, 59, 272, 273, 274, 275, -1, -1, -1, 279,
+ -1, 281, -1, -1, -1, -1, -1, 287, 288, -1,
+ -1, -1, -1, 93, -1, -1, 41, 297, 298, 44,
+ 300, 301, 302, 303, 304, 93, -1, -1, -1, 41,
+ -1, -1, 44, 58, 59, 272, 273, 274, 275, -1,
+ -1, -1, 279, -1, 281, -1, 58, 59, -1, -1,
+ 287, 288, -1, -1, -1, -1, 63, -1, -1, -1,
+ 297, 298, -1, 300, 301, 302, 303, 304, 93, -1,
+ -1, -1, -1, 272, 273, 274, 275, -1, -1, -1,
+ 279, 93, 281, -1, 91, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, 297, 298,
+ -1, 300, 301, 302, 303, -1, 287, 288, 289, 290,
+ -1, 272, 273, 274, 275, -1, 123, -1, 279, -1,
+ 281, -1, 303, 304, 305, 306, -1, -1, 309, -1,
+ -1, 312, 313, 314, -1, -1, 297, 298, -1, 300,
+ 301, 302, 63, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, 272, 273, 274, 275, -1, -1,
+ -1, 279, -1, 281, -1, -1, -1, -1, -1, -1,
+ 91, -1, -1, -1, -1, -1, -1, -1, -1, 297,
+ 298, -1, 300, 301, -1, -1, -1, -1, -1, -1,
+ -1, -1, 272, 273, 274, 275, -1, -1, -1, 279,
+ -1, -1, 123, -1, 272, 273, 274, 275, -1, -1,
+ -1, 279, -1, -1, -1, -1, 30, 297, 298, -1,
+ 300, -1, -1, -1, 38, -1, -1, -1, 42, 297,
+ 298, 45, -1, -1, -1, -1, -1, -1, 52, 53,
+ 54, 55, 56, -1, -1, 59, 60, 272, 273, 274,
+ 275, -1, 66, -1, 279, -1, -1, -1, -1, -1,
+ 272, 273, 274, 275, -1, -1, -1, 279, -1, -1,
+ -1, -1, 297, 298, 281, -1, -1, -1, -1, 93,
+ 287, 288, 289, 290, -1, 297, 298, -1, -1, -1,
+ -1, -1, -1, 300, 301, 302, 303, 304, 305, 306,
+ -1, -1, 309, -1, -1, 312, 313, 314, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, 151, 152, 153,
+ 154, 155, 156, 157, 158, 159, 160, 161, 162, 163,
+ 164, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ 281, -1, 176, -1, -1, -1, 287, 288, 289, 290,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ 301, 302, 303, 304, 305, 306, -1, -1, 309, -1,
+ -1, 312, 313, 314, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, 253, -1, -1,
+ -1, 255, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
- -1, -1, -1, -1, -1, -1, -1, -1, 284,
+ -1, -1, 286,
};
#define YYFINAL 1
#ifndef YYDEBUG
@@ -1107,6 +1104,7 @@ dEXT char * yyrule[] = {
"sideff : expr UNLESS expr",
"sideff : expr WHILE expr",
"sideff : expr UNTIL iexpr",
+"sideff : expr FOR expr",
"else :",
"else : ELSE mblock",
"else : ELSIF '(' mexpr ')' mblock else",
@@ -1285,9 +1283,9 @@ dEXT int yyerrflag;
dEXT int yychar;
dEXT YYSTYPE yyval;
dEXT YYSTYPE yylval;
-#line 631 "perly.y"
+#line 635 "perly.y"
/* PROGRAM */
-#line 1360 "perly.c"
+#line 1349 "perly.c"
#define YYABORT goto yyabort
#define YYACCEPT goto yyaccept
#define YYERROR goto yyerrlab
@@ -1304,8 +1302,7 @@ struct ysv {
};
void
-yydestruct(ptr)
-void* ptr;
+yydestruct(void *ptr)
{
struct ysv* ysave = (struct ysv*)ptr;
if (ysave->yyss) Safefree(ysave->yyss);
@@ -1320,7 +1317,7 @@ void* ptr;
}
int
-yyparse()
+yyparse(void)
{
register int yym, yyn, yystate;
register short *yyssp;
@@ -1331,12 +1328,15 @@ yyparse()
int retval = 0;
#if YYDEBUG
register char *yys;
+#ifndef __cplusplus
# ifndef getenv
extern char *getenv();
# endif
#endif
+#endif
- struct ysv *ysave = (struct ysv*)safemalloc(sizeof(struct ysv));
+ struct ysv *ysave;
+ New(73, ysave, 1, struct ysv);
SAVEDESTRUCTOR(yydestruct, ysave);
ysave->oldyydebug = yydebug;
ysave->oldyynerrs = yynerrs;
@@ -1352,6 +1352,7 @@ yyparse()
if (yyn >= '0' && yyn <= '9')
yydebug = yyn - '0';
}
+ else SETERRNO(0,SS$_NORMAL);
#endif
yynerrs = 0;
@@ -1361,8 +1362,10 @@ yyparse()
/*
** Initialize private stacks (yyparse may be called from an action)
*/
- ysave->yyss = yyss = (short*)safemalloc(yystacksize*sizeof(short));
- ysave->yyvs = yyvs = (YYSTYPE*)safemalloc(yystacksize*sizeof(YYSTYPE));
+ New(73, yyss, yystacksize, short);
+ New(73, yyvs, yystacksize, YYSTYPE);
+ ysave->yyss = yyss;
+ ysave->yyvs = yyvs;
if (!yyvs || !yyss)
goto yyoverflow;
@@ -1517,9 +1520,9 @@ case 1:
#line 86 "perly.y"
{
#if defined(YYDEBUG) && defined(DEBUGGING)
- yydebug = (debug & 1);
+ yydebug = (PL_debug & 1);
#endif
- expect = XSTATE;
+ PL_expect = XSTATE;
}
break;
case 2:
@@ -1528,8 +1531,8 @@ case 2:
break;
case 3:
#line 97 "perly.y"
-{ if (copline > (line_t)yyvsp[-3].ival)
- copline = yyvsp[-3].ival;
+{ if (PL_copline > (line_t)yyvsp[-3].ival)
+ PL_copline = yyvsp[-3].ival;
yyval.opval = block_end(yyvsp[-2].ival, yyvsp[-1].opval); }
break;
case 4:
@@ -1538,8 +1541,8 @@ case 4:
break;
case 5:
#line 107 "perly.y"
-{ if (copline > (line_t)yyvsp[-3].ival)
- copline = yyvsp[-3].ival;
+{ if (PL_copline > (line_t)yyvsp[-3].ival)
+ PL_copline = yyvsp[-3].ival;
yyval.opval = block_end(yyvsp[-2].ival, yyvsp[-1].opval); }
break;
case 6:
@@ -1558,8 +1561,8 @@ case 9:
#line 121 "perly.y"
{ yyval.opval = append_list(OP_LINESEQ,
(LISTOP*)yyvsp[-1].opval, (LISTOP*)yyvsp[0].opval);
- pad_reset_pending = TRUE;
- if (yyvsp[-1].opval && yyvsp[0].opval) hints |= HINT_BLOCK_SCOPE; }
+ PL_pad_reset_pending = TRUE;
+ if (yyvsp[-1].opval && yyvsp[0].opval) PL_hints |= HINT_BLOCK_SCOPE; }
break;
case 10:
#line 128 "perly.y"
@@ -1572,14 +1575,14 @@ case 12:
}
else {
yyval.opval = Nullop;
- copline = NOLINE;
+ PL_copline = NOLINE;
}
- expect = XSTATE; }
+ PL_expect = XSTATE; }
break;
case 13:
#line 140 "perly.y"
{ yyval.opval = newSTATEOP(0, yyvsp[-2].pval, yyvsp[-1].opval);
- expect = XSTATE; }
+ PL_expect = XSTATE; }
break;
case 14:
#line 145 "perly.y"
@@ -1606,510 +1609,516 @@ case 19:
{ yyval.opval = newLOOPOP(OPf_PARENS, 1, yyvsp[0].opval, yyvsp[-2].opval);}
break;
case 20:
-#line 159 "perly.y"
-{ yyval.opval = Nullop; }
+#line 157 "perly.y"
+{ yyval.opval = newFOROP(0, Nullch, yyvsp[-1].ival,
+ Nullop, yyvsp[0].opval, yyvsp[-2].opval, Nullop); }
break;
case 21:
-#line 161 "perly.y"
-{ yyval.opval = scope(yyvsp[0].opval); }
+#line 162 "perly.y"
+{ yyval.opval = Nullop; }
break;
case 22:
-#line 163 "perly.y"
-{ copline = yyvsp[-5].ival;
+#line 164 "perly.y"
+{ yyval.opval = scope(yyvsp[0].opval); }
+break;
+case 23:
+#line 166 "perly.y"
+{ PL_copline = yyvsp[-5].ival;
yyval.opval = newSTATEOP(0, Nullch,
newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval));
- hints |= HINT_BLOCK_SCOPE; }
+ PL_hints |= HINT_BLOCK_SCOPE; }
break;
-case 23:
-#line 170 "perly.y"
-{ copline = yyvsp[-6].ival;
+case 24:
+#line 173 "perly.y"
+{ PL_copline = yyvsp[-6].ival;
yyval.opval = block_end(yyvsp[-4].ival,
newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); }
break;
-case 24:
-#line 174 "perly.y"
-{ copline = yyvsp[-6].ival;
+case 25:
+#line 177 "perly.y"
+{ PL_copline = yyvsp[-6].ival;
yyval.opval = block_end(yyvsp[-4].ival,
newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); }
break;
-case 25:
-#line 180 "perly.y"
+case 26:
+#line 183 "perly.y"
{ yyval.opval = Nullop; }
break;
-case 26:
-#line 182 "perly.y"
+case 27:
+#line 185 "perly.y"
{ yyval.opval = scope(yyvsp[0].opval); }
break;
-case 27:
-#line 186 "perly.y"
-{ copline = yyvsp[-6].ival;
+case 28:
+#line 189 "perly.y"
+{ PL_copline = yyvsp[-6].ival;
yyval.opval = block_end(yyvsp[-4].ival,
newSTATEOP(0, yyvsp[-7].pval,
newWHILEOP(0, 1, (LOOP*)Nullop,
yyvsp[-6].ival, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval))); }
break;
-case 28:
-#line 192 "perly.y"
-{ copline = yyvsp[-6].ival;
+case 29:
+#line 195 "perly.y"
+{ PL_copline = yyvsp[-6].ival;
yyval.opval = block_end(yyvsp[-4].ival,
newSTATEOP(0, yyvsp[-7].pval,
newWHILEOP(0, 1, (LOOP*)Nullop,
yyvsp[-6].ival, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval))); }
break;
-case 29:
-#line 198 "perly.y"
+case 30:
+#line 201 "perly.y"
{ yyval.opval = block_end(yyvsp[-6].ival,
newFOROP(0, yyvsp[-9].pval, yyvsp[-8].ival, yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); }
break;
-case 30:
-#line 201 "perly.y"
+case 31:
+#line 204 "perly.y"
{ yyval.opval = block_end(yyvsp[-4].ival,
newFOROP(0, yyvsp[-8].pval, yyvsp[-7].ival, mod(yyvsp[-6].opval, OP_ENTERLOOP),
yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); }
break;
-case 31:
-#line 205 "perly.y"
+case 32:
+#line 208 "perly.y"
{ yyval.opval = block_end(yyvsp[-4].ival,
newFOROP(0, yyvsp[-7].pval, yyvsp[-6].ival, Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); }
break;
-case 32:
-#line 209 "perly.y"
+case 33:
+#line 212 "perly.y"
{ OP *forop = append_elem(OP_LINESEQ,
scalar(yyvsp[-6].opval),
newWHILEOP(0, 1, (LOOP*)Nullop,
yyvsp[-9].ival, scalar(yyvsp[-4].opval),
yyvsp[0].opval, scalar(yyvsp[-2].opval)));
- copline = yyvsp[-9].ival;
+ PL_copline = yyvsp[-9].ival;
yyval.opval = block_end(yyvsp[-7].ival, newSTATEOP(0, yyvsp[-10].pval, forop)); }
break;
-case 33:
-#line 217 "perly.y"
+case 34:
+#line 220 "perly.y"
{ yyval.opval = newSTATEOP(0, yyvsp[-2].pval,
newWHILEOP(0, 1, (LOOP*)Nullop,
NOLINE, Nullop, yyvsp[-1].opval, yyvsp[0].opval)); }
break;
-case 34:
-#line 223 "perly.y"
+case 35:
+#line 226 "perly.y"
{ yyval.opval = Nullop; }
break;
-case 36:
-#line 228 "perly.y"
+case 37:
+#line 231 "perly.y"
{ (void)scan_num("1"); yyval.opval = yylval.opval; }
break;
-case 38:
-#line 233 "perly.y"
-{ yyval.opval = invert(scalar(yyvsp[0].opval)); }
-break;
case 39:
-#line 237 "perly.y"
-{ yyval.opval = yyvsp[0].opval; intro_my(); }
+#line 236 "perly.y"
+{ yyval.opval = invert(scalar(yyvsp[0].opval)); }
break;
case 40:
-#line 241 "perly.y"
+#line 240 "perly.y"
{ yyval.opval = yyvsp[0].opval; intro_my(); }
break;
case 41:
-#line 245 "perly.y"
+#line 244 "perly.y"
{ yyval.opval = yyvsp[0].opval; intro_my(); }
break;
case 42:
-#line 249 "perly.y"
+#line 248 "perly.y"
{ yyval.opval = yyvsp[0].opval; intro_my(); }
break;
case 43:
-#line 253 "perly.y"
-{ yyval.pval = Nullch; }
+#line 252 "perly.y"
+{ yyval.opval = yyvsp[0].opval; intro_my(); }
break;
-case 45:
-#line 258 "perly.y"
-{ yyval.ival = 0; }
+case 44:
+#line 256 "perly.y"
+{ yyval.pval = Nullch; }
break;
case 46:
-#line 260 "perly.y"
+#line 261 "perly.y"
{ yyval.ival = 0; }
break;
case 47:
-#line 262 "perly.y"
+#line 263 "perly.y"
{ yyval.ival = 0; }
break;
case 48:
-#line 264 "perly.y"
+#line 265 "perly.y"
{ yyval.ival = 0; }
break;
case 49:
-#line 268 "perly.y"
-{ newFORM(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); }
+#line 267 "perly.y"
+{ yyval.ival = 0; }
break;
case 50:
#line 271 "perly.y"
-{ yyval.opval = yyvsp[0].opval; }
+{ newFORM(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); }
break;
case 51:
-#line 272 "perly.y"
-{ yyval.opval = Nullop; }
+#line 274 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
break;
case 52:
-#line 276 "perly.y"
-{ newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, yyvsp[0].opval); }
+#line 275 "perly.y"
+{ yyval.opval = Nullop; }
break;
case 53:
-#line 280 "perly.y"
-{ yyval.ival = start_subparse(FALSE, 0); }
+#line 279 "perly.y"
+{ newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, yyvsp[0].opval); }
break;
case 54:
-#line 284 "perly.y"
-{ yyval.ival = start_subparse(FALSE, CVf_ANON); }
+#line 283 "perly.y"
+{ yyval.ival = start_subparse(FALSE, 0); }
break;
case 55:
-#line 288 "perly.y"
-{ yyval.ival = start_subparse(TRUE, 0); }
+#line 287 "perly.y"
+{ yyval.ival = start_subparse(FALSE, CVf_ANON); }
break;
case 56:
#line 291 "perly.y"
-{ char *name = SvPVx(((SVOP*)yyvsp[0].opval)->op_sv, na);
- if (strEQ(name, "BEGIN") || strEQ(name, "END"))
- CvUNIQUE_on(compcv);
- yyval.opval = yyvsp[0].opval; }
+{ yyval.ival = start_subparse(TRUE, 0); }
break;
case 57:
-#line 298 "perly.y"
-{ yyval.opval = Nullop; }
+#line 294 "perly.y"
+{ STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, n_a);
+ if (strEQ(name, "BEGIN") || strEQ(name, "END")
+ || strEQ(name, "INIT"))
+ CvSPECIAL_on(PL_compcv);
+ yyval.opval = yyvsp[0].opval; }
break;
-case 59:
+case 58:
#line 302 "perly.y"
-{ yyval.opval = yyvsp[0].opval; }
+{ yyval.opval = Nullop; }
break;
case 60:
-#line 303 "perly.y"
-{ yyval.opval = Nullop; expect = XSTATE; }
+#line 306 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
break;
case 61:
#line 307 "perly.y"
-{ package(yyvsp[-1].opval); }
+{ yyval.opval = Nullop; PL_expect = XSTATE; }
break;
case 62:
-#line 309 "perly.y"
-{ package(Nullop); }
+#line 311 "perly.y"
+{ package(yyvsp[-1].opval); }
break;
case 63:
#line 313 "perly.y"
-{ CvUNIQUE_on(compcv); /* It's a BEGIN {} */ }
+{ package(Nullop); }
break;
case 64:
-#line 315 "perly.y"
-{ utilize(yyvsp[-6].ival, yyvsp[-5].ival, yyvsp[-3].opval, yyvsp[-2].opval, yyvsp[-1].opval); }
+#line 317 "perly.y"
+{ CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
break;
case 65:
#line 319 "perly.y"
-{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); }
+{ utilize(yyvsp[-6].ival, yyvsp[-5].ival, yyvsp[-3].opval, yyvsp[-2].opval, yyvsp[-1].opval); }
break;
case 66:
-#line 321 "perly.y"
+#line 323 "perly.y"
+{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); }
+break;
+case 67:
+#line 325 "perly.y"
{ yyval.opval = newLOGOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, yyvsp[0].opval); }
break;
-case 68:
-#line 326 "perly.y"
+case 69:
+#line 330 "perly.y"
{ yyval.opval = yyvsp[-1].opval; }
break;
-case 69:
-#line 328 "perly.y"
+case 70:
+#line 332 "perly.y"
{ yyval.opval = append_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval); }
break;
-case 71:
-#line 333 "perly.y"
+case 72:
+#line 337 "perly.y"
{ yyval.opval = convert(yyvsp[-2].ival, OPf_STACKED,
prepend_elem(OP_LIST, newGVREF(yyvsp[-2].ival,yyvsp[-1].opval), yyvsp[0].opval) ); }
break;
-case 72:
-#line 336 "perly.y"
+case 73:
+#line 340 "perly.y"
{ yyval.opval = convert(yyvsp[-4].ival, OPf_STACKED,
prepend_elem(OP_LIST, newGVREF(yyvsp[-4].ival,yyvsp[-2].opval), yyvsp[-1].opval) ); }
break;
-case 73:
-#line 339 "perly.y"
+case 74:
+#line 343 "perly.y"
{ yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
prepend_elem(OP_LIST, scalar(yyvsp[-5].opval), yyvsp[-1].opval),
newUNOP(OP_METHOD, 0, yyvsp[-3].opval))); }
break;
-case 74:
-#line 344 "perly.y"
+case 75:
+#line 348 "perly.y"
{ yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
prepend_elem(OP_LIST, yyvsp[-1].opval, yyvsp[0].opval),
newUNOP(OP_METHOD, 0, yyvsp[-2].opval))); }
break;
-case 75:
-#line 349 "perly.y"
+case 76:
+#line 353 "perly.y"
{ yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
prepend_elem(OP_LIST, yyvsp[-3].opval, yyvsp[-1].opval),
newUNOP(OP_METHOD, 0, yyvsp[-4].opval))); }
break;
-case 76:
-#line 354 "perly.y"
+case 77:
+#line 358 "perly.y"
{ yyval.opval = convert(yyvsp[-1].ival, 0, yyvsp[0].opval); }
break;
-case 77:
-#line 356 "perly.y"
+case 78:
+#line 360 "perly.y"
{ yyval.opval = convert(yyvsp[-3].ival, 0, yyvsp[-1].opval); }
break;
-case 78:
-#line 358 "perly.y"
+case 79:
+#line 362 "perly.y"
{ yyvsp[0].opval = newANONSUB(yyvsp[-1].ival, 0, yyvsp[0].opval); }
break;
-case 79:
-#line 360 "perly.y"
+case 80:
+#line 364 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
prepend_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval), yyvsp[-4].opval)); }
break;
-case 82:
-#line 370 "perly.y"
+case 83:
+#line 374 "perly.y"
{ yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[-1].ival, yyvsp[0].opval); }
break;
-case 83:
-#line 372 "perly.y"
+case 84:
+#line 376 "perly.y"
{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
-case 84:
-#line 374 "perly.y"
+case 85:
+#line 378 "perly.y"
{ if (yyvsp[-1].ival != OP_REPEAT)
scalar(yyvsp[-2].opval);
yyval.opval = newBINOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, scalar(yyvsp[0].opval)); }
break;
-case 85:
-#line 378 "perly.y"
-{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
-break;
case 86:
-#line 380 "perly.y"
+#line 382 "perly.y"
{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
case 87:
-#line 382 "perly.y"
+#line 384 "perly.y"
{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
case 88:
-#line 384 "perly.y"
+#line 386 "perly.y"
{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
case 89:
-#line 386 "perly.y"
+#line 388 "perly.y"
{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
case 90:
-#line 388 "perly.y"
+#line 390 "perly.y"
{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
case 91:
-#line 390 "perly.y"
-{ yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));}
+#line 392 "perly.y"
+{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
break;
case 92:
-#line 392 "perly.y"
-{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); }
+#line 394 "perly.y"
+{ yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));}
break;
case 93:
-#line 394 "perly.y"
-{ yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); }
+#line 396 "perly.y"
+{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); }
break;
case 94:
-#line 396 "perly.y"
-{ yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); }
+#line 398 "perly.y"
+{ yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); }
break;
case 95:
-#line 398 "perly.y"
-{ yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); }
+#line 400 "perly.y"
+{ yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); }
break;
case 96:
-#line 401 "perly.y"
-{ yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); }
+#line 402 "perly.y"
+{ yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); }
break;
case 97:
-#line 403 "perly.y"
-{ yyval.opval = yyvsp[0].opval; }
+#line 405 "perly.y"
+{ yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); }
break;
case 98:
-#line 405 "perly.y"
-{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
+#line 407 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
break;
case 99:
-#line 407 "perly.y"
-{ yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));}
+#line 409 "perly.y"
+{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
break;
case 100:
-#line 409 "perly.y"
-{ yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); }
+#line 411 "perly.y"
+{ yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));}
break;
case 101:
-#line 411 "perly.y"
+#line 413 "perly.y"
+{ yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); }
+break;
+case 102:
+#line 415 "perly.y"
{ yyval.opval = newUNOP(OP_POSTINC, 0,
mod(scalar(yyvsp[-1].opval), OP_POSTINC)); }
break;
-case 102:
-#line 414 "perly.y"
+case 103:
+#line 418 "perly.y"
{ yyval.opval = newUNOP(OP_POSTDEC, 0,
mod(scalar(yyvsp[-1].opval), OP_POSTDEC)); }
break;
-case 103:
-#line 417 "perly.y"
+case 104:
+#line 421 "perly.y"
{ yyval.opval = newUNOP(OP_PREINC, 0,
mod(scalar(yyvsp[0].opval), OP_PREINC)); }
break;
-case 104:
-#line 420 "perly.y"
+case 105:
+#line 424 "perly.y"
{ yyval.opval = newUNOP(OP_PREDEC, 0,
mod(scalar(yyvsp[0].opval), OP_PREDEC)); }
break;
-case 105:
-#line 423 "perly.y"
-{ yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); }
-break;
case 106:
-#line 425 "perly.y"
-{ yyval.opval = sawparens(yyvsp[-1].opval); }
-break;
-case 107:
#line 427 "perly.y"
-{ yyval.opval = sawparens(newNULLLIST()); }
+{ yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); }
break;
-case 108:
+case 107:
#line 429 "perly.y"
-{ yyval.opval = newANONLIST(yyvsp[-1].opval); }
+{ yyval.opval = sawparens(yyvsp[-1].opval); }
break;
-case 109:
+case 108:
#line 431 "perly.y"
-{ yyval.opval = newANONLIST(Nullop); }
+{ yyval.opval = sawparens(newNULLLIST()); }
break;
-case 110:
+case 109:
#line 433 "perly.y"
-{ yyval.opval = newANONHASH(yyvsp[-2].opval); }
+{ yyval.opval = newANONLIST(yyvsp[-1].opval); }
break;
-case 111:
+case 110:
#line 435 "perly.y"
-{ yyval.opval = newANONHASH(Nullop); }
+{ yyval.opval = newANONLIST(Nullop); }
break;
-case 112:
+case 111:
#line 437 "perly.y"
-{ yyval.opval = newANONSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); }
+{ yyval.opval = newANONHASH(yyvsp[-2].opval); }
break;
-case 113:
+case 112:
#line 439 "perly.y"
-{ yyval.opval = yyvsp[0].opval; }
+{ yyval.opval = newANONHASH(Nullop); }
break;
-case 114:
+case 113:
#line 441 "perly.y"
-{ yyval.opval = newBINOP(OP_GELEM, 0, newGVREF(0,yyvsp[-4].opval), yyvsp[-2].opval); }
+{ yyval.opval = newANONSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); }
break;
-case 115:
+case 114:
#line 443 "perly.y"
{ yyval.opval = yyvsp[0].opval; }
break;
-case 116:
+case 115:
#line 445 "perly.y"
-{ yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); }
+{ yyval.opval = newBINOP(OP_GELEM, 0, yyvsp[-4].opval, scalar(yyvsp[-2].opval)); }
break;
-case 117:
+case 116:
#line 447 "perly.y"
-{ yyval.opval = newBINOP(OP_AELEM, 0,
- ref(newAVREF(yyvsp[-4].opval),OP_RV2AV),
- scalar(yyvsp[-1].opval));}
+{ yyval.opval = yyvsp[0].opval; }
+break;
+case 117:
+#line 449 "perly.y"
+{ yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); }
break;
case 118:
#line 451 "perly.y"
-{ assertref(yyvsp[-3].opval); yyval.opval = newBINOP(OP_AELEM, 0,
- ref(newAVREF(yyvsp[-3].opval),OP_RV2AV),
+{ yyval.opval = newBINOP(OP_AELEM, 0,
+ ref(newAVREF(yyvsp[-4].opval),OP_RV2AV),
scalar(yyvsp[-1].opval));}
break;
case 119:
#line 455 "perly.y"
-{ yyval.opval = yyvsp[0].opval; }
+{ assertref(yyvsp[-3].opval); yyval.opval = newBINOP(OP_AELEM, 0,
+ ref(newAVREF(yyvsp[-3].opval),OP_RV2AV),
+ scalar(yyvsp[-1].opval));}
break;
case 120:
-#line 457 "perly.y"
+#line 459 "perly.y"
{ yyval.opval = yyvsp[0].opval; }
break;
case 121:
-#line 459 "perly.y"
-{ yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));}
+#line 461 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
break;
case 122:
-#line 461 "perly.y"
-{ yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval));
- expect = XOPERATOR; }
+#line 463 "perly.y"
+{ yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));}
break;
case 123:
-#line 464 "perly.y"
+#line 465 "perly.y"
+{ yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval));
+ PL_expect = XOPERATOR; }
+break;
+case 124:
+#line 468 "perly.y"
{ yyval.opval = newBINOP(OP_HELEM, 0,
ref(newHVREF(yyvsp[-5].opval),OP_RV2HV),
jmaybe(yyvsp[-2].opval));
- expect = XOPERATOR; }
+ PL_expect = XOPERATOR; }
break;
-case 124:
-#line 469 "perly.y"
+case 125:
+#line 473 "perly.y"
{ assertref(yyvsp[-4].opval); yyval.opval = newBINOP(OP_HELEM, 0,
ref(newHVREF(yyvsp[-4].opval),OP_RV2HV),
jmaybe(yyvsp[-2].opval));
- expect = XOPERATOR; }
+ PL_expect = XOPERATOR; }
break;
-case 125:
-#line 474 "perly.y"
+case 126:
+#line 478 "perly.y"
{ yyval.opval = newSLICEOP(0, yyvsp[-1].opval, yyvsp[-4].opval); }
break;
-case 126:
-#line 476 "perly.y"
+case 127:
+#line 480 "perly.y"
{ yyval.opval = newSLICEOP(0, yyvsp[-1].opval, Nullop); }
break;
-case 127:
-#line 478 "perly.y"
+case 128:
+#line 482 "perly.y"
{ yyval.opval = prepend_elem(OP_ASLICE,
newOP(OP_PUSHMARK, 0),
newLISTOP(OP_ASLICE, 0,
list(yyvsp[-1].opval),
ref(yyvsp[-3].opval, OP_ASLICE))); }
break;
-case 128:
-#line 484 "perly.y"
+case 129:
+#line 488 "perly.y"
{ yyval.opval = prepend_elem(OP_HSLICE,
newOP(OP_PUSHMARK, 0),
newLISTOP(OP_HSLICE, 0,
list(yyvsp[-2].opval),
ref(oopsHV(yyvsp[-4].opval), OP_HSLICE)));
- expect = XOPERATOR; }
+ PL_expect = XOPERATOR; }
break;
-case 129:
-#line 491 "perly.y"
+case 130:
+#line 495 "perly.y"
{ yyval.opval = yyvsp[0].opval; }
break;
-case 130:
-#line 493 "perly.y"
+case 131:
+#line 497 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); }
break;
-case 131:
-#line 495 "perly.y"
+case 132:
+#line 499 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[-2].opval)); }
break;
-case 132:
-#line 497 "perly.y"
+case 133:
+#line 501 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, yyvsp[-1].opval, scalar(yyvsp[-3].opval))); }
break;
-case 133:
-#line 500 "perly.y"
+case 134:
+#line 504 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
break;
-case 134:
-#line 503 "perly.y"
+case 135:
+#line 507 "perly.y"
{ yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); }
break;
-case 135:
-#line 505 "perly.y"
+case 136:
+#line 509 "perly.y"
{ yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); }
break;
-case 136:
-#line 507 "perly.y"
+case 137:
+#line 511 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB,
OPf_SPECIAL|OPf_STACKED,
prepend_elem(OP_LIST,
@@ -2118,8 +2127,8 @@ case 136:
scalar(yyvsp[-2].opval)
)),Nullop)); dep();}
break;
-case 137:
-#line 515 "perly.y"
+case 138:
+#line 519 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB,
OPf_SPECIAL|OPf_STACKED,
append_elem(OP_LIST,
@@ -2129,162 +2138,162 @@ case 137:
scalar(yyvsp[-3].opval)
)))); dep();}
break;
-case 138:
-#line 524 "perly.y"
+case 139:
+#line 528 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
prepend_elem(OP_LIST,
scalar(newCVREF(0,scalar(yyvsp[-2].opval))), Nullop)); dep();}
break;
-case 139:
-#line 528 "perly.y"
+case 140:
+#line 532 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
prepend_elem(OP_LIST,
yyvsp[-1].opval,
scalar(newCVREF(0,scalar(yyvsp[-3].opval))))); dep();}
break;
-case 140:
-#line 533 "perly.y"
+case 141:
+#line 537 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
newCVREF(0, scalar(yyvsp[-3].opval))); }
break;
-case 141:
-#line 536 "perly.y"
+case 142:
+#line 540 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, yyvsp[-1].opval,
newCVREF(0, scalar(yyvsp[-4].opval)))); }
break;
-case 142:
-#line 540 "perly.y"
-{ yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL);
- hints |= HINT_BLOCK_SCOPE; }
-break;
case 143:
-#line 543 "perly.y"
-{ yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); }
+#line 544 "perly.y"
+{ yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL);
+ PL_hints |= HINT_BLOCK_SCOPE; }
break;
case 144:
-#line 545 "perly.y"
-{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
+#line 547 "perly.y"
+{ yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); }
break;
case 145:
-#line 547 "perly.y"
-{ yyval.opval = newOP(yyvsp[0].ival, 0); }
+#line 549 "perly.y"
+{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
break;
case 146:
-#line 549 "perly.y"
-{ yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
+#line 551 "perly.y"
+{ yyval.opval = newOP(yyvsp[0].ival, 0); }
break;
case 147:
-#line 551 "perly.y"
+#line 553 "perly.y"
{ yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
break;
case 148:
-#line 553 "perly.y"
+#line 555 "perly.y"
+{ yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
+break;
+case 149:
+#line 557 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
break;
-case 149:
-#line 556 "perly.y"
+case 150:
+#line 560 "perly.y"
{ yyval.opval = newOP(yyvsp[0].ival, 0); }
break;
-case 150:
-#line 558 "perly.y"
+case 151:
+#line 562 "perly.y"
{ yyval.opval = newOP(yyvsp[-2].ival, 0); }
break;
-case 151:
-#line 560 "perly.y"
+case 152:
+#line 564 "perly.y"
{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
scalar(yyvsp[0].opval)); }
break;
-case 152:
-#line 563 "perly.y"
+case 153:
+#line 567 "perly.y"
{ yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); }
break;
-case 153:
-#line 565 "perly.y"
+case 154:
+#line 569 "perly.y"
{ yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); }
break;
-case 154:
-#line 567 "perly.y"
+case 155:
+#line 571 "perly.y"
{ yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); }
break;
-case 155:
-#line 569 "perly.y"
+case 156:
+#line 573 "perly.y"
{ yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); }
break;
-case 158:
-#line 575 "perly.y"
-{ yyval.opval = Nullop; }
-break;
case 159:
-#line 577 "perly.y"
-{ yyval.opval = yyvsp[0].opval; }
+#line 579 "perly.y"
+{ yyval.opval = Nullop; }
break;
case 160:
#line 581 "perly.y"
-{ yyval.opval = Nullop; }
+{ yyval.opval = yyvsp[0].opval; }
break;
case 161:
-#line 583 "perly.y"
-{ yyval.opval = yyvsp[0].opval; }
+#line 585 "perly.y"
+{ yyval.opval = Nullop; }
break;
case 162:
-#line 585 "perly.y"
-{ yyval.opval = yyvsp[-1].opval; }
+#line 587 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
break;
case 163:
-#line 588 "perly.y"
-{ yyval.ival = 0; }
+#line 589 "perly.y"
+{ yyval.opval = yyvsp[-1].opval; }
break;
case 164:
-#line 589 "perly.y"
-{ yyval.ival = 1; }
+#line 592 "perly.y"
+{ yyval.ival = 0; }
break;
case 165:
#line 593 "perly.y"
-{ in_my = 0; yyval.opval = my(yyvsp[0].opval); }
+{ yyval.ival = 1; }
break;
case 166:
#line 597 "perly.y"
-{ yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); }
+{ PL_in_my = 0; yyval.opval = my(yyvsp[0].opval); }
break;
case 167:
#line 601 "perly.y"
-{ yyval.opval = newSVREF(yyvsp[0].opval); }
+{ yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); }
break;
case 168:
#line 605 "perly.y"
-{ yyval.opval = newAVREF(yyvsp[0].opval); }
+{ yyval.opval = newSVREF(yyvsp[0].opval); }
break;
case 169:
#line 609 "perly.y"
-{ yyval.opval = newHVREF(yyvsp[0].opval); }
+{ yyval.opval = newAVREF(yyvsp[0].opval); }
break;
case 170:
#line 613 "perly.y"
-{ yyval.opval = newAVREF(yyvsp[0].opval); }
+{ yyval.opval = newHVREF(yyvsp[0].opval); }
break;
case 171:
#line 617 "perly.y"
-{ yyval.opval = newGVREF(0,yyvsp[0].opval); }
+{ yyval.opval = newAVREF(yyvsp[0].opval); }
break;
case 172:
#line 621 "perly.y"
-{ yyval.opval = scalar(yyvsp[0].opval); }
+{ yyval.opval = newGVREF(0,yyvsp[0].opval); }
break;
case 173:
-#line 623 "perly.y"
-{ yyval.opval = scalar(yyvsp[0].opval); }
+#line 625 "perly.y"
+{ yyval.opval = scalar(yyvsp[0].opval); }
break;
case 174:
-#line 625 "perly.y"
-{ yyval.opval = scope(yyvsp[0].opval); }
+#line 627 "perly.y"
+{ yyval.opval = scalar(yyvsp[0].opval); }
break;
case 175:
-#line 628 "perly.y"
+#line 629 "perly.y"
+{ yyval.opval = scope(yyvsp[0].opval); }
+break;
+case 176:
+#line 632 "perly.y"
{ yyval.opval = yyvsp[0].opval; }
break;
-#line 2271 "perly.c"
+#line 2266 "perly.c"
}
yyssp -= yym;
yystate = *yyssp;
diff --git a/gnu/usr.bin/perl/vms/sockadapt.h b/gnu/usr.bin/perl/vms/sockadapt.h
index 7f9150a5795..3e5daf37659 100644
--- a/gnu/usr.bin/perl/vms/sockadapt.h
+++ b/gnu/usr.bin/perl/vms/sockadapt.h
@@ -145,7 +145,6 @@ void endnetent();
#include <socket.h>
#include <in.h>
#include <inet.h>
-#include <netdb.h>
/* SocketShr doesn't support these routines, but the DECC RTL contains
* stubs with these names, designed to be used with the UCX socket
@@ -156,6 +155,8 @@ void endnetent();
#define getnetent no_getnetent
#define setnetent no_setnetent
#define endnetent no_endnetent
+
+#include <netdb.h>
#endif
/* We don't have these two in the system headers. */
diff --git a/gnu/usr.bin/perl/vms/test.com b/gnu/usr.bin/perl/vms/test.com
index 114cb24a405..0e507dd2740 100644
--- a/gnu/usr.bin/perl/vms/test.com
+++ b/gnu/usr.bin/perl/vms/test.com
@@ -21,8 +21,17 @@ $ EndIf
$ EndIf
$ Set Message /Facility/Severity/Identification/Text
$
-$ exe = ".Exe"
-$ If p1.nes."" Then exe = p1
+$ exe = ".Exe"
+$ If p1.nes."" Then exe = p1
+$ If F$Extract(0,1,exe) .nes. "."
+$ Then
+$ Write Sys$Error ""
+$ Write Sys$Error "The first parameter passed to Test.Com must be the file type used for the"
+$ Write Sys$Error "images produced when you built Perl (i.e. "".Exe"", unless you edited"
+$ Write Sys$Error "Descrip.MMS or used the AXE=1 macro in the MM[SK] command line."
+$ Write Sys$Error ""
+$ Exit 44
+$ EndIf
$! Pick up a copy of perl to use for the tests
$ Delete/Log/NoConfirm Perl.;*
$ Copy/Log/NoConfirm [-]Perl'exe' []Perl.
@@ -74,6 +83,7 @@ $ Delete/Log/NoConfirm Echo.Obj;*
$ echo = "$" + F$Parse("Echo.Exe")
$
$! And do it
+$ Show Process/Accounting
$ testdir = "Directory/NoHead/NoTrail/Column=1"
$ Define/User Perlshr Sys$Disk:[-]PerlShr'exe'
$ MCR Sys$Disk:[]Perl. "-I[-.lib]" - "''p2'" "''p3'" "''p4'" "''p5'" "''p6'"
@@ -90,11 +100,10 @@ $ Deck/Dollar=$$END-OF-TEST$$
use Config;
@compexcl=('cpp.t');
-@ioexcl=('argv.t','dup.t','fs.t','inplace.t','pipe.t');
-@libexcl=('anydbm.t','db-btree.t','db-hash.t','db-recno.t',
+@ioexcl=('argv.t','dup.t','fs.t','pipe.t');
+@libexcl=('db-btree.t','db-hash.t','db-recno.t',
'gdbm.t','io_dup.t', 'io_pipe.t', 'io_sel.t', 'io_sock.t',
- 'ndbm.t','odbm.t','open2.t','open3.t','posix.t',
- 'sdbm.t');
+ 'ndbm.t','odbm.t','open2.t','open3.t', 'ph.t', 'posix.t');
# Note: POSIX is not part of basic build, but can be built
# separately if you're using DECC
@@ -103,7 +112,7 @@ use Config;
# insists on stat()ing a file descriptor before it'll use it.
push(@libexcl,'io_xs.t') if $Config{'vms_cc_type'} ne 'decc';
-@opexcl=('exec.t','fork.t','glob.t','groups.t','magic.t','misc.t','stat.t');
+@opexcl=('die_exit.t','exec.t','fork.t','glob.t','groups.t','magic.t','misc.t','stat.t');
@exclist=(@compexcl,@ioexcl,@libexcl,@opexcl);
foreach $file (@exclist) { $skip{$file}++; }
@@ -111,7 +120,7 @@ $| = 1;
@ARGV = grep($_,@ARGV); # remove empty elements due to "''p1'" syntax
-if ($ARGV[0] eq '-v') {
+if (lc($ARGV[0]) eq '-v') {
$verbose = 1;
shift;
}
@@ -153,7 +162,7 @@ while ($test = shift) {
} else {
$switch = '';
}
- open(results,"\$ MCR Sys\$Disk:[]Perl. $switch $test |") || (print "can't run.\n");
+ open(results,"\$ MCR Sys\$Disk:[]Perl. \"-I[-.lib]\" $switch $test |") || (print "can't run.\n");
$ok = 0;
$next = 0;
while (<results>) {
@@ -218,6 +227,7 @@ print sprintf("u=%g s=%g cu=%g cs=%g files=%d tests=%d\n",
$user,$sys,$cuser,$csys,$files,$totmax);
$$END-OF-TEST$$
$ wrapup:
+$ Show Process/Accounting
$ If F$Search("Echo.Exe").nes."" Then Delete/Log/NoConfirm Echo.Exe;*
$ Set Default &olddef
$ Set Message 'oldmsg'
diff --git a/gnu/usr.bin/perl/vms/vms.c b/gnu/usr.bin/perl/vms/vms.c
index f22579066d0..37f9587dc75 100644
--- a/gnu/usr.bin/perl/vms/vms.c
+++ b/gnu/usr.bin/perl/vms/vms.c
@@ -2,8 +2,8 @@
*
* VMS-specific routines for perl5
*
- * Last revised: 11-Apr-1997 by Charles Bailey bailey@genetics.upenn.edu
- * Version: 5.3.97c
+ * Last revised: 27-Feb-1998 by Charles Bailey bailey@newman.upenn.edu
+ * Version: 5.4.61
*/
#include <acedef.h>
@@ -11,6 +11,7 @@
#include <armdef.h>
#include <atrdef.h>
#include <chpdef.h>
+#include <clidef.h>
#include <climsgdef.h>
#include <descrip.h>
#include <dvidef.h>
@@ -19,6 +20,7 @@
#include <fscndef.h>
#include <iodef.h>
#include <jpidef.h>
+#include <kgbdef.h>
#include <libdef.h>
#include <lib$routines.h>
#include <lnmdef.h>
@@ -113,37 +115,48 @@ my_trnlnm(char *lnm, char *eqv, unsigned long int idx)
* domain (mostly - my_getenv() need not return a translation from
* the process logical name table)
*
- * Note: Uses static buffer -- not thread-safe!
+ * Note: Uses Perl temp to store result so char * can be returned to
+ * caller; this pointer will be invalidated at next Perl statement
+ * transition.
*/
/*{{{ char *my_getenv(char *lnm)*/
char *
my_getenv(char *lnm)
{
static char __my_getenv_eqv[LNM$C_NAMLENGTH+1];
- char uplnm[LNM$C_NAMLENGTH+1], *cp1, *cp2;
+ char uplnm[LNM$C_NAMLENGTH+1], *cp1, *cp2, *eqv;
unsigned long int idx = 0;
int trnsuccess;
-
+ SV *tmpsv;
+
+ if (PL_curinterp) { /* Perl interpreter running -- may be threaded */
+ /* Set up a temporary buffer for the return value; Perl will
+ * clean it up at the next statement transition */
+ tmpsv = sv_2mortal(newSVpv("",LNM$C_NAMLENGTH+1));
+ if (!tmpsv) return NULL;
+ eqv = SvPVX(tmpsv);
+ }
+ else eqv = __my_getenv_eqv; /* Assume no interpreter ==> single thread */
for (cp1 = lnm, cp2= uplnm; *cp1; cp1++, cp2++) *cp2 = _toupper(*cp1);
*cp2 = '\0';
if (cp1 - lnm == 7 && !strncmp(uplnm,"DEFAULT",7)) {
- getcwd(__my_getenv_eqv,sizeof __my_getenv_eqv);
- return __my_getenv_eqv;
+ getcwd(eqv,LNM$C_NAMLENGTH);
+ return eqv;
}
else {
if ((cp2 = strchr(uplnm,';')) != NULL) {
*cp2 = '\0';
idx = strtoul(cp2+1,NULL,0);
}
- trnsuccess = my_trnlnm(uplnm,__my_getenv_eqv,idx);
+ trnsuccess = my_trnlnm(uplnm,eqv,idx);
/* If we had a translation index, we're only interested in lnms */
if (!trnsuccess && cp2 != NULL) return Nullch;
- if (trnsuccess) return __my_getenv_eqv;
+ if (trnsuccess) return eqv;
else {
unsigned long int retsts;
struct dsc$descriptor_s symdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0},
- valdsc = {sizeof __my_getenv_eqv,DSC$K_DTYPE_T,
- DSC$K_CLASS_S, __my_getenv_eqv};
+ valdsc = {LNM$C_NAMLENGTH,DSC$K_DTYPE_T,
+ DSC$K_CLASS_S, eqv};
symdsc.dsc$w_length = cp1 - lnm;
symdsc.dsc$a_pointer = uplnm;
retsts = lib$get_symbol(&symdsc,&valdsc,&(valdsc.dsc$w_length),0);
@@ -162,7 +175,9 @@ my_getenv(char *lnm)
} /* end of my_getenv() */
/*}}}*/
-static FILE *safe_popen(char *, char *);
+static void create_mbx(unsigned short int *, struct dsc$descriptor_s *);
+
+static void riseandshine(unsigned long int dummy) { sys$wake(0,0); }
/*{{{ void prime_env_iter() */
void
@@ -171,37 +186,81 @@ prime_env_iter(void)
* find, in preparation for iterating over it.
*/
{
- static int primed = 0; /* XXX Not thread-safe!!! */
- HV *envhv = GvHVn(envgv);
- FILE *sholog;
- char eqv[LNM$C_NAMLENGTH+1],*start,*end;
+ dTHR;
+ static int primed = 0;
+ HV *envhv = GvHVn(PL_envgv);
+ PerlIO *sholog;
+ char eqv[LNM$C_NAMLENGTH+1],mbxnam[LNM$C_NAMLENGTH+1],*start,*end;
+ unsigned short int chan;
+#ifndef CLI$M_TRUSTED
+# define CLI$M_TRUSTED 0x40 /* Missing from VAXC headers */
+#endif
+ unsigned long int flags = CLI$M_NOWAIT | CLI$M_NOCLISYM | CLI$M_NOKEYPAD | CLI$M_TRUSTED;
+ unsigned long int i, retsts, substs = 0, wakect = 0;
STRLEN eqvlen;
SV *oldrs, *linesv, *eqvsv;
+ $DESCRIPTOR(cmddsc,"Show Logical *"); $DESCRIPTOR(nldsc,"_NLA0:");
+ $DESCRIPTOR(clidsc,"DCL"); $DESCRIPTOR(tabdsc,"DCLTABLES");
+ $DESCRIPTOR(mbxdsc,mbxnam);
+#ifdef USE_THREADS
+ static perl_mutex primenv_mutex;
+ MUTEX_INIT(&primenv_mutex);
+#endif
if (primed) return;
+ MUTEX_LOCK(&primenv_mutex);
+ if (primed) { MUTEX_UNLOCK(&primenv_mutex); return; }
/* Perform a dummy fetch as an lval to insure that the hash table is
- * set up. Otherwise, the hv_store() will turn into a nullop */
+ * set up. Otherwise, the hv_store() will turn into a nullop. */
(void) hv_fetch(envhv,"DEFAULT",7,TRUE);
- /* Also, set up the four "special" keys that the CRTL defines,
- * whether or not underlying logical names exist. */
- (void) hv_fetch(envhv,"HOME",4,TRUE);
- (void) hv_fetch(envhv,"TERM",4,TRUE);
- (void) hv_fetch(envhv,"PATH",4,TRUE);
- (void) hv_fetch(envhv,"USER",4,TRUE);
+ /* Also, set up any "special" keys that the CRTL defines,
+ * either by itself or becasue we were called from a C program
+ * using exec[lv]e() */
+ for (i = 0; environ[i]; i++) {
+ if (!(start = strchr(environ[i],'='))) {
+ warn("Ill-formed CRTL environ value \"%s\"\n",environ[i]);
+ }
+ else {
+ start++;
+ (void) hv_store(envhv,environ[i],start - environ[i] - 1,newSVpv(start,0),0);
+ }
+ }
/* Now, go get the logical names */
- if ((sholog = safe_popen("$ Show Logical *","r")) == Nullfp)
- _ckvmssts(vaxc$errno);
- /* We use Perl's sv_gets to read from the pipe, since safe_popen is
+ create_mbx(&chan,&mbxdsc);
+ if ((sholog = PerlIO_open(mbxnam,"r")) != Nullfp) {
+ if ((retsts = sys$dassgn(chan)) & 1) {
+ /* Be certain that subprocess is using the CLI and command tables we
+ * expect, and don't pass symbols through so that we insure that
+ * "Show Logical" can't be subverted.
+ */
+ do {
+ retsts = lib$spawn(&cmddsc,&nldsc,&mbxdsc,&flags,0,0,&substs,
+ 0,&riseandshine,0,0,&clidsc,&tabdsc);
+ flags &= ~CLI$M_TRUSTED; /* Just in case we hit a really old version */
+ } while (retsts == LIB$_INVARG && (flags | CLI$M_TRUSTED));
+ }
+ }
+ if (sholog == Nullfp || !(retsts & 1)) {
+ if (sholog != Nullfp) PerlIO_close(sholog);
+ MUTEX_UNLOCK(&primenv_mutex);
+ _ckvmssts(sholog == Nullfp ? vaxc$errno : retsts);
+ }
+ /* We use Perl's sv_gets to read from the pipe, since PerlIO_open is
* tied to Perl's I/O layer, so it may not return a simple FILE * */
- oldrs = rs;
- rs = newSVpv("\n",1);
+ oldrs = PL_rs;
+ PL_rs = newSVpv("\n",1);
linesv = newSVpv("",0);
while (1) {
if ((start = sv_gets(linesv,sholog,0)) == Nullch) {
- my_pclose(sholog);
- SvREFCNT_dec(linesv); SvREFCNT_dec(rs); rs = oldrs;
+ PerlIO_close(sholog);
+ SvREFCNT_dec(linesv); SvREFCNT_dec(PL_rs); PL_rs = oldrs;
primed = 1;
+ /* Wait for subprocess to clean up (we know subproc won't return 0) */
+ while (substs == 0) { sys$hiber(); wakect++;}
+ if (wakect > 1) sys$wake(0,0); /* Stole someone else's wake */
+ _ckvmssts(substs);
+ MUTEX_UNLOCK(&primenv_mutex);
return;
}
while (*start != '"' && *start != '=' && *start) start++;
@@ -211,11 +270,11 @@ prime_env_iter(void)
else end = Nullch;
if ((eqvlen = my_trnlnm(start,eqv,0)) == 0) {
if (vaxc$errno == SS$_NOLOGNAM || vaxc$errno == SS$_IVLOGNAM) {
- if (dowarn)
+ if (PL_dowarn)
warn("Ill-formed logical name |%s| in prime_env_iter",start);
continue;
}
- else _ckvmssts(vaxc$errno);
+ else { MUTEX_UNLOCK(&primenv_mutex); _ckvmssts(vaxc$errno); }
}
else {
eqvsv = newSVpv(eqv,eqvlen);
@@ -335,7 +394,7 @@ do_rmdir(char *name)
{
char dirfile[NAM$C_MAXRSS+1];
int retval;
- struct mystat st;
+ Stat_t st;
if (do_fileify_dirspec(name,dirfile,0) == NULL) return -1;
if (flex_stat(dirfile,&st) || !S_ISDIR(st.st_mode)) retval = -1;
@@ -557,7 +616,7 @@ popen_completion_ast(struct pipe_details *thispipe)
}
}
-static FILE *
+static PerlIO *
safe_popen(char *cmd, char *mode)
{
static int handler_set_up = FALSE;
@@ -614,7 +673,7 @@ safe_popen(char *cmd, char *mode)
info->next=open_pipes; /* prepend to list */
open_pipes=info;
- forkprocess = info->pid;
+ PL_forkprocess = info->pid;
return info->fp;
} /* end of safe_popen */
@@ -653,7 +712,7 @@ I32 my_pclose(FILE *fp)
unsigned long int chan, iosb[2], retsts, retsts2;
struct dsc$descriptor devdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, devnam};
- if (fgetname(info->fp,devnam)) {
+ if (fgetname(info->fp,devnam,1)) {
/* It oughta be a mailbox, so fgetname should give just the device
* name, but just in case . . . */
if ((cp = strrchr(devnam,':')) != NULL) *(cp+1) = '\0';
@@ -705,11 +764,11 @@ my_waitpid(Pid_t pid, int *statusp, int flags)
unsigned long int ownercode = JPI$_OWNER, ownerpid, mypid;
unsigned long int interval[2],sts;
- if (dowarn) {
+ if (PL_dowarn) {
_ckvmssts(lib$getjpi(&ownercode,&pid,0,&ownerpid,0,0));
_ckvmssts(lib$getjpi(&ownercode,0,0,&mypid,0,0));
if (ownerpid != mypid)
- warn("pid %d not a child",pid);
+ warn("pid %x not a child",pid);
}
_ckvmssts(sys$bintim(&intdsc,interval));
@@ -820,12 +879,14 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts)
retsts = sys$parse(&myfab,0,0);
if (!(retsts & 1)) {
+ mynam.nam$b_nop |= NAM$M_SYNCHK;
if (retsts == RMS$_DNF || retsts == RMS$_DIR ||
retsts == RMS$_DEV || retsts == RMS$_DEV) {
- mynam.nam$b_nop |= NAM$M_SYNCHK;
retsts = sys$parse(&myfab,0,0);
if (retsts & 1) goto expanded;
}
+ mynam.nam$l_rlf = NULL; myfab.fab$b_dns = 0;
+ (void) sys$parse(&myfab,0,0); /* Free search context */
if (out) Safefree(out);
set_vaxc_errno(retsts);
if (retsts == RMS$_PRV) set_errno(EACCES);
@@ -836,6 +897,8 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts)
}
retsts = sys$search(&myfab,0,0);
if (!(retsts & 1) && retsts != RMS$_FNF) {
+ mynam.nam$b_nop |= NAM$M_SYNCHK; mynam.nam$l_rlf = NULL;
+ myfab.fab$b_dns = 0; (void) sys$parse(&myfab,0,0); /* Free search context */
if (out) Safefree(out);
set_vaxc_errno(retsts);
if (retsts == RMS$_PRV) set_errno(EACCES);
@@ -853,6 +916,10 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts)
if (!(mynam.nam$l_fnb & NAM$M_EXP_VER) &&
(!defspec || !*defspec || !strchr(myfab.fab$l_dna,';')))
speclen = mynam.nam$l_ver - out;
+ if (!(mynam.nam$l_fnb & NAM$M_EXP_TYPE) &&
+ (!defspec || !*defspec || defspec[myfab.fab$b_dns-1] != '.' ||
+ defspec[myfab.fab$b_dns-2] == '.'))
+ speclen = mynam.nam$l_type - out;
/* If we just had a directory spec on input, $PARSE "helpfully"
* adds an empty name and type for us */
if (mynam.nam$l_name == mynam.nam$l_type &&
@@ -874,6 +941,9 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts)
if (do_tounixspec(outbuf,tmpfspec,0) == NULL) return NULL;
strcpy(outbuf,tmpfspec);
}
+ mynam.nam$b_nop |= NAM$M_SYNCHK; mynam.nam$l_rlf = NULL;
+ mynam.nam$l_rsa = NULL; mynam.nam$b_rss = 0;
+ myfab.fab$b_dns = 0; (void) sys$parse(&myfab,0,0); /* Free search context */
return outbuf;
}
/*}}}*/
@@ -911,7 +981,7 @@ char *rmsexpand_ts(char *spec, char *buf, char *def, unsigned opt)
** tounixspec() - convert any file spec into a Unix-style file spec.
** tovmsspec() - convert any file spec into a VMS-style spec.
**
-** Copyright 1996 by Charles Bailey <bailey@genetics.upenn.edu>
+** Copyright 1996 by Charles Bailey <bailey@newman.upenn.edu>
** Permission is given to distribute this code as part of the Perl
** standard distribution under the terms of the GNU General Public
** License or the Perl Artistic License. Copies of each may be
@@ -924,17 +994,20 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts)
static char __fileify_retbuf[NAM$C_MAXRSS+1];
unsigned long int dirlen, retlen, addmfd = 0, hasfilename = 0;
char *retspec, *cp1, *cp2, *lastdir;
- char trndir[NAM$C_MAXRSS+1], vmsdir[NAM$C_MAXRSS+1];
+ char trndir[NAM$C_MAXRSS+2], vmsdir[NAM$C_MAXRSS+1];
if (!dir || !*dir) {
set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL;
}
dirlen = strlen(dir);
- if (dir[dirlen-1] == '/') --dirlen;
- if (!dirlen) {
- set_errno(ENOTDIR);
- set_vaxc_errno(RMS$_DIR);
- return NULL;
+ while (dir[dirlen-1] == '/') --dirlen;
+ if (!dirlen) { /* We had Unixish '/' -- substitute top of current tree */
+ strcpy(trndir,"/sys$disk/000000");
+ dir = trndir;
+ dirlen = 16;
+ }
+ if (dirlen > NAM$C_MAXRSS) {
+ set_errno(ENAMETOOLONG); set_vaxc_errno(RMS$_SYN); return NULL;
}
if (!strpbrk(dir+1,"/]>:")) {
strcpy(trndir,*dir == '/' ? dir + 1: dir);
@@ -995,11 +1068,28 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts)
if (*(cp1+2) == '.') cp1++;
if (*(cp1+2) == '/' || *(cp1+2) == '\0') {
if (do_tovmsspec(dir,vmsdir,0) == NULL) return NULL;
+ if (strchr(vmsdir,'/') != NULL) {
+ /* If do_tovmsspec() returned it, it must have VMS syntax
+ * delimiters in it, so it's a mixed VMS/Unix spec. We take
+ * the time to check this here only so we avoid a recursion
+ * loop; otherwise, gigo.
+ */
+ set_errno(EINVAL); set_vaxc_errno(RMS$_SYN); return NULL;
+ }
if (do_fileify_dirspec(vmsdir,trndir,0) == NULL) return NULL;
return do_tounixspec(trndir,buf,ts);
}
cp1++;
} while ((cp1 = strstr(cp1,"/.")) != NULL);
+ lastdir = strrchr(dir,'/');
+ }
+ else if (!strcmp(&dir[dirlen-7],"/000000")) {
+ /* Ditto for specs that end in an MFD -- let the VMS code
+ * figure out whether it's a real device or a rooted logical. */
+ dir[dirlen] = '/'; dir[dirlen+1] = '\0';
+ if (do_tovmsspec(dir,vmsdir,0) == NULL) return NULL;
+ if (do_fileify_dirspec(vmsdir,trndir,0) == NULL) return NULL;
+ return do_tounixspec(trndir,buf,ts);
}
else {
if ( !(lastdir = cp1 = strrchr(dir,'/')) &&
@@ -1544,6 +1634,11 @@ static char *do_tovmsspec(char *path, char *buf, int ts) {
STRLEN trnend;
while (*(cp2+1) == '/') cp2++; /* Skip multiple /s */
+ if (!*(cp2+1)) {
+ if (!buf & ts) Renew(rslt,18,char);
+ strcpy(rslt,"sys$disk:[000000]");
+ return rslt;
+ }
while (*(++cp2) != '/' && *cp2) *(cp1++) = *cp2;
*cp1 = '\0';
islnm = my_trnlnm(rslt,trndev,0);
@@ -1720,7 +1815,7 @@ char *tounixpath_ts(char *path, char *buf) { return do_tounixpath(path,buf,1); }
* gain. *
* *
* 27-Aug-1994 Modified for inclusion in perl5 *
- * by Charles Bailey bailey@genetics.upenn.edu *
+ * by Charles Bailey bailey@newman.upenn.edu *
*****************************************************************************
*/
@@ -2223,27 +2318,83 @@ unsigned long int flags = 17, one = 1, retsts;
/* OS-specific initialization at image activation (not thread startup) */
+/* Older VAXC header files lack these constants */
+#ifndef JPI$_RIGHTS_SIZE
+# define JPI$_RIGHTS_SIZE 817
+#endif
+#ifndef KGB$M_SUBSYSTEM
+# define KGB$M_SUBSYSTEM 0x8
+#endif
+
/*{{{void vms_image_init(int *, char ***)*/
void
vms_image_init(int *argcp, char ***argvp)
{
- unsigned long int *mask, iosb[2], i;
- unsigned short int dummy;
- union prvdef iprv;
- struct itmlst_3 jpilist[2] = { {sizeof iprv, JPI$_IMAGPRIV, &iprv, &dummy},
- { 0, 0, 0, 0} };
+ unsigned long int *mask, iosb[2], i, rlst[128], rsz, add_taint = FALSE;
+ unsigned long int iprv[(sizeof(union prvdef) + sizeof(unsigned long int) - 1) / sizeof(unsigned long int)];
+ unsigned short int dummy, rlen;
+ struct itmlst_3 jpilist[4] = { {sizeof iprv, JPI$_IMAGPRIV, iprv, &dummy},
+ {sizeof rlst, JPI$_RIGHTSLIST, rlst, &rlen},
+ { sizeof rsz, JPI$_RIGHTS_SIZE, &rsz, &dummy},
+ { 0, 0, 0, 0} };
_ckvmssts(sys$getjpiw(0,NULL,NULL,jpilist,iosb,NULL,NULL));
_ckvmssts(iosb[0]);
- mask = (unsigned long int *) &iprv; /* Quick change of view */;
- for (i = 0; i < (sizeof iprv + sizeof(unsigned long int) - 1) / sizeof(unsigned long int); i++) {
- if (mask[i]) { /* Running image installed with privs? */
- _ckvmssts(sys$setprv(0,&iprv,0,NULL)); /* Turn 'em off. */
- tainting = TRUE;
+ for (i = 0; i < sizeof iprv / sizeof(unsigned long int); i++) {
+ if (iprv[i]) { /* Running image installed with privs? */
+ _ckvmssts(sys$setprv(0,iprv,0,NULL)); /* Turn 'em off. */
+ add_taint = TRUE;
break;
}
}
+ /* Rights identifiers might trigger tainting as well. */
+ if (!add_taint && (rlen || rsz)) {
+ while (rlen < rsz) {
+ /* We didn't get all the identifiers on the first pass. Allocate a
+ * buffer much larger than $GETJPI wants (rsz is size in bytes that
+ * were needed to hold all identifiers at time of last call; we'll
+ * allocate that many unsigned long ints), and go back and get 'em.
+ */
+ if (jpilist[1].bufadr != rlst) Safefree(jpilist[1].bufadr);
+ jpilist[1].bufadr = New(1320,mask,rsz,unsigned long int);
+ jpilist[1].buflen = rsz * sizeof(unsigned long int);
+ _ckvmssts(sys$getjpiw(0,NULL,NULL,&jpilist[1],iosb,NULL,NULL));
+ _ckvmssts(iosb[0]);
+ }
+ mask = jpilist[1].bufadr;
+ /* Check attribute flags for each identifier (2nd longword); protected
+ * subsystem identifiers trigger tainting.
+ */
+ for (i = 1; i < (rlen + sizeof(unsigned long int) - 1) / sizeof(unsigned long int); i += 2) {
+ if (mask[i] & KGB$M_SUBSYSTEM) {
+ add_taint = TRUE;
+ break;
+ }
+ }
+ if (mask != rlst) Safefree(mask);
+ }
+ /* We need to use this hack to tell Perl it should run with tainting,
+ * since its tainting flag may be part of the PL_curinterp struct, which
+ * hasn't been allocated when vms_image_init() is called.
+ */
+ if (add_taint) {
+ char ***newap;
+ New(1320,newap,*argcp+2,char **);
+ newap[0] = argvp[0];
+ *newap[1] = "-T";
+ Copy(argvp[1],newap[2],*argcp-1,char **);
+ /* We orphan the old argv, since we don't know where it's come from,
+ * so we don't know how to free it.
+ */
+ *argcp++; argvp = newap;
+ }
getredirection(argcp,argvp);
+#if defined(USE_THREADS) && defined(__DECC)
+ {
+# include <reentrancy.h>
+ (void) decc$set_reentrancy(C$C_MULTITHREAD);
+ }
+#endif
return;
}
/*}}}*/
@@ -2340,7 +2491,7 @@ trim_unixpath(char *fspec, char *wildspec, int opts)
for (front = end ; front >= base; front--)
if (*front == '/' && !dirs--) { front++; break; }
}
- for (cp1=template,cp2=lcres; *cp1 && cp2 <= lcend + sizeof lcend;
+ for (cp1=template,cp2=lcres; *cp1 && cp2 <= lcres + sizeof lcres;
cp1++,cp2++) *cp2 = _tolower(*cp1); /* Make lc copy for match */
if (cp1 != '\0') return 0; /* Path too long. */
lcend = cp2;
@@ -2413,7 +2564,7 @@ trim_unixpath(char *fspec, char *wildspec, int opts)
* VMS readdir() routines.
* Written by Rich $alz, <rsalz@bbn.com> in August, 1990.
*
- * 21-Jul-1994 Charles Bailey bailey@genetics.upenn.edu
+ * 21-Jul-1994 Charles Bailey bailey@newman.upenn.edu
* Minor modifications to original routines.
*/
@@ -2429,13 +2580,22 @@ opendir(char *name)
{
DIR *dd;
char dir[NAM$C_MAXRSS+1];
-
- /* Get memory for the handle, and the pattern. */
- New(1306,dd,1,DIR);
+ Stat_t sb;
+
if (do_tovmspath(name,dir,0) == NULL) {
- Safefree((char *)dd);
- return(NULL);
+ return NULL;
}
+ if (flex_stat(dir,&sb) == -1) return NULL;
+ if (!S_ISDIR(sb.st_mode)) {
+ set_errno(ENOTDIR); set_vaxc_errno(RMS$_DIR);
+ return NULL;
+ }
+ if (!cando_by_name(S_IRUSR,0,dir)) {
+ set_errno(EACCES); set_vaxc_errno(RMS$_PRV);
+ return NULL;
+ }
+ /* Get memory for the handle, and the pattern. */
+ New(1306,dd,1,DIR);
New(1307,dd->pattern,strlen(dir)+sizeof "*.*" + 1,char);
/* Fill in the fields; mainly playing with the descriptor. */
@@ -2669,9 +2829,9 @@ static struct dsc$descriptor_s VMScmd = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,Nullch};
static void
vms_execfree() {
- if (Cmd) {
- Safefree(Cmd);
- Cmd = Nullch;
+ if (PL_Cmd) {
+ Safefree(PL_Cmd);
+ PL_Cmd = Nullch;
}
if (VMScmd.dsc$a_pointer) {
Safefree(VMScmd.dsc$a_pointer);
@@ -2683,10 +2843,12 @@ vms_execfree() {
static char *
setup_argstr(SV *really, SV **mark, SV **sp)
{
+ dTHR;
char *junk, *tmps = Nullch;
register size_t cmdlen = 0;
size_t rlen;
register SV **idx;
+ STRLEN n_a;
idx = mark;
if (really) {
@@ -2703,20 +2865,20 @@ setup_argstr(SV *really, SV **mark, SV **sp)
cmdlen += rlen ? rlen + 1 : 0;
}
}
- New(401,Cmd,cmdlen+1,char);
+ New(401,PL_Cmd,cmdlen+1,char);
if (tmps && *tmps) {
- strcpy(Cmd,tmps);
+ strcpy(PL_Cmd,tmps);
mark++;
}
- else *Cmd = '\0';
+ else *PL_Cmd = '\0';
while (++mark <= sp) {
if (*mark) {
- strcat(Cmd," ");
- strcat(Cmd,SvPVx(*mark,na));
+ strcat(PL_Cmd," ");
+ strcat(PL_Cmd,SvPVx(*mark,n_a));
}
}
- return Cmd;
+ return PL_Cmd;
} /* end of setup_argstr() */
@@ -2748,9 +2910,9 @@ setup_cmddsc(char *cmd, int check_img)
else isdcl = 1;
if (isdcl) { /* It's a DCL command, just do it. */
VMScmd.dsc$w_length = strlen(cmd);
- if (cmd == Cmd) {
- VMScmd.dsc$a_pointer = Cmd;
- Cmd = Nullch; /* Don't try to free twice in vms_execfree() */
+ if (cmd == PL_Cmd) {
+ VMScmd.dsc$a_pointer = PL_Cmd;
+ PL_Cmd = Nullch; /* Don't try to free twice in vms_execfree() */
}
else VMScmd.dsc$a_pointer = savepvn(cmd,VMScmd.dsc$w_length);
}
@@ -2773,6 +2935,7 @@ setup_cmddsc(char *cmd, int check_img)
s = resspec;
while (*s && !isspace(*s)) s++;
*s = '\0';
+ if (!cando_by_name(S_IXUSR,0,resspec)) return RMS$_PRV;
New(402,VMScmd.dsc$a_pointer,7 + s - resspec + (rest ? strlen(rest) : 0),char);
strcpy(VMScmd.dsc$a_pointer,"$ MCR ");
strcat(VMScmd.dsc$a_pointer,resspec);
@@ -2790,6 +2953,7 @@ setup_cmddsc(char *cmd, int check_img)
bool
vms_do_aexec(SV *really,SV **mark,SV **sp)
{
+ dTHR;
if (sp > mark) {
if (vfork_called) { /* this follows a vfork - act Unixish */
vfork_called--;
@@ -2830,9 +2994,24 @@ vms_do_exec(char *cmd)
if ((retsts = setup_cmddsc(cmd,1)) & 1)
retsts = lib$do_command(&VMScmd);
- set_errno(EVMSERR);
+ switch (retsts) {
+ case RMS$_FNF:
+ set_errno(ENOENT); break;
+ case RMS$_DNF: case RMS$_DIR: case RMS$_DEV:
+ set_errno(ENOTDIR); break;
+ case RMS$_PRV:
+ set_errno(EACCES); break;
+ case RMS$_SYN:
+ set_errno(EINVAL); break;
+ case CLI$_BUFOVF:
+ set_errno(E2BIG); break;
+ case LIB$_INVARG: case LIB$_INVSTRDES: case SS$_ACCVIO: /* shouldn't happen */
+ _ckvmssts(retsts); /* fall through */
+ default: /* SS$_DUPLNAM, SS$_CLI, resource exhaustion, etc. */
+ set_errno(EVMSERR);
+ }
set_vaxc_errno(retsts);
- if (dowarn)
+ if (PL_dowarn)
warn("Can't exec \"%s\": %s", VMScmd.dsc$a_pointer, Strerror(errno));
vms_execfree();
}
@@ -2844,11 +3023,12 @@ vms_do_exec(char *cmd)
unsigned long int do_spawn(char *);
-/* {{{ unsigned long int do_aspawn(SV *really,SV **mark,SV **sp) */
+/* {{{ unsigned long int do_aspawn(void *really,void **mark,void **sp) */
unsigned long int
-do_aspawn(SV *really,SV **mark,SV **sp)
+do_aspawn(void *really,void **mark,void **sp)
{
- if (sp > mark) return do_spawn(setup_argstr(really,mark,sp));
+ dTHR;
+ if (sp > mark) return do_spawn(setup_argstr((SV *)really,(SV **)mark,(SV **)sp));
return SS$_ABORT;
} /* end of do_aspawn() */
@@ -2858,22 +3038,37 @@ do_aspawn(SV *really,SV **mark,SV **sp)
unsigned long int
do_spawn(char *cmd)
{
- unsigned long int substs, hadcmd = 1;
+ unsigned long int sts, substs, hadcmd = 1;
TAINT_ENV();
TAINT_PROPER("spawn");
if (!cmd || !*cmd) {
hadcmd = 0;
- _ckvmssts(lib$spawn(0,0,0,0,0,0,&substs,0,0,0,0,0,0));
+ sts = lib$spawn(0,0,0,0,0,0,&substs,0,0,0,0,0,0);
}
- else if ((substs = setup_cmddsc(cmd,0)) & 1) {
- _ckvmssts(lib$spawn(&VMScmd,0,0,0,0,0,&substs,0,0,0,0,0,0));
+ else if ((sts = setup_cmddsc(cmd,0)) & 1) {
+ sts = lib$spawn(&VMScmd,0,0,0,0,0,&substs,0,0,0,0,0,0);
}
- if (!(substs&1)) {
- set_errno(EVMSERR);
- set_vaxc_errno(substs);
- if (dowarn)
+ if (!(sts & 1)) {
+ switch (sts) {
+ case RMS$_FNF:
+ set_errno(ENOENT); break;
+ case RMS$_DNF: case RMS$_DIR: case RMS$_DEV:
+ set_errno(ENOTDIR); break;
+ case RMS$_PRV:
+ set_errno(EACCES); break;
+ case RMS$_SYN:
+ set_errno(EINVAL); break;
+ case CLI$_BUFOVF:
+ set_errno(E2BIG); break;
+ case LIB$_INVARG: case LIB$_INVSTRDES: case SS$_ACCVIO: /* shouldn't happen */
+ _ckvmssts(sts); /* fall through */
+ default: /* SS$_DUPLNAM, SS$_CLI, resource exhaustion, etc. */
+ set_errno(EVMSERR);
+ }
+ set_vaxc_errno(sts);
+ if (PL_dowarn)
warn("Can't spawn \"%s\": %s",
hadcmd ? VMScmd.dsc$a_pointer : "", Strerror(errno));
}
@@ -2915,7 +3110,7 @@ my_flush(FILE *fp)
int res;
if ((res = fflush(fp)) == 0) {
#ifdef VMS_DO_SOCKETS
- struct mystat s;
+ Stat_t s;
if (Fstat(fileno(fp), &s) == 0 && !S_ISSOCK(s.st_mode))
#endif
res = fsync(fileno(fp));
@@ -3125,7 +3320,7 @@ struct passwd *my_getpwuid(Uid_t uid)
else {
uic.uic$l_uic= uid;
if (!uic.uic$v_group)
- uic.uic$v_group= getgid();
+ uic.uic$v_group= PerlProc_getgid();
if (valid_uic(uic))
status = sys$idtoasc(uic.uic$l_uic, &lname, &name_desc, 0, 0, 0);
else status = SS$_IVIDENT;
@@ -3177,7 +3372,105 @@ void my_endpwent()
}
/*}}}*/
-#if __VMS_VER < 70000000 || __DECC_VER < 50200000
+#ifdef HOMEGROWN_POSIX_SIGNALS
+ /* Signal handling routines, pulled into the core from POSIX.xs.
+ *
+ * We need these for threads, so they've been rolled into the core,
+ * rather than left in POSIX.xs.
+ *
+ * (DRS, Oct 23, 1997)
+ */
+
+ /* sigset_t is atomic under VMS, so these routines are easy */
+/*{{{int my_sigemptyset(sigset_t *) */
+int my_sigemptyset(sigset_t *set) {
+ if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
+ *set = 0; return 0;
+}
+/*}}}*/
+
+
+/*{{{int my_sigfillset(sigset_t *)*/
+int my_sigfillset(sigset_t *set) {
+ int i;
+ if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
+ for (i = 0; i < NSIG; i++) *set |= (1 << i);
+ return 0;
+}
+/*}}}*/
+
+
+/*{{{int my_sigaddset(sigset_t *set, int sig)*/
+int my_sigaddset(sigset_t *set, int sig) {
+ if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
+ if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; }
+ *set |= (1 << (sig - 1));
+ return 0;
+}
+/*}}}*/
+
+
+/*{{{int my_sigdelset(sigset_t *set, int sig)*/
+int my_sigdelset(sigset_t *set, int sig) {
+ if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
+ if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; }
+ *set &= ~(1 << (sig - 1));
+ return 0;
+}
+/*}}}*/
+
+
+/*{{{int my_sigismember(sigset_t *set, int sig)*/
+int my_sigismember(sigset_t *set, int sig) {
+ if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
+ if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; }
+ *set & (1 << (sig - 1));
+}
+/*}}}*/
+
+
+/*{{{int my_sigprocmask(int how, sigset_t *set, sigset_t *oset)*/
+int my_sigprocmask(int how, sigset_t *set, sigset_t *oset) {
+ sigset_t tempmask;
+
+ /* If set and oset are both null, then things are badly wrong. Bail out. */
+ if ((oset == NULL) && (set == NULL)) {
+ set_errno(EFAULT); set_vaxc_errno(SS$_ACCVIO);
+ return -1;
+ }
+
+ /* If set's null, then we're just handling a fetch. */
+ if (set == NULL) {
+ tempmask = sigblock(0);
+ }
+ else {
+ switch (how) {
+ case SIG_SETMASK:
+ tempmask = sigsetmask(*set);
+ break;
+ case SIG_BLOCK:
+ tempmask = sigblock(*set);
+ break;
+ case SIG_UNBLOCK:
+ tempmask = sigblock(0);
+ sigsetmask(*oset & ~tempmask);
+ break;
+ default:
+ set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+ return -1;
+ }
+ }
+
+ /* Did they pass us an oset? If so, stick our holding mask into it */
+ if (oset)
+ *oset = tempmask;
+
+ return 0;
+}
+/*}}}*/
+#endif /* HOMEGROWN_POSIX_SIGNALS */
+
+
/* Used for UTC calculation in my_gmtime(), my_localtime(), my_time(),
* my_utime(), and flex_stat(), all of which operate on UTC unless
* VMSISH_TIMES is true.
@@ -3197,21 +3490,59 @@ static long int utc_offset_secs;
#undef localtime
#undef time
+#if defined(__VMS_VER) && __VMS_VER >= 70000000 && __DECC_VER >= 50200000
+# define RTL_USES_UTC 1
+#endif
+
+static time_t toutc_dst(time_t loc) {
+ struct tm *rsltmp;
+
+ if ((rsltmp = localtime(&loc)) == NULL) return -1;
+ loc -= utc_offset_secs;
+ if (rsltmp->tm_isdst) loc -= 3600;
+ return loc;
+}
+#define _toutc(secs) ((secs) == -1 ? -1 : \
+ ((gmtime_emulation_type || my_time(NULL)), \
+ (gmtime_emulation_type == 1 ? toutc_dst(secs) : \
+ ((secs) - utc_offset_secs))))
+
+static time_t toloc_dst(time_t utc) {
+ struct tm *rsltmp;
+
+ utc += utc_offset_secs;
+ if ((rsltmp = localtime(&utc)) == NULL) return -1;
+ if (rsltmp->tm_isdst) utc += 3600;
+ return utc;
+}
+#define _toloc(secs) ((secs) == -1 ? -1 : \
+ ((gmtime_emulation_type || my_time(NULL)), \
+ (gmtime_emulation_type == 1 ? toloc_dst(secs) : \
+ ((secs) + utc_offset_secs))))
+
+
/* my_time(), my_localtime(), my_gmtime()
- * By default traffic in UTC time values, suing CRTL gmtime() or
+ * By default traffic in UTC time values, using CRTL gmtime() or
* SYS$TIMEZONE_DIFFERENTIAL to determine offset from local time zone.
+ * Note: We need to use these functions even when the CRTL has working
+ * UTC support, since they also handle C<use vmsish qw(times);>
+ *
* Contributed by Chuck Lane <lane@duphy4.physics.drexel.edu>
- * Modified by Charles Bailey <bailey@genetics.upenn.edu>
+ * Modified by Charles Bailey <bailey@newman.upenn.edu>
*/
/*{{{time_t my_time(time_t *timep)*/
time_t my_time(time_t *timep)
{
+ dTHR;
time_t when;
+ struct tm *tm_p;
if (gmtime_emulation_type == 0) {
- struct tm *tm_p;
- time_t base = 15 * 86400; /* 15jan71; to avoid month ends */
+ int dstnow;
+ time_t base = 15 * 86400; /* 15jan71; to avoid month/year ends between */
+ /* results of calls to gmtime() and localtime() */
+ /* for same &base */
gmtime_emulation_type++;
if ((tm_p = gmtime(&base)) == NULL) { /* CRTL gmtime() is a fake */
@@ -3238,11 +3569,13 @@ time_t my_time(time_t *timep)
}
when = time(NULL);
- if (
-# ifdef VMSISH_TIME
- !VMSISH_TIME &&
-# endif
- when != -1) when -= utc_offset_secs;
+# ifdef VMSISH_TIME
+# ifdef RTL_USES_UTC
+ if (VMSISH_TIME) when = _toloc(when);
+# else
+ if (!VMSISH_TIME) when = _toutc(when);
+# endif
+# endif
if (timep != NULL) *timep = when;
return when;
@@ -3254,23 +3587,29 @@ time_t my_time(time_t *timep)
struct tm *
my_gmtime(const time_t *timep)
{
+ dTHR;
char *p;
time_t when;
+ struct tm *rsltmp;
if (timep == NULL) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
return NULL;
}
if (*timep == 0) gmtime_emulation_type = 0; /* possibly reset TZ */
- if (gmtime_emulation_type == 0) (void) my_time(NULL); /* Init UTC */
when = *timep;
# ifdef VMSISH_TIME
- if (VMSISH_TIME) when -= utc_offset_secs; /* Input was local time */
-# endif
+ if (VMSISH_TIME) when = _toutc(when); /* Input was local time */
+# endif
+# ifdef RTL_USES_UTC /* this implies that the CRTL has a working gmtime() */
+ return gmtime(&when);
+# else
/* CRTL localtime() wants local time as input, so does no tz correction */
- return localtime(&when);
-
+ rsltmp = localtime(&when);
+ if (rsltmp) rsltmp->tm_isdst = 0; /* We already took DST into account */
+ return rsltmp;
+#endif
} /* end of my_gmtime() */
/*}}}*/
@@ -3279,7 +3618,9 @@ my_gmtime(const time_t *timep)
struct tm *
my_localtime(const time_t *timep)
{
+ dTHR;
time_t when;
+ struct tm *rsltmp;
if (timep == NULL) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
@@ -3289,11 +3630,21 @@ my_localtime(const time_t *timep)
if (gmtime_emulation_type == 0) (void) my_time(NULL); /* Init UTC */
when = *timep;
+# ifdef RTL_USES_UTC
# ifdef VMSISH_TIME
- if (!VMSISH_TIME) when += utc_offset_secs; /* Input was UTC */
+ if (VMSISH_TIME) when = _toutc(when);
# endif
- /* CRTL localtime() wants local time as input, so does no tz correction */
+ /* CRTL localtime() wants UTC as input, does tz correction itself */
return localtime(&when);
+# else
+# ifdef VMSISH_TIME
+ if (!VMSISH_TIME) when = _toloc(when); /* Input was UTC */
+# endif
+# endif
+ /* CRTL localtime() wants local time as input, so does no tz correction */
+ rsltmp = localtime(&when);
+ if (rsltmp && gmtime_emulation_type != 1) rsltmp->tm_isdst = -1;
+ return rsltmp;
} /* end of my_localtime() */
/*}}}*/
@@ -3303,7 +3654,6 @@ my_localtime(const time_t *timep)
#define localtime(t) my_localtime(t)
#define time(t) my_time(t)
-#endif /* VMS VER < 7.0 || Dec C < 5.2
/* my_utime - update modification time of a file
* calling sequence is identical to POSIX utime(), but under
@@ -3325,6 +3675,7 @@ static const long int utime_baseadjust[2] = { 0x4beb4000, 0x7c9567 };
/*{{{int my_utime(char *path, struct utimbuf *utimes)*/
int my_utime(char *file, struct utimbuf *utimes)
{
+ dTHR;
register int i;
long int bintime[2], len = 2, lowbit, unixtime,
secscale = 10000000; /* seconds --> 100 ns intervals */
@@ -3367,11 +3718,9 @@ int my_utime(char *file, struct utimbuf *utimes)
*/
lowbit = (utimes->modtime & 1) ? secscale : 0;
unixtime = (long int) utimes->modtime;
-#if defined(VMSISH_TIME) && (__VMS_VER < 70000000 || __DECC_VER < 50200000)
- if (!VMSISH_TIME) { /* Input was UTC; convert to local for sys svc */
- if (!gmtime_emulation_type) (void) time(NULL); /* Initialize UTC */
- unixtime += utc_offset_secs;
- }
+# ifdef VMSISH_TIME
+ /* If input was UTC; convert to local for sys svc */
+ if (!VMSISH_TIME) unixtime = _toloc(unixtime);
# endif
unixtime >> 1; secscale << 1;
retsts = lib$emul(&secscale, &unixtime, &lowbit, bintime);
@@ -3569,17 +3918,16 @@ is_null_device(name)
return (*name++ == ':') && (*name != ':');
}
-/* Do the permissions allow some operation? Assumes statcache already set. */
+/* Do the permissions allow some operation? Assumes PL_statcache already set. */
/* Do this via $Check_Access on VMS, since the CRTL stat() returns only a
- * subset of the applicable information. (We have to stick with struct
- * stat instead of struct mystat in the prototype since we have to match
- * the one in proto.h.)
+ * subset of the applicable information.
*/
/*{{{I32 cando(I32 bit, I32 effective, struct stat *statbufp)*/
I32
-cando(I32 bit, I32 effective, struct stat *statbufp)
+cando(I32 bit, I32 effective, Stat_t *statbufp)
{
- if (statbufp == &statcache) return cando_by_name(bit,effective,namecache);
+ dTHR;
+ if (statbufp == &PL_statcache) return cando_by_name(bit,effective,namecache);
else {
char fname[NAM$C_MAXRSS+1];
unsigned long int retsts;
@@ -3588,12 +3936,12 @@ cando(I32 bit, I32 effective, struct stat *statbufp)
/* If the struct mystat is stale, we're OOL; stat() overwrites the
device name on successive calls */
- devdsc.dsc$a_pointer = ((struct mystat *)statbufp)->st_devnam;
- devdsc.dsc$w_length = strlen(((struct mystat *)statbufp)->st_devnam);
+ devdsc.dsc$a_pointer = ((Stat_t *)statbufp)->st_devnam;
+ devdsc.dsc$w_length = strlen(((Stat_t *)statbufp)->st_devnam);
namdsc.dsc$a_pointer = fname;
namdsc.dsc$w_length = sizeof fname - 1;
- retsts = lib$fid_to_name(&devdsc,&(((struct mystat *)statbufp)->st_ino),
+ retsts = lib$fid_to_name(&devdsc,&(((Stat_t *)statbufp)->st_ino),
&namdsc,&namdsc.dsc$w_length,0,0);
if (retsts & 1) {
fname[namdsc.dsc$w_length] = '\0';
@@ -3676,7 +4024,7 @@ cando_by_name(I32 bit, I32 effective, char *fname)
retsts = sys$check_access(&objtyp,&namdsc,&usrdsc,armlst);
if (retsts == SS$_NOPRIV || retsts == SS$_NOSUCHOBJECT ||
- retsts == SS$_INVFILFOROP || retsts == RMS$_FNF ||
+ retsts == SS$_INVFILFOROP || retsts == RMS$_FNF || retsts == RMS$_SYN ||
retsts == RMS$_DIR || retsts == RMS$_DEV) {
set_vaxc_errno(retsts);
if (retsts == SS$_NOPRIV) set_errno(EACCES);
@@ -3697,6 +4045,9 @@ cando_by_name(I32 bit, I32 effective, char *fname)
if ((privused & CHP$M_READALL) && !curprv.prv$v_readall) return FALSE;
return TRUE;
}
+ if (retsts == SS$_ACCONFLICT) {
+ return TRUE;
+ }
_ckvmssts(retsts);
return FALSE; /* Should never get here */
@@ -3705,25 +4056,33 @@ cando_by_name(I32 bit, I32 effective, char *fname)
/*}}}*/
-/*{{{ int flex_fstat(int fd, struct mystat *statbuf)*/
+/*{{{ int flex_fstat(int fd, Stat_t *statbuf)*/
int
-flex_fstat(int fd, struct mystat *statbufp)
+flex_fstat(int fd, Stat_t *statbufp)
{
+ dTHR;
if (!fstat(fd,(stat_t *) statbufp)) {
- if (statbufp == (struct mystat *) &statcache) *namecache == '\0';
+ if (statbufp == (Stat_t *) &PL_statcache) *namecache == '\0';
statbufp->st_dev = encode_dev(statbufp->st_devnam);
+# ifdef RTL_USES_UTC
+# ifdef VMSISH_TIME
+ if (VMSISH_TIME) {
+ statbufp->st_mtime = _toloc(statbufp->st_mtime);
+ statbufp->st_atime = _toloc(statbufp->st_atime);
+ statbufp->st_ctime = _toloc(statbufp->st_ctime);
+ }
+# endif
+# else
# ifdef VMSISH_TIME
if (!VMSISH_TIME) { /* Return UTC instead of local time */
# else
if (1) {
# endif
-#if __VMS_VER < 70000000 || __DECC_VER < 50200000
- if (!gmtime_emulation_type) (void)time(NULL);
- statbufp->st_mtime -= utc_offset_secs;
- statbufp->st_atime -= utc_offset_secs;
- statbufp->st_ctime -= utc_offset_secs;
-#endif
+ statbufp->st_mtime = _toutc(statbufp->st_mtime);
+ statbufp->st_atime = _toutc(statbufp->st_atime);
+ statbufp->st_ctime = _toutc(statbufp->st_ctime);
}
+#endif
return 0;
}
return -1;
@@ -3731,14 +4090,15 @@ flex_fstat(int fd, struct mystat *statbufp)
} /* end of flex_fstat() */
/*}}}*/
-/*{{{ int flex_stat(char *fspec, struct mystat *statbufp)*/
+/*{{{ int flex_stat(char *fspec, Stat_t *statbufp)*/
int
-flex_stat(char *fspec, struct mystat *statbufp)
+flex_stat(char *fspec, Stat_t *statbufp)
{
+ dTHR;
char fileified[NAM$C_MAXRSS+1];
int retval = -1;
- if (statbufp == (struct mystat *) &statcache)
+ if (statbufp == (Stat_t *) &PL_statcache)
do_tovmsspec(fspec,namecache,0);
if (is_null_device(fspec)) { /* Fake a stat() for the null device */
memset(statbufp,0,sizeof *statbufp);
@@ -3752,7 +4112,7 @@ flex_stat(char *fspec, struct mystat *statbufp)
}
/* Try for a directory name first. If fspec contains a filename without
- * a type (e.g. sea:[dark.dark]water), and both sea:[wine.dark]water.dir
+ * a type (e.g. sea:[wine.dark]water), and both sea:[wine.dark]water.dir
* and sea:[wine.dark]water. exist, we prefer the directory here.
* Similarly, sea:[wine.dark] returns the result for sea:[wine]dark.dir,
* not sea:[wine.dark]., if the latter exists. If the intended target is
@@ -3761,24 +4121,31 @@ flex_stat(char *fspec, struct mystat *statbufp)
*/
if (do_fileify_dirspec(fspec,fileified,0) != NULL) {
retval = stat(fileified,(stat_t *) statbufp);
- if (!retval && statbufp == (struct mystat *) &statcache)
+ if (!retval && statbufp == (Stat_t *) &PL_statcache)
strcpy(namecache,fileified);
}
if (retval) retval = stat(fspec,(stat_t *) statbufp);
if (!retval) {
statbufp->st_dev = encode_dev(statbufp->st_devnam);
+# ifdef RTL_USES_UTC
+# ifdef VMSISH_TIME
+ if (VMSISH_TIME) {
+ statbufp->st_mtime = _toloc(statbufp->st_mtime);
+ statbufp->st_atime = _toloc(statbufp->st_atime);
+ statbufp->st_ctime = _toloc(statbufp->st_ctime);
+ }
+# endif
+# else
# ifdef VMSISH_TIME
if (!VMSISH_TIME) { /* Return UTC instead of local time */
# else
if (1) {
# endif
-#if __VMS_VER < 70000000 || __DECC_VER < 50200000
- if (!gmtime_emulation_type) (void)time(NULL);
- statbufp->st_mtime -= utc_offset_secs;
- statbufp->st_atime -= utc_offset_secs;
- statbufp->st_ctime -= utc_offset_secs;
-#endif
+ statbufp->st_mtime = _toutc(statbufp->st_mtime);
+ statbufp->st_atime = _toutc(statbufp->st_atime);
+ statbufp->st_ctime = _toutc(statbufp->st_ctime);
}
+# endif
}
return retval;
@@ -3790,25 +4157,40 @@ flex_stat(char *fspec, struct mystat *statbufp)
FILE *
my_binmode(FILE *fp, char iotype)
{
- char filespec[NAM$C_MAXRSS], *acmode;
+ char filespec[NAM$C_MAXRSS], *acmode, *s, *colon, *dirend = Nullch;
+ int ret = 0, saverrno = errno, savevmserrno = vaxc$errno;
fpos_t pos;
- if (!fgetname(fp,filespec)) return NULL;
- if (iotype != '-' && fgetpos(fp,&pos) == -1) return NULL;
+ if (!fgetname(fp,filespec,1)) return NULL;
+ for (s = filespec; *s; s++) {
+ if (*s == ':') colon = s;
+ else if (*s == ']' || *s == '>') dirend = s;
+ }
+ /* Looks like a tmpfile, which will go away if reopened */
+ if (s == dirend + 3) return fp;
+ /* If we've got a non-file-structured device, clip off the trailing
+ * junk, and don't lose sleep if we can't get a stream position. */
+ if (dirend == Nullch) *(colon+1) = '\0';
+ if (iotype != '-'&& (ret = fgetpos(fp, &pos)) == -1 && dirend) return NULL;
switch (iotype) {
case '<': case 'r': acmode = "rb"; break;
- case '>': case 'w':
+ case '>': case 'w': case '|':
/* use 'a' instead of 'w' to avoid creating new file;
fsetpos below will take care of restoring file position */
case 'a': acmode = "ab"; break;
- case '+': case '|': case 's': acmode = "rb+"; break;
+ case '+': case 's': acmode = "rb+"; break;
case '-': acmode = fileno(fp) ? "ab" : "rb"; break;
+ /* iotype'll be null for the SYS$INPUT:/SYS$OUTPUT:/SYS$ERROR: files */
+ /* since we didn't really open them and can't really */
+ /* reopen them */
+ case 0: return NULL; break;
default:
- warn("Unrecognized iotype %c in my_binmode",iotype);
+ warn("Unrecognized iotype %x for %s in my_binmode",iotype, filespec);
acmode = "rb+";
}
if (freopen(filespec,acmode,fp) == NULL) return NULL;
- if (iotype != '-' && fsetpos(fp,&pos) == -1) return NULL;
+ if (iotype != '-' && ret != -1 && fsetpos(fp,&pos) == -1) return NULL;
+ if (ret == -1) { set_errno(saverrno); set_vaxc_errno(savevmserrno); }
return fp;
} /* end of my_binmode() */
/*}}}*/
@@ -3842,7 +4224,7 @@ my_getlogin()
*
* Returns 1 on success; returns 0 and sets errno and vaxc$errno on failure.
*
- * Copyright 1996 by Charles Bailey <bailey@genetics.upenn.edu>.
+ * Copyright 1996 by Charles Bailey <bailey@newman.upenn.edu>.
* Incorporates, with permission, some code from EZCOPY by Tim Adye
* <T.J.Adye@rl.ac.uk>. Permission is given to distribute this code
* as part of the Perl standard distribution under the terms of the
@@ -4026,12 +4408,13 @@ rmsexpand_fromperl(CV *cv)
{
dXSARGS;
char *fspec, *defspec = NULL, *rslt;
+ STRLEN n_a;
if (!items || items > 2)
croak("Usage: VMS::Filespec::rmsexpand(spec[,defspec])");
- fspec = SvPV(ST(0),na);
+ fspec = SvPV(ST(0),n_a);
if (!fspec || !*fspec) XSRETURN_UNDEF;
- if (items == 2) defspec = SvPV(ST(1),na);
+ if (items == 2) defspec = SvPV(ST(1),n_a);
rslt = do_rmsexpand(fspec,NULL,1,defspec,0);
ST(0) = sv_newmortal();
@@ -4044,9 +4427,10 @@ vmsify_fromperl(CV *cv)
{
dXSARGS;
char *vmsified;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::vmsify(spec)");
- vmsified = do_tovmsspec(SvPV(ST(0),na),NULL,1);
+ vmsified = do_tovmsspec(SvPV(ST(0),n_a),NULL,1);
ST(0) = sv_newmortal();
if (vmsified != NULL) sv_usepvn(ST(0),vmsified,strlen(vmsified));
XSRETURN(1);
@@ -4057,9 +4441,10 @@ unixify_fromperl(CV *cv)
{
dXSARGS;
char *unixified;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::unixify(spec)");
- unixified = do_tounixspec(SvPV(ST(0),na),NULL,1);
+ unixified = do_tounixspec(SvPV(ST(0),n_a),NULL,1);
ST(0) = sv_newmortal();
if (unixified != NULL) sv_usepvn(ST(0),unixified,strlen(unixified));
XSRETURN(1);
@@ -4070,9 +4455,10 @@ fileify_fromperl(CV *cv)
{
dXSARGS;
char *fileified;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::fileify(spec)");
- fileified = do_fileify_dirspec(SvPV(ST(0),na),NULL,1);
+ fileified = do_fileify_dirspec(SvPV(ST(0),n_a),NULL,1);
ST(0) = sv_newmortal();
if (fileified != NULL) sv_usepvn(ST(0),fileified,strlen(fileified));
XSRETURN(1);
@@ -4083,9 +4469,10 @@ pathify_fromperl(CV *cv)
{
dXSARGS;
char *pathified;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::pathify(spec)");
- pathified = do_pathify_dirspec(SvPV(ST(0),na),NULL,1);
+ pathified = do_pathify_dirspec(SvPV(ST(0),n_a),NULL,1);
ST(0) = sv_newmortal();
if (pathified != NULL) sv_usepvn(ST(0),pathified,strlen(pathified));
XSRETURN(1);
@@ -4096,9 +4483,10 @@ vmspath_fromperl(CV *cv)
{
dXSARGS;
char *vmspath;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::vmspath(spec)");
- vmspath = do_tovmspath(SvPV(ST(0),na),NULL,1);
+ vmspath = do_tovmspath(SvPV(ST(0),n_a),NULL,1);
ST(0) = sv_newmortal();
if (vmspath != NULL) sv_usepvn(ST(0),vmspath,strlen(vmspath));
XSRETURN(1);
@@ -4109,9 +4497,10 @@ unixpath_fromperl(CV *cv)
{
dXSARGS;
char *unixpath;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::unixpath(spec)");
- unixpath = do_tounixpath(SvPV(ST(0),na),NULL,1);
+ unixpath = do_tounixpath(SvPV(ST(0),n_a),NULL,1);
ST(0) = sv_newmortal();
if (unixpath != NULL) sv_usepvn(ST(0),unixpath,strlen(unixpath));
XSRETURN(1);
@@ -4124,22 +4513,23 @@ candelete_fromperl(CV *cv)
char fspec[NAM$C_MAXRSS+1], *fsp;
SV *mysv;
IO *io;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::candelete(spec)");
mysv = SvROK(ST(0)) ? SvRV(ST(0)) : ST(0);
if (SvTYPE(mysv) == SVt_PVGV) {
- if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),fspec)) {
+ if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),fspec,1)) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
- ST(0) = &sv_no;
+ ST(0) = &PL_sv_no;
XSRETURN(1);
}
fsp = fspec;
}
else {
- if (mysv != ST(0) || !(fsp = SvPV(mysv,na)) || !*fsp) {
+ if (mysv != ST(0) || !(fsp = SvPV(mysv,n_a)) || !*fsp) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
- ST(0) = &sv_no;
+ ST(0) = &PL_sv_no;
XSRETURN(1);
}
}
@@ -4159,39 +4549,40 @@ rmscopy_fromperl(CV *cv)
unsigned long int sts;
SV *mysv;
IO *io;
+ STRLEN n_a;
if (items < 2 || items > 3)
croak("Usage: File::Copy::rmscopy(from,to[,date_flag])");
mysv = SvROK(ST(0)) ? SvRV(ST(0)) : ST(0);
if (SvTYPE(mysv) == SVt_PVGV) {
- if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),inspec)) {
+ if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),inspec,1)) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
- ST(0) = &sv_no;
+ ST(0) = &PL_sv_no;
XSRETURN(1);
}
inp = inspec;
}
else {
- if (mysv != ST(0) || !(inp = SvPV(mysv,na)) || !*inp) {
+ if (mysv != ST(0) || !(inp = SvPV(mysv,n_a)) || !*inp) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
- ST(0) = &sv_no;
+ ST(0) = &PL_sv_no;
XSRETURN(1);
}
}
mysv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
if (SvTYPE(mysv) == SVt_PVGV) {
- if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),outspec)) {
+ if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),outspec,1)) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
- ST(0) = &sv_no;
+ ST(0) = &PL_sv_no;
XSRETURN(1);
}
outp = outspec;
}
else {
- if (mysv != ST(1) || !(outp = SvPV(mysv,na)) || !*outp) {
+ if (mysv != ST(1) || !(outp = SvPV(mysv,n_a)) || !*outp) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
- ST(0) = &sv_no;
+ ST(0) = &PL_sv_no;
XSRETURN(1);
}
}
@@ -4215,6 +4606,11 @@ init_os_extras()
newXSproto("VMS::Filespec::unixpath",unixpath_fromperl,file,"$");
newXSproto("VMS::Filespec::candelete",candelete_fromperl,file,"$");
newXS("File::Copy::rmscopy",rmscopy_fromperl,file);
+
+#ifdef PRIME_ENV_AT_STARTUP
+ prime_env_iter();
+#endif
+
return;
}
diff --git a/gnu/usr.bin/perl/vms/vms_yfix.pl b/gnu/usr.bin/perl/vms/vms_yfix.pl
index f57ea1d5150..08a8dbffb17 100644
--- a/gnu/usr.bin/perl/vms/vms_yfix.pl
+++ b/gnu/usr.bin/perl/vms/vms_yfix.pl
@@ -27,6 +27,11 @@ while (<C>) {
# accomodate old VAXC's macro susbstitution pecularities
$_ = "# ifndef getenv\n$_# endif\n";
}
+ elsif ( /getenv\("YYDEBUG"\)/ ) {
+ # Reset the "error" status if an optional lookup fails
+ while (not /^\s+\}/) { print COUT; $_ = <C>; }
+ $_ .= "\telse SETERRNO(0,SS\$_NORMAL);\n";
+ }
else {
# add the dEXT tag to definitions of global vars, so we'll insert
# a globaldef when perly.c is compiled
diff --git a/gnu/usr.bin/perl/vms/vmsish.h b/gnu/usr.bin/perl/vms/vmsish.h
index 2da1639baa4..228a0549960 100644
--- a/gnu/usr.bin/perl/vms/vmsish.h
+++ b/gnu/usr.bin/perl/vms/vmsish.h
@@ -16,12 +16,11 @@
#include <stsdef.h> /* bitmasks for exit status testing */
/* Suppress compiler warnings from DECC for VMS-specific extensions:
- * GLOBALEXT, NOSHAREEXT, READONLYEXT: global[dr]ef declarations
* ADDRCONSTEXT,NEEDCONSTEXT: initialization of data with non-constant values
* (e.g. pointer fields of descriptors)
*/
#ifdef __DECC
-# pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT,ADDRCONSTEXT,NEEDCONSTEXT)
+# pragma message disable (ADDRCONSTEXT,NEEDCONSTEXT)
#endif
/* DEC's C compilers and gcc use incompatible definitions of _to(upp|low)er() */
@@ -56,6 +55,11 @@
# include <unistd.h> /* DECC has this; VAXC and gcc don't */
#endif
+/* VAXC doesn't have a unary plus operator, so we need to get there indirectly */
+#if defined(VAXC) && !defined(__DECC)
+# define NO_UNARY_PLUS
+#endif
+
#ifdef NO_PERL_TYPEDEFS /* a2p; we don't want Perl's special routines */
# define DONT_MASK_RTL_CALLS
#endif
@@ -70,13 +74,14 @@
/* DECC introduces this routine in the RTL as of VMS 7.0; for now,
* we'll use ours, since it gives us the full VMS exit status. */
-#ifdef __PID_T
-# define Pid_t pid_t
-#else
-# define Pid_t unsigned int
-#endif
#define waitpid my_waitpid
+/* Don't redeclare standard RTL routines in Perl's header files;
+ * VMS history or extensions makes some of the formal protoypes
+ * differ from the common Unix forms.
+ */
+#define DONT_DECLARE_STD 1
+
/* Our own contribution to PerlShr's global symbols . . . */
#ifdef EMBED
# define my_trnlnm Perl_my_trnlnm
@@ -111,11 +116,15 @@
# define seekdir Perl_seekdir
# define closedir Perl_closedir
# define vmsreaddirversions Perl_vmsreaddirversions
-#if __VMS_VER < 70000000 || __DECC_VER < 50200000
# define my_gmtime Perl_my_gmtime
# define my_localtime Perl_my_localtime
# define my_time Perl_my_time
-#endif
+# define my_sigemptyset Perl_my_sigemptyset
+# define my_sigfillset Perl_my_sigfillset
+# define my_sigaddset Perl_my_sigaddset
+# define my_sigdelset Perl_my_sigdelset
+# define my_sigismember Perl_my_sigismember
+# define my_sigprocmask Perl_my_sigprocmask
# define cando_by_name Perl_cando_by_name
# define flex_fstat Perl_flex_fstat
# define flex_stat Perl_flex_stat
@@ -157,12 +166,6 @@
*/
#define BIG_TIME
-/* USE_STAT_RDEV:
- * This symbol is defined if this system has a stat structure declaring
- * st_rdev
- */
-#define USE_STAT_RDEV /**/
-
/* ACME_MESS:
* This symbol, if defined, indicates that error messages should be
* should be generated in a format that allows the use of the Acme
@@ -200,9 +203,9 @@
#define HINT_M_VMSISH_STATUS 0x01000000 /* system, $? return VMS status */
#define HINT_M_VMSISH_EXIT 0x02000000 /* exit(1) ==> SS$_NORMAL */
#define HINT_M_VMSISH_TIME 0x04000000 /* times are local, not UTC */
-#define NATIVE_HINTS (hints >> HINT_V_VMSISH) /* used in op.c */
+#define NATIVE_HINTS (PL_hints >> HINT_V_VMSISH) /* used in op.c */
-#define TEST_VMSISH(h) (curcop->op_private & ((h) >> HINT_V_VMSISH))
+#define TEST_VMSISH(h) (PL_curcop->op_private & ((h) >> HINT_V_VMSISH))
#define VMSISH_STATUS TEST_VMSISH(HINT_M_VMSISH_STATUS)
#define VMSISH_EXIT TEST_VMSISH(HINT_M_VMSISH_EXIT)
#define VMSISH_TIME TEST_VMSISH(HINT_M_VMSISH_TIME)
@@ -227,8 +230,8 @@
#endif
#define BIT_BUCKET "_NLA0:"
-#define PERL_SYS_INIT(c,v) vms_image_init((c),(v))
-#define PERL_SYS_TERM()
+#define PERL_SYS_INIT(c,v) vms_image_init((c),(v)); MALLOC_INIT
+#define PERL_SYS_TERM() MALLOC_TERM
#define dXSUB_SYS
#define HAS_KILL
#define HAS_WAIT
@@ -254,16 +257,16 @@
#define HAS_UTIME /**/
/* HAS_GROUP
- * This symbol, if defined, indicates that the getgrnam(),
- * getgrgid(), and getgrent() routines are available to
- * get group entries.
+ * This symbol, if defined, indicates that the getgrnam() and
+ * getgrgid() routines are available to get group entries.
+ * The getgrent() has a separate definition, HAS_GETGRENT.
*/
#undef HAS_GROUP /**/
/* HAS_PASSWD
- * This symbol, if defined, indicates that the getpwnam(),
- * getpwuid(), and getpwent() routines are available to
- * get password entries.
+ * This symbol, if defined, indicates that the getpwnam() and
+ * getpwuid() routines are available to get password entries.
+ * The getpwent() has a separate definition, HAS_GETPWENT.
*/
#define HAS_PASSWD /**/
@@ -278,6 +281,30 @@
*/
#define USEMYBINMODE
+/* Stat_t:
+ * This symbol holds the type used to declare buffers for information
+ * returned by stat(). It's usually just struct stat. It may be necessary
+ * to include <sys/stat.h> and <sys/types.h> to get any typedef'ed
+ * information.
+ */
+/* VMS:
+ * We need this typedef to point to the new type even if DONT_MASK_RTL_CALLS
+ * is in effect, since Perl's thread.h embeds one of these structs in its
+ * thread data struct, and our struct mystat is a different size from the
+ * regular struct stat (cf. note above about having to pad struct to work
+ * around bug in compiler.)
+ * It's OK to pass one of these to the RTL's stat(), though, since the
+ * fields it fills are the same in each struct.
+ */
+#define Stat_t struct mystat
+
+/* USE_STAT_RDEV:
+* This symbol is defined if this system has a stat structure declaring
+* st_rdev
+* VMS: Field exists in POSIXish version of struct stat(), but is not used.
+*/
+#undef USE_STAT_RDEV /**/
+
/*
* fwrite1() should be a routine with the same calling sequence as fwrite(),
* but which outputs all of the bytes requested as a single stream (unlike
@@ -326,16 +353,46 @@ struct utimbuf {
# define tbuffer_t struct tms
#endif
-/* Prior to VMS 7.0, the CRTL gmtime() routine was a stub which always
- * returned NULL. Substitute our own routine, which uses the logical
- * SYS$TIMEZONE_DIFFERENTIAL, whcih the native UTC support routines
- * in VMS 6.0 or later use. We also add shims for time() and localtime()
- * so we can run on UTC by default.
+/* Substitute our own routines for gmtime(), localtime(), and time(),
+ * which allow us to implement the vmsish 'time' pragma, and work
+ * around absence of system-level UTC support on old versions of VMS.
*/
-#if __VMS_VER < 70000000 || __DECC_VER < 50200000
#define gmtime(t) my_gmtime(t)
#define localtime(t) my_localtime(t)
#define time(t) my_time(t)
+
+/* If we're using an older version of VMS whose Unix signal emulation
+ * isn't very POSIXish, then roll our own.
+ */
+#if __VMS_VER < 70000000 || __DECC_VER < 50200000
+# define HOMEGROWN_POSIX_SIGNALS
+#endif
+#ifdef HOMEGROWN_POSIX_SIGNALS
+# define sigemptyset(t) my_sigemptyset(t)
+# define sigfillset(t) my_sigfillset(t)
+# define sigaddset(t, u) my_sigaddset(t, u)
+# define sigdelset(t, u) my_sigdelset(t, u)
+# define sigismember(t, u) my_sigismember(t, u)
+# define sigprocmask(t, u, v) my_sigprocmask(t, u, v)
+# ifndef _SIGSET_T
+ typedef int sigset_t;
+# endif
+ /* The tools for sigprocmask() are there, just not the routine itself */
+# ifndef SIG_UNBLOCK
+# define SIG_UNBLOCK 1
+# endif
+# ifndef SIG_BLOCK
+# define SIG_BLOCK 2
+# endif
+# ifndef SIG_SETMASK
+# define SIG_SETMASK 3
+# endif
+# define sigaction sigvec
+# define sa_flags sv_onstack
+# define sa_handler sv_handler
+# define sa_mask sv_mask
+# define sigsuspend(set) sigpause(*set)
+# define sigpending(a) (not_here("sigpending"),0)
#endif
/* VMS doesn't use a real sys_nerr, but we need this when scanning for error
@@ -451,6 +508,13 @@ struct mystat
char st_fab_rat; /* record attributes */
char st_fab_fsz; /* fixed header size */
unsigned st_dev; /* encoded device name */
+ /* Pad struct out to integral number of longwords, since DECC 5.6/VAX
+ * has a bug in dealing with offsets in structs in which are embedded
+ * other structs whose size is an odd number of bytes. (An even
+ * number of bytes is enough to make it happy, but we go for natural
+ * alignment anyhow.)
+ */
+ char st_fill1[sizeof(void *) - (3*sizeof(unsigned short) + 3*sizeof(char))%sizeof(void *)];
};
typedef unsigned mydev_t;
typedef unsigned myino_t;
@@ -536,19 +600,25 @@ long telldir _((DIR *));
void seekdir _((DIR *, long));
void closedir _((DIR *));
void vmsreaddirversions _((DIR *, int));
-#ifdef my_gmtime
struct tm * my_gmtime _((const time_t *));
struct tm * my_localtime _((const time_t *));
time_t my_time _((time_t *));
-#endif /* We're assuming these three come as a package */
+#ifdef HOMEGROWN_POSIX_SIGNALS
+int my_sigemptyset _((sigset_t *));
+int my_sigfillset _((sigset_t *));
+int my_sigaddset _((sigset_t *, int));
+int my_sigdelset _((sigset_t *, int));
+int my_sigismember _((sigset_t *, int));
+int my_sigprocmask _((int, sigset_t *, sigset_t *));
+#endif
I32 cando_by_name _((I32, I32, char *));
-int flex_fstat _((int, struct mystat *));
-int flex_stat _((char *, struct mystat *));
+int flex_fstat _((int, Stat_t *));
+int flex_stat _((char *, Stat_t *));
int trim_unixpath _((char *, char*, int));
int my_vfork _(());
bool vms_do_aexec _((SV *, SV **, SV **));
bool vms_do_exec _((char *));
-unsigned long int do_aspawn _((SV *, SV **, SV **));
+unsigned long int do_aspawn _((void *, void **, void **));
unsigned long int do_spawn _((char *));
int my_fwrite _((void *, size_t, size_t, FILE *));
int my_flush _((FILE *));
diff --git a/gnu/usr.bin/perl/vos/config_h.SH_orig b/gnu/usr.bin/perl/vos/config_h.SH_orig
index b1da78348e4..69f380446c9 100644
--- a/gnu/usr.bin/perl/vos/config_h.SH_orig
+++ b/gnu/usr.bin/perl/vos/config_h.SH_orig
@@ -25,7 +25,7 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
* that running config_h.SH again will wipe out any changes you've made.
* For a more permanent change edit config.sh and rerun config_h.SH.
*
- * \$Id: config_h.SH_orig,v 1.1.1.1 1999/04/29 22:42:10 millert Exp $
+ * \$Id: config_h.SH_orig,v 1.2 1999/04/29 22:52:50 millert Exp $
*/
/*
diff --git a/gnu/usr.bin/perl/win32/Makefile b/gnu/usr.bin/perl/win32/Makefile
index 7a98f84c2cb..6481d735cda 100644
--- a/gnu/usr.bin/perl/win32/Makefile
+++ b/gnu/usr.bin/perl/win32/Makefile
@@ -1,517 +1,959 @@
-#
-# Makefile to build perl on Windowns NT using Microsoft NMAKE.
-#
-#
-# This is set up to build a perl.exe that runs off a shared library
-# (perl.dll). Also makes individual DLLs for the XS extensions.
-#
-
-#
-# Set these to wherever you want "nmake install" to put your
-# newly built perl.
-INST_DRV=c:
-INST_TOP=$(INST_DRV)\perl
-
-#
-# uncomment next line if you are using Visual C++ 2.x
-#CCTYPE=MSVC20
-
-#
-# uncomment next line if you want debug version of perl (big,slow)
-#CFG=Debug
-
-#
-# set the install locations of the compiler include/libraries
-#CCHOME = f:\msvc20
-CCHOME = $(MSVCDIR)
-CCINCDIR = $(CCHOME)\include
-CCLIBDIR = $(CCHOME)\lib
-
-#
-# set this to your email address (perl will guess a value from
-# from your loginname and your hostname, which may not be right)
-#EMAIL =
-
-##################### CHANGE THESE ONLY IF YOU MUST #####################
-
-#
-# Programs to compile, build .lib files and link
-#
-
-CC=cl.exe
-LINK32=link.exe
-LIB32=$(LINK32) -lib
-#
-# Options
-#
-!IF "$(RUNTIME)" == ""
-RUNTIME = -MD
-!ENDIF
-INCLUDES = -I.\include -I. -I..
-#PCHFLAGS = -Fp"$(INTDIR)/modules.pch" -YX
-DEFINES = -DWIN32 -D_CONSOLE -DPERLDLL
-SUBSYS = console
-
-!IF "$(RUNTIME)" == "-MD"
-LIBC = msvcrt.lib
-WINIOMAYBE =
-!ELSE
-LIBC = libcmt.lib
-WINIOMAYBE = win32io.obj
-!ENDIF
-
-!IF "$(CFG)" == "Debug"
-! IF "$(CCTYPE)" == "MSVC20"
-OPTIMIZE = -Od $(RUNTIME) -Z7 -D_DEBUG
-! ELSE
-OPTIMIZE = -Od $(RUNTIME)d -Z7 -D_DEBUG
-! ENDIF
-LINK_DBG = -debug -pdb:none
-!ELSE
-! IF "$(CCTYPE)" == "MSVC20"
-OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
-! ELSE
-OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
-! ENDIF
-LINK_DBG = -release
-!ENDIF
-
-# we don't add LIBC here, the compiler do it based on -MD/-MT
-LIBFILES = oldnames.lib kernel32.lib user32.lib gdi32.lib \
- winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \
- oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \
- version.lib odbc32.lib odbccp32.lib
-
-CFLAGS = -nologo -W3 $(INCLUDES) $(DEFINES) $(PCHFLAGS) $(OPTIMIZE)
-LINK_FLAGS = -nologo $(LIBFILES) $(LINK_DBG) -machine:I386
-OBJOUT_FLAG = -Fo
-
-#################### do not edit below this line #######################
-############# NO USER-SERVICEABLE PARTS BEYOND THIS POINT ##############
-
-#
-# Rules
-#
-.SUFFIXES :
-.SUFFIXES : .c .obj .dll .lib .exe
-
-.c.obj:
- $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ $<
-
-.obj.dll:
- $(LINK32) -dll -subsystem:windows -implib:$(*B).lib -def:$(*B).def \
- -out:$@ $(LINK_FLAGS) $< $(LIBPERL)
-
-#
-INST_BIN=$(INST_TOP)\bin
-INST_LIB=$(INST_TOP)\lib
-INST_POD=$(INST_LIB)\pod
-INST_HTML=$(INST_POD)\html
-LIBDIR=..\lib
-EXTDIR=..\ext
-PODDIR=..\pod
-EXTUTILSDIR=$(LIBDIR)\extutils
-
-#
-# various targets
-PERLIMPLIB=..\perl.lib
-MINIPERL=..\miniperl.exe
-PERLDLL=..\perl.dll
-PERLEXE=..\perl.exe
-GLOBEXE=..\perlglob.exe
-CONFIGPM=..\lib\Config.pm
-MINIMOD=..\lib\ExtUtils\Miniperl.pm
-
-PL2BAT=bin\pl2bat.pl
-GLOBBAT = bin\perlglob.bat
-
-MAKE=nmake -nologo
-CFGSH_TMPL = config.vc
-CFGH_TMPL = config_H.vc
-PERL95EXE=..\perl95.exe
-XCOPY=xcopy /f /r /i /d
-RCOPY=xcopy /f /r /i /e /d
-NULL=
-
-#
-# filenames given to xsubpp must have forward slashes (since it puts
-# full pathnames in #line strings)
-XSUBPP=..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp -C++ -prototypes
-
-CORE_C= ..\av.c \
- ..\deb.c \
- ..\doio.c \
- ..\doop.c \
- ..\dump.c \
- ..\globals.c \
- ..\gv.c \
- ..\hv.c \
- ..\mg.c \
- ..\op.c \
- ..\perl.c \
- ..\perlio.c \
- ..\perly.c \
- ..\pp.c \
- ..\pp_ctl.c \
- ..\pp_hot.c \
- ..\pp_sys.c \
- ..\regcomp.c \
- ..\regexec.c \
- ..\run.c \
- ..\scope.c \
- ..\sv.c \
- ..\taint.c \
- ..\toke.c \
- ..\universal.c \
- ..\util.c
-
-CORE_OBJ= ..\av.obj \
- ..\deb.obj \
- ..\doio.obj \
- ..\doop.obj \
- ..\dump.obj \
- ..\globals.obj \
- ..\gv.obj \
- ..\hv.obj \
- ..\mg.obj \
- ..\op.obj \
- ..\perl.obj \
- ..\perlio.obj \
- ..\perly.obj \
- ..\pp.obj \
- ..\pp_ctl.obj \
- ..\pp_hot.obj \
- ..\pp_sys.obj \
- ..\regcomp.obj \
- ..\regexec.obj \
- ..\run.obj \
- ..\scope.obj \
- ..\sv.obj \
- ..\taint.obj \
- ..\toke.obj \
- ..\universal.obj\
- ..\util.obj
-
-WIN32_C = perllib.c \
- win32.c \
- win32io.c \
- win32sck.c
-
-WIN32_OBJ = win32.obj \
- win32io.obj \
- win32sck.obj
-
-PERL95_OBJ = perl95.obj \
- win32mt.obj \
- win32iomt.obj \
- win32sckmt.obj
-
-DLL_OBJ = perllib.obj $(DYNALOADER).obj
-
-CORE_H = ..\av.h \
- ..\cop.h \
- ..\cv.h \
- ..\dosish.h \
- ..\embed.h \
- ..\form.h \
- ..\gv.h \
- ..\handy.h \
- ..\hv.h \
- ..\mg.h \
- ..\nostdio.h \
- ..\op.h \
- ..\opcode.h \
- ..\perl.h \
- ..\perlio.h \
- ..\perlsdio.h \
- ..\perlsfio.h \
- ..\perly.h \
- ..\pp.h \
- ..\proto.h \
- ..\regexp.h \
- ..\scope.h \
- ..\sv.h \
- ..\unixish.h \
- ..\util.h \
- ..\XSUB.h \
- .\config.h \
- ..\EXTERN.h \
- .\include\dirent.h \
- .\include\netdb.h \
- .\include\sys\socket.h \
- .\win32.h
-
-EXTENSIONS=DynaLoader Socket IO Fcntl Opcode SDBM_File
-
-DYNALOADER=$(EXTDIR)\DynaLoader\DynaLoader
-SOCKET=$(EXTDIR)\Socket\Socket
-FCNTL=$(EXTDIR)\Fcntl\Fcntl
-OPCODE=$(EXTDIR)\Opcode\Opcode
-SDBM_FILE=$(EXTDIR)\SDBM_File\SDBM_File
-IO=$(EXTDIR)\IO\IO
-
-SOCKET_DLL=..\lib\auto\Socket\Socket.dll
-FCNTL_DLL=..\lib\auto\Fcntl\Fcntl.dll
-OPCODE_DLL=..\lib\auto\Opcode\Opcode.dll
-SDBM_FILE_DLL=..\lib\auto\SDBM_File\SDBM_File.dll
-IO_DLL=..\lib\auto\IO\IO.dll
-
-STATICLINKMODULES=DynaLoader
-DYNALOADMODULES= \
- $(SOCKET_DLL) \
- $(FCNTL_DLL) \
- $(OPCODE_DLL) \
- $(SDBM_FILE_DLL)\
- $(IO_DLL)
-
-POD2HTML=$(PODDIR)\pod2html
-POD2MAN=$(PODDIR)\pod2man
-POD2LATEX=$(PODDIR)\pod2latex
-POD2TEXT=$(PODDIR)\pod2text
-
-#
-# Top targets
-#
-
-all: $(PERLEXE) $(PERL95EXE) $(GLOBEXE) $(DYNALOADMODULES) $(MINIMOD) $(GLOBBAT)
-
-$(DYNALOADER).obj : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c
-
-#------------------------------------------------------------
-
-$(GLOBEXE): perlglob.obj
- $(LINK32) $(LINK_FLAGS) -out:$@ -subsystem:$(SUBSYS) perlglob.obj setargv.obj
-
-$(GLOBBAT) : ..\lib\File\DosGlob.pm $(MINIPERL)
- $(MINIPERL) $(PL2BAT) - < ..\lib\File\DosGlob.pm > $(GLOBBAT)
-
-perlglob.obj : perlglob.c
-
-..\miniperlmain.obj : ..\miniperlmain.c $(CORE_H)
-
-config.w32 : $(CFGSH_TMPL)
- copy $(CFGSH_TMPL) config.w32
-
-.\config.h : $(CFGSH_TMPL)
- -del /f config.h
- copy $(CFGH_TMPL) config.h
-
-..\config.sh : config.w32 $(MINIPERL) config_sh.PL
- $(MINIPERL) -I..\lib config_sh.PL "INST_DRV=$(INST_DRV)" \
- "INST_TOP=$(INST_TOP)" "cc=$(CC)" "ccflags=$(RUNTIME) -DWIN32" \
- "cf_email=$(EMAIL)" "libs=$(LIBFILES)" "incpath=$(CCINCDIR)" \
- "libpth=$(CCLIBDIR)" "libc=$(LIBC)" \
- config.w32 > ..\config.sh
-
-$(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl
- cd .. && miniperl configpm
- if exist lib\* $(RCOPY) lib\*.* ..\lib\$(NULL)
- $(XCOPY) ..\*.h ..\lib\CORE\*.*
- $(XCOPY) *.h ..\lib\CORE\*.*
- $(RCOPY) include ..\lib\CORE\*.*
- $(MINIPERL) -I..\lib config_h.PL || $(MAKE) CCTYPE=$(CCTYPE) \
- RUNTIME=$(RUNTIME) CFG=$(CFG) $(CONFIGPM)
-
-$(MINIPERL) : ..\miniperlmain.obj $(CORE_OBJ) $(WIN32_OBJ)
- $(LINK32) -subsystem:console -out:$@ @<<
- $(LINK_FLAGS) ..\miniperlmain.obj $(CORE_OBJ) $(WIN32_OBJ)
-<<
-
-$(WIN32_OBJ) : $(CORE_H)
-$(CORE_OBJ) : $(CORE_H)
-$(DLL_OBJ) : $(CORE_H)
-
-perldll.def : $(MINIPERL) $(CONFIGPM)
- $(MINIPERL) -w makedef.pl $(CCTYPE) > perldll.def
-
-$(PERLDLL): perldll.def $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ)
- $(LINK32) -dll -def:perldll.def -out:$@ @<<
- $(LINK_FLAGS) $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ)
-<<
- $(XCOPY) $(PERLIMPLIB) ..\lib\CORE
-
-perl.def : $(MINIPERL) makeperldef.pl
- $(MINIPERL) -I..\lib makeperldef.pl $(NULL) > perl.def
-
-$(MINIMOD) : $(MINIPERL) ..\minimod.pl
- cd .. && miniperl minimod.pl > lib\ExtUtils\Miniperl.pm
-
-perlmain.c : runperl.c
- copy runperl.c perlmain.c
-
-perlmain.obj : perlmain.c
- $(CC) $(CFLAGS) -UPERLDLL -c perlmain.c
-
-$(PERLEXE): $(PERLDLL) $(CONFIGPM) perlmain.obj
- $(LINK32) -subsystem:console -out:perl.exe $(LINK_FLAGS) \
- perlmain.obj $(WINIOMAYBE) $(PERLIMPLIB)
- copy perl.exe $@
- del perl.exe
- copy splittree.pl ..
- $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto"
- attrib -r ..\t\*.*
- copy test ..\t
-
-perl95.c : runperl.c
- copy runperl.c perl95.c
-
-perl95.obj : perl95.c
- $(CC) $(CFLAGS) -MT -UPERLDLL -c perl95.c
-
-win32iomt.obj : win32io.c
- $(CC) $(CFLAGS) -MT -c $(OBJOUT_FLAG)win32iomt.obj win32io.c
-
-win32sckmt.obj : win32sck.c
- $(CC) $(CFLAGS) -MT -c $(OBJOUT_FLAG)win32sckmt.obj win32sck.c
-
-win32mt.obj : win32.c
- $(CC) $(CFLAGS) -MT -c $(OBJOUT_FLAG)win32mt.obj win32.c
-
-$(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ)
- $(LINK32) -subsystem:console -out:perl95.exe $(LINK_FLAGS) \
- $(PERL95_OBJ) $(PERLIMPLIB)
- copy perl95.exe $@
- del perl95.exe
-
-$(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM)
- if not exist ..\lib\auto md ..\lib\auto
- $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL)
- cd $(EXTDIR)\$(*B)
- $(XSUBPP) dl_win32.xs > $(*B).c
- cd ..\..\win32
-
-$(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs
- copy dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs
-
-$(IO_DLL): $(PERLEXE) $(CONFIGPM) $(IO).xs
- cd $(EXTDIR)\$(*B)
- ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
- $(MAKE)
- cd ..\..\win32
-
-$(SDBM_FILE_DLL) : $(PERLEXE) $(SDBM_FILE).xs
- cd $(EXTDIR)\$(*B)
- ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
- $(MAKE)
- cd ..\..\win32
-
-$(FCNTL_DLL): $(PERLEXE) $(FCNTL).xs
- cd $(EXTDIR)\$(*B)
- ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
- $(MAKE)
- cd ..\..\win32
-
-$(OPCODE_DLL): $(PERLEXE) $(OPCODE).xs
- cd $(EXTDIR)\$(*B)
- ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
- $(MAKE)
- cd ..\..\win32
-
-$(SOCKET_DLL): $(SOCKET).xs $(PERLEXE)
- cd $(EXTDIR)\$(*B)
- ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
- $(MAKE)
- cd ..\..\win32
-
-doc: $(PERLEXE)
- cd ..\pod
- $(MAKE) -f ..\win32\pod.mak checkpods pod2html pod2latex \
- pod2man pod2text
- $(XCOPY) *.bat ..\win32\bin\*.*
- cd ..\win32
- copy ..\README.win32 ..\pod\perlwin32.pod
- $(PERLEXE) ..\installhtml --podroot=.. --htmldir=./html \
- --podpath=pod:lib:ext:utils --htmlroot="//$(INST_HTML::=|)" \
- --libpod=perlfunc:perlguts:perlvar:perlrun:perlop --recurse
-
-utils: $(PERLEXE)
- cd ..\utils
- nmake PERL=$(MINIPERL)
- $(PERLEXE) ..\win32\$(PL2BAT) h2ph splain perlbug pl2pm c2ph
- $(PERLEXE) ..\win32\$(PL2BAT) h2xs perldoc pstruct
- $(XCOPY) *.bat ..\win32\bin\*.*
- cd ..\win32
- $(PERLEXE) $(PL2BAT) bin\network.pl bin\www.pl bin\runperl.pl \
- bin\pl2bat.pl
-
-distclean: clean
- -del /f $(MINIPERL) $(PERLEXE) $(PERLDLL) $(GLOBEXE) \
- $(PERLIMPLIB) ..\miniperl.lib $(MINIMOD)
- -del /f *.def *.map
- -del /f $(SOCKET_DLL) $(IO_DLL) $(SDBM_FILE_DLL) $(FCNTL_DLL) \
- $(OPCODE_DLL)
- -del /f $(SOCKET).c $(IO).c $(SDBM_FILE).c $(FCNTL).c $(OPCODE).c \
- $(DYNALOADER).c
- -del /f $(PODDIR)\*.html
- -del /f $(PODDIR)\*.bat
- -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c \
- config.h.new perl95.c
- -del /f bin\*.bat
- -rmdir /s /q ..\lib\auto
- -rmdir /s /q ..\lib\CORE
- cd $(EXTDIR)
- -del /s *.lib *.def *.map *.bs Makefile *.obj pm_to_blib
- cd ..\win32
-
-install : all doc utils
- if not exist $(INST_TOP) mkdir $(INST_TOP)
- echo I $(INST_TOP) L $(LIBDIR)
- $(XCOPY) $(PERLEXE) $(INST_BIN)\*.*
- $(XCOPY) $(PERL95EXE) $(INST_BIN)\*.*
- $(XCOPY) $(GLOBEXE) $(INST_BIN)\*.*
- $(XCOPY) $(PERLDLL) $(INST_BIN)\*.*
- $(XCOPY) bin\*.bat $(INST_BIN)\*.*
- $(RCOPY) ..\lib $(INST_LIB)\*.*
- $(XCOPY) ..\pod\*.bat $(INST_BIN)\*.*
- $(XCOPY) ..\pod\*.pod $(INST_POD)\*.*
- $(RCOPY) html\*.* $(INST_HTML)\*.*
-
-inst_lib : $(CONFIGPM)
- copy splittree.pl ..
- $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto"
- $(RCOPY) ..\lib $(INST_LIB)\*.*
-
-minitest : $(MINIPERL) $(GLOBEXE) $(CONFIGPM)
- $(XCOPY) $(MINIPERL) ..\t\perl.exe
- $(XCOPY) $(GLOBEXE) ..\t\$(NULL)
- attrib -r ..\t\*.*
- copy test ..\t
- cd ..\t
- $(MINIPERL) -I..\lib test base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t
- cd ..\win32
-
-test-prep : all
- $(XCOPY) $(PERLEXE) ..\t\$(NULL)
- $(XCOPY) $(PERLDLL) ..\t\$(NULL)
- $(XCOPY) $(GLOBEXE) ..\t\$(NULL)
-
-test : test-prep
- cd ..\t
- $(PERLEXE) -I..\lib harness
- cd ..\win32
-
-test-notty : test-prep
- set PERL_SKIP_TTY_TEST=1
- cd ..\t
- $(PERLEXE) -I..\lib harness
- cd ..\win32
-
-clean :
- -@erase miniperlmain.obj
- -@erase $(MINIPERL)
- -@erase perlglob.obj
- -@erase perlmain.obj
- -@erase config.w32
- -@erase /f config.h
- -@erase $(GLOBEXE)
- -@erase $(PERLEXE)
- -@erase $(PERLDLL)
- -@erase $(CORE_OBJ)
- -@erase $(WIN32_OBJ)
- -@erase $(DLL_OBJ)
- -@erase ..\*.obj ..\*.lib ..\*.exp *.obj *.lib *.exp
- -@erase ..\t\*.exe ..\t\*.dll ..\t\*.bat
- -@erase *.ilk
- -@erase *.pdb
-
-
+#
+# Makefile to build perl on Windows NT using Microsoft NMAKE.
+#
+# This is set up to build a perl.exe that runs off a shared library
+# (perl.dll). Also makes individual DLLs for the XS extensions.
+#
+
+##
+## Make sure you read README.win32 *before* you mess with anything here!
+##
+
+##
+## Build configuration. Edit the values below to suit your needs.
+##
+
+#
+# Set these to wherever you want "nmake install" to put your
+# newly built perl.
+#
+INST_DRV = c:
+INST_TOP = $(INST_DRV)\perl
+
+#
+# Comment this out if you DON'T want your perl installation to be versioned.
+# This means that the new installation will overwrite any files from the
+# old installation at the same INST_TOP location. Leaving it enabled is
+# the safest route, as perl adds the extra version directory to all the
+# locations it installs files to. If you disable it, an alternative
+# versioned installation can be obtained by setting INST_TOP above to a
+# path that includes an arbitrary version string.
+#
+INST_VER = \5.00503
+
+#
+# uncomment to enable threads-capabilities
+#
+#USE_THREADS = define
+
+#
+# uncomment to enable multiple interpreters
+#
+#USE_MULTI = define
+
+#
+# uncomment next line if you are using Visual C++ 2.x
+#
+#CCTYPE = MSVC20
+
+#
+# uncomment next line if you want to use the perl object
+# Currently, this cannot be enabled if you ask for threads above
+#
+#OBJECT = -DPERL_OBJECT
+
+#
+# uncomment next line if you want debug version of perl (big,slow)
+#
+#CFG = Debug
+
+#
+# uncomment next option if you want to use the VC++ compiler optimization.
+# Warning: This is known to produce incorrect code for compiler versions
+# earlier than VC++ 98 (Visual Studio 6.0). VC++ 98 generates code that
+# successfully passes the Perl regression test suite. It hasn't yet been
+# widely tested with real applications though.
+#
+#CFG = Optimize
+
+#
+# uncomment to enable use of PerlCRT.DLL when using the Visual C compiler.
+# Highly recommended. It has patches that fix known bugs in MSVCRT.DLL.
+# This currently requires VC 5.0 with Service Pack 3.
+# Get it from CPAN at http://www.perl.com/CPAN/authors/id/D/DO/DOUGL/
+# and follow the directions in the package to install.
+#
+#USE_PERLCRT = define
+
+#
+# uncomment to enable linking with setargv.obj under the Visual C
+# compiler. Setting this options enables perl to expand wildcards in
+# arguments, but it may be harder to use alternate methods like
+# File::DosGlob that are more powerful. This option is supported only with
+# Visual C.
+#
+#USE_SETARGV = define
+
+#
+# if you have the source for des_fcrypt(), uncomment this and make sure the
+# file exists (see README.win32). File should be located in the same
+# directory as this file.
+#
+#CRYPT_SRC = fcrypt.c
+
+#
+# if you didn't set CRYPT_SRC and if you have des_fcrypt() available in a
+# library, uncomment this, and make sure the library exists (see README.win32)
+# Specify the full pathname of the library.
+#
+#CRYPT_LIB = fcrypt.lib
+
+#
+# set this if you wish to use perl's malloc
+# WARNING: Turning this on/off WILL break binary compatibility with extensions
+# you may have compiled with/without it. Be prepared to recompile all
+# extensions if you change the default. Currently, this cannot be enabled
+# if you ask for PERL_OBJECT above.
+#
+#PERL_MALLOC = define
+
+#
+# set the install locations of the compiler include/libraries
+# Running VCVARS32.BAT is *required* when using Visual C.
+# Some versions of Visual C don't define MSVCDIR in the environment,
+# so you may have to set CCHOME explicitly (spaces in the path name should
+# not be quoted)
+#
+#CCHOME = f:\msvc20
+CCHOME = $(MSVCDIR)
+CCINCDIR = $(CCHOME)\include
+CCLIBDIR = $(CCHOME)\lib
+
+#
+# specify semicolon-separated list of extra directories that modules will
+# look for libraries (spaces in path names need not be quoted)
+#
+EXTRALIBDIRS =
+
+#
+# set this to your email address (perl will guess a value from
+# from your loginname and your hostname, which may not be right)
+#
+#EMAIL =
+
+##
+## Build configuration ends.
+##
+
+##################### CHANGE THESE ONLY IF YOU MUST #####################
+
+!IF "$(CRYPT_SRC)$(CRYPT_LIB)" == ""
+D_CRYPT = undef
+!ELSE
+D_CRYPT = define
+CRYPT_FLAG = -DHAVE_DES_FCRYPT
+!ENDIF
+
+!IF "$(OBJECT)" != ""
+PERL_MALLOC = undef
+USE_THREADS = undef
+USE_MULTI = undef
+!ENDIF
+
+!IF "$(PERL_MALLOC)" == ""
+PERL_MALLOC = undef
+!ENDIF
+
+!IF "$(USE_THREADS)" == ""
+USE_THREADS = undef
+!ENDIF
+
+!IF "$(USE_MULTI)" == ""
+USE_MULTI = undef
+!ENDIF
+
+#BUILDOPT = -DPERL_GLOBAL_STRUCT
+# -DUSE_PERLIO -D__STDC__=1 -DUSE_SFIO -DI_SFIO -I\sfio97\include
+
+!IF "$(PROCESSOR_ARCHITECTURE)" == ""
+PROCESSOR_ARCHITECTURE = x86
+!ENDIF
+
+!IF "$(OBJECT)" != ""
+ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-object
+!ELSE
+!IF "$(USE_THREADS)" == "define"
+ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-thread
+!ELSE
+ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)
+!ENDIF
+!ENDIF
+
+ARCHDIR = ..\lib\$(ARCHNAME)
+COREDIR = ..\lib\CORE
+AUTODIR = ..\lib\auto
+
+#
+# Programs to compile, build .lib files and link
+#
+
+CC = cl.exe
+LINK32 = link.exe
+LIB32 = $(LINK32) -lib
+
+#
+# Options
+#
+
+RUNTIME = -MD
+INCLUDES = -I$(COREDIR) -I.\include -I. -I..
+#PCHFLAGS = -Fpc:\temp\vcmoduls.pch -YX
+DEFINES = -DWIN32 -D_CONSOLE -DNO_STRICT $(BUILDOPT) $(CRYPT_FLAG)
+LOCDEFS = -DPERLDLL -DPERL_CORE
+SUBSYS = console
+CXX_FLAG = -TP -GX
+
+!IF "$(USE_PERLCRT)" == ""
+! IF "$(CFG)" == "Debug"
+PERLCRTLIBC = msvcrtd.lib
+! ELSE
+PERLCRTLIBC = msvcrt.lib
+! ENDIF
+!ELSE
+! IF "$(CFG)" == "Debug"
+PERLCRTLIBC = PerlCRTD.lib
+! ELSE
+PERLCRTLIBC = PerlCRT.lib
+! ENDIF
+!ENDIF
+
+!IF "$(RUNTIME)" == "-MD"
+LIBC = $(PERLCRTLIBC)
+!ELSE
+LIBC = libcmt.lib
+!ENDIF
+
+!IF "$(CFG)" == "Debug"
+! IF "$(CCTYPE)" == "MSVC20"
+OPTIMIZE = -Od $(RUNTIME) -Z7 -D_DEBUG -DDEBUGGING
+! ELSE
+OPTIMIZE = -Od $(RUNTIME)d -Zi -D_DEBUG -DDEBUGGING
+! ENDIF
+LINK_DBG = -debug -pdb:none
+!ELSE
+! IF "$(CFG)" == "Optimize"
+OPTIMIZE = -O2 $(RUNTIME) -DNDEBUG
+! ELSE
+OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
+! ENDIF
+LINK_DBG = -release
+!ENDIF
+
+!IF "$(OBJECT)" != ""
+OPTIMIZE = $(OPTIMIZE) $(CXX_FLAG)
+!ENDIF
+
+LIBBASEFILES = $(CRYPT_LIB) oldnames.lib kernel32.lib user32.lib gdi32.lib \
+ winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \
+ oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \
+ version.lib odbc32.lib odbccp32.lib
+
+# we add LIBC here, since we may be using PerlCRT.dll
+LIBFILES = $(LIBBASEFILES) $(LIBC)
+
+CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) \
+ $(PCHFLAGS) $(OPTIMIZE)
+LINK_FLAGS = -nologo -nodefaultlib $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE)
+OBJOUT_FLAG = -Fo
+EXEOUT_FLAG = -Fe
+
+CFLAGS_O = $(CFLAGS) $(OBJECT)
+
+#################### do not edit below this line #######################
+############# NO USER-SERVICEABLE PARTS BEYOND THIS POINT ##############
+
+o = .obj
+
+#
+# Rules
+#
+
+.SUFFIXES : .c $(o) .dll .lib .exe
+
+.c$(o):
+ $(CC) -c -I$(<D) $(CFLAGS_O) $(OBJOUT_FLAG)$@ $<
+
+.y.c:
+ $(NOOP)
+
+$(o).dll:
+ $(LINK32) -dll -subsystem:windows -implib:$(*B).lib -def:$(*B).def \
+ -out:$@ $(LINK_FLAGS) $(LIBFILES) $< $(LIBPERL)
+
+#
+INST_BIN = $(INST_TOP)$(INST_VER)\bin\$(ARCHNAME)
+INST_SCRIPT = $(INST_TOP)$(INST_VER)\bin
+INST_LIB = $(INST_TOP)$(INST_VER)\lib
+INST_POD = $(INST_LIB)\pod
+INST_HTML = $(INST_POD)\html
+LIBDIR = ..\lib
+EXTDIR = ..\ext
+PODDIR = ..\pod
+EXTUTILSDIR = $(LIBDIR)\extutils
+
+#
+# various targets
+!IF "$(OBJECT)" == "-DPERL_OBJECT"
+PERLIMPLIB = ..\perlcore.lib
+PERLDLL = ..\perlcore.dll
+CAPILIB = $(COREDIR)\perlCAPI.lib
+!ELSE
+PERLIMPLIB = ..\perl.lib
+PERLDLL = ..\perl.dll
+CAPILIB =
+!ENDIF
+
+MINIPERL = ..\miniperl.exe
+MINIDIR = .\mini
+PERLEXE = ..\perl.exe
+GLOBEXE = ..\perlglob.exe
+CONFIGPM = ..\lib\Config.pm
+MINIMOD = ..\lib\ExtUtils\Miniperl.pm
+X2P = ..\x2p\a2p.exe
+
+PL2BAT = bin\pl2bat.pl
+GLOBBAT = bin\perlglob.bat
+
+UTILS = \
+ ..\utils\h2ph \
+ ..\utils\splain \
+ ..\utils\perlbug \
+ ..\utils\pl2pm \
+ ..\utils\c2ph \
+ ..\utils\h2xs \
+ ..\utils\perldoc \
+ ..\utils\pstruct \
+ ..\utils\perlcc \
+ ..\pod\checkpods \
+ ..\pod\pod2html \
+ ..\pod\pod2latex \
+ ..\pod\pod2man \
+ ..\pod\pod2text \
+ ..\x2p\find2perl \
+ ..\x2p\s2p \
+ bin\www.pl \
+ bin\runperl.pl \
+ bin\pl2bat.pl \
+ bin\perlglob.pl \
+ bin\search.pl
+
+MAKE = nmake -nologo
+
+CFGSH_TMPL = config.vc
+CFGH_TMPL = config_H.vc
+
+!IF "$(USE_PERLCRT)" == ""
+PERL95EXE = ..\perl95.exe
+!ENDIF
+
+XCOPY = xcopy /f /r /i /d
+RCOPY = xcopy /f /r /i /e /d
+NOOP = @echo
+NULL =
+
+#
+# filenames given to xsubpp must have forward slashes (since it puts
+# full pathnames in #line strings)
+XSUBPP = ..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp \
+ -C++ -prototypes
+
+MICROCORE_SRC = \
+ ..\av.c \
+ ..\byterun.c \
+ ..\deb.c \
+ ..\doio.c \
+ ..\doop.c \
+ ..\dump.c \
+ ..\globals.c \
+ ..\gv.c \
+ ..\hv.c \
+ ..\mg.c \
+ ..\op.c \
+ ..\perl.c \
+ ..\perly.c \
+ ..\pp.c \
+ ..\pp_ctl.c \
+ ..\pp_hot.c \
+ ..\pp_sys.c \
+ ..\regcomp.c \
+ ..\regexec.c \
+ ..\run.c \
+ ..\scope.c \
+ ..\sv.c \
+ ..\taint.c \
+ ..\toke.c \
+ ..\universal.c \
+ ..\util.c
+
+!IF "$(PERL_MALLOC)" == "define"
+EXTRACORE_SRC = $(EXTRACORE_SRC) ..\malloc.c
+!ENDIF
+
+!IF "$(OBJECT)" == ""
+EXTRACORE_SRC = $(EXTRACORE_SRC) ..\perlio.c
+!ENDIF
+
+WIN32_SRC = \
+ .\win32.c \
+ .\win32sck.c
+
+!IF "$(USE_THREADS)" == "define"
+WIN32_SRC = $(WIN32_SRC) .\win32thread.c
+!ENDIF
+
+!IF "$(CRYPT_SRC)" != ""
+WIN32_SRC = $(WIN32_SRC) .\$(CRYPT_SRC)
+!ENDIF
+
+PERL95_SRC = \
+ perl95.c \
+ win32mt.c \
+ win32sckmt.c
+
+!IF "$(CRYPT_SRC)" != ""
+PERL95_SRC = $(PERL95_SRC) .\$(CRYPT_SRC)
+!ENDIF
+
+DLL_SRC = $(DYNALOADER).c
+
+
+!IF "$(OBJECT)" == ""
+DLL_SRC = $(DLL_SRC) perllib.c
+!ENDIF
+
+X2P_SRC = \
+ ..\x2p\a2p.c \
+ ..\x2p\hash.c \
+ ..\x2p\str.c \
+ ..\x2p\util.c \
+ ..\x2p\walk.c
+
+CORE_NOCFG_H = \
+ ..\av.h \
+ ..\byterun.h \
+ ..\bytecode.h \
+ ..\cop.h \
+ ..\cv.h \
+ ..\dosish.h \
+ ..\embed.h \
+ ..\form.h \
+ ..\gv.h \
+ ..\handy.h \
+ ..\hv.h \
+ ..\iperlsys.h \
+ ..\mg.h \
+ ..\nostdio.h \
+ ..\op.h \
+ ..\opcode.h \
+ ..\perl.h \
+ ..\perlsdio.h \
+ ..\perlsfio.h \
+ ..\perly.h \
+ ..\pp.h \
+ ..\proto.h \
+ ..\regexp.h \
+ ..\scope.h \
+ ..\sv.h \
+ ..\thread.h \
+ ..\unixish.h \
+ ..\util.h \
+ ..\XSUB.h \
+ ..\EXTERN.h \
+ ..\perlvars.h \
+ ..\intrpvar.h \
+ ..\thrdvar.h \
+ .\include\dirent.h \
+ .\include\netdb.h \
+ .\include\sys\socket.h \
+ .\win32.h
+
+CORE_H = $(CORE_NOCFG_H) .\config.h
+
+MICROCORE_OBJ = $(MICROCORE_SRC:.c=.obj)
+CORE_OBJ = $(MICROCORE_OBJ) $(EXTRACORE_SRC:.c=.obj)
+WIN32_OBJ = $(WIN32_SRC:.c=.obj)
+MINICORE_OBJ = $(MICROCORE_OBJ:..\=.\mini\) \
+ $(MINIDIR)\miniperlmain$(o) \
+ $(MINIDIR)\perlio$(o)
+MINIWIN32_OBJ = $(WIN32_OBJ:.\=.\mini\)
+MINI_OBJ = $(MINICORE_OBJ) $(MINIWIN32_OBJ)
+PERL95_OBJ = $(PERL95_SRC:.c=.obj)
+DLL_OBJ = $(DLL_SRC:.c=.obj)
+X2P_OBJ = $(X2P_SRC:.c=.obj)
+
+PERLDLL_OBJ = $(CORE_OBJ)
+PERLEXE_OBJ = perlmain$(o)
+
+!IF "$(OBJECT)" == ""
+PERLDLL_OBJ = $(PERLDLL_OBJ) $(WIN32_OBJ) $(DLL_OBJ)
+!ELSE
+PERLEXE_OBJ = $(PERLEXE_OBJ) $(WIN32_OBJ) $(DLL_OBJ)
+PERL95_OBJ = $(PERL95_OBJ) DynaLoadmt$(o)
+!ENDIF
+
+!IF "$(USE_SETARGV)" != ""
+SETARGV_OBJ = setargv$(o)
+!ENDIF
+
+DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re \
+ Data/Dumper
+STATIC_EXT = DynaLoader
+NONXS_EXT = Errno
+
+DYNALOADER = $(EXTDIR)\DynaLoader\DynaLoader
+SOCKET = $(EXTDIR)\Socket\Socket
+FCNTL = $(EXTDIR)\Fcntl\Fcntl
+OPCODE = $(EXTDIR)\Opcode\Opcode
+SDBM_FILE = $(EXTDIR)\SDBM_File\SDBM_File
+IO = $(EXTDIR)\IO\IO
+POSIX = $(EXTDIR)\POSIX\POSIX
+ATTRS = $(EXTDIR)\attrs\attrs
+THREAD = $(EXTDIR)\Thread\Thread
+B = $(EXTDIR)\B\B
+RE = $(EXTDIR)\re\re
+DUMPER = $(EXTDIR)\Data\Dumper\Dumper
+ERRNO = $(EXTDIR)\Errno\Errno
+
+SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll
+FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll
+OPCODE_DLL = $(AUTODIR)\Opcode\Opcode.dll
+SDBM_FILE_DLL = $(AUTODIR)\SDBM_File\SDBM_File.dll
+IO_DLL = $(AUTODIR)\IO\IO.dll
+POSIX_DLL = $(AUTODIR)\POSIX\POSIX.dll
+ATTRS_DLL = $(AUTODIR)\attrs\attrs.dll
+THREAD_DLL = $(AUTODIR)\Thread\Thread.dll
+B_DLL = $(AUTODIR)\B\B.dll
+DUMPER_DLL = $(AUTODIR)\Data\Dumper\Dumper.dll
+RE_DLL = $(AUTODIR)\re\re.dll
+
+ERRNO_PM = $(LIBDIR)\Errno.pm
+
+EXTENSION_C = \
+ $(SOCKET).c \
+ $(FCNTL).c \
+ $(OPCODE).c \
+ $(SDBM_FILE).c \
+ $(IO).c \
+ $(POSIX).c \
+ $(ATTRS).c \
+ $(THREAD).c \
+ $(RE).c \
+ $(DUMPER).c \
+ $(B).c
+
+EXTENSION_DLL = \
+ $(SOCKET_DLL) \
+ $(FCNTL_DLL) \
+ $(OPCODE_DLL) \
+ $(SDBM_FILE_DLL)\
+ $(IO_DLL) \
+ $(POSIX_DLL) \
+ $(ATTRS_DLL) \
+ $(DUMPER_DLL) \
+ $(B_DLL)
+
+EXTENSION_PM = \
+ $(ERRNO_PM)
+
+!IF "$(OBJECT)" == ""
+EXTENSION_DLL = \
+ $(EXTENSION_DLL)\
+ $(THREAD_DLL) \
+ $(RE_DLL)
+!ENDIF
+
+POD2HTML = $(PODDIR)\pod2html
+POD2MAN = $(PODDIR)\pod2man
+POD2LATEX = $(PODDIR)\pod2latex
+POD2TEXT = $(PODDIR)\pod2text
+
+CFG_VARS = \
+ "INST_DRV=$(INST_DRV)" \
+ "INST_TOP=$(INST_TOP)" \
+ "INST_VER=$(INST_VER)" \
+ "archname=$(ARCHNAME)" \
+ "cc=$(CC)" \
+ "ccflags=$(OPTIMIZE:"=\") $(DEFINES) $(OBJECT)" \
+ "cf_email=$(EMAIL)" \
+ "d_crypt=$(D_CRYPT)" \
+ "d_mymalloc=$(PERL_MALLOC)" \
+ "libs=$(LIBFILES)" \
+ "incpath=$(CCINCDIR:"=\")" \
+ "libperl=$(PERLIMPLIB:..\=)" \
+ "libpth=$(CCLIBDIR:"=\");$(EXTRALIBDIRS:"=\")" \
+ "libc=$(LIBC)" \
+ "make=nmake" \
+ "static_ext=$(STATIC_EXT)" \
+ "dynamic_ext=$(DYNAMIC_EXT)" \
+ "nonxs_ext=$(NONXS_EXT)" \
+ "usethreads=$(USE_THREADS)" \
+ "usemultiplicity=$(USE_MULTI)" \
+ "LINK_FLAGS=$(LINK_FLAGS:"=\")" \
+ "optimize=$(OPTIMIZE:"=\")"
+
+#
+# Top targets
+#
+
+all : .\config.h $(GLOBEXE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) $(PERL95EXE) \
+ $(CAPILIB) $(X2P) $(EXTENSION_DLL) $(EXTENSION_PM)
+
+$(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c
+
+#------------------------------------------------------------
+
+$(GLOBEXE) : perlglob$(o)
+ $(LINK32) $(LINK_FLAGS) $(LIBFILES) -out:$@ -subsystem:$(SUBSYS) \
+ perlglob$(o) setargv$(o)
+
+perlglob$(o) : perlglob.c
+
+config.w32 : $(CFGSH_TMPL)
+ copy $(CFGSH_TMPL) config.w32
+
+.\config.h : $(CFGH_TMPL)
+ -del /f config.h
+ copy $(CFGH_TMPL) config.h
+
+..\config.sh : config.w32 $(MINIPERL) config_sh.PL
+ $(MINIPERL) -I..\lib config_sh.PL $(CFG_VARS) config.w32 > ..\config.sh
+
+# this target is for when changes to the main config.sh happen
+# edit config.{b,v,g}c and make this target once for each supported
+# compiler (e.g. `dmake CCTYPE=BORLAND regen_config_h`)
+regen_config_h:
+ perl config_sh.PL $(CFG_VARS) $(CFGSH_TMPL) > ..\config.sh
+ cd ..
+ -del /f perl.exe
+ perl configpm
+ cd win32
+ -del /f $(CFGH_TMPL)
+ -mkdir $(COREDIR)
+ -perl -I..\lib config_h.PL "INST_VER=$(INST_VER)"
+ rename config.h $(CFGH_TMPL)
+
+$(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl
+ cd .. && miniperl configpm
+ if exist lib\* $(RCOPY) lib\*.* ..\lib\$(NULL)
+ $(XCOPY) ..\*.h $(COREDIR)\*.*
+ $(XCOPY) *.h $(COREDIR)\*.*
+ $(XCOPY) ..\ext\re\re.pm $(LIBDIR)\*.*
+ $(RCOPY) include $(COREDIR)\*.*
+ $(MINIPERL) -I..\lib config_h.PL "INST_VER=$(INST_VER)" \
+ || $(MAKE) /$(MAKEFLAGS) $(CONFIGPM)
+
+$(MINIPERL) : $(MINIDIR) $(MINI_OBJ)
+ $(LINK32) -subsystem:console -out:$@ @<<
+ $(LINK_FLAGS) $(LIBFILES) $(MINI_OBJ)
+<<
+
+$(MINIDIR) :
+ if not exist "$(MINIDIR)" mkdir "$(MINIDIR)"
+
+$(MINICORE_OBJ) : $(CORE_NOCFG_H)
+ $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ ..\$(*F).c
+
+$(MINIWIN32_OBJ) : $(CORE_NOCFG_H)
+ $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ $(*F).c
+
+# 1. we don't want to rebuild miniperl.exe when config.h changes
+# 2. we don't want to rebuild miniperl.exe with non-default config.h
+$(MINI_OBJ) : $(CORE_NOCFG_H)
+
+$(WIN32_OBJ) : $(CORE_H)
+$(CORE_OBJ) : $(CORE_H)
+$(DLL_OBJ) : $(CORE_H)
+$(PERL95_OBJ) : $(CORE_H)
+$(X2P_OBJ) : $(CORE_H)
+
+perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym makedef.pl
+ $(MINIPERL) -w makedef.pl $(OPTIMIZE) $(DEFINES) $(OBJECT) \
+ CCTYPE=$(CCTYPE) > perldll.def
+
+$(PERLDLL): perldll.def $(PERLDLL_OBJ)
+ $(LINK32) -dll -def:perldll.def -out:$@ @<<
+ $(LINK_FLAGS) $(LIBFILES) $(PERLDLL_OBJ)
+<<
+ $(XCOPY) $(PERLIMPLIB) $(COREDIR)
+
+perl.def : $(MINIPERL) makeperldef.pl
+ $(MINIPERL) -I..\lib makeperldef.pl $(NULL) > perl.def
+
+$(MINIMOD) : $(MINIPERL) ..\minimod.pl
+ cd .. && miniperl minimod.pl > lib\ExtUtils\Miniperl.pm
+
+..\x2p\a2p$(o) : ..\x2p\a2p.c
+ $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\a2p.c
+
+..\x2p\hash$(o) : ..\x2p\hash.c
+ $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\hash.c
+
+..\x2p\str$(o) : ..\x2p\str.c
+ $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\str.c
+
+..\x2p\util$(o) : ..\x2p\util.c
+ $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\util.c
+
+..\x2p\walk$(o) : ..\x2p\walk.c
+ $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\walk.c
+
+$(X2P) : $(MINIPERL) $(X2P_OBJ)
+ $(MINIPERL) ..\x2p\find2perl.PL
+ $(MINIPERL) ..\x2p\s2p.PL
+ $(LINK32) -subsystem:console -out:$@ @<<
+ $(LINK_FLAGS) $(LIBFILES) $(X2P_OBJ)
+<<
+
+perlmain.c : runperl.c
+ copy runperl.c perlmain.c
+
+perlmain$(o) : perlmain.c
+ $(CC) $(CFLAGS_O) -UPERLDLL $(OBJOUT_FLAG)$@ -c perlmain.c
+
+$(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ)
+ $(LINK32) -subsystem:console -out:$@ $(LINK_FLAGS) $(LIBFILES) \
+ $(PERLEXE_OBJ) $(SETARGV_OBJ) $(PERLIMPLIB)
+ copy splittree.pl ..
+ $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR)
+
+!IF "$(USE_PERLCRT)" == ""
+
+perl95.c : runperl.c
+ copy runperl.c perl95.c
+
+perl95$(o) : perl95.c
+ $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c perl95.c
+
+win32sckmt$(o) : win32sck.c
+ $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \
+ $(OBJOUT_FLAG)win32sckmt$(o) win32sck.c
+
+win32mt$(o) : win32.c
+ $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \
+ $(OBJOUT_FLAG)win32mt$(o) win32.c
+
+DynaLoadmt$(o) : $(DYNALOADER).c
+ $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \
+ $(OBJOUT_FLAG)DynaLoadmt$(o) $(DYNALOADER).c
+
+$(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ)
+ $(LINK32) -subsystem:console -nodefaultlib -out:$@ $(LINK_FLAGS) \
+ $(LIBBASEFILES) $(PERL95_OBJ) $(SETARGV_OBJ) $(PERLIMPLIB) \
+ libcmt.lib
+
+!ENDIF
+
+$(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM)
+ if not exist $(AUTODIR) mkdir $(AUTODIR)
+ cd $(EXTDIR)\$(*B)
+ ..\$(MINIPERL) -I..\..\lib $(*B)_pm.PL
+ cd ..\..\win32
+ $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL)
+ cd $(EXTDIR)\$(*B)
+ $(XSUBPP) dl_win32.xs > $(*B).c
+ cd ..\..\win32
+
+!IF "$(OBJECT)" == "-DPERL_OBJECT"
+perlCAPI.cpp : $(MINIPERL)
+ $(MINIPERL) GenCAPI.pl $(COREDIR)
+
+perlCAPI$(o) : perlCAPI.cpp
+ $(CC) $(CFLAGS_O) $(RUNTIME) -UPERLDLL -c \
+ $(OBJOUT_FLAG)perlCAPI$(o) perlCAPI.cpp
+
+$(CAPILIB) : perlCAPI.cpp perlCAPI$(o)
+ lib /OUT:$(CAPILIB) perlCAPI$(o)
+!ENDIF
+
+$(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs
+ copy dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs
+
+$(DUMPER_DLL): $(PERLEXE) $(DUMPER).xs
+ cd $(EXTDIR)\Data\$(*B)
+ ..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl
+ $(MAKE)
+ cd ..\..\..\win32
+
+$(RE_DLL): $(PERLEXE) $(RE).xs
+ cd $(EXTDIR)\$(*B)
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ $(MAKE)
+ cd ..\..\win32
+
+$(B_DLL): $(PERLEXE) $(B).xs
+ cd $(EXTDIR)\$(*B)
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ $(MAKE)
+ cd ..\..\win32
+
+$(THREAD_DLL): $(PERLEXE) $(THREAD).xs
+ cd $(EXTDIR)\$(*B)
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ $(MAKE)
+ cd ..\..\win32
+
+$(ATTRS_DLL): $(PERLEXE) $(ATTRS).xs
+ cd $(EXTDIR)\$(*B)
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ $(MAKE)
+ cd ..\..\win32
+
+$(POSIX_DLL): $(PERLEXE) $(POSIX).xs
+ cd $(EXTDIR)\$(*B)
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ $(MAKE)
+ cd ..\..\win32
+
+$(IO_DLL): $(PERLEXE) $(IO).xs
+ cd $(EXTDIR)\$(*B)
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ $(MAKE)
+ cd ..\..\win32
+
+$(SDBM_FILE_DLL) : $(PERLEXE) $(SDBM_FILE).xs
+ cd $(EXTDIR)\$(*B)
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ $(MAKE)
+ cd ..\..\win32
+
+$(FCNTL_DLL): $(PERLEXE) $(FCNTL).xs
+ cd $(EXTDIR)\$(*B)
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ $(MAKE)
+ cd ..\..\win32
+
+$(OPCODE_DLL): $(PERLEXE) $(OPCODE).xs
+ cd $(EXTDIR)\$(*B)
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ $(MAKE)
+ cd ..\..\win32
+
+$(SOCKET_DLL): $(PERLEXE) $(SOCKET).xs
+ cd $(EXTDIR)\$(*B)
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ $(MAKE)
+ cd ..\..\win32
+
+$(ERRNO_PM): $(PERLEXE) $(ERRNO)_pm.PL
+ cd $(EXTDIR)\$(*B)
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ $(MAKE)
+ cd ..\..\win32
+
+doc: $(PERLEXE)
+ $(PERLEXE) -I..\lib ..\installhtml --podroot=.. --htmldir=./html \
+ --podpath=pod:lib:ext:utils --htmlroot="file://$(INST_HTML::=|)" \
+ --libpod=perlfunc:perlguts:perlvar:perlrun:perlop --recurse
+
+utils: $(PERLEXE) $(X2P)
+ cd ..\utils
+ $(MAKE) PERL=$(MINIPERL)
+ cd ..\pod
+ copy ..\README.win32 .\perlwin32.pod
+ $(MAKE) -f ..\win32\pod.mak converters
+ cd ..\win32
+ $(PERLEXE) $(PL2BAT) $(UTILS)
+
+distclean: clean
+ -del /f $(MINIPERL) $(PERLEXE) $(PERL95EXE) $(PERLDLL) $(GLOBEXE) \
+ $(PERLIMPLIB) ..\miniperl.lib $(MINIMOD)
+ -del /f *.def *.map
+ -del /f $(EXTENSION_DLL) $(EXTENSION_PM)
+ -del /f $(EXTENSION_C) $(DYNALOADER).c $(ERRNO).pm
+ -del /f $(EXTDIR)\DynaLoader\dl_win32.xs
+ -del /f $(LIBDIR)\.exists $(LIBDIR)\attrs.pm $(LIBDIR)\DynaLoader.pm
+ -del /f $(LIBDIR)\Fcntl.pm $(LIBDIR)\IO.pm $(LIBDIR)\Opcode.pm
+ -del /f $(LIBDIR)\ops.pm $(LIBDIR)\Safe.pm $(LIBDIR)\Thread.pm
+ -del /f $(LIBDIR)\SDBM_File.pm $(LIBDIR)\Socket.pm $(LIBDIR)\POSIX.pm
+ -del /f $(LIBDIR)\B.pm $(LIBDIR)\O.pm $(LIBDIR)\re.pm
+ -del /f $(LIBDIR)\Data\Dumper.pm
+ -rmdir /s /q $(LIBDIR)\IO || rmdir /s $(LIBDIR)\IO
+ -rmdir /s /q $(LIBDIR)\Thread || rmdir /s $(LIBDIR)\Thread
+ -rmdir /s /q $(LIBDIR)\B || rmdir /s $(LIBDIR)\B
+ -rmdir /s /q $(LIBDIR)\Data || rmdir /s $(LIBDIR)\Data
+ -del /f $(PODDIR)\*.html
+ -del /f $(PODDIR)\*.bat
+ cd ..\utils
+ -del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc pstruct
+ -del /f *.bat
+ cd ..\win32
+ cd ..\x2p
+ -del /f find2perl s2p
+ -del /f *.bat
+ cd ..\win32
+ -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new
+ -del /f $(CONFIGPM)
+ -del /f perl95.c
+ -del /f bin\*.bat
+ cd $(EXTDIR)
+ -del /s *.lib *.def *.map *.pdb *.bs Makefile *$(o) pm_to_blib
+ cd ..\win32
+ -rmdir /s /q $(AUTODIR) || rmdir /s $(AUTODIR)
+ -rmdir /s /q $(COREDIR) || rmdir /s $(COREDIR)
+
+install : all installbare installhtml
+
+installbare : utils
+ $(PERLEXE) ..\installperl
+!IF "$(USE_PERLCRT)" == ""
+ $(XCOPY) $(PERL95EXE) $(INST_BIN)\*.*
+!ENDIF
+ $(XCOPY) $(GLOBEXE) $(INST_BIN)\*.*
+ $(XCOPY) bin\*.bat $(INST_SCRIPT)\*.*
+ $(XCOPY) bin\network.pl $(INST_LIB)\*.*
+
+installhtml : doc
+ $(RCOPY) html\*.* $(INST_HTML)\*.*
+
+inst_lib : $(CONFIGPM)
+ copy splittree.pl ..
+ $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR)
+ $(RCOPY) ..\lib $(INST_LIB)\*.*
+
+minitest : $(MINIPERL) $(GLOBEXE) $(CONFIGPM) utils
+ $(XCOPY) $(MINIPERL) ..\t\perl.exe
+ $(XCOPY) $(GLOBEXE) ..\t\$(NULL)
+ attrib -r ..\t\*.*
+ copy test ..\t
+ cd ..\t
+ $(MINIPERL) -I..\lib test base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t
+ cd ..\win32
+
+test-prep : all utils
+ $(XCOPY) $(PERLEXE) ..\t\$(NULL)
+ $(XCOPY) $(PERLDLL) ..\t\$(NULL)
+ $(XCOPY) $(GLOBEXE) ..\t\$(NULL)
+
+test : test-prep
+ cd ..\t
+ $(PERLEXE) -I..\lib harness
+ cd ..\win32
+
+test-notty : test-prep
+ set PERL_SKIP_TTY_TEST=1
+ cd ..\t
+ $(PERLEXE) -I..\lib harness
+ cd ..\win32
+
+clean :
+ -@erase miniperlmain$(o)
+ -@erase $(MINIPERL)
+ -@erase perlglob$(o)
+ -@erase perlmain$(o)
+ -@erase config.w32
+ -@erase /f config.h
+ -@erase perlCAPI.cpp
+ -@erase $(GLOBEXE)
+ -@erase $(PERLEXE)
+ -@erase $(PERLDLL)
+ -@erase $(CORE_OBJ)
+ -@erase $(CAPILIB)
+ -rmdir /s /q $(MINIDIR) || rmdir /s $(MINIDIR)
+ -@erase $(WIN32_OBJ)
+ -@erase $(DLL_OBJ)
+ -@erase $(X2P_OBJ)
+ -@erase ..\*$(o) ..\*.lib ..\*.exp ..\*.res *$(o) *.lib *.exp *.res
+ -@erase ..\t\*.exe ..\t\*.dll ..\t\*.bat
+ -@erase ..\x2p\*.exe ..\x2p\*.bat
+ -@erase *.ilk
+ -@erase *.pdb
diff --git a/gnu/usr.bin/perl/win32/bin/pl2bat.pl b/gnu/usr.bin/perl/win32/bin/pl2bat.pl
index 73ae87164da..2fa80885005 100644
--- a/gnu/usr.bin/perl/win32/bin/pl2bat.pl
+++ b/gnu/usr.bin/perl/win32/bin/pl2bat.pl
@@ -1,73 +1,121 @@
-#!perl -w
+ eval 'exec perl -x -S "$0" ${1+"$@"}'
+ if 0; # In case running under some shell
+
require 5;
use Getopt::Std;
+use Config;
$0 =~ s|.*[/\\]||;
my $usage = <<EOT;
-Usage: $0 [-h] [-a argstring] [-s stripsuffix] [files]
+Usage: $0 [-h]
+ or: $0 [-w] [-u] [-a argstring] [-s stripsuffix] [files]
+ or: $0 [-w] [-u] [-n ntargs] [-o otherargs] [-s stripsuffix] [files]
+ -n ntargs arguments to invoke perl with in generated file
+ when run from Windows NT. Defaults to
+ '-x -S "%0" %*'.
+ -o otherargs arguments to invoke perl with in generated file
+ other than when run from Windows NT. Defaults
+ to '-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9'.
-a argstring arguments to invoke perl with in generated file
- Defaults to "-x -S %0 %*" on WindowsNT,
- "-x -S %0 %1 %2 %3 %4 %5 %6 %7 %8 %9" otherwise
+ ignoring operating system (for compatibility
+ with previous pl2bat versions).
+ -u update files that may have already been processed
+ by (some version of) pl2bat.
+ -w include "-w" on the /^#!.*perl/ line (unless
+ a /^#!.*perl/ line was already present).
-s stripsuffix strip this suffix from file before appending ".bat"
- Not case-sensitive
+ Not case-sensitive
Can be a regex if it begins with `/'
- Defaults to "/\.pl/"
+ Defaults to "/\.plx?/"
-h show this help
EOT
my %OPT = ();
-warn($usage), exit(0) if !getopts('ha:s:',\%OPT) or $OPT{'h'};
-$OPT{'a'} = ($^O eq 'MSWin32' and &Win32::IsWinNT
- ? '-x -S %0 %*'
- : '-x -S %0 %1 %2 %3 %4 %5 %6 %7 %8 %9')
- unless exists $OPT{'a'};
-$OPT{'s'} = '.pl' unless exists $OPT{'s'};
+warn($usage), exit(0) if !getopts('whun:o:a:s:',\%OPT) or $OPT{'h'};
+$OPT{'n'} = '-x -S "%0" %*' unless exists $OPT{'n'};
+$OPT{'o'} = '-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9' unless exists $OPT{'o'};
+$OPT{'s'} = '/\\.plx?/' unless exists $OPT{'s'};
$OPT{'s'} = ($OPT{'s'} =~ m|^/([^/]*)| ? $1 : "\Q$OPT{'s'}\E");
-(my $head = <<EOT) =~ s/^\t//gm;
+my $head;
+if( defined( $OPT{'a'} ) ) {
+ $head = <<EOT;
\@rem = '--*-Perl-*--
\@echo off
perl $OPT{'a'}
goto endofperl
\@rem ';
EOT
+} else {
+ $head = <<EOT;
+ \@rem = '--*-Perl-*--
+ \@echo off
+ if "%OS%" == "Windows_NT" goto WinNT
+ perl $OPT{'o'}
+ goto endofperl
+ :WinNT
+ perl $OPT{'n'}
+ if NOT "%COMSPEC%" == "%SystemRoot%\\system32\\cmd.exe" goto endofperl
+ if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+ goto endofperl
+ \@rem ';
+EOT
+}
+$head =~ s/^\t//gm;
my $headlines = 2 + ($head =~ tr/\n/\n/);
my $tail = "__END__\n:endofperl\n";
@ARGV = ('-') unless @ARGV;
-process(@ARGV);
+foreach ( @ARGV ) {
+ process($_);
+}
sub process {
- LOOP:
- foreach ( @_ ) {
- my $myhead = $head;
- my $linedone = 0;
- my $linenum = $headlines;
- my $line;
- open( FILE, $_ ) or die "$0: Can't open $_: $!";
- @file = <FILE>;
- foreach $line ( @file ) {
- $linenum++;
- if ( $line =~ /^:endofperl/) {
- warn "$0: $_ has already been converted to a batch file!\n";
- next LOOP;
+ my( $file )= @_;
+ my $myhead = $head;
+ my $linedone = 0;
+ my $taildone = 0;
+ my $linenum = 0;
+ my $skiplines = 0;
+ my $line;
+ my $start= $Config{startperl};
+ $start= "#!perl" unless $start =~ /^#!.*perl/;
+ open( FILE, $file ) or die "$0: Can't open $file: $!";
+ @file = <FILE>;
+ foreach $line ( @file ) {
+ $linenum++;
+ if ( $line =~ /^:endofperl\b/ ) {
+ if( ! exists $OPT{'u'} ) {
+ warn "$0: $file has already been converted to a batch file!\n";
+ return;
}
- if ( not $linedone and $line =~ /^#!.*perl/ ) {
- $line .= "#line $linenum\n";
- $linedone++;
+ $taildone++;
+ }
+ if ( not $linedone and $line =~ /^#!.*perl/ ) {
+ if( exists $OPT{'u'} ) {
+ $skiplines = $linenum - 1;
+ $line .= "#line ".(1+$headlines)."\n";
+ } else {
+ $line .= "#line ".($linenum+$headlines)."\n";
}
- }
- close( FILE );
- s/$OPT{'s'}$//oi;
- $_ .= '.bat' unless /\.bat$/i or /^-$/;
- open( FILE, ">$_" ) or die "Can't open $_: $!";
- print FILE $myhead;
- print FILE "#!perl\n#line " . ($headlines+1) . "\n" unless $linedone;
- print FILE @file, $tail;
- close( FILE );
+ $linedone++;
+ }
+ if ( $line =~ /^#\s*line\b/ and $linenum == 2 + $skiplines ) {
+ $line = "";
+ }
}
+ close( FILE );
+ $file =~ s/$OPT{'s'}$//oi;
+ $file .= '.bat' unless $file =~ /\.bat$/i or $file =~ /^-$/;
+ open( FILE, ">$file" ) or die "Can't open $file: $!";
+ print FILE $myhead;
+ print FILE $start, ( $OPT{'w'} ? " -w" : "" ),
+ "\n#line ", ($headlines+1), "\n" unless $linedone;
+ print FILE @file[$skiplines..$#file];
+ print FILE $tail unless $taildone;
+ close( FILE );
}
__END__
@@ -77,7 +125,11 @@ pl2bat - wrap perl code into a batch file
=head1 SYNOPSIS
-B<pl2bat> [B<-h>] S<[B<-a> I<argstring>]> S<[B<-s> I<stripsuffix>]> [files]
+B<pl2bat> B<-h>
+
+B<pl2bat> [B<-w>] S<[B<-a> I<argstring>]> S<[B<-s> I<stripsuffix>]> [files]
+
+B<pl2bat> [B<-w>] S<[B<-n> I<ntargs>]> S<[B<-o> I<otherargs>]> S<[B<-s> I<stripsuffix>]> [files]
=head1 DESCRIPTION
@@ -88,32 +140,64 @@ Note that by default, the ".pl" suffix will be stripped before adding
a ".bat" suffix to the supplied file names. This can be controlled
with the C<-s> option.
-The default behavior on WindowsNT is to generate a batch file that
+The default behavior is to have the batch file compare the C<OS>
+environment variable against C<"Windows_NT">. If they match, it
uses the C<%*> construct to refer to all the command line arguments
that were given to it, so you'll need to make sure that works on your
variant of the command shell. It is known to work in the cmd.exe shell
under WindowsNT. 4DOS/NT users will want to put a C<ParameterChar = *>
line in their initialization file, or execute C<setdos /p*> in
-the shell startup file. On Windows95 and other platforms a nine
-argument limit is imposed on command-line arguments given to the
-generated batch file, since they may not support C<%*> in batch files.
-This can be overridden using the C<-a> option.
+the shell startup file.
+
+On Windows95 and other platforms a nine-argument limit is imposed
+on command-line arguments given to the generated batch file, since
+they may not support C<%*> in batch files.
+
+These can be overridden using the C<-n> and C<-o> options or the
+deprecated C<-a> option.
=head1 OPTIONS
=over 8
+=item B<-n> I<ntargs>
+
+Arguments to invoke perl with in generated batch file when run from
+Windows NT (or Windows 98, probably). Defaults to S<'-x -S "%0" %*'>.
+
+=item B<-o> I<otherargs>
+
+Arguments to invoke perl with in generated batch file except when
+run from Windows NT (ie. when run from DOS, Windows 3.1, or Windows 95).
+Defaults to S<'-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9'>.
+
=item B<-a> I<argstring>
-Arguments to invoke perl with in generated batch file. Defaults to
-S<"-x -S %0 %*"> on WindowsNT, S<"-x -S %0 %1 %2 %3 %4 %5 %6 %7 %8 %9">
-on other platforms.
+Arguments to invoke perl with in generated batch file. Specifying
+B<-a> prevents the batch file from checking the C<OS> environment
+variable to determine which operating system it is being run from.
=item B<-s> I<stripsuffix>
Strip a suffix string from file name before appending a ".bat"
-suffix. The suffix is not case-sensitive. It can be a regex if it
-begins with `/' (the trailing '/' being optional. Defaults to ".pl".
+suffix. The suffix is not case-sensitive. It can be a regex if
+it begins with `/' (the trailing '/' is optional and a trailing
+C<$> is always assumed). Defaults to C</.plx?/>.
+
+=item B<-w>
+
+If no line matching C</^#!.*perl/> is found in the script, then such
+a line is inserted just after the new preamble. The exact line
+depends on C<$Config{startperl}> [see L<Config>]. With the B<-w>
+option, C<" -w"> is added after the value of C<$Config{startperl}>.
+If a line matching C</^#!.*perl/> already exists in the script,
+then it is not changed and the B<-w> option is ignored.
+
+=item B<-u>
+
+If the script appears to have already been processed by B<pl2bat>,
+then the script is skipped and not processed unless B<-u> was
+specified. If B<-u> is specified, the existing preamble is replaced.
=item B<-h>
@@ -135,6 +219,13 @@ Show command line usage.
print scalar reverse "rekcah lrep rehtona tsuj\n";
^Z
[..another.bat is now a certified japh application..]
+
+ C:\> ren *.bat *.pl
+ C:\> pl2bat -u *.pl
+ [..updates the wrapping of some previously wrapped scripts..]
+
+ C:\> pl2bat -u -s .bat *.bat
+ [..same as previous example except more dangerous..]
=head1 BUGS
@@ -142,8 +233,8 @@ C<$0> will contain the full name, including the ".bat" suffix
when the generated batch file runs. If you don't like this,
see runperl.bat for an alternative way to invoke perl scripts.
-Default behavior is to invoke Perl with the -S flag, so Perl will
-search the PATH to find the script. This may have undesirable
+Default behavior is to invoke Perl with the B<-S> flag, so Perl will
+search the PATH to find the script. This may have undesirable
effects.
=head1 SEE ALSO
diff --git a/gnu/usr.bin/perl/win32/bin/search.pl b/gnu/usr.bin/perl/win32/bin/search.pl
index b63f7353aff..ad74001be5f 100644
--- a/gnu/usr.bin/perl/win32/bin/search.pl
+++ b/gnu/usr.bin/perl/win32/bin/search.pl
@@ -71,6 +71,7 @@ sub init
{
## initialize variables that might be reset by command-line args
$DOREP=0; ## set true by -dorep (redo multi-hardlink files)
+ $DOREP=1 if $^O eq 'MSWin32';
$DO_SORT=0; ## set by -sort (sort files in a dir before checking)
$FIND_ONLY=0; ## set by -find (don't search files)
$LIST_ONLY=0; ## set true by -l (list filenames only)
@@ -867,7 +868,7 @@ sub dodir
}
## skip things that are empty
- unless (-s _) {
+ unless (-s _ || -d _) {
warn qq/skip (empty): $file\n/ if $WHY;
next;
}
@@ -894,7 +895,7 @@ sub dodir
}
## _never_ redo a directory
- if (defined $dir_done{$id}) {
+ if (defined $dir_done{$id} and $^O ne 'MSWin32') {
warn qq/skip (did as "$dir_done{$id}"): $file\n/ if $WHY;
next;
}
diff --git a/gnu/usr.bin/perl/win32/config.bc b/gnu/usr.bin/perl/win32/config.bc
index ad76309e5d9..eef2440d482 100644
--- a/gnu/usr.bin/perl/win32/config.bc
+++ b/gnu/usr.bin/perl/win32/config.bc
@@ -1,32 +1,5 @@
-#
-## This file was hand coded and a lot of information is invalid
-#
## Configured by: ~cf_email~
## Target system: WIN32
-#
-
-archlibexp='~INST_TOP~\lib'
-archname='MSWin32'
-cc='bcc32'
-ccflags='-DWIN32'
-cppflags='-DWIN32'
-dlsrc='dl_win32.xs'
-dynamic_ext='Fcntl IO Opcode SDBM_File Socket'
-extensions='Fcntl IO Opcode SDBM_File Socket'
-installarchlib='~INST_TOP~\lib'
-installprivlib='~INST_TOP~\lib'
-libpth=''
-libs=''
-osname='MSWin32'
-osvers='4.0'
-prefix='~INST_DRV~'
-privlibexp='~INST_TOP~\lib'
-sharpbang='#!'
-shsharp='true'
-sig_name='ZERO HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM USR1 USR2 CHLD PWR WINCH URG IO STOP TSTP CONT TTIN TTOU VTALRM PROF XCPU XFSZ WAITING LWP FREEZE THAW RTMIN NUM37 NUM38 NUM39 NUM40 NUM41 NUM42 RTMAX IOT CLD POLL'
-so='dll'
-startsh='#!/bin/sh'
-static_ext=' '
Author=''
CONFIG='true'
Date='$Date'
@@ -36,34 +9,42 @@ Locker=''
Log='$Log'
Mcc='Mcc'
PATCHLEVEL='~PATCHLEVEL~'
-POSIX_cflags='ccflags="$ccflags -DSTRUCT_TM_HASZONE"'
RCSfile='$RCSfile'
Revision='$Revision'
SUBVERSION='~SUBVERSION~'
Source=''
State=''
+_a='.lib'
+_exe='.exe'
+_o='.obj'
afs='false'
alignbytes='8'
+ansi2knr=''
aphostname=''
+apiversion='5.005'
ar='tlib /P128'
-archlib='~INST_TOP~\lib'
+archlib='~INST_TOP~~INST_VER~\lib\~archname~'
+archlibexp='~INST_TOP~~INST_VER~\lib\~archname~'
+archname='MSWin32'
archobjs=''
awk='awk'
baserev='5.0'
bash=''
-bin='~INST_TOP~\bin'
-binexp='~INST_TOP~\bin'
+bin='~INST_TOP~~INST_VER~\bin\~archname~'
+binexp='~INST_TOP~~INST_VER~\bin\~archname~'
bison=''
byacc='byacc'
byteorder='1234'
c=''
castflags='0'
cat='type'
-cccdlflags=''
-ccdlflags=' '
-cf_by='garyng'
-cf_email='71564.1743@compuserve.com'
-cf_time='Thu Apr 11 06:20:49 PDT 1996'
+cc='bcc32'
+cccdlflags=' '
+ccdlflags='-tWD'
+ccflags='-DWIN32'
+cf_by='nobody'
+cf_email='nobody@no.where.net'
+cf_time=''
chgrp=''
chmod=''
chown=''
@@ -73,12 +54,13 @@ compress=''
contains='grep'
cp='copy'
cpio=''
-cpp='cpp32'
+cpp='cpp32 -oCON'
cpp_stuff='42'
+cppflags='-DWIN32'
cpplast=''
cppminus=''
-cpprun=''
-cppstdin=''
+cpprun='cpp32 -oCON'
+cppstdin='cpp32 -oCON'
cryptlib=''
csh='undef'
d_Gconvert='gcvt((x),(n),(b))'
@@ -88,10 +70,8 @@ d_archlib='define'
d_attribut='undef'
d_bcmp='undef'
d_bcopy='undef'
-d_bincompat3='undef'
d_bsd='define'
d_bsdgetpgrp='undef'
-d_bsdpgrp='undef'
d_bsdsetpgrp='undef'
d_bzero='undef'
d_casti32='define'
@@ -113,6 +93,12 @@ d_dlopen='define'
d_dlsymun='undef'
d_dosuid='undef'
d_dup2='define'
+d_endgrent='undef'
+d_endhent='undef'
+d_endnent='undef'
+d_endpent='undef'
+d_endpwent='undef'
+d_endsent='undef'
d_eofnblk='define'
d_eunice='undef'
d_fchmod='undef'
@@ -127,25 +113,47 @@ d_flock='define'
d_fork='undef'
d_fpathconf='undef'
d_fsetpos='define'
+d_ftime='define'
+d_getgrent='undef'
d_getgrps='undef'
-d_setgrps='undef'
+d_gethbyaddr='define'
+d_gethbyname='define'
d_gethent='undef'
-d_gethname='undef'
-d_getlogin='undef'
+d_gethname='define'
+d_gethostprotos='define'
+d_getlogin='define'
+d_getnbyaddr='undef'
+d_getnbyname='undef'
+d_getnent='undef'
+d_getnetprotos='undef'
+d_getpbyname='define'
+d_getpbynumber='define'
+d_getpent='undef'
+d_getpwent='undef'
+d_getpgid='undef'
d_getpgrp2='undef'
d_getpgrp='undef'
-d_getpgid='undef'
d_getppid='undef'
d_getprior='undef'
+d_getprotoprotos='define'
+d_getsbyname='define'
+d_getsbyport='define'
+d_getsent='undef'
+d_getservprotos='define'
d_gettimeod='undef'
+d_grpasswd='undef'
+d_gnulibc='undef'
d_htonl='define'
d_index='undef'
d_inetaton='undef'
d_isascii='define'
d_killpg='undef'
+d_lchown='undef'
d_link='undef'
d_locconv='define'
d_lockf='undef'
+d_longdbl='define'
+d_longlong='undef'
d_lstat='undef'
d_mblen='define'
d_mbstowcs='define'
@@ -158,13 +166,13 @@ d_mkdir='define'
d_mkfifo='undef'
d_mktime='define'
d_msg='undef'
-d_msgctl='define'
-d_msgget='define'
-d_msgrcv='define'
-d_msgsnd='define'
+d_msgctl='undef'
+d_msgget='undef'
+d_msgrcv='undef'
+d_msgsnd='undef'
d_mymalloc='undef'
d_nice='undef'
-d_oldarchlib='undef'
+d_oldpthreads='undef'
d_oldsock='undef'
d_open3='undef'
d_pathconf='undef'
@@ -173,12 +181,16 @@ d_phostname='undef'
d_pipe='define'
d_poll='undef'
d_portable='define'
+d_pthread_yield='undef'
+d_pthreads_created_joinable='undef'
d_pwage='undef'
d_pwchange='undef'
d_pwclass='undef'
d_pwcomment='undef'
d_pwexpire='undef'
+d_pwgecos='undef'
d_pwquota='undef'
+d_pwpasswd='undef'
d_readdir='define'
d_readlink='undef'
d_rename='define'
@@ -187,16 +199,25 @@ d_rmdir='define'
d_safebcpy='undef'
d_safemcpy='undef'
d_sanemcmp='define'
+d_sched_yield='undef'
d_seekdir='define'
d_select='define'
d_sem='undef'
-d_semctl='define'
-d_semget='define'
-d_semop='define'
+d_semctl='undef'
+d_semctl_semid_ds='undef'
+d_semctl_semun='undef'
+d_semget='undef'
+d_semop='undef'
d_setegid='undef'
d_seteuid='undef'
+d_setgrent='undef'
+d_setgrps='undef'
+d_sethent='undef'
+d_setpwent='undef'
d_setlinebuf='undef'
d_setlocale='define'
+d_setnent='undef'
+d_setpent='undef'
d_setpgid='undef'
d_setpgrp2='undef'
d_setpgrp='undef'
@@ -207,20 +228,18 @@ d_setresuid='undef'
d_setreuid='undef'
d_setrgid='undef'
d_setruid='undef'
+d_setsent='undef'
d_setsid='undef'
+d_setvbuf='define'
d_sfio='undef'
d_shm='undef'
d_shmat='undef'
d_shmatprototype='undef'
-d_shmctl='define'
-d_shmdt='define'
-d_shmget='define'
-d_shrplib='undef'
+d_shmctl='undef'
+d_shmdt='undef'
+d_shmget='undef'
d_sigaction='undef'
-d_sigintrp=''
d_sigsetjmp='undef'
-d_sigvec='define'
-d_sigvectr='undef'
d_socket='define'
d_sockpair='undef'
d_statblks='undef'
@@ -253,6 +272,7 @@ d_truncate='undef'
d_tzname='define'
d_umask='define'
d_uname='undef'
+d_union_semun='define'
d_vfork='undef'
d_void_closedir='undef'
d_voidsig='define'
@@ -260,7 +280,7 @@ d_voidtty=''
d_volatile='define'
d_vprintf='define'
d_wait4='undef'
-d_waitpid='undef'
+d_waitpid='define'
d_wcstombs='define'
d_wctomb='define'
d_xenix='undef'
@@ -270,13 +290,18 @@ db_prefixtype='int'
defvoidused='15'
direntrytype='struct direct'
dlext='dll'
+dlsrc='dl_win32.xs'
+doublesize='8'
+dynamic_ext='Socket IO Fcntl Opcode SDBM_File attrs Thread'
eagain='EAGAIN'
+ebcdic='undef'
echo='echo'
egrep='egrep'
emacs=''
eunicefix=':'
exe_ext='.exe'
expr='expr'
+extensions='~static_ext~ ~dynamic_ext~ ~nonxs_ext~'
find='find'
firstmakefile='makefile'
flex=''
@@ -284,18 +309,19 @@ fpostype='fpos_t'
freetype='void'
full_csh=''
full_sed=''
-gcc=''
gccversion=''
gidtype='gid_t'
glibpth='/usr/shlib /lib/pa1.1 /usr/lib/large /lib /usr/lib /usr/lib/386 /lib/386 /lib/large /usr/lib/small /lib/small /usr/ccs/lib /usr/ucblib /usr/shlib '
grep='grep'
groupcat=''
groupstype='gid_t'
+gzip='gzip'
h_fcntl='false'
h_sysfile='true'
hint='recommended'
hostcat='ypcat hosts'
huge=''
+i_arpainet='define'
i_bsdioctl=''
i_db='undef'
i_dbm='undef'
@@ -304,14 +330,15 @@ i_dld='undef'
i_dlfcn='define'
i_fcntl='define'
i_float='define'
-i_gdbm='define'
-i_grp='define'
+i_gdbm='undef'
+i_grp='undef'
i_limits='define'
i_locale='define'
i_malloc='define'
i_math='define'
i_memory='undef'
i_ndbm='undef'
+i_netdb='undef'
i_neterrno='undef'
i_niin='undef'
i_pwd='undef'
@@ -350,22 +377,29 @@ i_varhdr='varargs.h'
i_vfork='undef'
incpath=''
inews=''
-installbin='~INST_TOP~\bin'
-installman1dir='~INST_TOP~\man\man1'
-installman3dir='~INST_TOP~\man\man3'
-installscript='~INST_TOP~\bin'
-installsitearch='~INST_TOP~\lib\site'
-installsitelib='~INST_TOP~\lib\site'
+installarchlib='~INST_TOP~~INST_VER~\lib\~archname~'
+installbin='~INST_TOP~~INST_VER~\bin\~archname~'
+installman1dir='~INST_TOP~~INST_VER~\man\man1'
+installman3dir='~INST_TOP~~INST_VER~\man\man3'
+installhtmldir='~INST_TOP~~INST_VER~\html'
+installhtmlhelpdir='~INST_TOP~~INST_VER~\htmlhelp'
+installprivlib='~INST_TOP~~INST_VER~\lib'
+installscript='~INST_TOP~~INST_VER~\bin'
+installsitearch='~INST_TOP~\site~INST_VER~\lib\~archname~'
+installsitelib='~INST_TOP~\site~INST_VER~\lib'
intsize='4'
-known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket'
+known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket IO attrs Thread'
ksh=''
large=''
ld='tlink32'
-lddlflags='-Tpd'
-ldflags=''
+lddlflags='-Tpd ~LINK_FLAGS~'
+ldflags='~LINK_FLAGS~'
less='less'
lib_ext='.lib'
libc='cw32mti.lib'
+libperl='perl.lib'
+libpth=''
+libs=''
libswanted='net socket inet nsl nm ndbm gdbm dbm db malloc dl dld ld sun m c cposix posix ndir dir crypt ucb bsd BSD PW x'
line='line'
lint=''
@@ -374,6 +408,8 @@ ln=''
lns='copy'
locincpth='/usr/local/include /opt/local/include /usr/gnu/include /opt/gnu/include /usr/GNU/include /opt/GNU/include'
loclibpth='/usr/local/lib /opt/local/lib /usr/gnu/lib /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib'
+longdblsize='10'
+longlongsize='8'
longsize='4'
lp=''
lpr=''
@@ -382,14 +418,15 @@ lseektype='off_t'
mail=''
mailx=''
make='dmake'
+make_set_make='#'
mallocobj='malloc.o'
mallocsrc='malloc.c'
malloctype='void *'
-man1dir='~INST_TOP~\man\man1'
-man1direxp='~INST_TOP~\man\man1'
+man1dir='~INST_TOP~~INST_VER~\man\man1'
+man1direxp='~INST_TOP~~INST_VER~\man\man1'
man1ext='1'
-man3dir='~INST_TOP~\man\man3'
-man3direxp='~INST_TOP~\man\man3'
+man3dir='~INST_TOP~~INST_VER~\man\man3'
+man3direxp='~INST_TOP~~INST_VER~\man\man3'
man3ext='3'
medium=''
mips=''
@@ -404,81 +441,104 @@ mydomain=''
myhostname=''
myuname=''
n='-n'
+netdb_hlen_type='int'
+netdb_host_type='char *'
+netdb_name_type='char *'
+netdb_net_type='long'
+nm=''
nm_opt=''
nm_so_opt=''
+nonxs_ext='Errno'
nroff=''
o_nonblock='O_NONBLOCK'
obj_ext='.obj'
-oldarchlib=''
-oldarchlibexp=''
-optimize='-O'
+optimize='-O2'
orderlib='false'
+osname='MSWin32'
+osvers='4.0'
package='perl5'
pager='more /e'
passcat=''
-patchlevel='2'
+patchlevel='~PATCHLEVEL~'
path_sep=';'
perl='perl'
perladmin=''
-perlpath='~INST_TOP~\bin\perl.exe'
+perlpath='~INST_TOP~~INST_VER~\bin\~archname~\perl.exe'
pg=''
phostname='hostname'
+pidtype='int'
plibpth=''
pmake=''
pr=''
+prefix='~INST_TOP~'
prefixexp='~INST_DRV~'
-privlib='~INST_TOP~\lib'
+privlib='~INST_TOP~~INST_VER~\lib'
+privlibexp='~INST_TOP~~INST_VER~\lib'
prototype='define'
+ptrsize='4'
randbits='15'
-ranlib=''
+ranlib='rem'
rd_nodata='-1'
rm='del'
rmail=''
runnm='true'
-scriptdir='~INST_TOP~\bin'
-scriptdirexp='~INST_TOP~\bin'
+scriptdir='~INST_TOP~~INST_VER~\bin'
+scriptdirexp='~INST_TOP~~INST_VER~\bin'
sed='sed'
-selecttype='int *'
+selecttype='Perl_fd_set *'
sendmail='blat'
sh='cmd /x /c'
shar=''
+sharpbang='#!'
shmattype='void *'
shortsize='2'
-shrpdir='none'
-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 6 18 22'
+shrpenv=''
+shsharp='true'
+sig_name='ZERO NUM01 INT QUIT ILL NUM05 NUM06 NUM07 FPE KILL NUM10 SEGV NUM12 PIPE ALRM TERM USR1 USR2 CHLD NUM19 USR3 BREAK ABRT STOP NUM24 CONT CLD'
+sig_name_init='"ZERO", "NUM01", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "USR1", "USR2", "CHLD", "NUM19", "USR3", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0'
+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 18 0'
+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, 18, 0'
signal_t='void'
-sitearch='~INST_TOP~\lib\site'
-sitearchexp='~INST_TOP~\lib\site'
-sitelib='~INST_TOP~\lib\site'
-sitelibexp='~INST_TOP~\lib\site'
+sitearch='~INST_TOP~\site~INST_VER~\lib\~archname~'
+sitearchexp='~INST_TOP~\site~INST_VER~\lib\~archname~'
+sitelib='~INST_TOP~\site~INST_VER~\lib'
+sitelibexp='~INST_TOP~\site~INST_VER~\lib'
sizetype='size_t'
sleep=''
smail=''
small=''
+so='dll'
sockethdr=''
socketlib=''
sort='sort'
spackage='Perl5'
spitshell=''
split=''
+src=''
ssizetype='int'
-startperl='#perl'
+startperl='#!perl'
+startsh='#!/bin/sh'
+static_ext='DynaLoader'
stdchar='unsigned char'
stdio_base='((fp)->buffer)'
stdio_bufsiz='((fp)->level + (fp)->curp - (fp)->buffer)'
stdio_cnt='((fp)->level)'
+stdio_filbuf=''
stdio_ptr='((fp)->curp)'
strings='/usr/include/string.h'
submit=''
+subversion='~SUBVERSION~'
sysman='/usr/man/man1'
tail=''
tar=''
tbl=''
+tee=''
test=''
timeincl='/usr/include/sys/time.h '
timetype='time_t'
touch='touch'
tr=''
+trnl='\012'
troff=''
uidtype='uid_t'
uname='uname'
@@ -486,13 +546,18 @@ uniq='uniq'
usedl='define'
usemymalloc='n'
usenm='false'
+useopcode='true'
useperlio='undef'
useposix='true'
-usesafe='true'
+usesfio='false'
+useshrplib='yes'
+usethreads='undef'
usevfork='false'
usrinc='/usr/include'
uuname=''
+version='~VERSION~'
vi=''
voidflags='15'
xlibpth='/usr/lib/386 /lib/386'
zcat=''
+zip='zip'
diff --git a/gnu/usr.bin/perl/win32/config.vc b/gnu/usr.bin/perl/win32/config.vc
index 7cc91dabd3b..df6e0e02a22 100644
--- a/gnu/usr.bin/perl/win32/config.vc
+++ b/gnu/usr.bin/perl/win32/config.vc
@@ -1,32 +1,5 @@
-#
-## This file was hand coded and a lot of information is invalid
-#
## Configured by: ~cf_email~
## Target system: WIN32
-#
-
-archlibexp='~INST_TOP~\lib'
-archname='MSWin32'
-cc='cl'
-ccflags='-MD -DWIN32'
-cppflags='-DWIN32'
-dlsrc='dl_win32.xs'
-dynamic_ext='Fcntl IO Opcode SDBM_File Socket'
-extensions='Fcntl IO Opcode SDBM_File Socket'
-installarchlib='~INST_TOP~\lib'
-installprivlib='~INST_TOP~\lib'
-libpth=''
-libs=''
-osname='MSWin32'
-osvers='4.0'
-prefix='~INST_DRV~'
-privlibexp='~INST_TOP~\lib'
-sharpbang='#!'
-shsharp='true'
-sig_name='ZERO HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM USR1 USR2 CHLD PWR WINCH URG IO STOP TSTP CONT TTIN TTOU VTALRM PROF XCPU XFSZ WAITING LWP FREEZE THAW RTMIN NUM37 NUM38 NUM39 NUM40 NUM41 NUM42 RTMAX IOT CLD POLL'
-so='dll'
-startsh='#!/bin/sh'
-static_ext=' '
Author=''
CONFIG='true'
Date='$Date'
@@ -36,34 +9,42 @@ Locker=''
Log='$Log'
Mcc='Mcc'
PATCHLEVEL='~PATCHLEVEL~'
-POSIX_cflags='ccflags="$ccflags -DSTRUCT_TM_HASZONE"'
RCSfile='$RCSfile'
Revision='$Revision'
SUBVERSION='~SUBVERSION~'
Source=''
State=''
+_a='.lib'
+_exe='.exe'
+_o='.obj'
afs='false'
alignbytes='8'
+ansi2knr=''
aphostname=''
+apiversion='5.005'
ar='lib'
-archlib='~INST_TOP~\lib'
+archlib='~INST_TOP~~INST_VER~\lib\~archname~'
+archlibexp='~INST_TOP~~INST_VER~\lib\~archname~'
+archname='MSWin32'
archobjs=''
awk='awk'
baserev='5.0'
bash=''
-bin='~INST_TOP~\bin'
-binexp='~INST_TOP~\bin'
+bin='~INST_TOP~~INST_VER~\bin\~archname~'
+binexp='~INST_TOP~~INST_VER~\bin\~archname~'
bison=''
byacc='byacc'
byteorder='1234'
c=''
castflags='0'
cat='type'
-cccdlflags=''
+cc='cl'
+cccdlflags=' '
ccdlflags=' '
-cf_by='garyng'
-cf_email='71564.1743@compuserve.com'
-cf_time='Thu Apr 11 06:20:49 PDT 1996'
+ccflags='-MD -DWIN32'
+cf_by='nobody'
+cf_email='nobody@no.where.net'
+cf_time=''
chgrp=''
chmod=''
chown=''
@@ -73,12 +54,13 @@ compress=''
contains='grep'
cp='copy'
cpio=''
-cpp='cpp'
+cpp='cl -nologo -E'
cpp_stuff='42'
+cppflags='-DWIN32'
cpplast=''
cppminus=''
-cpprun='cl -E'
-cppstdin='cl -E'
+cpprun='cl -nologo -E'
+cppstdin='cl -nologo -E'
cryptlib=''
csh='undef'
d_Gconvert='sprintf((b),"%.*g",(n),(x))'
@@ -88,10 +70,8 @@ d_archlib='define'
d_attribut='undef'
d_bcmp='undef'
d_bcopy='undef'
-d_bincompat3='undef'
d_bsd='define'
d_bsdgetpgrp='undef'
-d_bsdpgrp='undef'
d_bsdsetpgrp='undef'
d_bzero='undef'
d_casti32='define'
@@ -113,6 +93,12 @@ d_dlopen='define'
d_dlsymun='undef'
d_dosuid='undef'
d_dup2='define'
+d_endgrent='undef'
+d_endhent='undef'
+d_endnent='undef'
+d_endpent='undef'
+d_endpwent='undef'
+d_endsent='undef'
d_eofnblk='define'
d_eunice='undef'
d_fchmod='undef'
@@ -127,25 +113,47 @@ d_flock='define'
d_fork='undef'
d_fpathconf='undef'
d_fsetpos='define'
+d_ftime='define'
+d_getgrent='undef'
d_getgrps='undef'
-d_setgrps='undef'
+d_gethbyaddr='define'
+d_gethbyname='define'
d_gethent='undef'
-d_gethname='undef'
-d_getlogin='undef'
+d_gethname='define'
+d_gethostprotos='define'
+d_getlogin='define'
+d_getnbyaddr='undef'
+d_getnbyname='undef'
+d_getnent='undef'
+d_getnetprotos='undef'
+d_getpbyname='define'
+d_getpbynumber='define'
+d_getpent='undef'
+d_getpwent='undef'
+d_getpgid='undef'
d_getpgrp2='undef'
d_getpgrp='undef'
-d_getpgid='undef'
d_getppid='undef'
d_getprior='undef'
+d_getprotoprotos='define'
+d_getsbyname='define'
+d_getsbyport='define'
+d_getsent='undef'
+d_getservprotos='define'
d_gettimeod='undef'
+d_grpasswd='undef'
+d_gnulibc='undef'
d_htonl='define'
d_index='undef'
d_inetaton='undef'
d_isascii='define'
d_killpg='undef'
+d_lchown='undef'
d_link='undef'
d_locconv='define'
d_lockf='undef'
+d_longdbl='define'
+d_longlong='undef'
d_lstat='undef'
d_mblen='define'
d_mbstowcs='define'
@@ -158,13 +166,13 @@ d_mkdir='define'
d_mkfifo='undef'
d_mktime='define'
d_msg='undef'
-d_msgctl='define'
-d_msgget='define'
-d_msgrcv='define'
-d_msgsnd='define'
+d_msgctl='undef'
+d_msgget='undef'
+d_msgrcv='undef'
+d_msgsnd='undef'
d_mymalloc='undef'
d_nice='undef'
-d_oldarchlib='undef'
+d_oldpthreads='undef'
d_oldsock='undef'
d_open3='undef'
d_pathconf='undef'
@@ -173,12 +181,16 @@ d_phostname='undef'
d_pipe='define'
d_poll='undef'
d_portable='define'
+d_pthread_yield='undef'
+d_pthreads_created_joinable='undef'
d_pwage='undef'
d_pwchange='undef'
d_pwclass='undef'
d_pwcomment='undef'
d_pwexpire='undef'
+d_pwgecos='undef'
d_pwquota='undef'
+d_pwpasswd='undef'
d_readdir='define'
d_readlink='undef'
d_rename='define'
@@ -187,16 +199,25 @@ d_rmdir='define'
d_safebcpy='undef'
d_safemcpy='undef'
d_sanemcmp='define'
+d_sched_yield='undef'
d_seekdir='define'
d_select='define'
d_sem='undef'
-d_semctl='define'
-d_semget='define'
-d_semop='define'
+d_semctl='undef'
+d_semctl_semid_ds='undef'
+d_semctl_semun='undef'
+d_semget='undef'
+d_semop='undef'
d_setegid='undef'
d_seteuid='undef'
+d_setgrent='undef'
+d_setgrps='undef'
+d_sethent='undef'
+d_setpwent='undef'
d_setlinebuf='undef'
d_setlocale='define'
+d_setnent='undef'
+d_setpent='undef'
d_setpgid='undef'
d_setpgrp2='undef'
d_setpgrp='undef'
@@ -207,20 +228,18 @@ d_setresuid='undef'
d_setreuid='undef'
d_setrgid='undef'
d_setruid='undef'
+d_setsent='undef'
d_setsid='undef'
+d_setvbuf='define'
d_sfio='undef'
d_shm='undef'
d_shmat='undef'
d_shmatprototype='undef'
-d_shmctl='define'
-d_shmdt='define'
-d_shmget='define'
-d_shrplib='undef'
+d_shmctl='undef'
+d_shmdt='undef'
+d_shmget='undef'
d_sigaction='undef'
-d_sigintrp=''
d_sigsetjmp='undef'
-d_sigvec='define'
-d_sigvectr='undef'
d_socket='define'
d_sockpair='undef'
d_statblks='undef'
@@ -253,6 +272,7 @@ d_truncate='undef'
d_tzname='define'
d_umask='define'
d_uname='undef'
+d_union_semun='define'
d_vfork='undef'
d_void_closedir='undef'
d_voidsig='define'
@@ -260,7 +280,7 @@ d_voidtty=''
d_volatile='define'
d_vprintf='define'
d_wait4='undef'
-d_waitpid='undef'
+d_waitpid='define'
d_wcstombs='define'
d_wctomb='define'
d_xenix='undef'
@@ -270,13 +290,18 @@ db_prefixtype='int'
defvoidused='15'
direntrytype='struct direct'
dlext='dll'
+dlsrc='dl_win32.xs'
+doublesize='8'
+dynamic_ext='Socket IO Fcntl Opcode SDBM_File attrs Thread'
eagain='EAGAIN'
+ebcdic='undef'
echo='echo'
egrep='egrep'
emacs=''
eunicefix=':'
exe_ext='.exe'
expr='expr'
+extensions='~static_ext~ ~dynamic_ext~ ~nonxs_ext~'
find='find'
firstmakefile='makefile'
flex=''
@@ -284,18 +309,19 @@ fpostype='fpos_t'
freetype='void'
full_csh=''
full_sed=''
-gcc=''
gccversion=''
gidtype='gid_t'
glibpth='/usr/shlib /lib/pa1.1 /usr/lib/large /lib /usr/lib /usr/lib/386 /lib/386 /lib/large /usr/lib/small /lib/small /usr/ccs/lib /usr/ucblib /usr/shlib '
grep='grep'
groupcat=''
groupstype='gid_t'
+gzip='gzip'
h_fcntl='false'
h_sysfile='true'
hint='recommended'
hostcat='ypcat hosts'
huge=''
+i_arpainet='define'
i_bsdioctl=''
i_db='undef'
i_dbm='undef'
@@ -304,14 +330,15 @@ i_dld='undef'
i_dlfcn='define'
i_fcntl='define'
i_float='define'
-i_gdbm='define'
-i_grp='define'
+i_gdbm='undef'
+i_grp='undef'
i_limits='define'
i_locale='define'
i_malloc='define'
i_math='define'
i_memory='undef'
i_ndbm='undef'
+i_netdb='undef'
i_neterrno='undef'
i_niin='undef'
i_pwd='undef'
@@ -350,22 +377,29 @@ i_varhdr='varargs.h'
i_vfork='undef'
incpath=''
inews=''
-installbin='~INST_TOP~\bin'
-installman1dir='~INST_TOP~\man\man1'
-installman3dir='~INST_TOP~\man\man3'
-installscript='~INST_TOP~\bin'
-installsitearch='~INST_TOP~\lib\site'
-installsitelib='~INST_TOP~\lib\site'
+installarchlib='~INST_TOP~~INST_VER~\lib\~archname~'
+installbin='~INST_TOP~~INST_VER~\bin\~archname~'
+installman1dir='~INST_TOP~~INST_VER~\man\man1'
+installman3dir='~INST_TOP~~INST_VER~\man\man3'
+installhtmldir='~INST_TOP~~INST_VER~\html'
+installhtmlhelpdir='~INST_TOP~~INST_VER~\htmlhelp'
+installprivlib='~INST_TOP~~INST_VER~\lib'
+installscript='~INST_TOP~~INST_VER~\bin'
+installsitearch='~INST_TOP~\site~INST_VER~\lib\~archname~'
+installsitelib='~INST_TOP~\site~INST_VER~\lib'
intsize='4'
-known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket'
+known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket IO attrs Thread'
ksh=''
large=''
ld='link'
-lddlflags='-dll'
-ldflags='-nologo -subsystem:windows'
+lddlflags='-dll ~LINK_FLAGS~'
+ldflags='~LINK_FLAGS~'
less='less'
lib_ext='.lib'
libc='msvcrt.lib'
+libperl='perl.lib'
+libpth=''
+libs=''
libswanted='net socket inet nsl nm ndbm gdbm dbm db malloc dl dld ld sun m c cposix posix ndir dir crypt ucb bsd BSD PW x'
line='line'
lint=''
@@ -374,6 +408,8 @@ ln=''
lns='copy'
locincpth='/usr/local/include /opt/local/include /usr/gnu/include /opt/gnu/include /usr/GNU/include /opt/GNU/include'
loclibpth='/usr/local/lib /opt/local/lib /usr/gnu/lib /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib'
+longdblsize='10'
+longlongsize='8'
longsize='4'
lp=''
lpr=''
@@ -382,14 +418,15 @@ lseektype='off_t'
mail=''
mailx=''
make='nmake'
+make_set_make='#'
mallocobj='malloc.o'
mallocsrc='malloc.c'
malloctype='void *'
-man1dir='~INST_TOP~\man\man1'
-man1direxp='~INST_TOP~\man\man1'
+man1dir='~INST_TOP~~INST_VER~\man\man1'
+man1direxp='~INST_TOP~~INST_VER~\man\man1'
man1ext='1'
-man3dir='~INST_TOP~\man\man3'
-man3direxp='~INST_TOP~\man\man3'
+man3dir='~INST_TOP~~INST_VER~\man\man3'
+man3direxp='~INST_TOP~~INST_VER~\man\man3'
man3ext='3'
medium=''
mips=''
@@ -404,81 +441,104 @@ mydomain=''
myhostname=''
myuname=''
n='-n'
+netdb_hlen_type='int'
+netdb_host_type='char *'
+netdb_name_type='char *'
+netdb_net_type='long'
+nm=''
nm_opt=''
nm_so_opt=''
+nonxs_ext='Errno'
nroff=''
o_nonblock='O_NONBLOCK'
obj_ext='.obj'
-oldarchlib=''
-oldarchlibexp=''
optimize='-O'
orderlib='false'
+osname='MSWin32'
+osvers='4.0'
package='perl5'
pager='more /e'
passcat=''
-patchlevel='2'
+patchlevel='~PATCHLEVEL~'
path_sep=';'
perl='perl'
perladmin=''
-perlpath='~INST_TOP~\bin\perl.exe'
+perlpath='~INST_TOP~~INST_VER~\bin\~archname~\perl.exe'
pg=''
phostname='hostname'
+pidtype='int'
plibpth=''
pmake=''
pr=''
+prefix='~INST_TOP~'
prefixexp='~INST_DRV~'
-privlib='~INST_TOP~\lib'
+privlib='~INST_TOP~~INST_VER~\lib'
+privlibexp='~INST_TOP~~INST_VER~\lib'
prototype='define'
+ptrsize='4'
randbits='15'
-ranlib=''
+ranlib='rem'
rd_nodata='-1'
rm='del'
rmail=''
runnm='true'
-scriptdir='~INST_TOP~\bin'
-scriptdirexp='~INST_TOP~\bin'
+scriptdir='~INST_TOP~~INST_VER~\bin'
+scriptdirexp='~INST_TOP~~INST_VER~\bin'
sed='sed'
-selecttype='int *'
+selecttype='Perl_fd_set *'
sendmail='blat'
sh='cmd /x /c'
shar=''
+sharpbang='#!'
shmattype='void *'
shortsize='2'
-shrpdir='none'
-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 6 18 22'
+shrpenv=''
+shsharp='true'
+sig_name='ZERO NUM01 INT QUIT ILL NUM05 NUM06 NUM07 FPE KILL NUM10 SEGV NUM12 PIPE ALRM TERM NUM16 NUM17 NUM18 NUM19 CHLD BREAK ABRT STOP NUM24 CONT CLD'
+sig_name_init='"ZERO", "NUM01", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "NUM16", "NUM17", "NUM18", "NUM19", "CHLD", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0'
+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 20 0'
+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, 20, 0'
signal_t='void'
-sitearch='~INST_TOP~\lib\site'
-sitearchexp='~INST_TOP~\lib\site'
-sitelib='~INST_TOP~\lib\site'
-sitelibexp='~INST_TOP~\lib\site'
+sitearch='~INST_TOP~\site~INST_VER~\lib\~archname~'
+sitearchexp='~INST_TOP~\site~INST_VER~\lib\~archname~'
+sitelib='~INST_TOP~\site~INST_VER~\lib'
+sitelibexp='~INST_TOP~\site~INST_VER~\lib'
sizetype='size_t'
sleep=''
smail=''
small=''
+so='dll'
sockethdr=''
socketlib=''
sort='sort'
spackage='Perl5'
spitshell=''
split=''
+src=''
ssizetype='int'
-startperl='#perl'
-stdchar='unsigned char'
+startperl='#!perl'
+startsh='#!/bin/sh'
+static_ext='DynaLoader'
+stdchar='char'
stdio_base='((fp)->_base)'
stdio_bufsiz='((fp)->_cnt + (fp)->_ptr - (fp)->_base)'
stdio_cnt='((fp)->_cnt)'
+stdio_filbuf=''
stdio_ptr='((fp)->_ptr)'
strings='/usr/include/string.h'
submit=''
+subversion='~SUBVERSION~'
sysman='/usr/man/man1'
tail=''
tar=''
tbl=''
+tee=''
test=''
timeincl='/usr/include/sys/time.h '
timetype='time_t'
touch='touch'
tr=''
+trnl='\012'
troff=''
uidtype='uid_t'
uname='uname'
@@ -486,13 +546,18 @@ uniq='uniq'
usedl='define'
usemymalloc='n'
usenm='false'
+useopcode='true'
useperlio='undef'
useposix='true'
-usesafe='true'
+usesfio='false'
+useshrplib='yes'
+usethreads='undef'
usevfork='false'
usrinc='/usr/include'
uuname=''
+version='~VERSION~'
vi=''
voidflags='15'
xlibpth='/usr/lib/386 /lib/386'
zcat=''
+zip='zip'
diff --git a/gnu/usr.bin/perl/win32/config_H.bc b/gnu/usr.bin/perl/win32/config_H.bc
index 61fb5a32412..1d895dd188a 100644
--- a/gnu/usr.bin/perl/win32/config_H.bc
+++ b/gnu/usr.bin/perl/win32/config_H.bc
@@ -7,51 +7,24 @@
* that running config_h.SH again will wipe out any changes you've made.
* For a more permanent change edit config.sh and rerun config_h.SH.
*
- * $Id: Config_h.U,v 3.0.1.4 1995/09/25 09:10:49 ram Exp $
+ * $Id: Config_h.U,v 3.0.1.5 1997/02/28 14:57:43 ram Exp $
*/
-/* Configuration time: Thu Apr 11 06:20:49 PDT 1996
- * Configured by: garyng
- * Target system:
+/*
+ * Package name : perl5
+ * Source directory :
+ * Configuration time: undef
+ * Configured by : gsar
+ * Target system :
*/
#ifndef _config_h_
#define _config_h_
-/* MEM_ALIGNBYTES:
- * This symbol contains the number of bytes required to align a
- * double. Usual values are 2, 4 and 8.
- * On NeXT starting with 3.2, you can build "Fat" Multiple Architecture
- * Binaries (MAB) for targets with varying alignment. This only matters
- * for perl, where the config.h can be generated and installed on one
- * system, and used by a different architecture to build an extension.
- * The default is eight, for safety.
- */
-#ifndef NeXT
-#define MEM_ALIGNBYTES 8 /**/
-#else /* NeXT */
-#ifdef __m68k__
-#define MEM_ALIGNBYTES 2
-#else
-#ifdef __i386__
-#define MEM_ALIGNBYTES 4
-#else /* __hppa__, __sparc__ and default for unknown architectures */
-#define MEM_ALIGNBYTES 8
-#endif /* __i386__ */
-#endif /* __m68k__ */
-#endif /* NeXT */
-
-/* ARCHNAME:
- * This symbol holds a string representing the architecture name.
- * It may be used to construct an architecture-dependant pathname
- * where library files may be held under a private library, for
- * instance.
+/* LOC_SED:
+ * This symbol holds the complete pathname to the sed program.
*/
-#ifdef _ALPHA_
-#define ARCHNAME "alpha-mswin32" /**/
-#else
-#define ARCHNAME "x86-mswin32" /**/
-#endif
+#define LOC_SED "" /**/
/* BIN:
* This symbol holds the path of the bin directory where the package will
@@ -61,38 +34,8 @@
* This symbol is the filename expanded version of the BIN symbol, for
* programs that do not want to deal with that at run-time.
*/
-#define BIN "c:\\perl\\bin" /**/
-#define BIN_EXP "c:\\perl\\bin" /**/
-
-/* CAT2:
- * This macro catenates 2 tokens together.
- */
-/* STRINGIFY:
- * This macro surrounds its token with double quotes.
- */
-#if 42 == 1
-#define CAT2(a,b)a/**/b
-#define CAT3(a,b,c)a/**/b/**/c
-#define CAT4(a,b,c,d)a/**/b/**/c/**/d
-#define CAT5(a,b,c,d,e)a/**/b/**/c/**/d/**/e
-#define STRINGIFY(a)"a"
- /* If you can get stringification with catify, tell me how! */
-#endif
-#if 42 == 42
-#define CAT2(a,b)a ## b
-#define CAT3(a,b,c)a ## b ## c
-#define CAT4(a,b,c,d)a ## b ## c ## d
-#define CAT5(a,b,c,d,e)a ## b ## c ## d ## e
-#define StGiFy(a)# a
-#define STRINGIFY(a)StGiFy(a)
-#define SCAT2(a,b)StGiFy(a) StGiFy(b)
-#define SCAT3(a,b,c)StGiFy(a) StGiFy(b) StGiFy(c)
-#define SCAT4(a,b,c,d)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d)
-#define SCAT5(a,b,c,d,e)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d) StGiFy(e)
-#endif
-#ifndef CAT2
-#include "Bletch: How does this C preprocessor catenate tokens?"
-#endif
+#define BIN "c:\\perl\\5.00503\\bin\\MSWin32-x86" /**/
+#define BIN_EXP "c:\\perl\\5.00503\\bin\\MSWin32-x86" /**/
/* CPPSTDIN:
* This symbol contains the first part of the string which will invoke
@@ -106,7 +49,7 @@
* output. This symbol will have the value "-" if CPPSTDIN needs a minus
* to specify standard input, otherwise the value is "".
*/
-#define CPPSTDIN ""
+#define CPPSTDIN "cpp32 -oCON"
#define CPPMINUS ""
/* HAS_ALARM:
@@ -142,27 +85,6 @@
*/
/*#define HAS_BZERO /**/
-/* CASTI32:
- * This symbol is defined if the C compiler can cast negative
- * or large floating point numbers to 32-bit ints.
- */
-#define CASTI32 /**/
-
-/* CASTNEGFLOAT:
- * This symbol is defined if the C compiler can cast negative
- * numbers to unsigned longs, ints and shorts.
- */
-/* CASTFLAGS:
- * This symbol contains flags that say what difficulties the compiler
- * has casting odd floating values to unsigned long:
- * 0 = ok
- * 1 = couldn't cast < 0
- * 2 = couldn't cast >= 0x80000000
- * 4 = couldn't cast in argument expression list
- */
-#define CASTNEGFLOAT /**/
-#define CASTFLAGS 0 /**/
-
/* HAS_CHOWN:
* This symbol, if defined, indicates that the chown routine is
* available.
@@ -181,12 +103,6 @@
*/
#define HAS_CHSIZE /**/
-/* VOID_CLOSEDIR:
- * This symbol, if defined, indicates that the closedir() routine
- * does not return a value.
- */
-/*#define VOID_CLOSEDIR /**/
-
/* HASCONST:
* This symbol, if defined, indicates that this C compiler knows about
* the const type. There is no need to actually test for that symbol
@@ -231,6 +147,26 @@
*/
#define HAS_DLERROR /**/
+/* SETUID_SCRIPTS_ARE_SECURE_NOW:
+ * This symbol, if defined, indicates that the bug that prevents
+ * setuid scripts from being secure is not present in this kernel.
+ */
+/* DOSUID:
+ * This symbol, if defined, indicates that the C program should
+ * check the script that it is executing for setuid/setgid bits, and
+ * attempt to emulate setuid/setgid on systems that have disabled
+ * setuid #! scripts because the kernel can't do it securely.
+ * It is up to the package designer to make sure that this emulation
+ * is done securely. Among other things, it should do an fstat on
+ * the script it just opened to make sure it really is a setuid/setgid
+ * script, it should make sure the arguments passed correspond exactly
+ * to the argument on the #! line, and it should not trust any
+ * subprocesses to which it must pass the filename rather than the
+ * file descriptor of the script to be executed.
+ */
+/*#define SETUID_SCRIPTS_ARE_SECURE_NOW /**/
+/*#define DOSUID /**/
+
/* HAS_DUP2:
* This symbol, if defined, indicates that the dup2 routine is
* available to duplicate file descriptors.
@@ -301,19 +237,7 @@
* available to get the list of process groups. If unavailable, multiple
* groups are probably not supported.
*/
-/* HAS_SETGROUPS:
- * This symbol, if defined, indicates that the setgroups() routine is
- * available to set the list of process groups. If unavailable, multiple
- * groups are probably not supported.
- */
/*#define HAS_GETGROUPS /**/
-/*#define HAS_SETGROUPS /**/
-
-/* HAS_GETHOSTENT:
- * This symbol, if defined, indicates that the gethostent routine is
- * available to lookup host names in some data base or other.
- */
-/*#define HAS_GETHOSTENT /**/
/* HAS_UNAME:
* This symbol, if defined, indicates that the C program may use the
@@ -326,7 +250,25 @@
* This symbol, if defined, indicates that the getlogin routine is
* available to get the login name.
*/
-/*#define HAS_GETLOGIN /**/
+#define HAS_GETLOGIN /**/
+
+/* HAS_GETPGID:
+ * This symbol, if defined, indicates to the C program that
+ * the getpgid(pid) function is available to get the
+ * process group id.
+ */
+/*#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)
@@ -371,11 +313,12 @@
#define HAS_NTOHL /**/
#define HAS_NTOHS /**/
-/* HAS_ISASCII:
- * This manifest constant lets the C program know that isascii
- * is available.
+/* HAS_INET_ATON:
+ * This symbol, if defined, indicates to the C program that the
+ * inet_aton() function is available to parse IP address "dotted-quad"
+ * strings.
*/
-#define HAS_ISASCII /**/
+/*#define HAS_INET_ATON /**/
/* HAS_KILLPG:
* This symbol, if defined, indicates that the killpg routine is available
@@ -485,12 +428,6 @@
*/
/*#define HAS_NICE /**/
-/* HAS_OPEN3:
- * This manifest constant lets the C program know that the three
- * argument form of open(2) is available.
- */
-/*#define HAS_OPEN3 /**/
-
/* HAS_PATHCONF:
* This symbol, if defined, indicates that pathconf() is available
* to determine file-system related limits and options associated
@@ -518,7 +455,8 @@
/* HAS_POLL:
* This symbol, if defined, indicates that the poll routine is
- * available to poll active file descriptors.
+ * available to poll active file descriptors. You may safely
+ * include <poll.h> when this symbol is defined.
*/
/*#define HAS_POLL /**/
@@ -567,29 +505,6 @@
*/
#define HAS_RMDIR /**/
-/* HAS_SAFE_BCOPY:
- * This symbol, if defined, indicates that the bcopy routine is available
- * to copy potentially overlapping memory blocks. Otherwise you should
- * probably use memmove() or memcpy(). If neither is defined, roll your
- * own version.
- */
-/*#define HAS_SAFE_BCOPY /**/
-
-/* HAS_SAFE_MEMCPY:
- * This symbol, if defined, indicates that the memcpy routine is available
- * to copy potentially overlapping memory blocks. Otherwise you should
- * probably use memmove() or memcpy(). If neither is defined, roll your
- * own version.
- */
-/*#define HAS_SAFE_MEMCPY /**/
-
-/* HAS_SANE_MEMCMP:
- * This symbol, if defined, indicates that the memcmp routine is available
- * and can be used to compare relative magnitudes of chars with their high
- * bits set. If it is not defined, roll your own version.
- */
-#define HAS_SANE_MEMCMP /**/
-
/* HAS_SELECT:
* This symbol, if defined, indicates that the select routine is
* available to select active file descriptors. If the timeout field
@@ -628,6 +543,24 @@
*/
#define HAS_SETLOCALE /**/
+/* HAS_SETPGID:
+ * This symbol, if defined, indicates that the setpgid(pid, gpid)
+ * routine is available to set process group ID.
+ */
+/*#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.
@@ -704,88 +637,12 @@
#define Shmat_t void * /**/
/*#define HAS_SHMAT_PROTOTYPE /**/
-/* HAS_SIGACTION:
- * This symbol, if defined, indicates that Vr4's sigaction() routine
- * is available.
- */
-/*#define HAS_SIGACTION /**/
-
-/* HAS_SOCKET:
- * This symbol, if defined, indicates that the BSD socket interface is
- * supported.
- */
-/* HAS_SOCKETPAIR:
- * This symbol, if defined, indicates that the BSD socketpair() call is
- * supported.
- */
-#define HAS_SOCKET /**/
-/*#define HAS_SOCKETPAIR /**/
-
/* USE_STAT_BLOCKS:
* This symbol is defined if this system has a stat structure declaring
* st_blksize and st_blocks.
*/
/*#define USE_STAT_BLOCKS /**/
-/* USE_STDIO_PTR:
- * This symbol is defined if the _ptr and _cnt fields (or similar)
- * of the stdio FILE structure can be used to access the stdio buffer
- * for a file handle. If this is defined, then the FILE_ptr(fp)
- * and FILE_cnt(fp) macros will also be defined and should be used
- * to access these fields.
- */
-/* FILE_ptr:
- * This macro is used to access the _ptr field (or equivalent) of the
- * FILE structure pointed to by its argument. This macro will always be
- * defined if USE_STDIO_PTR is defined.
- */
-/* STDIO_PTR_LVALUE:
- * This symbol is defined if the FILE_ptr macro can be used as an
- * lvalue.
- */
-/* FILE_cnt:
- * This macro is used to access the _cnt field (or equivalent) of the
- * FILE structure pointed to by its argument. This macro will always be
- * defined if USE_STDIO_PTR is defined.
- */
-/* STDIO_CNT_LVALUE:
- * This symbol is defined if the FILE_cnt macro can be used as an
- * lvalue.
- */
-#define USE_STDIO_PTR /**/
-#ifdef USE_STDIO_PTR
-#define FILE_ptr(fp) ((fp)->curp)
-#define STDIO_PTR_LVALUE /**/
-#define FILE_cnt(fp) ((fp)->level)
-#define STDIO_CNT_LVALUE /**/
-#endif
-
-/* USE_STDIO_BASE:
- * This symbol is defined if the _base field (or similar) of the
- * stdio FILE structure can be used to access the stdio buffer for
- * a file handle. If this is defined, then the FILE_base(fp) macro
- * will also be defined and should be used to access this field.
- * Also, the FILE_bufsiz(fp) macro will be defined and should be used
- * to determine the number of bytes in the buffer. USE_STDIO_BASE
- * will never be defined unless USE_STDIO_PTR is.
- */
-/* FILE_base:
- * This macro is used to access the _base field (or equivalent) of the
- * FILE structure pointed to by its argument. This macro will always be
- * defined if USE_STDIO_BASE is defined.
- */
-/* FILE_bufsiz:
- * This macro is used to determine the number of bytes in the I/O
- * buffer pointed to by _base field (or equivalent) of the FILE
- * structure pointed to its argument. This macro will always be defined
- * if USE_STDIO_BASE is defined.
- */
-#define USE_STDIO_BASE /**/
-#ifdef USE_STDIO_BASE
-#define FILE_base(fp) ((fp)->buffer)
-#define FILE_bufsiz(fp) ((fp)->level + (fp)->curp - (fp)->buffer)
-#endif
-
/* HAS_STRCHR:
* This symbol is defined to indicate that the strchr()/strrchr()
* functions are available for string searching. If not, try the
@@ -890,20 +747,6 @@
*/
/*#define HAS_TCSETPGRP /**/
-/* Time_t:
- * This symbol holds the type returned by time(). It can be long,
- * or time_t on BSD sites (in which case <sys/types.h> should be
- * included).
- */
-#define Time_t time_t /* Time type */
-
-/* HAS_TIMES:
- * This symbol, if defined, indicates that the times() routine exists.
- * Note that this became obsolete on some systems (SUNOS), which now
- * use getrusage(). It may be necessary to include <sys/times.h>.
- */
-#define HAS_TIMES /**/
-
/* HAS_TRUNCATE:
* This symbol, if defined, indicates that the truncate routine is
* available to truncate files.
@@ -927,14 +770,6 @@
*/
/*#define HAS_VFORK /**/
-/* Signal_t:
- * This symbol's value is either "void" or "int", corresponding to the
- * appropriate return type of a signal handler. Thus, you can declare
- * a signal handler using "Signal_t (*handler)()", and define the
- * handler using "Signal_t handler(sig)".
- */
-#define Signal_t void /* Signal handler's return type */
-
/* HASVOLATILE:
* This symbol, if defined, indicates that this C compiler knows about
* the volatile declaration.
@@ -944,20 +779,6 @@
#define volatile
#endif
-/* HAS_VPRINTF:
- * This symbol, if defined, indicates that the vprintf routine is available
- * to printf with a pointer to an argument list. If unavailable, you
- * may need to write your own, probably in terms of _doprnt().
- */
-/* USE_CHAR_VSPRINTF:
- * This symbol is defined if this system has vsprintf() returning type
- * (char*). The trend seems to be to declare it as "int vsprintf()". It
- * is up to the package author to declare vsprintf correctly based on the
- * symbol.
- */
-#define HAS_VPRINTF /**/
-/*#define USE_CHAR_VSPRINTF /**/
-
/* HAS_WAIT4:
* This symbol, if defined, indicates that wait4() exists.
*/
@@ -967,7 +788,7 @@
* This symbol, if defined, indicates that the waitpid routine is
* available to wait for child process.
*/
-/*#define HAS_WAITPID /**/
+#define HAS_WAITPID /**/
/* HAS_WCSTOMBS:
* This symbol, if defined, indicates that the wcstombs routine is
@@ -981,46 +802,22 @@
*/
#define HAS_WCTOMB /**/
-/* Fpos_t:
- * This symbol holds the type used to declare file positions in libc.
- * It can be fpos_t, long, uint, etc... It may be necessary to include
- * <sys/types.h> to get any typedef'ed information.
- */
-#define Fpos_t fpos_t /* File position type */
-
-/* Gid_t:
- * This symbol holds the return type of getgid() and the type of
- * argument to setrgid() and related functions. Typically,
- * it is the type of group ids in the kernel. It can be int, ushort,
- * uid_t, etc... It may be necessary to include <sys/types.h> to get
- * any typedef'ed information.
- */
-#define Gid_t gid_t /* Type for getgid(), etc... */
-
-/* Groups_t:
- * This symbol holds the type used for the second argument to
- * [gs]etgroups(). Usually, this is the same of gidtype, but
- * sometimes it isn't. It can be int, ushort, uid_t, etc...
- * It may be necessary to include <sys/types.h> to get any
- * typedef'ed information. This is only required if you have
- * getgroups() or setgroups().
+/* I_ARPA_INET:
+ * This symbol, if defined, indicates that <arpa/inet.h> exists and should
+ * be included.
*/
-#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
-#define Groups_t gid_t /* Type for 2nd arg to [gs]etgroups() */
-#endif
+/*#define I_ARPA_INET /**/
-/* DB_Prefix_t:
- * This symbol contains the type of the prefix structure element
- * in the <db.h> header file. In older versions of DB, it was
- * int, while in newer ones it is u_int32_t.
+/* I_DBM:
+ * This symbol, if defined, indicates that <dbm.h> exists and should
+ * be included.
*/
-/* DB_Hash_t:
- * This symbol contains the type of the prefix structure element
- * in the <db.h> header file. In older versions of DB, it was
- * int, while in newer ones it is size_t.
+/* I_RPCSVC_DBM:
+ * This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and
+ * should be included.
*/
-#define DB_Hash_t int /**/
-#define DB_Prefix_t int /**/
+/*#define I_DBM /**/
+#define I_RPCSVC_DBM /**/
/* I_DIRENT:
* This symbol, if defined, indicates to the C program that it should
@@ -1064,7 +861,27 @@
* This symbol, if defined, indicates to the C program that it should
* include <grp.h>.
*/
-#define I_GRP /**/
+/* GRPASSWD:
+ * This symbol, if defined, indicates to the C program that struct group
+ * contains gr_passwd.
+ */
+/* HAS_SETGRENT:
+ * This symbol, if defined, indicates that the getgrent routine is
+ * available for initializing sequential access of the group database.
+ */
+/* HAS_GETGRENT:
+ * This symbol, if defined, indicates that the getgrent routine is
+ * available for sequential access of the group database.
+ */
+/* HAS_ENDGRENT:
+ * This symbol, if defined, indicates that the getgrent routine is
+ * available for finalizing sequential access of the group database.
+ */
+/*#define I_GRP /**/
+/*#define GRPASSWD /**/
+/*#define HAS_SETGRENT /**/
+/*#define HAS_GETGRENT /**/
+/*#define HAS_ENDGRENT /**/
/* I_LIMITS:
* This symbol, if defined, indicates to the C program that it should
@@ -1073,6 +890,12 @@
*/
#define I_LIMITS /**/
+/* I_LOCALE:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <locale.h>.
+ */
+#define I_LOCALE /**/
+
/* I_MATH:
* This symbol, if defined, indicates to the C program that it should
* include <math.h>.
@@ -1103,41 +926,11 @@
*/
/*#define I_NETINET_IN /**/
-/* I_PWD:
+/* I_SFIO:
* This symbol, if defined, indicates to the C program that it should
- * include <pwd.h>.
- */
-/* PWQUOTA:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_quota.
- */
-/* PWAGE:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_age.
- */
-/* PWCHANGE:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_change.
- */
-/* PWCLASS:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_class.
- */
-/* PWEXPIRE:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_expire.
- */
-/* PWCOMMENT:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_comment.
+ * include <sfio.h>.
*/
-/*#define I_PWD /**/
-/*#define PWQUOTA /**/
-/*#define PWAGE /**/
-/*#define PWCHANGE /**/
-/*#define PWCLASS /**/
-/*#define PWEXPIRE /**/
-/*#define PWCOMMENT /**/
+/*#define I_SFIO /**/
/* I_STDDEF:
* This symbol, if defined, indicates that <stddef.h> exists and should
@@ -1199,6 +992,12 @@
*/
/*#define I_SYS_SELECT /**/
+/* I_SYS_STAT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/stat.h>.
+ */
+#define I_SYS_STAT /**/
+
/* I_SYS_TIMES:
* This symbol, if defined, indicates to the C program that it should
* include <sys/times.h>.
@@ -1243,22 +1042,6 @@
/*#define I_TERMIOS /**/
/*#define I_SGTTY /**/
-/* I_TIME:
- * This symbol, if defined, indicates to the C program that it should
- * include <time.h>.
- */
-/* I_SYS_TIME:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/time.h>.
- */
-/* I_SYS_TIME_KERNEL:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/time.h> with KERNEL defined.
- */
-#define I_TIME /**/
-/*#define I_SYS_TIME /**/
-/*#define I_SYS_TIME_KERNEL /**/
-
/* I_UNISTD:
* This symbol, if defined, indicates to the C program that it should
* include <unistd.h>.
@@ -1271,6 +1054,14 @@
*/
#define I_UTIME /**/
+/* I_VALUES:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <values.h> to get definition of symbols like MINFLOAT or
+ * MAXLONG, i.e. machine dependant limitations. Probably, you
+ * should use <limits.h> instead, if it is available.
+ */
+/*#define I_VALUES /**/
+
/* I_STDARG:
* This symbol, if defined, indicates that <stdarg.h> exists and should
* be included.
@@ -1288,64 +1079,6 @@
*/
/*#define I_VFORK /**/
-/* INTSIZE:
- * This symbol contains the value of sizeof(int) so that the C
- * preprocessor can make decisions based on it.
- */
-/* LONGSIZE:
- * This symbol contains the value of sizeof(long) so that the C
- * preprocessor can make decisions based on it.
- */
-/* SHORTSIZE:
- * This symbol contains the value of sizeof(short) so that the C
- * preprocessor can make decisions based on it.
- */
-#define INTSIZE 4 /**/
-#define LONGSIZE 4 /**/
-#define SHORTSIZE 2 /**/
-
-/* Off_t:
- * This symbol holds the type used to declare offsets in the kernel.
- * It can be int, long, off_t, etc... It may be necessary to include
- * <sys/types.h> to get any typedef'ed information.
- */
-#define Off_t off_t /* <offset> type */
-
-/* Mode_t:
- * This symbol holds the type used to declare file modes
- * for systems calls. It is usually mode_t, but may be
- * int or unsigned short. It may be necessary to include <sys/types.h>
- * to get any typedef'ed information.
- */
-#define Mode_t mode_t /* file mode parameter for system calls */
-
-/* VAL_O_NONBLOCK:
- * This symbol is to be used during open() or fcntl(F_SETFL) to turn on
- * non-blocking I/O for the file descriptor. Note that there is no way
- * back, i.e. you cannot turn it blocking again this way. If you wish to
- * alternatively switch between blocking and non-blocking, use the
- * ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
- */
-/* VAL_EAGAIN:
- * This symbol holds the errno error code set by read() when no data was
- * present on the non-blocking file descriptor.
- */
-/* RD_NODATA:
- * This symbol holds the return code from read() when no data is present
- * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
- * not defined, then you can't distinguish between no data and EOF by
- * issuing a read(). You'll have to find another way to tell for sure!
- */
-/* EOF_NONBLOCK:
- * This symbol, if defined, indicates to the C program that a read() on
- * a non-blocking file descriptor will return 0 on EOF, and not the value
- * held in RD_NODATA (-1 usually, in that case!).
- */
-#define VAL_O_NONBLOCK O_NONBLOCK
-#define VAL_EAGAIN EAGAIN
-#define RD_NODATA -1
-#define EOF_NONBLOCK
-
/* CAN_PROTOTYPE:
* If defined, this macro indicates that the C compiler can handle
* function prototypes.
@@ -1364,37 +1097,14 @@
#define _(args) ()
#endif
-/* RANDBITS:
- * This symbol contains the number of bits of random number the rand()
- * function produces. Usual values are 15, 16, and 31.
- */
-#define RANDBITS 15 /**/
-
-/* Select_fd_set_t:
- * This symbol holds the type used for the 2nd, 3rd, and 4th
- * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET
- * is defined, and 'int *' otherwise. This is only useful if you
- * have select(), of course.
- */
-#define Select_fd_set_t int * /**/
-
-/* Size_t:
- * This symbol holds the type used to declare length parameters
- * for string functions. It is usually size_t, but may be
- * unsigned long, int, etc. It may be necessary to include
- * <sys/types.h> to get any typedef'ed information.
+/* SH_PATH:
+ * This symbol contains the full pathname to the shell used on this
+ * on this system to execute Bourne shell scripts. Usually, this will be
+ * /bin/sh, though it's possible that some systems will have /bin/ksh,
+ * /bin/pdksh, /bin/ash, /bin/bash, or even something such as
+ * D:/bin/sh.exe.
*/
-#define Size_t size_t /* length paramater for string functions */
-
-/* SSize_t:
- * This symbol holds the type used by functions that return
- * a count of bytes or an error condition. It must be a signed type.
- * It is usually ssize_t, but may be long or int, etc.
- * It may be necessary to include <sys/types.h> or <unistd.h>
- * to get any typedef'ed information.
- * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
- */
-#define SSize_t int /* signed count of bytes */
+#define SH_PATH "cmd /x /c" /**/
/* STDCHAR:
* This symbol is defined to be the type of char used in stdio.h.
@@ -1402,46 +1112,16 @@
*/
#define STDCHAR unsigned char /**/
-/* Uid_t:
- * This symbol holds the type used to declare user ids in the kernel.
- * It can be int, ushort, uid_t, etc... It may be necessary to include
- * <sys/types.h> to get any typedef'ed information.
- */
-#define Uid_t uid_t /* UID type */
-
-/* LOC_SED:
- * This symbol holds the complete pathname to the sed program.
- */
-#define LOC_SED "" /**/
-
-/* OSNAME:
- * This symbol contains the name of the operating system, as determined
- * by Configure. You shouldn't rely on it too much; the specific
- * feature tests from Configure are generally more reliable.
- */
-#define OSNAME "MSWin32" /**/
-
-/* ARCHLIB:
- * This variable, if defined, holds the name of the directory in
- * which the user wants to put architecture-dependent public
- * library files for perl5. It is most often a local directory
- * such as /usr/local/lib. Programs using this variable must be
- * prepared to deal with filename expansion. If ARCHLIB is the
- * same as PRIVLIB, it is not defined, since presumably the
- * program already searches PRIVLIB.
- */
-/* ARCHLIB_EXP:
- * This symbol contains the ~name expanded version of ARCHLIB, to be used
- * in programs that are not prepared to deal with ~ expansion at run-time.
- */
-#define ARCHLIB "c:\\perl\\lib" /**/
-#define ARCHLIB_EXP (win32PerlLibPath()) /**/
-
-/* BINCOMPAT3:
- * This symbol, if defined, indicates that Perl 5.004 should be
- * binary-compatible with Perl 5.003.
+/* MEM_ALIGNBYTES:
+ * This symbol contains the number of bytes required to align a
+ * double. Usual values are 2, 4 and 8.
+ * On NeXT starting with 3.2, you can build "Fat" Multiple Architecture
+ * Binaries (MAB) for targets with varying alignment. This only matters
+ * for perl, where the config.h can be generated and installed on one
+ * system, and used by a different architecture to build an extension.
+ * The default is eight, for safety.
*/
-/*#define BINCOMPAT3 /**/
+#define MEM_ALIGNBYTES 8 /**/
/* BYTEORDER:
* This symbol holds the hexadecimal constant defined in byteorder,
@@ -1466,39 +1146,32 @@
#endif /* ENDIAN CHECK */
#endif /* NeXT */
-/* CSH:
- * This symbol, if defined, indicates that the C-shell exists.
- * If defined, contains the full pathname of csh.
+/* CASTI32:
+ * This symbol is defined if the C compiler can cast negative
+ * or large floating point numbers to 32-bit ints.
*/
-/*#define CSH "" /**/
+#define CASTI32 /**/
-/* DLSYM_NEEDS_UNDERSCORE:
- * This symbol, if defined, indicates that we need to prepend an
- * underscore to the symbol name before calling dlsym(). This only
- * makes sense if you *have* dlsym, which we will presume is the
- * case if you're using dl_dlopen.xs.
+/* CASTNEGFLOAT:
+ * This symbol is defined if the C compiler can cast negative
+ * numbers to unsigned longs, ints and shorts.
*/
-/*#define DLSYM_NEEDS_UNDERSCORE /**/
-
-/* SETUID_SCRIPTS_ARE_SECURE_NOW:
- * This symbol, if defined, indicates that the bug that prevents
- * setuid scripts from being secure is not present in this kernel.
+/* CASTFLAGS:
+ * This symbol contains flags that say what difficulties the compiler
+ * has casting odd floating values to unsigned long:
+ * 0 = ok
+ * 1 = couldn't cast < 0
+ * 2 = couldn't cast >= 0x80000000
+ * 4 = couldn't cast in argument expression list
*/
-/* DOSUID:
- * This symbol, if defined, indicates that the C program should
- * check the script that it is executing for setuid/setgid bits, and
- * attempt to emulate setuid/setgid on systems that have disabled
- * setuid #! scripts because the kernel can't do it securely.
- * It is up to the package designer to make sure that this emulation
- * is done securely. Among other things, it should do an fstat on
- * the script it just opened to make sure it really is a setuid/setgid
- * script, it should make sure the arguments passed correspond exactly
- * to the argument on the #! line, and it should not trust any
- * subprocesses to which it must pass the filename rather than the
- * file descriptor of the script to be executed.
+#define CASTNEGFLOAT /**/
+#define CASTFLAGS 0 /**/
+
+/* VOID_CLOSEDIR:
+ * This symbol, if defined, indicates that the closedir() routine
+ * does not return a value.
*/
-/*#define SETUID_SCRIPTS_ARE_SECURE_NOW /**/
-/*#define DOSUID /**/
+/*#define VOID_CLOSEDIR /**/
/* Gconvert:
* This preprocessor macro is defined to convert a floating point
@@ -1517,62 +1190,58 @@
*/
#define Gconvert(x,n,t,b) gcvt((x),(n),(b))
-/* HAS_GETPGID:
+/* HAS_GNULIBC:
* This symbol, if defined, indicates to the C program that
- * the getpgid(pid) function is available to get the
- * process group id.
+ * the GNU C library is being used.
*/
-/*#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_GNULIBC /**/
+/* HAS_ISASCII:
+ * This manifest constant lets the C program know that isascii
+ * is available.
*/
-/*#define HAS_GETPGRP /**/
-/*#define USE_BSD_GETPGRP /**/
+#define HAS_ISASCII /**/
-/* HAS_INET_ATON:
- * This symbol, if defined, indicates to the C program that the
- * inet_aton() function is available to parse IP address "dotted-quad"
- * strings.
+/* 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_INET_ATON /**/
+/*#define HAS_LCHOWN /**/
-/* HAS_SETPGID:
- * This symbol, if defined, indicates to the C program that
- * the setpgid(pid, gpid) function is available to set the
- * process group id.
+/* HAS_OPEN3:
+ * This manifest constant lets the C program know that the three
+ * argument form of open(2) is available.
*/
-/*#define HAS_SETPGID /**/
+/*#define HAS_OPEN3 /**/
-/* HAS_SETPGRP:
- * This symbol, if defined, indicates that the setpgrp routine is
- * available to set the current process group.
+/* HAS_SAFE_BCOPY:
+ * This symbol, if defined, indicates that the bcopy routine is available
+ * to copy potentially overlapping memory blocks. Otherwise you should
+ * probably use memmove() or memcpy(). If neither is defined, roll your
+ * own version.
*/
-/* 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_SAFE_BCOPY /**/
+
+/* HAS_SAFE_MEMCPY:
+ * This symbol, if defined, indicates that the memcpy routine is available
+ * to copy potentially overlapping memory blocks. Otherwise you should
+ * probably use memmove() or memcpy(). If neither is defined, roll your
+ * own version.
*/
-/* USE_BSDPGRP:
- * This symbol, if defined, indicates that the BSD notion of process
- * group is to be used. For instance, you have to say setpgrp(pid, pgrp)
- * instead of the USG setpgrp(). This should be obsolete since
- * there are systems which have BSD-ish setpgrp but USG-ish getpgrp.
+/*#define HAS_SAFE_MEMCPY /**/
+
+/* HAS_SANE_MEMCMP:
+ * This symbol, if defined, indicates that the memcmp routine is available
+ * and can be used to compare relative magnitudes of chars with their high
+ * bits set. If it is not defined, roll your own version.
*/
-/*#define HAS_SETPGRP /**/
-/*#define USE_BSD_SETPGRP /**/
-/*#define USE_BSDPGRP /**/
+#define HAS_SANE_MEMCMP /**/
-/* USE_SFIO:
- * This symbol, if defined, indicates that sfio should
- * be used.
+/* HAS_SIGACTION:
+ * This symbol, if defined, indicates that Vr4's sigaction() routine
+ * is available.
*/
-/*#define USE_SFIO /**/
+/*#define HAS_SIGACTION /**/
/* Sigjmp_buf:
* This is the buffer type to be used with Sigsetjmp and Siglongjmp.
@@ -1598,48 +1267,483 @@
#define Siglongjmp(buf,retval) longjmp((buf),(retval))
#endif
-/* USE_DYNAMIC_LOADING:
- * This symbol, if defined, indicates that dynamic loading of
- * some sort is available.
+/* USE_STDIO_PTR:
+ * This symbol is defined if the _ptr and _cnt fields (or similar)
+ * of the stdio FILE structure can be used to access the stdio buffer
+ * for a file handle. If this is defined, then the FILE_ptr(fp)
+ * and FILE_cnt(fp) macros will also be defined and should be used
+ * to access these fields.
*/
-#define USE_DYNAMIC_LOADING /**/
+/* FILE_ptr:
+ * This macro is used to access the _ptr field (or equivalent) of the
+ * FILE structure pointed to by its argument. This macro will always be
+ * defined if USE_STDIO_PTR is defined.
+ */
+/* STDIO_PTR_LVALUE:
+ * This symbol is defined if the FILE_ptr macro can be used as an
+ * lvalue.
+ */
+/* FILE_cnt:
+ * This macro is used to access the _cnt field (or equivalent) of the
+ * FILE structure pointed to by its argument. This macro will always be
+ * defined if USE_STDIO_PTR is defined.
+ */
+/* STDIO_CNT_LVALUE:
+ * This symbol is defined if the FILE_cnt macro can be used as an
+ * lvalue.
+ */
+#define USE_STDIO_PTR /**/
+#ifdef USE_STDIO_PTR
+#define FILE_ptr(fp) ((fp)->curp)
+#define STDIO_PTR_LVALUE /**/
+#define FILE_cnt(fp) ((fp)->level)
+#define STDIO_CNT_LVALUE /**/
+#endif
-/* I_DBM:
- * This symbol, if defined, indicates that <dbm.h> exists and should
- * be included.
+/* USE_STDIO_BASE:
+ * This symbol is defined if the _base field (or similar) of the
+ * stdio FILE structure can be used to access the stdio buffer for
+ * a file handle. If this is defined, then the FILE_base(fp) macro
+ * will also be defined and should be used to access this field.
+ * Also, the FILE_bufsiz(fp) macro will be defined and should be used
+ * to determine the number of bytes in the buffer. USE_STDIO_BASE
+ * will never be defined unless USE_STDIO_PTR is.
*/
-/* I_RPCSVC_DBM:
- * This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and
- * should be included.
+/* FILE_base:
+ * This macro is used to access the _base field (or equivalent) of the
+ * FILE structure pointed to by its argument. This macro will always be
+ * defined if USE_STDIO_BASE is defined.
*/
-/*#define I_DBM /**/
-#define I_RPCSVC_DBM /**/
+/* FILE_bufsiz:
+ * This macro is used to determine the number of bytes in the I/O
+ * buffer pointed to by _base field (or equivalent) of the FILE
+ * structure pointed to its argument. This macro will always be defined
+ * if USE_STDIO_BASE is defined.
+ */
+#define USE_STDIO_BASE /**/
+#ifdef USE_STDIO_BASE
+#define FILE_base(fp) ((fp)->buffer)
+#define FILE_bufsiz(fp) ((fp)->level + (fp)->curp - (fp)->buffer)
+#endif
-/* I_LOCALE:
- * This symbol, if defined, indicates to the C program that it should
- * include <locale.h>.
+/* HAS_VPRINTF:
+ * This symbol, if defined, indicates that the vprintf routine is available
+ * to printf with a pointer to an argument list. If unavailable, you
+ * may need to write your own, probably in terms of _doprnt().
*/
-#define I_LOCALE /**/
+/* USE_CHAR_VSPRINTF:
+ * This symbol is defined if this system has vsprintf() returning type
+ * (char*). The trend seems to be to declare it as "int vsprintf()". It
+ * is up to the package author to declare vsprintf correctly based on the
+ * symbol.
+ */
+#define HAS_VPRINTF /**/
+/*#define USE_CHAR_VSPRINTF /**/
-/* I_SFIO:
- * This symbol, if defined, indicates to the C program that it should
- * include <sfio.h>.
+/* DOUBLESIZE:
+ * This symbol contains the size of a double, so that the C preprocessor
+ * can make decisions based on it.
*/
-/*#define I_SFIO /**/
+#define DOUBLESIZE 8 /**/
-/* I_SYS_STAT:
+/* I_TIME:
* This symbol, if defined, indicates to the C program that it should
- * include <sys/stat.h>.
+ * include <time.h>.
*/
-#define I_SYS_STAT /**/
+/* I_SYS_TIME:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/time.h>.
+ */
+/* I_SYS_TIME_KERNEL:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/time.h> with KERNEL defined.
+ */
+#define I_TIME /**/
+/*#define I_SYS_TIME /**/
+/*#define I_SYS_TIME_KERNEL /**/
-/* I_VALUES:
+/* INTSIZE:
+ * This symbol contains the value of sizeof(int) so that the C
+ * preprocessor can make decisions based on it.
+ */
+/* LONGSIZE:
+ * This symbol contains the value of sizeof(long) so that the C
+ * preprocessor can make decisions based on it.
+ */
+/* SHORTSIZE:
+ * This symbol contains the value of sizeof(short) so that the C
+ * preprocessor can make decisions based on it.
+ */
+#define INTSIZE 4 /**/
+#define LONGSIZE 4 /**/
+#define SHORTSIZE 2 /**/
+
+/* VAL_O_NONBLOCK:
+ * This symbol is to be used during open() or fcntl(F_SETFL) to turn on
+ * non-blocking I/O for the file descriptor. Note that there is no way
+ * back, i.e. you cannot turn it blocking again this way. If you wish to
+ * alternatively switch between blocking and non-blocking, use the
+ * ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
+ */
+/* VAL_EAGAIN:
+ * This symbol holds the errno error code set by read() when no data was
+ * present on the non-blocking file descriptor.
+ */
+/* RD_NODATA:
+ * This symbol holds the return code from read() when no data is present
+ * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
+ * not defined, then you can't distinguish between no data and EOF by
+ * issuing a read(). You'll have to find another way to tell for sure!
+ */
+/* EOF_NONBLOCK:
+ * This symbol, if defined, indicates to the C program that a read() on
+ * a non-blocking file descriptor will return 0 on EOF, and not the value
+ * held in RD_NODATA (-1 usually, in that case!).
+ */
+#define VAL_O_NONBLOCK O_NONBLOCK
+#define VAL_EAGAIN EAGAIN
+#define RD_NODATA -1
+#define EOF_NONBLOCK
+
+/* PTRSIZE:
+ * This symbol contains the size of a pointer, so that the C preprocessor
+ * can make decisions based on it. It will be sizeof(void *) if
+ * the compiler supports (void *); otherwise it will be
+ * sizeof(char *).
+ */
+#define PTRSIZE 4 /**/
+
+/* RANDBITS:
+ * This symbol contains the number of bits of random number the rand()
+ * function produces. Usual values are 15, 16, and 31.
+ */
+#define RANDBITS 15 /**/
+
+/* SSize_t:
+ * This symbol holds the type used by functions that return
+ * a count of bytes or an error condition. It must be a signed type.
+ * It is usually ssize_t, but may be long or int, etc.
+ * It may be necessary to include <sys/types.h> or <unistd.h>
+ * to get any typedef'ed information.
+ * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
+ */
+#define SSize_t int /* signed count of bytes */
+
+/* OSNAME:
+ * This symbol contains the name of the operating system, as determined
+ * by Configure. You shouldn't rely on it too much; the specific
+ * feature tests from Configure are generally more reliable.
+ */
+#define OSNAME "MSWin32" /**/
+
+/* CAT2:
+ * This macro catenates 2 tokens together.
+ */
+/* STRINGIFY:
+ * This macro surrounds its token with double quotes.
+ */
+#if 42 == 1
+#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 CAT2(a,b)a ## b
+#define StGiFy(a)# a
+#define STRINGIFY(a)StGiFy(a)
+#endif
+#if 42 != 1 && 42 != 42
+#include "Bletch: How does this C preprocessor catenate tokens?"
+#endif
+
+/* CSH:
+ * This symbol, if defined, contains the full pathname of csh.
+ */
+/*#define HAS_CSH /**/
+#ifdef HAS_CSH
+#define CSH "" /**/
+#endif
+
+/* HAS_ENDHOSTENT:
+ * This symbol, if defined, indicates that the endhostent() routine is
+ * available to close whatever was being used for host queries.
+ */
+/*#define HAS_ENDHOSTENT /**/
+
+/* HAS_ENDNETENT:
+ * This symbol, if defined, indicates that the endnetent() routine is
+ * available to close whatever was being used for network queries.
+ */
+/*#define HAS_ENDNETENT /**/
+
+/* HAS_ENDPROTOENT:
+ * This symbol, if defined, indicates that the endprotoent() routine is
+ * available to close whatever was being used for protocol queries.
+ */
+/*#define HAS_ENDPROTOENT /**/
+
+/* HAS_ENDSERVENT:
+ * This symbol, if defined, indicates that the endservent() routine is
+ * available to close whatever was being used for service queries.
+ */
+/*#define HAS_ENDSERVENT /**/
+
+/* HAS_GETHOSTBYADDR:
+ * This symbol, if defined, indicates that the gethostbyaddr() routine is
+ * available to look up hosts by their IP addresses.
+ */
+#define HAS_GETHOSTBYADDR /**/
+
+/* HAS_GETHOSTBYNAME:
+ * This symbol, if defined, indicates that the gethostbyname() routine is
+ * available to look up host names in some data base or other.
+ */
+#define HAS_GETHOSTBYNAME /**/
+
+/* HAS_GETHOSTENT:
+ * This symbol, if defined, indicates that the gethostent() routine is
+ * available to look up host names in some data base or another.
+ */
+/*#define HAS_GETHOSTENT /**/
+
+/* HAS_GETNETBYADDR:
+ * This symbol, if defined, indicates that the getnetbyaddr() routine is
+ * available to look up networks by their IP addresses.
+ */
+/*#define HAS_GETNETBYADDR /**/
+
+/* HAS_GETNETBYNAME:
+ * This symbol, if defined, indicates that the getnetbyname() routine is
+ * available to look up networks by their names.
+ */
+/*#define HAS_GETNETBYNAME /**/
+
+/* HAS_GETNETENT:
+ * This symbol, if defined, indicates that the getnetent() routine is
+ * available to look up network names in some data base or another.
+ */
+/*#define HAS_GETNETENT /**/
+
+/* HAS_GETPROTOENT:
+ * This symbol, if defined, indicates that the getprotoent() routine is
+ * available to look up protocols in some data base or another.
+ */
+/*#define HAS_GETPROTOENT /**/
+
+/* HAS_GETPROTOBYNAME:
+ * This symbol, if defined, indicates that the getprotobyname()
+ * routine is available to look up protocols by their name.
+ */
+/* HAS_GETPROTOBYNUMBER:
+ * This symbol, if defined, indicates that the getprotobynumber()
+ * routine is available to look up protocols by their number.
+ */
+#define HAS_GETPROTOBYNAME /**/
+#define HAS_GETPROTOBYNUMBER /**/
+
+/* HAS_GETSERVENT:
+ * This symbol, if defined, indicates that the getservent() routine is
+ * available to look up network services in some data base or another.
+ */
+/*#define HAS_GETSERVENT /**/
+
+/* HAS_GETSERVBYNAME:
+ * This symbol, if defined, indicates that the getservbyname()
+ * routine is available to look up services by their name.
+ */
+/* HAS_GETSERVBYPORT:
+ * This symbol, if defined, indicates that the getservbyport()
+ * routine is available to look up services by their port.
+ */
+#define HAS_GETSERVBYNAME /**/
+#define HAS_GETSERVBYPORT /**/
+
+/* HAS_LONG_DOUBLE:
+ * This symbol will be defined if the C compiler supports long
+ * doubles.
+ */
+/* LONG_DOUBLESIZE:
+ * This symbol contains the size of a long double, so that the
+ * C preprocessor can make decisions based on it. It is only
+ * defined if the system supports long doubles.
+ */
+#define HAS_LONG_DOUBLE /**/
+#ifdef HAS_LONG_DOUBLE
+#define LONG_DOUBLESIZE 10 /**/
+#endif
+
+/* HAS_LONG_LONG:
+ * This symbol will be defined if the C compiler supports
+ * long long.
+ */
+/* LONGLONGSIZE:
+ * This symbol contains the size of a long long, so that the
+ * C preprocessor can make decisions based on it. It is only
+ * defined if the system supports long long.
+ */
+/*#define HAS_LONG_LONG /**/
+#ifdef HAS_LONG_LONG
+#define LONGLONGSIZE 8 /**/
+#endif
+
+/* HAS_SETGROUPS:
+ * This symbol, if defined, indicates that the setgroups() routine is
+ * available to set the list of process groups. If unavailable, multiple
+ * groups are probably not supported.
+ */
+/*#define HAS_SETGROUPS /**/
+
+/* HAS_SETHOSTENT:
+ * This symbol, if defined, indicates that the sethostent() routine is
+ * available.
+ */
+/*#define HAS_SETHOSTENT /**/
+
+/* HAS_SETNETENT:
+ * This symbol, if defined, indicates that the setnetent() routine is
+ * available.
+ */
+/*#define HAS_SETNETENT /**/
+
+/* HAS_SETPROTOENT:
+ * This symbol, if defined, indicates that the setprotoent() routine is
+ * available.
+ */
+/*#define HAS_SETPROTOENT /**/
+
+/* HAS_SETSERVENT:
+ * This symbol, if defined, indicates that the setservent() routine is
+ * available.
+ */
+/*#define HAS_SETSERVENT /**/
+
+/* HAS_SETVBUF:
+ * This symbol, if defined, indicates that the setvbuf routine is
+ * available to change buffering on an open stdio stream.
+ * to a line-buffered mode.
+ */
+#define HAS_SETVBUF /**/
+
+/* HAS_SOCKET:
+ * This symbol, if defined, indicates that the BSD socket interface is
+ * supported.
+ */
+/* HAS_SOCKETPAIR:
+ * This symbol, if defined, indicates that the BSD socketpair() call is
+ * supported.
+ */
+#define HAS_SOCKET /**/
+/*#define HAS_SOCKETPAIR /**/
+
+/* HAS_UNION_SEMUN:
+ * This symbol, if defined, indicates that the union semun is
+ * defined by including <sys/sem.h>. If not, the user code
+ * probably needs to define it as:
+ * union semun {
+ * int val;
+ * struct semid_ds *buf;
+ * unsigned short *array;
+ * }
+ */
+/* USE_SEMCTL_SEMUN:
+ * This symbol, if defined, indicates that union semun is
+ * used for semctl IPC_STAT.
+ */
+/* USE_SEMCTL_SEMID_DS:
+ * This symbol, if defined, indicates that struct semid_ds * is
+ * used for semctl IPC_STAT.
+ */
+#define HAS_UNION_SEMUN /**/
+/*#define USE_SEMCTL_SEMUN /**/
+/*#define USE_SEMCTL_SEMID_DS /**/
+
+/* Signal_t:
+ * This symbol's value is either "void" or "int", corresponding to the
+ * appropriate return type of a signal handler. Thus, you can declare
+ * a signal handler using "Signal_t (*handler)()", and define the
+ * handler using "Signal_t handler(sig)".
+ */
+#define Signal_t void /* Signal handler's return type */
+
+/* Groups_t:
+ * This symbol holds the type used for the second argument to
+ * getgroups() and setgropus(). Usually, this is the same as
+ * gidtype (gid_t) , but sometimes it isn't.
+ * It can be int, ushort, uid_t, etc...
+ * It may be necessary to include <sys/types.h> to get any
+ * typedef'ed information. This is only required if you have
+ * getgroups() or setgropus()..
+ */
+#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
+#define Groups_t gid_t /* Type for 2nd arg to [sg]etgroups() */
+#endif
+
+/* I_NETDB:
+ * This symbol, if defined, indicates that <netdb.h> exists and
+ * should be included.
+ */
+/*#define I_NETDB /**/
+
+/* I_PWD:
* This symbol, if defined, indicates to the C program that it should
- * include <values.h> to get definition of symbols like MINFLOAT or
- * MAXLONG, i.e. machine dependant limitations. Probably, you
- * should use <limits.h> instead, if it is available.
+ * include <pwd.h>.
*/
-/*#define I_VALUES /**/
+/* PWQUOTA:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_quota.
+ */
+/* PWAGE:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_age.
+ */
+/* PWCHANGE:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_change.
+ */
+/* PWCLASS:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_class.
+ */
+/* PWEXPIRE:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_expire.
+ */
+/* PWCOMMENT:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_comment.
+ */
+/* PWGECOS:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_gecos.
+ */
+/* PWPASSWD:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_passwd.
+ */
+/* HAS_SETPWENT:
+ * This symbol, if defined, indicates that the getpwrent routine is
+ * available for initializing sequential access of the passwd database.
+ */
+/* HAS_GETPWENT:
+ * This symbol, if defined, indicates that the getpwent routine is
+ * available for sequential access of the password database.
+ */
+/* HAS_ENDPWENT:
+ * This symbol, if defined, indicates that the getpwent routine is
+ * available for finalizing sequential access of the passwd database.
+ */
+/*#define I_PWD /**/
+/*#define PWQUOTA /**/
+/*#define PWAGE /**/
+/*#define PWCHANGE /**/
+/*#define PWCLASS /**/
+/*#define PWEXPIRE /**/
+/*#define PWCOMMENT /**/
+/*#define PWGECOS /**/
+/*#define PWPASSWD /**/
+/*#define HAS_SETPWENT /**/
+/*#define HAS_GETPWENT /**/
+/*#define HAS_ENDPWENT /**/
/* Free_t:
* This variable contains the return type of free(). It is usually
@@ -1656,43 +1760,6 @@
*/
/*#define MYMALLOC /**/
-/* OLDARCHLIB:
- * This variable, if defined, holds the name of the directory in
- * which the user has perl5.000 or perl5.001 architecture-dependent
- * public library files for perl5. For the most part, these
- * files will work with 5.002 (and later), but that is not
- * guaranteed.
- */
-/* OLDARCHLIB_EXP:
- * This symbol contains the ~name expanded version of OLDARCHLIB, to be
- * used in programs that are not prepared to deal with ~ expansion at
- * run-time.
- */
-/*#define OLDARCHLIB "" /**/
-/*#define OLDARCHLIB_EXP "" /**/
-
-/* PRIVLIB:
- * This symbol contains the name of the private library for this package.
- * The library is private in the sense that it needn't be in anyone's
- * execution path, but it should be accessible by the world. The program
- * should be prepared to do ~ expansion.
- */
-/* PRIVLIB_EXP:
- * This symbol contains the ~name expanded version of PRIVLIB, to be used
- * in programs that are not prepared to deal with ~ expansion at run-time.
- */
-#define PRIVLIB "c:\\perl\\lib" /**/
-#define PRIVLIB_EXP "c:\\perl\\lib" /**/
-
-/* SH_PATH:
- * This symbol contains the full pathname to the shell used on this
- * on this system to execute Bourne shell scripts. Usually, this will be
- * /bin/sh, though it's possible that some systems will have /bin/ksh,
- * /bin/pdksh, /bin/ash, /bin/bash, or even something such as
- * D:/bin/sh.exe.
- */
-#define SH_PATH "cmd.exe" /**/
-
/* SIG_NAME:
* This symbol contains a list of signal names in order of
* signal number. This is intended
@@ -1721,8 +1788,95 @@
* The last element is 0, corresponding to the 0 at the end of
* the sig_name list.
*/
-#define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","ABRT","EMT","FPE","KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM","USR1","USR2","CHLD","PWR","WINCH","URG","IO","STOP","TSTP","CONT","TTIN","TTOU","VTALRM","PROF","XCPU","XFSZ","WAITING","LWP","FREEZE","THAW","RTMIN","NUM37","NUM38","NUM39","NUM40","NUM41","NUM42","RTMAX","IOT","CLD","POLL",0 /**/
-#define 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,6,18,22,0 /**/
+#define SIG_NAME "ZERO", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "USR1", "USR2", "CHLD", "USR3", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0 /**/
+#define SIG_NUM 0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 16, 17, 18, 20, 21, 22, 23, 25, 18, 0 /**/
+
+/* VOIDFLAGS:
+ * This symbol indicates how much support of the void type is given by this
+ * compiler. What various bits mean:
+ *
+ * 1 = supports declaration of void
+ * 2 = supports arrays of pointers to functions returning void
+ * 4 = supports comparisons between pointers to void functions and
+ * addresses of void functions
+ * 8 = suports declaration of generic void pointers
+ *
+ * The package designer should define VOIDUSED to indicate the requirements
+ * of the package. This can be done either by #defining VOIDUSED before
+ * including config.h, or by defining defvoidused in Myinit.U. If the
+ * latter approach is taken, only those flags will be tested. If the
+ * level of void support necessary is not present, defines void to int.
+ */
+#ifndef VOIDUSED
+#define VOIDUSED 15
+#endif
+#define VOIDFLAGS 15
+#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
+#define void int /* is void to be avoided? */
+#define M_VOID /* Xenix strikes again */
+#endif
+
+/* ARCHLIB:
+ * This variable, if defined, holds the name of the directory in
+ * which the user wants to put architecture-dependent public
+ * library files for perl5. It is most often a local directory
+ * such as /usr/local/lib. Programs using this variable must be
+ * prepared to deal with filename expansion. If ARCHLIB is the
+ * same as PRIVLIB, it is not defined, since presumably the
+ * program already searches PRIVLIB.
+ */
+/* ARCHLIB_EXP:
+ * This symbol contains the ~name expanded version of ARCHLIB, to be used
+ * in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+#define ARCHLIB "c:\\perl\\5.00503\\lib\\MSWin32-x86" /**/
+/*#define ARCHLIB_EXP "" /**/
+
+/* DLSYM_NEEDS_UNDERSCORE:
+ * This symbol, if defined, indicates that we need to prepend an
+ * underscore to the symbol name before calling dlsym(). This only
+ * makes sense if you *have* dlsym, which we will presume is the
+ * case if you're using dl_dlopen.xs.
+ */
+/*#define DLSYM_NEEDS_UNDERSCORE /**/
+
+/* USE_SFIO:
+ * This symbol, if defined, indicates that sfio should
+ * be used.
+ */
+/*#define USE_SFIO /**/
+
+/* USE_DYNAMIC_LOADING:
+ * This symbol, if defined, indicates that dynamic loading of
+ * some sort is available.
+ */
+#define USE_DYNAMIC_LOADING /**/
+
+/* DB_Prefix_t:
+ * This symbol contains the type of the prefix structure element
+ * in the <db.h> header file. In older versions of DB, it was
+ * int, while in newer ones it is u_int32_t.
+ */
+/* DB_Hash_t:
+ * This symbol contains the type of the prefix structure element
+ * in the <db.h> header file. In older versions of DB, it was
+ * int, while in newer ones it is size_t.
+ */
+#define DB_Hash_t int /**/
+#define DB_Prefix_t int /**/
+
+/* PRIVLIB:
+ * This symbol contains the name of the private library for this package.
+ * The library is private in the sense that it needn't be in anyone's
+ * execution path, but it should be accessible by the world. The program
+ * should be prepared to do ~ expansion.
+ */
+/* PRIVLIB_EXP:
+ * This symbol contains the ~name expanded version of PRIVLIB, to be used
+ * in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+#define PRIVLIB "c:\\perl\\5.00503\\lib" /**/
+#define PRIVLIB_EXP (win32_get_privlib("5.00503")) /**/
/* SITEARCH:
* This symbol contains the name of the private library for this package.
@@ -1737,8 +1891,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 "c:\\perl\\lib\\site" /**/
-#define SITEARCH_EXP "c:\\perl\\lib\\site" /**/
+#define SITEARCH "c:\\perl\\site\\5.00503\\lib\\MSWin32-x86" /**/
+/*#define SITEARCH_EXP "" /**/
/* SITELIB:
* This symbol contains the name of the private library for this package.
@@ -1753,15 +1907,15 @@
* This symbol contains the ~name expanded version of SITELIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITELIB "c:\\perl\\lib\\site" /**/
-#define SITELIB_EXP "c:\\perl\\lib\\site" /**/
+#define SITELIB "c:\\perl\\site\\5.00503\\lib" /**/
+#define SITELIB_EXP (win32_get_sitelib("5.00503")) /**/
/* STARTPERL:
* This variable contains the string to put in front of a perl
* script to make sure (one hopes) that it runs with perl and not
* some shell.
*/
-#define STARTPERL "#perl" /**/
+#define STARTPERL "#!perl" /**/
/* USE_PERLIO:
* This symbol, if defined, indicates that the PerlIO abstraction should
@@ -1770,33 +1924,171 @@
*/
/*#define USE_PERLIO /**/
-/* VOIDFLAGS:
- * This symbol indicates how much support of the void type is given by this
- * compiler. What various bits mean:
- *
- * 1 = supports declaration of void
- * 2 = supports arrays of pointers to functions returning void
- * 4 = supports comparisons between pointers to void functions and
- * addresses of void functions
- * 8 = suports declaration of generic void pointers
- *
- * The package designer should define VOIDUSED to indicate the requirements
- * of the package. This can be done either by #defining VOIDUSED before
- * including config.h, or by defining defvoidused in Myinit.U. If the
- * latter approach is taken, only those flags will be tested. If the
- * level of void support necessary is not present, defines void to int.
+/* HAS_GETHOST_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for gethostent(), gethostbyname(), and
+ * gethostbyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
*/
-#ifndef VOIDUSED
-#define VOIDUSED 15
-#endif
-#define VOIDFLAGS 15
-#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
-#define void int /* is void to be avoided? */
-#define M_VOID /* Xenix strikes again */
-#endif
+#define HAS_GETHOST_PROTOS /**/
+
+/* HAS_GETNET_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for getnetent(), getnetbyname(), and
+ * getnetbyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+/*#define HAS_GETNET_PROTOS /**/
+
+/* HAS_GETPROTO_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for getprotoent(), getprotobyname(), and
+ * getprotobyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+#define HAS_GETPROTO_PROTOS /**/
+
+/* HAS_GETSERV_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for getservent(), getservbyname(), and
+ * getservbyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+#define HAS_GETSERV_PROTOS /**/
+
+/* Netdb_host_t:
+ * This symbol holds the type used for the 1st argument
+ * to gethostbyaddr().
+ */
+/* Netdb_hlen_t:
+ * This symbol holds the type used for the 2nd argument
+ * to gethostbyaddr().
+ */
+/* Netdb_name_t:
+ * This symbol holds the type used for the argument to
+ * gethostbyname().
+ */
+/* Netdb_net_t:
+ * This symbol holds the type used for the 1st argument to
+ * getnetbyaddr().
+ */
+#define Netdb_host_t char * /**/
+#define Netdb_hlen_t int /**/
+#define Netdb_name_t char * /**/
+#define Netdb_net_t long /**/
+
+/* Select_fd_set_t:
+ * This symbol holds the type used for the 2nd, 3rd, and 4th
+ * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET
+ * is defined, and 'int *' otherwise. This is only useful if you
+ * have select(), of course.
+ */
+#define Select_fd_set_t Perl_fd_set * /**/
+
+/* ARCHNAME:
+ * This symbol holds a string representing the architecture name.
+ * It may be used to construct an architecture-dependant pathname
+ * where library files may be held under a private library, for
+ * instance.
+ */
+#define ARCHNAME "MSWin32-x86" /**/
+
+/* HAS_PTHREAD_YIELD:
+ * This symbol, if defined, indicates that the pthread_yield
+ * routine is available to yield the execution of the current
+ * thread.
+ */
+/* HAS_SCHED_YIELD:
+ * This symbol, if defined, indicates that the sched_yield
+ * routine is available to yield the execution of the current
+ * thread.
+ */
+/*#define HAS_PTHREAD_YIELD /**/
+/*#define HAS_SCHED_YIELD /**/
+
+/* PTHREADS_CREATED_JOINABLE:
+ * This symbol, if defined, indicates that pthreads are created
+ * in the joinable (aka undetached) state.
+ */
+/*#define PTHREADS_CREATED_JOINABLE /**/
+
+/* USE_THREADS:
+ * This symbol, if defined, indicates that Perl should
+ * be built to use threads.
+ */
+/* OLD_PTHREADS_API:
+ * This symbol, if defined, indicates that Perl should
+ * be built to use the old draft POSIX threads API.
+ */
+/*#define USE_THREADS /**/
+/*#define OLD_PTHREADS_API /**/
+
+/* Time_t:
+ * This symbol holds the type returned by time(). It can be long,
+ * or time_t on BSD sites (in which case <sys/types.h> should be
+ * included).
+ */
+#define Time_t time_t /* Time type */
+
+/* HAS_TIMES:
+ * This symbol, if defined, indicates that the times() routine exists.
+ * Note that this became obsolete on some systems (SUNOS), which now
+ * use getrusage(). It may be necessary to include <sys/times.h>.
+ */
+#define HAS_TIMES /**/
+
+/* Fpos_t:
+ * This symbol holds the type used to declare file positions in libc.
+ * It can be fpos_t, long, uint, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+#define Fpos_t fpos_t /* File position type */
+
+/* Gid_t:
+ * This symbol holds the return type of getgid() and the type of
+ * argument to setrgid() and related functions. Typically,
+ * it is the type of group ids in the kernel. It can be int, ushort,
+ * uid_t, etc... It may be necessary to include <sys/types.h> to get
+ * any typedef'ed information.
+ */
+#define Gid_t gid_t /* Type for getgid(), etc... */
+
+/* Off_t:
+ * This symbol holds the type used to declare offsets in the kernel.
+ * It can be int, long, off_t, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+#define Off_t off_t /* <offset> type */
+
+/* Mode_t:
+ * This symbol holds the type used to declare file modes
+ * for systems calls. It is usually mode_t, but may be
+ * int or unsigned short. It may be necessary to include <sys/types.h>
+ * to get any typedef'ed information.
+ */
+#define Mode_t mode_t /* file mode parameter for system calls */
+
+/* Pid_t:
+ * This symbol holds the type used to declare process ids in the kernel.
+ * It can be int, uint, pid_t, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+#define Pid_t int /* PID type */
+
+/* Size_t:
+ * This symbol holds the type used to declare length parameters
+ * for string functions. It is usually size_t, but may be
+ * unsigned long, int, etc. It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+#define Size_t size_t /* length paramater for string functions */
+
+/* Uid_t:
+ * This symbol holds the type used to declare user ids in the kernel.
+ * It can be int, ushort, uid_t, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+#define Uid_t uid_t /* UID type */
#endif
#include <win32.h>
-#ifndef DEBUGGING
-#define DEBUGGING
-#endif
diff --git a/gnu/usr.bin/perl/win32/config_H.vc b/gnu/usr.bin/perl/win32/config_H.vc
index 76f19f1d872..d239d246ba6 100644
--- a/gnu/usr.bin/perl/win32/config_H.vc
+++ b/gnu/usr.bin/perl/win32/config_H.vc
@@ -7,51 +7,24 @@
* that running config_h.SH again will wipe out any changes you've made.
* For a more permanent change edit config.sh and rerun config_h.SH.
*
- * $Id: Config_h.U,v 3.0.1.4 1995/09/25 09:10:49 ram Exp $
+ * $Id: Config_h.U,v 3.0.1.5 1997/02/28 14:57:43 ram Exp $
*/
-/* Configuration time: Thu Apr 11 06:20:49 PDT 1996
- * Configured by: garyng
- * Target system:
+/*
+ * Package name : perl5
+ * Source directory :
+ * Configuration time: undef
+ * Configured by : gsar
+ * Target system :
*/
#ifndef _config_h_
#define _config_h_
-/* MEM_ALIGNBYTES:
- * This symbol contains the number of bytes required to align a
- * double. Usual values are 2, 4 and 8.
- * On NeXT starting with 3.2, you can build "Fat" Multiple Architecture
- * Binaries (MAB) for targets with varying alignment. This only matters
- * for perl, where the config.h can be generated and installed on one
- * system, and used by a different architecture to build an extension.
- * The default is eight, for safety.
- */
-#ifndef NeXT
-#define MEM_ALIGNBYTES 8 /**/
-#else /* NeXT */
-#ifdef __m68k__
-#define MEM_ALIGNBYTES 2
-#else
-#ifdef __i386__
-#define MEM_ALIGNBYTES 4
-#else /* __hppa__, __sparc__ and default for unknown architectures */
-#define MEM_ALIGNBYTES 8
-#endif /* __i386__ */
-#endif /* __m68k__ */
-#endif /* NeXT */
-
-/* ARCHNAME:
- * This symbol holds a string representing the architecture name.
- * It may be used to construct an architecture-dependant pathname
- * where library files may be held under a private library, for
- * instance.
+/* LOC_SED:
+ * This symbol holds the complete pathname to the sed program.
*/
-#ifdef _ALPHA_
-#define ARCHNAME "alpha-mswin32" /**/
-#else
-#define ARCHNAME "x86-mswin32" /**/
-#endif
+#define LOC_SED "" /**/
/* BIN:
* This symbol holds the path of the bin directory where the package will
@@ -61,38 +34,8 @@
* This symbol is the filename expanded version of the BIN symbol, for
* programs that do not want to deal with that at run-time.
*/
-#define BIN "c:\\perl\\bin" /**/
-#define BIN_EXP "c:\\perl\\bin" /**/
-
-/* CAT2:
- * This macro catenates 2 tokens together.
- */
-/* STRINGIFY:
- * This macro surrounds its token with double quotes.
- */
-#if 42 == 1
-#define CAT2(a,b)a/**/b
-#define CAT3(a,b,c)a/**/b/**/c
-#define CAT4(a,b,c,d)a/**/b/**/c/**/d
-#define CAT5(a,b,c,d,e)a/**/b/**/c/**/d/**/e
-#define STRINGIFY(a)"a"
- /* If you can get stringification with catify, tell me how! */
-#endif
-#if 42 == 42
-#define CAT2(a,b)a ## b
-#define CAT3(a,b,c)a ## b ## c
-#define CAT4(a,b,c,d)a ## b ## c ## d
-#define CAT5(a,b,c,d,e)a ## b ## c ## d ## e
-#define StGiFy(a)# a
-#define STRINGIFY(a)StGiFy(a)
-#define SCAT2(a,b)StGiFy(a) StGiFy(b)
-#define SCAT3(a,b,c)StGiFy(a) StGiFy(b) StGiFy(c)
-#define SCAT4(a,b,c,d)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d)
-#define SCAT5(a,b,c,d,e)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d) StGiFy(e)
-#endif
-#ifndef CAT2
-#include "Bletch: How does this C preprocessor catenate tokens?"
-#endif
+#define BIN "c:\\perl\\5.00503\\bin\\MSWin32-x86" /**/
+#define BIN_EXP "c:\\perl\\5.00503\\bin\\MSWin32-x86" /**/
/* CPPSTDIN:
* This symbol contains the first part of the string which will invoke
@@ -106,7 +49,7 @@
* output. This symbol will have the value "-" if CPPSTDIN needs a minus
* to specify standard input, otherwise the value is "".
*/
-#define CPPSTDIN "cl -E"
+#define CPPSTDIN "cl -nologo -E"
#define CPPMINUS ""
/* HAS_ALARM:
@@ -142,27 +85,6 @@
*/
/*#define HAS_BZERO /**/
-/* CASTI32:
- * This symbol is defined if the C compiler can cast negative
- * or large floating point numbers to 32-bit ints.
- */
-#define CASTI32 /**/
-
-/* CASTNEGFLOAT:
- * This symbol is defined if the C compiler can cast negative
- * numbers to unsigned longs, ints and shorts.
- */
-/* CASTFLAGS:
- * This symbol contains flags that say what difficulties the compiler
- * has casting odd floating values to unsigned long:
- * 0 = ok
- * 1 = couldn't cast < 0
- * 2 = couldn't cast >= 0x80000000
- * 4 = couldn't cast in argument expression list
- */
-#define CASTNEGFLOAT /**/
-#define CASTFLAGS 0 /**/
-
/* HAS_CHOWN:
* This symbol, if defined, indicates that the chown routine is
* available.
@@ -181,12 +103,6 @@
*/
#define HAS_CHSIZE /**/
-/* VOID_CLOSEDIR:
- * This symbol, if defined, indicates that the closedir() routine
- * does not return a value.
- */
-/*#define VOID_CLOSEDIR /**/
-
/* HASCONST:
* This symbol, if defined, indicates that this C compiler knows about
* the const type. There is no need to actually test for that symbol
@@ -231,6 +147,26 @@
*/
#define HAS_DLERROR /**/
+/* SETUID_SCRIPTS_ARE_SECURE_NOW:
+ * This symbol, if defined, indicates that the bug that prevents
+ * setuid scripts from being secure is not present in this kernel.
+ */
+/* DOSUID:
+ * This symbol, if defined, indicates that the C program should
+ * check the script that it is executing for setuid/setgid bits, and
+ * attempt to emulate setuid/setgid on systems that have disabled
+ * setuid #! scripts because the kernel can't do it securely.
+ * It is up to the package designer to make sure that this emulation
+ * is done securely. Among other things, it should do an fstat on
+ * the script it just opened to make sure it really is a setuid/setgid
+ * script, it should make sure the arguments passed correspond exactly
+ * to the argument on the #! line, and it should not trust any
+ * subprocesses to which it must pass the filename rather than the
+ * file descriptor of the script to be executed.
+ */
+/*#define SETUID_SCRIPTS_ARE_SECURE_NOW /**/
+/*#define DOSUID /**/
+
/* HAS_DUP2:
* This symbol, if defined, indicates that the dup2 routine is
* available to duplicate file descriptors.
@@ -301,19 +237,7 @@
* available to get the list of process groups. If unavailable, multiple
* groups are probably not supported.
*/
-/* HAS_SETGROUPS:
- * This symbol, if defined, indicates that the setgroups() routine is
- * available to set the list of process groups. If unavailable, multiple
- * groups are probably not supported.
- */
/*#define HAS_GETGROUPS /**/
-/*#define HAS_SETGROUPS /**/
-
-/* HAS_GETHOSTENT:
- * This symbol, if defined, indicates that the gethostent routine is
- * available to lookup host names in some data base or other.
- */
-/*#define HAS_GETHOSTENT /**/
/* HAS_UNAME:
* This symbol, if defined, indicates that the C program may use the
@@ -326,7 +250,25 @@
* This symbol, if defined, indicates that the getlogin routine is
* available to get the login name.
*/
-/*#define HAS_GETLOGIN /**/
+#define HAS_GETLOGIN /**/
+
+/* HAS_GETPGID:
+ * This symbol, if defined, indicates to the C program that
+ * the getpgid(pid) function is available to get the
+ * process group id.
+ */
+/*#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)
@@ -371,11 +313,12 @@
#define HAS_NTOHL /**/
#define HAS_NTOHS /**/
-/* HAS_ISASCII:
- * This manifest constant lets the C program know that isascii
- * is available.
+/* HAS_INET_ATON:
+ * This symbol, if defined, indicates to the C program that the
+ * inet_aton() function is available to parse IP address "dotted-quad"
+ * strings.
*/
-#define HAS_ISASCII /**/
+/*#define HAS_INET_ATON /**/
/* HAS_KILLPG:
* This symbol, if defined, indicates that the killpg routine is available
@@ -485,12 +428,6 @@
*/
/*#define HAS_NICE /**/
-/* HAS_OPEN3:
- * This manifest constant lets the C program know that the three
- * argument form of open(2) is available.
- */
-/*#define HAS_OPEN3 /**/
-
/* HAS_PATHCONF:
* This symbol, if defined, indicates that pathconf() is available
* to determine file-system related limits and options associated
@@ -518,7 +455,8 @@
/* HAS_POLL:
* This symbol, if defined, indicates that the poll routine is
- * available to poll active file descriptors.
+ * available to poll active file descriptors. You may safely
+ * include <poll.h> when this symbol is defined.
*/
/*#define HAS_POLL /**/
@@ -567,29 +505,6 @@
*/
#define HAS_RMDIR /**/
-/* HAS_SAFE_BCOPY:
- * This symbol, if defined, indicates that the bcopy routine is available
- * to copy potentially overlapping memory blocks. Otherwise you should
- * probably use memmove() or memcpy(). If neither is defined, roll your
- * own version.
- */
-/*#define HAS_SAFE_BCOPY /**/
-
-/* HAS_SAFE_MEMCPY:
- * This symbol, if defined, indicates that the memcpy routine is available
- * to copy potentially overlapping memory blocks. Otherwise you should
- * probably use memmove() or memcpy(). If neither is defined, roll your
- * own version.
- */
-/*#define HAS_SAFE_MEMCPY /**/
-
-/* HAS_SANE_MEMCMP:
- * This symbol, if defined, indicates that the memcmp routine is available
- * and can be used to compare relative magnitudes of chars with their high
- * bits set. If it is not defined, roll your own version.
- */
-#define HAS_SANE_MEMCMP /**/
-
/* HAS_SELECT:
* This symbol, if defined, indicates that the select routine is
* available to select active file descriptors. If the timeout field
@@ -628,6 +543,24 @@
*/
#define HAS_SETLOCALE /**/
+/* HAS_SETPGID:
+ * This symbol, if defined, indicates that the setpgid(pid, gpid)
+ * routine is available to set process group ID.
+ */
+/*#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.
@@ -704,88 +637,12 @@
#define Shmat_t void * /**/
/*#define HAS_SHMAT_PROTOTYPE /**/
-/* HAS_SIGACTION:
- * This symbol, if defined, indicates that Vr4's sigaction() routine
- * is available.
- */
-/*#define HAS_SIGACTION /**/
-
-/* HAS_SOCKET:
- * This symbol, if defined, indicates that the BSD socket interface is
- * supported.
- */
-/* HAS_SOCKETPAIR:
- * This symbol, if defined, indicates that the BSD socketpair() call is
- * supported.
- */
-#define HAS_SOCKET /**/
-/*#define HAS_SOCKETPAIR /**/
-
/* USE_STAT_BLOCKS:
* This symbol is defined if this system has a stat structure declaring
* st_blksize and st_blocks.
*/
/*#define USE_STAT_BLOCKS /**/
-/* USE_STDIO_PTR:
- * This symbol is defined if the _ptr and _cnt fields (or similar)
- * of the stdio FILE structure can be used to access the stdio buffer
- * for a file handle. If this is defined, then the FILE_ptr(fp)
- * and FILE_cnt(fp) macros will also be defined and should be used
- * to access these fields.
- */
-/* FILE_ptr:
- * This macro is used to access the _ptr field (or equivalent) of the
- * FILE structure pointed to by its argument. This macro will always be
- * defined if USE_STDIO_PTR is defined.
- */
-/* STDIO_PTR_LVALUE:
- * This symbol is defined if the FILE_ptr macro can be used as an
- * lvalue.
- */
-/* FILE_cnt:
- * This macro is used to access the _cnt field (or equivalent) of the
- * FILE structure pointed to by its argument. This macro will always be
- * defined if USE_STDIO_PTR is defined.
- */
-/* STDIO_CNT_LVALUE:
- * This symbol is defined if the FILE_cnt macro can be used as an
- * lvalue.
- */
-#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 /**/
-#endif
-
-/* USE_STDIO_BASE:
- * This symbol is defined if the _base field (or similar) of the
- * stdio FILE structure can be used to access the stdio buffer for
- * a file handle. If this is defined, then the FILE_base(fp) macro
- * will also be defined and should be used to access this field.
- * Also, the FILE_bufsiz(fp) macro will be defined and should be used
- * to determine the number of bytes in the buffer. USE_STDIO_BASE
- * will never be defined unless USE_STDIO_PTR is.
- */
-/* FILE_base:
- * This macro is used to access the _base field (or equivalent) of the
- * FILE structure pointed to by its argument. This macro will always be
- * defined if USE_STDIO_BASE is defined.
- */
-/* FILE_bufsiz:
- * This macro is used to determine the number of bytes in the I/O
- * buffer pointed to by _base field (or equivalent) of the FILE
- * structure pointed to its argument. This macro will always be defined
- * if USE_STDIO_BASE is defined.
- */
-#define USE_STDIO_BASE /**/
-#ifdef USE_STDIO_BASE
-#define FILE_base(fp) ((fp)->_base)
-#define FILE_bufsiz(fp) ((fp)->_cnt + (fp)->_ptr - (fp)->_base)
-#endif
-
/* HAS_STRCHR:
* This symbol is defined to indicate that the strchr()/strrchr()
* functions are available for string searching. If not, try the
@@ -890,20 +747,6 @@
*/
/*#define HAS_TCSETPGRP /**/
-/* Time_t:
- * This symbol holds the type returned by time(). It can be long,
- * or time_t on BSD sites (in which case <sys/types.h> should be
- * included).
- */
-#define Time_t time_t /* Time type */
-
-/* HAS_TIMES:
- * This symbol, if defined, indicates that the times() routine exists.
- * Note that this became obsolete on some systems (SUNOS), which now
- * use getrusage(). It may be necessary to include <sys/times.h>.
- */
-#define HAS_TIMES /**/
-
/* HAS_TRUNCATE:
* This symbol, if defined, indicates that the truncate routine is
* available to truncate files.
@@ -927,14 +770,6 @@
*/
/*#define HAS_VFORK /**/
-/* Signal_t:
- * This symbol's value is either "void" or "int", corresponding to the
- * appropriate return type of a signal handler. Thus, you can declare
- * a signal handler using "Signal_t (*handler)()", and define the
- * handler using "Signal_t handler(sig)".
- */
-#define Signal_t void /* Signal handler's return type */
-
/* HASVOLATILE:
* This symbol, if defined, indicates that this C compiler knows about
* the volatile declaration.
@@ -944,20 +779,6 @@
#define volatile
#endif
-/* HAS_VPRINTF:
- * This symbol, if defined, indicates that the vprintf routine is available
- * to printf with a pointer to an argument list. If unavailable, you
- * may need to write your own, probably in terms of _doprnt().
- */
-/* USE_CHAR_VSPRINTF:
- * This symbol is defined if this system has vsprintf() returning type
- * (char*). The trend seems to be to declare it as "int vsprintf()". It
- * is up to the package author to declare vsprintf correctly based on the
- * symbol.
- */
-#define HAS_VPRINTF /**/
-/*#define USE_CHAR_VSPRINTF /**/
-
/* HAS_WAIT4:
* This symbol, if defined, indicates that wait4() exists.
*/
@@ -967,7 +788,7 @@
* This symbol, if defined, indicates that the waitpid routine is
* available to wait for child process.
*/
-/*#define HAS_WAITPID /**/
+#define HAS_WAITPID /**/
/* HAS_WCSTOMBS:
* This symbol, if defined, indicates that the wcstombs routine is
@@ -981,46 +802,22 @@
*/
#define HAS_WCTOMB /**/
-/* Fpos_t:
- * This symbol holds the type used to declare file positions in libc.
- * It can be fpos_t, long, uint, etc... It may be necessary to include
- * <sys/types.h> to get any typedef'ed information.
- */
-#define Fpos_t fpos_t /* File position type */
-
-/* Gid_t:
- * This symbol holds the return type of getgid() and the type of
- * argument to setrgid() and related functions. Typically,
- * it is the type of group ids in the kernel. It can be int, ushort,
- * uid_t, etc... It may be necessary to include <sys/types.h> to get
- * any typedef'ed information.
- */
-#define Gid_t gid_t /* Type for getgid(), etc... */
-
-/* Groups_t:
- * This symbol holds the type used for the second argument to
- * [gs]etgroups(). Usually, this is the same of gidtype, but
- * sometimes it isn't. It can be int, ushort, uid_t, etc...
- * It may be necessary to include <sys/types.h> to get any
- * typedef'ed information. This is only required if you have
- * getgroups() or setgroups().
+/* I_ARPA_INET:
+ * This symbol, if defined, indicates that <arpa/inet.h> exists and should
+ * be included.
*/
-#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
-#define Groups_t gid_t /* Type for 2nd arg to [gs]etgroups() */
-#endif
+/*#define I_ARPA_INET /**/
-/* DB_Prefix_t:
- * This symbol contains the type of the prefix structure element
- * in the <db.h> header file. In older versions of DB, it was
- * int, while in newer ones it is u_int32_t.
+/* I_DBM:
+ * This symbol, if defined, indicates that <dbm.h> exists and should
+ * be included.
*/
-/* DB_Hash_t:
- * This symbol contains the type of the prefix structure element
- * in the <db.h> header file. In older versions of DB, it was
- * int, while in newer ones it is size_t.
+/* I_RPCSVC_DBM:
+ * This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and
+ * should be included.
*/
-#define DB_Hash_t int /**/
-#define DB_Prefix_t int /**/
+/*#define I_DBM /**/
+#define I_RPCSVC_DBM /**/
/* I_DIRENT:
* This symbol, if defined, indicates to the C program that it should
@@ -1064,7 +861,27 @@
* This symbol, if defined, indicates to the C program that it should
* include <grp.h>.
*/
-#define I_GRP /**/
+/* GRPASSWD:
+ * This symbol, if defined, indicates to the C program that struct group
+ * contains gr_passwd.
+ */
+/* HAS_SETGRENT:
+ * This symbol, if defined, indicates that the getgrent routine is
+ * available for initializing sequential access of the group database.
+ */
+/* HAS_GETGRENT:
+ * This symbol, if defined, indicates that the getgrent routine is
+ * available for sequential access of the group database.
+ */
+/* HAS_ENDGRENT:
+ * This symbol, if defined, indicates that the getgrent routine is
+ * available for finalizing sequential access of the group database.
+ */
+/*#define I_GRP /**/
+/*#define GRPASSWD /**/
+/*#define HAS_SETGRENT /**/
+/*#define HAS_GETGRENT /**/
+/*#define HAS_ENDGRENT /**/
/* I_LIMITS:
* This symbol, if defined, indicates to the C program that it should
@@ -1073,6 +890,12 @@
*/
#define I_LIMITS /**/
+/* I_LOCALE:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <locale.h>.
+ */
+#define I_LOCALE /**/
+
/* I_MATH:
* This symbol, if defined, indicates to the C program that it should
* include <math.h>.
@@ -1103,41 +926,11 @@
*/
/*#define I_NETINET_IN /**/
-/* I_PWD:
+/* I_SFIO:
* This symbol, if defined, indicates to the C program that it should
- * include <pwd.h>.
- */
-/* PWQUOTA:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_quota.
- */
-/* PWAGE:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_age.
- */
-/* PWCHANGE:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_change.
- */
-/* PWCLASS:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_class.
- */
-/* PWEXPIRE:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_expire.
- */
-/* PWCOMMENT:
- * This symbol, if defined, indicates to the C program that struct passwd
- * contains pw_comment.
+ * include <sfio.h>.
*/
-/*#define I_PWD /**/
-/*#define PWQUOTA /**/
-/*#define PWAGE /**/
-/*#define PWCHANGE /**/
-/*#define PWCLASS /**/
-/*#define PWEXPIRE /**/
-/*#define PWCOMMENT /**/
+/*#define I_SFIO /**/
/* I_STDDEF:
* This symbol, if defined, indicates that <stddef.h> exists and should
@@ -1199,6 +992,12 @@
*/
/*#define I_SYS_SELECT /**/
+/* I_SYS_STAT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/stat.h>.
+ */
+#define I_SYS_STAT /**/
+
/* I_SYS_TIMES:
* This symbol, if defined, indicates to the C program that it should
* include <sys/times.h>.
@@ -1243,22 +1042,6 @@
/*#define I_TERMIOS /**/
/*#define I_SGTTY /**/
-/* I_TIME:
- * This symbol, if defined, indicates to the C program that it should
- * include <time.h>.
- */
-/* I_SYS_TIME:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/time.h>.
- */
-/* I_SYS_TIME_KERNEL:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/time.h> with KERNEL defined.
- */
-#define I_TIME /**/
-/*#define I_SYS_TIME /**/
-/*#define I_SYS_TIME_KERNEL /**/
-
/* I_UNISTD:
* This symbol, if defined, indicates to the C program that it should
* include <unistd.h>.
@@ -1271,6 +1054,14 @@
*/
#define I_UTIME /**/
+/* I_VALUES:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <values.h> to get definition of symbols like MINFLOAT or
+ * MAXLONG, i.e. machine dependant limitations. Probably, you
+ * should use <limits.h> instead, if it is available.
+ */
+/*#define I_VALUES /**/
+
/* I_STDARG:
* This symbol, if defined, indicates that <stdarg.h> exists and should
* be included.
@@ -1288,64 +1079,6 @@
*/
/*#define I_VFORK /**/
-/* INTSIZE:
- * This symbol contains the value of sizeof(int) so that the C
- * preprocessor can make decisions based on it.
- */
-/* LONGSIZE:
- * This symbol contains the value of sizeof(long) so that the C
- * preprocessor can make decisions based on it.
- */
-/* SHORTSIZE:
- * This symbol contains the value of sizeof(short) so that the C
- * preprocessor can make decisions based on it.
- */
-#define INTSIZE 4 /**/
-#define LONGSIZE 4 /**/
-#define SHORTSIZE 2 /**/
-
-/* Off_t:
- * This symbol holds the type used to declare offsets in the kernel.
- * It can be int, long, off_t, etc... It may be necessary to include
- * <sys/types.h> to get any typedef'ed information.
- */
-#define Off_t off_t /* <offset> type */
-
-/* Mode_t:
- * This symbol holds the type used to declare file modes
- * for systems calls. It is usually mode_t, but may be
- * int or unsigned short. It may be necessary to include <sys/types.h>
- * to get any typedef'ed information.
- */
-#define Mode_t mode_t /* file mode parameter for system calls */
-
-/* VAL_O_NONBLOCK:
- * This symbol is to be used during open() or fcntl(F_SETFL) to turn on
- * non-blocking I/O for the file descriptor. Note that there is no way
- * back, i.e. you cannot turn it blocking again this way. If you wish to
- * alternatively switch between blocking and non-blocking, use the
- * ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
- */
-/* VAL_EAGAIN:
- * This symbol holds the errno error code set by read() when no data was
- * present on the non-blocking file descriptor.
- */
-/* RD_NODATA:
- * This symbol holds the return code from read() when no data is present
- * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
- * not defined, then you can't distinguish between no data and EOF by
- * issuing a read(). You'll have to find another way to tell for sure!
- */
-/* EOF_NONBLOCK:
- * This symbol, if defined, indicates to the C program that a read() on
- * a non-blocking file descriptor will return 0 on EOF, and not the value
- * held in RD_NODATA (-1 usually, in that case!).
- */
-#define VAL_O_NONBLOCK O_NONBLOCK
-#define VAL_EAGAIN EAGAIN
-#define RD_NODATA -1
-#define EOF_NONBLOCK
-
/* CAN_PROTOTYPE:
* If defined, this macro indicates that the C compiler can handle
* function prototypes.
@@ -1364,84 +1097,31 @@
#define _(args) ()
#endif
-/* RANDBITS:
- * This symbol contains the number of bits of random number the rand()
- * function produces. Usual values are 15, 16, and 31.
- */
-#define RANDBITS 15 /**/
-
-/* Select_fd_set_t:
- * This symbol holds the type used for the 2nd, 3rd, and 4th
- * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET
- * is defined, and 'int *' otherwise. This is only useful if you
- * have select(), of course.
- */
-#define Select_fd_set_t int * /**/
-
-/* Size_t:
- * This symbol holds the type used to declare length parameters
- * for string functions. It is usually size_t, but may be
- * unsigned long, int, etc. It may be necessary to include
- * <sys/types.h> to get any typedef'ed information.
+/* SH_PATH:
+ * This symbol contains the full pathname to the shell used on this
+ * on this system to execute Bourne shell scripts. Usually, this will be
+ * /bin/sh, though it's possible that some systems will have /bin/ksh,
+ * /bin/pdksh, /bin/ash, /bin/bash, or even something such as
+ * D:/bin/sh.exe.
*/
-#define Size_t size_t /* length paramater for string functions */
-
-/* SSize_t:
- * This symbol holds the type used by functions that return
- * a count of bytes or an error condition. It must be a signed type.
- * It is usually ssize_t, but may be long or int, etc.
- * It may be necessary to include <sys/types.h> or <unistd.h>
- * to get any typedef'ed information.
- * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
- */
-#define SSize_t int /* signed count of bytes */
+#define SH_PATH "cmd /x /c" /**/
/* 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 /**/
-
-/* Uid_t:
- * This symbol holds the type used to declare user ids in the kernel.
- * It can be int, ushort, uid_t, etc... It may be necessary to include
- * <sys/types.h> to get any typedef'ed information.
- */
-#define Uid_t uid_t /* UID type */
+#define STDCHAR char /**/
-/* LOC_SED:
- * This symbol holds the complete pathname to the sed program.
- */
-#define LOC_SED "" /**/
-
-/* OSNAME:
- * This symbol contains the name of the operating system, as determined
- * by Configure. You shouldn't rely on it too much; the specific
- * feature tests from Configure are generally more reliable.
- */
-#define OSNAME "MSWin32" /**/
-
-/* ARCHLIB:
- * This variable, if defined, holds the name of the directory in
- * which the user wants to put architecture-dependent public
- * library files for perl5. It is most often a local directory
- * such as /usr/local/lib. Programs using this variable must be
- * prepared to deal with filename expansion. If ARCHLIB is the
- * same as PRIVLIB, it is not defined, since presumably the
- * program already searches PRIVLIB.
- */
-/* ARCHLIB_EXP:
- * This symbol contains the ~name expanded version of ARCHLIB, to be used
- * in programs that are not prepared to deal with ~ expansion at run-time.
- */
-#define ARCHLIB "c:\\perl\\lib" /**/
-#define ARCHLIB_EXP (win32PerlLibPath()) /**/
-
-/* BINCOMPAT3:
- * This symbol, if defined, indicates that Perl 5.004 should be
- * binary-compatible with Perl 5.003.
+/* MEM_ALIGNBYTES:
+ * This symbol contains the number of bytes required to align a
+ * double. Usual values are 2, 4 and 8.
+ * On NeXT starting with 3.2, you can build "Fat" Multiple Architecture
+ * Binaries (MAB) for targets with varying alignment. This only matters
+ * for perl, where the config.h can be generated and installed on one
+ * system, and used by a different architecture to build an extension.
+ * The default is eight, for safety.
*/
-/*#define BINCOMPAT3 /**/
+#define MEM_ALIGNBYTES 8 /**/
/* BYTEORDER:
* This symbol holds the hexadecimal constant defined in byteorder,
@@ -1466,39 +1146,32 @@
#endif /* ENDIAN CHECK */
#endif /* NeXT */
-/* CSH:
- * This symbol, if defined, indicates that the C-shell exists.
- * If defined, contains the full pathname of csh.
+/* CASTI32:
+ * This symbol is defined if the C compiler can cast negative
+ * or large floating point numbers to 32-bit ints.
*/
-/*#define CSH "" /**/
+#define CASTI32 /**/
-/* DLSYM_NEEDS_UNDERSCORE:
- * This symbol, if defined, indicates that we need to prepend an
- * underscore to the symbol name before calling dlsym(). This only
- * makes sense if you *have* dlsym, which we will presume is the
- * case if you're using dl_dlopen.xs.
+/* CASTNEGFLOAT:
+ * This symbol is defined if the C compiler can cast negative
+ * numbers to unsigned longs, ints and shorts.
*/
-/*#define DLSYM_NEEDS_UNDERSCORE /**/
-
-/* SETUID_SCRIPTS_ARE_SECURE_NOW:
- * This symbol, if defined, indicates that the bug that prevents
- * setuid scripts from being secure is not present in this kernel.
+/* CASTFLAGS:
+ * This symbol contains flags that say what difficulties the compiler
+ * has casting odd floating values to unsigned long:
+ * 0 = ok
+ * 1 = couldn't cast < 0
+ * 2 = couldn't cast >= 0x80000000
+ * 4 = couldn't cast in argument expression list
*/
-/* DOSUID:
- * This symbol, if defined, indicates that the C program should
- * check the script that it is executing for setuid/setgid bits, and
- * attempt to emulate setuid/setgid on systems that have disabled
- * setuid #! scripts because the kernel can't do it securely.
- * It is up to the package designer to make sure that this emulation
- * is done securely. Among other things, it should do an fstat on
- * the script it just opened to make sure it really is a setuid/setgid
- * script, it should make sure the arguments passed correspond exactly
- * to the argument on the #! line, and it should not trust any
- * subprocesses to which it must pass the filename rather than the
- * file descriptor of the script to be executed.
+#define CASTNEGFLOAT /**/
+#define CASTFLAGS 0 /**/
+
+/* VOID_CLOSEDIR:
+ * This symbol, if defined, indicates that the closedir() routine
+ * does not return a value.
*/
-/*#define SETUID_SCRIPTS_ARE_SECURE_NOW /**/
-/*#define DOSUID /**/
+/*#define VOID_CLOSEDIR /**/
/* Gconvert:
* This preprocessor macro is defined to convert a floating point
@@ -1517,62 +1190,58 @@
*/
#define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x))
-/* HAS_GETPGID:
+/* HAS_GNULIBC:
* This symbol, if defined, indicates to the C program that
- * the getpgid(pid) function is available to get the
- * process group id.
+ * the GNU C library is being used.
*/
-/*#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_GNULIBC /**/
+/* HAS_ISASCII:
+ * This manifest constant lets the C program know that isascii
+ * is available.
*/
-/*#define HAS_GETPGRP /**/
-/*#define USE_BSD_GETPGRP /**/
+#define HAS_ISASCII /**/
-/* HAS_INET_ATON:
- * This symbol, if defined, indicates to the C program that the
- * inet_aton() function is available to parse IP address "dotted-quad"
- * strings.
+/* 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_INET_ATON /**/
+/*#define HAS_LCHOWN /**/
-/* HAS_SETPGID:
- * This symbol, if defined, indicates to the C program that
- * the setpgid(pid, gpid) function is available to set the
- * process group id.
+/* HAS_OPEN3:
+ * This manifest constant lets the C program know that the three
+ * argument form of open(2) is available.
*/
-/*#define HAS_SETPGID /**/
+/*#define HAS_OPEN3 /**/
-/* HAS_SETPGRP:
- * This symbol, if defined, indicates that the setpgrp routine is
- * available to set the current process group.
+/* HAS_SAFE_BCOPY:
+ * This symbol, if defined, indicates that the bcopy routine is available
+ * to copy potentially overlapping memory blocks. Otherwise you should
+ * probably use memmove() or memcpy(). If neither is defined, roll your
+ * own version.
*/
-/* 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_SAFE_BCOPY /**/
+
+/* HAS_SAFE_MEMCPY:
+ * This symbol, if defined, indicates that the memcpy routine is available
+ * to copy potentially overlapping memory blocks. Otherwise you should
+ * probably use memmove() or memcpy(). If neither is defined, roll your
+ * own version.
*/
-/* USE_BSDPGRP:
- * This symbol, if defined, indicates that the BSD notion of process
- * group is to be used. For instance, you have to say setpgrp(pid, pgrp)
- * instead of the USG setpgrp(). This should be obsolete since
- * there are systems which have BSD-ish setpgrp but USG-ish getpgrp.
+/*#define HAS_SAFE_MEMCPY /**/
+
+/* HAS_SANE_MEMCMP:
+ * This symbol, if defined, indicates that the memcmp routine is available
+ * and can be used to compare relative magnitudes of chars with their high
+ * bits set. If it is not defined, roll your own version.
*/
-/*#define HAS_SETPGRP /**/
-/*#define USE_BSD_SETPGRP /**/
-/*#define USE_BSDPGRP /**/
+#define HAS_SANE_MEMCMP /**/
-/* USE_SFIO:
- * This symbol, if defined, indicates that sfio should
- * be used.
+/* HAS_SIGACTION:
+ * This symbol, if defined, indicates that Vr4's sigaction() routine
+ * is available.
*/
-/*#define USE_SFIO /**/
+/*#define HAS_SIGACTION /**/
/* Sigjmp_buf:
* This is the buffer type to be used with Sigsetjmp and Siglongjmp.
@@ -1598,48 +1267,483 @@
#define Siglongjmp(buf,retval) longjmp((buf),(retval))
#endif
-/* USE_DYNAMIC_LOADING:
- * This symbol, if defined, indicates that dynamic loading of
- * some sort is available.
+/* USE_STDIO_PTR:
+ * This symbol is defined if the _ptr and _cnt fields (or similar)
+ * of the stdio FILE structure can be used to access the stdio buffer
+ * for a file handle. If this is defined, then the FILE_ptr(fp)
+ * and FILE_cnt(fp) macros will also be defined and should be used
+ * to access these fields.
*/
-#define USE_DYNAMIC_LOADING /**/
+/* FILE_ptr:
+ * This macro is used to access the _ptr field (or equivalent) of the
+ * FILE structure pointed to by its argument. This macro will always be
+ * defined if USE_STDIO_PTR is defined.
+ */
+/* STDIO_PTR_LVALUE:
+ * This symbol is defined if the FILE_ptr macro can be used as an
+ * lvalue.
+ */
+/* FILE_cnt:
+ * This macro is used to access the _cnt field (or equivalent) of the
+ * FILE structure pointed to by its argument. This macro will always be
+ * defined if USE_STDIO_PTR is defined.
+ */
+/* STDIO_CNT_LVALUE:
+ * This symbol is defined if the FILE_cnt macro can be used as an
+ * lvalue.
+ */
+#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 /**/
+#endif
-/* I_DBM:
- * This symbol, if defined, indicates that <dbm.h> exists and should
- * be included.
+/* USE_STDIO_BASE:
+ * This symbol is defined if the _base field (or similar) of the
+ * stdio FILE structure can be used to access the stdio buffer for
+ * a file handle. If this is defined, then the FILE_base(fp) macro
+ * will also be defined and should be used to access this field.
+ * Also, the FILE_bufsiz(fp) macro will be defined and should be used
+ * to determine the number of bytes in the buffer. USE_STDIO_BASE
+ * will never be defined unless USE_STDIO_PTR is.
*/
-/* I_RPCSVC_DBM:
- * This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and
- * should be included.
+/* FILE_base:
+ * This macro is used to access the _base field (or equivalent) of the
+ * FILE structure pointed to by its argument. This macro will always be
+ * defined if USE_STDIO_BASE is defined.
*/
-/*#define I_DBM /**/
-#define I_RPCSVC_DBM /**/
+/* FILE_bufsiz:
+ * This macro is used to determine the number of bytes in the I/O
+ * buffer pointed to by _base field (or equivalent) of the FILE
+ * structure pointed to its argument. This macro will always be defined
+ * if USE_STDIO_BASE is defined.
+ */
+#define USE_STDIO_BASE /**/
+#ifdef USE_STDIO_BASE
+#define FILE_base(fp) ((fp)->_base)
+#define FILE_bufsiz(fp) ((fp)->_cnt + (fp)->_ptr - (fp)->_base)
+#endif
-/* I_LOCALE:
- * This symbol, if defined, indicates to the C program that it should
- * include <locale.h>.
+/* HAS_VPRINTF:
+ * This symbol, if defined, indicates that the vprintf routine is available
+ * to printf with a pointer to an argument list. If unavailable, you
+ * may need to write your own, probably in terms of _doprnt().
*/
-#define I_LOCALE /**/
+/* USE_CHAR_VSPRINTF:
+ * This symbol is defined if this system has vsprintf() returning type
+ * (char*). The trend seems to be to declare it as "int vsprintf()". It
+ * is up to the package author to declare vsprintf correctly based on the
+ * symbol.
+ */
+#define HAS_VPRINTF /**/
+/*#define USE_CHAR_VSPRINTF /**/
-/* I_SFIO:
- * This symbol, if defined, indicates to the C program that it should
- * include <sfio.h>.
+/* DOUBLESIZE:
+ * This symbol contains the size of a double, so that the C preprocessor
+ * can make decisions based on it.
*/
-/*#define I_SFIO /**/
+#define DOUBLESIZE 8 /**/
-/* I_SYS_STAT:
+/* I_TIME:
* This symbol, if defined, indicates to the C program that it should
- * include <sys/stat.h>.
+ * include <time.h>.
*/
-#define I_SYS_STAT /**/
+/* I_SYS_TIME:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/time.h>.
+ */
+/* I_SYS_TIME_KERNEL:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/time.h> with KERNEL defined.
+ */
+#define I_TIME /**/
+/*#define I_SYS_TIME /**/
+/*#define I_SYS_TIME_KERNEL /**/
-/* I_VALUES:
+/* INTSIZE:
+ * This symbol contains the value of sizeof(int) so that the C
+ * preprocessor can make decisions based on it.
+ */
+/* LONGSIZE:
+ * This symbol contains the value of sizeof(long) so that the C
+ * preprocessor can make decisions based on it.
+ */
+/* SHORTSIZE:
+ * This symbol contains the value of sizeof(short) so that the C
+ * preprocessor can make decisions based on it.
+ */
+#define INTSIZE 4 /**/
+#define LONGSIZE 4 /**/
+#define SHORTSIZE 2 /**/
+
+/* VAL_O_NONBLOCK:
+ * This symbol is to be used during open() or fcntl(F_SETFL) to turn on
+ * non-blocking I/O for the file descriptor. Note that there is no way
+ * back, i.e. you cannot turn it blocking again this way. If you wish to
+ * alternatively switch between blocking and non-blocking, use the
+ * ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
+ */
+/* VAL_EAGAIN:
+ * This symbol holds the errno error code set by read() when no data was
+ * present on the non-blocking file descriptor.
+ */
+/* RD_NODATA:
+ * This symbol holds the return code from read() when no data is present
+ * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
+ * not defined, then you can't distinguish between no data and EOF by
+ * issuing a read(). You'll have to find another way to tell for sure!
+ */
+/* EOF_NONBLOCK:
+ * This symbol, if defined, indicates to the C program that a read() on
+ * a non-blocking file descriptor will return 0 on EOF, and not the value
+ * held in RD_NODATA (-1 usually, in that case!).
+ */
+#define VAL_O_NONBLOCK O_NONBLOCK
+#define VAL_EAGAIN EAGAIN
+#define RD_NODATA -1
+#define EOF_NONBLOCK
+
+/* PTRSIZE:
+ * This symbol contains the size of a pointer, so that the C preprocessor
+ * can make decisions based on it. It will be sizeof(void *) if
+ * the compiler supports (void *); otherwise it will be
+ * sizeof(char *).
+ */
+#define PTRSIZE 4 /**/
+
+/* RANDBITS:
+ * This symbol contains the number of bits of random number the rand()
+ * function produces. Usual values are 15, 16, and 31.
+ */
+#define RANDBITS 15 /**/
+
+/* SSize_t:
+ * This symbol holds the type used by functions that return
+ * a count of bytes or an error condition. It must be a signed type.
+ * It is usually ssize_t, but may be long or int, etc.
+ * It may be necessary to include <sys/types.h> or <unistd.h>
+ * to get any typedef'ed information.
+ * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
+ */
+#define SSize_t int /* signed count of bytes */
+
+/* OSNAME:
+ * This symbol contains the name of the operating system, as determined
+ * by Configure. You shouldn't rely on it too much; the specific
+ * feature tests from Configure are generally more reliable.
+ */
+#define OSNAME "MSWin32" /**/
+
+/* CAT2:
+ * This macro catenates 2 tokens together.
+ */
+/* STRINGIFY:
+ * This macro surrounds its token with double quotes.
+ */
+#if 42 == 1
+#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 CAT2(a,b)a ## b
+#define StGiFy(a)# a
+#define STRINGIFY(a)StGiFy(a)
+#endif
+#if 42 != 1 && 42 != 42
+#include "Bletch: How does this C preprocessor catenate tokens?"
+#endif
+
+/* CSH:
+ * This symbol, if defined, contains the full pathname of csh.
+ */
+/*#define HAS_CSH /**/
+#ifdef HAS_CSH
+#define CSH "" /**/
+#endif
+
+/* HAS_ENDHOSTENT:
+ * This symbol, if defined, indicates that the endhostent() routine is
+ * available to close whatever was being used for host queries.
+ */
+/*#define HAS_ENDHOSTENT /**/
+
+/* HAS_ENDNETENT:
+ * This symbol, if defined, indicates that the endnetent() routine is
+ * available to close whatever was being used for network queries.
+ */
+/*#define HAS_ENDNETENT /**/
+
+/* HAS_ENDPROTOENT:
+ * This symbol, if defined, indicates that the endprotoent() routine is
+ * available to close whatever was being used for protocol queries.
+ */
+/*#define HAS_ENDPROTOENT /**/
+
+/* HAS_ENDSERVENT:
+ * This symbol, if defined, indicates that the endservent() routine is
+ * available to close whatever was being used for service queries.
+ */
+/*#define HAS_ENDSERVENT /**/
+
+/* HAS_GETHOSTBYADDR:
+ * This symbol, if defined, indicates that the gethostbyaddr() routine is
+ * available to look up hosts by their IP addresses.
+ */
+#define HAS_GETHOSTBYADDR /**/
+
+/* HAS_GETHOSTBYNAME:
+ * This symbol, if defined, indicates that the gethostbyname() routine is
+ * available to look up host names in some data base or other.
+ */
+#define HAS_GETHOSTBYNAME /**/
+
+/* HAS_GETHOSTENT:
+ * This symbol, if defined, indicates that the gethostent() routine is
+ * available to look up host names in some data base or another.
+ */
+/*#define HAS_GETHOSTENT /**/
+
+/* HAS_GETNETBYADDR:
+ * This symbol, if defined, indicates that the getnetbyaddr() routine is
+ * available to look up networks by their IP addresses.
+ */
+/*#define HAS_GETNETBYADDR /**/
+
+/* HAS_GETNETBYNAME:
+ * This symbol, if defined, indicates that the getnetbyname() routine is
+ * available to look up networks by their names.
+ */
+/*#define HAS_GETNETBYNAME /**/
+
+/* HAS_GETNETENT:
+ * This symbol, if defined, indicates that the getnetent() routine is
+ * available to look up network names in some data base or another.
+ */
+/*#define HAS_GETNETENT /**/
+
+/* HAS_GETPROTOENT:
+ * This symbol, if defined, indicates that the getprotoent() routine is
+ * available to look up protocols in some data base or another.
+ */
+/*#define HAS_GETPROTOENT /**/
+
+/* HAS_GETPROTOBYNAME:
+ * This symbol, if defined, indicates that the getprotobyname()
+ * routine is available to look up protocols by their name.
+ */
+/* HAS_GETPROTOBYNUMBER:
+ * This symbol, if defined, indicates that the getprotobynumber()
+ * routine is available to look up protocols by their number.
+ */
+#define HAS_GETPROTOBYNAME /**/
+#define HAS_GETPROTOBYNUMBER /**/
+
+/* HAS_GETSERVENT:
+ * This symbol, if defined, indicates that the getservent() routine is
+ * available to look up network services in some data base or another.
+ */
+/*#define HAS_GETSERVENT /**/
+
+/* HAS_GETSERVBYNAME:
+ * This symbol, if defined, indicates that the getservbyname()
+ * routine is available to look up services by their name.
+ */
+/* HAS_GETSERVBYPORT:
+ * This symbol, if defined, indicates that the getservbyport()
+ * routine is available to look up services by their port.
+ */
+#define HAS_GETSERVBYNAME /**/
+#define HAS_GETSERVBYPORT /**/
+
+/* HAS_LONG_DOUBLE:
+ * This symbol will be defined if the C compiler supports long
+ * doubles.
+ */
+/* LONG_DOUBLESIZE:
+ * This symbol contains the size of a long double, so that the
+ * C preprocessor can make decisions based on it. It is only
+ * defined if the system supports long doubles.
+ */
+#define HAS_LONG_DOUBLE /**/
+#ifdef HAS_LONG_DOUBLE
+#define LONG_DOUBLESIZE 10 /**/
+#endif
+
+/* HAS_LONG_LONG:
+ * This symbol will be defined if the C compiler supports
+ * long long.
+ */
+/* LONGLONGSIZE:
+ * This symbol contains the size of a long long, so that the
+ * C preprocessor can make decisions based on it. It is only
+ * defined if the system supports long long.
+ */
+/*#define HAS_LONG_LONG /**/
+#ifdef HAS_LONG_LONG
+#define LONGLONGSIZE 8 /**/
+#endif
+
+/* HAS_SETGROUPS:
+ * This symbol, if defined, indicates that the setgroups() routine is
+ * available to set the list of process groups. If unavailable, multiple
+ * groups are probably not supported.
+ */
+/*#define HAS_SETGROUPS /**/
+
+/* HAS_SETHOSTENT:
+ * This symbol, if defined, indicates that the sethostent() routine is
+ * available.
+ */
+/*#define HAS_SETHOSTENT /**/
+
+/* HAS_SETNETENT:
+ * This symbol, if defined, indicates that the setnetent() routine is
+ * available.
+ */
+/*#define HAS_SETNETENT /**/
+
+/* HAS_SETPROTOENT:
+ * This symbol, if defined, indicates that the setprotoent() routine is
+ * available.
+ */
+/*#define HAS_SETPROTOENT /**/
+
+/* HAS_SETSERVENT:
+ * This symbol, if defined, indicates that the setservent() routine is
+ * available.
+ */
+/*#define HAS_SETSERVENT /**/
+
+/* HAS_SETVBUF:
+ * This symbol, if defined, indicates that the setvbuf routine is
+ * available to change buffering on an open stdio stream.
+ * to a line-buffered mode.
+ */
+#define HAS_SETVBUF /**/
+
+/* HAS_SOCKET:
+ * This symbol, if defined, indicates that the BSD socket interface is
+ * supported.
+ */
+/* HAS_SOCKETPAIR:
+ * This symbol, if defined, indicates that the BSD socketpair() call is
+ * supported.
+ */
+#define HAS_SOCKET /**/
+/*#define HAS_SOCKETPAIR /**/
+
+/* HAS_UNION_SEMUN:
+ * This symbol, if defined, indicates that the union semun is
+ * defined by including <sys/sem.h>. If not, the user code
+ * probably needs to define it as:
+ * union semun {
+ * int val;
+ * struct semid_ds *buf;
+ * unsigned short *array;
+ * }
+ */
+/* USE_SEMCTL_SEMUN:
+ * This symbol, if defined, indicates that union semun is
+ * used for semctl IPC_STAT.
+ */
+/* USE_SEMCTL_SEMID_DS:
+ * This symbol, if defined, indicates that struct semid_ds * is
+ * used for semctl IPC_STAT.
+ */
+#define HAS_UNION_SEMUN /**/
+/*#define USE_SEMCTL_SEMUN /**/
+/*#define USE_SEMCTL_SEMID_DS /**/
+
+/* Signal_t:
+ * This symbol's value is either "void" or "int", corresponding to the
+ * appropriate return type of a signal handler. Thus, you can declare
+ * a signal handler using "Signal_t (*handler)()", and define the
+ * handler using "Signal_t handler(sig)".
+ */
+#define Signal_t void /* Signal handler's return type */
+
+/* Groups_t:
+ * This symbol holds the type used for the second argument to
+ * getgroups() and setgropus(). Usually, this is the same as
+ * gidtype (gid_t) , but sometimes it isn't.
+ * It can be int, ushort, uid_t, etc...
+ * It may be necessary to include <sys/types.h> to get any
+ * typedef'ed information. This is only required if you have
+ * getgroups() or setgropus()..
+ */
+#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
+#define Groups_t gid_t /* Type for 2nd arg to [sg]etgroups() */
+#endif
+
+/* I_NETDB:
+ * This symbol, if defined, indicates that <netdb.h> exists and
+ * should be included.
+ */
+/*#define I_NETDB /**/
+
+/* I_PWD:
* This symbol, if defined, indicates to the C program that it should
- * include <values.h> to get definition of symbols like MINFLOAT or
- * MAXLONG, i.e. machine dependant limitations. Probably, you
- * should use <limits.h> instead, if it is available.
+ * include <pwd.h>.
*/
-/*#define I_VALUES /**/
+/* PWQUOTA:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_quota.
+ */
+/* PWAGE:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_age.
+ */
+/* PWCHANGE:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_change.
+ */
+/* PWCLASS:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_class.
+ */
+/* PWEXPIRE:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_expire.
+ */
+/* PWCOMMENT:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_comment.
+ */
+/* PWGECOS:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_gecos.
+ */
+/* PWPASSWD:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_passwd.
+ */
+/* HAS_SETPWENT:
+ * This symbol, if defined, indicates that the getpwrent routine is
+ * available for initializing sequential access of the passwd database.
+ */
+/* HAS_GETPWENT:
+ * This symbol, if defined, indicates that the getpwent routine is
+ * available for sequential access of the password database.
+ */
+/* HAS_ENDPWENT:
+ * This symbol, if defined, indicates that the getpwent routine is
+ * available for finalizing sequential access of the passwd database.
+ */
+/*#define I_PWD /**/
+/*#define PWQUOTA /**/
+/*#define PWAGE /**/
+/*#define PWCHANGE /**/
+/*#define PWCLASS /**/
+/*#define PWEXPIRE /**/
+/*#define PWCOMMENT /**/
+/*#define PWGECOS /**/
+/*#define PWPASSWD /**/
+/*#define HAS_SETPWENT /**/
+/*#define HAS_GETPWENT /**/
+/*#define HAS_ENDPWENT /**/
/* Free_t:
* This variable contains the return type of free(). It is usually
@@ -1656,43 +1760,6 @@
*/
/*#define MYMALLOC /**/
-/* OLDARCHLIB:
- * This variable, if defined, holds the name of the directory in
- * which the user has perl5.000 or perl5.001 architecture-dependent
- * public library files for perl5. For the most part, these
- * files will work with 5.002 (and later), but that is not
- * guaranteed.
- */
-/* OLDARCHLIB_EXP:
- * This symbol contains the ~name expanded version of OLDARCHLIB, to be
- * used in programs that are not prepared to deal with ~ expansion at
- * run-time.
- */
-/*#define OLDARCHLIB "" /**/
-/*#define OLDARCHLIB_EXP "" /**/
-
-/* PRIVLIB:
- * This symbol contains the name of the private library for this package.
- * The library is private in the sense that it needn't be in anyone's
- * execution path, but it should be accessible by the world. The program
- * should be prepared to do ~ expansion.
- */
-/* PRIVLIB_EXP:
- * This symbol contains the ~name expanded version of PRIVLIB, to be used
- * in programs that are not prepared to deal with ~ expansion at run-time.
- */
-#define PRIVLIB "c:\\perl\\lib" /**/
-#define PRIVLIB_EXP "c:\\perl\\lib" /**/
-
-/* SH_PATH:
- * This symbol contains the full pathname to the shell used on this
- * on this system to execute Bourne shell scripts. Usually, this will be
- * /bin/sh, though it's possible that some systems will have /bin/ksh,
- * /bin/pdksh, /bin/ash, /bin/bash, or even something such as
- * D:/bin/sh.exe.
- */
-#define SH_PATH "cmd.exe" /**/
-
/* SIG_NAME:
* This symbol contains a list of signal names in order of
* signal number. This is intended
@@ -1721,8 +1788,95 @@
* The last element is 0, corresponding to the 0 at the end of
* the sig_name list.
*/
-#define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","ABRT","EMT","FPE","KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM","USR1","USR2","CHLD","PWR","WINCH","URG","IO","STOP","TSTP","CONT","TTIN","TTOU","VTALRM","PROF","XCPU","XFSZ","WAITING","LWP","FREEZE","THAW","RTMIN","NUM37","NUM38","NUM39","NUM40","NUM41","NUM42","RTMAX","IOT","CLD","POLL",0 /**/
-#define 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,6,18,22,0 /**/
+#define SIG_NAME "ZERO", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "CHLD", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0 /**/
+#define SIG_NUM 0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 20, 21, 22, 23, 25, 20, 0 /**/
+
+/* VOIDFLAGS:
+ * This symbol indicates how much support of the void type is given by this
+ * compiler. What various bits mean:
+ *
+ * 1 = supports declaration of void
+ * 2 = supports arrays of pointers to functions returning void
+ * 4 = supports comparisons between pointers to void functions and
+ * addresses of void functions
+ * 8 = suports declaration of generic void pointers
+ *
+ * The package designer should define VOIDUSED to indicate the requirements
+ * of the package. This can be done either by #defining VOIDUSED before
+ * including config.h, or by defining defvoidused in Myinit.U. If the
+ * latter approach is taken, only those flags will be tested. If the
+ * level of void support necessary is not present, defines void to int.
+ */
+#ifndef VOIDUSED
+#define VOIDUSED 15
+#endif
+#define VOIDFLAGS 15
+#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
+#define void int /* is void to be avoided? */
+#define M_VOID /* Xenix strikes again */
+#endif
+
+/* ARCHLIB:
+ * This variable, if defined, holds the name of the directory in
+ * which the user wants to put architecture-dependent public
+ * library files for perl5. It is most often a local directory
+ * such as /usr/local/lib. Programs using this variable must be
+ * prepared to deal with filename expansion. If ARCHLIB is the
+ * same as PRIVLIB, it is not defined, since presumably the
+ * program already searches PRIVLIB.
+ */
+/* ARCHLIB_EXP:
+ * This symbol contains the ~name expanded version of ARCHLIB, to be used
+ * in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+#define ARCHLIB "c:\\perl\\5.00503\\lib\\MSWin32-x86" /**/
+/*#define ARCHLIB_EXP "" /**/
+
+/* DLSYM_NEEDS_UNDERSCORE:
+ * This symbol, if defined, indicates that we need to prepend an
+ * underscore to the symbol name before calling dlsym(). This only
+ * makes sense if you *have* dlsym, which we will presume is the
+ * case if you're using dl_dlopen.xs.
+ */
+/*#define DLSYM_NEEDS_UNDERSCORE /**/
+
+/* USE_SFIO:
+ * This symbol, if defined, indicates that sfio should
+ * be used.
+ */
+/*#define USE_SFIO /**/
+
+/* USE_DYNAMIC_LOADING:
+ * This symbol, if defined, indicates that dynamic loading of
+ * some sort is available.
+ */
+#define USE_DYNAMIC_LOADING /**/
+
+/* DB_Prefix_t:
+ * This symbol contains the type of the prefix structure element
+ * in the <db.h> header file. In older versions of DB, it was
+ * int, while in newer ones it is u_int32_t.
+ */
+/* DB_Hash_t:
+ * This symbol contains the type of the prefix structure element
+ * in the <db.h> header file. In older versions of DB, it was
+ * int, while in newer ones it is size_t.
+ */
+#define DB_Hash_t int /**/
+#define DB_Prefix_t int /**/
+
+/* PRIVLIB:
+ * This symbol contains the name of the private library for this package.
+ * The library is private in the sense that it needn't be in anyone's
+ * execution path, but it should be accessible by the world. The program
+ * should be prepared to do ~ expansion.
+ */
+/* PRIVLIB_EXP:
+ * This symbol contains the ~name expanded version of PRIVLIB, to be used
+ * in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+#define PRIVLIB "c:\\perl\\5.00503\\lib" /**/
+#define PRIVLIB_EXP (win32_get_privlib("5.00503")) /**/
/* SITEARCH:
* This symbol contains the name of the private library for this package.
@@ -1737,8 +1891,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 "c:\\perl\\lib\\site" /**/
-#define SITEARCH_EXP "c:\\perl\\lib\\site" /**/
+#define SITEARCH "c:\\perl\\site\\5.00503\\lib\\MSWin32-x86" /**/
+/*#define SITEARCH_EXP "" /**/
/* SITELIB:
* This symbol contains the name of the private library for this package.
@@ -1753,15 +1907,15 @@
* This symbol contains the ~name expanded version of SITELIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITELIB "c:\\perl\\lib\\site" /**/
-#define SITELIB_EXP "c:\\perl\\lib\\site" /**/
+#define SITELIB "c:\\perl\\site\\5.00503\\lib" /**/
+#define SITELIB_EXP (win32_get_sitelib("5.00503")) /**/
/* STARTPERL:
* This variable contains the string to put in front of a perl
* script to make sure (one hopes) that it runs with perl and not
* some shell.
*/
-#define STARTPERL "#perl" /**/
+#define STARTPERL "#!perl" /**/
/* USE_PERLIO:
* This symbol, if defined, indicates that the PerlIO abstraction should
@@ -1770,33 +1924,171 @@
*/
/*#define USE_PERLIO /**/
-/* VOIDFLAGS:
- * This symbol indicates how much support of the void type is given by this
- * compiler. What various bits mean:
- *
- * 1 = supports declaration of void
- * 2 = supports arrays of pointers to functions returning void
- * 4 = supports comparisons between pointers to void functions and
- * addresses of void functions
- * 8 = suports declaration of generic void pointers
- *
- * The package designer should define VOIDUSED to indicate the requirements
- * of the package. This can be done either by #defining VOIDUSED before
- * including config.h, or by defining defvoidused in Myinit.U. If the
- * latter approach is taken, only those flags will be tested. If the
- * level of void support necessary is not present, defines void to int.
+/* HAS_GETHOST_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for gethostent(), gethostbyname(), and
+ * gethostbyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
*/
-#ifndef VOIDUSED
-#define VOIDUSED 15
-#endif
-#define VOIDFLAGS 15
-#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
-#define void int /* is void to be avoided? */
-#define M_VOID /* Xenix strikes again */
-#endif
+#define HAS_GETHOST_PROTOS /**/
+
+/* HAS_GETNET_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for getnetent(), getnetbyname(), and
+ * getnetbyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+/*#define HAS_GETNET_PROTOS /**/
+
+/* HAS_GETPROTO_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for getprotoent(), getprotobyname(), and
+ * getprotobyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+#define HAS_GETPROTO_PROTOS /**/
+
+/* HAS_GETSERV_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for getservent(), getservbyname(), and
+ * getservbyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+#define HAS_GETSERV_PROTOS /**/
+
+/* Netdb_host_t:
+ * This symbol holds the type used for the 1st argument
+ * to gethostbyaddr().
+ */
+/* Netdb_hlen_t:
+ * This symbol holds the type used for the 2nd argument
+ * to gethostbyaddr().
+ */
+/* Netdb_name_t:
+ * This symbol holds the type used for the argument to
+ * gethostbyname().
+ */
+/* Netdb_net_t:
+ * This symbol holds the type used for the 1st argument to
+ * getnetbyaddr().
+ */
+#define Netdb_host_t char * /**/
+#define Netdb_hlen_t int /**/
+#define Netdb_name_t char * /**/
+#define Netdb_net_t long /**/
+
+/* Select_fd_set_t:
+ * This symbol holds the type used for the 2nd, 3rd, and 4th
+ * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET
+ * is defined, and 'int *' otherwise. This is only useful if you
+ * have select(), of course.
+ */
+#define Select_fd_set_t Perl_fd_set * /**/
+
+/* ARCHNAME:
+ * This symbol holds a string representing the architecture name.
+ * It may be used to construct an architecture-dependant pathname
+ * where library files may be held under a private library, for
+ * instance.
+ */
+#define ARCHNAME "MSWin32-x86" /**/
+
+/* HAS_PTHREAD_YIELD:
+ * This symbol, if defined, indicates that the pthread_yield
+ * routine is available to yield the execution of the current
+ * thread.
+ */
+/* HAS_SCHED_YIELD:
+ * This symbol, if defined, indicates that the sched_yield
+ * routine is available to yield the execution of the current
+ * thread.
+ */
+/*#define HAS_PTHREAD_YIELD /**/
+/*#define HAS_SCHED_YIELD /**/
+
+/* PTHREADS_CREATED_JOINABLE:
+ * This symbol, if defined, indicates that pthreads are created
+ * in the joinable (aka undetached) state.
+ */
+/*#define PTHREADS_CREATED_JOINABLE /**/
+
+/* USE_THREADS:
+ * This symbol, if defined, indicates that Perl should
+ * be built to use threads.
+ */
+/* OLD_PTHREADS_API:
+ * This symbol, if defined, indicates that Perl should
+ * be built to use the old draft POSIX threads API.
+ */
+/*#define USE_THREADS /**/
+/*#define OLD_PTHREADS_API /**/
+
+/* Time_t:
+ * This symbol holds the type returned by time(). It can be long,
+ * or time_t on BSD sites (in which case <sys/types.h> should be
+ * included).
+ */
+#define Time_t time_t /* Time type */
+
+/* HAS_TIMES:
+ * This symbol, if defined, indicates that the times() routine exists.
+ * Note that this became obsolete on some systems (SUNOS), which now
+ * use getrusage(). It may be necessary to include <sys/times.h>.
+ */
+#define HAS_TIMES /**/
+
+/* Fpos_t:
+ * This symbol holds the type used to declare file positions in libc.
+ * It can be fpos_t, long, uint, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+#define Fpos_t fpos_t /* File position type */
+
+/* Gid_t:
+ * This symbol holds the return type of getgid() and the type of
+ * argument to setrgid() and related functions. Typically,
+ * it is the type of group ids in the kernel. It can be int, ushort,
+ * uid_t, etc... It may be necessary to include <sys/types.h> to get
+ * any typedef'ed information.
+ */
+#define Gid_t gid_t /* Type for getgid(), etc... */
+
+/* Off_t:
+ * This symbol holds the type used to declare offsets in the kernel.
+ * It can be int, long, off_t, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+#define Off_t off_t /* <offset> type */
+
+/* Mode_t:
+ * This symbol holds the type used to declare file modes
+ * for systems calls. It is usually mode_t, but may be
+ * int or unsigned short. It may be necessary to include <sys/types.h>
+ * to get any typedef'ed information.
+ */
+#define Mode_t mode_t /* file mode parameter for system calls */
+
+/* Pid_t:
+ * This symbol holds the type used to declare process ids in the kernel.
+ * It can be int, uint, pid_t, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+#define Pid_t int /* PID type */
+
+/* Size_t:
+ * This symbol holds the type used to declare length parameters
+ * for string functions. It is usually size_t, but may be
+ * unsigned long, int, etc. It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+#define Size_t size_t /* length paramater for string functions */
+
+/* Uid_t:
+ * This symbol holds the type used to declare user ids in the kernel.
+ * It can be int, ushort, uid_t, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+#define Uid_t uid_t /* UID type */
#endif
#include <win32.h>
-#ifndef DEBUGGING
-#define DEBUGGING
-#endif
diff --git a/gnu/usr.bin/perl/win32/config_h.PL b/gnu/usr.bin/perl/win32/config_h.PL
index 5d47016dc97..617b996cdb1 100644
--- a/gnu/usr.bin/perl/win32/config_h.PL
+++ b/gnu/usr.bin/perl/win32/config_h.PL
@@ -2,8 +2,21 @@
use Config;
use File::Compare qw(compare);
use File::Copy qw(copy);
+my $OBJ = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i;
my $name = $0;
$name =~ s#^(.*)\.PL$#../$1.SH#;
+my %opt;
+while (@ARGV && $ARGV[0] =~ /^([\w_]+)=(.*)$/)
+ {
+ $opt{$1}=$2;
+ shift(@ARGV);
+ }
+my $patchlevel = $opt{INST_VER};
+$patchlevel =~ s|^[\\/]||;
+$patchlevel =~ s|~VERSION~|$]|g;
+$patchlevel ||= $];
+$patchlevel = qq["$patchlevel"];
+
open(SH,"<$name") || die "Cannot open $name:$!";
while (<SH>)
{
@@ -27,6 +40,7 @@ eval $str;
die "$str:$@" if $@;
open(H,">$file.new") || die "Cannot open $file.new:$!";
+binmode H; # no CRs (which cause a spurious rebuild)
while (<SH>)
{
last if /^$term$/o;
@@ -35,18 +49,18 @@ while (<SH>)
munge();
s/\\\$/\$/g;
s#/[ *\*]*\*/#/**/#;
- if (/^\s*#define\s+ARCHLIB_EXP/)
+ if (/^\s*#define\s+(PRIVLIB|SITELIB)_EXP/)
{
- $_ = "#define ARCHLIB_EXP (win32PerlLibPath())\t/**/\n"
- . "#define APPLLIB_EXP (win32SiteLibPath())\t/**/\n";
+ $_ = "#define ". $1 . "_EXP (win32_get_". lc($1) . "($patchlevel))\t/**/\n";
+ }
+ # incpush() handles archlibs, so disable them
+ elsif (/^\s*#define\s+(ARCHLIB|SITEARCH)_EXP/)
+ {
+ $_ = "/*#define ". $1 . "_EXP \"\"\t/**/\n";
}
print H;
}
-print H "#include <win32.h>
-#ifndef DEBUGGING
-#define DEBUGGING
-#endif
-";
+print H "#include <win32.h>\n";
close(H);
close(SH);
@@ -55,15 +69,20 @@ chmod(0666,"../lib/CORE/config.h");
copy("$file.new","../lib/CORE/config.h") || die "Cannot copy:$!";
chmod(0444,"../lib/CORE/config.h");
-if (compare("$file.new",$file))
+if (!$OBJ && compare("$file.new",$file))
{
warn "$file has changed\n";
chmod(0666,$file);
unlink($file);
rename("$file.new",$file);
- chmod(0444,$file);
+ #chmod(0444,$file);
exit(1);
}
+else
+ {
+ unlink ("$file.new");
+ exit(0);
+ }
sub Config
{
diff --git a/gnu/usr.bin/perl/win32/config_sh.PL b/gnu/usr.bin/perl/win32/config_sh.PL
index 0769ef31120..1d4b2fb5c35 100644
--- a/gnu/usr.bin/perl/win32/config_sh.PL
+++ b/gnu/usr.bin/perl/win32/config_sh.PL
@@ -1,3 +1,15 @@
+# take a semicolon separated path list and turn it into a quoted
+# list of paths that Text::Parsewords will grok
+sub mungepath {
+ my $p = shift;
+ # remove leading/trailing semis/spaces
+ $p =~ s/^[ ;]+//;
+ $p =~ s/[ ;]+$//;
+ $p =~ s/'/"/g;
+ my @p = map { $_ = "\"$_\"" if /\s/ and !/^".*"$/; $_ } split /;/, $p;
+ return join(' ', @p);
+}
+
my %opt;
while (@ARGV && $ARGV[0] =~ /^([\w_]+)=(.*)$/)
{
@@ -5,6 +17,8 @@ while (@ARGV && $ARGV[0] =~ /^([\w_]+)=(.*)$/)
shift(@ARGV);
}
+$opt{VERSION} = $];
+$opt{INST_VER} =~ s|~VERSION~|$]|g;
if ($] =~ /\.(\d\d\d)?(\d\d)?$/) { # should always be true
$opt{PATCHLEVEL} = int($1 || 0);
$opt{SUBVERSION} = $2 || '00';
@@ -13,11 +27,23 @@ if ($] =~ /\.(\d\d\d)?(\d\d)?$/) { # should always be true
$opt{'cf_by'} = $ENV{USERNAME} unless $opt{'cf_by'};
$opt{'cf_email'} = $opt{'cf_by'} . '@' . (gethostbyname('localhost'))[0]
unless $opt{'cf_email'};
+$opt{'usemymalloc'} = 'y' if $opt{'d_mymalloc'} eq 'define';
+
+$opt{libpth} = mungepath($opt{libpth}) if exists $opt{libpth};
+$opt{incpath} = mungepath($opt{incpath}) if exists $opt{incpath};
while (<>)
{
s/~([\w_]+)~/$opt{$1}/g;
- $_ = "$1='$opt{$1}'\n" if (/^([\w_]+)=/ && exists($opt{$1}));
+ if (/^([\w_]+)=(.*)$/) {
+ # this depends on cf_time being empty in the template (or we'll get a loop)
+ if ($1 eq 'cf_time') {
+ $_ = "$1='" . localtime(time) . "'\n" if $2 =~ /^\s*'\s*'/;
+ }
+ elsif (exists $opt{$1}) {
+ $_ = "$1='$opt{$1}'\n";
+ }
+ }
print;
}
diff --git a/gnu/usr.bin/perl/win32/dl_win32.xs b/gnu/usr.bin/perl/win32/dl_win32.xs
index 7b227e299c9..c650acffb73 100644
--- a/gnu/usr.bin/perl/win32/dl_win32.xs
+++ b/gnu/usr.bin/perl/win32/dl_win32.xs
@@ -18,27 +18,75 @@ calls.
*/
#define WIN32_LEAN_AND_MEAN
+#ifdef __GNUC__
+#define Win32_Winsock
+#endif
#include <windows.h>
#include <string.h>
#include "EXTERN.h"
#include "perl.h"
+#include "win32.h"
+
+#ifdef PERL_OBJECT
+#define NO_XSLOCKS
+#endif /* PERL_OBJECT */
+
#include "XSUB.h"
+static SV *error_sv;
+
+static char *
+OS_Error_String(CPERLarg)
+{
+ DWORD err = GetLastError();
+ STRLEN len;
+ if (!error_sv)
+ error_sv = newSVpv("",0);
+ win32_str_os_error(error_sv,err);
+ return SvPV(error_sv,len);
+}
+
#include "dlutils.c" /* SaveError() etc */
static void
-dl_private_init()
+dl_private_init(CPERLarg)
{
- (void)dl_generic_private_init();
+ (void)dl_generic_private_init(PERL_OBJECT_THIS);
}
+/*
+ This function assumes the list staticlinkmodules
+ will be formed from package names with '::' replaced
+ with '/'. Thus Win32::OLE is in the list as Win32/OLE
+*/
static int
dl_static_linked(char *filename)
{
char **p;
+ char* ptr;
+ static char subStr[] = "/auto/";
+ char szBuffer[MAX_PATH];
+
+ /* change all the '\\' to '/' */
+ strcpy(szBuffer, filename);
+ for(ptr = szBuffer; ptr = strchr(ptr, '\\'); ++ptr)
+ *ptr = '/';
+
+ /* delete the file name */
+ ptr = strrchr(szBuffer, '/');
+ if(ptr != NULL)
+ *ptr = '\0';
+
+ /* remove leading lib path */
+ ptr = strstr(szBuffer, subStr);
+ if(ptr != NULL)
+ ptr += sizeof(subStr)-1;
+ else
+ ptr = szBuffer;
+
for (p = staticlinkmodules; *p;p++) {
- if (strstr(filename, *p)) return 1;
+ if (strstr(ptr, *p)) return 1;
};
return 0;
}
@@ -46,7 +94,7 @@ dl_static_linked(char *filename)
MODULE = DynaLoader PACKAGE = DynaLoader
BOOT:
- (void)dl_private_init();
+ (void)dl_private_init(PERL_OBJECT_THIS);
void *
dl_load_file(filename,flags=0)
@@ -54,15 +102,16 @@ dl_load_file(filename,flags=0)
int flags
PREINIT:
CODE:
- DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
+ DLDEBUG(1,PerlIO_printf(PerlIO_stderr(),"dl_load_file(%s):\n", filename));
if (dl_static_linked(filename) == 0)
RETVAL = (void*) LoadLibraryEx(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ;
else
RETVAL = (void*) GetModuleHandle(NULL);
- DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL));
+ DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
- SaveError("%d",GetLastError()) ;
+ SaveError(PERL_OBJECT_THIS_ "load_file:%s",
+ OS_Error_String(PERL_OBJECT_THIS)) ;
else
sv_setiv( ST(0), (IV)RETVAL);
@@ -72,13 +121,14 @@ dl_find_symbol(libhandle, symbolname)
void * libhandle
char * symbolname
CODE:
- DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
+ DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n",
libhandle, symbolname));
RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname);
- DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL));
+ DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref = %x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
- SaveError("%d",GetLastError()) ;
+ SaveError(PERL_OBJECT_THIS_ "find_symbol:%s",
+ OS_Error_String(PERL_OBJECT_THIS)) ;
else
sv_setiv( ST(0), (IV)RETVAL);
@@ -97,9 +147,9 @@ dl_install_xsub(perl_name, symref, filename="$Package")
void * symref
char * filename
CODE:
- DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
+ DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n",
perl_name, symref));
- ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(CV*))symref, filename)));
+ ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(CV* _CPERLarg))symref, filename)));
char *
diff --git a/gnu/usr.bin/perl/win32/include/dirent.h b/gnu/usr.bin/perl/win32/include/dirent.h
index 8cc7e11479b..be363ce8044 100644
--- a/gnu/usr.bin/perl/win32/include/dirent.h
+++ b/gnu/usr.bin/perl/win32/include/dirent.h
@@ -38,12 +38,12 @@ typedef struct _dir_struc
struct direct dirstr; // Directory structure to return
} DIR;
-DIR *opendir(char *filename);
-struct direct *readdir(DIR *dirp);
-long telldir(DIR *dirp);
-void seekdir(DIR *dirp,long loc);
-void rewinddir(DIR *dirp);
-int closedir(DIR *dirp);
+DIR * win32_opendir(char *filename);
+struct direct * win32_readdir(DIR *dirp);
+long win32_telldir(DIR *dirp);
+void win32_seekdir(DIR *dirp,long loc);
+void win32_rewinddir(DIR *dirp);
+int win32_closedir(DIR *dirp);
#endif //_INC_DIRENT
diff --git a/gnu/usr.bin/perl/win32/include/sys/socket.h b/gnu/usr.bin/perl/win32/include/sys/socket.h
index 9e5259b254f..6ffb0ac269e 100644
--- a/gnu/usr.bin/perl/win32/include/sys/socket.h
+++ b/gnu/usr.bin/perl/win32/include/sys/socket.h
@@ -11,6 +11,13 @@ extern "C" {
#endif
#ifndef _WINDOWS_
+#ifdef __GNUC__
+#define WIN32_LEAN_AND_MEAN
+#ifdef __GNUC__
+#define Win32_Winsock
+#endif
+#include <windows.h>
+#else
#define _WINDOWS_
#define FAR
@@ -38,12 +45,50 @@ typedef struct _OVERLAPPED {
HANDLE hEvent;
} OVERLAPPED, *LPOVERLAPPED;
+#endif
#endif //_WINDOWS_
+#ifndef __GNUC__
#include <winsock.h>
+#endif
#define ENOTSOCK WSAENOTSOCK
#undef HOST_NOT_FOUND
+#ifdef USE_SOCKETS_AS_HANDLES
+
+#ifndef PERL_FD_SETSIZE
+#define PERL_FD_SETSIZE 64
+#endif
+
+#define PERL_BITS_PER_BYTE 8
+#define PERL_NFDBITS (sizeof(Perl_fd_mask)*PERL_BITS_PER_BYTE)
+
+typedef int Perl_fd_mask;
+
+typedef struct Perl_fd_set {
+ Perl_fd_mask bits[(PERL_FD_SETSIZE+PERL_NFDBITS-1)/PERL_NFDBITS];
+} Perl_fd_set;
+
+#define PERL_FD_CLR(n,p) \
+ ((p)->bits[(n)/PERL_NFDBITS] &= ~((unsigned)1 << ((n)%PERL_NFDBITS)))
+
+#define PERL_FD_SET(n,p) \
+ ((p)->bits[(n)/PERL_NFDBITS] |= ((unsigned)1 << ((n)%PERL_NFDBITS)))
+
+#define PERL_FD_ZERO(p) memset((char *)(p),0,sizeof(*(p)))
+
+#define PERL_FD_ISSET(n,p) \
+ ((p)->bits[(n)/PERL_NFDBITS] & ((unsigned)1 << ((n)%PERL_NFDBITS)))
+
+#else /* USE_SOCKETS_AS_HANDLES */
+
+#define Perl_fd_set fd_set
+#define PERL_FD_SET(n,p) FD_SET(n,p)
+#define PERL_FD_CLR(n,p) FD_CLR(n,p)
+#define PERL_FD_ISSET(n,p) FD_ISSET(n,p)
+#define PERL_FD_ZERO(p) FD_ZERO(p)
+
+#endif /* USE_SOCKETS_AS_HANDLES */
SOCKET win32_accept (SOCKET s, struct sockaddr *addr, int *addrlen);
int win32_bind (SOCKET s, const struct sockaddr *addr, int namelen);
@@ -63,7 +108,8 @@ u_short win32_ntohs (u_short netshort);
int win32_recv (SOCKET s, char * buf, int len, int flags);
int win32_recvfrom (SOCKET s, char * buf, int len, int flags,
struct sockaddr *from, int * fromlen);
-int win32_select (int nfds, int *readfds, int *writefds, int *exceptfds, const struct timeval *timeout);
+int win32_select (int nfds, Perl_fd_set *rfds, Perl_fd_set *wfds, Perl_fd_set *xfds,
+ const struct timeval *timeout);
int win32_send (SOCKET s, const char * buf, int len, int flags);
int win32_sendto (SOCKET s, const char * buf, int len, int flags,
const struct sockaddr *to, int tolen);
@@ -95,6 +141,8 @@ void win32_endnetent(void);
void win32_endprotoent(void);
void win32_endservent(void);
+#ifndef WIN32SCK_IS_STDSCK
+#ifndef PERL_OBJECT
//
// direct to our version
//
@@ -115,6 +163,7 @@ void win32_endservent(void);
#define recv win32_recv
#define recvfrom win32_recvfrom
#define shutdown win32_shutdown
+#define closesocket win32_closesocket
#define ioctlsocket win32_ioctlsocket
#define setsockopt win32_setsockopt
#define getsockopt win32_getsockopt
@@ -142,6 +191,22 @@ void win32_endservent(void);
#define setprotoent win32_setprotoent
#define setservent win32_setservent
+#ifdef USE_SOCKETS_AS_HANDLES
+#undef fd_set
+#undef FD_SET
+#undef FD_CLR
+#undef FD_ISSET
+#undef FD_ZERO
+#define fd_set Perl_fd_set
+#define FD_SET(n,p) PERL_FD_SET(n,p)
+#define FD_CLR(n,p) PERL_FD_CLR(n,p)
+#define FD_ISSET(n,p) PERL_FD_ISSET(n,p)
+#define FD_ZERO(p) PERL_FD_ZERO(p)
+#endif /* USE_SOCKETS_AS_HANDLES */
+
+#endif /* PERL_OBJECT */
+#endif /* WIN32SCK_IS_STDSCK */
+
#ifdef __cplusplus
}
#endif
diff --git a/gnu/usr.bin/perl/win32/makedef.pl b/gnu/usr.bin/perl/win32/makedef.pl
index b4883ccb593..a637ca1d46c 100644
--- a/gnu/usr.bin/perl/win32/makedef.pl
+++ b/gnu/usr.bin/perl/win32/makedef.pl
@@ -14,29 +14,90 @@
# that does not present in the WIN32 port but there is no easy
# way to find them so I just put a exception list here
-my $CCTYPE = shift || "MSVC";
+my $CCTYPE = "MSVC"; # default
-$skip_sym=<<'!END!OF!SKIP!';
-Perl_SvIV
-Perl_SvNV
-Perl_SvTRUE
-Perl_SvUV
+while (@ARGV)
+ {
+ my $flag = shift;
+ $define{$1} = 1 if ($flag =~ /^-D(\w+)$/);
+ $CCTYPE = $1 if ($flag =~ /^CCTYPE=(\w+)$/);
+ }
+
+open(CFG,'config.h') || die "Cannot open config.h:$!";
+while (<CFG>)
+ {
+ $define{$1} = 1 if /^\s*#\s*define\s+(MYMALLOC)\b/;
+ $define{$1} = 1 if /^\s*#\s*define\s+(USE_THREADS)\b/;
+ }
+close(CFG);
+
+warn join(' ',keys %define)."\n";
+
+if ($define{PERL_OBJECT}) {
+ print "LIBRARY PerlCore\n";
+ print "DESCRIPTION 'Perl interpreter'\n";
+ print "EXPORTS\n";
+ output_symbol("perl_alloc");
+ exit(0);
+}
+
+if ($CCTYPE ne 'GCC')
+ {
+ print "LIBRARY Perl\n";
+ print "DESCRIPTION 'Perl interpreter, export autogenerated'\n";
+ }
+else
+ {
+ $define{'PERL_GLOBAL_STRUCT'} = 1;
+ $define{'MULTIPLICITY'} = 1;
+ }
+
+print "EXPORTS\n";
+
+my %skip;
+my %export;
+
+sub skip_symbols
+{
+ my $list = shift;
+ foreach my $symbol (@$list)
+ {
+ $skip{$symbol} = 1;
+ }
+}
+
+sub emit_symbols
+{
+ my $list = shift;
+ foreach my $symbol (@$list)
+ {
+ emit_symbol($symbol) unless exists $skip{$symbol};
+ }
+}
+
+skip_symbols [qw(
+PL_statusvalue_vms
+PL_archpat_auto
+PL_cryptseen
+PL_DBcv
+PL_generation
+PL_in_clean_all
+PL_in_clean_objs
+PL_lastgotoprobe
+PL_linestart
+PL_modcount
+PL_pending_ident
+PL_sortcxix
+PL_sublex_info
+PL_timesbuf
Perl_block_type
-Perl_sv_pvn
Perl_additem
Perl_cast_ulong
Perl_check_uni
Perl_checkcomma
Perl_chsize
Perl_ck_aelem
-Perl_cryptseen
Perl_cx_dump
-Perl_deb
-Perl_deb_growlevel
-Perl_debop
-Perl_debprofdump
-Perl_debstack
-Perl_debstackptrs
Perl_do_ipcctl
Perl_do_ipcget
Perl_do_msgrcv
@@ -63,6 +124,7 @@ Perl_force_next
Perl_force_word
Perl_hv_stashpv
Perl_intuit_more
+Perl_init_thread_intern
Perl_know_next
Perl_modkids
Perl_mstats
@@ -84,13 +146,6 @@ Perl_pp_map
Perl_pp_nswitch
Perl_q
Perl_reall_srchlen
-Perl_regdump
-Perl_regfold
-Perl_regmyendp
-Perl_regmyp_size
-Perl_regmystartp
-Perl_regnarrate
-Perl_regprop
Perl_same_dirent
Perl_saw_return
Perl_scan_const
@@ -106,16 +161,14 @@ Perl_scan_trans
Perl_scan_word
Perl_setenv_getix
Perl_skipspace
+Perl_sort_mutex
Perl_sublex_done
Perl_sublex_start
-Perl_sv_peek
Perl_sv_ref
Perl_sv_setptrobj
-Perl_timesbuf
Perl_too_few_arguments
Perl_too_many_arguments
Perl_unlnk
-Perl_wait4pid
Perl_watch
Perl_yyname
Perl_yyrule
@@ -127,36 +180,144 @@ mystack_mark
perl_init_ext
perl_requirepv
stack
-statusvalue_vms
Perl_safexcalloc
Perl_safexmalloc
Perl_safexfree
Perl_safexrealloc
Perl_my_memcmp
Perl_my_memset
-Perl_cshlen
-Perl_cshname
-!END!OF!SKIP!
+PL_cshlen
+PL_cshname
+PL_opsave
+)];
-# All symbols have a Perl_ prefix because that's what embed.h
-# sticks in front of them.
+if ($define{'MYMALLOC'})
+ {
+ skip_symbols [qw(
+ Perl_safefree
+ Perl_safemalloc
+ Perl_saferealloc
+ Perl_safecalloc)];
+ emit_symbols [qw(
+ Perl_malloc
+ Perl_free
+ Perl_realloc
+ Perl_calloc)];
+ }
+else
+ {
+ skip_symbols [qw(
+ Perl_malloced_size)];
+ }
-print "LIBRARY Perl\n";
-print "DESCRIPTION 'Perl interpreter, export autogenerated'\n";
-print "CODE LOADONCALL\n";
-print "DATA LOADONCALL NONSHARED MULTIPLE\n";
-print "EXPORTS\n";
+unless ($define{'USE_THREADS'})
+ {
+ skip_symbols [qw(
+PL_thr_key
+PL_sv_mutex
+PL_cred_mutex
+PL_strtab_mutex
+PL_svref_mutex
+PL_malloc_mutex
+PL_eval_mutex
+PL_eval_cond
+PL_eval_owner
+PL_threads_mutex
+PL_nthreads
+PL_nthreads_cond
+PL_threadnum
+PL_threadsv_names
+PL_thrsv
+Perl_vtbl_mutex
+Perl_getTHR
+Perl_setTHR
+Perl_condpair_magic
+Perl_new_struct_thread
+Perl_per_thread_magicals
+Perl_thread_create
+Perl_find_threadsv
+Perl_unlock_condpair
+Perl_magic_mutexfree
+Perl_sv_iv
+Perl_sv_nv
+Perl_sv_true
+Perl_sv_uv
+Perl_sv_pvn
+)];
+ }
-open (GLOBAL, "<../global.sym") || die "failed to open global.sym" . $!;
-while (<GLOBAL>) {
- my $symbol;
- next if (!/^[A-Za-z]/);
- next if (/_amg[ \t]*$/);
- $symbol = "Perl_$_";
- next if ($skip_sym =~ m/$symbol/m);
- emit_symbol($symbol);
+unless ($define{'FAKE_THREADS'})
+ {
+ skip_symbols [qw(PL_curthr)];
+ }
+
+sub readvar
+{
+ my $file = shift;
+ open(VARS,$file) || die "Cannot open $file:$!";
+ my @syms;
+ while (<VARS>)
+ {
+ # All symbols have a Perl_ prefix because that's what embed.h
+ # sticks in front of them.
+ push(@syms,"PL_".$1) if (/\bPERLVARI?C?\([IGT](\w+)/);
+ }
+ close(VARS);
+ return \@syms;
}
+
+if ($define{'USE_THREADS'} || $define{'MULTIPLICITY'})
+ {
+ my $thrd = readvar("../thrdvar.h");
+ skip_symbols $thrd;
+ }
+
+if ($define{'MULTIPLICITY'})
+ {
+ my $interp = readvar("../intrpvar.h");
+ skip_symbols $interp;
+ }
+
+if ($define{'PERL_GLOBAL_STRUCT'})
+ {
+ my $global = readvar("../perlvars.h");
+ skip_symbols $global;
+ emit_symbols [qw(Perl_GetVars)];
+ emit_symbols [qw(PL_Vars PL_VarsPtr)] unless $CCTYPE eq 'GCC';
+ }
+
+unless ($define{'DEBUGGING'})
+ {
+ skip_symbols [qw(
+ Perl_deb
+ Perl_deb_growlevel
+ Perl_debop
+ Perl_debprofdump
+ Perl_debstack
+ Perl_debstackptrs
+ Perl_runops_debug
+ Perl_sv_peek
+ Perl_watchaddr
+ Perl_watchok)];
+ }
+
+if ($define{'HAVE_DES_FCRYPT'})
+ {
+ emit_symbols [qw(win32_crypt)];
+ }
+
+open (GLOBAL, "<../global.sym") || die "failed to open global.sym" . $!;
+while (<GLOBAL>)
+ {
+ next if (!/^[A-Za-z]/);
+ next if (/_amg[ \t]*$/);
+ # All symbols have a Perl_ prefix because that's what embed.h
+ # sticks in front of them.
+ chomp($_);
+ my $symbol = "Perl_$_";
+ emit_symbol($symbol) unless exists $skip{$symbol};
+ }
close(GLOBAL);
# also add symbols from interp.sym
@@ -164,45 +325,67 @@ close(GLOBAL);
# doesn't hurt to include them anyway.
# these don't have Perl prefix
-open (INTERP, "<../interp.sym") || die "failed to open interp.sym" . $!;
-while (<INTERP>) {
- my $symbol;
- next if (!/^[A-Za-z]/);
- next if (/_amg[ \t]*$/);
- $symbol = $_;
- next if ($skip_sym =~ m/$symbol/m);
- #print "\t$symbol";
- emit_symbol("Perl_" . $symbol);
-}
+unless ($define{'PERL_GLOBAL_STRUCT'})
+ {
+ my $glob = readvar("../perlvars.h");
+ emit_symbols $glob;
+ }
+
+unless ($define{'MULTIPLICITY'})
+ {
+ my $glob = readvar("../intrpvar.h");
+ emit_symbols $glob;
+ }
-#close(INTERP);
+unless ($define{'MULTIPLICITY'} || $define{'USE_THREADS'})
+ {
+ my $glob = readvar("../thrdvar.h");
+ emit_symbols $glob;
+ }
while (<DATA>) {
my $symbol;
next if (!/^[A-Za-z]/);
next if (/^#/);
+ s/\r//g;
+ chomp($_);
$symbol = $_;
- next if ($skip_sym =~ m/^$symbol/m);
+ next if exists $skip{$symbol};
emit_symbol($symbol);
}
+foreach my $symbol (sort keys %export)
+ {
+ output_symbol($symbol);
+ }
+
sub emit_symbol {
my $symbol = shift;
- chomp $symbol;
- if ($CCTYPE eq "BORLAND") {
- # workaround Borland quirk by exporting both the straight
- # name and a name with leading underscore. Note the
- # alias *must* come after the symbol itself, if both
- # are to be exported. (Linker bug?)
- print "\t_$symbol\n";
- print "\t$symbol = _$symbol\n";
- }
- else {
- # for binary coexistence, export both the symbol and
- # alias with leading underscore
- print "\t$symbol\n";
- print "\t_$symbol = $symbol\n";
- }
+ chomp($symbol);
+ $export{$symbol} = 1;
+}
+
+sub output_symbol {
+ my $symbol = shift;
+ if ($CCTYPE eq "BORLAND") {
+ # workaround Borland quirk by exporting both the straight
+ # name and a name with leading underscore. Note the
+ # alias *must* come after the symbol itself, if both
+ # are to be exported. (Linker bug?)
+ print "\t_$symbol\n";
+ print "\t$symbol = _$symbol\n";
+ }
+ elsif ($CCTYPE eq 'GCC') {
+ # Symbols have leading _ whole process is $%£"% slow
+ # so skip aliases for now
+ print "\t$symbol\n";
+ }
+ else {
+ # for binary coexistence, export both the symbol and
+ # alias with leading underscore
+ print "\t$symbol\n";
+ print "\t_$symbol = $symbol\n";
+ }
}
1;
@@ -211,6 +394,7 @@ __DATA__
perl_init_i18nl10n
perl_init_ext
perl_alloc
+perl_atexit
perl_construct
perl_destruct
perl_free
@@ -227,7 +411,13 @@ perl_call_sv
perl_require_pv
perl_eval_pv
perl_eval_sv
+perl_new_ctype
+perl_new_collate
+perl_new_numeric
+perl_set_numeric_standard
+perl_set_numeric_local
boot_DynaLoader
+Perl_thread_create
win32_errno
win32_environ
win32_stdin
@@ -265,6 +455,7 @@ win32_stat
win32_pipe
win32_popen
win32_pclose
+win32_rename
win32_setmode
win32_lseek
win32_tell
@@ -280,6 +471,7 @@ win32_mkdir
win32_rmdir
win32_chdir
win32_flock
+win32_execv
win32_execvp
win32_htons
win32_ntohs
@@ -297,6 +489,7 @@ win32_sendto
win32_recv
win32_recvfrom
win32_shutdown
+win32_closesocket
win32_ioctlsocket
win32_setsockopt
win32_getsockopt
@@ -324,6 +517,7 @@ win32_setnetent
win32_setprotoent
win32_setservent
win32_getenv
+win32_putenv
win32_perror
win32_setbuf
win32_setvbuf
@@ -340,8 +534,26 @@ win32_malloc
win32_calloc
win32_realloc
win32_free
-win32stdio
+win32_sleep
+win32_times
+win32_alarm
+win32_open_osfhandle
+win32_get_osfhandle
+win32_ioctl
+win32_utime
+win32_wait
+win32_waitpid
+win32_kill
+win32_str_os_error
+win32_opendir
+win32_readdir
+win32_telldir
+win32_seekdir
+win32_rewinddir
+win32_closedir
Perl_win32_init
+Perl_init_os_extras
+Perl_getTHR
+Perl_setTHR
RunPerl
-SetIOSubSystem
-GetIOSubSystem
+
diff --git a/gnu/usr.bin/perl/win32/makefile.mk b/gnu/usr.bin/perl/win32/makefile.mk
index dbac98f7ffd..0c613d38cea 100644
--- a/gnu/usr.bin/perl/win32/makefile.mk
+++ b/gnu/usr.bin/perl/win32/makefile.mk
@@ -1,607 +1,1121 @@
-#
-# Makefile to build perl on Windowns NT using Microsoft NMAKE.
-#
-#
-# This is set up to build a perl.exe that runs off a shared library
-# (perl.dll). Also makes individual DLLs for the XS extensions.
-#
-
-#
-# Set these to wherever you want "nmake install" to put your
-# newly built perl.
-INST_DRV=c:
-INST_TOP=$(INST_DRV)\perl
-
-#
-# uncomment one if you are using Visual C++ 2.x or Borland
-# comment out both if you are using Visual C++ 4.x and above
-#CCTYPE=MSVC20
-CCTYPE=BORLAND
-
-#
-# uncomment next line if you want debug version of perl (big,slow)
-#CFG=Debug
-
-#
-# set the install locations of the compiler include/libraries
-#CCHOME = f:\msdev\vc
-CCHOME = D:\bc5
-CCINCDIR = $(CCHOME)\include
-CCLIBDIR = $(CCHOME)\lib
-
-#
-# set this to point to cmd.exe (only needed if you use some
-# alternate shell that doesn't grok cmd.exe style commands)
-SHELL = g:\winnt\system32\cmd.exe
-
-#
-# set this to your email address (perl will guess a value from
-# from your loginname and your hostname, which may not be right)
-#EMAIL =
-
-##################### CHANGE THESE ONLY IF YOU MUST #####################
-
-#
-# Programs to compile, build .lib files and link
-#
-
-.USESHELL :
-
-.IF "$(CCTYPE)" == "BORLAND"
-
-CC = bcc32
-LINK32 = tlink32
-LIB32 = tlib
-IMPLIB = implib
-
-#
-# Options
-#
-RUNTIME = -D_RTLDLL
-INCLUDES = -I.\include -I. -I.. -I$(CCINCDIR)
-#PCHFLAGS = -H -H$(INTDIR)\bcmoduls.pch
-DEFINES = -DWIN32 -DPERLDLL
-SUBSYS = console
-LIBC = cw32mti.lib
-LIBFILES = import32.lib $(LIBC) odbc32.lib odbccp32.lib
-
-WINIOMAYBE =
-
-.IF "$(CFG)" == "Debug"
-OPTIMIZE = -v $(RUNTIME)
-LINK_DBG = -v
-.ELSE
-OPTIMIZE = -O $(RUNTIME)
-LINK_DBG =
-.ENDIF
-
-CFLAGS = -w -tWM -tWD $(INCLUDES) $(DEFINES) $(PCHFLAGS) $(OPTIMIZE)
-LINK_FLAGS = $(LINK_DBG) -L$(CCLIBDIR)
-OBJOUT_FLAG = -o
-
-.ELSE
-
-CC=cl.exe
-LINK32=link.exe
-LIB32=$(LINK32) -lib
-#
-# Options
-#
-.IF "$(RUNTIME)" == ""
-RUNTIME = -MD
-.ENDIF
-INCLUDES = -I.\include -I. -I..
-#PCHFLAGS = -Fp$(INTDIR)\vcmoduls.pch -YX
-DEFINES = -DWIN32 -D_CONSOLE -DPERLDLL
-SUBSYS = console
-
-.IF "$(RUNTIME)" == "-MD"
-LIBC = msvcrt.lib
-WINIOMAYBE =
-.ELSE
-LIBC = libcmt.lib
-WINIOMAYBE = win32io.obj
-.ENDIF
-
-.IF "$(CFG)" == "Debug"
-.IF "$(CCTYPE)" == "MSVC20"
-OPTIMIZE = -Od $(RUNTIME) -Z7 -D_DEBUG
-.ELSE
-OPTIMIZE = -Od $(RUNTIME)d -Z7 -D_DEBUG
-.ENDIF
-LINK_DBG = -debug -pdb:none
-.ELSE
-.IF "$(CCTYPE)" == "MSVC20"
-OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
-.ELSE
-OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
-.ENDIF
-LINK_DBG = -release
-.ENDIF
-
-# we don't add LIBC here, the compiler do it based on -MD/-MT
-LIBFILES = oldnames.lib kernel32.lib user32.lib gdi32.lib \
- winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \
- oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \
- version.lib odbc32.lib odbccp32.lib
-
-CFLAGS = -nologo -W3 $(INCLUDES) $(DEFINES) $(PCHFLAGS) $(OPTIMIZE)
-LINK_FLAGS = -nologo $(LIBFILES) $(LINK_DBG) -machine:I386
-OBJOUT_FLAG = -Fo
-
-.ENDIF
-
-#################### do not edit below this line #######################
-############# NO USER-SERVICEABLE PARTS BEYOND THIS POINT ##############
-
-#
-# Rules
-#
-.SUFFIXES :
-.SUFFIXES : .c .obj .dll .lib .exe
-
-.c.obj:
- $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ $<
-
-.IF "$(CCTYPE)" == "BORLAND"
-
-.obj.dll:
- $(LINK32) -Tpd -ap $(LINK_FLAGS) c0d32.obj $<,$@,,$(LIBFILES),$(*B).def
- $(IMPLIB) $(*B).lib $@
-.ELSE
-
-.obj.dll:
- $(LINK32) -dll -subsystem:windows -implib:$(*B).lib -def:$(*B).def \
- -out:$@ $(LINK_FLAGS) $< $(LIBPERL)
-
-.ENDIF
-
-#
-INST_BIN=$(INST_TOP)\bin
-INST_LIB=$(INST_TOP)\lib
-INST_POD=$(INST_LIB)\pod
-INST_HTML=$(INST_POD)\html
-LIBDIR=..\lib
-EXTDIR=..\ext
-PODDIR=..\pod
-EXTUTILSDIR=$(LIBDIR)\extutils
-
-#
-# various targets
-PERLIMPLIB=..\perl.lib
-MINIPERL=..\miniperl.exe
-PERLDLL=..\perl.dll
-PERLEXE=..\perl.exe
-GLOBEXE=..\perlglob.exe
-CONFIGPM=..\lib\Config.pm
-MINIMOD=..\lib\ExtUtils\Miniperl.pm
-
-PL2BAT=bin\pl2bat.pl
-GLOBBAT = bin\perlglob.bat
-
-.IF "$(CCTYPE)" == "BORLAND"
-
-# Borland wildargs is incompatible with MS setargv
-CFGSH_TMPL = config.bc
-CFGH_TMPL = config_H.bc
-# Borland's perl.exe will work on W95, so we don't make this
-
-.ELSE
-
-MAKE = nmake -nologo
-CFGSH_TMPL = config.vc
-CFGH_TMPL = config_H.vc
-PERL95EXE=..\perl95.exe
-
-.ENDIF
-
-XCOPY=xcopy /f /r /i /d
-RCOPY=xcopy /f /r /i /e /d
-#NULL=
-
-#
-# filenames given to xsubpp must have forward slashes (since it puts
-# full pathnames in #line strings)
-XSUBPP=..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp -C++ -prototypes
-
-CORE_C= ..\av.c \
- ..\deb.c \
- ..\doio.c \
- ..\doop.c \
- ..\dump.c \
- ..\globals.c \
- ..\gv.c \
- ..\hv.c \
- ..\mg.c \
- ..\op.c \
- ..\perl.c \
- ..\perlio.c \
- ..\perly.c \
- ..\pp.c \
- ..\pp_ctl.c \
- ..\pp_hot.c \
- ..\pp_sys.c \
- ..\regcomp.c \
- ..\regexec.c \
- ..\run.c \
- ..\scope.c \
- ..\sv.c \
- ..\taint.c \
- ..\toke.c \
- ..\universal.c \
- ..\util.c
-
-CORE_OBJ= ..\av.obj \
- ..\deb.obj \
- ..\doio.obj \
- ..\doop.obj \
- ..\dump.obj \
- ..\globals.obj \
- ..\gv.obj \
- ..\hv.obj \
- ..\mg.obj \
- ..\op.obj \
- ..\perl.obj \
- ..\perlio.obj \
- ..\perly.obj \
- ..\pp.obj \
- ..\pp_ctl.obj \
- ..\pp_hot.obj \
- ..\pp_sys.obj \
- ..\regcomp.obj \
- ..\regexec.obj \
- ..\run.obj \
- ..\scope.obj \
- ..\sv.obj \
- ..\taint.obj \
- ..\toke.obj \
- ..\universal.obj\
- ..\util.obj
-
-WIN32_C = perllib.c \
- win32.c \
- win32io.c \
- win32sck.c
-
-WIN32_OBJ = win32.obj \
- win32io.obj \
- win32sck.obj
-
-PERL95_OBJ = perl95.obj \
- win32mt.obj \
- win32iomt.obj \
- win32sckmt.obj
-
-DLL_OBJ = perllib.obj $(DYNALOADER).obj
-
-CORE_H = ..\av.h \
- ..\cop.h \
- ..\cv.h \
- ..\dosish.h \
- ..\embed.h \
- ..\form.h \
- ..\gv.h \
- ..\handy.h \
- ..\hv.h \
- ..\mg.h \
- ..\nostdio.h \
- ..\op.h \
- ..\opcode.h \
- ..\perl.h \
- ..\perlio.h \
- ..\perlsdio.h \
- ..\perlsfio.h \
- ..\perly.h \
- ..\pp.h \
- ..\proto.h \
- ..\regexp.h \
- ..\scope.h \
- ..\sv.h \
- ..\unixish.h \
- ..\util.h \
- ..\XSUB.h \
- .\config.h \
- ..\EXTERN.h \
- .\include\dirent.h \
- .\include\netdb.h \
- .\include\sys\socket.h \
- .\win32.h
-
-
-EXTENSIONS=DynaLoader Socket IO Fcntl Opcode SDBM_File
-
-DYNALOADER=$(EXTDIR)\DynaLoader\DynaLoader
-SOCKET=$(EXTDIR)\Socket\Socket
-FCNTL=$(EXTDIR)\Fcntl\Fcntl
-OPCODE=$(EXTDIR)\Opcode\Opcode
-SDBM_FILE=$(EXTDIR)\SDBM_File\SDBM_File
-IO=$(EXTDIR)\IO\IO
-
-SOCKET_DLL=..\lib\auto\Socket\Socket.dll
-FCNTL_DLL=..\lib\auto\Fcntl\Fcntl.dll
-OPCODE_DLL=..\lib\auto\Opcode\Opcode.dll
-SDBM_FILE_DLL=..\lib\auto\SDBM_File\SDBM_File.dll
-IO_DLL=..\lib\auto\IO\IO.dll
-
-STATICLINKMODULES=DynaLoader
-DYNALOADMODULES= \
- $(SOCKET_DLL) \
- $(FCNTL_DLL) \
- $(OPCODE_DLL) \
- $(SDBM_FILE_DLL)\
- $(IO_DLL)
-
-POD2HTML=$(PODDIR)\pod2html
-POD2MAN=$(PODDIR)\pod2man
-POD2LATEX=$(PODDIR)\pod2latex
-POD2TEXT=$(PODDIR)\pod2text
-
-#
-# Top targets
-#
-
-all: $(PERLEXE) $(PERL95EXE) $(GLOBEXE) $(DYNALOADMODULES) $(MINIMOD) $(GLOBBAT)
-
-$(DYNALOADER).obj : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c
-
-#------------------------------------------------------------
-
-$(GLOBEXE): perlglob.obj
-.IF "$(CCTYPE)" == "BORLAND"
- $(CC) -c -w -v -tWM -I$(CCINCDIR) perlglob.c
- $(LINK32) -Tpe -ap $(LINK_FLAGS) c0x32.obj perlglob.obj \
- $(CCLIBDIR)\32BIT\wildargs.obj,$@,,import32.lib cw32mt.lib,
-.ELSE
- $(LINK32) $(LINK_FLAGS) -out:$@ -subsystem:$(SUBSYS) perlglob.obj setargv.obj
-.ENDIF
-
-$(GLOBBAT) : ..\lib\File\DosGlob.pm $(MINIPERL)
- $(MINIPERL) $(PL2BAT) - < ..\lib\File\DosGlob.pm > $(GLOBBAT)
-
-perlglob.obj : perlglob.c
-
-..\miniperlmain.obj : ..\miniperlmain.c $(CORE_H)
-
-config.w32 : $(CFGSH_TMPL)
- copy $(CFGSH_TMPL) config.w32
-
-.\config.h : $(CFGSH_TMPL)
- -del /f config.h
- copy $(CFGH_TMPL) config.h
-
-..\config.sh : config.w32 $(MINIPERL) config_sh.PL
- $(MINIPERL) -I..\lib config_sh.PL "INST_DRV=$(INST_DRV)" \
- "INST_TOP=$(INST_TOP)" "cc=$(CC)" "ccflags=$(RUNTIME) -DWIN32" \
- "cf_email=$(EMAIL)" "libs=$(LIBFILES:f)" "incpath=$(CCINCDIR)" \
- "libpth=$(strip $(CCLIBDIR) $(LIBFILES:d))" "libc=$(LIBC)" \
- config.w32 > ..\config.sh
-
-$(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl
- cd .. && miniperl configpm
- if exist lib\* $(RCOPY) lib\*.* ..\lib\$(NULL)
- $(XCOPY) ..\*.h ..\lib\CORE\*.*
- $(XCOPY) *.h ..\lib\CORE\*.*
- $(RCOPY) include ..\lib\CORE\*.*
- $(MINIPERL) -I..\lib config_h.PL || $(MAKE) CCTYPE=$(CCTYPE) \
- RUNTIME=$(RUNTIME) CFG=$(CFG) $(CONFIGPM)
-
-$(MINIPERL) : ..\miniperlmain.obj $(CORE_OBJ) $(WIN32_OBJ)
-.IF "$(CCTYPE)" == "BORLAND"
- $(LINK32) -Tpe -ap $(LINK_FLAGS) \
- @$(mktmp c0x32.obj ..\miniperlmain.obj \
- $(CORE_OBJ:s,\,\\) $(WIN32_OBJ:s,\,\\),$@,,$(LIBFILES),)
-.ELSE
- $(LINK32) -subsystem:console -out:$@ \
- @$(mktmp $(LINK_FLAGS) ..\miniperlmain.obj \
- $(CORE_OBJ:s,\,\\) $(WIN32_OBJ:s,\,\\))
-.ENDIF
-
-$(WIN32_OBJ) : $(CORE_H)
-$(CORE_OBJ) : $(CORE_H)
-$(DLL_OBJ) : $(CORE_H)
-
-perldll.def : $(MINIPERL) $(CONFIGPM)
- $(MINIPERL) -w makedef.pl $(CCTYPE) > perldll.def
-
-$(PERLDLL): perldll.def $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ)
-.IF "$(CCTYPE)" == "BORLAND"
- $(LINK32) -Tpd -ap $(LINK_FLAGS) \
- @$(mktmp c0d32.obj $(CORE_OBJ:s,\,\\) \
- $(WIN32_OBJ:s,\,\\) $(DLL_OBJ:s,\,\\)\n \
- $@,\n \
- $(LIBFILES)\n \
- perldll.def\n)
- $(IMPLIB) $*.lib $@
-.ELSE
- $(LINK32) -dll -def:perldll.def -out:$@ \
- @$(mktmp $(LINK_FLAGS) $(CORE_OBJ:s,\,\\) \
- $(WIN32_OBJ:s,\,\\) $(DLL_OBJ:s,\,\\))
-.ENDIF
- $(XCOPY) $(PERLIMPLIB) ..\lib\CORE
-
-perl.def : $(MINIPERL) makeperldef.pl
- $(MINIPERL) -I..\lib makeperldef.pl $(NULL) > perl.def
-
-$(MINIMOD) : $(MINIPERL) ..\minimod.pl
- cd .. && miniperl minimod.pl > lib\ExtUtils\Miniperl.pm
-
-perlmain.c : runperl.c
- copy runperl.c perlmain.c
-
-perlmain.obj : perlmain.c
- $(CC) $(CFLAGS) -UPERLDLL -c perlmain.c
-
-
-$(PERLEXE): $(PERLDLL) $(CONFIGPM) perlmain.obj
-.IF "$(CCTYPE)" == "BORLAND"
- $(LINK32) -Tpe -ap $(LINK_FLAGS) \
- @$(mktmp c0x32.obj perlmain.obj $(WINIOMAYBE)\n \
- $@,\n \
- $(PERLIMPLIB) $(LIBFILES)\n)
-.ELSE
- $(LINK32) -subsystem:console -out:perl.exe $(LINK_FLAGS) \
- perlmain.obj $(WINIOMAYBE) $(PERLIMPLIB)
- copy perl.exe $@
- del perl.exe
-.ENDIF
- copy splittree.pl ..
- $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto"
- attrib -r ..\t\*.*
- copy test ..\t
-
-.IF "$(CCTYPE)" != "BORLAND"
-
-perl95.c : runperl.c
- copy runperl.c perl95.c
-
-perl95.obj : perl95.c
- $(CC) $(CFLAGS) -MT -UPERLDLL -c perl95.c
-
-win32iomt.obj : win32io.c
- $(CC) $(CFLAGS) -MT -c $(OBJOUT_FLAG)win32iomt.obj win32io.c
-
-win32sckmt.obj : win32sck.c
- $(CC) $(CFLAGS) -MT -c $(OBJOUT_FLAG)win32sckmt.obj win32sck.c
-
-win32mt.obj : win32.c
- $(CC) $(CFLAGS) -MT -c $(OBJOUT_FLAG)win32mt.obj win32.c
-
-$(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ)
- $(LINK32) -subsystem:console -out:perl95.exe $(LINK_FLAGS) \
- $(PERL95_OBJ) $(PERLIMPLIB)
- copy perl95.exe $@
- del perl95.exe
-
-.ENDIF
-
-$(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM)
- if not exist ..\lib\auto mkdir ..\lib\auto
- $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL)
- cd $(EXTDIR)\$(*B) && $(XSUBPP) dl_win32.xs > $(*B).c
- $(XCOPY) $(EXTDIR)\$(*B)\dlutils.c .
-
-$(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs
- copy dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs
-
-$(IO_DLL): $(PERLEXE) $(CONFIGPM) $(IO).xs
- cd $(EXTDIR)\$(*B) && \
- ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
- cd $(EXTDIR)\$(*B) && $(MAKE)
-
-$(SDBM_FILE_DLL) : $(PERLEXE) $(SDBM_FILE).xs
- cd $(EXTDIR)\$(*B) && \
- ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
- cd $(EXTDIR)\$(*B) && $(MAKE)
-
-$(FCNTL_DLL): $(PERLEXE) $(FCNTL).xs
- cd $(EXTDIR)\$(*B) && \
- ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
- cd $(EXTDIR)\$(*B) && $(MAKE)
-
-$(OPCODE_DLL): $(PERLEXE) $(OPCODE).xs
- cd $(EXTDIR)\$(*B) && \
- ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
- cd $(EXTDIR)\$(*B) && $(MAKE)
-
-$(SOCKET_DLL): $(SOCKET).xs $(PERLEXE)
- cd $(EXTDIR)\$(*B) && \
- ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
- cd $(EXTDIR)\$(*B) && $(MAKE)
-
-doc: $(PERLEXE)
- cd ..\pod && $(MAKE) -f ..\win32\pod.mak checkpods \
- pod2html pod2latex pod2man pod2text
- cd ..\pod && $(XCOPY) *.bat ..\win32\bin\*.*
- copy ..\README.win32 ..\pod\perlwin32.pod
- $(PERLEXE) ..\installhtml --podroot=.. --htmldir=./html \
- --podpath=pod:lib:ext:utils --htmlroot="//$(INST_HTML:s,:,|,)" \
- --libpod=perlfunc:perlguts:perlvar:perlrun:perlop --recurse
-
-utils: $(PERLEXE)
- cd ..\utils && $(MAKE) PERL=$(MINIPERL)
- cd ..\utils && $(PERLEXE) ..\win32\$(PL2BAT) h2ph splain perlbug \
- pl2pm c2ph h2xs perldoc pstruct
- $(XCOPY) ..\utils\*.bat bin\*.*
- $(PERLEXE) $(PL2BAT) bin\network.pl bin\www.pl bin\runperl.pl \
- bin\pl2bat.pl
-
-distclean: clean
- -del /f $(MINIPERL) $(PERLEXE) $(PERLDLL) $(GLOBEXE) \
- $(PERLIMPLIB) ..\miniperl.lib $(MINIMOD)
- -del /f *.def *.map
- -del /f $(SOCKET_DLL) $(IO_DLL) $(SDBM_FILE_DLL) $(FCNTL_DLL) \
- $(OPCODE_DLL)
- -del /f $(SOCKET).c $(IO).c $(SDBM_FILE).c $(FCNTL).c $(OPCODE).c \
- $(DYNALOADER).c
- -del /f $(PODDIR)\*.html
- -del /f $(PODDIR)\*.bat
- -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new
-.IF "$(PERL95EXE)" != ""
- -del /f perl95.c
-.ENDIF
- -del /f bin\*.bat
- -cd $(EXTDIR) && del /s *.lib *.def *.map *.bs Makefile *.obj pm_to_blib
- -rmdir /s /q ..\lib\auto
- -rmdir /s /q ..\lib\CORE
-
-install : all doc utils
- if not exist $(INST_TOP) mkdir $(INST_TOP)
- echo I $(INST_TOP) L $(LIBDIR)
- $(XCOPY) $(PERLEXE) $(INST_BIN)\*.*
-.IF "$(PERL95EXE)" != ""
- $(XCOPY) $(PERL95EXE) $(INST_BIN)\*.*
-.ENDIF
- $(XCOPY) $(GLOBEXE) $(INST_BIN)\*.*
- $(XCOPY) $(PERLDLL) $(INST_BIN)\*.*
- $(XCOPY) bin\*.bat $(INST_BIN)\*.*
- $(RCOPY) ..\lib $(INST_LIB)\*.*
- $(XCOPY) ..\pod\*.bat $(INST_BIN)\*.*
- $(XCOPY) ..\pod\*.pod $(INST_POD)\*.*
- $(RCOPY) html\*.* $(INST_HTML)\*.*
-
-inst_lib : $(CONFIGPM)
- copy splittree.pl ..
- $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto"
- $(RCOPY) ..\lib $(INST_LIB)\*.*
-
-minitest : $(MINIPERL) $(GLOBEXE) $(CONFIGPM)
- $(XCOPY) $(MINIPERL) ..\t\perl.exe
-.IF "$(CCTYPE)" == "BORLAND"
- $(XCOPY) $(GLOBBAT) ..\t\$(NULL)
-.ELSE
- $(XCOPY) $(GLOBEXE) ..\t\$(NULL)
-.ENDIF
- attrib -r ..\t\*.*
- copy test ..\t
- cd ..\t && \
- $(MINIPERL) -I..\lib test base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t
-
-test : all
- $(XCOPY) $(PERLEXE) ..\t\$(NULL)
- $(XCOPY) $(PERLDLL) ..\t\$(NULL)
-.IF "$(CCTYPE)" == "BORLAND"
- $(XCOPY) $(GLOBBAT) ..\t\$(NULL)
-.ELSE
- $(XCOPY) $(GLOBEXE) ..\t\$(NULL)
-.ENDIF
- cd ..\t && $(PERLEXE) -I..\lib harness
-
-clean :
- -@erase miniperlmain.obj
- -@erase $(MINIPERL)
- -@erase perlglob.obj
- -@erase perlmain.obj
- -@erase config.w32
- -@erase /f config.h
- -@erase $(GLOBEXE)
- -@erase $(PERLEXE)
- -@erase $(PERLDLL)
- -@erase $(CORE_OBJ)
- -@erase $(WIN32_OBJ)
- -@erase $(DLL_OBJ)
- -@erase ..\*.obj ..\*.lib ..\*.exp *.obj *.lib *.exp
- -@erase ..\t\*.exe ..\t\*.dll ..\t\*.bat
- -@erase *.ilk
- -@erase *.pdb
-
-
+#
+# Makefile to build perl on Windows NT using DMAKE.
+# Supported compilers:
+# Visual C++ 2.0 thro 5.0
+# Borland C++ 5.02
+# Mingw32 with gcc-2.8.1 or egcs-1.0.2 **experimental**
+#
+# This is set up to build a perl.exe that runs off a shared library
+# (perl.dll). Also makes individual DLLs for the XS extensions.
+#
+
+##
+## Make sure you read README.win32 *before* you mess with anything here!
+##
+
+##
+## Build configuration. Edit the values below to suit your needs.
+##
+
+#
+# Set these to wherever you want "nmake install" to put your
+# newly built perl.
+#
+INST_DRV *= c:
+INST_TOP *= $(INST_DRV)\perl
+
+#
+# Comment this out if you DON'T want your perl installation to be versioned.
+# This means that the new installation will overwrite any files from the
+# old installation at the same INST_TOP location. Leaving it enabled is
+# the safest route, as perl adds the extra version directory to all the
+# locations it installs files to. If you disable it, an alternative
+# versioned installation can be obtained by setting INST_TOP above to a
+# path that includes an arbitrary version string.
+#
+INST_VER *= \5.00503
+
+#
+# uncomment to enable threads-capabilities
+#
+#USE_THREADS *= define
+
+#
+# uncomment to enable multiple interpreters
+#
+#USE_MULTI *= define
+
+#
+# uncomment one
+#
+#CCTYPE *= MSVC20
+#CCTYPE *= MSVC
+CCTYPE *= BORLAND
+#CCTYPE *= GCC
+
+#
+# uncomment next line if you want to use the perl object
+# Currently, this cannot be enabled if you ask for threads above, or
+# if you are using GCC or EGCS.
+#
+#OBJECT *= -DPERL_OBJECT
+
+#
+# uncomment next line if you want debug version of perl (big,slow)
+#
+#CFG *= Debug
+
+#
+# uncomment next option if you want to use the VC++ compiler optimization.
+# This option is only relevant for the Microsoft compiler; we automatically
+# use maximum optimization with the other compilers (unless you specify a
+# DEBUGGING build).
+# Warning: This is known to produce incorrect code for compiler versions
+# earlier than VC++ 98 (Visual Studio 6.0). VC++ 98 generates code that
+# successfully passes the Perl regression test suite. It hasn't yet been
+# widely tested with real applications though.
+#
+#CFG *= Optimize
+
+#
+# uncomment to enable use of PerlCRT.DLL when using the Visual C compiler.
+# Highly recommended. It has patches that fix known bugs in MSVCRT.DLL.
+# This currently requires VC 5.0 with Service Pack 3.
+# Get it from CPAN at http://www.perl.com/CPAN/authors/id/D/DO/DOUGL/
+# and follow the directions in the package to install.
+#
+#USE_PERLCRT *= define
+
+#
+# uncomment to enable linking with setargv.obj under the Visual C
+# compiler. Setting this options enables perl to expand wildcards in
+# arguments, but it may be harder to use alternate methods like
+# File::DosGlob that are more powerful. This option is supported only with
+# Visual C.
+#
+#USE_SETARGV *= define
+
+#
+# if you have the source for des_fcrypt(), uncomment this and make sure the
+# file exists (see README.win32). File should be located in the same
+# directory as this file.
+#
+#CRYPT_SRC *= fcrypt.c
+
+#
+# if you didn't set CRYPT_SRC and if you have des_fcrypt() available in a
+# library, uncomment this, and make sure the library exists (see README.win32)
+# Specify the full pathname of the library.
+#
+#CRYPT_LIB *= fcrypt.lib
+
+#
+# set this if you wish to use perl's malloc
+# WARNING: Turning this on/off WILL break binary compatibility with extensions
+# you may have compiled with/without it. Be prepared to recompile all
+# extensions if you change the default. Currently, this cannot be enabled
+# if you ask for PERL_OBJECT above.
+#
+#PERL_MALLOC *= define
+
+#
+# set the install locations of the compiler include/libraries
+# Running VCVARS32.BAT is *required* when using Visual C.
+# Some versions of Visual C don't define MSVCDIR in the environment,
+# so you may have to set CCHOME explicitly (spaces in the path name should
+# not be quoted)
+#
+#CCHOME *= f:\msdev\vc
+CCHOME *= C:\bc5
+#CCHOME *= D:\packages\mingw32
+CCINCDIR *= $(CCHOME)\include
+CCLIBDIR *= $(CCHOME)\lib
+
+#
+# specify semicolon-separated list of extra directories that modules will
+# look for libraries (spaces in path names need not be quoted)
+#
+EXTRALIBDIRS *=
+
+#
+# set this to point to cmd.exe (only needed if you use some
+# alternate shell that doesn't grok cmd.exe style commands)
+#
+#SHELL *= g:\winnt\system32\cmd.exe
+
+#
+# set this to your email address (perl will guess a value from
+# from your loginname and your hostname, which may not be right)
+#
+#EMAIL *=
+
+##
+## Build configuration ends.
+##
+
+##################### CHANGE THESE ONLY IF YOU MUST #####################
+
+.IF "$(CRYPT_SRC)$(CRYPT_LIB)" == ""
+D_CRYPT = undef
+.ELSE
+D_CRYPT = define
+CRYPT_FLAG = -DHAVE_DES_FCRYPT
+.ENDIF
+
+.IF "$(OBJECT)" != ""
+PERL_MALLOC != undef
+USE_THREADS != undef
+USE_MULTI != undef
+.ENDIF
+
+PERL_MALLOC *= undef
+
+USE_THREADS *= undef
+USE_MULTI *= undef
+
+#BUILDOPT *= -DPERL_GLOBAL_STRUCT
+# -DUSE_PERLIO -D__STDC__=1 -DUSE_SFIO -DI_SFIO -I\sfio97\include
+
+.IMPORT .IGNORE : PROCESSOR_ARCHITECTURE
+
+PROCESSOR_ARCHITECTURE *= x86
+
+.IF "$(OBJECT)" != ""
+ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-object
+.ELIF "$(USE_THREADS)" == "define"
+ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-thread
+.ELSE
+ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)
+.ENDIF
+
+ARCHDIR = ..\lib\$(ARCHNAME)
+COREDIR = ..\lib\CORE
+AUTODIR = ..\lib\auto
+
+#
+# Programs to compile, build .lib files and link
+#
+
+.USESHELL :
+
+.IF "$(CCTYPE)" == "BORLAND"
+
+CC = bcc32
+LINK32 = tlink32
+LIB32 = tlib /P128
+IMPLIB = implib -c
+
+#
+# Options
+#
+RUNTIME = -D_RTLDLL
+INCLUDES = -I$(COREDIR) -I.\include -I. -I.. -I"$(CCINCDIR)"
+#PCHFLAGS = -H -Hc -H=c:\temp\bcmoduls.pch
+DEFINES = -DWIN32 $(BUILDOPT) $(CRYPT_FLAG)
+LOCDEFS = -DPERLDLL -DPERL_CORE
+SUBSYS = console
+CXX_FLAG = -P
+
+LIBC = cw32mti.lib
+LIBFILES = $(CRYPT_LIB) import32.lib $(LIBC) odbc32.lib odbccp32.lib
+
+.IF "$(CFG)" == "Debug"
+OPTIMIZE = -v $(RUNTIME) -DDEBUGGING
+LINK_DBG = -v
+.ELSE
+OPTIMIZE = -O2 $(RUNTIME)
+LINK_DBG =
+.ENDIF
+
+CFLAGS = -w -g0 -tWM -tWD $(INCLUDES) $(DEFINES) $(LOCDEFS) \
+ $(PCHFLAGS) $(OPTIMIZE)
+LINK_FLAGS = $(LINK_DBG) -L"$(CCLIBDIR)"
+OBJOUT_FLAG = -o
+EXEOUT_FLAG = -e
+LIBOUT_FLAG =
+
+.ELIF "$(CCTYPE)" == "GCC"
+
+CC = gcc
+LINK32 = gcc
+LIB32 = ar rc
+IMPLIB = dlltool
+
+o = .o
+a = .a
+
+#
+# Options
+#
+RUNTIME =
+INCLUDES = -I$(COREDIR) -I.\include -I. -I..
+DEFINES = -DWIN32 $(BUILDOPT) $(CRYPT_FLAG)
+LOCDEFS = -DPERLDLL -DPERL_CORE
+SUBSYS = console
+CXX_FLAG = -xc++
+
+LIBC = -lcrtdll
+LIBFILES = $(CRYPT_LIB) -ladvapi32 -luser32 -lnetapi32 -lwsock32 \
+ -lmingw32 -lgcc -lmoldname $(LIBC) -lkernel32
+
+.IF "$(CFG)" == "Debug"
+OPTIMIZE = -g -O2 $(RUNTIME) -DDEBUGGING
+LINK_DBG = -g
+.ELSE
+OPTIMIZE = -g -O2 $(RUNTIME)
+LINK_DBG =
+.ENDIF
+
+CFLAGS = $(INCLUDES) $(DEFINES) $(LOCDEFS) $(OPTIMIZE)
+LINK_FLAGS = $(LINK_DBG) -L"$(CCLIBDIR)"
+OBJOUT_FLAG = -o
+EXEOUT_FLAG = -o
+LIBOUT_FLAG =
+
+.ELSE
+
+CC = cl.exe
+LINK32 = link.exe
+LIB32 = $(LINK32) -lib
+
+#
+# Options
+#
+
+RUNTIME = -MD
+INCLUDES = -I$(COREDIR) -I.\include -I. -I..
+#PCHFLAGS = -Fpc:\temp\vcmoduls.pch -YX
+DEFINES = -DWIN32 -D_CONSOLE -DNO_STRICT $(BUILDOPT) $(CRYPT_FLAG)
+LOCDEFS = -DPERLDLL -DPERL_CORE
+SUBSYS = console
+CXX_FLAG = -TP -GX
+
+.IF "$(USE_PERLCRT)" == ""
+.IF "$(CFG)" == "Debug"
+PERLCRTLIBC = msvcrtd.lib
+.ELSE
+PERLCRTLIBC = msvcrt.lib
+.ENDIF
+.ELSE
+.IF "$(CFG)" == "Debug"
+PERLCRTLIBC = PerlCRTD.lib
+.ELSE
+PERLCRTLIBC = PerlCRT.lib
+.ENDIF
+.ENDIF
+
+.IF "$(RUNTIME)" == "-MD"
+LIBC = $(PERLCRTLIBC)
+.ELSE
+LIBC = libcmt.lib
+.ENDIF
+
+.IF "$(CFG)" == "Debug"
+.IF "$(CCTYPE)" == "MSVC20"
+OPTIMIZE = -Od $(RUNTIME) -Z7 -D_DEBUG -DDEBUGGING
+.ELSE
+OPTIMIZE = -Od $(RUNTIME)d -Zi -D_DEBUG -DDEBUGGING
+.ENDIF
+LINK_DBG = -debug -pdb:none
+.ELSE
+.IF "$(CFG)" == "Optimize"
+OPTIMIZE = -O2 $(RUNTIME) -DNDEBUG
+.ELSE
+OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
+.ENDIF
+LINK_DBG = -release
+.ENDIF
+
+LIBBASEFILES = $(CRYPT_LIB) oldnames.lib kernel32.lib user32.lib gdi32.lib \
+ winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \
+ oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \
+ version.lib odbc32.lib odbccp32.lib
+
+# we add LIBC here, since we may be using PerlCRT.dll
+LIBFILES = $(LIBBASEFILES) $(LIBC)
+
+CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) \
+ $(PCHFLAGS) $(OPTIMIZE)
+LINK_FLAGS = -nologo -nodefaultlib $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE)
+OBJOUT_FLAG = -Fo
+EXEOUT_FLAG = -Fe
+LIBOUT_FLAG = /out:
+
+.ENDIF
+
+.IF "$(OBJECT)" != ""
+OPTIMIZE += $(CXX_FLAG)
+.ENDIF
+
+CFLAGS_O = $(CFLAGS) $(OBJECT)
+
+#################### do not edit below this line #######################
+############# NO USER-SERVICEABLE PARTS BEYOND THIS POINT ##############
+
+o *= .obj
+a *= .lib
+
+LKPRE = INPUT (
+LKPOST = )
+
+#
+# Rules
+#
+
+.SUFFIXES : .c $(o) .dll $(a) .exe
+
+.c$(o):
+ $(CC) -c $(null,$(<:d) $(NULL) -I$(<:d)) $(CFLAGS_O) $(OBJOUT_FLAG)$@ $<
+
+.y.c:
+ $(NOOP)
+
+$(o).dll:
+.IF "$(CCTYPE)" == "BORLAND"
+ $(LINK32) -Tpd -ap $(LINK_FLAGS) c0d32$(o) $<,$@,,$(LIBFILES),$(*B).def
+ $(IMPLIB) $(*B).lib $@
+.ELIF "$(CCTYPE)" == "GCC"
+ $(LINK32) -o $@ $(LINK_FLAGS) $< $(LIBFILES)
+ $(IMPLIB) -def $(*B).def $(*B).a $@
+.ELSE
+ $(LINK32) -dll -subsystem:windows -implib:$(*B).lib -def:$(*B).def \
+ -out:$@ $(LINK_FLAGS) $(LIBFILES) $< $(LIBPERL)
+.ENDIF
+
+#
+INST_BIN = $(INST_TOP)$(INST_VER)\bin\$(ARCHNAME)
+INST_SCRIPT = $(INST_TOP)$(INST_VER)\bin
+INST_LIB = $(INST_TOP)$(INST_VER)\lib
+INST_POD = $(INST_LIB)\pod
+INST_HTML = $(INST_POD)\html
+LIBDIR = ..\lib
+EXTDIR = ..\ext
+PODDIR = ..\pod
+EXTUTILSDIR = $(LIBDIR)\extutils
+
+#
+# various targets
+MINIPERL = ..\miniperl.exe
+MINIDIR = .\mini
+PERLEXE = ..\perl.exe
+GLOBEXE = ..\perlglob.exe
+CONFIGPM = ..\lib\Config.pm
+MINIMOD = ..\lib\ExtUtils\Miniperl.pm
+X2P = ..\x2p\a2p.exe
+
+PL2BAT = bin\pl2bat.pl
+GLOBBAT = bin\perlglob.bat
+
+UTILS = \
+ ..\utils\h2ph \
+ ..\utils\splain \
+ ..\utils\perlbug \
+ ..\utils\pl2pm \
+ ..\utils\c2ph \
+ ..\utils\h2xs \
+ ..\utils\perldoc \
+ ..\utils\pstruct \
+ ..\utils\perlcc \
+ ..\pod\checkpods \
+ ..\pod\pod2html \
+ ..\pod\pod2latex \
+ ..\pod\pod2man \
+ ..\pod\pod2text \
+ ..\x2p\find2perl \
+ ..\x2p\s2p \
+ bin\www.pl \
+ bin\runperl.pl \
+ bin\pl2bat.pl \
+ bin\perlglob.pl \
+ bin\search.pl
+
+.IF "$(CCTYPE)" == "BORLAND"
+
+CFGSH_TMPL = config.bc
+CFGH_TMPL = config_H.bc
+
+.ELIF "$(CCTYPE)" == "GCC"
+
+CFGSH_TMPL = config.gc
+CFGH_TMPL = config_H.gc
+.IF "$(OBJECT)" == "-DPERL_OBJECT"
+PERLIMPLIB = ..\libperlcore$(a)
+.ELSE
+PERLIMPLIB = ..\libperl$(a)
+.ENDIF
+
+.ELSE
+
+CFGSH_TMPL = config.vc
+CFGH_TMPL = config_H.vc
+.IF "$(USE_PERLCRT)" == ""
+PERL95EXE = ..\perl95.exe
+.ENDIF
+
+.ENDIF
+
+.IF "$(OBJECT)" == "-DPERL_OBJECT"
+PERLIMPLIB *= ..\perlcore$(a)
+PERLDLL = ..\perlcore.dll
+CAPILIB = $(COREDIR)\perlCAPI$(a)
+.ELSE
+PERLIMPLIB *= ..\perl$(a)
+PERLDLL = ..\perl.dll
+CAPILIB =
+.ENDIF
+
+XCOPY = xcopy /f /r /i /d
+RCOPY = xcopy /f /r /i /e /d
+NOOP = @echo
+
+#
+# filenames given to xsubpp must have forward slashes (since it puts
+# full pathnames in #line strings)
+XSUBPP = ..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp \
+ -C++ -prototypes
+
+MICROCORE_SRC = \
+ ..\av.c \
+ ..\byterun.c \
+ ..\deb.c \
+ ..\doio.c \
+ ..\doop.c \
+ ..\dump.c \
+ ..\globals.c \
+ ..\gv.c \
+ ..\hv.c \
+ ..\mg.c \
+ ..\op.c \
+ ..\perl.c \
+ ..\perly.c \
+ ..\pp.c \
+ ..\pp_ctl.c \
+ ..\pp_hot.c \
+ ..\pp_sys.c \
+ ..\regcomp.c \
+ ..\regexec.c \
+ ..\run.c \
+ ..\scope.c \
+ ..\sv.c \
+ ..\taint.c \
+ ..\toke.c \
+ ..\universal.c \
+ ..\util.c
+
+.IF "$(PERL_MALLOC)" == "define"
+EXTRACORE_SRC += ..\malloc.c
+.ENDIF
+
+.IF "$(OBJECT)" == ""
+EXTRACORE_SRC += ..\perlio.c
+.ENDIF
+
+WIN32_SRC = \
+ .\win32.c \
+ .\win32sck.c
+
+.IF "$(USE_THREADS)" == "define"
+WIN32_SRC += .\win32thread.c
+.ENDIF
+
+.IF "$(CRYPT_SRC)" != ""
+WIN32_SRC += .\$(CRYPT_SRC)
+.ENDIF
+
+PERL95_SRC = \
+ perl95.c \
+ win32mt.c \
+ win32sckmt.c
+
+.IF "$(CRYPT_SRC)" != ""
+PERL95_SRC += .\$(CRYPT_SRC)
+.ENDIF
+
+DLL_SRC = $(DYNALOADER).c
+
+
+.IF "$(OBJECT)" == ""
+DLL_SRC += perllib.c
+.ENDIF
+
+X2P_SRC = \
+ ..\x2p\a2p.c \
+ ..\x2p\hash.c \
+ ..\x2p\str.c \
+ ..\x2p\util.c \
+ ..\x2p\walk.c
+
+CORE_NOCFG_H = \
+ ..\av.h \
+ ..\byterun.h \
+ ..\bytecode.h \
+ ..\cop.h \
+ ..\cv.h \
+ ..\dosish.h \
+ ..\embed.h \
+ ..\form.h \
+ ..\gv.h \
+ ..\handy.h \
+ ..\hv.h \
+ ..\iperlsys.h \
+ ..\mg.h \
+ ..\nostdio.h \
+ ..\op.h \
+ ..\opcode.h \
+ ..\perl.h \
+ ..\perlsdio.h \
+ ..\perlsfio.h \
+ ..\perly.h \
+ ..\pp.h \
+ ..\proto.h \
+ ..\regexp.h \
+ ..\scope.h \
+ ..\sv.h \
+ ..\thread.h \
+ ..\unixish.h \
+ ..\util.h \
+ ..\XSUB.h \
+ ..\EXTERN.h \
+ ..\perlvars.h \
+ ..\intrpvar.h \
+ ..\thrdvar.h \
+ .\include\dirent.h \
+ .\include\netdb.h \
+ .\include\sys\socket.h \
+ .\win32.h
+
+CORE_H = $(CORE_NOCFG_H) .\config.h
+
+MICROCORE_OBJ = $(MICROCORE_SRC:db:+$(o))
+CORE_OBJ = $(MICROCORE_OBJ) $(EXTRACORE_SRC:db:+$(o))
+WIN32_OBJ = $(WIN32_SRC:db:+$(o))
+MINICORE_OBJ = $(MINIDIR)\{$(MICROCORE_OBJ:f) miniperlmain$(o) perlio$(o)}
+MINIWIN32_OBJ = $(MINIDIR)\{$(WIN32_OBJ:f)}
+MINI_OBJ = $(MINICORE_OBJ) $(MINIWIN32_OBJ)
+PERL95_OBJ = $(PERL95_SRC:db:+$(o))
+DLL_OBJ = $(DLL_SRC:db:+$(o))
+X2P_OBJ = $(X2P_SRC:db:+$(o))
+
+PERLDLL_OBJ = $(CORE_OBJ)
+PERLEXE_OBJ = perlmain$(o)
+
+.IF "$(OBJECT)" == ""
+PERLDLL_OBJ += $(WIN32_OBJ) $(DLL_OBJ)
+.ELSE
+PERLEXE_OBJ += $(WIN32_OBJ) $(DLL_OBJ)
+PERL95_OBJ += DynaLoadmt$(o)
+.ENDIF
+
+.IF "$(USE_SETARGV)" != ""
+SETARGV_OBJ = setargv$(o)
+.ENDIF
+
+DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re \
+ Data/Dumper
+STATIC_EXT = DynaLoader
+NONXS_EXT = Errno
+
+DYNALOADER = $(EXTDIR)\DynaLoader\DynaLoader
+SOCKET = $(EXTDIR)\Socket\Socket
+FCNTL = $(EXTDIR)\Fcntl\Fcntl
+OPCODE = $(EXTDIR)\Opcode\Opcode
+SDBM_FILE = $(EXTDIR)\SDBM_File\SDBM_File
+IO = $(EXTDIR)\IO\IO
+POSIX = $(EXTDIR)\POSIX\POSIX
+ATTRS = $(EXTDIR)\attrs\attrs
+THREAD = $(EXTDIR)\Thread\Thread
+B = $(EXTDIR)\B\B
+RE = $(EXTDIR)\re\re
+DUMPER = $(EXTDIR)\Data\Dumper\Dumper
+ERRNO = $(EXTDIR)\Errno\Errno
+
+SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll
+FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll
+OPCODE_DLL = $(AUTODIR)\Opcode\Opcode.dll
+SDBM_FILE_DLL = $(AUTODIR)\SDBM_File\SDBM_File.dll
+IO_DLL = $(AUTODIR)\IO\IO.dll
+POSIX_DLL = $(AUTODIR)\POSIX\POSIX.dll
+ATTRS_DLL = $(AUTODIR)\attrs\attrs.dll
+THREAD_DLL = $(AUTODIR)\Thread\Thread.dll
+B_DLL = $(AUTODIR)\B\B.dll
+DUMPER_DLL = $(AUTODIR)\Data\Dumper\Dumper.dll
+RE_DLL = $(AUTODIR)\re\re.dll
+
+ERRNO_PM = $(LIBDIR)\Errno.pm
+
+EXTENSION_C = \
+ $(SOCKET).c \
+ $(FCNTL).c \
+ $(OPCODE).c \
+ $(SDBM_FILE).c \
+ $(IO).c \
+ $(POSIX).c \
+ $(ATTRS).c \
+ $(THREAD).c \
+ $(RE).c \
+ $(DUMPER).c \
+ $(B).c
+
+EXTENSION_DLL = \
+ $(SOCKET_DLL) \
+ $(FCNTL_DLL) \
+ $(OPCODE_DLL) \
+ $(SDBM_FILE_DLL)\
+ $(IO_DLL) \
+ $(POSIX_DLL) \
+ $(ATTRS_DLL) \
+ $(DUMPER_DLL) \
+ $(B_DLL)
+
+EXTENSION_PM = \
+ $(ERRNO_PM)
+
+# re.dll doesn't build with PERL_OBJECT yet
+.IF "$(OBJECT)" == ""
+EXTENSION_DLL += \
+ $(THREAD_DLL) \
+ $(RE_DLL)
+.ENDIF
+
+POD2HTML = $(PODDIR)\pod2html
+POD2MAN = $(PODDIR)\pod2man
+POD2LATEX = $(PODDIR)\pod2latex
+POD2TEXT = $(PODDIR)\pod2text
+
+CFG_VARS = \
+ "INST_DRV=$(INST_DRV)" \
+ "INST_TOP=$(INST_TOP)" \
+ "INST_VER=$(INST_VER)" \
+ "archname=$(ARCHNAME)" \
+ "cc=$(CC)" \
+ "ccflags=$(OPTIMIZE:s/"/\"/) $(DEFINES) $(OBJECT)" \
+ "cf_email=$(EMAIL)" \
+ "d_crypt=$(D_CRYPT)" \
+ "d_mymalloc=$(PERL_MALLOC)" \
+ "libs=$(LIBFILES:f)" \
+ "incpath=$(CCINCDIR:s/"/\"/)" \
+ "libperl=$(PERLIMPLIB:f)" \
+ "libpth=$(CCLIBDIR:s/"/\"/);$(EXTRALIBDIRS:s/"/\"/)" \
+ "libc=$(LIBC)" \
+ "make=dmake" \
+ "_o=$(o)" "obj_ext=$(o)" \
+ "_a=$(a)" "lib_ext=$(a)" \
+ "static_ext=$(STATIC_EXT)" \
+ "dynamic_ext=$(DYNAMIC_EXT)" \
+ "nonxs_ext=$(NONXS_EXT)" \
+ "usethreads=$(USE_THREADS)" \
+ "usemultiplicity=$(USE_MULTI)" \
+ "LINK_FLAGS=$(LINK_FLAGS:s/"/\"/)" \
+ "optimize=$(OPTIMIZE:s/"/\"/)"
+
+#
+# Top targets
+#
+
+all : .\config.h $(GLOBEXE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) $(PERL95EXE) \
+ $(CAPILIB) $(X2P) $(EXTENSION_DLL) $(EXTENSION_PM)
+
+$(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c
+
+#------------------------------------------------------------
+
+$(GLOBEXE) : perlglob$(o)
+.IF "$(CCTYPE)" == "BORLAND"
+ $(CC) -c -w -v -tWM -I"$(CCINCDIR)" perlglob.c
+ $(LINK32) -Tpe -ap $(LINK_FLAGS) c0x32$(o) perlglob$(o) \
+ "$(CCLIBDIR)\32BIT\wildargs$(o)",$@,,import32.lib cw32mt.lib,
+.ELIF "$(CCTYPE)" == "GCC"
+ $(LINK32) $(LINK_FLAGS) -o $@ perlglob$(o) $(LIBFILES)
+.ELSE
+ $(LINK32) $(LINK_FLAGS) $(LIBFILES) -out:$@ -subsystem:$(SUBSYS) \
+ perlglob$(o) setargv$(o)
+.ENDIF
+
+perlglob$(o) : perlglob.c
+
+config.w32 : $(CFGSH_TMPL)
+ copy $(CFGSH_TMPL) config.w32
+
+.\config.h : $(CFGH_TMPL) $(CORE_NOCFG_H)
+ -del /f config.h
+ copy $(CFGH_TMPL) config.h
+
+..\config.sh : config.w32 $(MINIPERL) config_sh.PL
+ $(MINIPERL) -I..\lib config_sh.PL $(CFG_VARS) config.w32 > ..\config.sh
+
+# this target is for when changes to the main config.sh happen
+# edit config.{b,v,g}c and make this target once for each supported
+# compiler (e.g. `dmake CCTYPE=BORLAND regen_config_h`)
+regen_config_h:
+ perl config_sh.PL $(CFG_VARS) $(CFGSH_TMPL) > ..\config.sh
+ -cd .. && del /f perl.exe
+ cd .. && perl configpm
+ -del /f $(CFGH_TMPL)
+ -mkdir $(COREDIR)
+ -perl -I..\lib config_h.PL "INST_VER=$(INST_VER)"
+ rename config.h $(CFGH_TMPL)
+
+$(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl
+ cd .. && miniperl configpm
+ if exist lib\* $(RCOPY) lib\*.* ..\lib\$(NULL)
+ $(XCOPY) ..\*.h $(COREDIR)\*.*
+ $(XCOPY) *.h $(COREDIR)\*.*
+ $(XCOPY) ..\ext\re\re.pm $(LIBDIR)\*.*
+ $(RCOPY) include $(COREDIR)\*.*
+ $(MINIPERL) -I..\lib config_h.PL "INST_VER=$(INST_VER)" \
+ || $(MAKE) $(MAKEMACROS) $(CONFIGPM)
+
+$(MINIPERL) : $(MINIDIR) $(MINI_OBJ)
+.IF "$(CCTYPE)" == "BORLAND"
+ $(LINK32) -Tpe -ap $(LINK_FLAGS) \
+ @$(mktmp c0x32$(o) $(MINI_OBJ:s,\,\\),$(@:s,\,\\),,$(LIBFILES),)
+.ELIF "$(CCTYPE)" == "GCC"
+ $(LINK32) -v -o $@ $(LINK_FLAGS) \
+ $(mktmp $(LKPRE) $(MINI_OBJ:s,\,\\) $(LIBFILES) $(LKPOST))
+.ELSE
+ $(LINK32) -subsystem:console -out:$@ \
+ @$(mktmp $(LINK_FLAGS) $(LIBFILES) $(MINI_OBJ:s,\,\\))
+.ENDIF
+
+$(MINIDIR) :
+ if not exist "$(MINIDIR)" mkdir "$(MINIDIR)"
+
+$(MINICORE_OBJ) : $(CORE_NOCFG_H)
+ $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ ..\$(*B).c
+
+$(MINIWIN32_OBJ) : $(CORE_NOCFG_H)
+ $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ $(*B).c
+
+# 1. we don't want to rebuild miniperl.exe when config.h changes
+# 2. we don't want to rebuild miniperl.exe with non-default config.h
+$(MINI_OBJ) : $(CORE_NOCFG_H)
+
+$(WIN32_OBJ) : $(CORE_H)
+$(CORE_OBJ) : $(CORE_H)
+$(DLL_OBJ) : $(CORE_H)
+$(PERL95_OBJ) : $(CORE_H)
+$(X2P_OBJ) : $(CORE_H)
+
+perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym makedef.pl
+ $(MINIPERL) -w makedef.pl $(OPTIMIZE) $(DEFINES) $(OBJECT) \
+ CCTYPE=$(CCTYPE) > perldll.def
+
+$(PERLDLL): perldll.def $(PERLDLL_OBJ)
+.IF "$(CCTYPE)" == "BORLAND"
+ $(LINK32) -Tpd -ap $(LINK_FLAGS) \
+ @$(mktmp c0d32$(o) $(PERLDLL_OBJ:s,\,\\)\n \
+ $@,\n \
+ $(LIBFILES)\n \
+ perldll.def\n)
+ $(IMPLIB) $*.lib $@
+.ELIF "$(CCTYPE)" == "GCC"
+ $(LINK32) -mdll -o $@ -Wl,--base-file -Wl,perl.base $(LINK_FLAGS) \
+ $(mktmp $(LKPRE) $(PERLDLL_OBJ:s,\,\\) $(LIBFILES) $(LKPOST))
+ dlltool --output-lib $(PERLIMPLIB) \
+ --dllname perl.dll \
+ --def perldll.def \
+ --base-file perl.base \
+ --output-exp perl.exp
+ $(LINK32) -mdll -o $@ $(LINK_FLAGS) \
+ $(mktmp $(LKPRE) $(PERLDLL_OBJ:s,\,\\) $(LIBFILES) \
+ perl.exp $(LKPOST))
+.ELSE
+ $(LINK32) -dll -def:perldll.def -out:$@ \
+ @$(mktmp $(LINK_FLAGS) $(LIBFILES) $(PERLDLL_OBJ:s,\,\\))
+.ENDIF
+ $(XCOPY) $(PERLIMPLIB) $(COREDIR)
+
+perl.def : $(MINIPERL) makeperldef.pl
+ $(MINIPERL) -I..\lib makeperldef.pl $(NULL) > perl.def
+
+$(MINIMOD) : $(MINIPERL) ..\minimod.pl
+ cd .. && miniperl minimod.pl > lib\ExtUtils\Miniperl.pm
+
+..\x2p\a2p$(o) : ..\x2p\a2p.c
+ $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\a2p.c
+
+..\x2p\hash$(o) : ..\x2p\hash.c
+ $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\hash.c
+
+..\x2p\str$(o) : ..\x2p\str.c
+ $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\str.c
+
+..\x2p\util$(o) : ..\x2p\util.c
+ $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\util.c
+
+..\x2p\walk$(o) : ..\x2p\walk.c
+ $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\walk.c
+
+$(X2P) : $(MINIPERL) $(X2P_OBJ)
+ $(MINIPERL) ..\x2p\find2perl.PL
+ $(MINIPERL) ..\x2p\s2p.PL
+.IF "$(CCTYPE)" == "BORLAND"
+ $(LINK32) -Tpe -ap $(LINK_FLAGS) \
+ @$(mktmp c0x32$(o) $(X2P_OBJ:s,\,\\),$(@:s,\,\\),,$(LIBFILES),)
+.ELIF "$(CCTYPE)" == "GCC"
+ $(LINK32) -v -o $@ $(LINK_FLAGS) \
+ $(mktmp $(LKPRE) $(X2P_OBJ:s,\,\\) $(LIBFILES) $(LKPOST))
+.ELSE
+ $(LINK32) -subsystem:console -out:$@ \
+ @$(mktmp $(LINK_FLAGS) $(LIBFILES) $(X2P_OBJ:s,\,\\))
+.ENDIF
+
+perlmain.c : runperl.c
+ copy runperl.c perlmain.c
+
+perlmain$(o) : perlmain.c
+ $(CC) $(CFLAGS_O) -UPERLDLL $(OBJOUT_FLAG)$@ -c perlmain.c
+
+$(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ)
+.IF "$(CCTYPE)" == "BORLAND"
+ $(LINK32) -Tpe -ap $(LINK_FLAGS) \
+ @$(mktmp c0x32$(o) $(PERLEXE_OBJ:s,\,\\)\n \
+ $(@:s,\,\\),\n \
+ $(PERLIMPLIB) $(LIBFILES)\n)
+.ELIF "$(CCTYPE)" == "GCC"
+ $(LINK32) -o $@ $(LINK_FLAGS) \
+ $(PERLEXE_OBJ) $(PERLIMPLIB) $(LIBFILES)
+.ELSE
+ $(LINK32) -subsystem:console -out:$@ $(LINK_FLAGS) $(LIBFILES) \
+ $(PERLEXE_OBJ) $(SETARGV_OBJ) $(PERLIMPLIB)
+.ENDIF
+ copy splittree.pl ..
+ $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR)
+
+.IF "$(CCTYPE)" != "BORLAND"
+.IF "$(CCTYPE)" != "GCC"
+.IF "$(USE_PERLCRT)" == ""
+
+perl95.c : runperl.c
+ copy runperl.c perl95.c
+
+perl95$(o) : perl95.c
+ $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c perl95.c
+
+win32sckmt$(o) : win32sck.c
+ $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \
+ $(OBJOUT_FLAG)win32sckmt$(o) win32sck.c
+
+win32mt$(o) : win32.c
+ $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \
+ $(OBJOUT_FLAG)win32mt$(o) win32.c
+
+DynaLoadmt$(o) : $(DYNALOADER).c
+ $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \
+ $(OBJOUT_FLAG)DynaLoadmt$(o) $(DYNALOADER).c
+
+$(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ)
+ $(LINK32) -subsystem:console -nodefaultlib -out:$@ $(LINK_FLAGS) \
+ $(LIBBASEFILES) $(PERL95_OBJ) $(SETARGV_OBJ) $(PERLIMPLIB) \
+ libcmt.lib
+
+.ENDIF
+.ENDIF
+.ENDIF
+
+$(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM)
+ if not exist $(AUTODIR) mkdir $(AUTODIR)
+ cd $(EXTDIR)\$(*B) && ..\$(MINIPERL) -I..\..\lib $(*B)_pm.PL
+ $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL)
+ cd $(EXTDIR)\$(*B) && $(XSUBPP) dl_win32.xs > $(*B).c
+ $(XCOPY) $(EXTDIR)\$(*B)\dlutils.c .
+
+.IF "$(OBJECT)" == "-DPERL_OBJECT"
+
+perlCAPI.cpp : $(MINIPERL)
+ $(MINIPERL) GenCAPI.pl $(COREDIR)
+
+perlCAPI$(o) : perlCAPI.cpp
+.IF "$(CCTYPE)" == "BORLAND"
+ $(CC) $(CFLAGS_O) -c $(OBJOUT_FLAG)perlCAPI$(o) perlCAPI.cpp
+.ELIF "$(CCTYPE)" == "GCC"
+ $(CC) $(CFLAGS_O) -c $(OBJOUT_FLAG)perlCAPI$(o) perlCAPI.cpp
+.ELSE
+ $(CC) $(CFLAGS_O) $(RUNTIME) -UPERLDLL -c \
+ $(OBJOUT_FLAG)perlCAPI$(o) perlCAPI.cpp
+.ENDIF
+
+$(CAPILIB) : perlCAPI.cpp perlCAPI$(o)
+.IF "$(CCTYPE)" == "BORLAND"
+ $(LIB32) $(LIBOUT_FLAG)$(CAPILIB) +perlCAPI$(o)
+.ELSE
+ $(LIB32) $(LIBOUT_FLAG)$(CAPILIB) perlCAPI$(o)
+.ENDIF
+
+.ENDIF
+
+$(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs
+ copy dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs
+
+$(DUMPER_DLL): $(PERLEXE) $(DUMPER).xs
+ cd $(EXTDIR)\Data\$(*B) && \
+ ..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl
+ cd $(EXTDIR)\Data\$(*B) && $(MAKE)
+
+$(RE_DLL): $(PERLEXE) $(RE).xs
+ cd $(EXTDIR)\$(*B) && \
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ cd $(EXTDIR)\$(*B) && $(MAKE)
+
+$(B_DLL): $(PERLEXE) $(B).xs
+ cd $(EXTDIR)\$(*B) && \
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ cd $(EXTDIR)\$(*B) && $(MAKE)
+
+$(THREAD_DLL): $(PERLEXE) $(THREAD).xs
+ cd $(EXTDIR)\$(*B) && \
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ cd $(EXTDIR)\$(*B) && $(MAKE)
+
+$(ATTRS_DLL): $(PERLEXE) $(ATTRS).xs
+ cd $(EXTDIR)\$(*B) && \
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ cd $(EXTDIR)\$(*B) && $(MAKE)
+
+$(POSIX_DLL): $(PERLEXE) $(POSIX).xs
+ cd $(EXTDIR)\$(*B) && \
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ cd $(EXTDIR)\$(*B) && $(MAKE)
+
+$(IO_DLL): $(PERLEXE) $(IO).xs
+ cd $(EXTDIR)\$(*B) && \
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ cd $(EXTDIR)\$(*B) && $(MAKE)
+
+$(SDBM_FILE_DLL) : $(PERLEXE) $(SDBM_FILE).xs
+ cd $(EXTDIR)\$(*B) && \
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ cd $(EXTDIR)\$(*B) && $(MAKE)
+
+$(FCNTL_DLL): $(PERLEXE) $(FCNTL).xs
+ cd $(EXTDIR)\$(*B) && \
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ cd $(EXTDIR)\$(*B) && $(MAKE)
+
+$(OPCODE_DLL): $(PERLEXE) $(OPCODE).xs
+ cd $(EXTDIR)\$(*B) && \
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ cd $(EXTDIR)\$(*B) && $(MAKE)
+
+$(SOCKET_DLL): $(PERLEXE) $(SOCKET).xs
+ cd $(EXTDIR)\$(*B) && \
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ cd $(EXTDIR)\$(*B) && $(MAKE)
+
+$(ERRNO_PM): $(PERLEXE) $(ERRNO)_pm.PL
+ cd $(EXTDIR)\$(*B) && \
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ cd $(EXTDIR)\$(*B) && $(MAKE)
+
+doc: $(PERLEXE)
+ $(PERLEXE) -I..\lib ..\installhtml --podroot=.. --htmldir=./html \
+ --podpath=pod:lib:ext:utils --htmlroot="file://$(INST_HTML:s,:,|,)"\
+ --libpod=perlfunc:perlguts:perlvar:perlrun:perlop --recurse
+
+utils: $(PERLEXE) $(X2P)
+ cd ..\utils && $(MAKE) PERL=$(MINIPERL)
+ copy ..\README.win32 ..\pod\perlwin32.pod
+ cd ..\pod && $(MAKE) -f ..\win32\pod.mak converters
+ $(PERLEXE) $(PL2BAT) $(UTILS)
+
+distclean: clean
+ -del /f $(MINIPERL) $(PERLEXE) $(PERL95EXE) $(PERLDLL) $(GLOBEXE) \
+ $(PERLIMPLIB) ..\miniperl$(a) $(MINIMOD)
+ -del /f *.def *.map
+ -del /f $(EXTENSION_DLL) $(EXTENSION_PM)
+ -del /f $(EXTENSION_C) $(DYNALOADER).c $(ERRNO).pm
+ -del /f $(EXTDIR)\DynaLoader\dl_win32.xs
+ -del /f $(LIBDIR)\.exists $(LIBDIR)\attrs.pm $(LIBDIR)\DynaLoader.pm
+ -del /f $(LIBDIR)\Fcntl.pm $(LIBDIR)\IO.pm $(LIBDIR)\Opcode.pm
+ -del /f $(LIBDIR)\ops.pm $(LIBDIR)\Safe.pm $(LIBDIR)\Thread.pm
+ -del /f $(LIBDIR)\SDBM_File.pm $(LIBDIR)\Socket.pm $(LIBDIR)\POSIX.pm
+ -del /f $(LIBDIR)\B.pm $(LIBDIR)\O.pm $(LIBDIR)\re.pm
+ -del /f $(LIBDIR)\Data\Dumper.pm
+ -rmdir /s /q $(LIBDIR)\IO || rmdir /s $(LIBDIR)\IO
+ -rmdir /s /q $(LIBDIR)\Thread || rmdir /s $(LIBDIR)\Thread
+ -rmdir /s /q $(LIBDIR)\B || rmdir /s $(LIBDIR)\B
+ -rmdir /s /q $(LIBDIR)\Data || rmdir /s $(LIBDIR)\Data
+ -del /f $(PODDIR)\*.html
+ -del /f $(PODDIR)\*.bat
+ -cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc \
+ pstruct *.bat
+ -cd ..\x2p && del /f find2perl s2p *.bat
+ -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new
+ -del /f $(CONFIGPM)
+.IF "$(PERL95EXE)" != ""
+ -del /f perl95.c
+.ENDIF
+ -del /f bin\*.bat
+ -cd $(EXTDIR) && del /s *$(a) *.def *.map *.pdb *.bs Makefile *$(o) \
+ pm_to_blib
+ -rmdir /s /q $(AUTODIR) || rmdir /s $(AUTODIR)
+ -rmdir /s /q $(COREDIR) || rmdir /s $(COREDIR)
+
+install : all installbare installhtml
+
+installbare : utils
+ $(PERLEXE) ..\installperl
+.IF "$(PERL95EXE)" != ""
+ $(XCOPY) $(PERL95EXE) $(INST_BIN)\*.*
+.ENDIF
+ $(XCOPY) $(GLOBEXE) $(INST_BIN)\*.*
+ $(XCOPY) bin\*.bat $(INST_SCRIPT)\*.*
+ $(XCOPY) bin\network.pl $(INST_LIB)\*.*
+
+installhtml : doc
+ $(RCOPY) html\*.* $(INST_HTML)\*.*
+
+inst_lib : $(CONFIGPM)
+ copy splittree.pl ..
+ $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR)
+ $(RCOPY) ..\lib $(INST_LIB)\*.*
+
+minitest : $(MINIPERL) $(GLOBEXE) $(CONFIGPM) utils
+ $(XCOPY) $(MINIPERL) ..\t\perl.exe
+.IF "$(CCTYPE)" == "BORLAND"
+ $(XCOPY) $(GLOBBAT) ..\t\$(NULL)
+.ELSE
+ $(XCOPY) $(GLOBEXE) ..\t\$(NULL)
+.ENDIF
+ attrib -r ..\t\*.*
+ copy test ..\t
+ cd ..\t && \
+ $(MINIPERL) -I..\lib test base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t
+
+test-prep : all utils
+ $(XCOPY) $(PERLEXE) ..\t\$(NULL)
+ $(XCOPY) $(PERLDLL) ..\t\$(NULL)
+.IF "$(CCTYPE)" == "BORLAND"
+ $(XCOPY) $(GLOBBAT) ..\t\$(NULL)
+.ELSE
+ $(XCOPY) $(GLOBEXE) ..\t\$(NULL)
+.ENDIF
+
+test : test-prep
+ cd ..\t && $(PERLEXE) -I..\lib harness
+
+test-notty : test-prep
+ set PERL_SKIP_TTY_TEST=1 && \
+ cd ..\t && $(PERLEXE) -I.\lib harness
+
+clean :
+ -@erase miniperlmain$(o)
+ -@erase $(MINIPERL)
+ -@erase perlglob$(o)
+ -@erase perlmain$(o)
+ -@erase perlCAPI.cpp
+ -@erase config.w32
+ -@erase /f config.h
+ -@erase $(GLOBEXE)
+ -@erase $(PERLEXE)
+ -@erase $(PERLDLL)
+ -@erase $(CORE_OBJ)
+ -rmdir /s /q $(MINIDIR) || rmdir /s $(MINIDIR)
+ -@erase $(WIN32_OBJ)
+ -@erase $(DLL_OBJ)
+ -@erase $(X2P_OBJ)
+ -@erase ..\*$(o) ..\*$(a) ..\*.exp ..\*.res *$(o) *$(a) *.exp *.res
+ -@erase ..\t\*.exe ..\t\*.dll ..\t\*.bat
+ -@erase ..\x2p\*.exe ..\x2p\*.bat
+ -@erase *.ilk
+ -@erase *.pdb
diff --git a/gnu/usr.bin/perl/win32/perlglob.c b/gnu/usr.bin/perl/win32/perlglob.c
index b2fdca2f71e..be9d55052ce 100644
--- a/gnu/usr.bin/perl/win32/perlglob.c
+++ b/gnu/usr.bin/perl/win32/perlglob.c
@@ -22,7 +22,8 @@ main(int argc, char *argv[])
/* check out the file system characteristics */
if (GetFullPathName(".", MAX_PATH, root, &dummy)) {
- if (dummy = strchr(root, '\\'))
+ dummy = strchr(root,'\\');
+ if (dummy)
*++dummy = '\0';
if (GetVolumeInformation(root, volname, MAX_PATH,
&serial, &maxname, &flags, 0, 0)) {
@@ -40,3 +41,4 @@ main(int argc, char *argv[])
}
return 0;
}
+
diff --git a/gnu/usr.bin/perl/win32/perllib.c b/gnu/usr.bin/perl/win32/perllib.c
index 391b4d375f0..d1d942c4956 100644
--- a/gnu/usr.bin/perl/win32/perllib.c
+++ b/gnu/usr.bin/perl/win32/perllib.c
@@ -2,31 +2,28 @@
* "The Road goes ever on and on, down from the door where it began."
*/
-#ifdef __cplusplus
-extern "C" {
-#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
-#ifdef __cplusplus
-}
-# define EXTERN_C extern "C"
-#else
-# define EXTERN_C extern
-#endif
-
static void xs_init _((void));
-__declspec(dllexport) int
+DllExport int
RunPerl(int argc, char **argv, char **env, void *iosubsystem)
{
int exitstatus;
PerlInterpreter *my_perl;
- void *pOldIOSubsystem;
- pOldIOSubsystem = SetIOSubSystem(iosubsystem);
+#ifdef PERL_GLOBAL_STRUCT
+#define PERLVAR(var,type) /**/
+#define PERLVARI(var,type,init) PL_Vars.var = init;
+#define PERLVARIC(var,type,init) PL_Vars.var = init;
+#include "perlvars.h"
+#undef PERLVAR
+#undef PERLVARI
+#undef PERLVARIC
+#endif
PERL_SYS_INIT(&argc,&argv);
@@ -35,7 +32,7 @@ RunPerl(int argc, char **argv, char **env, void *iosubsystem)
if (!(my_perl = perl_alloc()))
return (1);
perl_construct( my_perl );
- perl_destruct_level = 0;
+ PL_perl_destruct_level = 0;
exitstatus = perl_parse( my_perl, xs_init, argc, argv, env);
if (!exitstatus) {
@@ -47,12 +44,10 @@ RunPerl(int argc, char **argv, char **env, void *iosubsystem)
PERL_SYS_TERM();
- SetIOSubSystem(pOldIOSubsystem);
-
return (exitstatus);
}
-extern HANDLE PerlDllHandle;
+extern HANDLE w32_perldll_handle;
BOOL APIENTRY
DllMain(HANDLE hModule, /* DLL module handle */
@@ -71,7 +66,7 @@ DllMain(HANDLE hModule, /* DLL module handle */
setmode( fileno( stderr ), O_BINARY );
_fmode = O_BINARY;
#endif
- PerlDllHandle = hModule;
+ w32_perldll_handle = hModule;
break;
/* The DLL is detaching from a process due to
diff --git a/gnu/usr.bin/perl/win32/pod.mak b/gnu/usr.bin/perl/win32/pod.mak
index 9881ed882d6..c9569a3b5aa 100644
--- a/gnu/usr.bin/perl/win32/pod.mak
+++ b/gnu/usr.bin/perl/win32/pod.mak
@@ -8,8 +8,10 @@ POD2HTML = pod2html \
all: $(CONVERTERS) html
+converters: $(CONVERTERS)
+
PERL = ..\miniperl.exe
-PL2BAT = ..\win32\bin\pl2bat.pl
+REALPERL = ..\perl.exe
POD = \
perl.pod \
@@ -20,9 +22,12 @@ POD = \
perlre.pod \
perlrun.pod \
perlfunc.pod \
+ perlopentut.pod \
perlvar.pod \
perlsub.pod \
perlmod.pod \
+ perlmodlib.pod \
+ perlmodinstall.pod \
perlform.pod \
perllocale.pod \
perlref.pod \
@@ -33,15 +38,18 @@ POD = \
perltie.pod \
perlbot.pod \
perlipc.pod \
+ perlthrtut.pod \
perldebug.pod \
perldiag.pod \
perlsec.pod \
perltrap.pod \
+ perlport.pod \
perlstyle.pod \
perlpod.pod \
perlbook.pod \
perlembed.pod \
perlapio.pod \
+ perlwin32.pod \
perlxs.pod \
perlxstut.pod \
perlguts.pod \
@@ -67,12 +75,16 @@ MAN = \
perlre.man \
perlrun.man \
perlfunc.man \
+ perlopentut.man \
perlvar.man \
perlsub.man \
perlmod.man \
+ perlmodlib.man \
+ perlmodinstall.man \
perlform.man \
perllocale.man \
perlref.man \
+ perlreftut.man \
perldsc.man \
perllol.man \
perltoot.man \
@@ -80,15 +92,18 @@ MAN = \
perltie.man \
perlbot.man \
perlipc.man \
+ perlthrtut.man \
perldebug.man \
perldiag.man \
perlsec.man \
perltrap.man \
+ perlport.man \
perlstyle.man \
perlpod.man \
perlbook.man \
perlembed.man \
perlapio.man \
+ perlwin32.man \
perlxs.man \
perlxstut.man \
perlguts.man \
@@ -114,12 +129,16 @@ HTML = \
perlre.html \
perlrun.html \
perlfunc.html \
+ perlopentut.html \
perlvar.html \
perlsub.html \
perlmod.html \
+ perlmodlib.html \
+ perlmodinstall.html \
perlform.html \
perllocale.html \
perlref.html \
+ perlreftut.html \
perldsc.html \
perllol.html \
perltoot.html \
@@ -127,15 +146,18 @@ HTML = \
perltie.html \
perlbot.html \
perlipc.html \
+ perlthrtut.html \
perldebug.html \
perldiag.html \
perlsec.html \
perltrap.html \
+ perlport.html \
perlstyle.html \
perlpod.html \
perlbook.html \
perlembed.html \
perlapio.html \
+ perlwin32.html \
perlxs.html \
perlxstut.html \
perlguts.html \
@@ -161,12 +183,16 @@ TEX = \
perlre.tex \
perlrun.tex \
perlfunc.tex \
+ perlopentut.tex \
perlvar.tex \
perlsub.tex \
perlmod.tex \
+ perlmodlib.tex \
+ perlmodinstall.tex \
perlform.tex \
perllocale.tex \
perlref.tex \
+ perlreftut.tex \
perldsc.tex \
perllol.tex \
perltoot.tex \
@@ -174,15 +200,18 @@ TEX = \
perltie.tex \
perlbot.tex \
perlipc.tex \
+ perlthrtut.tex \
perldebug.tex \
perldiag.tex \
perlsec.tex \
perltrap.tex \
+ perlport.tex \
perlstyle.tex \
perlpod.tex \
perlbook.tex \
perlembed.tex \
perlapio.tex \
+ perlwin32.tex \
perlxs.tex \
perlxstut.tex \
perlguts.tex \
@@ -206,67 +235,67 @@ html: pod2html $(HTML)
tex: pod2latex $(TEX)
toc:
- $(PERL) -I..\lib buildtoc >perltoc.pod
+ $(PERL) -I../lib buildtoc >perltoc.pod
.SUFFIXES: .pm .pod
.SUFFIXES: .man
.pm.man:
- $(PERL) -I..\lib pod2man $*.pm >$*.man
+ $(PERL) -I../lib pod2man $*.pm >$*.man
.pod.man:
- $(PERL) -I..\lib pod2man $*.pod >$*.man
+ $(PERL) -I../lib pod2man $*.pod >$*.man
.SUFFIXES: .html
.pm.html:
- $(PERL) -I..\lib $(POD2HTML) --infile=$*.pm --outfile=$*.html
+ $(PERL) -I../lib $(POD2HTML) --infile=$*.pm --outfile=$*.html
.pod.html:
- $(PERL) -I..\lib $(POD2HTML) --infile=$*.pod --outfile=$*.html
+ $(PERL) -I../lib $(POD2HTML) --infile=$*.pod --outfile=$*.html
.SUFFIXES: .tex
.pm.tex:
- $(PERL) -I..\lib pod2latex $*.pm
+ $(PERL) -I../lib pod2latex $*.pm
.pod.tex:
- $(PERL) -I..\lib pod2latex $*.pod
+ $(PERL) -I../lib pod2latex $*.pod
clean:
- del /f $(MAN) $(HTML) $(TEX)
- del /f pod2html-*cache
- del /f *.aux *.log
+ rm -f $(MAN)
+ rm -f $(HTML)
+ rm -f $(TEX)
+ rm -f pod2html-*cache
+ rm -f *.aux *.log *.exe
realclean: clean
- del /f $(CONVERTERS)
+ rm -f $(CONVERTERS)
distclean: realclean
check: checkpods
@echo "checking..."; \
- $(PERL) -I..\lib checkpods $(POD)
+ $(PERL) -I../lib checkpods $(POD)
# Dependencies.
-pod2latex: pod2latex.PL ..\lib\Config.pm
- $(PERL) -I..\lib pod2latex.PL
- $(PERL) $(PL2BAT) pod2latex
+pod2latex: pod2latex.PL ../lib/Config.pm
+ $(PERL) -I../lib pod2latex.PL
-pod2html: pod2html.PL ..\lib\Config.pm
- $(PERL) -I..\lib pod2html.PL
- $(PERL) $(PL2BAT) pod2html
+pod2html: pod2html.PL ../lib/Config.pm
+ $(PERL) -I ../lib pod2html.PL
-pod2man: pod2man.PL ..\lib\Config.pm
- $(PERL) -I..\lib pod2man.PL
- $(PERL) $(PL2BAT) pod2man
+pod2man: pod2man.PL ../lib/Config.pm
+ $(PERL) -I ../lib pod2man.PL
-pod2text: pod2text.PL ..\lib\Config.pm
- $(PERL) -I..\lib pod2text.PL
- $(PERL) $(PL2BAT) pod2text
+pod2text: pod2text.PL ../lib/Config.pm
+ $(PERL) -I ../lib pod2text.PL
-checkpods: checkpods.PL ..\lib\Config.pm
- $(PERL) -I..\lib checkpods.PL
- $(PERL) $(PL2BAT) checkpods
+checkpods: checkpods.PL ../lib/Config.pm
+ $(PERL) -I ../lib checkpods.PL
+compile: all
+ $(REALPERL) -I../lib ../utils/perlcc -regex 's/$$/.exe/' pod2latex pod2man pod2text checkpods -prog -verbose dcf -log ../compilelog;
+
diff --git a/gnu/usr.bin/perl/win32/runperl.c b/gnu/usr.bin/perl/win32/runperl.c
index 07e2bd6f835..8cf521d4ea5 100644
--- a/gnu/usr.bin/perl/win32/runperl.c
+++ b/gnu/usr.bin/perl/win32/runperl.c
@@ -1,18 +1,96 @@
-#include <stdio.h>
-#include <win32io.h>
+#include "EXTERN.h"
+#include "perl.h"
+
+#ifdef PERL_OBJECT
+
+#define NO_XSLOCKS
+#include "XSUB.H"
+#include "win32iop.h"
+
+#include <fcntl.h>
+#include "perlhost.h"
+
+
+char *staticlinkmodules[] = {
+ "DynaLoader",
+ NULL,
+};
+
+EXTERN_C void boot_DynaLoader _((CV* cv _CPERLarg));
+
+static void
+xs_init(CPERLarg)
+{
+ char *file = __FILE__;
+ dXSUB_SYS;
+ newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+}
+
+CPerlObj *pPerl;
+
+#undef PERL_SYS_INIT
+#define PERL_SYS_INIT(a, c)
+
+int
+main(int argc, char **argv, char **env)
+{
+ CPerlHost host;
+ int exitstatus = 1;
+#ifndef __BORLANDC__
+ /* XXX this _may_ be a problem on some compilers (e.g. Borland) that
+ * want to free() argv after main() returns. As luck would have it,
+ * Borland's CRT does the right thing to argv[0] already. */
+ char szModuleName[MAX_PATH];
+
+ GetModuleFileName(NULL, szModuleName, sizeof(szModuleName));
+ argv[0] = szModuleName;
+#endif
+
+ if (!host.PerlCreate())
+ exit(exitstatus);
+
+ exitstatus = host.PerlParse(xs_init, argc, argv, NULL);
+
+ if (!exitstatus)
+ exitstatus = host.PerlRun();
+
+ host.PerlDestroy();
+
+ return exitstatus;
+}
+
+#else /* PERL_OBJECT */
+
+#ifdef __GNUC__
+/*
+ * GNU C does not do __declspec()
+ */
+#define __declspec(foo)
+
+/* Mingw32 defaults to globing command line
+ * This is inconsistent with other Win32 ports and
+ * seems to cause trouble with passing -DXSVERSION=\"1.6\"
+ * So we turn it off like this:
+ */
+int _CRT_glob = 0;
-#ifndef _DLL
-extern WIN32_IOSUBSYSTEM win32stdio;
#endif
-extern int RunPerl(int argc, char **argv, char **env, void *iosubsystem);
+
+__declspec(dllimport) int RunPerl(int argc, char **argv, char **env, void *ios);
int
main(int argc, char **argv, char **env)
{
-#ifdef _DLL
- return (RunPerl(argc, argv, env, NULL));
-#else
- return (RunPerl(argc, argv, env, &win32stdio));
+#ifndef __BORLANDC__
+ /* XXX this _may_ be a problem on some compilers (e.g. Borland) that
+ * want to free() argv after main() returns. As luck would have it,
+ * Borland's CRT does the right thing to argv[0] already. */
+ char szModuleName[MAX_PATH];
+ GetModuleFileName(NULL, szModuleName, sizeof(szModuleName));
+ argv[0] = szModuleName;
#endif
+ return RunPerl(argc, argv, env, (void*)0);
}
+
+#endif /* PERL_OBJECT */
diff --git a/gnu/usr.bin/perl/win32/win32.c b/gnu/usr.bin/perl/win32/win32.c
index 7cbfae8a83d..7b9acd4a8f1 100644
--- a/gnu/usr.bin/perl/win32/win32.c
+++ b/gnu/usr.bin/perl/win32/win32.c
@@ -11,8 +11,23 @@
#define WIN32_LEAN_AND_MEAN
#define WIN32IO_IS_STDIO
#include <tchar.h>
+#ifdef __GNUC__
+#define Win32_Winsock
+#endif
#include <windows.h>
+#ifndef __MINGW32__
+#include <lmcons.h>
+#include <lmerr.h>
+/* ugliness to work around a buggy struct definition in lmwksta.h */
+#undef LPTSTR
+#define LPTSTR LPWSTR
+#include <lmwksta.h>
+#undef LPTSTR
+#define LPTSTR LPSTR
+#include <lmapibuf.h>
+#endif /* __MINGW32__ */
+
/* #include "config.h" */
#define PERLIO_NOT_STDIO 0
@@ -22,109 +37,288 @@
#include "EXTERN.h"
#include "perl.h"
+
+#include "patchlevel.h"
+
+#define NO_XSLOCKS
+#ifdef PERL_OBJECT
+extern CPerlObj* pPerl;
+#endif
#include "XSUB.h"
+
+#include "Win32iop.h"
#include <fcntl.h>
#include <sys/stat.h>
+#ifndef __GNUC__
+/* assert.h conflicts with #define of assert in perl.h */
#include <assert.h>
+#endif
#include <string.h>
#include <stdarg.h>
#include <float.h>
+#include <time.h>
+#if defined(_MSC_VER) || defined(__MINGW32__)
+#include <sys/utime.h>
+#else
+#include <utime.h>
+#endif
-#define CROAK croak
-#define WARN warn
+#ifdef __GNUC__
+/* Mingw32 defaults to globing command line
+ * So we turn it off like this:
+ */
+int _CRT_glob = 0;
+#endif
#define EXECF_EXEC 1
#define EXECF_SPAWN 2
#define EXECF_SPAWN_NOWAIT 3
-static DWORD IdOS(void);
-
-extern WIN32_IOSUBSYSTEM win32stdio;
-static PWIN32_IOSUBSYSTEM pIOSubSystem = &win32stdio;
-
-BOOL ProbeEnv = FALSE;
-DWORD Win32System = (DWORD)-1;
-char szShellPath[MAX_PATH+1];
-char szPerlLibRoot[MAX_PATH+1];
-HANDLE PerlDllHandle = INVALID_HANDLE_VALUE;
+#if defined(PERL_OBJECT)
+#undef win32_get_privlib
+#define win32_get_privlib g_win32_get_privlib
+#undef win32_get_sitelib
+#define win32_get_sitelib g_win32_get_sitelib
+#undef do_aspawn
+#define do_aspawn g_do_aspawn
+#undef do_spawn
+#define do_spawn g_do_spawn
+#undef do_exec
+#define do_exec g_do_exec
+#undef getlogin
+#define getlogin g_getlogin
+#endif
-static int do_spawn2(char *cmd, int exectype);
+static DWORD os_id(void);
+static void get_shell(void);
+static long tokenize(char *str, char **dest, char ***destv);
+ int do_spawn2(char *cmd, int exectype);
+static BOOL has_shell_metachars(char *ptr);
+static long filetime_to_clock(PFILETIME ft);
+static BOOL filetime_from_time(PFILETIME ft, time_t t);
+static char * get_emd_part(char *leading, char *trailing, ...);
+static void remove_dead_process(HANDLE deceased);
+
+HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
+static DWORD w32_platform = (DWORD)-1;
+
+#ifdef USE_THREADS
+# ifdef USE_DECLSPEC_THREAD
+__declspec(thread) char strerror_buffer[512];
+__declspec(thread) char getlogin_buffer[128];
+__declspec(thread) char w32_perllib_root[MAX_PATH+1];
+# ifdef HAVE_DES_FCRYPT
+__declspec(thread) char crypt_buffer[30];
+# endif
+# else
+# define strerror_buffer (thr->i.Wstrerror_buffer)
+# define getlogin_buffer (thr->i.Wgetlogin_buffer)
+# define w32_perllib_root (thr->i.Ww32_perllib_root)
+# define crypt_buffer (thr->i.Wcrypt_buffer)
+# endif
+#else
+static char strerror_buffer[512];
+static char getlogin_buffer[128];
+static char w32_perllib_root[MAX_PATH+1];
+# ifdef HAVE_DES_FCRYPT
+static char crypt_buffer[30];
+# endif
+#endif
int
IsWin95(void) {
- return (IdOS() == VER_PLATFORM_WIN32_WINDOWS);
+ return (os_id() == VER_PLATFORM_WIN32_WINDOWS);
}
int
IsWinNT(void) {
- return (IdOS() == VER_PLATFORM_WIN32_NT);
+ return (os_id() == VER_PLATFORM_WIN32_NT);
+}
+
+char*
+GetRegStrFromKey(HKEY hkey, const char *lpszValueName, char** ptr, DWORD* lpDataLen)
+{ /* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */
+ HKEY handle;
+ DWORD type;
+ const char *subkey = "Software\\Perl";
+ long retval;
+
+ retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
+ if (retval == ERROR_SUCCESS){
+ retval = RegQueryValueEx(handle, lpszValueName, 0, &type, NULL, lpDataLen);
+ if (retval == ERROR_SUCCESS && type == REG_SZ) {
+ if (*ptr) {
+ Renew(*ptr, *lpDataLen, char);
+ }
+ else {
+ New(1312, *ptr, *lpDataLen, char);
+ }
+ retval = RegQueryValueEx(handle, lpszValueName, 0, NULL, (PBYTE)*ptr, lpDataLen);
+ if (retval != ERROR_SUCCESS) {
+ Safefree(*ptr);
+ *ptr = Nullch;
+ }
+ }
+ RegCloseKey(handle);
+ }
+ return *ptr;
}
-DllExport PWIN32_IOSUBSYSTEM
-SetIOSubSystem(void *p)
+char*
+GetRegStr(const char *lpszValueName, char** ptr, DWORD* lpDataLen)
{
- PWIN32_IOSUBSYSTEM old = pIOSubSystem;
- if (p) {
- PWIN32_IOSUBSYSTEM pio = (PWIN32_IOSUBSYSTEM)p;
- if (pio->signature_begin == 12345678L
- && pio->signature_end == 87654321L) {
- pIOSubSystem = pio;
- }
- }
- else {
- pIOSubSystem = &win32stdio;
+ *ptr = GetRegStrFromKey(HKEY_CURRENT_USER, lpszValueName, ptr, lpDataLen);
+ if (*ptr == Nullch)
+ {
+ *ptr = GetRegStrFromKey(HKEY_LOCAL_MACHINE, lpszValueName, ptr, lpDataLen);
}
- return old;
+ return *ptr;
}
-DllExport PWIN32_IOSUBSYSTEM
-GetIOSubSystem(void)
+static char *
+get_emd_part(char *prev_path, char *trailing_path, ...)
{
- return pIOSubSystem;
+ char base[10];
+ va_list ap;
+ char mod_name[MAX_PATH+1];
+ char *ptr;
+ char *optr;
+ char *strip;
+ int oldsize, newsize;
+
+ va_start(ap, trailing_path);
+ strip = va_arg(ap, char *);
+
+ sprintf(base, "%5.3f", (double) 5 + ((double) PATCHLEVEL / (double) 1000));
+
+ GetModuleFileName((HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
+ ? GetModuleHandle(NULL) : w32_perldll_handle),
+ mod_name, sizeof(mod_name));
+ ptr = strrchr(mod_name, '\\');
+ while (ptr && strip) {
+ /* look for directories to skip back */
+ optr = ptr;
+ *ptr = '\0';
+ ptr = strrchr(mod_name, '\\');
+ if (!ptr || stricmp(ptr+1, strip) != 0) {
+ if(!(*strip == '5' && *(ptr+1) == '5' && strncmp(strip, base, 5) == 0
+ && strncmp(ptr+1, base, 5) == 0)) {
+ *optr = '\\';
+ ptr = optr;
+ }
+ }
+ strip = va_arg(ap, char *);
+ }
+ if (!ptr) {
+ ptr = mod_name;
+ *ptr++ = '.';
+ *ptr = '\\';
+ }
+ va_end(ap);
+ strcpy(++ptr, trailing_path);
+
+ /* only add directory if it exists */
+ if(GetFileAttributes(mod_name) != (DWORD) -1) {
+ /* directory exists */
+ newsize = strlen(mod_name) + 1;
+ if (prev_path) {
+ oldsize = strlen(prev_path) + 1;
+ newsize += oldsize; /* includes plus 1 for ';' */
+ Renew(prev_path, newsize, char);
+ prev_path[oldsize-1] = ';';
+ strcpy(&prev_path[oldsize], mod_name);
+ }
+ else {
+ New(1311, prev_path, newsize, char);
+ strcpy(prev_path, mod_name);
+ }
+ }
+
+ return prev_path;
}
char *
-win32PerlLibPath(void)
+win32_get_privlib(char *pl)
{
- char *end;
- GetModuleFileName((PerlDllHandle == INVALID_HANDLE_VALUE)
- ? GetModuleHandle(NULL)
- : PerlDllHandle,
- szPerlLibRoot,
- sizeof(szPerlLibRoot));
+ char *stdlib = "lib";
+ char buffer[MAX_PATH+1];
+ char *path = Nullch;
+ DWORD datalen;
+
+ /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */
+ sprintf(buffer, "%s-%s", stdlib, pl);
+ path = GetRegStr(buffer, &path, &datalen);
+ if (!path)
+ path = GetRegStr(stdlib, &path, &datalen);
- *(end = strrchr(szPerlLibRoot, '\\')) = '\0';
- if (stricmp(end-4,"\\bin") == 0)
- end -= 4;
- strcpy(end,"\\lib");
- return (szPerlLibRoot);
+ /* $stdlib .= ";$EMD/../../lib" */
+ return get_emd_part(path, stdlib, ARCHNAME, "bin", Nullch);
}
char *
-win32SiteLibPath(void)
+win32_get_sitelib(char *pl)
{
- static char szPerlSiteLib[MAX_PATH+1];
- strcpy(szPerlSiteLib, win32PerlLibPath());
- strcat(szPerlSiteLib, "\\site");
- return (szPerlSiteLib);
+ char *sitelib = "sitelib";
+ char regstr[40];
+ char pathstr[MAX_PATH+1];
+ DWORD datalen;
+ char *path1 = Nullch;
+ char *path2 = Nullch;
+ int len, newsize;
+
+ /* $HKCU{"sitelib-$]"} || $HKLM{"sitelib-$]"} . ---; */
+ sprintf(regstr, "%s-%s", sitelib, pl);
+ path1 = GetRegStr(regstr, &path1, &datalen);
+
+ /* $sitelib .=
+ * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/$]/lib"; */
+ sprintf(pathstr, "site\\%s\\lib", pl);
+ path1 = get_emd_part(path1, pathstr, ARCHNAME, "bin", pl, Nullch);
+
+ /* $HKCU{'sitelib'} || $HKLM{'sitelib'} . ---; */
+ path2 = GetRegStr(sitelib, &path2, &datalen);
+
+ /* $sitelib .=
+ * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/lib"; */
+ path2 = get_emd_part(path2, "site\\lib", ARCHNAME, "bin", pl, Nullch);
+
+ if (!path1)
+ return path2;
+
+ if (!path2)
+ return path1;
+
+ len = strlen(path1);
+ newsize = len + strlen(path2) + 2; /* plus one for ';' */
+
+ Renew(path1, newsize, char);
+ path1[len++] = ';';
+ strcpy(&path1[len], path2);
+
+ Safefree(path2);
+ return path1;
}
-BOOL
-HasRedirection(char *ptr)
+
+static BOOL
+has_shell_metachars(char *ptr)
{
int inquote = 0;
char quote = '\0';
/*
* Scan string looking for redirection (< or >) or pipe
- * characters (|) that are not in a quoted string
+ * characters (|) that are not in a quoted string.
+ * Shell variable interpolation (%VAR%) can also happen inside strings.
*/
- while(*ptr) {
+ while (*ptr) {
switch(*ptr) {
+ case '%':
+ return TRUE;
case '\'':
case '\"':
- if(inquote) {
- if(quote == *ptr) {
+ if (inquote) {
+ if (quote == *ptr) {
inquote = 0;
quote = '\0';
}
@@ -137,7 +331,7 @@ HasRedirection(char *ptr)
case '>':
case '<':
case '|':
- if(!inquote)
+ if (!inquote)
return TRUE;
default:
break;
@@ -147,6 +341,7 @@ HasRedirection(char *ptr)
return FALSE;
}
+#if !defined(PERL_OBJECT)
/* since the current process environment is being updated in util.c
* the library functions will get the correct environment
*/
@@ -168,156 +363,10 @@ my_popen(char *cmd, char *mode)
#else
#define fixcmd(x)
#endif
-
-#if 1
-/* was #ifndef PERLDLL, but the #else stuff doesn't work on NT
- * GSAR 97/03/13
- */
fixcmd(cmd);
-#ifdef __BORLANDC__ /* workaround a Borland stdio bug */
win32_fflush(stdout);
win32_fflush(stderr);
-#endif
return win32_popen(cmd, mode);
-#else
-/*
- * There seems to be some problems for the _popen call in a DLL
- * this trick at the moment seems to work but it is never test
- * on NT yet
- *
- */
-# ifdef __cplusplus
-#define EXT_C_FUNC extern "C"
-# else
-#define EXT_C_FUNC extern
-# endif
-
- EXT_C_FUNC int __cdecl _set_osfhnd(int fh, long value);
- EXT_C_FUNC void __cdecl _lock_fhandle(int);
- EXT_C_FUNC void __cdecl _unlock_fhandle(int);
-
- BOOL fSuccess;
- PerlIO *pf; /* to store the _popen return value */
- int tm = 0; /* flag indicating tDllExport or binary mode */
- int fhNeeded, fhInherited, fhDup;
- int ineeded, iinherited;
- DWORD dwDup;
- int phdls[2]; /* I/O handles for pipe */
- HANDLE hPIn, hPOut, hPErr,
- hSaveStdin, hSaveStdout, hSaveStderr,
- hPNeeded, hPInherited, hPDuped;
-
- /* first check for errors in the arguments */
- if ( (cmd == NULL) || (mode == NULL)
- || ((*mode != 'w') && (*mode != _T('r'))) )
- goto error1;
-
- if ( *(mode + 1) == _T('t') )
- tm = O_TEXT;
- else if ( *(mode + 1) == _T('b') )
- tm = O_BINARY;
- else
- tm = (*mode == 'w' ? O_BINARY : O_TEXT);
-
-
- fixcmd(cmd);
- if (&win32stdio != pIOSubSystem)
- return win32_popen(cmd, mode);
-
-#ifdef EFG
- if ( _pipe( phdls, 1024, tm ) == -1 )
-#else
- if ( win32_pipe( phdls, 1024, tm ) == -1 )
-#endif
- goto error1;
-
- /* save the current situation */
- hSaveStdin = GetStdHandle(STD_INPUT_HANDLE);
- hSaveStdout = GetStdHandle(STD_OUTPUT_HANDLE);
- hSaveStderr = GetStdHandle(STD_ERROR_HANDLE);
-
- if (*mode == _T('w')) {
- ineeded = 1;
- dwDup = STD_INPUT_HANDLE;
- iinherited = 0;
- }
- else {
- ineeded = 0;
- dwDup = STD_OUTPUT_HANDLE;
- iinherited = 1;
- }
-
- fhNeeded = phdls[ineeded];
- fhInherited = phdls[iinherited];
-
- fSuccess = DuplicateHandle(GetCurrentProcess(),
- (HANDLE) stolen_get_osfhandle(fhNeeded),
- GetCurrentProcess(),
- &hPNeeded,
- 0,
- FALSE, /* not inherited */
- DUPLICATE_SAME_ACCESS);
-
- if (!fSuccess)
- goto error2;
-
- fhDup = stolen_open_osfhandle((long) hPNeeded, tm);
- win32_dup2(fhDup, fhNeeded);
- win32_close(fhDup);
-
-#ifdef AAA
- /* Close the Out pipe, child won't need it */
- hPDuped = (HANDLE) stolen_get_osfhandle(fhNeeded);
-
- _lock_fhandle(fhNeeded);
- _set_osfhnd(fhNeeded, (long)hPNeeded); /* put in ours duplicated one */
- _unlock_fhandle(fhNeeded);
-
- CloseHandle(hPDuped); /* close the handle first */
-#endif
-
- if (!SetStdHandle(dwDup, (HANDLE) stolen_get_osfhandle(fhInherited)))
- goto error2;
-
- /*
- * make sure the child see the same stderr as the calling program
- */
- if (!SetStdHandle(STD_ERROR_HANDLE,
- (HANDLE)stolen_get_osfhandle(win32_fileno(win32_stderr()))))
- goto error2;
-
- pf = win32_popen(cmd, mode); /* ask _popen to do the job */
-
- /* restore to where we were */
- SetStdHandle(STD_INPUT_HANDLE, hSaveStdin);
- SetStdHandle(STD_OUTPUT_HANDLE, hSaveStdout);
- SetStdHandle(STD_ERROR_HANDLE, hSaveStderr);
-
- /* we don't need it any more, that's for the child */
- win32_close(fhInherited);
-
- if (NULL == pf) {
- /* something wrong */
- win32_close(fhNeeded);
- goto error1;
- }
- else {
- /*
- * here we steal the file handle in pf and stuff ours in
- */
- win32_dup2(fhNeeded, win32_fileno(pf));
- win32_close(fhNeeded);
- }
- return (pf);
-
-error2:
- win32_close(fhNeeded);
- win32_close(fhInherited);
-
-error1:
- return (NULL);
-
-#endif
}
long
@@ -325,26 +374,78 @@ my_pclose(PerlIO *fp)
{
return win32_pclose(fp);
}
+#endif
static DWORD
-IdOS(void)
+os_id(void)
{
static OSVERSIONINFO osver;
- if (osver.dwPlatformId != Win32System) {
+ if (osver.dwPlatformId != w32_platform) {
memset(&osver, 0, sizeof(OSVERSIONINFO));
osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
GetVersionEx(&osver);
- Win32System = osver.dwPlatformId;
+ w32_platform = osver.dwPlatformId;
}
- return (Win32System);
+ return (w32_platform);
}
-static char *
-GetShell(void)
+/* Tokenize a string. Words are null-separated, and the list
+ * ends with a doubled null. Any character (except null and
+ * including backslash) may be escaped by preceding it with a
+ * backslash (the backslash will be stripped).
+ * Returns number of words in result buffer.
+ */
+static long
+tokenize(char *str, char **dest, char ***destv)
+{
+ char *retstart = Nullch;
+ char **retvstart = 0;
+ int items = -1;
+ if (str) {
+ int slen = strlen(str);
+ register char *ret;
+ register char **retv;
+ New(1307, ret, slen+2, char);
+ New(1308, retv, (slen+3)/2, char*);
+
+ retstart = ret;
+ retvstart = retv;
+ *retv = ret;
+ items = 0;
+ while (*str) {
+ *ret = *str++;
+ if (*ret == '\\' && *str)
+ *ret = *str++;
+ else if (*ret == ' ') {
+ while (*str == ' ')
+ str++;
+ if (ret == retstart)
+ ret--;
+ else {
+ *ret = '\0';
+ ++items;
+ if (*str)
+ *++retv = ret+1;
+ }
+ }
+ else if (!*str)
+ ++items;
+ ret++;
+ }
+ retvstart[items] = Nullch;
+ *ret++ = '\0';
+ *ret = '\0';
+ }
+ *dest = retstart;
+ *destv = retvstart;
+ return items;
+}
+
+static void
+get_shell(void)
{
- if (!ProbeEnv) {
- char* defaultshell = (IsWinNT() ? "cmd.exe" : "command.com");
+ if (!w32_perlshell_tokens) {
/* we don't use COMSPEC here for two reasons:
* 1. the same reason perl on UNIX doesn't use SHELL--rampant and
* uncontrolled unportability of the ensuing scripts.
@@ -352,55 +453,75 @@ GetShell(void)
* interactive use (which is what most programs look in COMSPEC
* for).
*/
- char *usershell = getenv("PERL5SHELL");
-
- ProbeEnv = TRUE;
- strcpy(szShellPath, usershell ? usershell : defaultshell);
+ char* defaultshell = (IsWinNT() ? "cmd.exe /x/c" : "command.com /c");
+ char *usershell = getenv("PERL5SHELL");
+ w32_perlshell_items = tokenize(usershell ? usershell : defaultshell,
+ &w32_perlshell_tokens,
+ &w32_perlshell_vec);
}
- return szShellPath;
}
int
-do_aspawn(void* really, void** mark, void** arglast)
+do_aspawn(void *vreally, void **vmark, void **vsp)
{
+ SV *really = (SV*)vreally;
+ SV **mark = (SV**)vmark;
+ SV **sp = (SV**)vsp;
char **argv;
- char *strPtr;
- char *cmd;
+ char *str;
int status;
- unsigned int length;
+ int flag = P_WAIT;
int index = 0;
- SV *sv = (SV*)really;
- SV** pSv = (SV**)mark;
+ STRLEN n_a;
- New(1310, argv, (arglast - mark) + 4, char*);
+ if (sp <= mark)
+ return -1;
- if(sv != Nullsv) {
- cmd = SvPV(sv, length);
- }
- else {
- argv[index++] = cmd = GetShell();
- if (IsWinNT())
- argv[index++] = "/x"; /* always enable command extensions */
- argv[index++] = "/c";
+ get_shell();
+ New(1306, argv, (sp - mark) + w32_perlshell_items + 2, char*);
+
+ if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
+ ++mark;
+ flag = SvIVx(*mark);
}
- while(++pSv <= (SV**)arglast) {
- sv = *pSv;
- strPtr = SvPV(sv, length);
- if(strPtr != NULL && *strPtr != '\0')
- argv[index++] = strPtr;
+ while (++mark <= sp) {
+ if (*mark && (str = SvPV(*mark, n_a)))
+ argv[index++] = str;
+ else
+ argv[index++] = "";
}
argv[index++] = 0;
- status = win32_spawnvp(P_WAIT, cmd, (const char* const*)argv);
-
- Safefree(argv);
+ status = win32_spawnvp(flag,
+ (const char*)(really ? SvPV(really,n_a) : argv[0]),
+ (const char* const*)argv);
+
+ if (status < 0 && (errno == ENOEXEC || errno == ENOENT)) {
+ /* possible shell-builtin, invoke with shell */
+ int sh_items;
+ sh_items = w32_perlshell_items;
+ while (--index >= 0)
+ argv[index+sh_items] = argv[index];
+ while (--sh_items >= 0)
+ argv[sh_items] = w32_perlshell_vec[sh_items];
+
+ status = win32_spawnvp(flag,
+ (const char*)(really ? SvPV(really,n_a) : argv[0]),
+ (const char* const*)argv);
+ }
- if (status < 0) {
- if (dowarn)
- warn("Can't spawn \"%s\": %s", cmd, strerror(errno));
- status = 255 << 8;
+ if (flag != P_NOWAIT) {
+ if (status < 0) {
+ if (PL_dowarn)
+ warn("Can't spawn \"%s\": %s", argv[0], strerror(errno));
+ status = 255 * 256;
+ }
+ else
+ status *= 256;
+ PL_statusvalue = status;
}
+ Safefree(argv);
return (status);
}
@@ -412,13 +533,11 @@ do_spawn2(char *cmd, int exectype)
char **argv;
int status = -1;
BOOL needToTry = TRUE;
- char *shell, *cmd2;
-
- /* save an extra exec if possible */
- shell = GetShell();
+ char *cmd2;
- /* see if there are shell metacharacters in it */
- if(!HasRedirection(cmd)) {
+ /* Save an extra exec if possible. See if there are shell
+ * metacharacters in it */
+ if (!has_shell_metachars(cmd)) {
New(1301,argv, strlen(cmd) / 2 + 2, char*);
New(1302,cmd2, strlen(cmd) + 1, char);
strcpy(cmd2, cmd);
@@ -428,13 +547,13 @@ do_spawn2(char *cmd, int exectype)
s++;
if (*s)
*(a++) = s;
- while(*s && !isspace(*s))
+ while (*s && !isspace(*s))
s++;
- if(*s)
+ if (*s)
*s++ = '\0';
}
*a = Nullch;
- if(argv[0]) {
+ if (argv[0]) {
switch (exectype) {
case EXECF_SPAWN:
status = win32_spawnvp(P_WAIT, argv[0],
@@ -448,19 +567,21 @@ do_spawn2(char *cmd, int exectype)
status = win32_execvp(argv[0], (const char* const*)argv);
break;
}
- if(status != -1 || errno == 0)
+ if (status != -1 || errno == 0)
needToTry = FALSE;
}
Safefree(argv);
Safefree(cmd2);
}
- if(needToTry) {
- char *argv[5];
- int i = 0;
- argv[i++] = shell;
- if (IsWinNT())
- argv[i++] = "/x";
- argv[i++] = "/c"; argv[i++] = cmd; argv[i] = Nullch;
+ if (needToTry) {
+ char **argv;
+ int i = -1;
+ get_shell();
+ New(1306, argv, w32_perlshell_items + 2, char*);
+ while (++i < w32_perlshell_items)
+ argv[i] = w32_perlshell_vec[i];
+ argv[i++] = cmd;
+ argv[i] = Nullch;
switch (exectype) {
case EXECF_SPAWN:
status = win32_spawnvp(P_WAIT, argv[0],
@@ -474,14 +595,20 @@ do_spawn2(char *cmd, int exectype)
status = win32_execvp(argv[0], (const char* const*)argv);
break;
}
+ cmd = argv[0];
+ Safefree(argv);
}
- if (status < 0) {
- if (dowarn)
- warn("Can't %s \"%s\": %s",
- (exectype == EXECF_EXEC ? "exec" : "spawn"),
- needToTry ? shell : argv[0],
- strerror(errno));
- status = 255 << 8;
+ if (exectype != EXECF_SPAWN_NOWAIT) {
+ if (status < 0) {
+ if (PL_dowarn)
+ warn("Can't %s \"%s\": %s",
+ (exectype == EXECF_EXEC ? "exec" : "spawn"),
+ cmd, strerror(errno));
+ status = 255 * 256;
+ }
+ else
+ status *= 256;
+ PL_statusvalue = status;
}
return (status);
}
@@ -492,6 +619,12 @@ do_spawn(char *cmd)
return do_spawn2(cmd, EXECF_SPAWN);
}
+int
+do_spawn_nowait(char *cmd)
+{
+ return do_spawn2(cmd, EXECF_SPAWN_NOWAIT);
+}
+
bool
do_exec(char *cmd)
{
@@ -499,64 +632,48 @@ do_exec(char *cmd)
return FALSE;
}
-
-#define PATHLEN 1024
-
/* The idea here is to read all the directory names into a string table
* (separated by nulls) and when one of the other dir functions is called
* return the pointer to the current file name.
*/
DIR *
-opendir(char *filename)
-{
- DIR *p;
- long len;
- long idx;
- char scannamespc[PATHLEN];
- char *scanname = scannamespc;
- struct stat sbuf;
- WIN32_FIND_DATA FindData;
- HANDLE fh;
-/* char root[_MAX_PATH];*/
-/* char volname[_MAX_PATH];*/
-/* DWORD serial, maxname, flags;*/
-/* BOOL downcase;*/
-/* char *dummy;*/
+win32_opendir(char *filename)
+{
+ DIR *p;
+ long len;
+ long idx;
+ char scanname[MAX_PATH+3];
+ struct stat sbuf;
+ WIN32_FIND_DATA FindData;
+ HANDLE fh;
+
+ len = strlen(filename);
+ if (len > MAX_PATH)
+ return NULL;
/* check to see if filename is a directory */
- if (win32_stat(filename, &sbuf) < 0 || sbuf.st_mode & S_IFDIR == 0) {
+ if (win32_stat(filename, &sbuf) < 0 || !S_ISDIR(sbuf.st_mode))
return NULL;
- }
- /* get the file system characteristics */
-/* if(GetFullPathName(filename, MAX_PATH, root, &dummy)) {
- * if(dummy = strchr(root, '\\'))
- * *++dummy = '\0';
- * if(GetVolumeInformation(root, volname, MAX_PATH, &serial,
- * &maxname, &flags, 0, 0)) {
- * downcase = !(flags & FS_CASE_IS_PRESERVED);
- * }
- * }
- * else {
- * downcase = TRUE;
- * }
- */
/* Get us a DIR structure */
Newz(1303, p, 1, DIR);
- if(p == NULL)
+ if (p == NULL)
return NULL;
/* Create the search pattern */
strcpy(scanname, filename);
-
- if(index("/\\", *(scanname + strlen(scanname) - 1)) == NULL)
- strcat(scanname, "/*");
- else
- strcat(scanname, "*");
+ if (scanname[len-1] != '/' && scanname[len-1] != '\\')
+ scanname[len++] = '/';
+ scanname[len++] = '*';
+ scanname[len] = '\0';
/* do the FindFirstFile call */
fh = FindFirstFile(scanname, &FindData);
- if(fh == INVALID_HANDLE_VALUE) {
+ if (fh == INVALID_HANDLE_VALUE) {
+ /* FindFirstFile() fails on empty drives! */
+ if (GetLastError() == ERROR_FILE_NOT_FOUND)
+ return p;
+ Safefree( p);
return NULL;
}
@@ -565,13 +682,9 @@ opendir(char *filename)
*/
idx = strlen(FindData.cFileName)+1;
New(1304, p->start, idx, char);
- if(p->start == NULL) {
- CROAK("opendir: malloc failed!\n");
- }
+ if (p->start == NULL)
+ croak("opendir: malloc failed!\n");
strcpy(p->start, FindData.cFileName);
-/* if(downcase)
- * strlwr(p->start);
- */
p->nfiles++;
/* loop finding all the files that match the wildcard
@@ -585,20 +698,16 @@ opendir(char *filename)
* new name and it's null terminator
*/
Renew(p->start, idx+len+1, char);
- if(p->start == NULL) {
- CROAK("opendir: malloc failed!\n");
- }
+ if (p->start == NULL)
+ croak("opendir: malloc failed!\n");
strcpy(&p->start[idx], FindData.cFileName);
-/* if (downcase)
- * strlwr(&p->start[idx]);
- */
- p->nfiles++;
- idx += len+1;
- }
- FindClose(fh);
- p->size = idx;
- p->curr = p->start;
- return p;
+ p->nfiles++;
+ idx += len+1;
+ }
+ FindClose(fh);
+ p->size = idx;
+ p->curr = p->start;
+ return p;
}
@@ -606,7 +715,7 @@ opendir(char *filename)
* string pointer to the nDllExport entry.
*/
struct direct *
-readdir(DIR *dirp)
+win32_readdir(DIR *dirp)
{
int len;
static int dummy = 0;
@@ -634,7 +743,7 @@ readdir(DIR *dirp)
/* Telldir returns the current string pointer position */
long
-telldir(DIR *dirp)
+win32_telldir(DIR *dirp)
{
return (long) dirp->curr;
}
@@ -644,21 +753,21 @@ telldir(DIR *dirp)
*(Saved by telldir).
*/
void
-seekdir(DIR *dirp, long loc)
+win32_seekdir(DIR *dirp, long loc)
{
dirp->curr = (char *)loc;
}
/* Rewinddir resets the string pointer to the start */
void
-rewinddir(DIR *dirp)
+win32_rewinddir(DIR *dirp)
{
dirp->curr = dirp->start;
}
/* free the memory allocated by opendir */
int
-closedir(DIR *dirp)
+win32_closedir(DIR *dirp)
{
Safefree(dirp->start);
Safefree(dirp);
@@ -705,73 +814,90 @@ getegid(void)
}
int
-setuid(uid_t uid)
+setuid(uid_t auid)
{
- return (uid == ROOT_UID ? 0 : -1);
+ return (auid == ROOT_UID ? 0 : -1);
}
int
-setgid(gid_t gid)
+setgid(gid_t agid)
{
- return (gid == ROOT_GID ? 0 : -1);
+ return (agid == ROOT_GID ? 0 : -1);
+}
+
+char *
+getlogin(void)
+{
+ dTHR;
+ char *buf = getlogin_buffer;
+ DWORD size = sizeof(getlogin_buffer);
+ if (GetUserName(buf,&size))
+ return buf;
+ return (char*)NULL;
}
-/*
- * pretended kill
- */
int
-kill(int pid, int sig)
+chown(const char *path, uid_t owner, gid_t group)
{
+ /* XXX noop */
+ return 0;
+}
+
+static void
+remove_dead_process(HANDLE deceased)
+{
+#ifndef USE_RTL_WAIT
+ int child;
+ for (child = 0 ; child < w32_num_children ; ++child) {
+ if (w32_child_pids[child] == deceased) {
+ Copy(&w32_child_pids[child+1], &w32_child_pids[child],
+ (w32_num_children-child-1), HANDLE);
+ w32_num_children--;
+ break;
+ }
+ }
+#endif
+}
+
+DllExport int
+win32_kill(int pid, int sig)
+{
+#ifdef USE_RTL_WAIT
HANDLE hProcess= OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
+#else
+ HANDLE hProcess = (HANDLE) pid;
+#endif
if (hProcess == NULL) {
- CROAK("kill process failed!\n");
+ croak("kill process failed!\n");
}
else {
if (!TerminateProcess(hProcess, sig))
- CROAK("kill process failed!\n");
+ croak("kill process failed!\n");
CloseHandle(hProcess);
+
+ /* WaitForMultipleObjects() on a pid that was killed returns error
+ * so if we know the pid is gone we remove it from process list */
+ remove_dead_process(hProcess);
}
return 0;
}
-
+
/*
* File system stuff
*/
-#if 0
-int
-ioctl(int i, unsigned int u, char *data)
-{
- CROAK("ioctl not implemented!\n");
- return -1;
-}
-#endif
-
-unsigned int
-sleep(unsigned int t)
+DllExport unsigned int
+win32_sleep(unsigned int t)
{
Sleep(t*1000);
return 0;
}
-
-#undef rename
-
-int
-myrename(char *OldFileName, char *newname)
-{
- if(_access(newname, 0) != -1) { /* file exists */
- _unlink(newname);
- }
- return rename(OldFileName, newname);
-}
-
-
DllExport int
win32_stat(const char *path, struct stat *buffer)
{
- char t[MAX_PATH];
+ char t[MAX_PATH+1];
const char *p = path;
int l = strlen(path);
int res;
@@ -787,9 +913,32 @@ win32_stat(const char *path, struct stat *buffer)
};
}
}
- res = pIOSubSystem->pfnstat(p,buffer);
+ res = stat(p,buffer);
+ if (res < 0) {
+ /* CRT is buggy on sharenames, so make sure it really isn't.
+ * XXX using GetFileAttributesEx() will enable us to set
+ * buffer->st_*time (but note that's not available on the
+ * Windows of 1995) */
+ DWORD r = GetFileAttributes(p);
+ if (r != 0xffffffff && (r & FILE_ATTRIBUTE_DIRECTORY)) {
+ buffer->st_mode |= S_IFDIR | S_IREAD;
+ errno = 0;
+ if (!(r & FILE_ATTRIBUTE_READONLY))
+ buffer->st_mode |= S_IWRITE | S_IEXEC;
+ return 0;
+ }
+ }
+ else {
+ if (l == 3 && path[l-2] == ':'
+ && (path[l-1] == '\\' || path[l-1] == '/'))
+ {
+ /* The drive can be inaccessible, some _stat()s are buggy */
+ if (!GetVolumeInformation(path,NULL,0,NULL,NULL,NULL,NULL,0)) {
+ errno = ENOENT;
+ return -1;
+ }
+ }
#ifdef __BORLANDC__
- if (res == 0) {
if (S_ISDIR(buffer->st_mode))
buffer->st_mode |= S_IWRITE | S_IEXEC;
else if (S_ISREG(buffer->st_mode)) {
@@ -806,8 +955,8 @@ win32_stat(const char *path, struct stat *buffer)
else
buffer->st_mode &= ~S_IEXEC;
}
- }
#endif
+ }
return res;
}
@@ -816,46 +965,443 @@ win32_stat(const char *path, struct stat *buffer)
DllExport char *
win32_getenv(const char *name)
{
- static char *curitem = Nullch;
- static DWORD curlen = 512;
+ static char *curitem = Nullch; /* XXX threadead */
+ static DWORD curlen = 0; /* XXX threadead */
DWORD needlen;
- if (!curitem)
+ if (!curitem) {
+ curlen = 512;
New(1305,curitem,curlen,char);
- if (!(needlen = GetEnvironmentVariable(name,curitem,curlen)))
- return Nullch;
- while (needlen > curlen) {
- Renew(curitem,needlen,char);
- curlen = needlen;
- needlen = GetEnvironmentVariable(name,curitem,curlen);
}
+
+ needlen = GetEnvironmentVariable(name,curitem,curlen);
+ if (needlen != 0) {
+ while (needlen > curlen) {
+ Renew(curitem,needlen,char);
+ curlen = needlen;
+ needlen = GetEnvironmentVariable(name,curitem,curlen);
+ }
+ }
+ else {
+ /* allow any environment variables that begin with 'PERL'
+ to be stored in the registry */
+ if (curitem)
+ *curitem = '\0';
+
+ if (strncmp(name, "PERL", 4) == 0) {
+ if (curitem) {
+ Safefree(curitem);
+ curitem = Nullch;
+ curlen = 0;
+ }
+ curitem = GetRegStr(name, &curitem, &curlen);
+ }
+ }
+ if (curitem && *curitem == '\0')
+ return Nullch;
+
return curitem;
}
+DllExport int
+win32_putenv(const char *name)
+{
+ char* curitem;
+ char* val;
+ int relval = -1;
+ if(name) {
+ New(1309,curitem,strlen(name)+1,char);
+ strcpy(curitem, name);
+ val = strchr(curitem, '=');
+ if(val) {
+ /* The sane way to deal with the environment.
+ * Has these advantages over putenv() & co.:
+ * * enables us to store a truly empty value in the
+ * environment (like in UNIX).
+ * * we don't have to deal with RTL globals, bugs and leaks.
+ * * Much faster.
+ * Why you may want to enable USE_WIN32_RTL_ENV:
+ * * environ[] and RTL functions will not reflect changes,
+ * which might be an issue if extensions want to access
+ * the env. via RTL. This cuts both ways, since RTL will
+ * not see changes made by extensions that call the Win32
+ * functions directly, either.
+ * GSAR 97-06-07
+ */
+ *val++ = '\0';
+ if(SetEnvironmentVariable(curitem, *val ? val : NULL))
+ relval = 0;
+ }
+ Safefree(curitem);
+ }
+ return relval;
+}
+
#endif
-#undef times
-int
-mytimes(struct tms *timebuf)
+static long
+filetime_to_clock(PFILETIME ft)
{
- clock_t t = clock();
- timebuf->tms_utime = t;
- timebuf->tms_stime = 0;
- timebuf->tms_cutime = 0;
- timebuf->tms_cstime = 0;
+ __int64 qw = ft->dwHighDateTime;
+ qw <<= 32;
+ qw |= ft->dwLowDateTime;
+ qw /= 10000; /* File time ticks at 0.1uS, clock at 1mS */
+ return (long) qw;
+}
+DllExport int
+win32_times(struct tms *timebuf)
+{
+ FILETIME user;
+ FILETIME kernel;
+ FILETIME dummy;
+ if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy,
+ &kernel,&user)) {
+ timebuf->tms_utime = filetime_to_clock(&user);
+ timebuf->tms_stime = filetime_to_clock(&kernel);
+ timebuf->tms_cutime = 0;
+ timebuf->tms_cstime = 0;
+
+ } else {
+ /* That failed - e.g. Win95 fallback to clock() */
+ clock_t t = clock();
+ timebuf->tms_utime = t;
+ timebuf->tms_stime = 0;
+ timebuf->tms_cutime = 0;
+ timebuf->tms_cstime = 0;
+ }
return 0;
}
-#undef alarm
-unsigned int
-myalarm(unsigned int sec)
+/* fix utime() so it works on directories in NT
+ * thanks to Jan Dubois <jan.dubois@ibm.net>
+ */
+static BOOL
+filetime_from_time(PFILETIME pFileTime, time_t Time)
+{
+ struct tm *pTM = gmtime(&Time);
+ SYSTEMTIME SystemTime;
+
+ if (pTM == NULL)
+ return FALSE;
+
+ SystemTime.wYear = pTM->tm_year + 1900;
+ SystemTime.wMonth = pTM->tm_mon + 1;
+ SystemTime.wDay = pTM->tm_mday;
+ SystemTime.wHour = pTM->tm_hour;
+ SystemTime.wMinute = pTM->tm_min;
+ SystemTime.wSecond = pTM->tm_sec;
+ SystemTime.wMilliseconds = 0;
+
+ return SystemTimeToFileTime(&SystemTime, pFileTime);
+}
+
+DllExport int
+win32_utime(const char *filename, struct utimbuf *times)
+{
+ HANDLE handle;
+ FILETIME ftCreate;
+ FILETIME ftAccess;
+ FILETIME ftWrite;
+ struct utimbuf TimeBuffer;
+
+ int rc = utime(filename,times);
+ /* EACCES: path specifies directory or readonly file */
+ if (rc == 0 || errno != EACCES /* || !IsWinNT() */)
+ return rc;
+
+ if (times == NULL) {
+ times = &TimeBuffer;
+ time(&times->actime);
+ times->modtime = times->actime;
+ }
+
+ /* This will (and should) still fail on readonly files */
+ handle = CreateFile(filename, GENERIC_READ | GENERIC_WRITE,
+ FILE_SHARE_READ | FILE_SHARE_DELETE, NULL,
+ OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ if (handle == INVALID_HANDLE_VALUE)
+ return rc;
+
+ if (GetFileTime(handle, &ftCreate, &ftAccess, &ftWrite) &&
+ filetime_from_time(&ftAccess, times->actime) &&
+ filetime_from_time(&ftWrite, times->modtime) &&
+ SetFileTime(handle, &ftCreate, &ftAccess, &ftWrite))
+ {
+ rc = 0;
+ }
+
+ CloseHandle(handle);
+ return rc;
+}
+
+DllExport int
+win32_waitpid(int pid, int *status, int flags)
+{
+ int rc;
+ if (pid == -1)
+ return win32_wait(status);
+ else {
+ rc = cwait(status, pid, WAIT_CHILD);
+ /* cwait() returns "correctly" on Borland */
+#ifndef __BORLANDC__
+ if (status)
+ *status *= 256;
+#endif
+ remove_dead_process((HANDLE)pid);
+ }
+ return rc >= 0 ? pid : rc;
+}
+
+DllExport int
+win32_wait(int *status)
{
- /* we warn the usuage of alarm function */
- if (sec != 0)
- WARN("dummy function alarm called, program might not function as expected\n");
+#ifdef USE_RTL_WAIT
+ return wait(status);
+#else
+ /* XXX this wait emulation only knows about processes
+ * spawned via win32_spawnvp(P_NOWAIT, ...).
+ */
+ int i, retval;
+ DWORD exitcode, waitcode;
+
+ if (!w32_num_children) {
+ errno = ECHILD;
+ return -1;
+ }
+
+ /* if a child exists, wait for it to die */
+ waitcode = WaitForMultipleObjects(w32_num_children,
+ w32_child_pids,
+ FALSE,
+ INFINITE);
+ if (waitcode != WAIT_FAILED) {
+ if (waitcode >= WAIT_ABANDONED_0
+ && waitcode < WAIT_ABANDONED_0 + w32_num_children)
+ i = waitcode - WAIT_ABANDONED_0;
+ else
+ i = waitcode - WAIT_OBJECT_0;
+ if (GetExitCodeProcess(w32_child_pids[i], &exitcode) ) {
+ CloseHandle(w32_child_pids[i]);
+ *status = (int)((exitcode & 0xff) << 8);
+ retval = (int)w32_child_pids[i];
+ Copy(&w32_child_pids[i+1], &w32_child_pids[i],
+ (w32_num_children-i-1), HANDLE);
+ w32_num_children--;
+ return retval;
+ }
+ }
+
+FAILED:
+ errno = GetLastError();
+ return -1;
+
+#endif
+}
+
+static UINT timerid = 0;
+
+static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time)
+{
+ KillTimer(NULL,timerid);
+ timerid=0;
+ sighandler(14);
+}
+
+DllExport unsigned int
+win32_alarm(unsigned int sec)
+{
+ /*
+ * the 'obvious' implentation is SetTimer() with a callback
+ * which does whatever receiving SIGALRM would do
+ * we cannot use SIGALRM even via raise() as it is not
+ * one of the supported codes in <signal.h>
+ *
+ * Snag is unless something is looking at the message queue
+ * nothing happens :-(
+ */
+ if (sec)
+ {
+ timerid = SetTimer(NULL,timerid,sec*1000,(TIMERPROC)TimerProc);
+ if (!timerid)
+ croak("Cannot set timer");
+ }
+ else
+ {
+ if (timerid)
+ {
+ KillTimer(NULL,timerid);
+ timerid=0;
+ }
+ }
return 0;
}
+#if defined(HAVE_DES_FCRYPT) || defined(PERL_OBJECT)
+#ifdef HAVE_DES_FCRYPT
+extern char * des_fcrypt(const char *txt, const char *salt, char *cbuf);
+#endif
+
+DllExport char *
+win32_crypt(const char *txt, const char *salt)
+{
+#ifdef HAVE_DES_FCRYPT
+ dTHR;
+ return des_fcrypt(txt, salt, crypt_buffer);
+#else
+ die("The crypt() function is unimplemented due to excessive paranoia.");
+ return Nullch;
+#endif
+}
+#endif
+
+#ifdef USE_FIXED_OSFHANDLE
+
+EXTERN_C int __cdecl _alloc_osfhnd(void);
+EXTERN_C int __cdecl _set_osfhnd(int fh, long value);
+EXTERN_C void __cdecl _lock_fhandle(int);
+EXTERN_C void __cdecl _unlock_fhandle(int);
+EXTERN_C void __cdecl _unlock(int);
+
+#if (_MSC_VER >= 1000)
+typedef struct {
+ long osfhnd; /* underlying OS file HANDLE */
+ char osfile; /* attributes of file (e.g., open in text mode?) */
+ char pipech; /* one char buffer for handles opened on pipes */
+#if defined (_MT) && !defined (DLL_FOR_WIN32S)
+ int lockinitflag;
+ CRITICAL_SECTION lock;
+#endif /* defined (_MT) && !defined (DLL_FOR_WIN32S) */
+} ioinfo;
+
+EXTERN_C ioinfo * __pioinfo[];
+
+#define IOINFO_L2E 5
+#define IOINFO_ARRAY_ELTS (1 << IOINFO_L2E)
+#define _pioinfo(i) (__pioinfo[i >> IOINFO_L2E] + (i & (IOINFO_ARRAY_ELTS - 1)))
+#define _osfile(i) (_pioinfo(i)->osfile)
+
+#else /* (_MSC_VER >= 1000) */
+extern char _osfile[];
+#endif /* (_MSC_VER >= 1000) */
+
+#define FOPEN 0x01 /* file handle open */
+#define FAPPEND 0x20 /* file handle opened O_APPEND */
+#define FDEV 0x40 /* file handle refers to device */
+#define FTEXT 0x80 /* file handle is in text mode */
+
+#define _STREAM_LOCKS 26 /* Table of stream locks */
+#define _LAST_STREAM_LOCK (_STREAM_LOCKS+_NSTREAM_-1) /* Last stream lock */
+#define _FH_LOCKS (_LAST_STREAM_LOCK+1) /* Table of fh locks */
+
+/***
+*int my_open_osfhandle(long osfhandle, int flags) - open C Runtime file handle
+*
+*Purpose:
+* This function allocates a free C Runtime file handle and associates
+* it with the Win32 HANDLE specified by the first parameter. This is a
+* temperary fix for WIN95's brain damage GetFileType() error on socket
+* we just bypass that call for socket
+*
+*Entry:
+* long osfhandle - Win32 HANDLE to associate with C Runtime file handle.
+* int flags - flags to associate with C Runtime file handle.
+*
+*Exit:
+* returns index of entry in fh, if successful
+* return -1, if no free entry is found
+*
+*Exceptions:
+*
+*******************************************************************************/
+
+static int
+my_open_osfhandle(long osfhandle, int flags)
+{
+ int fh;
+ char fileflags; /* _osfile flags */
+
+ /* copy relevant flags from second parameter */
+ fileflags = FDEV;
+
+ if (flags & O_APPEND)
+ fileflags |= FAPPEND;
+
+ if (flags & O_TEXT)
+ fileflags |= FTEXT;
+
+ /* attempt to allocate a C Runtime file handle */
+ if ((fh = _alloc_osfhnd()) == -1) {
+ errno = EMFILE; /* too many open files */
+ _doserrno = 0L; /* not an OS error */
+ return -1; /* return error to caller */
+ }
+
+ /* the file is open. now, set the info in _osfhnd array */
+ _set_osfhnd(fh, osfhandle);
+
+ fileflags |= FOPEN; /* mark as open */
+
+#if (_MSC_VER >= 1000)
+ _osfile(fh) = fileflags; /* set osfile entry */
+ _unlock_fhandle(fh);
+#else
+ _osfile[fh] = fileflags; /* set osfile entry */
+ _unlock(fh+_FH_LOCKS); /* unlock handle */
+#endif
+
+ return fh; /* return handle */
+}
+
+#define _open_osfhandle my_open_osfhandle
+#endif /* USE_FIXED_OSFHANDLE */
+
+/* simulate flock by locking a range on the file */
+
+#define LK_ERR(f,i) ((f) ? (i = 0) : (errno = GetLastError()))
+#define LK_LEN 0xffff0000
+
+DllExport int
+win32_flock(int fd, int oper)
+{
+ OVERLAPPED o;
+ int i = -1;
+ HANDLE fh;
+
+ if (!IsWinNT()) {
+ croak("flock() unimplemented on this platform");
+ return -1;
+ }
+ fh = (HANDLE)_get_osfhandle(fd);
+ memset(&o, 0, sizeof(o));
+
+ switch(oper) {
+ case LOCK_SH: /* shared lock */
+ LK_ERR(LockFileEx(fh, 0, 0, LK_LEN, 0, &o),i);
+ break;
+ case LOCK_EX: /* exclusive lock */
+ LK_ERR(LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK, 0, LK_LEN, 0, &o),i);
+ break;
+ case LOCK_SH|LOCK_NB: /* non-blocking shared lock */
+ LK_ERR(LockFileEx(fh, LOCKFILE_FAIL_IMMEDIATELY, 0, LK_LEN, 0, &o),i);
+ break;
+ case LOCK_EX|LOCK_NB: /* non-blocking exclusive lock */
+ LK_ERR(LockFileEx(fh,
+ LOCKFILE_EXCLUSIVE_LOCK|LOCKFILE_FAIL_IMMEDIATELY,
+ 0, LK_LEN, 0, &o),i);
+ break;
+ case LOCK_UN: /* unlock lock */
+ LK_ERR(UnlockFileEx(fh, 0, LK_LEN, 0, &o),i);
+ break;
+ default: /* unknown */
+ errno = EINVAL;
+ break;
+ }
+ return i;
+}
+
+#undef LK_ERR
+#undef LK_LEN
+
/*
* redirected io subsystem for all XS modules
*
@@ -864,45 +1410,45 @@ myalarm(unsigned int sec)
DllExport int *
win32_errno(void)
{
- return (pIOSubSystem->pfnerrno());
+ return (&errno);
}
DllExport char ***
win32_environ(void)
{
- return (pIOSubSystem->pfnenviron());
+ return (&(_environ));
}
/* the rest are the remapped stdio routines */
DllExport FILE *
win32_stderr(void)
{
- return (pIOSubSystem->pfnstderr());
+ return (stderr);
}
DllExport FILE *
win32_stdin(void)
{
- return (pIOSubSystem->pfnstdin());
+ return (stdin);
}
DllExport FILE *
win32_stdout()
{
- return (pIOSubSystem->pfnstdout());
+ return (stdout);
}
DllExport int
win32_ferror(FILE *fp)
{
- return (pIOSubSystem->pfnferror(fp));
+ return (ferror(fp));
}
DllExport int
win32_feof(FILE *fp)
{
- return (pIOSubSystem->pfnfeof(fp));
+ return (feof(fp));
}
/*
@@ -911,8 +1457,6 @@ win32_feof(FILE *fp)
* we have to roll our own.
*/
-__declspec(thread) char strerror_buffer[512];
-
DllExport char *
win32_strerror(int e)
{
@@ -921,26 +1465,54 @@ win32_strerror(int e)
#endif
DWORD source = 0;
- if(e < 0 || e > sys_nerr) {
- if(e < 0)
+ if (e < 0 || e > sys_nerr) {
+ dTHR;
+ if (e < 0)
e = GetLastError();
- if(FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0,
+ if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0,
strerror_buffer, sizeof(strerror_buffer), NULL) == 0)
strcpy(strerror_buffer, "Unknown Error");
return strerror_buffer;
}
- return pIOSubSystem->pfnstrerror(e);
+ return strerror(e);
+}
+
+DllExport void
+win32_str_os_error(void *sv, DWORD dwErr)
+{
+ DWORD dwLen;
+ char *sMsg;
+ dwLen = FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER
+ |FORMAT_MESSAGE_IGNORE_INSERTS
+ |FORMAT_MESSAGE_FROM_SYSTEM, NULL,
+ dwErr, 0, (char *)&sMsg, 1, NULL);
+ if (0 < dwLen) {
+ while (0 < dwLen && isspace(sMsg[--dwLen]))
+ ;
+ if ('.' != sMsg[dwLen])
+ dwLen++;
+ sMsg[dwLen]= '\0';
+ }
+ if (0 == dwLen) {
+ sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
+ dwLen = sprintf(sMsg,
+ "Unknown error #0x%lX (lookup 0x%lX)",
+ dwErr, GetLastError());
+ }
+ sv_setpvn((SV*)sv, sMsg, dwLen);
+ LocalFree(sMsg);
}
+
DllExport int
win32_fprintf(FILE *fp, const char *format, ...)
{
va_list marker;
va_start(marker, format); /* Initialize variable arguments. */
- return (pIOSubSystem->pfnvfprintf(fp, format, marker));
+ return (vfprintf(fp, format, marker));
}
DllExport int
@@ -949,188 +1521,409 @@ win32_printf(const char *format, ...)
va_list marker;
va_start(marker, format); /* Initialize variable arguments. */
- return (pIOSubSystem->pfnvprintf(format, marker));
+ return (vprintf(format, marker));
}
DllExport int
win32_vfprintf(FILE *fp, const char *format, va_list args)
{
- return (pIOSubSystem->pfnvfprintf(fp, format, args));
+ return (vfprintf(fp, format, args));
}
DllExport int
win32_vprintf(const char *format, va_list args)
{
- return (pIOSubSystem->pfnvprintf(format, args));
+ return (vprintf(format, args));
}
DllExport size_t
win32_fread(void *buf, size_t size, size_t count, FILE *fp)
{
- return pIOSubSystem->pfnfread(buf, size, count, fp);
+ return fread(buf, size, count, fp);
}
DllExport size_t
win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp)
{
- return pIOSubSystem->pfnfwrite(buf, size, count, fp);
+ return fwrite(buf, size, count, fp);
}
DllExport FILE *
win32_fopen(const char *filename, const char *mode)
{
if (stricmp(filename, "/dev/null")==0)
- return pIOSubSystem->pfnfopen("NUL", mode);
- return pIOSubSystem->pfnfopen(filename, mode);
+ return fopen("NUL", mode);
+ return fopen(filename, mode);
}
+#ifndef USE_SOCKETS_AS_HANDLES
+#undef fdopen
+#define fdopen my_fdopen
+#endif
+
DllExport FILE *
win32_fdopen( int handle, const char *mode)
{
- return pIOSubSystem->pfnfdopen(handle, mode);
+ return fdopen(handle, (char *) mode);
}
DllExport FILE *
win32_freopen( const char *path, const char *mode, FILE *stream)
{
if (stricmp(path, "/dev/null")==0)
- return pIOSubSystem->pfnfreopen("NUL", mode, stream);
- return pIOSubSystem->pfnfreopen(path, mode, stream);
+ return freopen("NUL", mode, stream);
+ return freopen(path, mode, stream);
}
DllExport int
win32_fclose(FILE *pf)
{
- return pIOSubSystem->pfnfclose(pf);
+ return my_fclose(pf); /* defined in win32sck.c */
}
DllExport int
win32_fputs(const char *s,FILE *pf)
{
- return pIOSubSystem->pfnfputs(s, pf);
+ return fputs(s, pf);
}
DllExport int
win32_fputc(int c,FILE *pf)
{
- return pIOSubSystem->pfnfputc(c,pf);
+ return fputc(c,pf);
}
DllExport int
win32_ungetc(int c,FILE *pf)
{
- return pIOSubSystem->pfnungetc(c,pf);
+ return ungetc(c,pf);
}
DllExport int
win32_getc(FILE *pf)
{
- return pIOSubSystem->pfngetc(pf);
+ return getc(pf);
}
DllExport int
win32_fileno(FILE *pf)
{
- return pIOSubSystem->pfnfileno(pf);
+ return fileno(pf);
}
DllExport void
win32_clearerr(FILE *pf)
{
- pIOSubSystem->pfnclearerr(pf);
+ clearerr(pf);
return;
}
DllExport int
win32_fflush(FILE *pf)
{
- return pIOSubSystem->pfnfflush(pf);
+ return fflush(pf);
}
DllExport long
win32_ftell(FILE *pf)
{
- return pIOSubSystem->pfnftell(pf);
+ return ftell(pf);
}
DllExport int
win32_fseek(FILE *pf,long offset,int origin)
{
- return pIOSubSystem->pfnfseek(pf, offset, origin);
+ return fseek(pf, offset, origin);
}
DllExport int
win32_fgetpos(FILE *pf,fpos_t *p)
{
- return pIOSubSystem->pfnfgetpos(pf, p);
+ return fgetpos(pf, p);
}
DllExport int
win32_fsetpos(FILE *pf,const fpos_t *p)
{
- return pIOSubSystem->pfnfsetpos(pf, p);
+ return fsetpos(pf, p);
}
DllExport void
win32_rewind(FILE *pf)
{
- pIOSubSystem->pfnrewind(pf);
+ rewind(pf);
return;
}
DllExport FILE*
win32_tmpfile(void)
{
- return pIOSubSystem->pfntmpfile();
+ return tmpfile();
}
DllExport void
win32_abort(void)
{
- pIOSubSystem->pfnabort();
+ abort();
return;
}
DllExport int
-win32_fstat(int fd,struct stat *bufptr)
+win32_fstat(int fd,struct stat *sbufptr)
{
- return pIOSubSystem->pfnfstat(fd,bufptr);
+ return fstat(fd,sbufptr);
}
DllExport int
win32_pipe(int *pfd, unsigned int size, int mode)
{
- return pIOSubSystem->pfnpipe(pfd, size, mode);
+ return _pipe(pfd, size, mode);
}
+/*
+ * a popen() clone that respects PERL5SHELL
+ */
+
DllExport FILE*
win32_popen(const char *command, const char *mode)
{
- return pIOSubSystem->pfnpopen(command, mode);
+#ifdef USE_RTL_POPEN
+ return _popen(command, mode);
+#else
+ int p[2];
+ int parent, child;
+ int stdfd, oldfd;
+ int ourmode;
+ int childpid;
+
+ /* establish which ends read and write */
+ if (strchr(mode,'w')) {
+ stdfd = 0; /* stdin */
+ parent = 1;
+ child = 0;
+ }
+ else if (strchr(mode,'r')) {
+ stdfd = 1; /* stdout */
+ parent = 0;
+ child = 1;
+ }
+ else
+ return NULL;
+
+ /* set the correct mode */
+ if (strchr(mode,'b'))
+ ourmode = O_BINARY;
+ else if (strchr(mode,'t'))
+ ourmode = O_TEXT;
+ else
+ ourmode = _fmode & (O_TEXT | O_BINARY);
+
+ /* the child doesn't inherit handles */
+ ourmode |= O_NOINHERIT;
+
+ if (win32_pipe( p, 512, ourmode) == -1)
+ return NULL;
+
+ /* save current stdfd */
+ if ((oldfd = win32_dup(stdfd)) == -1)
+ goto cleanup;
+
+ /* make stdfd go to child end of pipe (implicitly closes stdfd) */
+ /* stdfd will be inherited by the child */
+ if (win32_dup2(p[child], stdfd) == -1)
+ goto cleanup;
+
+ /* close the child end in parent */
+ win32_close(p[child]);
+
+ /* start the child */
+ if ((childpid = do_spawn_nowait((char*)command)) == -1)
+ goto cleanup;
+
+ /* revert stdfd to whatever it was before */
+ if (win32_dup2(oldfd, stdfd) == -1)
+ goto cleanup;
+
+ /* close saved handle */
+ win32_close(oldfd);
+
+ sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
+
+ /* we have an fd, return a file stream */
+ return (win32_fdopen(p[parent], (char *)mode));
+
+cleanup:
+ /* we don't need to check for errors here */
+ win32_close(p[0]);
+ win32_close(p[1]);
+ if (oldfd != -1) {
+ win32_dup2(oldfd, stdfd);
+ win32_close(oldfd);
+ }
+ return (NULL);
+
+#endif /* USE_RTL_POPEN */
}
+/*
+ * pclose() clone
+ */
+
DllExport int
win32_pclose(FILE *pf)
{
- return pIOSubSystem->pfnpclose(pf);
+#ifdef USE_RTL_POPEN
+ return _pclose(pf);
+#else
+
+ int childpid, status;
+ SV *sv;
+
+ sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE);
+ if (SvIOK(sv))
+ childpid = SvIVX(sv);
+ else
+ childpid = 0;
+
+ if (!childpid) {
+ errno = EBADF;
+ return -1;
+ }
+
+ win32_fclose(pf);
+ SvIVX(sv) = 0;
+
+ remove_dead_process((HANDLE)childpid);
+
+ /* wait for the child */
+ if (cwait(&status, childpid, WAIT_CHILD) == -1)
+ return (-1);
+ /* cwait() returns "correctly" on Borland */
+#ifndef __BORLANDC__
+ status *= 256;
+#endif
+ return (status);
+
+#endif /* USE_RTL_POPEN */
+}
+
+DllExport int
+win32_rename(const char *oname, const char *newname)
+{
+ /* XXX despite what the documentation says about MoveFileEx(),
+ * it doesn't work under Windows95!
+ */
+ if (IsWinNT()) {
+ if (!MoveFileEx(oname,newname,
+ MOVEFILE_COPY_ALLOWED|MOVEFILE_REPLACE_EXISTING)) {
+ DWORD err = GetLastError();
+ switch (err) {
+ case ERROR_BAD_NET_NAME:
+ case ERROR_BAD_NETPATH:
+ case ERROR_BAD_PATHNAME:
+ case ERROR_FILE_NOT_FOUND:
+ case ERROR_FILENAME_EXCED_RANGE:
+ case ERROR_INVALID_DRIVE:
+ case ERROR_NO_MORE_FILES:
+ case ERROR_PATH_NOT_FOUND:
+ errno = ENOENT;
+ break;
+ default:
+ errno = EACCES;
+ break;
+ }
+ return -1;
+ }
+ return 0;
+ }
+ else {
+ int retval = 0;
+ char tmpname[MAX_PATH+1];
+ char dname[MAX_PATH+1];
+ char *endname = Nullch;
+ STRLEN tmplen = 0;
+ DWORD from_attr, to_attr;
+
+ /* if oname doesn't exist, do nothing */
+ from_attr = GetFileAttributes(oname);
+ if (from_attr == 0xFFFFFFFF) {
+ errno = ENOENT;
+ return -1;
+ }
+
+ /* if newname exists, rename it to a temporary name so that we
+ * don't delete it in case oname happens to be the same file
+ * (but perhaps accessed via a different path)
+ */
+ to_attr = GetFileAttributes(newname);
+ if (to_attr != 0xFFFFFFFF) {
+ /* if newname is a directory, we fail
+ * XXX could overcome this with yet more convoluted logic */
+ if (to_attr & FILE_ATTRIBUTE_DIRECTORY) {
+ errno = EACCES;
+ return -1;
+ }
+ tmplen = strlen(newname);
+ strcpy(tmpname,newname);
+ endname = tmpname+tmplen;
+ for (; endname > tmpname ; --endname) {
+ if (*endname == '/' || *endname == '\\') {
+ *endname = '\0';
+ break;
+ }
+ }
+ if (endname > tmpname)
+ endname = strcpy(dname,tmpname);
+ else
+ endname = ".";
+
+ /* get a temporary filename in same directory
+ * XXX is this really the best we can do? */
+ if (!GetTempFileName((LPCTSTR)endname, "plr", 0, tmpname)) {
+ errno = ENOENT;
+ return -1;
+ }
+ DeleteFile(tmpname);
+
+ retval = rename(newname, tmpname);
+ if (retval != 0) {
+ errno = EACCES;
+ return retval;
+ }
+ }
+
+ /* rename oname to newname */
+ retval = rename(oname, newname);
+
+ /* if we created a temporary file before ... */
+ if (endname != Nullch) {
+ /* ...and rename succeeded, delete temporary file/directory */
+ if (retval == 0)
+ DeleteFile(tmpname);
+ /* else restore it to what it was */
+ else
+ (void)rename(tmpname, newname);
+ }
+ return retval;
+ }
}
DllExport int
win32_setmode(int fd, int mode)
{
- return pIOSubSystem->pfnsetmode(fd, mode);
+ return setmode(fd, mode);
}
DllExport long
win32_lseek(int fd, long offset, int origin)
{
- return pIOSubSystem->pfnlseek(fd, offset, origin);
+ return lseek(fd, offset, origin);
}
DllExport long
win32_tell(int fd)
{
- return pIOSubSystem->pfntell(fd);
+ return tell(fd);
}
DllExport int
@@ -1144,198 +1937,290 @@ win32_open(const char *path, int flag, ...)
va_end(ap);
if (stricmp(path, "/dev/null")==0)
- return pIOSubSystem->pfnopen("NUL", flag, pmode);
- return pIOSubSystem->pfnopen(path,flag,pmode);
+ return open("NUL", flag, pmode);
+ return open(path,flag,pmode);
}
DllExport int
win32_close(int fd)
{
- return pIOSubSystem->pfnclose(fd);
+ return close(fd);
}
DllExport int
win32_eof(int fd)
{
- return pIOSubSystem->pfneof(fd);
+ return eof(fd);
}
DllExport int
win32_dup(int fd)
{
- return pIOSubSystem->pfndup(fd);
+ return dup(fd);
}
DllExport int
win32_dup2(int fd1,int fd2)
{
- return pIOSubSystem->pfndup2(fd1,fd2);
+ return dup2(fd1,fd2);
}
DllExport int
win32_read(int fd, void *buf, unsigned int cnt)
{
- return pIOSubSystem->pfnread(fd, buf, cnt);
+ return read(fd, buf, cnt);
}
DllExport int
win32_write(int fd, const void *buf, unsigned int cnt)
{
- return pIOSubSystem->pfnwrite(fd, buf, cnt);
+ return write(fd, buf, cnt);
}
DllExport int
win32_mkdir(const char *dir, int mode)
{
- return pIOSubSystem->pfnmkdir(dir); /* just ignore mode */
+ return mkdir(dir); /* just ignore mode */
}
DllExport int
win32_rmdir(const char *dir)
{
- return pIOSubSystem->pfnrmdir(dir);
+ return rmdir(dir);
}
DllExport int
win32_chdir(const char *dir)
{
- return pIOSubSystem->pfnchdir(dir);
+ return chdir(dir);
}
DllExport int
win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
{
- return pIOSubSystem->pfnspawnvp(mode, cmdname, argv);
+ int status;
+
+#ifndef USE_RTL_WAIT
+ if (mode == P_NOWAIT && w32_num_children >= MAXIMUM_WAIT_OBJECTS)
+ return -1;
+#endif
+
+ status = spawnvp(mode, cmdname, (char * const *) argv);
+#ifndef USE_RTL_WAIT
+ /* XXX For the P_NOWAIT case, Borland RTL returns pinfo.dwProcessId
+ * while VC RTL returns pinfo.hProcess. For purposes of the custom
+ * implementation of win32_wait(), we assume the latter.
+ */
+ if (mode == P_NOWAIT && status >= 0)
+ w32_child_pids[w32_num_children++] = (HANDLE)status;
+#endif
+ return status;
+}
+
+DllExport int
+win32_execv(const char *cmdname, const char *const *argv)
+{
+ return execv(cmdname, (char *const *)argv);
}
DllExport int
win32_execvp(const char *cmdname, const char *const *argv)
{
- return pIOSubSystem->pfnexecvp(cmdname, argv);
+ return execvp(cmdname, (char *const *)argv);
}
DllExport void
win32_perror(const char *str)
{
- pIOSubSystem->pfnperror(str);
+ perror(str);
}
DllExport void
win32_setbuf(FILE *pf, char *buf)
{
- pIOSubSystem->pfnsetbuf(pf, buf);
+ setbuf(pf, buf);
}
DllExport int
win32_setvbuf(FILE *pf, char *buf, int type, size_t size)
{
- return pIOSubSystem->pfnsetvbuf(pf, buf, type, size);
+ return setvbuf(pf, buf, type, size);
}
DllExport int
win32_flushall(void)
{
- return pIOSubSystem->pfnflushall();
+ return flushall();
}
DllExport int
win32_fcloseall(void)
{
- return pIOSubSystem->pfnfcloseall();
+ return fcloseall();
}
DllExport char*
win32_fgets(char *s, int n, FILE *pf)
{
- return pIOSubSystem->pfnfgets(s, n, pf);
+ return fgets(s, n, pf);
}
DllExport char*
win32_gets(char *s)
{
- return pIOSubSystem->pfngets(s);
+ return gets(s);
}
DllExport int
win32_fgetc(FILE *pf)
{
- return pIOSubSystem->pfnfgetc(pf);
+ return fgetc(pf);
}
DllExport int
win32_putc(int c, FILE *pf)
{
- return pIOSubSystem->pfnputc(c,pf);
+ return putc(c,pf);
}
DllExport int
win32_puts(const char *s)
{
- return pIOSubSystem->pfnputs(s);
+ return puts(s);
}
DllExport int
win32_getchar(void)
{
- return pIOSubSystem->pfngetchar();
+ return getchar();
}
DllExport int
win32_putchar(int c)
{
- return pIOSubSystem->pfnputchar(c);
+ return putchar(c);
+}
+
+#ifdef MYMALLOC
+
+#ifndef USE_PERL_SBRK
+
+static char *committed = NULL;
+static char *base = NULL;
+static char *reserved = NULL;
+static char *brk = NULL;
+static DWORD pagesize = 0;
+static DWORD allocsize = 0;
+
+void *
+sbrk(int need)
+{
+ void *result;
+ if (!pagesize)
+ {SYSTEM_INFO info;
+ GetSystemInfo(&info);
+ /* Pretend page size is larger so we don't perpetually
+ * call the OS to commit just one page ...
+ */
+ pagesize = info.dwPageSize << 3;
+ allocsize = info.dwAllocationGranularity;
+ }
+ /* This scheme fails eventually if request for contiguous
+ * block is denied so reserve big blocks - this is only
+ * address space not memory ...
+ */
+ if (brk+need >= reserved)
+ {
+ DWORD size = 64*1024*1024;
+ char *addr;
+ if (committed && reserved && committed < reserved)
+ {
+ /* Commit last of previous chunk cannot span allocations */
+ addr = (char *) VirtualAlloc(committed,reserved-committed,MEM_COMMIT,PAGE_READWRITE);
+ if (addr)
+ committed = reserved;
+ }
+ /* Reserve some (more) space
+ * Note this is a little sneaky, 1st call passes NULL as reserved
+ * so lets system choose where we start, subsequent calls pass
+ * the old end address so ask for a contiguous block
+ */
+ addr = (char *) VirtualAlloc(reserved,size,MEM_RESERVE,PAGE_NOACCESS);
+ if (addr)
+ {
+ reserved = addr+size;
+ if (!base)
+ base = addr;
+ if (!committed)
+ committed = base;
+ if (!brk)
+ brk = committed;
+ }
+ else
+ {
+ return (void *) -1;
+ }
+ }
+ result = brk;
+ brk += need;
+ if (brk > committed)
+ {
+ DWORD size = ((brk-committed + pagesize -1)/pagesize) * pagesize;
+ char *addr = (char *) VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE);
+ if (addr)
+ {
+ committed += size;
+ }
+ else
+ return (void *) -1;
+ }
+ return result;
}
+#endif
+#endif
+
DllExport void*
win32_malloc(size_t size)
{
- return pIOSubSystem->pfnmalloc(size);
+ return malloc(size);
}
DllExport void*
win32_calloc(size_t numitems, size_t size)
{
- return pIOSubSystem->pfncalloc(numitems,size);
+ return calloc(numitems,size);
}
DllExport void*
win32_realloc(void *block, size_t size)
{
- return pIOSubSystem->pfnrealloc(block,size);
+ return realloc(block,size);
}
DllExport void
win32_free(void *block)
{
- pIOSubSystem->pfnfree(block);
+ free(block);
}
+
int
-stolen_open_osfhandle(long handle, int flags)
+win32_open_osfhandle(long handle, int flags)
{
- return pIOSubSystem->pfn_open_osfhandle(handle, flags);
+ return _open_osfhandle(handle, flags);
}
long
-stolen_get_osfhandle(int fd)
+win32_get_osfhandle(int fd)
{
- return pIOSubSystem->pfn_get_osfhandle(fd);
+ return _get_osfhandle(fd);
}
/*
* Extras.
*/
-DllExport int
-win32_flock(int fd, int oper)
-{
- if (!IsWinNT()) {
- croak("flock() unimplemented on this platform");
- return -1;
- }
- return pIOSubSystem->pfnflock(fd, oper);
-}
-
static
XS(w32_GetCwd)
{
@@ -1353,7 +2238,7 @@ XS(w32_GetCwd)
*/
if (SvCUR(sv))
SvPOK_on(sv);
- EXTEND(sp,1);
+ EXTEND(SP,1);
ST(0) = sv;
XSRETURN(1);
}
@@ -1362,9 +2247,10 @@ static
XS(w32_SetCwd)
{
dXSARGS;
+ STRLEN n_a;
if (items != 1)
croak("usage: Win32::SetCurrentDirectory($cwd)");
- if (SetCurrentDirectory(SvPV(ST(0),na)))
+ if (SetCurrentDirectory(SvPV(ST(0),n_a)))
XSRETURN_YES;
XSRETURN_NO;
@@ -1397,8 +2283,8 @@ static
XS(w32_LoginName)
{
dXSARGS;
- char name[256];
- DWORD size = sizeof(name);
+ char *name = getlogin_buffer;
+ DWORD size = sizeof(getlogin_buffer);
if (GetUserName(name,&size)) {
/* size includes NULL */
ST(0) = sv_2mortal(newSVpv(name,size-1));
@@ -1426,6 +2312,8 @@ static
XS(w32_DomainName)
{
dXSARGS;
+#ifndef HAS_NETWKSTAGETINFO
+ /* mingw32 (and Win95) don't have NetWksta*(), so do it the old way */
char name[256];
DWORD size = sizeof(name);
if (GetUserName(name,&size)) {
@@ -1434,11 +2322,31 @@ XS(w32_DomainName)
char dname[256];
DWORD dnamelen = sizeof(dname);
SID_NAME_USE snu;
- if (LookupAccountName(NULL, name, &sid, &sidlen,
+ if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,
dname, &dnamelen, &snu)) {
XSRETURN_PV(dname); /* all that for this */
}
}
+#else
+ /* this way is more reliable, in case user has a local account.
+ * XXX need dynamic binding of netapi32.dll symbols or this will fail on
+ * Win95. Probably makes more sense to move it into libwin32. */
+ char dname[256];
+ DWORD dnamelen = sizeof(dname);
+ PWKSTA_INFO_100 pwi;
+ if (NERR_Success == NetWkstaGetInfo(NULL, 100, (LPBYTE*)&pwi)) {
+ if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
+ WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_langroup,
+ -1, (LPSTR)dname, dnamelen, NULL, NULL);
+ }
+ else {
+ WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_computername,
+ -1, (LPSTR)dname, dnamelen, NULL, NULL);
+ }
+ NetApiBufferFree(pwi);
+ XSRETURN_PV(dname);
+ }
+#endif
XSRETURN_UNDEF;
}
@@ -1521,19 +2429,20 @@ XS(w32_Spawn)
PROCESS_INFORMATION stProcInfo;
STARTUPINFO stStartInfo;
BOOL bSuccess = FALSE;
+ STRLEN n_a;
- if(items != 3)
+ if (items != 3)
croak("usage: Win32::Spawn($cmdName, $args, $PID)");
- cmd = SvPV(ST(0),na);
- args = SvPV(ST(1), na);
+ cmd = SvPV(ST(0),n_a);
+ args = SvPV(ST(1), n_a);
memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */
stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */
stStartInfo.dwFlags = STARTF_USESHOWWINDOW; /* Enable wShowWindow control */
stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE; /* Start min (normal) */
- if(CreateProcess(
+ if (CreateProcess(
cmd, /* Image path */
args, /* Arguments for command line */
NULL, /* Default process security */
@@ -1566,7 +2475,7 @@ XS(w32_GetShortPathName)
SV *shortpath;
DWORD len;
- if(items != 1)
+ if (items != 1)
croak("usage: Win32::GetShortPathName($longPathName)");
shortpath = sv_mortalcopy(ST(0));
@@ -1582,18 +2491,32 @@ XS(w32_GetShortPathName)
ST(0) = shortpath;
}
else
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
XSRETURN(1);
}
+static
+XS(w32_Sleep)
+{
+ dXSARGS;
+ if (items != 1)
+ croak("usage: Win32::Sleep($milliseconds)");
+ Sleep(SvIV(ST(0)));
+ XSRETURN_YES;
+}
+
void
-init_os_extras()
+Perl_init_os_extras()
{
char *file = __FILE__;
dXSUB_SYS;
- /* XXX should be removed after checking with Nick */
- newXS("Win32::GetCurrentDirectory", w32_GetCwd, file);
+ w32_perlshell_tokens = Nullch;
+ w32_perlshell_items = -1;
+ w32_fdpid = newAV(); /* XXX needs to be in Perl_win32_init()? */
+#ifndef USE_RTL_WAIT
+ w32_num_children = 0;
+#endif
/* these names are Activeware compatible */
newXS("Win32::GetCwd", w32_GetCwd, file);
@@ -1611,6 +2534,7 @@ init_os_extras()
newXS("Win32::Spawn", w32_Spawn, file);
newXS("Win32::GetTickCount", w32_GetTickCount, file);
newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
+ newXS("Win32::Sleep", w32_Sleep, file);
/* XXX Bloat Alert! The following Activeware preloads really
* ought to be part of Win32::Sys::*, so they're not included
@@ -1633,7 +2557,33 @@ Perl_win32_init(int *argcp, char ***argvp)
* want to be at the vendor's whim on the default, we set
* it explicitly here.
*/
-#if !defined(_ALPHA_)
+#if !defined(_ALPHA_) && !defined(__GNUC__)
_control87(MCW_EM, MCW_EM);
#endif
+ MALLOC_INIT;
+}
+
+#ifdef USE_BINMODE_SCRIPTS
+
+void
+win32_strip_return(SV *sv)
+{
+ char *s = SvPVX(sv);
+ char *e = s+SvCUR(sv);
+ char *d = s;
+ while (s < e)
+ {
+ if (*s == '\r' && s[1] == '\n')
+ {
+ *d++ = '\n';
+ s += 2;
+ }
+ else
+ {
+ *d++ = *s++;
+ }
+ }
+ SvCUR_set(sv,d-SvPVX(sv));
}
+
+#endif
diff --git a/gnu/usr.bin/perl/win32/win32.h b/gnu/usr.bin/perl/win32/win32.h
index dc069ba366c..961347d5fea 100644
--- a/gnu/usr.bin/perl/win32/win32.h
+++ b/gnu/usr.bin/perl/win32/win32.h
@@ -9,23 +9,128 @@
#ifndef _INC_WIN32_PERL5
#define _INC_WIN32_PERL5
+#ifdef PERL_OBJECT
+# define DYNAMIC_ENV_FETCH
+# define ENV_HV_NAME "___ENV_HV_NAME___"
+# define prime_env_iter()
+# define WIN32IO_IS_STDIO /* don't pull in custom stdio layer */
+# ifdef PERL_GLOBAL_STRUCT
+# error PERL_GLOBAL_STRUCT cannot be defined with PERL_OBJECT
+# endif
+# define win32_get_privlib PerlEnv_lib_path
+# define win32_get_sitelib PerlEnv_sitelib_path
+#endif
+
+#ifdef __GNUC__
+typedef long long __int64;
+# define Win32_Winsock
+/* GCC does not do __declspec() - render it a nop
+ * and turn on options to avoid importing data
+ */
+#ifndef __declspec
+# define __declspec(x)
+#endif
+# ifndef PERL_OBJECT
+# define PERL_GLOBAL_STRUCT
+# define MULTIPLICITY
+# endif
+#endif
+
+/* Define DllExport akin to perl's EXT,
+ * If we are in the DLL or mimicing the DLL for Win95 work round
+ * then Export the symbol,
+ * otherwise import it.
+ */
+
+#if defined(PERL_OBJECT)
+#define DllExport
+#else
+#if defined(PERLDLL) || defined(WIN95FIX)
+#define DllExport
+/*#define DllExport __declspec(dllexport)*/ /* noises with VC5+sp3 */
+#else
+#define DllExport __declspec(dllimport)
+#endif
+#endif
+
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#ifdef WIN32_LEAN_AND_MEAN /* C file is NOT a Perl5 original. */
#define CONTEXT PERL_CONTEXT /* Avoid conflict of CONTEXT defs. */
-#define index strchr /* Why 'index'? */
#endif /*WIN32_LEAN_AND_MEAN */
+#ifndef TLS_OUT_OF_INDEXES
+#define TLS_OUT_OF_INDEXES (DWORD)0xFFFFFFFF
+#endif
+
#include <dirent.h>
#include <io.h>
#include <process.h>
#include <stdio.h>
#include <direct.h>
+#include <stdlib.h>
+#ifndef EXT
+#include "EXTERN.h"
+#endif
-/* For UNIX compatibility. */
+struct tms {
+ long tms_utime;
+ long tms_stime;
+ long tms_cutime;
+ long tms_cstime;
+};
+
+#ifndef START_EXTERN_C
+#undef EXTERN_C
+#ifdef __cplusplus
+# define START_EXTERN_C extern "C" {
+# define END_EXTERN_C }
+# define EXTERN_C extern "C"
+#else
+# define START_EXTERN_C
+# define END_EXTERN_C
+# define EXTERN_C
+#endif
+#endif
+
+#define STANDARD_C 1
+#define DOSISH 1 /* no escaping our roots */
+#define OP_BINARY O_BINARY /* mistake in in pp_sys.c? */
+
+/* Define USE_SOCKETS_AS_HANDLES to enable emulation of windows sockets as
+ * real filehandles. XXX Should always be defined (the other version is untested) */
+#define USE_SOCKETS_AS_HANDLES
+
+/* read() and write() aren't transparent for socket handles */
+#define PERL_SOCK_SYSREAD_IS_RECV
+#define PERL_SOCK_SYSWRITE_IS_SEND
+
+
+/* if USE_WIN32_RTL_ENV is not defined, Perl uses direct Win32 calls
+ * to read the environment, bypassing the runtime's (usually broken)
+ * facilities for accessing the same. See note in util.c/my_setenv(). */
+/*#define USE_WIN32_RTL_ENV */
+
+/* Define USE_FIXED_OSFHANDLE to fix VC's _open_osfhandle() on W95.
+ * Can only enable it if not using the DLL CRT (it doesn't expose internals) */
+#if defined(_MSC_VER) && !defined(_DLL) && defined(_M_IX86)
+#define USE_FIXED_OSFHANDLE
+#endif
+
+#define ENV_IS_CASELESS
+
+#ifndef VER_PLATFORM_WIN32_WINDOWS /* VC-2.0 headers don't have this */
+#define VER_PLATFORM_WIN32_WINDOWS 1
+#endif
+
+#ifndef FILE_SHARE_DELETE /* VC-4.0 headers don't have this */
+#define FILE_SHARE_DELETE 0x00000004
+#endif
-#ifdef __BORLANDC__
+/* Compiler-specific stuff. */
+
+#ifdef __BORLANDC__ /* Borland C++ */
#define _access access
#define _chdir chdir
@@ -35,120 +140,230 @@
#define DllMain DllEntryPoint
#endif
-#pragma warn -ccc
-#pragma warn -rch
-#pragma warn -sig
-#pragma warn -pia
-#pragma warn -par
-#pragma warn -aus
-#pragma warn -use
-#pragma warn -csu
-#pragma warn -pro
+#pragma warn -ccc /* "condition is always true/false" */
+#pragma warn -rch /* "unreachable code" */
+#pragma warn -sig /* "conversion may lose significant digits" */
+#pragma warn -pia /* "possibly incorrect assignment" */
+#pragma warn -par /* "parameter 'foo' is never used" */
+#pragma warn -aus /* "'foo' is assigned a value that is never used" */
+#pragma warn -use /* "'foo' is declared but never used" */
+#pragma warn -csu /* "comparing signed and unsigned values" */
+#pragma warn -pro /* "call to function with no prototype" */
+
+#define USE_RTL_WAIT /* Borland has a working wait() */
+
+/* Borland is picky about a bare member function name used as its ptr */
+#ifdef PERL_OBJECT
+#define FUNC_NAME_TO_PTR(name) &(name)
+#endif
-#else
+#endif
+
+#ifdef _MSC_VER /* Microsoft Visual C++ */
typedef long uid_t;
typedef long gid_t;
+#pragma warning(disable: 4018 4035 4101 4102 4244 4245 4761)
-#endif
-
-extern uid_t getuid(void);
-extern gid_t getgid(void);
-extern uid_t geteuid(void);
-extern gid_t getegid(void);
-extern int setuid(uid_t uid);
-extern int setgid(gid_t gid);
-
-extern int kill(int pid, int sig);
+#ifndef PERL_OBJECT
+
+/* Visual C thinks that a pointer to a member variable is 16 bytes in size. */
+#define STRUCT_MGVTBL_DEFINITION \
+struct mgvtbl { \
+ union { \
+ int (CPERLscope(*svt_get)) _((SV *sv, MAGIC* mg)); \
+ char handle_VC_problem1[16]; \
+ }; \
+ union { \
+ int (CPERLscope(*svt_set)) _((SV *sv, MAGIC* mg)); \
+ char handle_VC_problem2[16]; \
+ }; \
+ union { \
+ U32 (CPERLscope(*svt_len)) _((SV *sv, MAGIC* mg)); \
+ char handle_VC_problem3[16]; \
+ }; \
+ union { \
+ int (CPERLscope(*svt_clear)) _((SV *sv, MAGIC* mg)); \
+ char handle_VC_problem4[16]; \
+ }; \
+ union { \
+ int (CPERLscope(*svt_free)) _((SV *sv, MAGIC* mg)); \
+ char handle_VC_problem5[16]; \
+ }; \
+}
+
+#define BASEOP_DEFINITION \
+ OP* op_next; \
+ OP* op_sibling; \
+ OP* (CPERLscope(*op_ppaddr))_((ARGSproto)); \
+ char handle_VC_problem[12]; \
+ PADOFFSET op_targ; \
+ OPCODE op_type; \
+ U16 op_seq; \
+ U8 op_flags; \
+ U8 op_private;
+
+#define UNION_ANY_DEFINITION union any { \
+ void* any_ptr; \
+ I32 any_i32; \
+ IV any_iv; \
+ long any_long; \
+ void (CPERLscope(*any_dptr)) _((void*)); \
+ char handle_VC_problem[16]; \
+}
+
+#endif /* PERL_OBJECT */
+
+#endif /* _MSC_VER */
+
+#ifdef __MINGW32__ /* Minimal Gnu-Win32 */
-extern char *staticlinkmodules[];
+typedef long uid_t;
+typedef long gid_t;
+#ifndef _environ
+#define _environ environ
+#endif
+#define flushall _flushall
+#define fcloseall _fcloseall
-/* if USE_WIN32_RTL_ENV is not defined, Perl uses direct Win32 calls
- * to read the environment, bypassing the runtime's (usually broken)
- * facilities for accessing the same. See note in util.c/my_setenv().
- */
-/*#define USE_WIN32_RTL_ENV */
+#ifdef PERL_OBJECT
+#define FUNC_NAME_TO_PTR(name) &(name)
+#endif
-#ifndef USE_WIN32_RTL_ENV
-#include <stdlib.h>
-#ifndef EXT
-#include "EXTERN.h"
+#ifndef _O_NOINHERIT
+# define _O_NOINHERIT 0x0080
+# ifndef _NO_OLDNAMES
+# define O_NOINHERIT _O_NOINHERIT
+# endif
#endif
-#undef getenv
-#define getenv win32_getenv
-EXT char *win32_getenv(const char *name);
+
+#ifndef _O_NOINHERIT
+# define _O_NOINHERIT 0x0080
+# ifndef _NO_OLDNAMES
+# define O_NOINHERIT _O_NOINHERIT
+# endif
#endif
-EXT void Perl_win32_init(int *argcp, char ***argvp);
+#endif /* __MINGW32__ */
-#define USE_SOCKETS_AS_HANDLES
-#ifndef USE_SOCKETS_AS_HANDLES
-extern FILE *myfdopen(int, char *);
+/* compatibility stuff for other compilers goes here */
-#undef fdopen
-#define fdopen myfdopen
-#endif /* USE_SOCKETS_AS_HANDLES */
-#define STANDARD_C 1 /* Perl5 likes standard C. */
-#define DOSISH 1 /* Take advantage of DOSish code in Perl5. */
+START_EXTERN_C
-#define OP_BINARY O_BINARY /* Mistake in in pp_sys.c. */
+/* For UNIX compatibility. */
-#undef pipe
-#define pipe(fd) win32_pipe((fd), 512, O_BINARY) /* the pipe call is a bit different */
+extern uid_t getuid(void);
+extern gid_t getgid(void);
+extern uid_t geteuid(void);
+extern gid_t getegid(void);
+extern int setuid(uid_t uid);
+extern int setgid(gid_t gid);
+extern int kill(int pid, int sig);
+extern void *sbrk(int need);
+extern char * getlogin(void);
+extern int chown(const char *p, uid_t o, gid_t g);
-#undef pause
-#define pause() sleep((32767L << 16) + 32767)
+#undef Stat
+#define Stat win32_stat
+#undef init_os_extras
+#define init_os_extras Perl_init_os_extras
-#undef times
-#define times mytimes
+DllExport void Perl_win32_init(int *argcp, char ***argvp);
+DllExport void Perl_init_os_extras(void);
+DllExport void win32_str_os_error(void *sv, DWORD err);
-#undef alarm
-#define alarm myalarm
+#ifndef USE_SOCKETS_AS_HANDLES
+extern FILE * my_fdopen(int, char *);
+#endif
+extern int my_fclose(FILE *);
+extern int do_aspawn(void *really, void **mark, void **sp);
+extern int do_spawn(char *cmd);
+extern int do_spawn_nowait(char *cmd);
+extern char do_exec(char *cmd);
+extern char * win32_get_privlib(char *pl);
+extern char * win32_get_sitelib(char *pl);
+extern int IsWin95(void);
+extern int IsWinNT(void);
-struct tms {
- long tms_utime;
- long tms_stime;
- long tms_cutime;
- long tms_cstime;
-};
+extern char * staticlinkmodules[];
-unsigned int sleep(unsigned int);
-char *win32PerlLibPath(void);
-char *win32SiteLibPath(void);
-int mytimes(struct tms *timebuf);
-unsigned int myalarm(unsigned int sec);
-int do_aspawn(void* really, void** mark, void** arglast);
-int do_spawn(char *cmd);
-char do_exec(char *cmd);
-void init_os_extras(void);
+END_EXTERN_C
typedef char * caddr_t; /* In malloc.c (core address). */
/*
- * Extension Library, only good for VC
- */
-
-#define DllExport __declspec(dllexport)
-#define DllImport __declspec(dllimport)
-
-/*
* handle socket stuff, assuming socket is always available
*/
-
#include <sys/socket.h>
#include <netdb.h>
-#ifdef _MSC_VER
-#pragma warning(disable: 4018 4035 4101 4102 4244 4245 4761)
+#ifdef MYMALLOC
+#define EMBEDMYMALLOC /**/
+/* #define USE_PERL_SBRK /**/
+/* #define PERL_SBRK_VIA_MALLOC /**/
#endif
-int IsWin95(void);
-int IsWinNT(void);
+#if defined(PERLDLL) && !defined(PERL_CORE)
+#define PERL_CORE
+#endif
-#ifndef VER_PLATFORM_WIN32_WINDOWS /* VC-2.0 headers dont have this */
-#define VER_PLATFORM_WIN32_WINDOWS 1
+#ifdef USE_BINMODE_SCRIPTS
+#define PERL_SCRIPT_MODE "rb"
+EXT void win32_strip_return(struct sv *sv);
+#else
+#define PERL_SCRIPT_MODE "r"
+#define win32_strip_return(sv) NOOP
#endif
+#define HAVE_INTERP_INTERN
+struct interp_intern {
+ char * w32_perlshell_tokens;
+ char ** w32_perlshell_vec;
+ long w32_perlshell_items;
+ struct av * w32_fdpid;
+#ifndef USE_RTL_WAIT
+ long w32_num_children;
+ HANDLE w32_child_pids[MAXIMUM_WAIT_OBJECTS];
+#endif
+};
+
+#define w32_perlshell_tokens (PL_sys_intern.w32_perlshell_tokens)
+#define w32_perlshell_vec (PL_sys_intern.w32_perlshell_vec)
+#define w32_perlshell_items (PL_sys_intern.w32_perlshell_items)
+#define w32_fdpid (PL_sys_intern.w32_fdpid)
+
+#ifndef USE_RTL_WAIT
+# define w32_num_children (PL_sys_intern.w32_num_children)
+# define w32_child_pids (PL_sys_intern.w32_child_pids)
+#endif
+
+/*
+ * Now Win32 specific per-thread data stuff
+ */
+
+#ifdef USE_THREADS
+# ifndef USE_DECLSPEC_THREAD
+# define HAVE_THREAD_INTERN
+
+struct thread_intern {
+ /* XXX can probably use one buffer instead of several */
+ char Wstrerror_buffer[512];
+ struct servent Wservent;
+ char Wgetlogin_buffer[128];
+ char Ww32_perllib_root[MAX_PATH+1];
+# ifdef USE_SOCKETS_AS_HANDLES
+ int Winit_socktype;
+# endif
+# ifdef HAVE_DES_FCRYPT
+ char Wcrypt_buffer[30];
+# endif
+# ifdef USE_RTL_THREAD_API
+ void * retv; /* slot for thread return value */
+# endif
+};
+# endif /* !USE_DECLSPEC_THREAD */
+#endif /* USE_THREADS */
+
#endif /* _INC_WIN32_PERL5 */
diff --git a/gnu/usr.bin/perl/win32/win32iop.h b/gnu/usr.bin/perl/win32/win32iop.h
index 4606563d0e8..c7a74444e06 100644
--- a/gnu/usr.bin/perl/win32/win32iop.h
+++ b/gnu/usr.bin/perl/win32/win32iop.h
@@ -1,6 +1,31 @@
#ifndef WIN32IOP_H
#define WIN32IOP_H
+#ifndef START_EXTERN_C
+#ifdef __cplusplus
+# define START_EXTERN_C extern "C" {
+# define END_EXTERN_C }
+# define EXTERN_C extern "C"
+#else
+# define START_EXTERN_C
+# define END_EXTERN_C
+# define EXTERN_C
+#endif
+#endif
+
+#if defined(_MSC_VER) || defined(__MINGW32__)
+# include <sys/utime.h>
+#else
+# include <utime.h>
+#endif
+
+/*
+ * defines for flock emulation
+ */
+#define LOCK_SH 1
+#define LOCK_EX 2
+#define LOCK_NB 4
+#define LOCK_UN 8
/*
* Make this as close to original stdio as possible.
@@ -9,96 +34,105 @@
/*
* function prototypes for our own win32io layer
*/
-EXT int * win32_errno(void);
-EXT char *** win32_environ(void);
-EXT FILE* win32_stdin(void);
-EXT FILE* win32_stdout(void);
-EXT FILE* win32_stderr(void);
-EXT int win32_ferror(FILE *fp);
-EXT int win32_feof(FILE *fp);
-EXT char* win32_strerror(int e);
-
-EXT int win32_fprintf(FILE *pf, const char *format, ...);
-EXT int win32_printf(const char *format, ...);
-EXT int win32_vfprintf(FILE *pf, const char *format, va_list arg);
-EXT int win32_vprintf(const char *format, va_list arg);
-EXT size_t win32_fread(void *buf, size_t size, size_t count, FILE *pf);
-EXT size_t win32_fwrite(const void *buf, size_t size, size_t count, FILE *pf);
-EXT FILE* win32_fopen(const char *path, const char *mode);
-EXT FILE* win32_fdopen(int fh, const char *mode);
-EXT FILE* win32_freopen(const char *path, const char *mode, FILE *pf);
-EXT int win32_fclose(FILE *pf);
-EXT int win32_fputs(const char *s,FILE *pf);
-EXT int win32_fputc(int c,FILE *pf);
-EXT int win32_ungetc(int c,FILE *pf);
-EXT int win32_getc(FILE *pf);
-EXT int win32_fileno(FILE *pf);
-EXT void win32_clearerr(FILE *pf);
-EXT int win32_fflush(FILE *pf);
-EXT long win32_ftell(FILE *pf);
-EXT int win32_fseek(FILE *pf,long offset,int origin);
-EXT int win32_fgetpos(FILE *pf,fpos_t *p);
-EXT int win32_fsetpos(FILE *pf,const fpos_t *p);
-EXT void win32_rewind(FILE *pf);
-EXT FILE* win32_tmpfile(void);
-EXT void win32_abort(void);
-EXT int win32_fstat(int fd,struct stat *bufptr);
-EXT int win32_stat(const char *name,struct stat *bufptr);
-EXT int win32_pipe( int *phandles, unsigned int psize, int textmode );
-EXT FILE* win32_popen( const char *command, const char *mode );
-EXT int win32_pclose( FILE *pf);
-EXT int win32_setmode( int fd, int mode);
-EXT long win32_lseek( int fd, long offset, int origin);
-EXT long win32_tell( int fd);
-EXT int win32_dup( int fd);
-EXT int win32_dup2(int h1, int h2);
-EXT int win32_open(const char *path, int oflag,...);
-EXT int win32_close(int fd);
-EXT int win32_eof(int fd);
-EXT int win32_read(int fd, void *buf, unsigned int cnt);
-EXT int win32_write(int fd, const void *buf, unsigned int cnt);
-EXT int win32_spawnvp(int mode, const char *cmdname,
+START_EXTERN_C
+
+DllExport int * win32_errno(void);
+DllExport char *** win32_environ(void);
+DllExport FILE* win32_stdin(void);
+DllExport FILE* win32_stdout(void);
+DllExport FILE* win32_stderr(void);
+DllExport int win32_ferror(FILE *fp);
+DllExport int win32_feof(FILE *fp);
+DllExport char* win32_strerror(int e);
+
+DllExport int win32_fprintf(FILE *pf, const char *format, ...);
+DllExport int win32_printf(const char *format, ...);
+DllExport int win32_vfprintf(FILE *pf, const char *format, va_list arg);
+DllExport int win32_vprintf(const char *format, va_list arg);
+DllExport size_t win32_fread(void *buf, size_t size, size_t count, FILE *pf);
+DllExport size_t win32_fwrite(const void *buf, size_t size, size_t count, FILE *pf);
+DllExport FILE* win32_fopen(const char *path, const char *mode);
+DllExport FILE* win32_fdopen(int fh, const char *mode);
+DllExport FILE* win32_freopen(const char *path, const char *mode, FILE *pf);
+DllExport int win32_fclose(FILE *pf);
+DllExport int win32_fputs(const char *s,FILE *pf);
+DllExport int win32_fputc(int c,FILE *pf);
+DllExport int win32_ungetc(int c,FILE *pf);
+DllExport int win32_getc(FILE *pf);
+DllExport int win32_fileno(FILE *pf);
+DllExport void win32_clearerr(FILE *pf);
+DllExport int win32_fflush(FILE *pf);
+DllExport long win32_ftell(FILE *pf);
+DllExport int win32_fseek(FILE *pf,long offset,int origin);
+DllExport int win32_fgetpos(FILE *pf,fpos_t *p);
+DllExport int win32_fsetpos(FILE *pf,const fpos_t *p);
+DllExport void win32_rewind(FILE *pf);
+DllExport FILE* win32_tmpfile(void);
+DllExport void win32_abort(void);
+DllExport int win32_fstat(int fd,struct stat *sbufptr);
+DllExport int win32_stat(const char *name,struct stat *sbufptr);
+DllExport int win32_pipe( int *phandles, unsigned int psize, int textmode );
+DllExport FILE* win32_popen( const char *command, const char *mode );
+DllExport int win32_pclose( FILE *pf);
+DllExport int win32_rename( const char *oname, const char *newname);
+DllExport int win32_setmode( int fd, int mode);
+DllExport long win32_lseek( int fd, long offset, int origin);
+DllExport long win32_tell( int fd);
+DllExport int win32_dup( int fd);
+DllExport int win32_dup2(int h1, int h2);
+DllExport int win32_open(const char *path, int oflag,...);
+DllExport int win32_close(int fd);
+DllExport int win32_eof(int fd);
+DllExport int win32_read(int fd, void *buf, unsigned int cnt);
+DllExport int win32_write(int fd, const void *buf, unsigned int cnt);
+DllExport int win32_spawnvp(int mode, const char *cmdname,
const char *const *argv);
-EXT int win32_mkdir(const char *dir, int mode);
-EXT int win32_rmdir(const char *dir);
-EXT int win32_chdir(const char *dir);
-EXT int win32_flock(int fd, int oper);
-EXT int win32_execvp(const char *cmdname, const char *const *argv);
-EXT void win32_perror(const char *str);
-EXT void win32_setbuf(FILE *pf, char *buf);
-EXT int win32_setvbuf(FILE *pf, char *buf, int type, size_t size);
-EXT int win32_flushall(void);
-EXT int win32_fcloseall(void);
-EXT char* win32_fgets(char *s, int n, FILE *pf);
-EXT char* win32_gets(char *s);
-EXT int win32_fgetc(FILE *pf);
-EXT int win32_putc(int c, FILE *pf);
-EXT int win32_puts(const char *s);
-EXT int win32_getchar(void);
-EXT int win32_putchar(int c);
-EXT void* win32_malloc(size_t size);
-EXT void* win32_calloc(size_t numitems, size_t size);
-EXT void* win32_realloc(void *block, size_t size);
-EXT void win32_free(void *block);
+DllExport int win32_mkdir(const char *dir, int mode);
+DllExport int win32_rmdir(const char *dir);
+DllExport int win32_chdir(const char *dir);
+DllExport int win32_flock(int fd, int oper);
+DllExport int win32_execv(const char *cmdname, const char *const *argv);
+DllExport int win32_execvp(const char *cmdname, const char *const *argv);
+DllExport void win32_perror(const char *str);
+DllExport void win32_setbuf(FILE *pf, char *buf);
+DllExport int win32_setvbuf(FILE *pf, char *buf, int type, size_t size);
+DllExport int win32_flushall(void);
+DllExport int win32_fcloseall(void);
+DllExport char* win32_fgets(char *s, int n, FILE *pf);
+DllExport char* win32_gets(char *s);
+DllExport int win32_fgetc(FILE *pf);
+DllExport int win32_putc(int c, FILE *pf);
+DllExport int win32_puts(const char *s);
+DllExport int win32_getchar(void);
+DllExport int win32_putchar(int c);
+DllExport void* win32_malloc(size_t size);
+DllExport void* win32_calloc(size_t numitems, size_t size);
+DllExport void* win32_realloc(void *block, size_t size);
+DllExport void win32_free(void *block);
-/*
- * these two are win32 specific but still io related
- */
-int stolen_open_osfhandle(long handle, int flags);
-long stolen_get_osfhandle(int fd);
+DllExport int win32_open_osfhandle(long handle, int flags);
+DllExport long win32_get_osfhandle(int fd);
-/*
- * defines for flock emulation
- */
-#define LOCK_SH 1
-#define LOCK_EX 2
-#define LOCK_NB 4
-#define LOCK_UN 8
+#ifndef USE_WIN32_RTL_ENV
+DllExport char* win32_getenv(const char *name);
+DllExport int win32_putenv(const char *name);
+#endif
-#include <win32io.h> /* pull in the io sub system structure */
+DllExport unsigned win32_sleep(unsigned int);
+DllExport int win32_times(struct tms *timebuf);
+DllExport unsigned win32_alarm(unsigned int sec);
+DllExport int win32_stat(const char *path, struct stat *buf);
+DllExport int win32_ioctl(int i, unsigned int u, char *data);
+DllExport int win32_utime(const char *f, struct utimbuf *t);
+DllExport int win32_wait(int *status);
+DllExport int win32_waitpid(int pid, int *status, int flags);
+DllExport int win32_kill(int pid, int sig);
+
+#if defined(HAVE_DES_FCRYPT) || defined(PERL_OBJECT)
+DllExport char * win32_crypt(const char *txt, const char *salt);
+#endif
-EXT PWIN32_IOSUBSYSTEM SetIOSubSystem(void *piosubsystem);
-EXT PWIN32_IOSUBSYSTEM GetIOSubSystem(void);
+END_EXTERN_C
/*
* the following six(6) is #define in stdio.h
@@ -111,6 +145,15 @@ EXT PWIN32_IOSUBSYSTEM GetIOSubSystem(void);
#undef stdout
#undef ferror
#undef feof
+#undef fclose
+#undef pipe
+#undef pause
+#undef sleep
+#undef times
+#undef alarm
+#undef ioctl
+#undef utime
+#undef wait
#ifdef __BORLANDC__
#undef ungetc
@@ -133,6 +176,7 @@ EXT PWIN32_IOSUBSYSTEM GetIOSubSystem(void);
/*
* redirect to our own version
*/
+#undef fprintf
#define fprintf win32_fprintf
#define vfprintf win32_vfprintf
#define printf win32_printf
@@ -140,12 +184,14 @@ EXT PWIN32_IOSUBSYSTEM GetIOSubSystem(void);
#define fread(buf,size,count,f) win32_fread(buf,size,count,f)
#define fwrite(buf,size,count,f) win32_fwrite(buf,size,count,f)
#define fopen win32_fopen
+#undef fdopen
#define fdopen win32_fdopen
#define freopen win32_freopen
#define fclose(f) win32_fclose(f)
#define fputs(s,f) win32_fputs(s,f)
#define fputc(c,f) win32_fputc(c,f)
#define ungetc(c,f) win32_ungetc(c,f)
+#undef getc
#define getc(f) win32_getc(f)
#define fileno(f) win32_fileno(f)
#define clearerr(f) win32_clearerr(f)
@@ -159,6 +205,7 @@ EXT PWIN32_IOSUBSYSTEM GetIOSubSystem(void);
#define abort() win32_abort()
#define fstat(fd,bufptr) win32_fstat(fd,bufptr)
#define stat(pth,bufptr) win32_stat(pth,bufptr)
+#define rename(old,new) win32_rename(old,new)
#define setmode(fd,mode) win32_setmode(fd,mode)
#define lseek(fd,offset,orig) win32_lseek(fd,offset,orig)
#define tell(fd) win32_tell(fd)
@@ -169,32 +216,74 @@ EXT PWIN32_IOSUBSYSTEM GetIOSubSystem(void);
#define eof(fd) win32_eof(fd)
#define read(fd,b,s) win32_read(fd,b,s)
#define write(fd,b,s) win32_write(fd,b,s)
-#define _open_osfhandle stolen_open_osfhandle
-#define _get_osfhandle stolen_get_osfhandle
+#define _open_osfhandle win32_open_osfhandle
+#define _get_osfhandle win32_get_osfhandle
#define spawnvp win32_spawnvp
#define mkdir win32_mkdir
#define rmdir win32_rmdir
#define chdir win32_chdir
#define flock(fd,o) win32_flock(fd,o)
+#define execv win32_execv
#define execvp win32_execvp
#define perror win32_perror
#define setbuf win32_setbuf
#define setvbuf win32_setvbuf
+#undef flushall
#define flushall win32_flushall
+#undef fcloseall
#define fcloseall win32_fcloseall
#define fgets win32_fgets
#define gets win32_gets
#define fgetc win32_fgetc
+#undef putc
#define putc win32_putc
#define puts win32_puts
+#undef getchar
#define getchar win32_getchar
+#undef putchar
#define putchar win32_putchar
-#define fscanf (GetIOSubSystem()->pfnfscanf)
-#define scanf (GetIOSubSystem()->pfnscanf)
+
+#if !defined(MYMALLOC) || !defined(PERL_CORE)
+#undef malloc
+#undef calloc
+#undef realloc
+#undef free
#define malloc win32_malloc
#define calloc win32_calloc
#define realloc win32_realloc
#define free win32_free
-#endif /* WIN32IO_IS_STDIO */
+#endif
+
+#define pipe(fd) win32_pipe((fd), 512, O_BINARY)
+#define pause() win32_sleep((32767L << 16) + 32767)
+#define sleep win32_sleep
+#define times win32_times
+#define alarm win32_alarm
+#define ioctl win32_ioctl
+#define utime win32_utime
+#define wait win32_wait
+#define waitpid win32_waitpid
+#define kill win32_kill
+
+#define opendir win32_opendir
+#define readdir win32_readdir
+#define telldir win32_telldir
+#define seekdir win32_seekdir
+#define rewinddir win32_rewinddir
+#define closedir win32_closedir
+
+#ifdef HAVE_DES_FCRYPT
+#undef crypt
+#define crypt win32_crypt
+#endif
+
+#ifndef USE_WIN32_RTL_ENV
+#undef getenv
+#define getenv win32_getenv
+#undef putenv
+#define putenv win32_putenv
+#endif
+#endif /* WIN32IO_IS_STDIO */
#endif /* WIN32IOP_H */
+
diff --git a/gnu/usr.bin/perl/win32/win32sck.c b/gnu/usr.bin/perl/win32/win32sck.c
index 3653fc8b884..27136058402 100644
--- a/gnu/usr.bin/perl/win32/win32sck.c
+++ b/gnu/usr.bin/perl/win32/win32sck.c
@@ -1,4 +1,4 @@
-/* NTSock.C
+/* win32sck.c
*
* (c) 1995 Microsoft Corporation. All rights reserved.
* Developed by hip communications inc., http://info.hip.com/info/
@@ -8,229 +8,146 @@
* License or the Artistic License, as specified in the README file.
*/
-#include <windows.h>
+#define WIN32IO_IS_STDIO
+#define WIN32SCK_IS_STDSCK
#define WIN32_LEAN_AND_MEAN
+#ifdef __GNUC__
+#define Win32_Winsock
+#endif
+#include <windows.h>
#include "EXTERN.h"
#include "perl.h"
+
+#if defined(PERL_OBJECT)
+#define NO_XSLOCKS
+extern CPerlObj* pPerl;
+#include "XSUB.h"
+#endif
+
+#include "Win32iop.h"
#include <sys/socket.h>
#include <fcntl.h>
#include <sys/stat.h>
#include <assert.h>
+#include <io.h>
-#define CROAK croak
-
-#ifdef USE_SOCKETS_AS_HANDLES
/* thanks to Beverly Brown (beverly@datacube.com) */
-
-#define OPEN_SOCKET(x) _open_osfhandle(x,O_RDWR|O_BINARY)
-#define TO_SOCKET(x) _get_osfhandle(x)
-
+#ifdef USE_SOCKETS_AS_HANDLES
+# define OPEN_SOCKET(x) win32_open_osfhandle(x,O_RDWR|O_BINARY)
+# define TO_SOCKET(x) _get_osfhandle(x)
#else
-
# define OPEN_SOCKET(x) (x)
# define TO_SOCKET(x) (x)
-
#endif /* USE_SOCKETS_AS_HANDLES */
+#ifdef USE_THREADS
+#define StartSockets() \
+ STMT_START { \
+ if (!wsock_started) \
+ start_sockets(); \
+ set_socktype(); \
+ } STMT_END
+#else
+#define StartSockets() \
+ STMT_START { \
+ if (!wsock_started) { \
+ start_sockets(); \
+ set_socktype(); \
+ } \
+ } STMT_END
+#endif
+
+#define EndSockets() \
+ STMT_START { \
+ if (wsock_started) \
+ WSACleanup(); \
+ } STMT_END
+
+#define SOCKET_TEST(x, y) \
+ STMT_START { \
+ StartSockets(); \
+ if((x) == (y)) \
+ errno = WSAGetLastError(); \
+ } STMT_END
+
+#define SOCKET_TEST_ERROR(x) SOCKET_TEST(x, SOCKET_ERROR)
+
static struct servent* win32_savecopyservent(struct servent*d,
struct servent*s,
const char *proto);
-#define SOCKETAPI PASCAL
-
-typedef SOCKET (SOCKETAPI *LPSOCKACCEPT)(SOCKET, struct sockaddr *, int *);
-typedef int (SOCKETAPI *LPSOCKBIND)(SOCKET, const struct sockaddr *, int);
-typedef int (SOCKETAPI *LPSOCKCLOSESOCKET)(SOCKET);
-typedef int (SOCKETAPI *LPSOCKCONNECT)(SOCKET, const struct sockaddr *, int);
-typedef int (SOCKETAPI *LPSOCKIOCTLSOCKET)(SOCKET, long, u_long *);
-typedef int (SOCKETAPI *LPSOCKGETPEERNAME)(SOCKET, struct sockaddr *, int *);
-typedef int (SOCKETAPI *LPSOCKGETSOCKNAME)(SOCKET, struct sockaddr *, int *);
-typedef int (SOCKETAPI *LPSOCKGETSOCKOPT)(SOCKET, int, int, char *, int *);
-typedef u_long (SOCKETAPI *LPSOCKHTONL)(u_long);
-typedef u_short (SOCKETAPI *LPSOCKHTONS)(u_short);
-typedef int (SOCKETAPI *LPSOCKLISTEN)(SOCKET, int);
-typedef u_long (SOCKETAPI *LPSOCKNTOHL)(u_long);
-typedef u_short (SOCKETAPI *LPSOCKNTOHS)(u_short);
-typedef int (SOCKETAPI *LPSOCKRECV)(SOCKET, char *, int, int);
-typedef int (SOCKETAPI *LPSOCKRECVFROM)(SOCKET, char *, int, int, struct sockaddr *, int *);
-typedef int (SOCKETAPI *LPSOCKSELECT)(int, fd_set *, fd_set *, fd_set *, const struct timeval *);
-typedef int (SOCKETAPI *LPSOCKSEND)(SOCKET, const char *, int, int);
-typedef int (SOCKETAPI *LPSOCKSENDTO)(SOCKET, const char *, int, int, const struct sockaddr *, int);
-typedef int (SOCKETAPI *LPSOCKSETSOCKOPT)(SOCKET, int, int, const char *, int);
-typedef int (SOCKETAPI *LPSOCKSHUTDOWN)(SOCKET, int);
-typedef SOCKET (SOCKETAPI *LPSOCKSOCKET)(int, int, int);
-typedef char FAR *(SOCKETAPI *LPSOCKINETNTOA)(struct in_addr in);
-typedef unsigned long (SOCKETAPI *LPSOCKINETADDR)(const char FAR * cp);
-
-
-/* Database function prototypes */
-typedef struct hostent *(SOCKETAPI *LPSOCKGETHOSTBYADDR)(const char *, int, int);
-typedef struct hostent *(SOCKETAPI *LPSOCKGETHOSTBYNAME)(const char *);
-typedef int (SOCKETAPI *LPSOCKGETHOSTNAME)(char *, int);
-typedef struct servent *(SOCKETAPI *LPSOCKGETSERVBYPORT)(int, const char *);
-typedef struct servent *(SOCKETAPI *LPSOCKGETSERVBYNAME)(const char *, const char *);
-typedef struct protoent *(SOCKETAPI *LPSOCKGETPROTOBYNUMBER)(int);
-typedef struct protoent *(SOCKETAPI *LPSOCKGETPROTOBYNAME)(const char *);
-
-/* Microsoft Windows Extension function prototypes */
-typedef int (SOCKETAPI *LPSOCKWSASTARTUP)(unsigned short, LPWSADATA);
-typedef int (SOCKETAPI *LPSOCKWSACLEANUP)(void);
-typedef int (SOCKETAPI *LPSOCKWSAGETLASTERROR)(void);
-typedef int (SOCKETAPI *LPWSAFDIsSet)(SOCKET, fd_set *);
-
-static HINSTANCE hWinSockDll = 0;
-/* extern CRITICAL_SECTION csSock; */
-
-static LPSOCKACCEPT paccept = 0;
-static LPSOCKBIND pbind = 0;
-static LPSOCKCLOSESOCKET pclosesocket = 0;
-static LPSOCKCONNECT pconnect = 0;
-static LPSOCKIOCTLSOCKET pioctlsocket = 0;
-static LPSOCKGETPEERNAME pgetpeername = 0;
-static LPSOCKGETSOCKNAME pgetsockname = 0;
-static LPSOCKGETSOCKOPT pgetsockopt = 0;
-static LPSOCKHTONL phtonl = 0;
-static LPSOCKHTONS phtons = 0;
-static LPSOCKLISTEN plisten = 0;
-static LPSOCKNTOHL pntohl = 0;
-static LPSOCKNTOHS pntohs = 0;
-static LPSOCKRECV precv = 0;
-static LPSOCKRECVFROM precvfrom = 0;
-static LPSOCKSELECT pselect = 0;
-static LPSOCKSEND psend = 0;
-static LPSOCKSENDTO psendto = 0;
-static LPSOCKSETSOCKOPT psetsockopt = 0;
-static LPSOCKSHUTDOWN pshutdown = 0;
-static LPSOCKSOCKET psocket = 0;
-static LPSOCKGETHOSTBYADDR pgethostbyaddr = 0;
-static LPSOCKGETHOSTBYNAME pgethostbyname = 0;
-static LPSOCKGETHOSTNAME pgethostname = 0;
-static LPSOCKGETSERVBYPORT pgetservbyport = 0;
-static LPSOCKGETSERVBYNAME pgetservbyname = 0;
-static LPSOCKGETPROTOBYNUMBER pgetprotobynumber = 0;
-static LPSOCKGETPROTOBYNAME pgetprotobyname = 0;
-static LPSOCKWSASTARTUP pWSAStartup = 0;
-static LPSOCKWSACLEANUP pWSACleanup = 0;
-static LPSOCKWSAGETLASTERROR pWSAGetLastError = 0;
-static LPWSAFDIsSet pWSAFDIsSet = 0;
-static LPSOCKINETNTOA pinet_ntoa = 0;
-static LPSOCKINETADDR pinet_addr = 0;
+#ifdef USE_THREADS
+#ifdef USE_DECLSPEC_THREAD
__declspec(thread) struct servent myservent;
+__declspec(thread) int init_socktype;
+#else
+#define myservent (thr->i.Wservent)
+#define init_socktype (thr->i.Winit_socktype)
+#endif
+#else
+static struct servent myservent;
+#endif
-
-void *
-GetAddress(HINSTANCE hInstance, char *lpFunctionName)
-{
- FARPROC proc = GetProcAddress(hInstance, lpFunctionName);
- if(proc == 0)
- CROAK("Unable to get address of %s in WSock32.dll", lpFunctionName);
- return proc;
-}
-
-void
-LoadWinSock(void)
-{
-/* EnterCriticalSection(&csSock); */
- if(hWinSockDll == NULL) {
- HINSTANCE hLib = LoadLibrary("WSock32.DLL");
- if(hLib == NULL)
- CROAK("Could not load WSock32.dll\n");
-
- paccept = (LPSOCKACCEPT)GetAddress(hLib, "accept");
- pbind = (LPSOCKBIND)GetAddress(hLib, "bind");
- pclosesocket = (LPSOCKCLOSESOCKET)GetAddress(hLib, "closesocket");
- pconnect = (LPSOCKCONNECT)GetAddress(hLib, "connect");
- pioctlsocket = (LPSOCKIOCTLSOCKET)GetAddress(hLib, "ioctlsocket");
- pgetpeername = (LPSOCKGETPEERNAME)GetAddress(hLib, "getpeername");
- pgetsockname = (LPSOCKGETSOCKNAME)GetAddress(hLib, "getsockname");
- pgetsockopt = (LPSOCKGETSOCKOPT)GetAddress(hLib, "getsockopt");
- phtonl = (LPSOCKHTONL)GetAddress(hLib, "htonl");
- phtons = (LPSOCKHTONS)GetAddress(hLib, "htons");
- plisten = (LPSOCKLISTEN)GetAddress(hLib, "listen");
- pntohl = (LPSOCKNTOHL)GetAddress(hLib, "ntohl");
- pntohs = (LPSOCKNTOHS)GetAddress(hLib, "ntohs");
- precv = (LPSOCKRECV)GetAddress(hLib, "recv");
- precvfrom = (LPSOCKRECVFROM)GetAddress(hLib, "recvfrom");
- pselect = (LPSOCKSELECT)GetAddress(hLib, "select");
- psend = (LPSOCKSEND)GetAddress(hLib, "send");
- psendto = (LPSOCKSENDTO)GetAddress(hLib, "sendto");
- psetsockopt = (LPSOCKSETSOCKOPT)GetAddress(hLib, "setsockopt");
- pshutdown = (LPSOCKSHUTDOWN)GetAddress(hLib, "shutdown");
- psocket = (LPSOCKSOCKET)GetAddress(hLib, "socket");
- pgethostbyaddr = (LPSOCKGETHOSTBYADDR)GetAddress(hLib, "gethostbyaddr");
- pgethostbyname = (LPSOCKGETHOSTBYNAME)GetAddress(hLib, "gethostbyname");
- pgethostname = (LPSOCKGETHOSTNAME)GetAddress(hLib, "gethostname");
- pgetservbyport = (LPSOCKGETSERVBYPORT)GetAddress(hLib, "getservbyport");
- pgetservbyname = (LPSOCKGETSERVBYNAME)GetAddress(hLib, "getservbyname");
- pgetprotobynumber = (LPSOCKGETPROTOBYNUMBER)GetAddress(hLib, "getprotobynumber");
- pgetprotobyname = (LPSOCKGETPROTOBYNAME)GetAddress(hLib, "getprotobyname");
- pWSAStartup = (LPSOCKWSASTARTUP)GetAddress(hLib, "WSAStartup");
- pWSACleanup = (LPSOCKWSACLEANUP)GetAddress(hLib, "WSACleanup");
- pWSAGetLastError = (LPSOCKWSAGETLASTERROR)GetAddress(hLib, "WSAGetLastError");
- pWSAFDIsSet = (LPWSAFDIsSet)GetAddress(hLib, "__WSAFDIsSet");
- pinet_addr = (LPSOCKINETADDR)GetAddress(hLib,"inet_addr");
- pinet_ntoa = (LPSOCKINETNTOA)GetAddress(hLib,"inet_ntoa");
-
- hWinSockDll = hLib;
- }
-/* LeaveCriticalSection(&csSock); */
-}
-
-void
-EndSockets(void)
-{
- if(hWinSockDll != NULL) {
- pWSACleanup();
- FreeLibrary(hWinSockDll);
- }
- hWinSockDll = NULL;
-}
+static int wsock_started = 0;
void
-StartSockets(void)
+start_sockets(void)
{
unsigned short version;
WSADATA retdata;
int ret;
- int iSockOpt = SO_SYNCHRONOUS_NONALERT;
- LoadWinSock();
/*
* initalize the winsock interface and insure that it is
* cleaned up at exit.
*/
version = 0x101;
- if(ret = pWSAStartup(version, &retdata))
- CROAK("Unable to locate winsock library!\n");
+ if(ret = WSAStartup(version, &retdata))
+ croak("Unable to locate winsock library!\n");
if(retdata.wVersion != version)
- CROAK("Could not find version 1.1 of winsock dll\n");
+ croak("Could not find version 1.1 of winsock dll\n");
/* atexit((void (*)(void)) EndSockets); */
+ wsock_started = 1;
+}
+void
+set_socktype(void)
+{
#ifdef USE_SOCKETS_AS_HANDLES
+#ifdef USE_THREADS
+ dTHR;
+ if(!init_socktype) {
+#endif
+ int iSockOpt = SO_SYNCHRONOUS_NONALERT;
/*
* Enable the use of sockets as filehandles
*/
- psetsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
+ setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
(char *)&iSockOpt, sizeof(iSockOpt));
+#ifdef USE_THREADS
+ init_socktype = 1;
+ }
+#endif
#endif /* USE_SOCKETS_AS_HANDLES */
}
#ifndef USE_SOCKETS_AS_HANDLES
+#undef fdopen
FILE *
-myfdopen(int fd, char *mode)
+my_fdopen(int fd, char *mode)
{
FILE *fp;
char sockbuf[256];
int optlen = sizeof(sockbuf);
int retval;
- if (hWinSockDll == 0)
+ if (!wsock_started)
return(fdopen(fd, mode));
- retval = pgetsockopt((SOCKET)fd, SOL_SOCKET, SO_TYPE, sockbuf, &optlen);
- if(retval == SOCKET_ERROR && pWSAGetLastError() == WSAENOTSOCK) {
+ retval = getsockopt((SOCKET)fd, SOL_SOCKET, SO_TYPE, sockbuf, &optlen);
+ if(retval == SOCKET_ERROR && WSAGetLastError() == WSAENOTSOCK) {
return(fdopen(fd, mode));
}
@@ -257,51 +174,39 @@ myfdopen(int fd, char *mode)
u_long
win32_htonl(u_long hostlong)
{
- if(hWinSockDll == 0)
- StartSockets();
-
- return phtonl(hostlong);
+ StartSockets();
+ return htonl(hostlong);
}
u_short
win32_htons(u_short hostshort)
{
- if(hWinSockDll == 0)
- StartSockets();
-
- return phtons(hostshort);
+ StartSockets();
+ return htons(hostshort);
}
u_long
win32_ntohl(u_long netlong)
{
- if(hWinSockDll == 0)
- StartSockets();
-
- return pntohl(netlong);
+ StartSockets();
+ return ntohl(netlong);
}
u_short
win32_ntohs(u_short netshort)
{
- if(hWinSockDll == 0)
- StartSockets();
-
- return pntohs(netshort);
+ StartSockets();
+ return ntohs(netshort);
}
-#define SOCKET_TEST(x, y) if(hWinSockDll == 0) StartSockets();\
- if((x) == (y)) errno = pWSAGetLastError()
-
-#define SOCKET_TEST_ERROR(x) SOCKET_TEST(x, SOCKET_ERROR)
SOCKET
win32_accept(SOCKET s, struct sockaddr *addr, int *addrlen)
{
SOCKET r;
- SOCKET_TEST((r = paccept(TO_SOCKET(s), addr, addrlen)), INVALID_SOCKET);
+ SOCKET_TEST((r = accept(TO_SOCKET(s), addr, addrlen)), INVALID_SOCKET);
return OPEN_SOCKET(r);
}
@@ -310,7 +215,7 @@ win32_bind(SOCKET s, const struct sockaddr *addr, int addrlen)
{
int r;
- SOCKET_TEST_ERROR(r = pbind(TO_SOCKET(s), addr, addrlen));
+ SOCKET_TEST_ERROR(r = bind(TO_SOCKET(s), addr, addrlen));
return r;
}
@@ -319,7 +224,7 @@ win32_connect(SOCKET s, const struct sockaddr *addr, int addrlen)
{
int r;
- SOCKET_TEST_ERROR(r = pconnect(TO_SOCKET(s), addr, addrlen));
+ SOCKET_TEST_ERROR(r = connect(TO_SOCKET(s), addr, addrlen));
return r;
}
@@ -329,7 +234,7 @@ win32_getpeername(SOCKET s, struct sockaddr *addr, int *addrlen)
{
int r;
- SOCKET_TEST_ERROR(r = pgetpeername(TO_SOCKET(s), addr, addrlen));
+ SOCKET_TEST_ERROR(r = getpeername(TO_SOCKET(s), addr, addrlen));
return r;
}
@@ -338,7 +243,7 @@ win32_getsockname(SOCKET s, struct sockaddr *addr, int *addrlen)
{
int r;
- SOCKET_TEST_ERROR(r = pgetsockname(TO_SOCKET(s), addr, addrlen));
+ SOCKET_TEST_ERROR(r = getsockname(TO_SOCKET(s), addr, addrlen));
return r;
}
@@ -347,7 +252,7 @@ win32_getsockopt(SOCKET s, int level, int optname, char *optval, int *optlen)
{
int r;
- SOCKET_TEST_ERROR(r = pgetsockopt(TO_SOCKET(s), level, optname, optval, optlen));
+ SOCKET_TEST_ERROR(r = getsockopt(TO_SOCKET(s), level, optname, optval, optlen));
return r;
}
@@ -356,7 +261,7 @@ win32_ioctlsocket(SOCKET s, long cmd, u_long *argp)
{
int r;
- SOCKET_TEST_ERROR(r = pioctlsocket(TO_SOCKET(s), cmd, argp));
+ SOCKET_TEST_ERROR(r = ioctlsocket(TO_SOCKET(s), cmd, argp));
return r;
}
@@ -365,7 +270,7 @@ win32_listen(SOCKET s, int backlog)
{
int r;
- SOCKET_TEST_ERROR(r = plisten(TO_SOCKET(s), backlog));
+ SOCKET_TEST_ERROR(r = listen(TO_SOCKET(s), backlog));
return r;
}
@@ -374,7 +279,7 @@ win32_recv(SOCKET s, char *buf, int len, int flags)
{
int r;
- SOCKET_TEST_ERROR(r = precv(TO_SOCKET(s), buf, len, flags));
+ SOCKET_TEST_ERROR(r = recv(TO_SOCKET(s), buf, len, flags));
return r;
}
@@ -382,20 +287,41 @@ int
win32_recvfrom(SOCKET s, char *buf, int len, int flags, struct sockaddr *from, int *fromlen)
{
int r;
+ int frombufsize = *fromlen;
- SOCKET_TEST_ERROR(r = precvfrom(TO_SOCKET(s), buf, len, flags, from, fromlen));
+ SOCKET_TEST_ERROR(r = recvfrom(TO_SOCKET(s), buf, len, flags, from, fromlen));
+ /* Winsock's recvfrom() only returns a valid 'from' when the socket
+ * is connectionless. Perl expects a valid 'from' for all types
+ * of sockets, so go the extra mile.
+ */
+ if (r != SOCKET_ERROR && frombufsize == *fromlen)
+ (void)win32_getpeername(s, from, fromlen);
return r;
}
/* select contributed by Vincent R. Slyngstad (vrs@ibeam.intel.com) */
int
-win32_select(int nfds, int* rd, int* wr, int* ex, const struct timeval* timeout)
+win32_select(int nfds, Perl_fd_set* rd, Perl_fd_set* wr, Perl_fd_set* ex, const struct timeval* timeout)
{
- long r;
- int dummy = 0;
+ int r;
+#ifdef USE_SOCKETS_AS_HANDLES
+ Perl_fd_set dummy;
int i, fd, bit, offset;
- FD_SET nrd, nwr, nex,*prd,*pwr,*pex;
+ FD_SET nrd, nwr, nex, *prd, *pwr, *pex;
+ /* winsock seems incapable of dealing with all three null fd_sets,
+ * so do the (millisecond) sleep as a special case
+ */
+ if (!(rd || wr || ex)) {
+ if (timeout)
+ Sleep(timeout->tv_sec * 1000 +
+ timeout->tv_usec / 1000); /* do the best we can */
+ else
+ Sleep(UINT_MAX);
+ return 0;
+ }
+ StartSockets();
+ PERL_FD_ZERO(&dummy);
if (!rd)
rd = &dummy, prd = NULL;
else
@@ -414,35 +340,28 @@ win32_select(int nfds, int* rd, int* wr, int* ex, const struct timeval* timeout)
FD_ZERO(&nex);
for (i = 0; i < nfds; i++) {
fd = TO_SOCKET(i);
- bit = 1L<<(i % (sizeof(int)*8));
- offset = i / (sizeof(int)*8);
- if (rd[offset] & bit)
+ if (PERL_FD_ISSET(i,rd))
FD_SET(fd, &nrd);
- if (wr[offset] & bit)
+ if (PERL_FD_ISSET(i,wr))
FD_SET(fd, &nwr);
- if (ex[offset] & bit)
+ if (PERL_FD_ISSET(i,ex))
FD_SET(fd, &nex);
}
- SOCKET_TEST_ERROR(r = pselect(nfds, prd, pwr, pex, timeout));
+ SOCKET_TEST_ERROR(r = select(nfds, prd, pwr, pex, timeout));
for (i = 0; i < nfds; i++) {
fd = TO_SOCKET(i);
- bit = 1L<<(i % (sizeof(int)*8));
- offset = i / (sizeof(int)*8);
- if (rd[offset] & bit) {
- if (!pWSAFDIsSet(fd, &nrd))
- rd[offset] &= ~bit;
- }
- if (wr[offset] & bit) {
- if (!pWSAFDIsSet(fd, &nwr))
- wr[offset] &= ~bit;
- }
- if (ex[offset] & bit) {
- if (!pWSAFDIsSet(fd, &nex))
- ex[offset] &= ~bit;
- }
+ if (PERL_FD_ISSET(i,rd) && !FD_ISSET(fd, &nrd))
+ PERL_FD_CLR(i,rd);
+ if (PERL_FD_ISSET(i,wr) && !FD_ISSET(fd, &nwr))
+ PERL_FD_CLR(i,wr);
+ if (PERL_FD_ISSET(i,ex) && !FD_ISSET(fd, &nex))
+ PERL_FD_CLR(i,ex);
}
+#else
+ SOCKET_TEST_ERROR(r = select(nfds, rd, wr, ex, timeout));
+#endif
return r;
}
@@ -451,7 +370,7 @@ win32_send(SOCKET s, const char *buf, int len, int flags)
{
int r;
- SOCKET_TEST_ERROR(r = psend(TO_SOCKET(s), buf, len, flags));
+ SOCKET_TEST_ERROR(r = send(TO_SOCKET(s), buf, len, flags));
return r;
}
@@ -461,7 +380,7 @@ win32_sendto(SOCKET s, const char *buf, int len, int flags,
{
int r;
- SOCKET_TEST_ERROR(r = psendto(TO_SOCKET(s), buf, len, flags, to, tolen));
+ SOCKET_TEST_ERROR(r = sendto(TO_SOCKET(s), buf, len, flags, to, tolen));
return r;
}
@@ -470,7 +389,7 @@ win32_setsockopt(SOCKET s, int level, int optname, const char *optval, int optle
{
int r;
- SOCKET_TEST_ERROR(r = psetsockopt(TO_SOCKET(s), level, optname, optval, optlen));
+ SOCKET_TEST_ERROR(r = setsockopt(TO_SOCKET(s), level, optname, optval, optlen));
return r;
}
@@ -479,7 +398,16 @@ win32_shutdown(SOCKET s, int how)
{
int r;
- SOCKET_TEST_ERROR(r = pshutdown(TO_SOCKET(s), how));
+ SOCKET_TEST_ERROR(r = shutdown(TO_SOCKET(s), how));
+ return r;
+}
+
+int
+win32_closesocket(SOCKET s)
+{
+ int r;
+
+ SOCKET_TEST_ERROR(r = closesocket(TO_SOCKET(s)));
return r;
}
@@ -489,13 +417,11 @@ win32_socket(int af, int type, int protocol)
SOCKET s;
#ifndef USE_SOCKETS_AS_HANDLES
- SOCKET_TEST(s = psocket(af, type, protocol), INVALID_SOCKET);
+ SOCKET_TEST(s = socket(af, type, protocol), INVALID_SOCKET);
#else
- if(hWinSockDll == 0)
- StartSockets();
-
- if((s = psocket(af, type, protocol)) == INVALID_SOCKET)
- errno = pWSAGetLastError();
+ StartSockets();
+ if((s = socket(af, type, protocol)) == INVALID_SOCKET)
+ errno = WSAGetLastError();
else
s = OPEN_SOCKET(s);
#endif /* USE_SOCKETS_AS_HANDLES */
@@ -507,16 +433,18 @@ win32_socket(int af, int type, int protocol)
int
my_fclose (FILE *pf)
{
- int osf, retval;
- if (hWinSockDll == 0) /* No WinSockDLL? */
- return(fclose(pf)); /* Then not a socket. */
- osf = TO_SOCKET(fileno(pf)); /* Get it now before it's gone! */
- retval = fclose(pf); /* Must fclose() before closesocket() */
- if (osf != -1
- && pclosesocket(osf) == SOCKET_ERROR
- && WSAGetLastError() != WSAENOTSOCK)
- retval = EOF;
- return retval;
+ int osf, retval;
+ if (!wsock_started) /* No WinSock? */
+ return(fclose(pf)); /* Then not a socket. */
+ osf = TO_SOCKET(fileno(pf));/* Get it now before it's gone! */
+ retval = fclose(pf); /* Must fclose() before closesocket() */
+ if (osf != -1
+ && closesocket(osf) == SOCKET_ERROR
+ && WSAGetLastError() != WSAENOTSOCK)
+ {
+ return EOF;
+ }
+ return retval;
}
struct hostent *
@@ -524,7 +452,7 @@ win32_gethostbyaddr(const char *addr, int len, int type)
{
struct hostent *r;
- SOCKET_TEST(r = pgethostbyaddr(addr, len, type), NULL);
+ SOCKET_TEST(r = gethostbyaddr(addr, len, type), NULL);
return r;
}
@@ -533,7 +461,7 @@ win32_gethostbyname(const char *name)
{
struct hostent *r;
- SOCKET_TEST(r = pgethostbyname(name), NULL);
+ SOCKET_TEST(r = gethostbyname(name), NULL);
return r;
}
@@ -542,7 +470,7 @@ win32_gethostname(char *name, int len)
{
int r;
- SOCKET_TEST_ERROR(r = pgethostname(name, len));
+ SOCKET_TEST_ERROR(r = gethostname(name, len));
return r;
}
@@ -551,7 +479,7 @@ win32_getprotobyname(const char *name)
{
struct protoent *r;
- SOCKET_TEST(r = pgetprotobyname(name), NULL);
+ SOCKET_TEST(r = getprotobyname(name), NULL);
return r;
}
@@ -560,7 +488,7 @@ win32_getprotobynumber(int num)
{
struct protoent *r;
- SOCKET_TEST(r = pgetprotobynumber(num), NULL);
+ SOCKET_TEST(r = getprotobynumber(num), NULL);
return r;
}
@@ -568,8 +496,9 @@ struct servent *
win32_getservbyname(const char *name, const char *proto)
{
struct servent *r;
-
- SOCKET_TEST(r = pgetservbyname(name, proto), NULL);
+ dTHR;
+
+ SOCKET_TEST(r = getservbyname(name, proto), NULL);
if (r) {
r = win32_savecopyservent(&myservent, r, proto);
}
@@ -580,130 +509,142 @@ struct servent *
win32_getservbyport(int port, const char *proto)
{
struct servent *r;
+ dTHR;
- SOCKET_TEST(r = pgetservbyport(port, proto), NULL);
+ SOCKET_TEST(r = getservbyport(port, proto), NULL);
if (r) {
r = win32_savecopyservent(&myservent, r, proto);
}
return r;
}
+int
+win32_ioctl(int i, unsigned int u, char *data)
+{
+ u_long argp = (u_long)data;
+ int retval;
+
+ if (!wsock_started) {
+ croak("ioctl implemented only on sockets");
+ /* NOTREACHED */
+ }
+
+ retval = ioctlsocket(TO_SOCKET(i), (long)u, &argp);
+ if (retval == SOCKET_ERROR) {
+ if (WSAGetLastError() == WSAENOTSOCK) {
+ croak("ioctl implemented only on sockets");
+ /* NOTREACHED */
+ }
+ errno = WSAGetLastError();
+ }
+ return retval;
+}
+
char FAR *
win32_inet_ntoa(struct in_addr in)
{
- if(hWinSockDll == 0)
- StartSockets();
-
- return pinet_ntoa(in);
+ StartSockets();
+ return inet_ntoa(in);
}
unsigned long
win32_inet_addr(const char FAR *cp)
{
- if(hWinSockDll == 0)
- StartSockets();
-
- return pinet_addr(cp);
-
+ StartSockets();
+ return inet_addr(cp);
}
/*
* Networking stubs
*/
-#undef CROAK
-#define CROAK croak
void
win32_endhostent()
{
- CROAK("endhostent not implemented!\n");
+ croak("endhostent not implemented!\n");
}
void
win32_endnetent()
{
- CROAK("endnetent not implemented!\n");
+ croak("endnetent not implemented!\n");
}
void
win32_endprotoent()
{
- CROAK("endprotoent not implemented!\n");
+ croak("endprotoent not implemented!\n");
}
void
win32_endservent()
{
- CROAK("endservent not implemented!\n");
+ croak("endservent not implemented!\n");
}
struct netent *
win32_getnetent(void)
{
- CROAK("getnetent not implemented!\n");
+ croak("getnetent not implemented!\n");
return (struct netent *) NULL;
}
struct netent *
win32_getnetbyname(char *name)
{
- CROAK("getnetbyname not implemented!\n");
+ croak("getnetbyname not implemented!\n");
return (struct netent *)NULL;
}
struct netent *
win32_getnetbyaddr(long net, int type)
{
- CROAK("getnetbyaddr not implemented!\n");
+ croak("getnetbyaddr not implemented!\n");
return (struct netent *)NULL;
}
struct protoent *
win32_getprotoent(void)
{
- CROAK("getprotoent not implemented!\n");
+ croak("getprotoent not implemented!\n");
return (struct protoent *) NULL;
}
struct servent *
win32_getservent(void)
{
- CROAK("getservent not implemented!\n");
+ croak("getservent not implemented!\n");
return (struct servent *) NULL;
}
void
win32_sethostent(int stayopen)
{
- CROAK("sethostent not implemented!\n");
+ croak("sethostent not implemented!\n");
}
void
win32_setnetent(int stayopen)
{
- CROAK("setnetent not implemented!\n");
+ croak("setnetent not implemented!\n");
}
void
win32_setprotoent(int stayopen)
{
- CROAK("setprotoent not implemented!\n");
+ croak("setprotoent not implemented!\n");
}
void
win32_setservent(int stayopen)
{
- CROAK("setservent not implemented!\n");
+ croak("setservent not implemented!\n");
}
-#define WIN32IO_IS_STDIO
-#include <io.h>
-#include "win32iop.h"
-
static struct servent*
win32_savecopyservent(struct servent*d, struct servent*s, const char *proto)
{
@@ -715,7 +656,7 @@ win32_savecopyservent(struct servent*d, struct servent*s, const char *proto)
d->s_proto = s->s_proto;
else
#endif
- if (proto && strlen(proto))
+ if (proto && strlen(proto))
d->s_proto = (char *)proto;
else
d->s_proto = "tcp";
diff --git a/gnu/usr.bin/perl/x2p/Makefile.SH b/gnu/usr.bin/perl/x2p/Makefile.SH
index 65a3d75ec1d..1f92d5d2317 100644
--- a/gnu/usr.bin/perl/x2p/Makefile.SH
+++ b/gnu/usr.bin/perl/x2p/Makefile.SH
@@ -36,8 +36,10 @@ BYACC = $byacc
LDFLAGS = $ldflags
SMALL = $small
LARGE = $large $split
-mallocsrc = $mallocsrc
-mallocobj = $mallocobj
+# XXX Perl malloc temporarily unusable (declaration collisions with
+# stdlib.h)
+#mallocsrc = $mallocsrc
+#mallocobj = $mallocobj
shellflags = $shellflags
libs = $libs
@@ -46,22 +48,26 @@ $make_set_make
# grrr
SHELL = $sh
-# These variables will be used in a future version to make
-# the make file more portable to non-unix systems.
+# These variables may need to be manually set for non-Unix systems.
AR = $ar
-EXE_EXT = $exe_ext
-LIB_EXT = $lib_ext
-OBJ_EXT = $obj_ext
-PATH_SEP = $path_sep
+EXE_EXT = $_ext
+LIB_EXT = $_a
+OBJ_EXT = $_o
+PATH_SEP = $p_
FIRSTMAKEFILE = $firstmakefile
+# how to tr(anslate) newlines
+
+TRNL = '$trnl'
+
.SUFFIXES: .c \$(OBJ_EXT)
!GROK!THIS!
cat >>Makefile <<'!NO!SUBS!'
+REALPERL = ../perl
CCCMD = `sh $(shellflags) cflags $@`
public = a2p s2p find2perl
@@ -77,6 +83,8 @@ shextract = Makefile cflags
pl = find2perl.PL s2p.PL
plextract = find2perl s2p
+plexe = find2perl.exe s2p.exe
+plc = find2perl.c s2p.c
addedbyconf = $(shextract) $(plextract)
@@ -93,10 +101,13 @@ lintflags = -phbvxac
$(CCCMD) -DPERL_FOR_X2P $*.c
all: $(public) $(private) $(util)
- touch all
+ @echo " "
+
+compile: all
+ $(REALPERL) -I../lib ../utils/perlcc -regex 's/$$/.exe/' $(plextract) -prog -verbose dcf -log ../compilelog;
a2p: $(obj) a2p$(OBJ_EXT)
- $(CC) $(LDFLAGS) $(obj) a2p$(OBJ_EXT) $(libs) -o a2p
+ $(CC) -o a2p $(LDFLAGS) $(obj) a2p$(OBJ_EXT) $(libs)
# I now supply a2p.c with the kits, so the following section is
# used only if you force byacc to run by saying
@@ -105,19 +116,20 @@ a2p: $(obj) a2p$(OBJ_EXT)
run_byacc: FORCE
@ echo Expect many shift/reduce and reduce/reduce conflicts
$(BYACC) a2p.y
+ rm -f a2p.c
mv y.tab.c a2p.c
# We don't want to regenerate a2p.c, but it might appear out-of-date
# after a patch is applied or a new distribution is made.
a2p.c: a2p.y
- -@touch a2p.c
+ -@sh -c true
a2p$(OBJ_EXT): a2p.c a2py.c a2p.h EXTERN.h util.h INTERN.h \
../handy.h ../config.h str.h hash.h
$(CCCMD) $(LARGE) a2p.c
clean:
- rm -f a2p *$(OBJ_EXT)
+ rm -f a2p *$(OBJ_EXT) $(plexe) $(plc)
realclean: clean
rm -f *.orig core $(addedbyconf) all malloc.c
@@ -135,13 +147,13 @@ depend: $(mallocsrc) ../makedepend
sh ../makedepend MAKE=$(MAKE)
clist:
- echo $(c) | tr ' ' '\012' >.clist
+ echo $(c) | tr ' ' $(TRNL) >.clist
hlist:
- echo $(h) | tr ' ' '\012' >.hlist
+ echo $(h) | tr ' ' $(TRNL) >.hlist
shlist:
- echo $(sh) | tr ' ' '\012' >.shlist
+ echo $(sh) | tr ' ' $(TRNL) >.shlist
# These should be automatically generated
@@ -153,7 +165,8 @@ malloc.c: ../malloc.c
sed <../malloc.c >malloc.c \
-e 's/"EXTERN.h"/"..\/EXTERN.h"/' \
-e 's/"perl.h"/"..\/perl.h"/' \
- -e 's/my_exit/exit/'
+ -e 's/my_exit/exit/' \
+ -e 's/MUTEX_[A-Z_]*(&PL_malloc_mutex);//'
# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
$(obj):
diff --git a/gnu/usr.bin/perl/x2p/a2p.c b/gnu/usr.bin/perl/x2p/a2p.c
index 340e4bfad60..e79e1562034 100644
--- a/gnu/usr.bin/perl/x2p/a2p.c
+++ b/gnu/usr.bin/perl/x2p/a2p.c
@@ -2014,7 +2014,9 @@ yyparse()
register int yym, yyn, yystate;
#if YYDEBUG
register char *yys;
+#ifndef __cplusplus
extern char *getenv();
+#endif
if (yys = getenv("YYDEBUG"))
{
diff --git a/gnu/usr.bin/perl/x2p/a2p.h b/gnu/usr.bin/perl/x2p/a2p.h
index b00b0723eab..80530469ed0 100644
--- a/gnu/usr.bin/perl/x2p/a2p.h
+++ b/gnu/usr.bin/perl/x2p/a2p.h
@@ -9,6 +9,11 @@
*/
#define VOIDUSED 1
+
+#ifdef WIN32
+#define _INC_WIN32_PERL5 /* kludge around win32 stdio layer */
+#endif
+
#ifdef VMS
# include "config.h"
#else
@@ -19,6 +24,26 @@
# define STANDARD_C 1
#endif
+#ifdef WIN32
+#undef USE_STDIO_PTR /* XXX fast gets won't work, must investigate */
+# ifndef STANDARD_C
+# define STANDARD_C
+# endif
+# if defined(__BORLANDC__)
+# pragma warn -ccc
+# pragma warn -rch
+# pragma warn -sig
+# pragma warn -pia
+# pragma warn -par
+# pragma warn -aus
+# pragma warn -use
+# pragma warn -csu
+# pragma warn -pro
+# elif defined(_MSC_VER)
+# elif defined(__MINGW32__)
+# endif
+#endif
+
/* Use all the "standard" definitions? */
#if defined(STANDARD_C) && defined(I_STDLIB)
# include <stdlib.h>
@@ -63,10 +88,10 @@
# include <strings.h>
#endif
-#ifndef HAS_BCOPY
+#if !defined(HAS_BCOPY) || defined(__cplusplus)
# define bcopy(s1,s2,l) memcpy(s2,s1,l)
#endif
-#ifndef HAS_BZERO
+#if !defined(HAS_BZERO) || defined(__cplusplus)
# define bzero(s,l) memset(s,0,l)
#endif
@@ -387,6 +412,10 @@ EXT int debug INIT(0);
EXT int dlevel INIT(0);
#define YYDEBUG 1
extern int yydebug;
+#else
+# ifndef YYDEBUG
+# define YYDEBUG 0
+# endif
#endif
EXT STR *freestrroot INIT(Nullstr);
diff --git a/gnu/usr.bin/perl/x2p/a2py.c b/gnu/usr.bin/perl/x2p/a2py.c
index 3a3cb5275d1..8a6155f4555 100644
--- a/gnu/usr.bin/perl/x2p/a2py.c
+++ b/gnu/usr.bin/perl/x2p/a2py.c
@@ -8,7 +8,10 @@
* $Log: a2py.c,v $
*/
-#ifdef OS2
+#if defined(OS2) || defined(WIN32)
+#if defined(WIN32)
+#include <io.h>
+#endif
#include "../patchlevel.h"
#endif
#include "util.h"
@@ -18,15 +21,17 @@ char *myname;
int checkers = 0;
-int oper0();
-int oper1();
-int oper2();
-int oper3();
-int oper4();
-int oper5();
-STR *walk();
+int oper0(int type);
+int oper1(int type, int arg1);
+int oper2(int type, int arg1, int arg2);
+int oper3(int type, int arg1, int arg2, int arg3);
+int oper4(int type, int arg1, int arg2, int arg3, int arg4);
+int oper5(int type, int arg1, int arg2, int arg3, int arg4, int arg5);
+STR *walk(int useval, int level, register int node, int *numericptr, int minprec);
+
+#if defined(OS2) || defined(WIN32)
+static void usage(void);
-#ifdef OS2
static void
usage()
{
@@ -44,10 +49,7 @@ usage()
#endif
int
-main(argc,argv,env)
-register int argc;
-register char **argv;
-register char **env;
+main(register int argc, register char **argv, register char **env)
{
register STR *str;
int i;
@@ -64,7 +66,7 @@ register char **env;
#ifdef DEBUGGING
case 'D':
debug = atoi(argv[0]+2);
-#ifdef YYDEBUG
+#if YYDEBUG
yydebug = (debug & 1);
#endif
break;
@@ -89,9 +91,11 @@ register char **env;
case 0:
break;
default:
- fatal("Unrecognized switch: %s\n",argv[0]);
-#ifdef OS2
+#if defined(OS2) || defined(WIN32)
+ fprintf(stderr, "Unrecognized switch: %s\n",argv[0]);
usage();
+#else
+ fatal("Unrecognized switch: %s\n",argv[0]);
#endif
}
}
@@ -100,7 +104,7 @@ register char **env;
/* open script */
if (argv[0] == Nullch) {
-#ifdef OS2
+#if defined(OS2) || defined(WIN32)
if ( isatty(fileno(stdin)) )
usage();
#endif
@@ -200,14 +204,14 @@ register char **env;
int idtype;
int
-yylex()
+yylex(void)
{
register char *s = bufptr;
register char *d;
register int tmp;
retry:
-#ifdef YYDEBUG
+#if YYDEBUG
if (yydebug)
if (strchr(s,'\n'))
fprintf(stderr,"Tokener at %s",s);
@@ -269,7 +273,11 @@ yylex()
case ':':
tmp = *s++;
XOP(tmp);
+#ifdef EBCDIC
+ case 7:
+#else
case 127:
+#endif
s++;
XTERM('}');
case '}':
@@ -794,8 +802,7 @@ yylex()
}
char *
-scanpat(s)
-register char *s;
+scanpat(register char *s)
{
register char *d;
@@ -840,16 +847,14 @@ register char *s;
}
void
-yyerror(s)
-char *s;
+yyerror(char *s)
{
fprintf(stderr,"%s in file %s at line %d\n",
s,filename,line);
}
char *
-scannum(s)
-register char *s;
+scannum(register char *s)
{
register char *d;
@@ -885,16 +890,14 @@ register char *s;
}
int
-string(ptr,len)
-char *ptr;
-int len;
+string(char *ptr, int len)
{
int retval = mop;
ops[mop++].ival = OSTRING + (1<<8);
if (!len)
len = strlen(ptr);
- ops[mop].cval = safemalloc(len+1);
+ ops[mop].cval = (char *) safemalloc(len+1);
strncpy(ops[mop].cval,ptr,len);
ops[mop++].cval[len] = '\0';
if (mop >= OPSMAX)
@@ -903,8 +906,7 @@ int len;
}
int
-oper0(type)
-int type;
+oper0(int type)
{
int retval = mop;
@@ -917,9 +919,7 @@ int type;
}
int
-oper1(type,arg1)
-int type;
-int arg1;
+oper1(int type, int arg1)
{
int retval = mop;
@@ -933,10 +933,7 @@ int arg1;
}
int
-oper2(type,arg1,arg2)
-int type;
-int arg1;
-int arg2;
+oper2(int type, int arg1, int arg2)
{
int retval = mop;
@@ -951,11 +948,7 @@ int arg2;
}
int
-oper3(type,arg1,arg2,arg3)
-int type;
-int arg1;
-int arg2;
-int arg3;
+oper3(int type, int arg1, int arg2, int arg3)
{
int retval = mop;
@@ -971,12 +964,7 @@ int arg3;
}
int
-oper4(type,arg1,arg2,arg3,arg4)
-int type;
-int arg1;
-int arg2;
-int arg3;
-int arg4;
+oper4(int type, int arg1, int arg2, int arg3, int arg4)
{
int retval = mop;
@@ -993,13 +981,7 @@ int arg4;
}
int
-oper5(type,arg1,arg2,arg3,arg4,arg5)
-int type;
-int arg1;
-int arg2;
-int arg3;
-int arg4;
-int arg5;
+oper5(int type, int arg1, int arg2, int arg3, int arg4, int arg5)
{
int retval = mop;
@@ -1019,8 +1001,7 @@ int arg5;
int depth = 0;
void
-dump(branch)
-int branch;
+dump(int branch)
{
register int type;
register int len;
@@ -1047,9 +1028,7 @@ int branch;
}
int
-bl(arg,maybe)
-int arg;
-int maybe;
+bl(int arg, int maybe)
{
if (!arg)
return 0;
@@ -1062,8 +1041,7 @@ int maybe;
}
void
-fixup(str)
-STR *str;
+fixup(STR *str)
{
register char *s;
register char *t;
@@ -1088,8 +1066,7 @@ STR *str;
}
void
-putlines(str)
-STR *str;
+putlines(STR *str)
{
register char *d, *s, *t, *e;
register int pos, newpos;
@@ -1165,7 +1142,7 @@ STR *str;
}
void
-putone()
+putone(void)
{
register char *t;
@@ -1188,8 +1165,7 @@ putone()
}
int
-numary(arg)
-int arg;
+numary(int arg)
{
STR *key;
int dummy;
@@ -1203,8 +1179,7 @@ int arg;
}
int
-rememberargs(arg)
-int arg;
+rememberargs(int arg)
{
int type;
STR *str;
@@ -1226,8 +1201,7 @@ int arg;
}
int
-aryrefarg(arg)
-int arg;
+aryrefarg(int arg)
{
int type = ops[arg].ival & 255;
STR *str;
@@ -1241,10 +1215,7 @@ int arg;
}
int
-fixfargs(name,arg,prevargs)
-int name;
-int arg;
-int prevargs;
+fixfargs(int name, int arg, int prevargs)
{
int type;
STR *str;
@@ -1280,10 +1251,7 @@ int prevargs;
}
int
-fixrargs(name,arg,prevargs)
-char *name;
-int arg;
-int prevargs;
+fixrargs(char *name, int arg, int prevargs)
{
int type;
STR *str;
@@ -1297,7 +1265,7 @@ int prevargs;
numargs = fixrargs(name,ops[arg+3].ival,numargs);
}
else {
- char *tmpbuf = safemalloc(strlen(name) + (sizeof(prevargs) * 3) + 5);
+ char *tmpbuf = (char *) safemalloc(strlen(name) + (sizeof(prevargs) * 3) + 5);
sprintf(tmpbuf,"%s:%d",name,prevargs);
str = hfetch(curarghash,tmpbuf);
safefree(tmpbuf);
diff --git a/gnu/usr.bin/perl/x2p/find2perl.PL b/gnu/usr.bin/perl/x2p/find2perl.PL
index c23fc923a8f..f82b6602e72 100644
--- a/gnu/usr.bin/perl/x2p/find2perl.PL
+++ b/gnu/usr.bin/perl/x2p/find2perl.PL
@@ -2,6 +2,7 @@
use Config;
use File::Basename qw(&basename &dirname);
+use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
@@ -12,6 +13,7 @@ use File::Basename qw(&basename &dirname);
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
@@ -26,7 +28,7 @@ print "Extracting $file (with variable substitutions)\n";
print OUT <<"!GROK!THIS!";
$Config{startperl}
eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
- if \$running_under_some_shell;
+ if \$running_under_some_shell;
\$startperl = "$Config{startperl}";
\$perlpath = "$Config{perlpath}";
!GROK!THIS!
@@ -34,10 +36,16 @@ $Config{startperl}
# In the following, perl variables are not expanded during extraction.
print OUT <<'!NO!SUBS!';
+
#
# Modified September 26, 1993 to provide proper handling of years after 1999
# Tom Link <tml+@pitt.edu>
# University of Pittsburgh
+#
+# Modified April 7, 1998 with nasty hacks to implement the troublesome -follow
+# Billy Constantine <wdconsta@cs.adelaide.edu.au> <billy@smug.adelaide.edu.au>
+# University of Adelaide, Adelaide, South Australia
+#
while ($ARGV[0] =~ /^[^-!(]/) {
push(@roots, shift);
@@ -47,6 +55,8 @@ for (@roots) { $_ = &quote($_); }
$roots = join(',', @roots);
$indent = 1;
+$stat = 'lstat';
+$decl = '';
while (@ARGV) {
$_ = shift;
@@ -60,6 +70,12 @@ while (@ARGV) {
$indent--;
$out .= &tab . ")";
}
+ elsif ($_ eq 'follow') {
+ $stat = 'stat';
+ $decl = '%already_seen = ();';
+ $out .= &tab . '(not $already_seen{"$dev,$ino"}) &&';
+ $out .= "\n" . &tab . '(($already_seen{"$dev,$ino"} = !(-d _)) || 1)';
+ }
elsif ($_ eq '!') {
$out .= &tab . "!";
next;
@@ -178,7 +194,7 @@ while (@ARGV) {
$file = shift;
$newername = 'AGE_OF' . $file;
$newername =~ s/[^\w]/_/g;
- $newername = '$' . $newername;
+ $newername = "\$$newername";
$out .= "(-M _ < $newername)";
$initnewer .= "$newername = -M " . &quote($file) . ";\n";
}
@@ -278,10 +294,10 @@ require "$find.pl";
# Traverse desired filesystems
+$decl
&$find($roots);
$flushall
exit;
-
sub wanted {
$out;
}
@@ -312,10 +328,11 @@ END
}
if ($initls) {
- print <<'END';
+ print <<"INTERP", <<'END';
sub ls {
- ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
- $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
+ (\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid,\$rdev,\$sizemm,
+ \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat\(_\);
+INTERP
$pname = $name;
@@ -380,7 +397,7 @@ END
}
if ($initcpio) {
-print <<'END';
+print <<'START', <<"INTERP", <<'END';
sub cpio {
local($nc,$fh) = @_;
local($text);
@@ -390,8 +407,10 @@ sub cpio {
$size = 0;
}
else {
- ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
- $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
+START
+ (\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid,\$rdev,\$size,
+ \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat\(_\);
+INTERP
if (-f _) {
open(IN, "./$_\0") || do {
warn "Couldn't open $name: $!\n";
@@ -465,14 +484,16 @@ END
}
if ($inittar) {
-print <<'END';
+print <<'START', <<"INTERP", <<'END';
sub tar {
local($fh) = @_;
local($linkname,$header,$l,$slop);
local($linkflag) = "\0";
- ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
- $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
+START
+ (\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid,\$rdev,\$size,
+ \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat\(_\);
+INTERP
$nm = $name;
if ($nlink > 1) {
if ($linkname = $linkseen{$fh,$dev,$ino}) {
@@ -561,13 +582,13 @@ sub tab {
}
else {
if ($saw_or) {
- $tabstring .= <<'ENDOFSTAT' . $tabstring;
-($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
+ $tabstring .= <<"ENDOFSTAT" . $tabstring;
+(\$nlink || ((\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid) = $stat\(\$_\))) &&
ENDOFSTAT
}
else {
- $tabstring .= <<'ENDOFSTAT' . $tabstring;
-(($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
+ $tabstring .= <<"ENDOFSTAT" . $tabstring;
+((\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid) = $stat\(\$_\)) &&
ENDOFSTAT
}
$statdone = 1;
@@ -603,3 +624,4 @@ sub quote {
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;
diff --git a/gnu/usr.bin/perl/x2p/hash.c b/gnu/usr.bin/perl/x2p/hash.c
index 5859eab470f..f11f7dfc55b 100644
--- a/gnu/usr.bin/perl/x2p/hash.c
+++ b/gnu/usr.bin/perl/x2p/hash.c
@@ -14,9 +14,7 @@
#include "util.h"
STR *
-hfetch(tb,key)
-register HASH *tb;
-char *key;
+hfetch(register HASH *tb, char *key)
{
register char *s;
register int i;
@@ -42,10 +40,7 @@ char *key;
}
bool
-hstore(tb,key,val)
-register HASH *tb;
-char *key;
-STR *val;
+hstore(register HASH *tb, char *key, STR *val)
{
register char *s;
register int i;
@@ -70,7 +65,7 @@ STR *val;
if (strNE(entry->hent_key,key)) /* is this it? */
continue;
/*NOSTRICT*/
- Safefree(entry->hent_val);
+ safefree(entry->hent_val);
entry->hent_val = val;
return TRUE;
}
@@ -133,8 +128,7 @@ char *key;
#endif
void
-hsplit(tb)
-HASH *tb;
+hsplit(HASH *tb)
{
int oldsize = tb->tbl_max + 1;
register int newsize = oldsize * 2;
@@ -171,7 +165,7 @@ HASH *tb;
}
HASH *
-hnew()
+hnew(void)
{
register HASH *tb = (HASH*)safemalloc(sizeof(HASH));
@@ -195,8 +189,7 @@ register HASH *tb;
#endif
int
-hiterinit(tb)
-register HASH *tb;
+hiterinit(register HASH *tb)
{
tb->tbl_riter = -1;
tb->tbl_eiter = Null(HENT*);
@@ -204,8 +197,7 @@ register HASH *tb;
}
HENT *
-hiternext(tb)
-register HASH *tb;
+hiternext(register HASH *tb)
{
register HENT *entry;
@@ -228,15 +220,13 @@ register HASH *tb;
}
char *
-hiterkey(entry)
-register HENT *entry;
+hiterkey(register HENT *entry)
{
return entry->hent_key;
}
STR *
-hiterval(entry)
-register HENT *entry;
+hiterval(register HENT *entry)
{
return entry->hent_val;
}
diff --git a/gnu/usr.bin/perl/x2p/s2p.PL b/gnu/usr.bin/perl/x2p/s2p.PL
index 73f67872de1..463465dded3 100644
--- a/gnu/usr.bin/perl/x2p/s2p.PL
+++ b/gnu/usr.bin/perl/x2p/s2p.PL
@@ -2,6 +2,7 @@
use Config;
use File::Basename qw(&basename &dirname);
+use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
@@ -12,6 +13,7 @@ use File::Basename qw(&basename &dirname);
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
@@ -135,7 +137,7 @@ while ($ARGV[0] =~ /^-/) {
}
unless ($debug) {
- open(BODY,">/tmp/sperl$$") ||
+ open(BODY,"+>/tmp/sperl$$") ||
&Die("Can't open temp file: $!\n");
}
@@ -343,26 +345,7 @@ print BODY &q(<<'EOT');
EOT
}
-close BODY;
-
unless ($debug) {
- open(HEAD,">/tmp/sperl2$$.c")
- || &Die("Can't open temp file 2: $!\n");
- print HEAD "#define PRINTIT\n" if $printit;
- print HEAD "#define APPENDSEEN\n" if $appendseen;
- print HEAD "#define TSEEN\n" if $tseen;
- print HEAD "#define DSEEN\n" if $dseen;
- print HEAD "#define ASSUMEN\n" if $assumen;
- print HEAD "#define ASSUMEP\n" if $assumep;
- print HEAD "#define TOPLABEL\n" if $toplabel;
- print HEAD "#define SAWNEXT\n" if $sawnext;
- if ($opens) {print HEAD "$opens\n";}
- open(BODY,"/tmp/sperl$$")
- || &Die("Can't reopen temp file: $!\n");
- while (<BODY>) {
- print HEAD $_;
- }
- close HEAD;
print &q(<<"EOT");
: $startperl
@@ -370,11 +353,13 @@ unless ($debug) {
: if \$running_under_some_shell;
:
EOT
- open(BODY,"cc -E /tmp/sperl2$$.c |") ||
- &Die("Can't reopen temp file: $!\n");
+ print"$opens\n" if $opens;
+ seek(BODY, 0, 0) || die "Can't rewind temp file: $!\n";
while (<BODY>) {
- /^# [0-9]/ && next;
/^[ \t]*$/ && next;
+ /^#ifdef (\w+)/ && ((${lc $1} || &skip), next);
+ /^#else/ && (&skip, next);
+ /^#endif/ && next;
s/^<><>//;
print;
}
@@ -384,8 +369,7 @@ EOT
exit;
sub Cleanup {
- chdir "/tmp";
- unlink "sperl$$", "sperl2$$", "sperl2$$.c";
+ unlink "/tmp/sperl$$";
}
sub Die {
&Cleanup;
@@ -603,7 +587,6 @@ EOT
$repl = substr($_, $repl+1, $end-$repl-1);
$end = substr($_, $end + 1, 1000);
&simplify($pat);
- $dol = '$';
$subst = "$pat$repl$delim";
$cmd = '';
while ($end) {
@@ -688,7 +671,7 @@ EOT
}
if (/^H/) {
- $_ = '$hold .= "\n"; $hold .= $_;';
+ $_ = '$hold .= "\n", $hold .= $_;';
next;
}
@@ -698,7 +681,7 @@ EOT
}
if (/^G/) {
- $_ = '$_ .= "\n"; $_ .= $hold;';
+ $_ = '$_ .= "\n", $_ .= $hold;';
next;
}
@@ -846,8 +829,20 @@ sub simplify {
$_[0] =~ s/([\w\s!@#%^&-=,:;'"])\1\*/$1+/g;
}
+sub skip {
+ local($level) = 0;
+
+ while(<BODY>) {
+ /^#ifdef/ && $level++;
+ /^#else/ && !$level && return;
+ /^#endif/ && !$level-- && return;
+ }
+
+ die "Unterminated `#ifdef' conditional\n";
+}
!NO!SUBS!
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;
diff --git a/gnu/usr.bin/perl/x2p/str.c b/gnu/usr.bin/perl/x2p/str.c
index 88b3c604054..b820a8d67da 100644
--- a/gnu/usr.bin/perl/x2p/str.c
+++ b/gnu/usr.bin/perl/x2p/str.c
@@ -13,9 +13,7 @@
#include "util.h"
void
-str_numset(str,num)
-register STR *str;
-double num;
+str_numset(register STR *str, double num)
{
str->str_nval = num;
str->str_pok = 0; /* invalidate pointer */
@@ -23,8 +21,7 @@ double num;
}
char *
-str_2ptr(str)
-register STR *str;
+str_2ptr(register STR *str)
{
register char *s;
@@ -47,8 +44,7 @@ register STR *str;
}
double
-str_2num(str)
-register STR *str;
+str_2num(register STR *str)
{
if (!str)
return 0.0;
@@ -65,9 +61,7 @@ register STR *str;
}
void
-str_sset(dstr,sstr)
-STR *dstr;
-register STR *sstr;
+str_sset(STR *dstr, register STR *sstr)
{
if (!sstr)
str_nset(dstr,No,0);
@@ -80,10 +74,7 @@ register STR *sstr;
}
void
-str_nset(str,ptr,len)
-register STR *str;
-register char *ptr;
-register int len;
+str_nset(register STR *str, register char *ptr, register int len)
{
GROWSTR(&(str->str_ptr), &(str->str_len), len + 1);
bcopy(ptr,str->str_ptr,len);
@@ -94,9 +85,7 @@ register int len;
}
void
-str_set(str,ptr)
-register STR *str;
-register char *ptr;
+str_set(register STR *str, register char *ptr)
{
register int len;
@@ -111,9 +100,9 @@ register char *ptr;
}
void
-str_chop(str,ptr) /* like set but assuming ptr is in str */
-register STR *str;
-register char *ptr;
+str_chop(register STR *str, register char *ptr) /* like set but assuming ptr is in str */
+
+
{
if (!(str->str_pok))
str_2ptr(str);
@@ -124,10 +113,7 @@ register char *ptr;
}
void
-str_ncat(str,ptr,len)
-register STR *str;
-register char *ptr;
-register int len;
+str_ncat(register STR *str, register char *ptr, register int len)
{
if (!(str->str_pok))
str_2ptr(str);
@@ -140,9 +126,7 @@ register int len;
}
void
-str_scat(dstr,sstr)
-STR *dstr;
-register STR *sstr;
+str_scat(STR *dstr, register STR *sstr)
{
if (!(sstr->str_pok))
str_2ptr(sstr);
@@ -151,9 +135,7 @@ register STR *sstr;
}
void
-str_cat(str,ptr)
-register STR *str;
-register char *ptr;
+str_cat(register STR *str, register char *ptr)
{
register int len;
@@ -170,11 +152,7 @@ register char *ptr;
}
char *
-str_append_till(str,from,delim,keeplist)
-register STR *str;
-register char *from;
-register int delim;
-char *keeplist;
+str_append_till(register STR *str, register char *from, register int delim, char *keeplist)
{
register char *to;
register int len;
@@ -209,8 +187,7 @@ char *keeplist;
}
STR *
-str_new(len)
-int len;
+str_new(int len)
{
register STR *str;
@@ -228,9 +205,7 @@ int len;
}
void
-str_grow(str,len)
-register STR *str;
-int len;
+str_grow(register STR *str, int len)
{
if (len && str)
GROWSTR(&(str->str_ptr), &(str->str_len), len + 1);
@@ -239,11 +214,9 @@ int len;
/* make str point to what nstr did */
void
-str_replace(str,nstr)
-register STR *str;
-register STR *nstr;
+str_replace(register STR *str, register STR *nstr)
{
- Safefree(str->str_ptr);
+ safefree(str->str_ptr);
str->str_ptr = nstr->str_ptr;
str->str_len = nstr->str_len;
str->str_cur = nstr->str_cur;
@@ -254,8 +227,7 @@ register STR *nstr;
}
void
-str_free(str)
-register STR *str;
+str_free(register STR *str)
{
if (!str)
return;
@@ -269,8 +241,7 @@ register STR *str;
}
int
-str_len(str)
-register STR *str;
+str_len(register STR *str)
{
if (!str)
return 0;
@@ -283,9 +254,7 @@ register STR *str;
}
char *
-str_gets(str,fp)
-register STR *str;
-register FILE *fp;
+str_gets(register STR *str, register FILE *fp)
{
#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
/* Here is some breathtakingly efficient cheating */
@@ -366,8 +335,7 @@ thats_all_folks:
}
void
-str_inc(str)
-register STR *str;
+str_inc(register STR *str)
{
register char *d;
@@ -403,8 +371,7 @@ register STR *str;
}
void
-str_dec(str)
-register STR *str;
+str_dec(register STR *str)
{
register char *d;
@@ -436,8 +403,7 @@ register STR *str;
/* make a string that will exist for the duration of the expression eval */
STR *
-str_mortal(oldstr)
-STR *oldstr;
+str_mortal(STR *oldstr)
{
register STR *str = str_new(0);
static long tmps_size = -1;
@@ -458,8 +424,7 @@ STR *oldstr;
}
STR *
-str_make(s)
-char *s;
+str_make(char *s)
{
register STR *str = str_new(0);
@@ -468,8 +433,7 @@ char *s;
}
STR *
-str_nmake(n)
-double n;
+str_nmake(double n)
{
register STR *str = str_new(0);
diff --git a/gnu/usr.bin/perl/x2p/util.c b/gnu/usr.bin/perl/x2p/util.c
index 469beb0c149..364dfe94fa4 100644
--- a/gnu/usr.bin/perl/x2p/util.c
+++ b/gnu/usr.bin/perl/x2p/util.c
@@ -13,9 +13,7 @@
#include "INTERN.h"
#include "util.h"
-#ifdef I_STDARG
-# include <stdarg.h>
-#endif
+#include <stdarg.h>
#define FLUSH
static char nomem[] = "Out of memory!\n";
@@ -24,8 +22,7 @@ static char nomem[] = "Out of memory!\n";
Malloc_t
-safemalloc(size)
-MEM_SIZE size;
+safemalloc(MEM_SIZE size)
{
Malloc_t ptr;
@@ -43,14 +40,13 @@ MEM_SIZE size;
exit(1);
}
/*NOTREACHED*/
+ return 0;
}
/* paranoid version of realloc */
Malloc_t
-saferealloc(where,size)
-Malloc_t where;
-MEM_SIZE size;
+saferealloc(Malloc_t where, MEM_SIZE size)
{
Malloc_t ptr;
@@ -69,13 +65,13 @@ MEM_SIZE size;
exit(1);
}
/*NOTREACHED*/
+ return 0;
}
/* safe version of free */
Free_t
-safefree(where)
-Malloc_t where;
+safefree(Malloc_t where)
{
#ifdef DEBUGGING
if (debug & 128)
@@ -87,10 +83,7 @@ Malloc_t where;
/* safe version of string copy */
char *
-safecpy(to,from,len)
-char *to;
-register char *from;
-register int len;
+safecpy(char *to, register char *from, register int len)
{
register char *dest = to;
@@ -103,9 +96,7 @@ register int len;
/* copy a string up to some (non-backslashed) delimiter, if any */
char *
-cpytill(to,from,delim)
-register char *to, *from;
-register int delim;
+cpytill(register char *to, register char *from, register int delim)
{
for (; *from; from++,to++) {
if (*from == '\\') {
@@ -124,9 +115,7 @@ register int delim;
char *
-cpy2(to,from,delim)
-register char *to, *from;
-register int delim;
+cpy2(register char *to, register char *from, register int delim)
{
for (; *from; from++,to++) {
if (*from == '\\')
@@ -144,9 +133,7 @@ register int delim;
/* return ptr to little string in big string, NULL if not found */
char *
-instr(big, little)
-char *big, *little;
-
+instr(char *big, char *little)
{
register char *t, *s, *x;
@@ -166,10 +153,9 @@ char *big, *little;
/* copy a string to a safe spot */
char *
-savestr(str)
-char *str;
+savestr(char *str)
{
- register char *newaddr = safemalloc((MEM_SIZE)(strlen(str)+1));
+ register char *newaddr = (char *) safemalloc((MEM_SIZE)(strlen(str)+1));
(void)strcpy(newaddr,str);
return newaddr;
@@ -178,31 +164,21 @@ char *str;
/* grow a static string to at least a certain length */
void
-growstr(strptr,curlen,newlen)
-char **strptr;
-int *curlen;
-int newlen;
+growstr(char **strptr, int *curlen, int newlen)
{
if (newlen > *curlen) { /* need more room? */
if (*curlen)
- *strptr = saferealloc(*strptr,(MEM_SIZE)newlen);
+ *strptr = (char *) saferealloc(*strptr,(MEM_SIZE)newlen);
else
- *strptr = safemalloc((MEM_SIZE)newlen);
+ *strptr = (char *) safemalloc((MEM_SIZE)newlen);
*curlen = newlen;
}
}
void
-#if defined(I_STDARG) && defined(HAS_VPRINTF)
croak(char *pat,...)
-#else /* I_STDARG */
-/*VARARGS1*/
-croak(pat,a1,a2,a3,a4)
- char *pat;
- int a1,a2,a3,a4;
-#endif /* I_STDARG */
{
-#if defined(I_STDARG) && defined(HAS_VPRINTF)
+#if defined(HAS_VPRINTF)
va_list args;
va_start(args, pat);
@@ -214,16 +190,9 @@ croak(pat,a1,a2,a3,a4)
}
void
-#if defined(I_STDARG) && defined(HAS_VPRINTF)
fatal(char *pat,...)
-#else /* I_STDARG */
-/*VARARGS1*/
-fatal(pat,a1,a2,a3,a4)
- char *pat;
- int a1,a2,a3,a4;
-#endif /* I_STDARG */
{
-#if defined(I_STDARG) && defined(HAS_VPRINTF)
+#if defined(HAS_VPRINTF)
va_list args;
va_start(args, pat);
@@ -235,16 +204,9 @@ fatal(pat,a1,a2,a3,a4)
}
void
-#if defined(I_STDARG) && defined(HAS_VPRINTF)
warn(char *pat,...)
-#else /* I_STDARG */
-/*VARARGS1*/
-warn(pat,a1,a2,a3,a4)
- char *pat;
- int a1,a2,a3,a4;
-#endif /* I_STDARG */
{
-#if defined(I_STDARG) && defined(HAS_VPRINTF)
+#if defined(HAS_VPRINTF)
va_list args;
va_start(args, pat);
diff --git a/gnu/usr.bin/perl/x2p/util.h b/gnu/usr.bin/perl/x2p/util.h
index ff93e8ac7a0..aa31bea2176 100644
--- a/gnu/usr.bin/perl/x2p/util.h
+++ b/gnu/usr.bin/perl/x2p/util.h
@@ -28,15 +28,9 @@ void growstr _(( char **strptr, int *curlen, int newlen ));
char * instr _(( char *big, char *little ));
char * safecpy _(( char *to, char *from, int len ));
char * savestr _(( char *str ));
-#if defined(I_STDARG) && defined(HAS_VPRINTF)
void croak _(( char *pat, ... ));
void fatal _(( char *pat, ... ));
void warn _(( char *pat, ... ));
-#else /* defined(I_STDARG) && defined(HAS_VPRINTF) */
-void croak _(( char *pat, int a1, int a2, int a3, int a4 ));
-void Myfatal ();
-void warn ();
-#endif /* defined(I_STDARG) && defined(HAS_VPRINTF) */
int prewalk _(( int numit, int level, int node, int *numericptr ));
Malloc_t safemalloc _((MEM_SIZE nbytes));
diff --git a/gnu/usr.bin/perl/x2p/walk.c b/gnu/usr.bin/perl/x2p/walk.c
index cb40073b22a..24b86aab503 100644
--- a/gnu/usr.bin/perl/x2p/walk.c
+++ b/gnu/usr.bin/perl/x2p/walk.c
@@ -37,12 +37,12 @@ STR * walk _(( int useval, int level, int node, int *numericptr, int minprec ));
STR *
-walk(useval,level,node,numericptr,minprec)
-int useval;
-int level;
-register int node;
-int *numericptr;
-int minprec; /* minimum precedence without parens */
+walk(int useval, int level, register int node, int *numericptr, int minprec)
+
+
+
+
+ /* minimum precedence without parens */
{
register int len;
register STR *str;
@@ -133,7 +133,7 @@ int minprec; /* minimum precedence without parens */
if (saw_FS && !const_FS)
do_chop = TRUE;
if (do_chop) {
- str_cat(str,"chop;\t# strip record separator\n");
+ str_cat(str,"chomp;\t# strip record separator\n");
tab(str,level);
}
if (do_split)
@@ -190,7 +190,7 @@ int minprec; /* minimum precedence without parens */
i = 0;
if (do_chop) {
i++;
- str_cat(str,"chop;\t# strip record separator\n");
+ str_cat(str,"chomp;\t# strip record separator\n");
tab(str,level);
}
if (do_split && !(len & 1)) {
@@ -1556,9 +1556,7 @@ sub Pick {\n\
}
static void
-tab(str,lvl)
-register STR *str;
-register int lvl;
+tab(register STR *str, register int lvl)
{
while (lvl > 1) {
str_cat(str,"\t");
@@ -1569,9 +1567,7 @@ register int lvl;
}
static void
-fixtab(str,lvl)
-register STR *str;
-register int lvl;
+fixtab(register STR *str, register int lvl)
{
register char *s;
@@ -1589,8 +1585,7 @@ register int lvl;
}
static void
-addsemi(str)
-register STR *str;
+addsemi(register STR *str)
{
register char *s;
@@ -1602,9 +1597,7 @@ register STR *str;
}
static void
-emit_split(str,level)
-register STR *str;
-int level;
+emit_split(register STR *str, int level)
{
register int i;
@@ -1637,11 +1630,7 @@ int level;
}
int
-prewalk(numit,level,node,numericptr)
-int numit;
-int level;
-register int node;
-int *numericptr;
+prewalk(int numit, int level, register int node, int *numericptr)
{
register int len;
register int type;
@@ -2058,8 +2047,7 @@ int *numericptr;
}
static void
-numericize(node)
-register int node;
+numericize(register int node)
{
register int len;
register int type;