diff options
| author | Perl 5 Porters <perl5-porters@africa.nicoh.com> | 1997-03-01 18:40:49 +1200 |
|---|---|---|
| committer | Chip Salzenberg <chip@atlantic.net> | 1997-03-01 18:40:49 +1200 |
| commit | 9607fc9c489d4095e3baa795d7ead7acba96137d (patch) | |
| tree | 2dfac2b59f20ce6d1dccd5bbdf9343c30dae8992 | |
| parent | 92112241d1458d5df77a0d57b4e82dca2637735a (diff) | |
| download | perl-9607fc9c489d4095e3baa795d7ead7acba96137d.tar.gz | |
[inseparable changes from match from perl-5.003_91 to perl-5.003_92]
CORE LANGUAGE CHANGES
Subject: Strictly follow lexical context of C<eval ''> and nested subs
From: Chip Salzenberg <chip@perl.com>
Files: op.c
Subject: Make ::SUPER and UNIVERSAL work together
From: Chip Salzenberg <chip@perl.com>
Files: gv.c pod/perlguts.pod
CORE PORTABILITY
Subject: OS/2 patches
Date: Wed, 5 Mar 1997 22:08:43 -0500 (EST)
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: hints/os2.sh lib/ExtUtils/MakeMaker.pm t/op/taint.t
Msg-ID: 199703060308.WAA22211@monk.mps.ohio-state.edu
(applied based on p5p patch as commit eda4d5189d403b15f244b4696a710fb91d15053e)
Subject: VMS patches
Date: Wed, 05 Mar 1997 23:10:24 -0500 (EST)
From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
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
private-msgid: 01IG5SQE4A6U00661G@hmivax.humgen.upenn.edu
DOCUMENTATION
Subject: Add taint checks and srand to perldelta
Date: Sun, 2 Mar 1997 11:56:08 -0800 (PST)
From: Tom Phoenix <rootbeer@teleport.com>
Files: pod/perldelta.pod
Msg-ID: Pine.GSO.3.95q.970302115355.23058D-100000@kelly.teleport.com
(applied based on p5p patch as commit b28e0bc0aa3232e18d1bacb3efcbfb755ad100e0)
Subject: Don't call FileHandle 'deprecated'
From: Chip Salzenberg <chip@perl.com>
Files: pod/perldelta.pod
Subject: Improve sample module header
Date: Sat, 01 Mar 1997 10:32:31 -0700
From: Tom Christiansen <tchrist@jhereg.perl.com>
Files: pod/perlmod.pod
Msg-ID: 199703011732.KAA14693@jhereg.perl.com
(applied based on p5p patch as commit 3e1e15658152387f41e00ded4796cede4e1e10d3)
Subject: Update list of CPAN sites
Date: Sun, 2 Mar 1997 16:54:22 +0200 (EET)
From: Jarkko Hietaniemi <jhi@iki.fi>
Files: pod/perlmod.pod
Msg-ID: 199703021454.QAA07446@alpha.hut.fi
(applied based on p5p patch as commit 9423903e60e6c92c1893f5f4cab2476f403f8a4b)
Subject: Enhance description of 'server error'
Date: Tue, 4 Feb 1997 21:03:23 +0200 (EET)
From: Jarkko Hietaniemi <jhi@cc.hut.fi>
Files: pod/perldiag.pod
private-msgid: 199702041903.VAA16070@alpha.hut.fi
Subject: Regularize format of E-Mail addresses in *.pod
From: Chip Salzenberg <chip@perl.com>
Files: pod/*.pod
LIBRARY AND EXTENSIONS
Subject: Use IV instead of double for tms structure members
From: Chip Salzenberg <chip@perl.com>
Files: ext/POSIX/POSIX.xs
OTHER CORE CHANGES
Subject: Make sure $^X is tainted when ARG_ZERO_IS_SCRIPT
From: Chip Salzenberg <chip@perl.com>
Files: toke.c
Subject: Clarify '-T too late' error
From: Chip Salzenberg <chip@perl.com>
Files: perl.c pod/perldiag.pod
Subject: Warn when redefining or undefining a constant sub
From: Chip Salzenberg <chip@perl.com>
Files: pod/perldiag.pod pp.c sv.c
Subject: Don't generate spurious 'not imported' warning
From: Chip Salzenberg <chip@perl.com>
Files: gv.c t/pragma/strict-vars pod/perldiag.pod
Subject: Clarify message re: @host in string
From: Chip Salzenberg <chip@perl.com>
Files: pod/perldiag.pod pod/perltrap.pod toke.c
Subject: Disconnect refs that are targets of pp_readline
From: Chip Salzenberg <chip@perl.com>
Files: pp_hot.c
Subject: Fix typo in test of HvFILL()
From: Chip Salzenberg <chip@perl.com>
Files: op.c
Subject: Allow for pad name array to be shorter than pad array
From: Chip Salzenberg <chip@perl.com>
Files: op.c
Subject: Eliminate format-string type warnings
Date: Mon, 3 Mar 1997 10:15:11 +0100 (MET)
From: Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
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
private-msgid: 199703030915.KAA11634@bombur2.uio.no
Subject: Update copyright dates
From: Chip Salzenberg <chip@perl.com>
Files: *.[hc] x2p/*.[hc] win32/EXTERN.h vms/vmsish.h vms/vms.c
TESTS
Subject: Smarter t/op/taint.t
Date: Mon, 3 Mar 1997 10:31:54 -0800 (PST)
From: Tom Phoenix <rootbeer@teleport.com>
Files: t/op/taint.t
private-msgid: Pine.GSO.3.95q.970303103047.24000A-100000@kelly.teleport.com
Subject: Fix taint test for systems without csh
From: Chip Salzenberg <chip@perl.com>
Files: t/op/taint.t
| -rw-r--r-- | Changes | 210 | ||||
| -rw-r--r-- | EXTERN.h | 2 | ||||
| -rw-r--r-- | INTERN.h | 2 | ||||
| -rw-r--r-- | av.c | 2 | ||||
| -rw-r--r-- | av.h | 2 | ||||
| -rw-r--r-- | cop.h | 2 | ||||
| -rw-r--r-- | cv.h | 2 | ||||
| -rw-r--r-- | deb.c | 2 | ||||
| -rw-r--r-- | doio.c | 6 | ||||
| -rw-r--r-- | doop.c | 2 | ||||
| -rw-r--r-- | dump.c | 2 | ||||
| -rw-r--r-- | ext/POSIX/POSIX.xs | 10 | ||||
| -rw-r--r-- | form.h | 2 | ||||
| -rw-r--r-- | gv.c | 114 | ||||
| -rw-r--r-- | gv.h | 2 | ||||
| -rw-r--r-- | handy.h | 2 | ||||
| -rw-r--r-- | hints/dec_osf.sh | 2 | ||||
| -rw-r--r-- | hints/os2.sh | 4 | ||||
| -rw-r--r-- | hv.c | 2 | ||||
| -rw-r--r-- | hv.h | 2 | ||||
| -rw-r--r-- | lib/ExtUtils/MM_VMS.pm | 33 | ||||
| -rw-r--r-- | lib/ExtUtils/MakeMaker.pm | 7 | ||||
| -rw-r--r-- | lib/ExtUtils/Manifest.pm | 52 | ||||
| -rw-r--r-- | mg.c | 2 | ||||
| -rw-r--r-- | mg.h | 2 | ||||
| -rw-r--r-- | op.c | 40 | ||||
| -rw-r--r-- | op.h | 2 | ||||
| -rw-r--r-- | patchlevel.h | 2 | ||||
| -rw-r--r-- | perl.c | 6 | ||||
| -rw-r--r-- | perl.h | 2 | ||||
| -rw-r--r-- | perlsdio.h | 28 | ||||
| -rw-r--r-- | perly.y | 2 | ||||
| -rw-r--r-- | plan9/buildinfo | 2 | ||||
| -rw-r--r-- | pod/perl.pod | 4 | ||||
| -rw-r--r-- | pod/perlcall.pod | 2 | ||||
| -rw-r--r-- | pod/perldelta.pod | 46 | ||||
| -rw-r--r-- | pod/perldiag.pod | 73 | ||||
| -rw-r--r-- | pod/perldsc.pod | 2 | ||||
| -rw-r--r-- | pod/perlembed.pod | 9 | ||||
| -rw-r--r-- | pod/perlguts.pod | 17 | ||||
| -rw-r--r-- | pod/perlipc.pod | 2 | ||||
| -rw-r--r-- | pod/perllocale.pod | 2 | ||||
| -rw-r--r-- | pod/perllol.pod | 2 | ||||
| -rw-r--r-- | pod/perlmod.pod | 190 | ||||
| -rw-r--r-- | pod/perltie.pod | 4 | ||||
| -rw-r--r-- | pod/perltoc.pod | 37 | ||||
| -rw-r--r-- | pod/perltrap.pod | 12 | ||||
| -rw-r--r-- | pod/perlxs.pod | 2 | ||||
| -rw-r--r-- | pod/perlxstut.pod | 2 | ||||
| -rw-r--r-- | pp.c | 13 | ||||
| -rw-r--r-- | pp.h | 2 | ||||
| -rw-r--r-- | pp_ctl.c | 10 | ||||
| -rw-r--r-- | pp_hot.c | 6 | ||||
| -rw-r--r-- | pp_sys.c | 2 | ||||
| -rw-r--r-- | regcomp.c | 2 | ||||
| -rw-r--r-- | regexec.c | 2 | ||||
| -rw-r--r-- | run.c | 7 | ||||
| -rw-r--r-- | scope.c | 2 | ||||
| -rw-r--r-- | sv.c | 19 | ||||
| -rw-r--r-- | sv.h | 2 | ||||
| -rwxr-xr-x | t/op/runlevel.t | 24 | ||||
| -rwxr-xr-x | t/op/taint.t | 240 | ||||
| -rw-r--r-- | t/pragma/strict-vars | 2 | ||||
| -rw-r--r-- | toke.c | 9 | ||||
| -rw-r--r-- | util.c | 2 | ||||
| -rw-r--r-- | util.h | 2 | ||||
| -rw-r--r-- | vms/config.vms | 2 | ||||
| -rw-r--r-- | vms/descrip.mms | 6 | ||||
| -rw-r--r-- | vms/perly_c.vms | 2 | ||||
| -rw-r--r-- | vms/sockadapt.c | 61 | ||||
| -rw-r--r-- | vms/sockadapt.h | 56 | ||||
| -rw-r--r-- | vms/vms.c | 1 | ||||
| -rw-r--r-- | vms/vms_yfix.pl | 4 | ||||
| -rw-r--r-- | vms/vmsish.h | 1 | ||||
| -rw-r--r-- | win32/EXTERN.h | 2 | ||||
| -rw-r--r-- | x2p/EXTERN.h | 2 | ||||
| -rw-r--r-- | x2p/INTERN.h | 2 | ||||
| -rw-r--r-- | x2p/a2p.c | 2 | ||||
| -rw-r--r-- | x2p/a2p.h | 2 | ||||
| -rw-r--r-- | x2p/a2p.y | 2 | ||||
| -rw-r--r-- | x2p/a2py.c | 5 | ||||
| -rw-r--r-- | x2p/hash.c | 2 | ||||
| -rw-r--r-- | x2p/hash.h | 2 | ||||
| -rw-r--r-- | x2p/proto.h | 2 | ||||
| -rw-r--r-- | x2p/str.c | 2 | ||||
| -rw-r--r-- | x2p/str.h | 2 | ||||
| -rw-r--r-- | x2p/util.c | 2 | ||||
| -rw-r--r-- | x2p/util.h | 2 | ||||
| -rw-r--r-- | x2p/walk.c | 2 |
89 files changed, 971 insertions, 501 deletions
@@ -9,6 +9,216 @@ releases.) ---------------- +Version 5.003_92 +---------------- + +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 <rootbeer@teleport.com> + 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 <ilya@math.ohio-state.edu> + 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 <bailey@HMIVAX.HUMGEN.UPENN.EDU> + 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 <h.b.furuseth@usit.uio.no> + 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 <roderick@argon.org> + 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 <ilya@math.ohio-state.edu> + 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 <rootbeer@teleport.com> + 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 <rootbeer@teleport.com> + 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 <tchrist@jhereg.perl.com>, + Graham Barr <gbarr@ti.com> + 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 <rootbeer@teleport.com> + 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 <jhi@iki.fi> + 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 <jhi@cc.hut.fi> + 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 + + +---------------- Version 5.003_91 ---------------- @@ -1,6 +1,6 @@ /* EXTERN.h * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* INTERN.h * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* av.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* av.h * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* cop.h * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* cv.h * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* deb.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* doio.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1370,8 +1370,8 @@ SV **sp; { a = SvPV(astr, len); if (len != infosize) - croak("Bad arg length for %s, is %d, should be %ld", - op_desc[optype], len, (long)infosize); + croak("Bad arg length for %s, is %lu, should be %ld", + op_desc[optype], (unsigned long)len, (long)infosize); } } else @@ -1,6 +1,6 @@ /* doop.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* dump.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 3754e8c888..2575ca19cb 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -3533,11 +3533,11 @@ times() clock_t realtime; realtime = times( &tms ); EXTEND(sp,5); - PUSHs( sv_2mortal( newSVnv( realtime ) ) ); - PUSHs( sv_2mortal( newSVnv( tms.tms_utime ) ) ); - PUSHs( sv_2mortal( newSVnv( tms.tms_stime ) ) ); - PUSHs( sv_2mortal( newSVnv( tms.tms_cutime ) ) ); - PUSHs( sv_2mortal( newSVnv( tms.tms_cstime ) ) ); + PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) ); + PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) ); + PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) ); + PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) ); + PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) ); double difftime(time1, time2) @@ -1,6 +1,6 @@ /* form.h * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* gv.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -131,7 +131,6 @@ I32 level; GV* topgv; GV* gv; GV** gvp; - HV* lastchance; CV* cv; if (!stash) @@ -159,8 +158,33 @@ I32 level; } } - gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE); - if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) { + gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE); + av = (gvp && (gv = *gvp) && gv != (GV*)&sv_undef) ? GvAV(gv) : Nullav; + + /* create @.*::SUPER::ISA on demand */ + if (!av) { + char* packname = HvNAME(stash); + STRLEN packlen = strlen(packname); + + if (packlen >= 7 && strEQ(packname + packlen - 7, "::SUPER")) { + HV* basestash; + + 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))) { + gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE); + if (!gvp || !(gv = *gvp)) + croak("Cannot create %s::ISA", HvNAME(stash)); + if (SvTYPE(gv) != SVt_PVGV) + gv_init(gv, stash, "ISA", 3, TRUE); + SvREFCNT_dec(GvAV(gv)); + GvAV(gv) = (AV*)SvREFCNT_inc(av); + } + } + } + + if (av) { SV** svp = AvARRAY(av); I32 items = AvFILL(av) + 1; while (items--) { @@ -179,7 +203,11 @@ I32 level; } } + /* if at top level, try UNIVERSAL */ + if (level == 0 || level == -1) { + HV* lastchance; + if (lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE)) { if (gv = gv_fetchmeth(lastchance, name, len, (level >= 0) ? level + 1 : level - 1)) { @@ -209,67 +237,29 @@ char* name; GV* gv; for (nend = name; *nend; nend++) { - if (*nend == ':' || *nend == '\'') + if (*nend == '\'') nsplit = nend; + else if (*nend == ':' && *(nend + 1) == ':') + nsplit = ++nend; } if (nsplit) { - char ch; char *origname = name; name = nsplit + 1; - ch = *nsplit; if (*nsplit == ':') --nsplit; - *nsplit = '\0'; - if (strEQ(origname,"SUPER")) { - /* Degenerate case ->SUPER::method should really lookup in original stash */ - SV *tmpstr = sv_2mortal(newSVpv(HvNAME(curcop->cop_stash),0)); + if ((nsplit - origname) == 5 && strnEQ(origname, "SUPER", 5)) { + /* ->SUPER::method should really be looked up in original stash */ + SV *tmpstr = sv_2mortal(newSVpv(HvNAME(curcop->cop_stash), 0)); sv_catpvn(tmpstr, "::SUPER", 7); - stash = gv_stashpvn(SvPVX(tmpstr),SvCUR(tmpstr),TRUE); - *nsplit = ch; - DEBUG_o( deb("Treating %s as %s::%s\n",origname,HvNAME(stash),name) ); - } else { - stash = gv_stashpvn(origname, nsplit - origname, TRUE); - *nsplit = ch; + stash = gv_stashpvn(SvPVX(tmpstr), SvCUR(tmpstr), TRUE); + DEBUG_o( deb("Treating %s as %s::%s\n", + origname, HvNAME(stash), name) ); } - } - gv = gv_fetchmeth(stash, name, nend - name, 0); - - if (!gv) { - /* Failed obvious case - look for SUPER as last element of stash's name */ - char *packname = HvNAME(stash); - STRLEN len = strlen(packname); - if (len >= 7 && strEQ(packname+len-7,"::SUPER")) { - /* Now look for @.*::SUPER::ISA */ - GV** gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE); - len -= 7; - if (!gvp || (gv = *gvp) == (GV*)&sv_undef || !GvAV(gv)) { - /* No @ISA in package ending in ::SUPER - drop suffix - and see if there is an @ISA there - */ - HV *basestash; - char ch = packname[len]; - AV *av; - packname[len] = '\0'; - basestash = gv_stashpvn(packname, len, TRUE); - packname[len] = ch; - gvp = (GV**)hv_fetch(basestash,"ISA",3,FALSE); - if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) { - /* Okay found @ISA after dropping the SUPER, alias it */ - SV *tmpstr = sv_2mortal(newSVpv(HvNAME(stash),0)); - sv_catpvn(tmpstr, "::ISA", 5); - gv = gv_fetchpv(SvPV(tmpstr,na),TRUE,SVt_PVGV); - if (gv) { - GvAV(gv) = (AV*)SvREFCNT_inc(av); - /* ... and re-try lookup */ - gv = gv_fetchmeth(stash, name, nend - name, 0); - } else { - croak("Cannot create %s::ISA",HvNAME(stash)); - } - } - } - } + else + stash = gv_stashpvn(origname, nsplit - origname, TRUE); } + gv = gv_fetchmeth(stash, name, nend - name, 0); if (!gv) { if (strEQ(name,"import")) gv = (GV*)&sv_yes; @@ -383,7 +373,7 @@ I32 sv_type; I32 len; register char *namend; HV *stash = 0; - bool global = FALSE; + U32 add_gvflags = 0; char *tmpbuf; if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */ @@ -441,6 +431,8 @@ I32 sv_type; if (!stash) { if (isIDFIRST(*name)) { + bool global = FALSE; + if (isUPPER(*name)) { if (*name > 'I') { if (*name == 'S' && ( @@ -465,6 +457,7 @@ I32 sv_type; } else if (*name == '_' && !name[1]) global = TRUE; + if (global) stash = defstash; else if ((COP*)curcop == &compiling) { @@ -511,6 +504,10 @@ I32 sv_type; 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 return Nullgv; @@ -537,6 +534,7 @@ I32 sv_type; warn("Had to create %s unexpectedly", nambeg); gv_init(gv, stash, name, len, add & 2); gv_init_sv(gv, sv_type); + GvFLAGS(gv) |= add_gvflags; /* set up magic where warranted */ switch (*name) { @@ -997,13 +995,13 @@ HV* stash; { int filled = 0; int i; - char *cp; + const char *cp; SV* sv = NULL; SV** svp; /* Work with "fallback" key, which we assume to be first in AMG_names */ - if ( cp = (char *)AMG_names[0] ) { + if ( cp = AMG_names[0] ) { /* Try to find via inheritance. */ gv = gv_fetchmeth(stash, "()", 2, -1); /* A cookie: "()". */ if (gv) sv = GvSV(gv); @@ -1015,7 +1013,7 @@ HV* stash; for (i = 1; i < NofAMmeth; i++) { cv = 0; - cp = (char *)AMG_names[i]; + cp = AMG_names[i]; *buf = '('; /* A cookie: "(". */ strcpy(buf + 1, cp); @@ -1,6 +1,6 @@ /* gv.h * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* handy.h * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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/hints/dec_osf.sh b/hints/dec_osf.sh index d50c4c60dc..0ba4dad077 100644 --- a/hints/dec_osf.sh +++ b/hints/dec_osf.sh @@ -86,7 +86,7 @@ esac # be nauseatingly ANSI case "$cc" in -gcc) ccflags="$ccflags -ansi" +*gcc*) ccflags="$ccflags -ansi" ;; *) ccflags="$ccflags -std" ;; diff --git a/hints/os2.sh b/hints/os2.sh index 9bce2a594c..70e478b96f 100644 --- a/hints/os2.sh +++ b/hints/os2.sh @@ -32,7 +32,9 @@ libemx="`../UU/loc . X c:/emx/lib d:/emx/lib e:/emx/lib f:/emx/lib g:/emx/lib h: if test "$libemx" = "X"; then echo "Cannot find C library!"; fi -libpth="$libemx/mt $libemx" +# Acute backslashitis: +libpth="`echo \"$LIBRARY_PATH\" | tr ';\\\' ' /'`" +libpth="$libpth $libemx/mt $libemx" set `emxrev -f emxlibcm` emxcrtrev=$5 @@ -1,6 +1,6 @@ /* hv.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* hv.h * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm index e719946f92..aca41ea371 100644 --- a/lib/ExtUtils/MM_VMS.pm +++ b/lib/ExtUtils/MM_VMS.pm @@ -6,8 +6,6 @@ # Author: Charles Bailey bailey@genetics.upenn.edu package ExtUtils::MM_VMS; -$ExtUtils::MM_VMS::Revision=$ExtUtils::MM_VMS::Revision = '5.39 (31-Jan-1997)'; -unshift @MM::ISA, 'ExtUtils::MM_VMS'; use Carp qw( &carp ); use Config; @@ -15,6 +13,11 @@ require Exporter; use VMS::Filespec; use File::Basename; +use vars qw($Revision); +$Revision = '5.3901 (6-Mar-1997)'; + +unshift @MM::ISA, 'ExtUtils::MM_VMS'; + Exporter::import('ExtUtils::MakeMaker', '$Verbose', '&neatvalue'); =head1 NAME @@ -1303,12 +1306,12 @@ $(BASEEXT).opt : Makefile.PL foreach $lib (split ' ', $self->{LDLOADLIBS}) { $lib =~ s%\$%\\\$%g; # Escape '$' in VMS filespecs if (length($line) + length($lib) > 160) { - push @m, "\t\$(PERL) -e \"print qq[$line]\" >>\$(MMS\$TARGET)\n"; + push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n"; $line = $lib . '\n'; } else { $line .= $lib . '\n'; } } - push @m, "\t\$(PERL) -e \"print qq[$line]\" >>\$(MMS\$TARGET)\n" if $line; + push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n" if $line; } join('',@m); @@ -1405,7 +1408,7 @@ $(INST_STATIC) : $(OBJECT) $(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;" + $(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;" '); push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); join('',@m); @@ -1581,7 +1584,7 @@ sub subdir_x { subdirs :: olddef = F$Environment("Default") Set Default ',$subdir,' - - $(MMS) all $(USEMACROS)$(PASTHRU)$(MACROEND) + - $(MMS)$(MMSQUALIFIERS) all $(USEMACROS)$(PASTHRU)$(MACROEND) Set Default \'olddef\' '; join('',@m); @@ -1606,7 +1609,7 @@ clean :: foreach $dir (@{$self->{DIR}}) { # clean subdirectories first my($vmsdir) = $self->fixpath($dir,1); push( @m, ' If F$Search("'.$vmsdir.'$(MAKEFILE)").nes."" Then \\',"\n\t", - '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS) clean`;"',"\n"); + '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) clean`;"',"\n"); } push @m, ' $(RM_F) *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *$(OBJ_EXT) *$(LIB_EXT) *.Opt $(BOOTSTRAP) $(BASEEXT).bso .MM_Tmp '; @@ -1658,7 +1661,7 @@ realclean :: clean foreach(@{$self->{DIR}}){ my($vmsdir) = $self->fixpath($_,1); push(@m, ' If F$Search("'."$vmsdir".'$(MAKEFILE)").nes."" Then \\',"\n\t", - '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS) realclean`;"',"\n"); + '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) realclean`;"',"\n"); } push @m,' $(RM_RF) $(INST_AUTODIR) $(INST_ARCHAUTODIR) '; @@ -1799,8 +1802,8 @@ disttest : distdir startdir = F$Environment("Default") Set Default [.$(DISTVNAME)] $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL - $(MMS) - $(MMS) test + $(MMS)$(MMSQUALIFIERS) + $(MMS)$(MMSQUALIFIERS) test Set Default 'startdir' }; } @@ -2019,7 +2022,7 @@ $(MAKEFILE) : Makefile.PL $(CONFIGDEP) $(NOECHO) $(SAY) "$(MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)" $(NOECHO) $(SAY) "Cleaning current config before rebuilding $(MAKEFILE) ..." - $(MV) $(MAKEFILE) $(MAKEFILE)_old - - $(MMS) $(USEMAKEFILE)$(MAKEFILE)_old clean + - $(MMS)$(MMSQUALIFIERS) $(USEMAKEFILE)$(MAKEFILE)_old clean $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL ],join(' ',map(qq["$_"],@ARGV)),q[ $(NOECHO) $(SAY) "$(MAKEFILE) has been rebuilt." $(NOECHO) $(SAY) "Please run $(MMS) to build the extension." @@ -2054,7 +2057,7 @@ testdb :: testdb_\$(LINKTYPE) foreach(@{$self->{DIR}}){ my($vmsdir) = $self->fixpath($_,1); push(@m, ' If F$Search("',$vmsdir,'$(MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'", - '; print `$(MMS) $(PASTHRU2) test`'."\n"); + '; print `$(MMS)$(MMSQUALIFIERS) $(PASTHRU2) test`'."\n"); } push(@m, "\t\$(NOECHO) \$(SAY) \"No tests defined for \$(NAME) extension.\"\n") unless $tests or -f "test.pl" or @{$self->{DIR}}; @@ -2146,7 +2149,7 @@ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) MAKEAPERL=1 NORECURS=1 $(MAP_TARGET) :: $(MAKE_APERL_FILE) - $(MMS)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET) + $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET) }; push @m, map( " \\\n\t\t$_", @ARGV ); push @m, "\n"; @@ -2292,9 +2295,9 @@ $(MAP_SHRTARGET) : $(MAP_LIBPERL) $(MAP_STATIC) ',"${libperldir}Perlshr_Attr.Opt $(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" - $(NOECHO) $(SAY) " $(MMS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)" + $(NOECHO) $(SAY) " $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)" $(NOECHO) $(SAY) "To remove the intermediate files, say - $(NOECHO) $(SAY) " $(MMS)$(USEMAKEFILE)$(MAKEFILE) map_clean" + $(NOECHO) $(SAY) " $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) map_clean" '; push @m,' ',"${tmp}perlmain.c",' : $(MAKEFILE) diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm index 77e4e2b545..a46a7504fe 100644 --- a/lib/ExtUtils/MakeMaker.pm +++ b/lib/ExtUtils/MakeMaker.pm @@ -2,7 +2,7 @@ BEGIN {require 5.002;} # MakeMaker 5.17 was the last MakeMaker that was compatib package ExtUtils::MakeMaker; -$Version = $VERSION = "5.4001"; +$Version = $VERSION = "5.4002"; $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.211 $, 10)) =~ s/\s+$//; @@ -244,10 +244,13 @@ sub full_setup { XS_VERSION clean depend dist dynamic_lib linkext macro realclean tool_autosplit - installpm + IMPORTS + installpm /; + # IMPORTS is used under OS/2 + # ^^^ installpm is deprecated, will go about Summer 96 # @Overridable is close to @MM_Sections but not identical. The diff --git a/lib/ExtUtils/Manifest.pm b/lib/ExtUtils/Manifest.pm index 09bdbd55c0..dc7d421edc 100644 --- a/lib/ExtUtils/Manifest.pm +++ b/lib/ExtUtils/Manifest.pm @@ -7,20 +7,20 @@ use File::Copy 'copy'; use Carp; use strict; -use vars qw(@ISA @EXPORT_OK $VERSION $Debug $Verbose $Is_VMS $Quiet $MANIFEST $found); +use vars qw($VERSION @ISA @EXPORT_OK + $Is_VMS $Debug $Verbose $Quiet $MANIFEST $found); +$VERSION = '1.2801'; @ISA=('Exporter'); @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 'skipcheck', 'maniread', 'manicopy'); -$Debug = 0; -$Verbose = 1; $Is_VMS = $^O eq 'VMS'; +if ($Is_VMS) { require File::Basename } -$VERSION = "1.28"; - +$Debug = 0; +$Verbose = 1; $Quiet = 0; - $MANIFEST = 'MANIFEST'; # Really cool fix from Ilya :) @@ -128,8 +128,19 @@ sub maniread { } while (<M>){ chomp; - if ($Is_VMS) { /^(\S+)/ and $read->{"\L$1"}=$_; } - else { /^(\S+)\s*(.*)/ and $read->{$1}=$2; } + if ($Is_VMS) { + my($file)= /^(\S+)/; + next unless $file; + my($base,$dir) = File::Basename::fileparse($file); + # Resolve illegal file specifications in the same way as tar + $dir =~ tr/./_/; + my(@pieces) = split(/\./,$base); + if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); } + my $okfile = "$dir$base"; + warn "Debug: Illegal name $file changed to $okfile\n" if $Debug; + $read->{"\L$okfile"}=$_; + } + else { /^(\S+)\s*(.*)/ and $read->{$1}=$2; } } close M; $read; @@ -177,8 +188,7 @@ sub manicopy { $dir = VMS::Filespec::unixify($dir) if $Is_VMS; File::Path::mkpath(["$target/$dir"],1,$Is_VMS ? undef : 0755); } - if ($Is_VMS) { vms_cp_if_diff($file,"$target/$file"); } - else { cp_if_diff($file, "$target/$file", $how); } + cp_if_diff($file, "$target/$file", $how); } } @@ -207,36 +217,18 @@ sub cp_if_diff { } } -# Do the comparisons here rather than spawning off another process -sub vms_cp_if_diff { - my($from,$to) = @_; - my($diff) = 0; - local(*F,*T); - open(F,$from) or croak "Can't read $from: $!\n"; - if (open(T,$to)) { - while (<F>) { $diff++,last if $_ ne <T>; } - $diff++ unless eof(T); - close T; - } - else { $diff++; } - close F; - if ($diff) { - system('copy',VMS::Filespec::vmsify($from),VMS::Filespec::vmsify($to)) & 1 - or confess "Copy failed: $!"; - } -} - sub cp { my ($srcFile, $dstFile) = @_; my ($perm,$access,$mod) = (stat $srcFile)[2,8,9]; copy($srcFile,$dstFile); - utime $access, $mod, $dstFile; + utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile; # chmod a+rX-w,go-w chmod( 0444 | ( $perm & 0111 ? 0111 : 0 ), $dstFile ); } sub ln { my ($srcFile, $dstFile) = @_; + return &cp if $Is_VMS; link($srcFile, $dstFile); local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x) my $mode= 0444 | (stat)[2] & 0700; @@ -1,6 +1,6 @@ /* mg.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* mg.h * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* op.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -188,7 +188,6 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) for (off = AvFILL(curname); off > 0; off--) { if ((sv = svp[off]) && sv != &sv_undef && - !SvFAKE(sv) && seq <= SvIVX(sv) && seq > I_32(SvNVX(sv)) && strEQ(SvPVX(sv), name)) @@ -199,21 +198,24 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) depth = CvDEPTH(cv); if (!depth) { - if (newoff) + if (newoff) { + if (SvFAKE(sv)) + continue; return 0; /* don't clone from inactive stack frame */ + } depth = 1; } oldpad = (AV*)*av_fetch(curlist, depth, FALSE); oldsv = *av_fetch(oldpad, off, TRUE); if (!newoff) { /* Not a mere clone operation. */ - SV *sv = NEWSV(1103,0); + SV *namesv = NEWSV(1103,0); newoff = pad_alloc(OP_PADSV, SVs_PADMY); - sv_upgrade(sv, SVt_PVNV); - sv_setpv(sv, name); - av_store(comppad_name, newoff, sv); - SvNVX(sv) = (double)curcop->cop_seq; - SvIVX(sv) = 999999999; /* A ref, intro immediately */ - SvFAKE_on(sv); /* A ref, not a real var */ + 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 */ + SvFAKE_on(namesv); /* A ref, not a real var */ if (CvANON(compcv) || SvTYPE(compcv) == SVt_PVFM) { /* "It's closures all the way down." */ CvCLONE_on(compcv); @@ -235,7 +237,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) } } else if (!CvUNIQUE(compcv)) { - if (dowarn && !CvUNIQUE(cv)) + if (dowarn && !SvFAKE(sv) && !CvUNIQUE(cv)) warn("Variable \"%s\" will not stay shared", name); } } @@ -2885,7 +2887,7 @@ CV* cv; pname = AvARRAY(pad_name); ppad = AvARRAY(pad); - for (ix = 1; ix <= AvFILL(pad); ix++) { + for (ix = 1; ix <= AvFILL(pad_name); ix++) { if (SvPOK(pname[ix])) PerlIO_printf(Perl_debug_log, "\t%4d. 0x%p (%s\"%s\" %ld-%ld)\n", ix, ppad[ix], @@ -2909,6 +2911,8 @@ 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); AV* comppadlist; CV* cv; @@ -2948,8 +2952,8 @@ CV* outside; av_store(comppad, 0, (SV*)av); AvFLAGS(av) = AVf_REIFY; - for (ix = AvFILL(protopad); ix > 0; ix--) { - SV* namesv = pname[ix]; + for (ix = fpad; ix > 0; ix--) { + SV* namesv = (ix <= fname) ? pname[ix] : Nullsv; if (namesv && namesv != &sv_undef) { char *name = SvPVX(namesv); /* XXX */ if (SvFLAGS(namesv) & SVf_FAKE) { /* lexical from outside? */ @@ -2986,8 +2990,8 @@ CV* outside; /* Now that vars are all in place, clone nested closures. */ - for (ix = AvFILL(protopad); ix > 0; ix--) { - SV* namesv = pname[ix]; + for (ix = fpad; ix > 0; ix--) { + SV* namesv = (ix <= fname) ? pname[ix] : Nullsv; if (namesv && namesv != &sv_undef && !(SvFLAGS(namesv) & SVf_FAKE) @@ -3173,8 +3177,8 @@ OP *block; db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV); } hv = GvHVn(db_postponed); - if (HvFILL(hv) >= 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr)) - && (cv = GvCV(db_postponed))) { + if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr)) + && (cv = GvCV(db_postponed))) { dSP; PUSHMARK(sp); XPUSHs(tmpstr); @@ -1,6 +1,6 @@ /* op.h * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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/patchlevel.h b/patchlevel.h index 0d6595bf41..42143c3cfc 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1,5 +1,5 @@ #define PATCHLEVEL 3 -#define SUBVERSION 91 +#define SUBVERSION 92 /* local_patches -- list of locally applied less-than-subversion patches. @@ -1,6 +1,6 @@ /* perl.c * - * Copyright (c) 1987-1996 Larry Wall + * Copyright (c) 1987-1997 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. @@ -1400,7 +1400,7 @@ char *s; return s; case 'T': if (!tainting) - croak("Too late for \"-T\" option (try putting it first)"); + croak("Too late for \"-T\" option"); s++; return s; case 'u': @@ -1427,7 +1427,7 @@ char *s; #endif #ifdef OS2 printf("\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n" - "Version 5 port Copyright (c) 1994-1996, Andreas Kaiser, Ilya Zakharevich\n"); + "Version 5 port Copyright (c) 1994-1997, Andreas Kaiser, Ilya Zakharevich\n"); #endif #ifdef atarist printf("atariST series port, ++jrb bammi@cadence.com\n"); @@ -1,6 +1,6 @@ /* perl.h * - * Copyright (c) 1987-1994, Larry Wall + * Copyright (c) 1987-1997, 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/perlsdio.h b/perlsdio.h index f5c2921f38..97add0f991 100644 --- a/perlsdio.h +++ b/perlsdio.h @@ -16,7 +16,6 @@ #define PerlIO_printf fprintf #define PerlIO_stdoutf printf #define PerlIO_vprintf(f,fmt,a) vfprintf(f,fmt,a) -#define PerlIO_read(f,buf,count) fread(buf,1,count,f) #define PerlIO_write(f,buf,count) fwrite1(buf,1,count,f) #define PerlIO_open fopen #define PerlIO_fdopen fdopen @@ -24,21 +23,28 @@ #define PerlIO_close(f) fclose(f) #define PerlIO_puts(f,s) fputs(s,f) #define PerlIO_putc(f,c) fputc(c,f) -#if defined(VMS) && defined(__DECC) - /* Unusual definition of ungetc() here to accomodate fast_sv_gets()' - * belief that it can mix getc/ungetc with reads from stdio buffer */ - int decc$ungetc(int __c, FILE *__stream); -# define PerlIO_ungetc(f,c) ((c) == EOF ? EOF : \ - ((*(f) && !((*(f))->_flag & _IONBF) && \ - ((*(f))->_ptr > (*(f))->_base)) ? \ - ((*(f))->_cnt++, *(--(*(f))->_ptr) = (c)) : decc$ungetc(c,f))) - /* Work around bug in DECCRTL/AXP (DECC v5.x) which causes read - * from a pipe after EOF has been returned once to hang. +#if defined(VMS) +# if defined(__DECC) + /* Unusual definition of ungetc() here to accomodate fast_sv_gets()' + * belief that it can mix getc/ungetc with reads from stdio buffer */ + int decc$ungetc(int __c, FILE *__stream); +# define PerlIO_ungetc(f,c) ((c) == EOF ? EOF : \ + ((*(f) && !((*(f))->_flag & _IONBF) && \ + ((*(f))->_ptr > (*(f))->_base)) ? \ + ((*(f))->_cnt++, *(--(*(f))->_ptr) = (c)) : decc$ungetc(c,f))) +# else +# define PerlIO_ungetc(f,c) ungetc(c,f) +# endif + /* Work around bug in DECCRTL/AXP (DECC v5.x) and some versions of old + * VAXCRTL which causes read from a pipe after EOF has been returned + * once to hang. */ # define PerlIO_getc(f) (feof(f) ? EOF : getc(f)) +# define PerlIO_read(f,buf,count) (feof(f) ? 0 : fread(buf,1,count,f)) #else # define PerlIO_ungetc(f,c) ungetc(c,f) # define PerlIO_getc(f) getc(f) +# define PerlIO_read(f,buf,count) fread(buf,1,count,f) #endif #define PerlIO_eof(f) feof(f) #define PerlIO_getname(f,b) fgetname(f,b) @@ -1,6 +1,6 @@ /* perly.y * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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/plan9/buildinfo b/plan9/buildinfo index 96639c3eb2..ac81a7f96f 100644 --- a/plan9/buildinfo +++ b/plan9/buildinfo @@ -1 +1 @@ -p9pvers = 5.003_91 +p9pvers = 5.003_92 diff --git a/pod/perl.pod b/pod/perl.pod index 99f996f130..f3ddc3c2c7 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -227,7 +227,7 @@ See L<perlrun>. =head1 AUTHOR -Larry Wall E<lt>F<larry@wall.org>E<gt>, with the help of oodles of other folks. +Larry Wall <F<larry@wall.org>>, with the help of oodles of other folks. =head1 FILES @@ -277,7 +277,7 @@ expression may not compile to more than 32767 bytes internally. You may mail your bug reports (be sure to include full configuration information as output by the myconfig program in the perl source tree, -or by C<perl -V>) to F<perlbug@perl.com>. +or by C<perl -V>) to <F<perlbug@perl.com>>. 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/pod/perlcall.pod b/pod/perlcall.pod index 20c863cc57..dc965009d6 100644 --- a/pod/perlcall.pod +++ b/pod/perlcall.pod @@ -1889,7 +1889,7 @@ L<perlxs>, L<perlguts>, L<perlembed> =head1 AUTHOR -Paul Marquess E<lt>F<pmarquess@bfsec.bt.co.uk>E<gt> +Paul Marquess <F<pmarquess@bfsec.bt.co.uk>> Special thanks to the following people who assisted in the creation of the document. diff --git a/pod/perldelta.pod b/pod/perldelta.pod index bfdf9031ef..734e940b42 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -42,13 +42,26 @@ fixed. As a result, the string "$$0" is no longer equivalent to C<$$."0">, but rather to C<${$0}>. To get the old behavior, change "$$" followed by a digit to "${$}". -=head2 Internal Change: FileHandle Deprecated +=head2 Changes to Tainting Checks -Filehandles are now stored internally as type IO::Handle. -Although C<use FileHandle> and C<*STDOUT{FILEHANDLE}> -are still supported for backwards compatibility, -C<use IO::Handle> (or C<IO::Seekable> or C<IO::File>) and -C<*STDOUT{IO}> are the way of the future. +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. + +=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. + +In harmony with this change, C<*GLOB{FILEHANDLE}> is now a +backward-compatible synonym for C<*STDOUT{IO}>. =head2 Internal Change: PerlIO internal IO abstraction interface @@ -198,6 +211,19 @@ 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.) +=item srand + +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. + +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. + =item $_ as Default Functions documented in the Camel to default to $_ now in @@ -1028,10 +1054,10 @@ There may also be information at http://www.perl.com/perl/, the Perl Home Page. If you believe you have an unreported bug, please run the B<perlbug> -program included with your release. Make sure you trim your bug -down to a tiny but sufficient test case. Your bug report, along -with the output of C<perl -V>, will be sent off to F<perlbug@perl.com> -to be analysed by the Perl porting team. +program included with your release. Make sure you trim your bug down +to a tiny but sufficient test case. Your bug report, along with the +output of C<perl -V>, will be sent off to <F<perlbug@perl.com>> to be +analysed by the Perl porting team. =head1 SEE ALSO diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 3334b65b61..c21e28a913 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -838,6 +838,12 @@ the return value of your socket() call? See L<perlfunc/connect>. inlining. See L<perlsub/"Constant Functions"> for commentary and workarounds. +=item Constant subroutine %s undefined + +(S) You undefined a subroutine which had previously been eligible for +inlining. See L<perlsub/"Constant Functions"> for commentary and +workarounds. + =item Copy method did not return a reference (F) The method which overloads "=" is buggy. See L<overload/Copy Constructor>. @@ -1106,6 +1112,16 @@ 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 In string, @%s now must be written as \@%s + +(F) It used to be that Perl would try to guess whether you wanted an +array interpolated or a literal @. It did this when the string was first +used at runtime. Now strings are parsed at compile time, and ambiguous +instances of @ must be disambiguated, either by prepending a backslash to +indicate a literal, or by declaring (or using) the array within the +program before the string (lexically). (Someday it will simply assume +that an unbackslashed @ interpolates an array.) + =item Insecure dependency in %s (F) You tried to do something that the tainting mechanism didn't like. @@ -1196,16 +1212,6 @@ L<perlfunc/last>. (W) You tried to do a listen on a closed socket. Did you forget to check the return value of your socket() call? See L<perlfunc/listen>. -=item Literal @%s now requires backslash - -(F) It used to be that Perl would try to guess whether you wanted an -array interpolated or a literal @. It did this when the string was -first used at runtime. Now strings are parsed at compile time, and -ambiguous instances of @ must be disambiguated, either by putting a -backslash to indicate a literal, or by declaring (or using) the array -within the program before the string (lexically). (Someday it will simply -assume that an unbackslashed @ interpolates an array.) - =item Method for operation %s not found in package %s during blessing (F) An attempt was made to specify an entry in an overloading table that @@ -1976,12 +1982,22 @@ See L<perlre>. =item Server error -Also known as "500 Server error". This is a CGI error, not a Perl -error. You need to make sure your script is executable, is accessible -by the user CGI is running the script under (which is probably not -the user account you tested it under), does not rely on any environment -variables (like PATH) 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. +Also known as "500 Server error". + +B<This is a CGI error, not a Perl error>. + +You need to make sure your script is executable, is accessible by the user +CGI is running the script under (which is probably not the user account you +tested it under), does not rely on any environment variables (like PATH) +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 + 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 =item setegid() not implemented @@ -2194,18 +2210,21 @@ you're not running on Unix. (F) There has to be at least one argument to syscall() to specify the system call to call, silly dilly. -=item Too late for "B<-T>" option (try putting it first) +=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. -(X) The #! line in a Perl script contains the B<-T> option, but Perl -was not invoked with B<-T> in its argument list. Due to the way Perl -handles tainting, by the time Perl discovers a B<-T> in a script, it's -too late to properly taint everything from the environment. So Perl -gives up. +If the Perl script is being executed as a command using the #! +mechanism (or its local equivalent), this error can usually be fixed +by editing the #! line so that the B<-T> option is a part of Perl's +first argument: e.g. change C<perl -n -T> to C<perl -T -n>. -This error can usually be fixed by editing the #! line so that the -B<-T> option is in the Perl program's first argument. (Many operating -systems that implement the #! feature only pick up one argument from -it, so Perl has to get the rest on its own.) +If the Perl script is being executed as C<perl scriptname>, then the +B<-T> option must appear on the command line: C<perl -T scriptname>. =item Too many ('s @@ -2470,7 +2489,7 @@ 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" is not exported +=item Variable "%s" is not imported%s (F) While "use strict" in effect, you referred to a global variable that you apparently thought was imported from another module, because diff --git a/pod/perldsc.pod b/pod/perldsc.pod index a6d6480dbf..fad539c0ec 100644 --- a/pod/perldsc.pod +++ b/pod/perldsc.pod @@ -828,7 +828,7 @@ perlref(1), perllol(1), perldata(1), perlobj(1) =head1 AUTHOR -Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> +Tom Christiansen <F<tchrist@perl.com>> Last update: Wed Oct 23 04:57:50 MET DST 1996 diff --git a/pod/perlembed.pod b/pod/perlembed.pod index a8bedccfd8..4b88754f72 100644 --- a/pod/perlembed.pod +++ b/pod/perlembed.pod @@ -56,8 +56,7 @@ L<Maintaining multiple interpreter instances> L<Using Perl modules, which themselves use C libraries, from your C program> This documentation is Unix specific; if you have information about how -to embed Perl on other platforms, please send e-mail to -orwant@tpj.com. +to embed Perl on other platforms, please send e-mail to <F<orwant@tpj.com>>. =head2 Compiling your C program @@ -955,9 +954,9 @@ each from the other, combine them as you wish. =head1 AUTHOR -Jon Orwant and F<E<lt>orwant@media.mit.eduE<gt>> and Doug MacEachern -F<E<lt>dougm@osf.orgE<gt>>, with small contributions from Tim Bunce, -Tom Christiansen, Hallvard Furuseth, Dov Grobgeld, and Ilya Zakharevich. +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. diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 95bd4eccbd..21e4b2c789 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -1370,15 +1370,17 @@ Used to indicate scalar context. See C<GIMME> 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>. +C<NULL>. The glob lives in the given C<stash>, or in the stashes +accessable via @ISA and @<UNIVERSAL>. -The argument C<level> should be either 0 or -1. If C<level==0>, as a +The argument C<level> should be either 0 or -1. If C<level==0>, as a side-effect creates a glob with the given C<name> in the given C<stash> which in the case of success contains an alias for the subroutine, and sets up caching info for this glob. Similarly for all the searched stashes. +This function grants C<"SUPER"> token as a postfix of the stash name. + The GV returned from C<gv_fetchmeth> may be a method cache entry, 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 @@ -1398,8 +1400,7 @@ check for it being "AUTOLOAD", since at the later time the the call may load a different subroutine due to $AUTOLOAD changing its value. Use the glob created via a side effect to do this. -This function grants C<"SUPER"> token as prefix of name or postfix of -the stash name. +This function grants C<"SUPER"> token as a prefix of the method name. Has the same side-effects and as C<gv_fetchmeth> with C<level==0>. C<name> should be writable if contains C<':'> or C<'\''>. @@ -2898,14 +2899,14 @@ destination, C<n> is the number of items, and C<t> is the type. =head1 EDITOR -Jeff Okamoto <okamoto@corp.hp.com> +Jeff Okamoto <F<okamoto@corp.hp.com>> 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, and Ulrich Pfeifer. -API Listing by Dean Roehrich <roehrich@cray.com>. +API Listing by Dean Roehrich <F<roehrich@cray.com>>. =head1 DATE -Version 31.1: 1997/2/25 +Version 31.2: 1997/3/5 diff --git a/pod/perlipc.pod b/pod/perlipc.pod index 83f3d4ba34..d289ad380c 100644 --- a/pod/perlipc.pod +++ b/pod/perlipc.pod @@ -658,7 +658,7 @@ Here's a sample Unix-domain client: $rendezvous = shift || '/tmp/catsock'; socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!"; - connect(SOCK, sockaddr_un($remote)) || die "connect: $!"; + connect(SOCK, sockaddr_un($rendezvous)) || die "connect: $!"; while ($line = <SOCK>) { print $line; } diff --git a/pod/perllocale.pod b/pod/perllocale.pod index 15138677d2..9ac77b8e48 100644 --- a/pod/perllocale.pod +++ b/pod/perllocale.pod @@ -778,7 +778,7 @@ In certain system environments 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 +please report in excruciating detail to <F<perlbug@perl.com>>, and complain to your vendor: maybe some bug fixes exist for these problems in your operating system. Sometimes such bug fixes are called an operating system upgrade. diff --git a/pod/perllol.pod b/pod/perllol.pod index b2d5dbe537..f15b24384e 100644 --- a/pod/perllol.pod +++ b/pod/perllol.pod @@ -308,6 +308,6 @@ perldata(1), perlref(1), perldsc(1) =head1 AUTHOR -Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> +Tom Christiansen <F<tchrist@perl.com>> Last udpate: Sat Oct 7 19:35:26 MDT 1995 diff --git a/pod/perlmod.pod b/pod/perlmod.pod index 9b649d6425..3f6c19860a 100644 --- a/pod/perlmod.pod +++ b/pod/perlmod.pod @@ -222,17 +222,66 @@ definition and make its semantics available implicitly through method calls on the class and its objects, without explicit exportation of any symbols. Or it can do a little of both. -For example, to start a normal module called Fred, create -a file called Fred.pm and put this at the start of it: - - package Fred; - use strict; - use Exporter (); - use vars qw(@ISA @EXPORT @EXPORT_OK); - @ISA = qw(Exporter); - @EXPORT = qw(&func1 &func2); - @EXPORT_OK = qw($sally @listabob %harry &func3); - use vars qw($sally @listabob %harry); +For example, to start a normal module called Some::Module, create +a file called Some/Module.pm and start with this template: + + package Some::Module; # assumes Some/Module.pm + + use strict; + + BEGIN { + use Exporter (); + use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + + # set the version for version checking + $VERSION = 1.00; + # if using RCS/CVS, this may be preferred + $VERSION = do { my @r = (q$Revision: 2.21 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker + + @ISA = qw(Exporter); + @EXPORT = qw(&func1 &func2 &func4); + %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], + + # your exported package globals go here, + # as well as any optionally exported functions + @EXPORT_OK = qw($Var1 %Hashit &func3); + } + use vars @EXPORT_OK; + + # non-exported package globals go here + use vars qw(@more $stuff); + + # initalize package globals, first exported ones + $Var1 = ''; + %Hashit = (); + + # then the others (which are still accessible as $Some::Module::stuff) + $stuff = ''; + @more = (); + + # all file-scoped lexicals must be created before + # the functions below that use them. + + # file-private lexicals go here + my $priv_var = ''; + my %secret_hash = (); + + # here's a file-private function as a closure, + # callable as &$priv_func; it cannot be prototyped. + my $priv_func = sub { + # stuff goes here. + }; + + # make all your functions, whether exported or not; + # remember to put something interesting in the {} stubs + sub func1 {} # no prototype + sub func2() {} # proto'd void + sub func3($$) {} # proto'd to 2 scalars + + # this one isn't exported, but could be called! + sub func4(\%) {} # proto'd to 1 hash ref + + END { } # module clean-up code here (global destructor) Then go on to declare and use your variables in functions without any qualifications. @@ -904,70 +953,87 @@ You should try to choose one close to you: =over =item * -ftp://ftp.sterling.com/programming/languages/perl/ - -=item * -ftp://ftp.sedl.org/pub/mirrors/CPAN/ - -=item * -ftp://ftp.uoknor.edu/mirrors/CPAN/ - -=item * -ftp://ftp.delphi.com/pub/mirrors/packages/perl/CPAN/ +Africa -=item * -ftp://uiarchive.cso.uiuc.edu/pub/lang/perl/CPAN/ - -=item * -ftp://ftp.cis.ufl.edu/pub/perl/CPAN/ - -=item * -ftp://ftp.switch.ch/mirror/CPAN/ - -=item * -ftp://ftp.sunet.se/pub/lang/perl/CPAN/ - -=item * -ftp://ftp.ci.uminho.pt/pub/lang/perl/ - -=item * -ftp://ftp.cs.ruu.nl/pub/PERL/CPAN/ + South Africa ftp://ftp.is.co.za/programming/perl/CPAN/ =item * -ftp://ftp.demon.co.uk/pub/mirrors/perl/CPAN/ +Asia -=item * -ftp://ftp.rz.ruhr-uni-bochum.de/pub/programming/languages/perl/CPAN/ - -=item * -ftp://ftp.leo.org/pub/comp/programming/languages/perl/CPAN/ + 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/ =item * -ftp://ftp.pasteur.fr/pub/computing/unix/perl/CPAN/ +Australasia -=item * -ftp://ftp.ibp.fr/pub/perl/CPAN/ - -=item * -ftp://ftp.funet.fi/pub/languages/perl/CPAN/ + Australia ftp://ftp.netinfo.com.au/pub/perl/CPAN/ + New Zealand ftp://ftp.tekotago.ac.nz/pub/perl/CPAN/ =item * -ftp://ftp.tekotago.ac.nz/pub/perl/CPAN/ +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/ + Switzerland ftp://sunsite.cnlab-switch.ch/mirror/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/ =item * -ftp://ftp.mame.mu.oz.au/pub/perl/CPAN/ +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/ + 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 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/ + Washington ftp://ftp.spu.edu/pub/CPAN/ =item * -ftp://coombs.anu.edu.au/pub/perl/ +South America -=item * -ftp://dongpo.math.ncu.edu.tw/perl/CPAN/ - -=item * -ftp://ftp.lab.kdd.co.jp/lang/perl/CPAN/ - -=item * -ftp://ftp.is.co.za/programming/perl/CPAN/ + Chile ftp://sunsite.dcc.uchile.cl/pub/Lang/perl/CPAN/ =back @@ -1273,7 +1339,7 @@ or upload to one of these sites: ftp://franz.ww.tu-berlin.de/incoming ftp://ftp.cis.ufl.edu/incoming -and notify upload@franz.ww.tu-berlin.de. +and notify <F<upload@franz.ww.tu-berlin.de>>. By using the WWW interface you can ask the Upload Server to mirror your modules from your ftp or WWW site into your own directory on diff --git a/pod/perltie.pod b/pod/perltie.pod index dfc6894172..ffd348fcc1 100644 --- a/pod/perltie.pod +++ b/pod/perltie.pod @@ -60,7 +60,7 @@ And now whenever either of those variables is accessed, its current system priority is retrieved and returned. If those variables are set, then the process's priority is changed! -We'll use Jarkko Hietaniemi F<E<lt>Jarkko.Hietaniemi@hut.fiE<gt>>'s +We'll use Jarkko Hietaniemi <F<Jarkko.Hietaniemi@hut.fi>>'s BSD::Resource class (not included) to access the PRIO_PROCESS, PRIO_MIN, and PRIO_MAX constants from your system, as well as the getpriority() and setpriority() system calls. Here's the preamble of the class. @@ -814,4 +814,4 @@ source code to MLDBM. Tom Christiansen -TIEHANDLE by Sven Verdoolaege E<lt>F<skimo@dns.ufsia.ac.be>E<gt> +TIEHANDLE by Sven Verdoolaege <F<skimo@dns.ufsia.ac.be>> diff --git a/pod/perltoc.pod b/pod/perltoc.pod index 551f444c31..9e943d1623 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -54,7 +54,9 @@ expression enhancements, Innumerable Unbundled Modules, Compilability =item Fixed Parsing of $$<digit>, &$<digit>, etc. -=item Internal Change: FileHandle Deprecated +=item Changes to Tainting Checks + +=item Internal Change: FileHandle Class Based on IO::* Classes =item Internal Change: PerlIO internal IO abstraction interface @@ -66,9 +68,9 @@ $^E, $^H, $^M delete on slices, flock, printf and sprintf, keys as an lvalue, my() in Control Structures, unpack() and pack(), use VERSION, use Module VERSION -LIST, prototype(FUNCTION), $_ as Default, C<m//g> does not trigger a pos() -reset on failure, nested C<sub{}> closures work now, formats work right on -changing lexicals +LIST, prototype(FUNCTION), srand, $_ as Default, C<m//g> does not trigger a +pos() reset on failure, nested C<sub{}> closures work now, formats work +right on changing lexicals =item New Built-in Methods @@ -547,7 +549,8 @@ World Wide Web, HTML, HTTP, CGI, MIME, Server and Daemon Utilities, Archiving and Compression, Images, Pixmap and Bitmap Manipulation, Drawing, and Graphing, Mail and Usenet News, Control Flow Utilities (callbacks and exceptions etc), File Handle and Input/Output Stream Utilities, -Miscellaneous Modules +Miscellaneous Modules, Africa, Asia, Australasia, Europe, North America, +South America =item Modules: Creation, Use, and Abuse @@ -2582,12 +2585,16 @@ E<lt>noneE<gt>, !, =s, :s, =i, :i, =f, :f =item EXAMPLES -=item CONFIGURATION VARIABLES +=item CONFIGURATION OPTIONS + +default, auto_abbrev, getopt_compat, require_order, permute, bundling +(default: reset), bundling_override (default: reset), ignore_case +(default: set), ignore_case_always (default: reset), pass_through (default: +reset), debug (default: reset) + +=item OTHER USEFUL VARIABLES -$Getopt::Long::autoabbrev, $Getopt::Long::getopt_compat, -$Getopt::Long::order, $Getopt::Long::bundling, $Getopt::Long::ignorecase, -$Getopt::Long::passthrough, $Getopt::Long::VERSION, $Getopt::Long::error, -$Getopt::Long::debug +$Getopt::Long::VERSION, $Getopt::Long::error =head2 Getopt::Std, getopt - Process single-character switches with switch clustering @@ -2617,7 +2624,7 @@ locale =item CONSTRUCTOR -new ([ ARGS ] ) +new ([ ARGS ] ), new_tmpfile =item METHODS @@ -2750,7 +2757,7 @@ hostpath(), peerpath() =item CONSTRUCTOR -new ([ ARGS ] ) +new ([ ARGS ] ), new_tmpfile =item METHODS @@ -3393,10 +3400,14 @@ no real package is found, substitutes stubs instead of basic functions. =item Minimal set of supported functions C<ReadLine>, C<new>, C<readline>, C<addhistory>, C<IN>, $C<OUT>, -C<MinLine>, C<findConsole>, C<Features> +C<MinLine>, C<findConsole>, Attribs, C<Features> + +=item Additional supported functions =item EXPORTS +=item ENVIRONMENT + =head2 Test::Harness - run perl standard test scripts with statistics =item SYNOPSIS diff --git a/pod/perltrap.pod b/pod/perltrap.pod index a179b8b5a8..6f6688701f 100644 --- a/pod/perltrap.pod +++ b/pod/perltrap.pod @@ -391,8 +391,8 @@ Everything else. =back If you find an example of a conversion trap that is not listed here, -please submit it to Bill Middleton F<wjm@best.com> for inclusion. -Also note that at least some of these can be caught with C<-w>. +please submit it to Bill Middleton <F<wjm@best.com>> for inclusion. +Also note that at least some of these can be caught with B<-w>. =head2 Discontinuance, Deprecation, and BugFix traps @@ -550,9 +550,9 @@ behave like C<split /\s+/> (which does). =item * BugFix -Perl 4 would ignore any text which was attached to an C<-e> switch, +Perl 4 would ignore any text which was attached to an B<-e> switch, always taking the code snippet from the following arg. Additionally, it -would silently accept an C<-e> switch without a following arg. Both of +would silently accept an B<-e> switch without a following arg. Both of these behaviors have been fixed. perl -e'print "attached to -e"' 'print "separate arg"' @@ -740,7 +740,7 @@ variable is localized subsequent to the assignment print "@fred"; # should print "1, 2, 4" # perl4 prints: 1 2 4 - # perl5 prints: Literal @fred now requires backslash + # perl5 prints: In string, @fred now must be written as \@fred =item * (Scalar String) @@ -1261,7 +1261,7 @@ within certain expressions, statements, contexts, or whatever. print "To: someone@somewhere.com\n"; # perl4 prints: To:someone@somewhere.com - # perl5 errors : Literal @somewhere now requires backslash + # perl5 errors : In string, @somewhere now must be written as \@somewhere =item * Interpolation diff --git a/pod/perlxs.pod b/pod/perlxs.pod index 35d74e9eed..bc2cce1cfa 100644 --- a/pod/perlxs.pod +++ b/pod/perlxs.pod @@ -1177,5 +1177,5 @@ This document covers features supported by C<xsubpp> 1.935. =head1 AUTHOR -Dean Roehrich F<E<lt>roehrich@cray.comE<gt>> +Dean Roehrich <F<roehrich@cray.com>> Jul 8, 1996 diff --git a/pod/perlxstut.pod b/pod/perlxstut.pod index 0ad1b1038d..7b9b7c60f5 100644 --- a/pod/perlxstut.pod +++ b/pod/perlxstut.pod @@ -729,7 +729,7 @@ and L<perlpod>. =head2 Author -Jeff Okamoto E<lt>F<okamoto@corp.hp.com>E<gt> +Jeff Okamoto <F<okamoto@corp.hp.com>> Reviewed and assisted by Dean Roehrich, Ilya Zakharevich, Andreas Koenig, and Tim Bunce. @@ -1,6 +1,6 @@ /* pp.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -92,7 +92,8 @@ PP(pp_padhv) else { SV* sv = sv_newmortal(); if (HvFILL((HV*)TARG)) { - sprintf(buf, "%d/%d", HvFILL((HV*)TARG), HvMAX((HV*)TARG)+1); + sprintf(buf, "%ld/%ld", + (long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG)+1); sv_setpv(sv, buf); } else @@ -545,6 +546,11 @@ PP(pp_undef) hv_undef((HV*)sv); break; case SVt_PVCV: + if (!CvANON((CV*)sv) && cv_const_sv((CV*)sv)) + warn("Constant subroutine %s undefined", + GvENAME(CvGV((CV*)sv))); + /* FALL THROUGH */ + case SVt_PVFM: cv_undef((CV*)sv); break; case SVt_PVGV: @@ -2990,7 +2996,8 @@ PP(pp_unpack) char decn[sizeof(UV) * 3 + 1]; char *t; - (void) sprintf(decn, "%0*ld", sizeof(decn) - 1, auv); + (void) sprintf(decn, "%0*ld", + (int)sizeof(decn) - 1, auv); sv = newSVpv(decn, 0); while (s < strend) { sv = mul128(sv, *s & 0x7f); @@ -1,6 +1,6 @@ /* pp.h * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* pp_ctl.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1127,8 +1127,8 @@ sortcv(a, b) const void *a; const void *b; { - SV **str1 = (SV **) a; - SV **str2 = (SV **) b; + SV * const *str1 = (SV * const *)a; + SV * const *str2 = (SV * const *)b; I32 oldsaveix = savestack_ix; I32 oldscopeix = scopestack_ix; I32 result; @@ -1154,7 +1154,7 @@ sortcmp(a, b) const void *a; const void *b; { - return sv_cmp(*(SV **)a, *(SV **)b); + return sv_cmp(*(SV * const *)a, *(SV * const *)b); } static int @@ -1162,7 +1162,7 @@ sortcmp_locale(a, b) const void *a; const void *b; { - return sv_cmp_locale(*(SV **)a, *(SV **)b); + return sv_cmp_locale(*(SV * const *)a, *(SV * const *)b); } PP(pp_reset) @@ -1,6 +1,6 @@ /* pp_hot.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -557,7 +557,7 @@ PP(pp_rv2hv) else { dTARGET; if (HvFILL(hv)) { - sprintf(buf, "%d/%d", HvFILL(hv), HvMAX(hv)+1); + sprintf(buf, "%ld/%ld", (long)HvFILL(hv), (long)HvMAX(hv)+1); sv_setpv(TARG, buf); } else @@ -1137,6 +1137,8 @@ do_readline() } else { sv = TARG; + if (SvROK(sv)) + sv_unref(sv); (void)SvUPGRADE(sv, SVt_PV); tmplen = SvLEN(sv); /* remember if already alloced */ if (!tmplen) @@ -1,6 +1,6 @@ /* pp_sys.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -43,7 +43,7 @@ * **** Alterations to Henry's code are... **** - **** Copyright (c) 1991-1994, Larry Wall + **** Copyright (c) 1991-1997, Larry Wall **** **** You may distribute under the terms of either the GNU General Public **** License or the Artistic License, as specified in the README file. @@ -42,7 +42,7 @@ * **** Alterations to Henry's code are... **** - **** Copyright (c) 1991-1994, Larry Wall + **** Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* run.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -111,12 +111,13 @@ OP* op; void debprofdump() { - U32 i; + unsigned i; if (!profiledata) return; for (i = 0; i < MAXO; i++) { if (profiledata[i]) - PerlIO_printf(Perl_debug_log, "%d\t%lu\n", i, profiledata[i]); + PerlIO_printf(Perl_debug_log, + "%u\t%lu\n", i, (unsigned long)profiledata[i]); } } @@ -1,6 +1,6 @@ /* scope.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* sv.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1973,11 +1973,16 @@ register SV *sstr; CV* cv = GvCV(dstr); if (cv) { dref = (SV*)cv; - if (dowarn && sref != dref && - !GvCVGEN((GV*)dstr) && - (CvROOT(cv) || CvXSUB(cv)) ) - warn("Subroutine %s redefined", - GvENAME((GV*)dstr)); + if (sref != dref && + !GvCVGEN((GV*)dstr) && + (CvROOT(cv) || CvXSUB(cv)) ) { + if (cv_const_sv(cv)) + warn("Constant subroutine %s redefined", + GvENAME((GV*)dstr)); + else if (dowarn) + warn("Subroutine %s redefined", + GvENAME((GV*)dstr)); + } } } if (GvCV(dstr) != (CV*)sref) { @@ -3168,7 +3173,7 @@ thats_really_all_folks: SvCUR_set(sv, bp - (STDCHAR*)SvPVX(sv)); /* set length */ DEBUG_P(PerlIO_printf(Perl_debug_log, "Screamer: done, len=%d, string=|%.*s|\n", - SvCUR(sv),SvCUR(sv),SvPVX(sv))); + SvCUR(sv),(int)SvCUR(sv),SvPVX(sv))); } else { @@ -1,6 +1,6 @@ /* sv.h * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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/t/op/runlevel.t b/t/op/runlevel.t index ca6aac5e5b..2fc2174596 100755 --- a/t/op/runlevel.t +++ b/t/op/runlevel.t @@ -16,7 +16,8 @@ chdir 't' if -d 't'; @INC = "../lib"; -$ENV{PERL5LIB} = "../lib"; +$Is_VMS = $^O eq 'VMS'; +$ENV{PERL5LIB} = "../lib" unless $Is_VMS; $|=1; @@ -26,22 +27,27 @@ print "1..", scalar @prgs, "\n"; $tmpfile = "runltmp000"; 1 while -f ++$tmpfile; -END { unlink $tmpfile if $tmpfile; } +END { if ($tmpfile) { 1 while unlink $tmpfile; } } for (@prgs){ my $switch; - if (s/^\s*-\w+//){ - $switch = $&; + if (s/^\s*(-\w+)//){ + $switch = $1; } my($prog,$expected) = split(/\nEXPECT\n/, $_); - open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1"; - print TEST $prog, "\n"; + open TEST, ">$tmpfile"; + print TEST "$prog\n"; close TEST; - $status = $?; - $results = `cat $tmpfile`; + my $results = $Is_VMS ? + `MCR $^X "-I[-.lib]" $switch $tmpfile` : + `sh -c './perl $switch $tmpfile' 2>&1`; + my $status = $?; $results =~ s/\n+$//; + # allow expected output to be written as if $prog is on STDIN + $results =~ s/runltmp\d+/-/g; + $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg $expected =~ s/\n+$//; - if ( $results ne $expected){ + if ($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/t/op/taint.t b/t/op/taint.t index 32277181f6..56765fb71d 100755 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -3,7 +3,7 @@ # Taint tests by Tom Phoenix <rootbeer@teleport.com>. # # I don't claim to know all about tainting. If anyone sees -# tests that I've missed here, please add them. But this is +# tests that I've missed here, please add them. But this is # better than having no tests at all, right? # @@ -61,7 +61,7 @@ sub test ($$;$) { for (split m/^/m, $diag) { print "# $_"; } - print "\n" unless + print "\n" unless $diag eq '' or substr($diag, -1) eq "\n"; } @@ -75,7 +75,7 @@ print PROG 'print "@ARGV\n"', "\n"; close PROG; my $echo = "$Invoke_Perl $ECHO"; -print "1..96\n"; +print "1..98\n"; # First, let's make sure that Perl is checking the dangerous # environment variables. Maybe they aren't set yet, so we'll @@ -84,7 +84,7 @@ print "1..96\n"; $ENV{'DCL$PATH'} = '' if $Is_VMS; $ENV{PATH} = $TAINT; - $ENV{IFS} = ''; + $ENV{IFS} = " \t\n"; test 1, eval { `$echo 1` } eq ''; test 2, $@ =~ /^Insecure \$ENV{PATH}/, $@; @@ -93,19 +93,29 @@ print "1..96\n"; test 3, eval { `$echo 1` } eq ''; test 4, $@ =~ /^Insecure \$ENV{IFS}/, $@; - my ($tmp) = grep { (stat)[2] & 2 } '/tmp', '/var/tmp', '/usr/tmp'; + my $tmp; + if ($^O eq 'os2' || $^O eq 'amigaos') { + print "# all directories are writeable\n"; + } + else { + $tmp = (grep { defined and -d and (stat _)[2] & 2 } + qw(/tmp /var/tmp /usr/tmp /sys$scratch), + @ENV{qw(TMP TEMP)})[0] + or print "# can't find world-writeable directory to test PATH\n"; + } + if ($tmp) { $ENV{PATH} = $tmp; + $ENV{IFS} = " \t\n"; test 5, eval { `$echo 1` } eq ''; test 6, $@ =~ /^Insecure directory in \$ENV{PATH}/, $@; } else { - print "# can't find writeable directory to test PATH tainting\n"; for (5..6) { print "ok $_\n" } } $ENV{PATH} = ''; - $ENV{IFS} = ''; + $ENV{IFS} = " \t\n"; test 7, eval { `$echo 1` } eq "1\n"; test 8, $@ eq '', $@; @@ -113,45 +123,57 @@ print "1..96\n"; $ENV{'DCL$PATH'} = $TAINT; test 9, eval { `$echo 1` } eq ''; test 10, $@ =~ /^Insecure \$ENV{DCL\$PATH}/, $@; + if ($tmp) { + $ENV{'DCL$PATH'} = $tmp; + test 11, eval { `$echo 1` } eq ''; + test 12, $@ =~ /^Insecure directory in \$ENV{DCL\$PATH}/, $@; + } + else { + print "# can't find world-writeable directory to test DCL\$PATH\n"; + for (11..12) { print "ok $_\n" } + } $ENV{'DCL$PATH'} = ''; } else { print "# This is not VMS\n"; - for (9..10) { print "ok $_\n"; } + for (9..12) { print "ok $_\n"; } } } # Let's see that we can taint and untaint as needed. { my $foo = $TAINT; - test 11, tainted $foo; + test 13, tainted $foo; + + # That was a sanity check. If it failed, stop the insanity! + die "Taint checks don't seem to be enabled" unless tainted $foo; $foo = "foo"; - test 12, not tainted $foo; + test 14, not tainted $foo; taint_these($foo); - test 13, tainted $foo; + test 15, tainted $foo; my @list = 1..10; - test 14, not any_tainted @list; + test 16, not any_tainted @list; taint_these @list[1,3,5,7,9]; - test 15, any_tainted @list; - test 16, all_tainted @list[1,3,5,7,9]; - test 17, not any_tainted @list[0,2,4,6,8]; + test 17, any_tainted @list; + test 18, all_tainted @list[1,3,5,7,9]; + test 19, not any_tainted @list[0,2,4,6,8]; ($foo) = $foo =~ /(.+)/; - test 18, not tainted $foo; + test 20, not tainted $foo; $foo = $1 if ('bar' . $TAINT) =~ /(.+)/; - test 19, not tainted $foo; - test 20, $foo eq 'bar'; + test 21, not tainted $foo; + test 22, $foo eq 'bar'; my $pi = 4 * atan2(1,1) + $TAINT0; - test 21, tainted $pi; + test 23, tainted $pi; ($pi) = $pi =~ /(\d+\.\d+)/; - test 22, not tainted $pi; - test 23, sprintf("%.5f", $pi) eq '3.14159'; + test 24, not tainted $pi; + test 25, sprintf("%.5f", $pi) eq '3.14159'; } # How about command-line arguments? The problem is that we don't @@ -167,144 +189,150 @@ print "1..96\n"; }; close PROG; print `$Invoke_Perl "-T" $arg and some suspect arguments`; - test 24, !$?, "Exited with status $?"; + test 26, !$?, "Exited with status $?"; unlink $arg; } # Reading from a file should be tainted { - my $file = './perl' . $Config{exe_ext}; - test 25, open(FILE, $file), "Couldn't open '$file': $!"; + my $file = './TEST'; + test 27, open(FILE, $file), "Couldn't open '$file': $!"; my $block; sysread(FILE, $block, 100); - my $line = <FILE>; # Should "work" + my $line = <FILE>; close FILE; - test 26, tainted $block; - test 27, tainted $line; + test 28, tainted $block; + test 29, tainted $line; } -# Globs should be tainted. +# Globs should be tainted. { + # Some glob implementations need to spawn system programs. + local $ENV{PATH} = ''; + $ENV{PATH} = (-l '/bin' ? '' : '/bin:') . '/usr/bin' unless $Is_VMS; + my @globs = <*>; - test 28, all_tainted @globs; + test 30, all_tainted @globs; @globs = glob '*'; - test 29, all_tainted @globs; + test 31, all_tainted @globs; } # Output of commands should be tainted { my $foo = `$echo abc`; - test 30, tainted $foo; + test 32, tainted $foo; } # Certain system variables should be tainted { - test 31, all_tainted $^X, $0; + test 33, all_tainted $^X, $0; } # Results of matching should all be untainted { my $foo = "abcdefghi" . $TAINT; - test 32, tainted $foo; + test 34, tainted $foo; $foo =~ /def/; - test 33, not any_tainted $`, $&, $'; + test 35, not any_tainted $`, $&, $'; $foo =~ /(...)(...)(...)/; - test 34, not any_tainted $1, $2, $3, $+; + test 36, not any_tainted $1, $2, $3, $+; my @bar = $foo =~ /(...)(...)(...)/; - test 35, not any_tainted @bar; + test 37, not any_tainted @bar; - test 36, tainted $foo; # $foo should still be tainted! - test 37, $foo eq "abcdefghi"; + test 38, tainted $foo; # $foo should still be tainted! + test 39, $foo eq "abcdefghi"; } # Operations which affect files can't use tainted data. { - test 38, eval { chmod 0, $TAINT } eq '', 'chmod'; - test 39, $@ =~ /^Insecure dependency/, $@; - - test 40, eval { truncate 'NoSuChFiLe', $TAINT0 } eq '', 'truncate'; + test 40, eval { chmod 0, $TAINT } eq '', 'chmod'; test 41, $@ =~ /^Insecure dependency/, $@; - test 42, eval { rename '', $TAINT } eq '', 'rename'; - test 43, $@ =~ /^Insecure dependency/, $@; + # There is no feature test in $Config{} for truncate, + # so we allow for the possibility that it's missing. + test 42, eval { truncate 'NoSuChFiLe', $TAINT0 } eq '', 'truncate'; + test 43, $@ =~ /^(?:Insecure dependency|truncate not implemented)/, $@; - test 44, eval { unlink $TAINT } eq '', 'unlink'; + test 44, eval { rename '', $TAINT } eq '', 'rename'; test 45, $@ =~ /^Insecure dependency/, $@; - test 46, eval { utime $TAINT } eq '', 'utime'; + test 46, eval { unlink $TAINT } eq '', 'unlink'; test 47, $@ =~ /^Insecure dependency/, $@; + test 48, eval { utime $TAINT } eq '', 'utime'; + test 49, $@ =~ /^Insecure dependency/, $@; + if ($Config{d_chown}) { - test 48, eval { chown -1, -1, $TAINT } eq '', 'chown'; - test 49, $@ =~ /^Insecure dependency/, $@; + test 50, eval { chown -1, -1, $TAINT } eq '', 'chown'; + test 51, $@ =~ /^Insecure dependency/, $@; } else { print "# chown() is not available\n"; - for (48..49) { print "ok $_\n" } + for (50..51) { print "ok $_\n" } } if ($Config{d_link}) { - test 50, eval { link $TAINT, '' } eq '', 'link'; - test 51, $@ =~ /^Insecure dependency/, $@; + test 52, eval { link $TAINT, '' } eq '', 'link'; + test 53, $@ =~ /^Insecure dependency/, $@; } else { print "# link() is not available\n"; - for (50..51) { print "ok $_\n" } + for (52..53) { print "ok $_\n" } } if ($Config{d_symlink}) { - test 52, eval { symlink $TAINT, '' } eq '', 'symlink'; - test 53, $@ =~ /^Insecure dependency/, $@; + test 54, eval { symlink $TAINT, '' } eq '', 'symlink'; + test 55, $@ =~ /^Insecure dependency/, $@; } else { print "# symlink() is not available\n"; - for (52..53) { print "ok $_\n" } + for (54..55) { print "ok $_\n" } } } # Operations which affect directories can't use tainted data. { - test 54, eval { mkdir $TAINT0, $TAINT } eq '', 'mkdir'; - test 55, $@ =~ /^Insecure dependency/, $@; - - test 56, eval { rmdir $TAINT } eq '', 'rmdir'; + test 56, eval { mkdir $TAINT0, $TAINT } eq '', 'mkdir'; test 57, $@ =~ /^Insecure dependency/, $@; - test 58, eval { chdir $TAINT } eq '', 'chdir'; + test 58, eval { rmdir $TAINT } eq '', 'rmdir'; test 59, $@ =~ /^Insecure dependency/, $@; + test 60, eval { chdir $TAINT } eq '', 'chdir'; + test 61, $@ =~ /^Insecure dependency/, $@; + if ($Config{d_chroot}) { - test 60, eval { chroot $TAINT } eq '', 'chroot'; - test 61, $@ =~ /^Insecure dependency/, $@; + test 62, eval { chroot $TAINT } eq '', 'chroot'; + test 63, $@ =~ /^Insecure dependency/, $@; } else { print "# chroot() is not available\n"; - for (60..61) { print "ok $_\n" } + for (62..63) { print "ok $_\n" } } } # Some operations using files can't use tainted data. { my $foo = "imaginary library" . $TAINT; - test 62, eval { require $foo } eq '', 'require'; - test 63, $@ =~ /^Insecure dependency/, $@; + test 64, eval { require $foo } eq '', 'require'; + test 65, $@ =~ /^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 64, eval { open FOO, $foo } eq '', 'open for read'; - test 65, $@ eq '', $@; # NB: This should be allowed - test 66, $! == 2; # File not found + test 66, eval { open FOO, $foo } eq '', 'open for read'; + test 67, $@ eq '', $@; # NB: This should be allowed + test 68, $! == 2; # File not found - test 67, eval { open FOO, "> $foo" } eq '', 'open for write'; - test 68, $@ =~ /^Insecure dependency/, $@; + test 69, eval { open FOO, "> $foo" } eq '', 'open for write'; + test 70, $@ =~ /^Insecure dependency/, $@; } # Commands to the system can't use tainted data @@ -313,71 +341,71 @@ print "1..96\n"; if ($^O eq 'amigaos') { print "# open(\"|\") is not available\n"; - for (69..72) { print "ok $_\n" } + for (71..74) { print "ok $_\n" } } else { - test 69, eval { open FOO, "| $foo" } eq '', 'popen to'; - test 70, $@ =~ /^Insecure dependency/, $@; - - test 71, eval { open FOO, "$foo |" } eq '', 'popen from'; + test 71, eval { open FOO, "| $foo" } eq '', 'popen to'; test 72, $@ =~ /^Insecure dependency/, $@; - } - test 73, eval { exec $TAINT } eq '', 'exec'; - test 74, $@ =~ /^Insecure dependency/, $@; + test 73, eval { open FOO, "$foo |" } eq '', 'popen from'; + test 74, $@ =~ /^Insecure dependency/, $@; + } - test 75, eval { system $TAINT } eq '', 'system'; + test 75, eval { exec $TAINT } eq '', 'exec'; test 76, $@ =~ /^Insecure dependency/, $@; + test 77, eval { system $TAINT } eq '', 'system'; + test 78, $@ =~ /^Insecure dependency/, $@; + $foo = "*"; taint_these $foo; - test 77, eval { `$echo 1$foo` } eq '', 'backticks'; - test 78, $@ =~ /^Insecure dependency/, $@; + test 79, eval { `$echo 1$foo` } eq '', 'backticks'; + test 80, $@ =~ /^Insecure dependency/, $@; if ($Is_VMS) { # wildcard expansion doesn't invoke shell, so is safe - test 79, join('', eval { glob $foo } ) ne '', 'globbing'; - test 80, $@ eq '', $@; + test 81, join('', eval { glob $foo } ) ne '', 'globbing'; + test 82, $@ eq '', $@; } else { - test 79, join('', eval { glob $foo } ) eq '', 'globbing'; - test 80, $@ =~ /^Insecure dependency/, $@; + test 81, join('', eval { glob $foo } ) eq '', 'globbing'; + test 82, $@ =~ /^Insecure dependency/, $@; } } # Operations which affect processes can't use tainted data. { - test 81, eval { kill 0, $TAINT } eq '', 'kill'; - test 82, $@ =~ /^Insecure dependency/, $@; + test 83, eval { kill 0, $TAINT } eq '', 'kill'; + test 84, $@ =~ /^Insecure dependency/, $@; if ($Config{d_setpgrp}) { - test 83, eval { setpgrp 0, $TAINT } eq '', 'setpgrp'; - test 84, $@ =~ /^Insecure dependency/, $@; + test 85, eval { setpgrp 0, $TAINT } eq '', 'setpgrp'; + test 86, $@ =~ /^Insecure dependency/, $@; } else { print "# setpgrp() is not available\n"; - for (83..84) { print "ok $_\n" } + for (85..86) { print "ok $_\n" } } if ($Config{d_setprior}) { - test 85, eval { setpriority 0, $TAINT, $TAINT } eq '', 'setpriority'; - test 86, $@ =~ /^Insecure dependency/, $@; + test 87, eval { setpriority 0, $TAINT, $TAINT } eq '', 'setpriority'; + test 88, $@ =~ /^Insecure dependency/, $@; } else { print "# setpriority() is not available\n"; - for (85..86) { print "ok $_\n" } + for (87..88) { print "ok $_\n" } } } # Some miscellaneous operations can't use tainted data. { if ($Config{d_syscall}) { - test 87, eval { syscall $TAINT } eq '', 'syscall'; - test 88, $@ =~ /^Insecure dependency/, $@; + test 89, eval { syscall $TAINT } eq '', 'syscall'; + test 90, $@ =~ /^Insecure dependency/, $@; } else { print "# syscall() is not available\n"; - for (87..88) { print "ok $_\n" } + for (89..90) { print "ok $_\n" } } { @@ -386,29 +414,29 @@ print "1..96\n"; local *FOO; my $temp = "./taintC$$"; END { unlink $temp } - test 89, open(FOO, "> $temp"), "Couldn't open $temp for write: $!"; + test 91, open(FOO, "> $temp"), "Couldn't open $temp for write: $!"; - test 90, eval { ioctl FOO, $TAINT, $foo } eq '', 'ioctl'; - test 91, $@ =~ /^Insecure dependency/, $@; + test 92, eval { ioctl FOO, $TAINT, $foo } eq '', 'ioctl'; + test 93, $@ =~ /^Insecure dependency/, $@; if ($Config{d_fcntl}) { - test 92, eval { fcntl FOO, $TAINT, $foo } eq '', 'fcntl'; - test 93, $@ =~ /^Insecure dependency/, $@; + test 94, eval { fcntl FOO, $TAINT, $foo } eq '', 'fcntl'; + test 95, $@ =~ /^Insecure dependency/, $@; } else { print "# fcntl() is not available\n"; - for (92..93) { print "ok $_\n" } + for (94..95) { print "ok $_\n" } } close FOO; } } -# Some tests involving references +# Some tests involving references { my $foo = 'abc' . $TAINT; my $fooref = \$foo; - test 94, not tainted $fooref; - test 95, tainted $$fooref; - test 96, tainted $foo; + test 96, not tainted $fooref; + test 97, tainted $$fooref; + test 98, tainted $foo; } diff --git a/t/pragma/strict-vars b/t/pragma/strict-vars index 727eb2d4f2..9814fd6ee8 100644 --- a/t/pragma/strict-vars +++ b/t/pragma/strict-vars @@ -165,8 +165,6 @@ print STDERR $@; $joe = 1 ; EXPECT Global symbol "joe" requires explicit package name at - line 5. -Variable "$joe" is not imported at - line 8. -Global symbol "joe" requires explicit package name at - line 8. Execution of - aborted due to compilation errors. ######## @@ -1,6 +1,6 @@ /* toke.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1263,7 +1263,8 @@ yylex() GV *gv = gv_fetchpv(tokenbuf+1, FALSE, SVt_PVAV); if (!gv || ((tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv))) { char tmpbuf[1024]; - sprintf(tmpbuf, "Literal %s now requires backslash", tokenbuf); + sprintf(tmpbuf, "In string, %s now must be written as \\%s", + tokenbuf, tokenbuf); yyerror(tmpbuf); } } @@ -1604,8 +1605,10 @@ 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(curcop->cop_filegv))) { sv_setpvn(x, ipath, ipathend - ipath); + SvSETMAGIC(x); + } TAINT_NOT; /* $^X is always tainted, but that's OK */ } #endif /* ARG_ZERO_IS_SCRIPT */ @@ -1,6 +1,6 @@ /* util.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* util.h * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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/vms/config.vms b/vms/config.vms index 5a24c33609..03051da43d 100644 --- a/vms/config.vms +++ b/vms/config.vms @@ -76,7 +76,7 @@ * when Perl is built. Please do not change it by hand; make * any changes to FndVers.Com instead. */ -#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00391" /**/ +#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00392" /**/ #define ARCHLIB ARCHLIB_EXP /*config-skip*/ /* ARCHNAME: diff --git a/vms/descrip.mms b/vms/descrip.mms index fc264ff99d..184271c14c 100644 --- a/vms/descrip.mms +++ b/vms/descrip.mms @@ -65,7 +65,7 @@ OBJVAL = $(MMS$TARGET_NAME)$(O) .endif # Updated by fndvers.com -- do not edit by hand -PERL_VERSION = 5_00391# +PERL_VERSION = 5_00392# ARCHDIR = [.lib.$(ARCH).$(PERL_VERSION)] @@ -799,8 +799,8 @@ test : all [.t.lib]vmsfspec.t archify : all @ Write Sys$Output "Moving files to architecture-specific locations for $(ARCH)" archroot = "$(ARCHAUTO)" - "]" + "...]" - Backup/Log/Verify [.lib.auto...]*.*;/Exclude=(*.al,*.ix) 'archroot' - Delete/Log/NoConfirm [.lib.auto...]*.*;*/exclude=(*.al,*.ix) + Backup/Log/Verify [.lib.auto...]*.*;/Exclude=(*.al,*.ix) 'archroot'/New_Version + Delete/Log/NoConfirm [.lib.auto...]*.*;*/exclude=(*.al,*.ix,*.dir) Delete/Log/NoConfirm [.lib]Config.pm;* Copy/Log/NoConfirm *$(E);,[.x2p]a2p$(E); $(ARCHDIR) Delete/Log/NoConfirm Perl*$(E);*,[.x2p]a2p$(E);* diff --git a/vms/perly_c.vms b/vms/perly_c.vms index d6d35bb610..0949d5bf1d 100644 --- a/vms/perly_c.vms +++ b/vms/perly_c.vms @@ -1286,7 +1286,9 @@ yyparse() int retval = 0; #if YYDEBUG register char *yys; +# ifndef getenv extern char *getenv(); +# endif #endif struct ysv *ysave = (struct ysv*)safemalloc(sizeof(struct ysv)); diff --git a/vms/sockadapt.c b/vms/sockadapt.c index cc130a5598..e4c3dad213 100644 --- a/vms/sockadapt.c +++ b/vms/sockadapt.c @@ -1,28 +1,76 @@ /* sockadapt.c * * Author: Charles Bailey bailey@genetics.upenn.edu - * Last Revised: 29-Jan-1996 + * Last Revised: 4-Mar-1997 * * This file should contain stubs for any of the TCP/IP functions perl5 * requires which are not supported by your TCP/IP stack. These stubs * can attempt to emulate the routine in question, or can just return * an error status or cause perl to die. * - * This version is set up for perl5 with socketshr 0.9D TCP/IP support. + * This version is set up for perl5 with UCX (or emulation) via + * the DECCRTL or SOCKETSHR 0.9D. */ #include "EXTERN.h" #include "perl.h" + #if defined(__DECC) && defined(__DECC_VER) && (__DECC_VER >= 50200000) +# define __sockadapt_my_hostent_t __struct_hostent_ptr32 # define __sockadapt_my_netent_t __struct_netent_ptr32 +# define __sockadapt_my_servent_t __struct_servent_ptr32 # define __sockadapt_my_addr_t __in_addr_t # define __sockadapt_my_name_t const char * #else +# define __sockadapt_my_hostent_t struct hostent * # define __sockadapt_my_netent_t struct netent * +# define __sockadapt_my_servent_t struct servent * # define __sockadapt_my_addr_t long # define __sockadapt_my_name_t char * #endif +void setnetent(int stayopen) { + croak("Function \"setnetent\" not implemented in this version of perl"); +} +void endnetent() { + croak("Function \"endnetent\" not implemented in this version of perl"); +} + +#if defined(DECCRTL_SOCKETS) + /* Use builtin socket interface in DECCRTL and + * UCX emulation in whatever TCP/IP stack is present. + */ + + void sethostent(int stayopen) { + croak("Function \"sethostent\" not implemented in this version of perl"); + } + void endhostent() { + croak("Function \"endhostent\" not implemented in this version of perl"); + } + void setprotoent(int stayopen) { + croak("Function \"setprotoent\" not implemented in this version of perl"); + } + void endprotoent() { + croak("Function \"endprotoent\" not implemented in this version of perl"); + } + void setservent(int stayopen) { + croak("Function \"setservent\" not implemented in this version of perl"); + } + void endservent() { + croak("Function \"endservent\" not implemented in this version of perl"); + } + __sockadapt_my_hostent_t gethostent() { + croak("Function \"gethostent\" not implemented in this version of perl"); + return (__sockadapt_my_hostent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */ + } + __sockadapt_my_servent_t getservent() { + croak("Function \"getservent\" not implemented in this version of perl"); + return (__sockadapt_my_servent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */ + } + +#else + /* Work around things missing/broken in SOCKETSHR. */ + __sockadapt_my_netent_t getnetbyaddr( __sockadapt_my_addr_t net, int type) { croak("Function \"getnetbyaddr\" not implemented in this version of perl"); return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */ @@ -33,13 +81,7 @@ __sockadapt_my_netent_t getnetbyname( __sockadapt_my_name_t name) { } __sockadapt_my_netent_t getnetent() { croak("Function \"getnetent\" not implemented in this version of perl"); - return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */ -} -void setnetent() { - croak("Function \"setnetent\" not implemented in this version of perl"); -} -void endnetent() { - croak("Function \"endnetent\" not implemented in this version of perl"); + return (__sockadapt_my_netent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */ } /* Some TCP/IP implementations seem to return success, when getpeername() @@ -64,3 +106,4 @@ int my_getpeername(int sock, struct sockaddr *addr, int *addrlen) { } return rslt; } +#endif /* SOCKETSHR stuff */ diff --git a/vms/sockadapt.h b/vms/sockadapt.h index 041fbd7073..e104ca7f3c 100644 --- a/vms/sockadapt.h +++ b/vms/sockadapt.h @@ -2,7 +2,7 @@ * * Authors: Charles Bailey bailey@genetics.upenn.edu * David Denholm denholm@conmat.phys.soton.ac.uk - * Last Revised: 17-Mar-1995 + * Last Revised: 4-Mar-1997 * * This file should include any other header files and procide any * declarations, typedefs, and prototypes needed by perl for TCP/IP @@ -11,15 +11,33 @@ * This version is set up for perl5 with socketshr 0.9D TCP/IP support. */ -/* SocketShr doesn't support these routines, but the DECC RTL contains - * stubs with these names, designed to be used with the UCX socket - * library. We avoid linker collisions by substituting new names. - */ -#define getnetbyaddr no_getnetbyaddr -#define getnetbyname no_getnetbyname -#define getnetent no_getnetent -#define setnetent no_setnetent -#define endnetent no_endnetent +#ifndef __SOCKADAPT_INCLUDED +#define __SOCKADAPT_INCLUDED 1 + +#if defined(DECCRTL_SOCKETS) + /* Use builtin socket interface in DECCRTL and + * UCX emulation in whatever TCP/IP stack is present. + * Provide prototypes for missing routines; stubs are + * in sockadapt.c. + */ +# include <socket.h> +# include <inet.h> +# include <in.h> +# include <netdb.h> + void sethostent(int); + void endhostent(void); + void setnetent(int); + void endnetent(void); + void setprotoent(int); + void endprotoent(void); + void setservent(int); + void endservent(void); + +#else + /* Pull in SOCKETSHR's header, and set up structures for + * gcc, whose basic header file set doesn't include the + * TCP/IP stuff. + */ #ifdef __GNU_CC__ @@ -109,7 +127,7 @@ struct netent { struct netent *getnetbyaddr( long net, int type); struct netent *getnetbyname( char *name); struct netent *getnetent(); -void setnetent(); +void setnetent(int); void endnetent(); #else /* !__GNU_CC__ */ @@ -123,13 +141,22 @@ void endnetent(); #include <inet.h> #include <netdb.h> /* However, we don't have these two in the system headers. */ -void setnetent(); +void setnetent(int); void endnetent(); +/* SocketShr doesn't support these routines, but the DECC RTL contains + * stubs with these names, designed to be used with the UCX socket + * library. We avoid linker collisions by substituting new names. + */ +#define getnetbyaddr no_getnetbyaddr +#define getnetbyname no_getnetbyname +#define getnetent no_getnetent +#define setnetent no_setnetent +#define endnetent no_endnetent #endif #include <socketshr.h> -/* socketshr.h from SocketShr 0.9D doesn't alias fileno; it's comments say +/* socketshr.h from SocketShr 0.9D doesn't alias fileno; its comments say * that the CRTL version works OK. This isn't the case, at least with * VAXC, so we use the SocketShr version. * N.B. This means that sockadapt.h must be included *after* stdio.h. @@ -148,3 +175,6 @@ int si_fileno(FILE *); #endif #define getpeername my_getpeername int my_getpeername _((int, struct sockaddr *, int *)); + +#endif /* SOCKETSHR stuff */ +#endif /* include guard */ @@ -2343,7 +2343,6 @@ trim_unixpath(char *fspec, char *wildspec, int opts) /* * VMS readdir() routines. * Written by Rich $alz, <rsalz@bbn.com> in August, 1990. - * This code has no copyright. * * 21-Jul-1994 Charles Bailey bailey@genetics.upenn.edu * Minor modifications to original routines. diff --git a/vms/vms_yfix.pl b/vms/vms_yfix.pl index 9f29c80825..f57ea1d515 100644 --- a/vms/vms_yfix.pl +++ b/vms/vms_yfix.pl @@ -23,6 +23,10 @@ while (<C>) { # "y.tab.c" is illegal as a VMS filename; DECC 5.2/VAX preprocessor # doesn't like this. if ( s/^#line\s+(\d+)\s+"y.tab.c"/#line $1 "y_tab.c"/ ) { 1; } + elsif (/char \*getenv/) { + # accomodate old VAXC's macro susbstitution pecularities + $_ = "# ifndef getenv\n$_# endif\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/vms/vmsish.h b/vms/vmsish.h index 61543415e2..fd4434efb2 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -360,7 +360,6 @@ struct utimbuf { * opendir(), closedir(), readdir(), seekdir(), telldir(), and * vmsreaddirversions(), and preprocessor stuff on which these depend: * Written by Rich $alz, <rsalz@bbn.com> in August, 1990. - * This code has no copyright. */ /* Data structure returned by READDIR(). */ struct dirent { diff --git a/win32/EXTERN.h b/win32/EXTERN.h index f9dc77c89b..3ce63772a4 100644 --- a/win32/EXTERN.h +++ b/win32/EXTERN.h @@ -1,6 +1,6 @@ /* EXTERN.h * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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/x2p/EXTERN.h b/x2p/EXTERN.h index e4abe5f87b..cd1a4112ae 100644 --- a/x2p/EXTERN.h +++ b/x2p/EXTERN.h @@ -1,6 +1,6 @@ /* $RCSfile: EXTERN.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:05 $ * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1997, 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/x2p/INTERN.h b/x2p/INTERN.h index aa3af58c8d..ac1d57ab05 100644 --- a/x2p/INTERN.h +++ b/x2p/INTERN.h @@ -1,6 +1,6 @@ /* $RCSfile: INTERN.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:06 $ * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -5,7 +5,7 @@ static char yysccsid[] = "@(#)yaccpar 1.8 (Berkeley) 01/20/91"; #line 2 "a2p.y" /* $RCSfile: a2p.y,v $$Revision: 4.1 $$Date: 92/08/07 18:29:12 $ * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* $RCSfile: a2p.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:09 $ * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,7 +1,7 @@ %{ /* $RCSfile: a2p.y,v $$Revision: 4.1 $$Date: 92/08/07 18:29:12 $ * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1997, 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/x2p/a2py.c b/x2p/a2py.c index 0c37b6bbf9..46ec604c06 100644 --- a/x2p/a2py.c +++ b/x2p/a2py.c @@ -1,6 +1,6 @@ /* $RCSfile: a2py.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:14 $ * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -27,6 +27,7 @@ int oper5(); STR *walk(); #ifdef OS2 +static void usage() { printf("\nThis is the AWK to PERL translator, version 5.0, patchlevel %d\n", PATCHLEVEL); @@ -41,6 +42,8 @@ usage() exit(1); } #endif + +int main(argc,argv,env) register int argc; register char **argv; diff --git a/x2p/hash.c b/x2p/hash.c index 58236f49e4..5859eab470 100644 --- a/x2p/hash.c +++ b/x2p/hash.c @@ -1,6 +1,6 @@ /* $RCSfile: hash.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:20 $ * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1997, 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/x2p/hash.h b/x2p/hash.h index f61a29f4e6..9dc64a1dcd 100644 --- a/x2p/hash.h +++ b/x2p/hash.h @@ -1,6 +1,6 @@ /* $RCSfile: hash.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:21 $ * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1997, 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/x2p/proto.h b/x2p/proto.h index eb5fb15b37..85d749616a 100644 --- a/x2p/proto.h +++ b/x2p/proto.h @@ -1,6 +1,6 @@ /* proto.h * - * Copyright (c) 1991-1996, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* $RCSfile: str.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:26 $ * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -1,6 +1,6 @@ /* $RCSfile: str.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:27 $ * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1997, 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/x2p/util.c b/x2p/util.c index 519fae5a8a..c70bab9f07 100644 --- a/x2p/util.c +++ b/x2p/util.c @@ -1,6 +1,6 @@ /* $RCSfile: util.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:29 $ * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1997, 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/x2p/util.h b/x2p/util.h index bdd85c199d..ff93e8ac7a 100644 --- a/x2p/util.h +++ b/x2p/util.h @@ -1,6 +1,6 @@ /* $RCSfile: util.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:30 $ * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1997, 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/x2p/walk.c b/x2p/walk.c index 403d686e39..936f202df8 100644 --- a/x2p/walk.c +++ b/x2p/walk.c @@ -1,6 +1,6 @@ /* $RCSfile: walk.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:31 $ * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1997, 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. |