summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Changes361
-rw-r--r--doio.c31
-rw-r--r--embed.h1
-rw-r--r--ext/Opcode/Makefile.PL2
-rw-r--r--ext/Opcode/Opcode.pm6
-rw-r--r--ext/Opcode/Opcode.xs5
-rw-r--r--ext/POSIX/POSIX.pod2
-rw-r--r--global.sym1
-rw-r--r--keywords.h67
-rwxr-xr-xkeywords.pl1
-rw-r--r--opcode.h281
-rwxr-xr-xopcode.pl1
-rw-r--r--patchlevel.h1
-rw-r--r--pod/perldelta.pod30
-rw-r--r--pod/perldiag.pod17
-rw-r--r--pod/perlfunc.pod71
-rw-r--r--pod/perltoc.pod99
-rw-r--r--pp_sys.c21
-rw-r--r--proto.h1
-rwxr-xr-xt/op/sysio.t19
-rw-r--r--toke.c75
21 files changed, 618 insertions, 475 deletions
diff --git a/Changes b/Changes
index b50c1add44..a1ae3c26e4 100644
--- a/Changes
+++ b/Changes
@@ -8,13 +8,13 @@ or in the .../src/5/0/unsupported directory for sub-version
releases.)
----------------
- Cast and Crew
----------------
+ ---------------
+ CAST AND CREW
+ ---------------
-To save space, and to give due honor to those who have made Perl 5.004
-what is is today, here are some of the more common names in the Changes
-file, and their current addresses (as of March 1997):
+To give due honor to those who have made Perl 5.004 what is is today,
+here are some of the more common names in the Changes file, and their
+current addresses (as of March 1997):
Gisle Aas <gisle@aas.no>
Kenneth Albanowski <kjahds@kjahds.com>
@@ -45,9 +45,106 @@ And the Keepers of the Patch Pumpkin:
Chip Salzenberg <chip@perl.com>
--------------------
- Version 5.003_97f
--------------------
+-----------------
+Version 5.003_97g
+-----------------
+
+This one has two security bug fixes for buffer overflows. Perl has
+not yet been searched to see if more fixes are needed.
+
+ CORE LANGUAGE CHANGES
+
+ Title: "Improve sysseek(), remove systell(), fix Opcode"
+ From: Chip Salzenberg
+ Files: doio.c ext/Opcode/Makefile.PL ext/Opcode/Opcode.pm
+ ext/Opcode/Opcode.xs global.sym keywords.pl opcode.pl
+ pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod pp_sys.c
+ proto.h t/op/sysio.t toke.c
+
+ Title: "Fix (and test) spaces in {,un}pack()"
+ From: Chip Salzenberg
+ Files: pp.c t/op/pack.t
+
+ CORE PORTABILITY
+
+ Title: "Irix update"
+ From: Scott Henry <scotth@sgi.com>
+ Msg-ID: <yd8d8rsi0ln.fsf@hoshi.engr.sgi.com>
+ Date: 18 Apr 1997 12:37:24 -0700
+ Files: MANIFEST hints/irix_6.sh hints/irix_6_0.sh hints/irix_6_1.sh
+
+ Title: "ExtUtils/Miniperl.pm not built on Win32"
+ From: Nick Ing-Simmons
+ Msg-ID: <199704181742.SAA08407@ni-s.u-net.com>
+ Date: Fri, 18 Apr 1997 18:42:32 +0100
+ Files: win32/Makefile
+
+ OTHER CORE CHANGES
+
+ Title: "SECURITY FIX: 'Identifier too long'"
+ From: Chip Salzenberg
+ Files: pod/perldelta.pod pod/perldiag.pod toke.c
+
+ Title: "SECURITY FIX: Buffer overflow in gv_fetchfile()"
+ From: Chip Salzenberg
+ Files: gv.c
+
+ Title: "Remove pp_method() inefficiency from last patch"
+ From: Chip Salzenberg
+ Files: pp_hot.c
+
+ BUILD PROCESS
+
+ Title: "Fix unnecessary re-linking"
+ From: Chip Salzenberg
+ Files: lib/ExtUtils/MM_Unix.pm
+
+ Title: "Fix tcsh hack in Configure"
+ From: Chip Salzenberg
+ Files: Configure
+
+ Title: "Minor, optional patch to Makefile.SH"
+ From: "Randy J. Ray" <rjray@uswest.com>
+ Msg-ID: <rjray-9703180132.AA00374040@snakepit.ecte.uswc.uswest.com>
+ Date: Thu, 17 Apr 1997 19:32:17 -0600
+ Files: Makefile.SH
+
+ LIBRARY AND EXTENSIONS
+
+ Title: "Patch to Getopt::Long"
+ From: Johan Vromans <jvromans@squirrel.nl>
+ Msg-ID: <m0wIKCO-00081IC@phoenix.squirrel.nl>
+ Date: Fri, 18 Apr 97 22:24 MET DST
+ Files: lib/Getopt/Long.pm
+
+ Title: "Fix NAME in SDBM_File build"
+ From: Chip Salzenberg
+ Files: ext/SDBM_File/sdbm/Makefile.PL
+
+ TESTS
+
+ (no other changes)
+
+ UTILITIES
+
+ Title: "Make h2ph generate constant subs"
+ From: Roderick Schertler
+ Msg-ID: <pz2088w5ot.fsf@eeyore.ibcinc.com>
+ Date: 18 Apr 1997 14:23:46 -0400
+ Files: utils/h2ph.PL
+
+ DOCUMENTATION
+
+ Title: "Document {,un}pack changes"
+ From: Paul Marquess
+ Msg-ID: <9704181249.AA11733@claudius.bfsec.bt.co.uk>
+ Date: Fri, 18 Apr 97 13:49:39 BST
+ Files: pod/perldelta.pod pod/perldiag.pod
+
+
+-----------------
+Version 5.003_97f
+-----------------
This is it before _98. No more last-minute features. Really, I mean
it this time. No kidding.
@@ -139,9 +236,9 @@ it this time. No kidding.
Files: pod/perlfunc.pod
--------------------
- Version 5.003_97e
--------------------
+-----------------
+Version 5.003_97e
+-----------------
Y'know, I've heard of this "beta" thing, but it's been so long since
I've seen one, I'm not sure it really exists...
@@ -295,9 +392,9 @@ I've seen one, I'm not sure it really exists...
Files: pod/perlop.pod
--------------------
- Version 5.003_97d
--------------------
+-----------------
+Version 5.003_97d
+-----------------
Any minute now... second public beta... no, really...
@@ -430,9 +527,9 @@ Any minute now... second public beta... no, really...
Files: pod/perlpod.pod
--------------------
- Version 5.003_97c
--------------------
+-----------------
+Version 5.003_97c
+-----------------
That second public beta will be Real Soon Now...
@@ -537,9 +634,9 @@ That second public beta will be Real Soon Now...
Files: ext/IO/lib/IO/Socket.pm
--------------------
- Version 5.003_97b
--------------------
+-----------------
+Version 5.003_97b
+-----------------
Working on the second public beta...
@@ -649,9 +746,9 @@ Working on the second public beta...
Files: pod/perltrap.pod
--------------------
- Version 5.003_97a
--------------------
+-----------------
+Version 5.003_97a
+-----------------
This release gets a letter instead of a full subversion because I'm
planning on making 5.003_98 the second public beta.
@@ -776,9 +873,9 @@ planning on making 5.003_98 the second public beta.
pod/perlstyle.pod pod/perltoc.pod pod/perlvar.pod
-------------------
- Version 5.003_97
-------------------
+----------------
+Version 5.003_97
+----------------
CORE LANGUAGE CHANGES
@@ -899,9 +996,9 @@ planning on making 5.003_98 the second public beta.
Files: lib/CGI.pm lib/ExtUtils/Command.pm
-------------------
- Version 5.003_96
-------------------
+----------------
+Version 5.003_96
+----------------
CORE LANGUAGE CHANGES
@@ -1183,9 +1280,9 @@ planning on making 5.003_98 the second public beta.
Files: pod/*.pod
-------------------
- Version 5.003_95
-------------------
+----------------
+Version 5.003_95
+----------------
CORE LANGUAGE CHANGES
@@ -1348,9 +1445,9 @@ planning on making 5.003_98 the second public beta.
Files: pod/perlfaq*.pod
-------------------
- Version 5.003_94
-------------------
+----------------
+Version 5.003_94
+----------------
CORE LANGUAGE CHANGES
@@ -1737,9 +1834,9 @@ planning on making 5.003_98 the second public beta.
Files: ext/DB_File/DB_File.pm
-------------------
- Version 5.003_93
-------------------
+----------------
+Version 5.003_93
+----------------
Me, last time:
"This release will be the public beta of 5.004,
@@ -1901,9 +1998,9 @@ Me, now:
pod/perlop.pod pod/perlsub.pod
-------------------
- Version 5.003_92
-------------------
+----------------
+Version 5.003_92
+----------------
This release will be the public beta of 5.004, or my name isn't
Larson T. Pettifogger.
@@ -2110,9 +2207,9 @@ Larson T. Pettifogger.
Files: pod/*.pod
-------------------
- Version 5.003_91
-------------------
+----------------
+Version 5.003_91
+----------------
This is (should be? must be!) the public beta of 5.004.
@@ -2302,9 +2399,9 @@ This is (should be? must be!) the public beta of 5.004.
pod/perltoc.pod
-------------------
- Version 5.003_90
-------------------
+----------------
+Version 5.003_90
+----------------
At last, a mil[le]stone: The first beta of Perl 5.004.
@@ -2463,9 +2560,9 @@ At last, a mil[le]stone: The first beta of Perl 5.004.
Files: pod/perldiag.pod pod/perlsec.pod
-------------------
- Version 5.003_28
-------------------
+----------------
+Version 5.003_28
+----------------
This release is beta candidate #6. If this isn't good enough to go beta,
I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....)
@@ -2642,9 +2739,9 @@ I'll eat a floppy disk. (Okay, it's a chocolate floppy, but still....)
pod/perltie.pod pod/perltoc.pod pod/perltrap.pod x2p/a2p.pod
-------------------
- Version 5.003_27
-------------------
+----------------
+Version 5.003_27
+----------------
This release is beta candidate #5: Our last, best hope for a beta.
@@ -2820,9 +2917,9 @@ This release is beta candidate #5: Our last, best hope for a beta.
Files: pod/perldiag.pod
-------------------
- Version 5.003_26
-------------------
+----------------
+Version 5.003_26
+----------------
This release is beta candidate #4. "Once more, dear friends...."
@@ -2958,9 +3055,9 @@ This release is beta candidate #4. "Once more, dear friends...."
Files: pod/perltie.pod
-------------------
- Version 5.003_25
-------------------
+----------------
+Version 5.003_25
+----------------
This release is beta candidate #3. Here's hoping...
@@ -3125,9 +3222,9 @@ This release is beta candidate #3. Here's hoping...
Files: pod/perldiag.pod
-------------------
- Version 5.003_24
-------------------
+----------------
+Version 5.003_24
+----------------
This release is the second candidate for a public beta test.
It's, well, bunches better than _23.
@@ -3311,9 +3408,9 @@ It's, well, bunches better than _23.
Files: pod/perlsyn.pod
-------------------
- Version 5.003_23
-------------------
+----------------
+Version 5.003_23
+----------------
This release is our first candidate for a public beta test.
@@ -3616,9 +3713,9 @@ This release is our first candidate for a public beta test.
Files: pod/perllocale.pod
-------------------
- Version 5.003_22
-------------------
+----------------
+Version 5.003_22
+----------------
This release is primarily made up of bug fixes, the foremost among
which repairs a showstopper memory corruption bug in formats.
@@ -3692,9 +3789,9 @@ which repairs a showstopper memory corruption bug in formats.
Files: configpm
-------------------
- Version 5.003_21
-------------------
+----------------
+Version 5.003_21
+----------------
This release includes several important bug fixes, and a couple of
minor but valuable language tweaks. Please read on for a list of the
@@ -3990,9 +4087,9 @@ significant changes:
Files: pod/perlsub.pod pod/perltoc.pod pod/perlvar.pod
-------------------
- Version 5.003_20
-------------------
+----------------
+Version 5.003_20
+----------------
The only language change in this release is the recension of support
for named closures: Now, no subroutine declared "sub foo {}" can be
@@ -4158,9 +4255,9 @@ updates, and expanded tests. This is good stuff. "I love you, man!"
Files: pod/perlfunc.pod pod/perltoc.pod
-------------------
- Version 5.003_19
-------------------
+----------------
+Version 5.003_19
+----------------
Lots of internal cleanup in this patch, especially plugged memory
leaks when embedded Perl interpreters shut down and restart. The
@@ -4291,9 +4388,9 @@ Here's a list of the more significant changes...
vms/descrip.mms
-------------------
- Version 5.003_18
-------------------
+----------------
+Version 5.003_18
+----------------
Yet further down the road to 5.004....
@@ -4401,9 +4498,9 @@ Yet further down the road to 5.004....
Files: pod/perldiag.pod
-------------------
- Version 5.003_17
-------------------
+----------------
+Version 5.003_17
+----------------
The rate of patches is slowing down.... I see 5.004 at the end of the
tunnel! (Hey, what's that whistle?)
@@ -4487,9 +4584,9 @@ tunnel! (Hey, what's that whistle?)
Files: pod/perllocale.pod
-------------------
- Version 5.003_16
-------------------
+----------------
+Version 5.003_16
+----------------
This patch is all bug fixes, library updates, and documentation
updates. We'll get to 5.004 RSN, I promise. :-)
@@ -4576,9 +4673,9 @@ updates. We'll get to 5.004 RSN, I promise. :-)
Files: pod/perllocale.pod
-------------------
- Version 5.003_15
-------------------
+----------------
+Version 5.003_15
+----------------
As soon as I posted 5.003_14, I found a fatal error in it. :-(
@@ -4586,9 +4683,9 @@ This release is strictly a bug fix -- it removes some function caching
changes that were supposed to be improvements, but weren't.
-------------------
- Version 5.003_14
-------------------
+----------------
+Version 5.003_14
+----------------
We seem to have achieved "release candidate" status.
@@ -4745,9 +4842,9 @@ We seem to have achieved "release candidate" status.
Files: lib/Class/Template.pm lib/Time/tm.pm
-------------------
- Version 5.003_13
-------------------
+----------------
+Version 5.003_13
+----------------
The watchword here is "synchronization." There were a couple of
show-stopper bugs in 5.003_12, so I'm issuing this patch to bring
@@ -4835,9 +4932,9 @@ everyone up to a common working base.
Files: pod/perlpod.pod pod/pod2html.PL
-------------------
- Version 5.003_12
-------------------
+----------------
+Version 5.003_12
+----------------
This patch is huge. A multitude of bug fixes, new modules (especially
CPAN and Net::FTP), a couple of new Configure variables, updated
@@ -5110,9 +5207,9 @@ the more significant changes in 5.003_12:
Date: Sat, 14 Dec 1996 18:56:33 -0700
Files: pod/*
-------------------
- Version 5.003_11
-------------------
+----------------
+Version 5.003_11
+----------------
This patch is (still) closing in on 5.004. Nothing dramatic, lots of
value.
@@ -5277,9 +5374,9 @@ value.
Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs
-------------------
- Version 5.003_10
-------------------
+----------------
+Version 5.003_10
+----------------
This patch is closing in on 5.004. It contains lots of small and
valuable changes, but nothing dramatic.
@@ -5419,9 +5516,9 @@ valuable changes, but nothing dramatic.
Files: pod/perlfunc.pod
-------------------
- Version 5.003_09
-------------------
+----------------
+Version 5.003_09
+----------------
This patch was a compendium of various fixes and enhancements from
many people, including some serious improvement in lexical variable
@@ -5607,9 +5704,9 @@ scoping and locale handling.
Files: x2p/util.c
-------------------
- Version 5.003_08
-------------------
+----------------
+Version 5.003_08
+----------------
This patch was a compendium of various fixes and enhancements from
many people. Here are some of the more significant changes.
@@ -5758,9 +5855,9 @@ many people. Here are some of the more significant changes.
Files: x2p/a2p.c x2p/a2p.y
-------------------
- Version 5.003_07
-------------------
+----------------
+Version 5.003_07
+----------------
This patch was primarily to fix bugs or include little things I missed
in 5.003_06. 5.003_07 is intended to be stable enough to merit serious
@@ -6409,9 +6506,9 @@ Index: x2p/cflags.SH
pathname of the file being extracted.
-------------------
- Version 5.003_06
-------------------
+----------------
+Version 5.003_06
+----------------
This patch was primarily to fix bugs, improve the documentation,
and work towards restoring binary compatibility with 5.003.
@@ -8658,9 +8755,9 @@ Index: x2p/s2p.PL
I then embedded the pod into the s2p script.
-------------------
- Version 5.003_05
-------------------
+----------------
+Version 5.003_05
+----------------
This patch was primarily to fix bugs and to clean up some of
the remaining issues from in 5.003_04. The details are described below.
@@ -9369,9 +9466,9 @@ Index: vms/vmsish.h
VMS 5.003_05 Update.
-------------------
- Version 5.003_04
-------------------
+----------------
+Version 5.003_04
+----------------
This patch was primarily to fix bugs and to clean up some of
the changes made in 5.003_03. The details are described below.
@@ -9894,9 +9991,9 @@ Index: utils/perldoc.PL
doesn't support the -x option.)
-------------------
- Version 5.003_03
-------------------
+----------------
+Version 5.003_03
+----------------
Most of the changes in 5.003_03 are to make the build and installation
process more robust. The details are described below. A very brief
@@ -10506,9 +10603,9 @@ Index: x2p/str.c
Use Configure's FILE_filbuf macro instead of a raw _filbuf.
-------------------
- Version 5.003_02
-------------------
+----------------
+Version 5.003_02
+----------------
o Visible Changes to Core Functionality
- Redefining constant subs, or changing sub's prototype now give warnings.
@@ -10550,9 +10647,9 @@ o Changes in OS-specific and Build-time Support
- Typo patch for VMS.
-------------------
- Version 5.003_01
-------------------
+----------------
+Version 5.003_01
+----------------
Version 5.003_01 contains bugfixes and additions accumulated since
version 5.002_01, since the patch to version 5.003 was deliberately
diff --git a/doio.c b/doio.c
index 829d6d920f..0d57425269 100644
--- a/doio.c
+++ b/doio.c
@@ -667,13 +667,10 @@ GV *gv;
if (PerlIO_eof(fp))
(void)PerlIO_seek(fp, 0L, 2); /* ultrix 1.2 workaround */
#endif
- if (op->op_type == OP_SYSTELL)
- return lseek(PerlIO_fileno(fp), 0L, 1);
- else
- return PerlIO_tell(fp);
+ return PerlIO_tell(fp);
}
if (dowarn)
- warn("%s() on unopened file", op_name[op->op_type]);
+ warn("tell() on unopened file");
SETERRNO(EBADF,RMS$_IFI);
return -1L;
}
@@ -692,17 +689,31 @@ int whence;
if (PerlIO_eof(fp))
(void)PerlIO_seek(fp, 0L, 2); /* ultrix 1.2 workaround */
#endif
- if (op->op_type == OP_SYSSEEK)
- return lseek(PerlIO_fileno(fp), pos, whence) >= 0;
- else
- return PerlIO_seek(fp, pos, whence) >= 0;
+ return PerlIO_seek(fp, pos, whence) >= 0;
}
if (dowarn)
- warn("%s() on unopened file", op_name[op->op_type]);
+ warn("seek() on unopened file");
SETERRNO(EBADF,RMS$_IFI);
return FALSE;
}
+long
+do_sysseek(gv, pos, whence)
+GV *gv;
+long pos;
+int whence;
+{
+ register IO *io;
+ register PerlIO *fp;
+
+ if (gv && (io = GvIO(gv)) && (fp = IoIFP(io)))
+ return lseek(PerlIO_fileno(fp), pos, whence);
+ if (dowarn)
+ warn("sysseek() on unopened file");
+ SETERRNO(EBADF,RMS$_IFI);
+ return -1L;
+}
+
#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
/* code courtesy of William Kucharski */
#define HAS_CHSIZE
diff --git a/embed.h b/embed.h
index 5f01f244aa..a5936c4fe5 100644
--- a/embed.h
+++ b/embed.h
@@ -166,6 +166,7 @@
#define do_semop Perl_do_semop
#define do_shmio Perl_do_shmio
#define do_sprintf Perl_do_sprintf
+#define do_sysseek Perl_do_sysseek
#define do_tell Perl_do_tell
#define do_trans Perl_do_trans
#define do_vecset Perl_do_vecset
diff --git a/ext/Opcode/Makefile.PL b/ext/Opcode/Makefile.PL
index c7ddaafd29..7fdcdf6ac1 100644
--- a/ext/Opcode/Makefile.PL
+++ b/ext/Opcode/Makefile.PL
@@ -3,5 +3,5 @@ WriteMakefile(
NAME => 'Opcode',
MAN3PODS => ' ',
VERSION_FROM => 'Opcode.pm',
- XS_VERSION => '1.01'
+ XS_VERSION => '1.02'
);
diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm
index b3cfb50374..a35ad1b47b 100644
--- a/ext/Opcode/Opcode.pm
+++ b/ext/Opcode/Opcode.pm
@@ -4,8 +4,8 @@ require 5.002;
use vars qw($VERSION $XS_VERSION @ISA @EXPORT_OK);
-$VERSION = "1.03";
-$XS_VERSION = "1.01";
+$VERSION = "1.04";
+$XS_VERSION = "1.02";
use strict;
use Carp;
@@ -382,7 +382,7 @@ such as open would need to be enabled.
print sysread syswrite send recv
- eof tell seek systell sysseek
+ eof tell seek sysseek
readdir telldir seekdir rewinddir
diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs
index ef2be80594..538f0ecf30 100644
--- a/ext/Opcode/Opcode.xs
+++ b/ext/Opcode/Opcode.xs
@@ -46,7 +46,7 @@ op_names_init()
while(i-- > 0)
bitmap[i] = 0xFF;
/* Take care to set the right number of bits in the last byte */
- bitmap[len-1] = ~(0xFF << (maxo & 0x07));
+ bitmap[len-1] = (maxo & 0x07) ? ~(0xFF << (maxo & 0x07)) : 0xFF;
put_op_bitspec(":all",0, opset_all); /* don't mortalise */
}
@@ -290,7 +290,8 @@ invert_opset(opset)
while(len-- > 0)
bitmap[len] = ~bitmap[len];
/* take care of extra bits beyond maxo in last byte */
- bitmap[opset_len-1] &= ~(0xFF << (maxo & 0x07));
+ if (maxo & 07)
+ bitmap[opset_len-1] &= ~(0xFF << (maxo & 0x07));
}
ST(0) = opset;
diff --git a/ext/POSIX/POSIX.pod b/ext/POSIX/POSIX.pod
index fba225f5b9..c781765a14 100644
--- a/ext/POSIX/POSIX.pod
+++ b/ext/POSIX/POSIX.pod
@@ -606,7 +606,7 @@ longjmp() is C-specific: use die instead.
=item lseek
-Move the read/write file pointer. This uses file descriptors such as
+Move the file's read/write position. This uses file descriptors such as
those obtained by calling C<POSIX::open>.
$fd = POSIX::open( "foo", &POSIX::O_RDONLY );
diff --git a/global.sym b/global.sym
index 728cb6ef46..7baefdbeae 100644
--- a/global.sym
+++ b/global.sym
@@ -399,6 +399,7 @@ do_seek
do_semop
do_shmio
do_sprintf
+do_sysseek
do_tell
do_trans
do_vecset
diff --git a/keywords.h b/keywords.h
index 7c62db552c..2be133b748 100644
--- a/keywords.h
+++ b/keywords.h
@@ -212,37 +212,36 @@
#define KEY_sysopen 211
#define KEY_sysread 212
#define KEY_sysseek 213
-#define KEY_systell 214
-#define KEY_system 215
-#define KEY_syswrite 216
-#define KEY_tell 217
-#define KEY_telldir 218
-#define KEY_tie 219
-#define KEY_tied 220
-#define KEY_time 221
-#define KEY_times 222
-#define KEY_tr 223
-#define KEY_truncate 224
-#define KEY_uc 225
-#define KEY_ucfirst 226
-#define KEY_umask 227
-#define KEY_undef 228
-#define KEY_unless 229
-#define KEY_unlink 230
-#define KEY_unpack 231
-#define KEY_unshift 232
-#define KEY_untie 233
-#define KEY_until 234
-#define KEY_use 235
-#define KEY_utime 236
-#define KEY_values 237
-#define KEY_vec 238
-#define KEY_wait 239
-#define KEY_waitpid 240
-#define KEY_wantarray 241
-#define KEY_warn 242
-#define KEY_while 243
-#define KEY_write 244
-#define KEY_x 245
-#define KEY_xor 246
-#define KEY_y 247
+#define KEY_system 214
+#define KEY_syswrite 215
+#define KEY_tell 216
+#define KEY_telldir 217
+#define KEY_tie 218
+#define KEY_tied 219
+#define KEY_time 220
+#define KEY_times 221
+#define KEY_tr 222
+#define KEY_truncate 223
+#define KEY_uc 224
+#define KEY_ucfirst 225
+#define KEY_umask 226
+#define KEY_undef 227
+#define KEY_unless 228
+#define KEY_unlink 229
+#define KEY_unpack 230
+#define KEY_unshift 231
+#define KEY_untie 232
+#define KEY_until 233
+#define KEY_use 234
+#define KEY_utime 235
+#define KEY_values 236
+#define KEY_vec 237
+#define KEY_wait 238
+#define KEY_waitpid 239
+#define KEY_wantarray 240
+#define KEY_warn 241
+#define KEY_while 242
+#define KEY_write 243
+#define KEY_x 244
+#define KEY_xor 245
+#define KEY_y 246
diff --git a/keywords.pl b/keywords.pl
index 805b5bc2e0..aebb3ee2e7 100755
--- a/keywords.pl
+++ b/keywords.pl
@@ -238,7 +238,6 @@ syscall
sysopen
sysread
sysseek
-systell
system
syswrite
tell
diff --git a/opcode.h b/opcode.h
index eb6ff8fb30..52403d457d 100644
--- a/opcode.h
+++ b/opcode.h
@@ -212,147 +212,146 @@ typedef enum {
OP_PRTF, /* 205 */
OP_PRINT, /* 206 */
OP_SYSOPEN, /* 207 */
- OP_SYSTELL, /* 208 */
- OP_SYSSEEK, /* 209 */
- OP_SYSREAD, /* 210 */
- OP_SYSWRITE, /* 211 */
- OP_SEND, /* 212 */
- OP_RECV, /* 213 */
- OP_EOF, /* 214 */
- OP_TELL, /* 215 */
- OP_SEEK, /* 216 */
- OP_TRUNCATE, /* 217 */
- OP_FCNTL, /* 218 */
- OP_IOCTL, /* 219 */
- OP_FLOCK, /* 220 */
- OP_SOCKET, /* 221 */
- OP_SOCKPAIR, /* 222 */
- OP_BIND, /* 223 */
- OP_CONNECT, /* 224 */
- OP_LISTEN, /* 225 */
- OP_ACCEPT, /* 226 */
- OP_SHUTDOWN, /* 227 */
- OP_GSOCKOPT, /* 228 */
- OP_SSOCKOPT, /* 229 */
- OP_GETSOCKNAME, /* 230 */
- OP_GETPEERNAME, /* 231 */
- OP_LSTAT, /* 232 */
- OP_STAT, /* 233 */
- OP_FTRREAD, /* 234 */
- OP_FTRWRITE, /* 235 */
- OP_FTREXEC, /* 236 */
- OP_FTEREAD, /* 237 */
- OP_FTEWRITE, /* 238 */
- OP_FTEEXEC, /* 239 */
- OP_FTIS, /* 240 */
- OP_FTEOWNED, /* 241 */
- OP_FTROWNED, /* 242 */
- OP_FTZERO, /* 243 */
- OP_FTSIZE, /* 244 */
- OP_FTMTIME, /* 245 */
- OP_FTATIME, /* 246 */
- OP_FTCTIME, /* 247 */
- OP_FTSOCK, /* 248 */
- OP_FTCHR, /* 249 */
- OP_FTBLK, /* 250 */
- OP_FTFILE, /* 251 */
- OP_FTDIR, /* 252 */
- OP_FTPIPE, /* 253 */
- OP_FTLINK, /* 254 */
- OP_FTSUID, /* 255 */
- OP_FTSGID, /* 256 */
- OP_FTSVTX, /* 257 */
- OP_FTTTY, /* 258 */
- OP_FTTEXT, /* 259 */
- OP_FTBINARY, /* 260 */
- OP_CHDIR, /* 261 */
- OP_CHOWN, /* 262 */
- OP_CHROOT, /* 263 */
- OP_UNLINK, /* 264 */
- OP_CHMOD, /* 265 */
- OP_UTIME, /* 266 */
- OP_RENAME, /* 267 */
- OP_LINK, /* 268 */
- OP_SYMLINK, /* 269 */
- OP_READLINK, /* 270 */
- OP_MKDIR, /* 271 */
- OP_RMDIR, /* 272 */
- OP_OPEN_DIR, /* 273 */
- OP_READDIR, /* 274 */
- OP_TELLDIR, /* 275 */
- OP_SEEKDIR, /* 276 */
- OP_REWINDDIR, /* 277 */
- OP_CLOSEDIR, /* 278 */
- OP_FORK, /* 279 */
- OP_WAIT, /* 280 */
- OP_WAITPID, /* 281 */
- OP_SYSTEM, /* 282 */
- OP_EXEC, /* 283 */
- OP_KILL, /* 284 */
- OP_GETPPID, /* 285 */
- OP_GETPGRP, /* 286 */
- OP_SETPGRP, /* 287 */
- OP_GETPRIORITY, /* 288 */
- OP_SETPRIORITY, /* 289 */
- OP_TIME, /* 290 */
- OP_TMS, /* 291 */
- OP_LOCALTIME, /* 292 */
- OP_GMTIME, /* 293 */
- OP_ALARM, /* 294 */
- OP_SLEEP, /* 295 */
- OP_SHMGET, /* 296 */
- OP_SHMCTL, /* 297 */
- OP_SHMREAD, /* 298 */
- OP_SHMWRITE, /* 299 */
- OP_MSGGET, /* 300 */
- OP_MSGCTL, /* 301 */
- OP_MSGSND, /* 302 */
- OP_MSGRCV, /* 303 */
- OP_SEMGET, /* 304 */
- OP_SEMCTL, /* 305 */
- OP_SEMOP, /* 306 */
- OP_REQUIRE, /* 307 */
- OP_DOFILE, /* 308 */
- OP_ENTEREVAL, /* 309 */
- OP_LEAVEEVAL, /* 310 */
- OP_ENTERTRY, /* 311 */
- OP_LEAVETRY, /* 312 */
- OP_GHBYNAME, /* 313 */
- OP_GHBYADDR, /* 314 */
- OP_GHOSTENT, /* 315 */
- OP_GNBYNAME, /* 316 */
- OP_GNBYADDR, /* 317 */
- OP_GNETENT, /* 318 */
- OP_GPBYNAME, /* 319 */
- OP_GPBYNUMBER, /* 320 */
- OP_GPROTOENT, /* 321 */
- OP_GSBYNAME, /* 322 */
- OP_GSBYPORT, /* 323 */
- OP_GSERVENT, /* 324 */
- OP_SHOSTENT, /* 325 */
- OP_SNETENT, /* 326 */
- OP_SPROTOENT, /* 327 */
- OP_SSERVENT, /* 328 */
- OP_EHOSTENT, /* 329 */
- OP_ENETENT, /* 330 */
- OP_EPROTOENT, /* 331 */
- OP_ESERVENT, /* 332 */
- OP_GPWNAM, /* 333 */
- OP_GPWUID, /* 334 */
- OP_GPWENT, /* 335 */
- OP_SPWENT, /* 336 */
- OP_EPWENT, /* 337 */
- OP_GGRNAM, /* 338 */
- OP_GGRGID, /* 339 */
- OP_GGRENT, /* 340 */
- OP_SGRENT, /* 341 */
- OP_EGRENT, /* 342 */
- OP_GETLOGIN, /* 343 */
- OP_SYSCALL, /* 344 */
+ OP_SYSSEEK, /* 208 */
+ OP_SYSREAD, /* 209 */
+ OP_SYSWRITE, /* 210 */
+ OP_SEND, /* 211 */
+ OP_RECV, /* 212 */
+ OP_EOF, /* 213 */
+ OP_TELL, /* 214 */
+ OP_SEEK, /* 215 */
+ OP_TRUNCATE, /* 216 */
+ OP_FCNTL, /* 217 */
+ OP_IOCTL, /* 218 */
+ OP_FLOCK, /* 219 */
+ OP_SOCKET, /* 220 */
+ OP_SOCKPAIR, /* 221 */
+ OP_BIND, /* 222 */
+ OP_CONNECT, /* 223 */
+ OP_LISTEN, /* 224 */
+ OP_ACCEPT, /* 225 */
+ OP_SHUTDOWN, /* 226 */
+ OP_GSOCKOPT, /* 227 */
+ OP_SSOCKOPT, /* 228 */
+ OP_GETSOCKNAME, /* 229 */
+ OP_GETPEERNAME, /* 230 */
+ OP_LSTAT, /* 231 */
+ OP_STAT, /* 232 */
+ OP_FTRREAD, /* 233 */
+ OP_FTRWRITE, /* 234 */
+ OP_FTREXEC, /* 235 */
+ OP_FTEREAD, /* 236 */
+ OP_FTEWRITE, /* 237 */
+ OP_FTEEXEC, /* 238 */
+ OP_FTIS, /* 239 */
+ OP_FTEOWNED, /* 240 */
+ OP_FTROWNED, /* 241 */
+ OP_FTZERO, /* 242 */
+ OP_FTSIZE, /* 243 */
+ OP_FTMTIME, /* 244 */
+ OP_FTATIME, /* 245 */
+ OP_FTCTIME, /* 246 */
+ OP_FTSOCK, /* 247 */
+ OP_FTCHR, /* 248 */
+ OP_FTBLK, /* 249 */
+ OP_FTFILE, /* 250 */
+ OP_FTDIR, /* 251 */
+ OP_FTPIPE, /* 252 */
+ OP_FTLINK, /* 253 */
+ OP_FTSUID, /* 254 */
+ OP_FTSGID, /* 255 */
+ OP_FTSVTX, /* 256 */
+ OP_FTTTY, /* 257 */
+ OP_FTTEXT, /* 258 */
+ OP_FTBINARY, /* 259 */
+ OP_CHDIR, /* 260 */
+ OP_CHOWN, /* 261 */
+ OP_CHROOT, /* 262 */
+ OP_UNLINK, /* 263 */
+ OP_CHMOD, /* 264 */
+ OP_UTIME, /* 265 */
+ OP_RENAME, /* 266 */
+ OP_LINK, /* 267 */
+ OP_SYMLINK, /* 268 */
+ OP_READLINK, /* 269 */
+ OP_MKDIR, /* 270 */
+ OP_RMDIR, /* 271 */
+ OP_OPEN_DIR, /* 272 */
+ OP_READDIR, /* 273 */
+ OP_TELLDIR, /* 274 */
+ OP_SEEKDIR, /* 275 */
+ OP_REWINDDIR, /* 276 */
+ OP_CLOSEDIR, /* 277 */
+ OP_FORK, /* 278 */
+ OP_WAIT, /* 279 */
+ OP_WAITPID, /* 280 */
+ OP_SYSTEM, /* 281 */
+ OP_EXEC, /* 282 */
+ OP_KILL, /* 283 */
+ OP_GETPPID, /* 284 */
+ OP_GETPGRP, /* 285 */
+ OP_SETPGRP, /* 286 */
+ OP_GETPRIORITY, /* 287 */
+ OP_SETPRIORITY, /* 288 */
+ OP_TIME, /* 289 */
+ OP_TMS, /* 290 */
+ OP_LOCALTIME, /* 291 */
+ OP_GMTIME, /* 292 */
+ OP_ALARM, /* 293 */
+ OP_SLEEP, /* 294 */
+ OP_SHMGET, /* 295 */
+ OP_SHMCTL, /* 296 */
+ OP_SHMREAD, /* 297 */
+ OP_SHMWRITE, /* 298 */
+ OP_MSGGET, /* 299 */
+ OP_MSGCTL, /* 300 */
+ OP_MSGSND, /* 301 */
+ OP_MSGRCV, /* 302 */
+ OP_SEMGET, /* 303 */
+ OP_SEMCTL, /* 304 */
+ OP_SEMOP, /* 305 */
+ OP_REQUIRE, /* 306 */
+ OP_DOFILE, /* 307 */
+ OP_ENTEREVAL, /* 308 */
+ OP_LEAVEEVAL, /* 309 */
+ OP_ENTERTRY, /* 310 */
+ OP_LEAVETRY, /* 311 */
+ OP_GHBYNAME, /* 312 */
+ OP_GHBYADDR, /* 313 */
+ OP_GHOSTENT, /* 314 */
+ OP_GNBYNAME, /* 315 */
+ OP_GNBYADDR, /* 316 */
+ OP_GNETENT, /* 317 */
+ OP_GPBYNAME, /* 318 */
+ OP_GPBYNUMBER, /* 319 */
+ OP_GPROTOENT, /* 320 */
+ OP_GSBYNAME, /* 321 */
+ OP_GSBYPORT, /* 322 */
+ OP_GSERVENT, /* 323 */
+ OP_SHOSTENT, /* 324 */
+ OP_SNETENT, /* 325 */
+ OP_SPROTOENT, /* 326 */
+ OP_SSERVENT, /* 327 */
+ OP_EHOSTENT, /* 328 */
+ OP_ENETENT, /* 329 */
+ OP_EPROTOENT, /* 330 */
+ OP_ESERVENT, /* 331 */
+ OP_GPWNAM, /* 332 */
+ OP_GPWUID, /* 333 */
+ OP_GPWENT, /* 334 */
+ OP_SPWENT, /* 335 */
+ OP_EPWENT, /* 336 */
+ OP_GGRNAM, /* 337 */
+ OP_GGRGID, /* 338 */
+ OP_GGRENT, /* 339 */
+ OP_SGRENT, /* 340 */
+ OP_EGRENT, /* 341 */
+ OP_GETLOGIN, /* 342 */
+ OP_SYSCALL, /* 343 */
OP_max
} opcode;
-#define MAXO 345
+#define MAXO 344
#ifndef DOINIT
EXT char *op_name[];
@@ -566,7 +565,6 @@ EXT char *op_name[] = {
"prtf",
"print",
"sysopen",
- "systell",
"sysseek",
"sysread",
"syswrite",
@@ -918,7 +916,6 @@ EXT char *op_desc[] = {
"printf",
"print",
"sysopen",
- "systell",
"sysseek",
"sysread",
"syswrite",
@@ -1299,7 +1296,6 @@ OP * pp_leavewrite _((void));
OP * pp_prtf _((void));
OP * pp_print _((void));
OP * pp_sysopen _((void));
-OP * pp_systell _((void));
OP * pp_sysseek _((void));
OP * pp_sysread _((void));
OP * pp_syswrite _((void));
@@ -1649,7 +1645,6 @@ EXT OP * (*ppaddr[])() = {
pp_prtf,
pp_print,
pp_sysopen,
- pp_systell,
pp_sysseek,
pp_sysread,
pp_syswrite,
@@ -2001,7 +1996,6 @@ EXT OP * (*check[]) _((OP *op)) = {
ck_listiob, /* prtf */
ck_listiob, /* print */
ck_fun, /* sysopen */
- ck_fun, /* systell */
ck_fun, /* sysseek */
ck_fun, /* sysread */
ck_fun, /* syswrite */
@@ -2353,7 +2347,6 @@ EXT U32 opargs[] = {
0x00002e15, /* prtf */
0x00002e15, /* print */
0x00911604, /* sysopen */
- 0x00000e0c, /* systell */
0x00011604, /* sysseek */
0x0091761d, /* sysread */
0x0091161d, /* syswrite */
diff --git a/opcode.pl b/opcode.pl
index 2d3e28da64..6fed2f8896 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -470,7 +470,6 @@ prtf printf ck_listiob ims F? L
print print ck_listiob ims F? L
sysopen sysopen ck_fun s F S S S?
-systell systell ck_fun st F?
sysseek sysseek ck_fun s F S S
sysread sysread ck_fun imst F R S S?
syswrite syswrite ck_fun imst F S S S?
diff --git a/patchlevel.h b/patchlevel.h
index 0579db53af..a75fc48f25 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -44,6 +44,7 @@ static char *local_patches[] = {
,"Dev97D - Fourth development patch to 5.003_97"
,"Dev97E - Fifth development patch to 5.003_97"
,"Dev97F - Sixth development patch to 5.003_97"
+ ,"Dev97G - Seventh development patch to 5.003_97"
,NULL
};
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 5132b49ae2..0613412bcd 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -299,12 +299,15 @@ provides seven bits of the total value, with the most significant
first. Bit eight of each byte is set, except for the last byte, in
which bit eight is clear.
-=item sysseek() and systell()
+Both pack() and unpack() now fail when their templates contain invalid
+types. (Invalid types used to be ignored.)
-These are new. The sysseek() operator is a variant of seek() that works
-on the system file pointer. It is the only reliable way to seek before
-using sysread() or syswrite(). Its companion operator systell() reports
-the current position of the system file pointer.
+=item sysseek()
+
+The new sysseek() operator is a variant of seek() that sets and gets the
+file's system read/write position, using the lseek(2) system call. It is
+the only reliable way to seek before using sysread() or syswrite(). Its
+return value is the new position, or the undefined value on failure.
=item use VERSION
@@ -907,7 +910,7 @@ on the first call).
=item C<perl_eval_pv>
-A new function handy for eval'ing strings of Perl code inside C code.
+A new function handy for eval'ing strings of Perl code inside C code.
This function returns the value from the eval statement, which can
be used instead of fetching globals from the symbol table. See
L<perlguts>, L<perlembed> and L<perlcall> for details and examples.
@@ -1063,6 +1066,13 @@ you called it with no args and both C<$@> and C<$_> were empty.
subroutine) by unconventional means, such as a goto, or a loop control
statement. See L<perlfunc/sort>.
+=item Identifier too long
+
+(F) Perl limits identifiers (names for variables, functions, etc.) to
+252 characters for simple names, somewhat more for compound names (like
+C<$A::B>). You've exceeded Perl's limits. Future versions of Perl are
+likely to eliminate these arbitrary limitations.
+
=item Illegal character %s (carriage return)
(F) A carriage return character was found in the input. This is an
@@ -1097,6 +1107,14 @@ empty (except that C<d_csh> should be C<'undef'>) so that Perl will
think csh is missing. In either case, after editing config.sh, run
C<./Configure -S> and rebuild Perl.
+=item Invalid type in pack: '%s'
+
+(F) The given character is not a valid pack type. See L<perlfunc/pack>.
+
+=item Invalid type in unpack: '%s'
+
+(F) The given character is not a valid unpack type. See L<perlfunc/unpack>.
+
=item Name "%s::%s" used only once: possible typo
(W) Typographical errors often show up as unique variable names.
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index feee58a219..a4a897c64b 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1098,6 +1098,13 @@ an emergency basis to prevent a core dump.
(D) Really old Perl let you omit the % on hash names in some spots. This
is now heavily deprecated.
+=item Identifier too long
+
+(F) Perl limits identifiers (names for variables, functions, etc.) to
+252 characters for simple names, somewhat more for compound names (like
+C<$A::B>). You've exceeded Perl's limits. Future versions of Perl are
+likely to eliminate these arbitrary limitations.
+
=item Ill-formed logical name |%s| in prime_env_iter
(W) A warning peculiar to VMS. A logical name was encountered when preparing
@@ -1231,11 +1238,11 @@ greater than the maximum character. See L<perlre>.
=item Invalid type in pack: '%s'
-(F) The given character is not a valid pack type. See L<perlop/pack>.
+(F) The given character is not a valid pack type. See L<perlfunc/pack>.
=item Invalid type in unpack: '%s'
-(F) The given character is not a valid unpack type. See L<perlop/unpack>.
+(F) The given character is not a valid unpack type. See L<perlfunc/unpack>.
=item ioctl is not implemented
@@ -2214,10 +2221,10 @@ or "msg". See L<perlfunc/semctl>, for example.
(W) The filehandle you're writing to got itself closed sometime before now.
Check your logic flow.
-=item %stell() on unopened file
+=item tell() on unopened file
-(W) You tried to use the tell() or systell() function on a filehandle that
-was either never opened or has since been closed.
+(W) You tried to use the tell() function on a filehandle that was either
+never opened or has since been closed.
=item Test on unopened file E<lt>%sE<gt>
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index e8dc893efa..51de42b923 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -109,7 +109,7 @@ delete, each, exists, keys, values
binmode, close, closedir, dbmclose, dbmopen, die, eof,
fileno, flock, format, getc, print, printf, read, readdir,
rewinddir, seek, seekdir, select, syscall, sysread, sysseek,
-systell, syswrite, tell, telldir, truncate, warn, write
+syswrite, tell, telldir, truncate, warn, write
=item Functions for fixed length data or records
@@ -1231,7 +1231,7 @@ example:
See L<perlform> for many details and examples.
-=item formline PICTURE, LIST
+=item formline PICTURE,LIST
This is an internal function used by C<format>s, though you may call it
too. It formats (see L<perlform>) a list of values according to the
@@ -2589,31 +2589,30 @@ C<(some expression)> suffices.
=item seek FILEHANDLE,POSITION,WHENCE
-Randomly positions the file pointer for FILEHANDLE, just like the fseek()
-call of stdio. FILEHANDLE may be an expression whose value gives the name
-of the filehandle. The values for WHENCE are 0 to set the file pointer to
-POSITION, 1 to set the it to current plus POSITION, and 2 to set it to EOF
-plus offset. You may use the values SEEK_SET, SEEK_CUR, and SEEK_END for
-this from either the IO::Seekable or the POSIX module. Returns 1 upon
-success, 0 otherwise.
-
-If you want to position a file pointer for sysread() or syswrite(), don't
-use seek() -- buffering makes its effect on the system file pointer
+Sets FILEHANDLE's position, just like the fseek() call of stdio.
+FILEHANDLE may be an expression whose value gives the name of the
+filehandle. The values for WHENCE are 0 to set the new position to
+POSITION, 1 to set it to the current position plus POSITION, and 2 to
+set it to EOF plus POSITION (typically negative). For WHENCE you may
+use the constants SEEK_SET, SEEK_CUR, and SEEK_END from either the
+IO::Seekable or the POSIX module. Returns 1 upon success, 0 otherwise.
+
+If you want to position file for sysread() or syswrite(), don't use
+seek() -- buffering makes its effect on the file's system position
unpredictable and non-portable. Use sysseek() instead.
On some systems you have to do a seek whenever you switch between reading
and writing. Amongst other things, this may have the effect of calling
-stdio's clearerr(3). A "whence" of 1 (SEEK_CUR) is useful for not moving
-the file pointer:
+stdio's clearerr(3). A WHENCE of 1 (SEEK_CUR) is useful for not moving
+the file position:
seek(TEST,0,1);
This is also useful for applications emulating C<tail -f>. Once you hit
EOF on your read, and then sleep for a while, you might have to stick in a
-seek() to reset things. First the simple trick listed above to clear the
-filepointer. The seek() doesn't change the current position, but it
-I<does> clear the end-of-file condition on the handle, so that the next
-C<E<lt>FILEE<gt>> makes Perl try again to read something. We hope.
+seek() to reset things. The seek() doesn't change the current position,
+but it I<does> clear the end-of-file condition on the handle, so that the
+next C<E<lt>FILEE<gt>> makes Perl try again to read something. We hope.
If that doesn't work (some stdios are particularly cantankerous), then
you may need something more like this:
@@ -3358,26 +3357,20 @@ the result of the read is appended.
=item sysseek FILEHANDLE,POSITION,WHENCE
-Randomly positions the system file pointer for FILEHANDLE using the
-system call lseek(2). It bypasses stdio, so mixing this with reads
-(other than sysread()), print(), write(), seek(), or tell() may cause
-confusion. FILEHANDLE may be an expression whose value gives the name
-of the filehandle. The values for WHENCE are 0 to set the file pointer
-to POSITION, 1 to set the it to current plus POSITION, and 2 to set it
-to EOF plus offset. You may use the values SEEK_SET, SEEK_CUR, and
-SEEK_END for this from either the IO::Seekable or the POSIX module.
-Returns 1 upon success, 0 otherwise. See also L</systell>.
-
-=item systell FILEHANDLE
-
-=item systell
-
-Returns the current position of the system file pointer for FILEHANDLE
-as reported by the system call lseek(2). It bypasses stdio, so mixing
-this with reads (other than sysread()), print(), write(), seek(), or
-tell() may cause confusion. FILEHANDLE may be an expression whose value
-gives the name of the actual filehandle. If FILEHANDLE is omitted,
-assumes the file last read. See also L</sysseek>.
+Sets FILEHANDLE's system position using the system call lseek(2). It
+bypasses stdio, so mixing this with reads (other than sysread()),
+print(), write(), seek(), or tell() may cause confusion. FILEHANDLE may
+be an expression whose value gives the name of the filehandle. The
+values for WHENCE are 0 to set the new position to POSITION, 1 to set
+the it to the current position plus POSITION, and 2 to set it to EOF
+plus POSITION (typically negative). For WHENCE, you may use the
+constants SEEK_SET, SEEK_CUR, and SEEK_END from either the IO::Seekable
+or the POSIX module.
+
+Returns the new position, or the undefined value on failure. A position
+of zero is returned as the string "0 but true"; thus sysseek() returns
+TRUE on success and FALSE on failure, yet you can still easily determine
+the new position.
=item system LIST
@@ -3443,7 +3436,7 @@ that many bytes counting backwards from the end of the string.
=item tell
-Returns the current file position for FILEHANDLE. FILEHANDLE may be an
+Returns the current position for FILEHANDLE. FILEHANDLE may be an
expression whose value gives the name of the actual filehandle. If
FILEHANDLE is omitted, assumes the file last read.
diff --git a/pod/perltoc.pod b/pod/perltoc.pod
index e7fed663ad..388a672f50 100644
--- a/pod/perltoc.pod
+++ b/pod/perltoc.pod
@@ -860,11 +860,10 @@ $^E, $^H, $^M
=item New and changed builtin functions
delete on slices, flock, printf and sprintf, keys as an lvalue, my() in
-Control Structures, pack() and unpack(), sysseek() and systell(), use
-VERSION, use Module VERSION LIST, prototype(FUNCTION), srand, $_ as
-Default, C<m//g> does not reset search position on failure, C<m//x> ignores
-whitespace before ?*+{}, nested C<sub{}> closures work now, formats work
-right on changing lexicals
+Control Structures, pack() and unpack(), sysseek(), use VERSION, use Module
+VERSION LIST, prototype(FUNCTION), srand, $_ as Default, C<m//g> does not
+reset search position on failure, C<m//x> ignores whitespace before ?*+{},
+nested C<sub{}> closures work now, formats work right on changing lexicals
=item New builtin methods
@@ -943,21 +942,22 @@ nonexistent shared string, Attempt to use reference as lvalue in substr,
Can't use bareword ("%s") as %s ref while "strict refs" in use, Cannot
resolve method `%s' overloading `%s' in package `%s', Constant subroutine
%s redefined, Constant subroutine %s undefined, Copy method did not return
-a reference, Died, Exiting pseudo-block via %s, Illegal character %s
-(carriage return), Illegal switch in PERL5OPT: %s, Integer overflow in hex
-number, Integer overflow in octal number, internal error: glob failed, Name
-"%s::%s" used only once: possible typo, Null picture in formline, Offset
-outside string, Out of memory!, Out of memory during request for %s,
-Possible attempt to put comments in qw() list, Possible attempt to separate
-words with commas, Scalar value @%s{%s} better written as $%s{%s}, Stub
-found while resolving method `%s' overloading `%s' in package `%s', Too
-late for "B<-T>" option, untie attempted while %d inner references still
-exist, Unrecognized character %s, Unsupported function fork, Use of
-"$$<digit>" to mean "${$}<digit>" is deprecated, Value of %s can be "0";
-test with defined(), Variable "%s" may be unavailable, Variable "%s" will
-not stay shared, Warning: something's wrong, Ill-formed logical name |%s|
-in prime_env_iter, Got an error from DosAllocMem, Malformed PERLLIB_PREFIX,
-PERL_SH_DIR too long, Process terminated by SIG%s
+a reference, Died, Exiting pseudo-block via %s, Identifier too long,
+Illegal character %s (carriage return), Illegal switch in PERL5OPT: %s,
+Integer overflow in hex number, Integer overflow in octal number, internal
+error: glob failed, Invalid type in pack: '%s', Invalid type in unpack:
+'%s', Name "%s::%s" used only once: possible typo, Null picture in
+formline, Offset outside string, Out of memory!, Out of memory during
+request for %s, Possible attempt to put comments in qw() list, Possible
+attempt to separate words with commas, Scalar value @%s{%s} better written
+as $%s{%s}, Stub found while resolving method `%s' overloading `%s' in
+package `%s', Too late for "B<-T>" option, untie attempted while %d inner
+references still exist, Unrecognized character %s, Unsupported function
+fork, Use of "$$<digit>" to mean "${$}<digit>" is deprecated, Value of %s
+can be "0"; test with defined(), Variable "%s" may be unavailable, Variable
+"%s" will not stay shared, Warning: something's wrong, Ill-formed logical
+name |%s| in prime_env_iter, Got an error from DosAllocMem, Malformed
+PERLLIB_PREFIX, PERL_SH_DIR too long, Process terminated by SIG%s
=item BUGS
@@ -1175,26 +1175,26 @@ defined EXPR, defined, delete EXPR, die LIST, do BLOCK, do
SUBROUTINE(LIST), do EXPR, dump LABEL, each HASH, eof FILEHANDLE, eof (),
eof, eval EXPR, eval BLOCK, exec LIST, exists EXPR, exit EXPR, exp EXPR,
exp, fcntl FILEHANDLE,FUNCTION,SCALAR, fileno FILEHANDLE, flock
-FILEHANDLE,OPERATION, fork, format, formline PICTURE, LIST, getc
-FILEHANDLE, getc, getlogin, getpeername SOCKET, getpgrp PID, getppid,
-getpriority WHICH,WHO, getpwnam NAME, getgrnam NAME, gethostbyname NAME,
-getnetbyname NAME, getprotobyname NAME, getpwuid UID, getgrgid GID,
-getservbyname NAME,PROTO, gethostbyaddr ADDR,ADDRTYPE, getnetbyaddr
-ADDR,ADDRTYPE, getprotobynumber NUMBER, getservbyport PORT,PROTO, getpwent,
-getgrent, gethostent, getnetent, getprotoent, getservent, setpwent,
-setgrent, sethostent STAYOPEN, setnetent STAYOPEN, setprotoent STAYOPEN,
-setservent STAYOPEN, endpwent, endgrent, endhostent, endnetent,
-endprotoent, endservent, getsockname SOCKET, getsockopt
-SOCKET,LEVEL,OPTNAME, glob EXPR, glob, gmtime EXPR, goto LABEL, goto EXPR,
-goto &NAME, grep BLOCK LIST, grep EXPR,LIST, hex EXPR, hex, import, index
-STR,SUBSTR,POSITION, index STR,SUBSTR, int EXPR, int, ioctl
-FILEHANDLE,FUNCTION,SCALAR, join EXPR,LIST, keys HASH, kill LIST, last
-LABEL, last, lc EXPR, lc, lcfirst EXPR, lcfirst, length EXPR, length, link
-OLDFILE,NEWFILE, listen SOCKET,QUEUESIZE, local EXPR, localtime EXPR, log
-EXPR, log, lstat FILEHANDLE, lstat EXPR, lstat, m//, map BLOCK LIST, map
-EXPR,LIST, mkdir FILENAME,MODE, msgctl ID,CMD,ARG, msgget KEY,FLAGS, msgsnd
-ID,MSG,FLAGS, msgrcv ID,VAR,SIZE,TYPE,FLAGS, my EXPR, next LABEL, next, no
-Module LIST, oct EXPR, oct, open FILEHANDLE,EXPR, open FILEHANDLE, opendir
+FILEHANDLE,OPERATION, fork, format, formline PICTURE,LIST, getc FILEHANDLE,
+getc, getlogin, getpeername SOCKET, getpgrp PID, getppid, getpriority
+WHICH,WHO, getpwnam NAME, getgrnam NAME, gethostbyname NAME, getnetbyname
+NAME, getprotobyname NAME, getpwuid UID, getgrgid GID, getservbyname
+NAME,PROTO, gethostbyaddr ADDR,ADDRTYPE, getnetbyaddr ADDR,ADDRTYPE,
+getprotobynumber NUMBER, getservbyport PORT,PROTO, getpwent, getgrent,
+gethostent, getnetent, getprotoent, getservent, setpwent, setgrent,
+sethostent STAYOPEN, setnetent STAYOPEN, setprotoent STAYOPEN, setservent
+STAYOPEN, endpwent, endgrent, endhostent, endnetent, endprotoent,
+endservent, getsockname SOCKET, getsockopt SOCKET,LEVEL,OPTNAME, glob EXPR,
+glob, gmtime EXPR, goto LABEL, goto EXPR, goto &NAME, grep BLOCK LIST, grep
+EXPR,LIST, hex EXPR, hex, import, index STR,SUBSTR,POSITION, index
+STR,SUBSTR, int EXPR, int, ioctl FILEHANDLE,FUNCTION,SCALAR, join
+EXPR,LIST, keys HASH, kill LIST, last LABEL, last, lc EXPR, lc, lcfirst
+EXPR, lcfirst, length EXPR, length, link OLDFILE,NEWFILE, listen
+SOCKET,QUEUESIZE, local EXPR, localtime EXPR, log EXPR, log, lstat
+FILEHANDLE, lstat EXPR, lstat, m//, map BLOCK LIST, map EXPR,LIST, mkdir
+FILENAME,MODE, msgctl ID,CMD,ARG, msgget KEY,FLAGS, msgsnd ID,MSG,FLAGS,
+msgrcv ID,VAR,SIZE,TYPE,FLAGS, my EXPR, next LABEL, next, no Module LIST,
+oct EXPR, oct, open FILEHANDLE,EXPR, open FILEHANDLE, opendir
DIRHANDLE,EXPR, ord EXPR, ord, pack TEMPLATE,LIST, package NAMESPACE, pipe
READHANDLE,WRITEHANDLE, pop ARRAY, pop, pos SCALAR, pos, print FILEHANDLE
LIST, print LIST, print, printf FILEHANDLE FORMAT, LIST, printf FORMAT,
@@ -1222,16 +1222,15 @@ sub NAME, sub NAME BLOCK, substr EXPR,OFFSET,LEN, substr EXPR,OFFSET,
symlink OLDFILE,NEWFILE, syscall LIST, sysopen FILEHANDLE,FILENAME,MODE,
sysopen FILEHANDLE,FILENAME,MODE,PERMS, sysread
FILEHANDLE,SCALAR,LENGTH,OFFSET, sysread FILEHANDLE,SCALAR,LENGTH, sysseek
-FILEHANDLE,POSITION,WHENCE, systell FILEHANDLE, systell, system LIST,
-syswrite FILEHANDLE,SCALAR,LENGTH,OFFSET, syswrite
-FILEHANDLE,SCALAR,LENGTH, tell FILEHANDLE, tell, telldir DIRHANDLE, tie
-VARIABLE,CLASSNAME,LIST, tied VARIABLE, time, times, tr///, truncate
-FILEHANDLE,LENGTH, truncate EXPR,LENGTH, uc EXPR, uc, ucfirst EXPR,
-ucfirst, umask EXPR, umask, undef EXPR, undef, unlink LIST, unlink, unpack
-TEMPLATE,EXPR, untie VARIABLE, unshift ARRAY,LIST, use Module LIST, use
-Module, use Module VERSION LIST, use VERSION, utime LIST, values HASH, vec
-EXPR,OFFSET,BITS, wait, waitpid PID,FLAGS, wantarray, warn LIST, write
-FILEHANDLE, write EXPR, write, y///
+FILEHANDLE,POSITION,WHENCE, system LIST, syswrite
+FILEHANDLE,SCALAR,LENGTH,OFFSET, syswrite FILEHANDLE,SCALAR,LENGTH, tell
+FILEHANDLE, tell, telldir DIRHANDLE, tie VARIABLE,CLASSNAME,LIST, tied
+VARIABLE, time, times, tr///, truncate FILEHANDLE,LENGTH, truncate
+EXPR,LENGTH, uc EXPR, uc, ucfirst EXPR, ucfirst, umask EXPR, umask, undef
+EXPR, undef, unlink LIST, unlink, unpack TEMPLATE,EXPR, untie VARIABLE,
+unshift ARRAY,LIST, use Module LIST, use Module, use Module VERSION LIST,
+use VERSION, utime LIST, values HASH, vec EXPR,OFFSET,BITS, wait, waitpid
+PID,FLAGS, wantarray, warn LIST, write FILEHANDLE, write EXPR, write, y///
=back
diff --git a/pp_sys.c b/pp_sys.c
index 712b003abb..6d18ac96bc 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -155,6 +155,9 @@ static int dooneliner _((char *cmd, char *filename));
#endif /* no flock() */
+#define ZBTLEN 10
+static char zero_but_true[ZBTLEN + 1] = "0 but true";
+
/* Pushy I/O. */
PP(pp_backtick)
@@ -1357,11 +1360,6 @@ PP(pp_eof)
PP(pp_tell)
{
- return pp_systell(ARGS);
-}
-
-PP(pp_systell)
-{
dSP; dTARGET;
GV *gv;
@@ -1386,7 +1384,14 @@ PP(pp_sysseek)
long offset = POPl;
gv = last_in_gv = (GV*)POPs;
- PUSHs(boolSV(do_seek(gv, offset, whence)));
+ if (op->op_type == OP_SEEK)
+ PUSHs(boolSV(do_seek(gv, offset, whence)));
+ else {
+ long n = do_sysseek(gv, offset, whence);
+ PUSHs((n < 0) ? &sv_undef
+ : sv_2mortal(n ? newSViv((IV)n)
+ : newSVpv(zero_but_true, ZBTLEN)));
+ }
RETURN;
}
@@ -1527,7 +1532,7 @@ PP(pp_ioctl)
PUSHi(retval);
}
else {
- PUSHp("0 but true", 10);
+ PUSHp(zero_but_true, ZBTLEN);
}
RETURN;
}
@@ -3459,7 +3464,7 @@ PP(pp_semctl)
PUSHi(anum);
}
else {
- PUSHp("0 but true",10);
+ PUSHp(zero_but_true, ZBTLEN);
}
RETURN;
#else
diff --git a/proto.h b/proto.h
index ec216ea099..c2f1ef4da1 100644
--- a/proto.h
+++ b/proto.h
@@ -97,6 +97,7 @@ I32 do_semop _((SV** mark, SV** sp));
I32 do_shmio _((I32 optype, SV** mark, SV** sp));
#endif
void do_sprintf _((SV* sv, I32 len, SV** sarg));
+long do_sysseek _((GV* gv, long pos, int whence));
long do_tell _((GV* gv));
I32 do_trans _((SV* sv, OP* arg));
void do_vecset _((SV* sv));
diff --git a/t/op/sysio.t b/t/op/sysio.t
index 6135cd3465..0af333db84 100755
--- a/t/op/sysio.t
+++ b/t/op/sysio.t
@@ -1,6 +1,6 @@
#!./perl
-print "1..34\n";
+print "1..36\n";
chdir('op') || die "sysio.t: cannot look for myself: $!";
@@ -164,22 +164,25 @@ print "ok 29\n";
print 'not ' unless ($b eq '#!ererl');
print "ok 30\n";
-# test sysseek and systell
+# test sysseek
-sysseek(I, 2, 0);
+print 'not ' unless sysseek(I, 2, 0) == 2;
+print "ok 31\n";
sysread(I, $b, 3);
print 'not ' unless $b eq 'ere';
-print "ok 31\n";
-print 'not ' unless systell(I) == 5;
print "ok 32\n";
-sysseek(I, -2, 1);
+print 'not ' unless sysseek(I, -2, 1) == 3;
+print "ok 33\n";
sysread(I, $b, 4);
print 'not ' unless $b eq 'rerl';
-print "ok 33\n";
-print 'not ' unless systell(I) == 7;
print "ok 34\n";
+print 'not ' unless sysseek(I, 0, 0) eq '0 but true';
+print "ok 35\n";
+print 'not ' if defined sysseek(I, -1, 1);
+print "ok 36\n";
+
close(I);
unlink $outfile;
diff --git a/toke.c b/toke.c
index 1431d26d2d..c24c45c9c1 100644
--- a/toke.c
+++ b/toke.c
@@ -22,13 +22,15 @@ static SV *q _((SV *sv));
static char *scan_const _((char *start));
static char *scan_formline _((char *s));
static char *scan_heredoc _((char *s));
-static char *scan_ident _((char *s, char *send, char *dest, I32 ck_uni));
+static char *scan_ident _((char *s, char *send, char *dest, STRLEN destlen,
+ I32 ck_uni));
static char *scan_inputsymbol _((char *start));
static char *scan_pat _((char *start));
static char *scan_str _((char *start));
static char *scan_subst _((char *start));
static char *scan_trans _((char *start));
-static char *scan_word _((char *s, char *dest, int allow_package, STRLEN *slp));
+static char *scan_word _((char *s, char *dest, STRLEN destlen,
+ int allow_package, STRLEN *slp));
static char *skipspace _((char *s));
static void checkcomma _((char *s, char *name, char *what));
static void force_ident _((char *s, int kind));
@@ -48,6 +50,8 @@ static int uni _((I32 f, char *s));
static char * filter_gets _((SV *sv, PerlIO *fp, STRLEN append));
static void restore_rsfp _((void *f));
+static char too_long[] = "Identifier too long";
+
static char *linestart; /* beg. of most recently read line */
static char pending_ident; /* pending identifier lookup */
@@ -505,7 +509,7 @@ int allow_tick;
(allow_pack && *s == ':') ||
(allow_tick && *s == '\'') )
{
- s = scan_word(s, tokenbuf, allow_pack, &len);
+ s = scan_word(s, tokenbuf, sizeof tokenbuf, allow_pack, &len);
if (check_keyword && keyword(tokenbuf, len))
return start;
if (token == METHOD) {
@@ -923,7 +927,7 @@ register char *s;
char seen[256];
unsigned char un_char = 0, last_un_char;
char *send = strchr(s,']');
- char tmpbuf[512];
+ char tmpbuf[sizeof tokenbuf * 4];
if (!send) /* has to be an expression */
return TRUE;
@@ -948,7 +952,7 @@ register char *s;
case '$':
weight -= seen[un_char] * 10;
if (isALNUM(s[1])) {
- scan_ident(s,send,tmpbuf,FALSE);
+ scan_ident(s, send, tmpbuf, sizeof tmpbuf, FALSE);
if ((int)strlen(tmpbuf) > 1 && gv_fetchpv(tmpbuf,FALSE, SVt_PV))
weight -= 100;
else
@@ -1018,7 +1022,7 @@ char *start;
GV *gv;
{
char *s = start + (*start == '$');
- char tmpbuf[1024];
+ char tmpbuf[sizeof tokenbuf];
STRLEN len;
GV* indirgv;
@@ -1028,7 +1032,7 @@ GV *gv;
if (!GvCVu(gv))
gv = 0;
}
- s = scan_word(s, tmpbuf, TRUE, &len);
+ s = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
if (*start == '$') {
if (gv || last_lop_op == OP_PRINT || isUPPER(*tokenbuf))
return 0;
@@ -1853,7 +1857,7 @@ yylex()
case '*':
if (expect != XOPERATOR) {
- s = scan_ident(s, bufend, tokenbuf, TRUE);
+ s = scan_ident(s, bufend, tokenbuf, sizeof tokenbuf, TRUE);
expect = XOPERATOR;
force_ident(tokenbuf, '*');
if (!*tokenbuf)
@@ -1873,7 +1877,7 @@ yylex()
Mop(OP_MODULO);
}
tokenbuf[0] = '%';
- s = scan_ident(s, bufend, tokenbuf+1, TRUE);
+ s = scan_ident(s, bufend, tokenbuf + 1, sizeof tokenbuf - 1, TRUE);
if (!tokenbuf[1]) {
if (s == bufend)
yyerror("Final % should be \\% or %name");
@@ -1963,7 +1967,8 @@ yylex()
d++;
}
if (d < bufend && isIDFIRST(*d)) {
- d = scan_word(d, tokenbuf + 1, FALSE, &len);
+ d = scan_word(d, tokenbuf + 1, sizeof tokenbuf - 1,
+ FALSE, &len);
while (d < bufend && (*d == ' ' || *d == '\t'))
d++;
if (*d == '}') {
@@ -2068,7 +2073,7 @@ yylex()
BAop(OP_BIT_AND);
}
- s = scan_ident(s-1, bufend, tokenbuf, TRUE);
+ s = scan_ident(s - 1, bufend, tokenbuf, sizeof tokenbuf, TRUE);
if (*tokenbuf) {
expect = XOPERATOR;
force_ident(tokenbuf, '&');
@@ -2190,7 +2195,8 @@ yylex()
if (expect == XOPERATOR)
no_op("Array length", bufptr);
tokenbuf[0] = '@';
- s = scan_ident(s+1, bufend, tokenbuf+1, FALSE);
+ s = scan_ident(s + 1, bufend, tokenbuf + 1, sizeof tokenbuf - 1,
+ FALSE);
if (!tokenbuf[1])
PREREF(DOLSHARP);
expect = XOPERATOR;
@@ -2201,7 +2207,7 @@ yylex()
if (expect == XOPERATOR)
no_op("Scalar", bufptr);
tokenbuf[0] = '$';
- s = scan_ident(s, bufend, tokenbuf+1, FALSE);
+ s = scan_ident(s, bufend, tokenbuf + 1, sizeof tokenbuf - 1, FALSE);
if (!tokenbuf[1]) {
if (s == bufend)
yyerror("Final $ should be \\$ or $name");
@@ -2242,11 +2248,11 @@ yylex()
if (dowarn && strEQ(tokenbuf+1, "SIG") &&
(t = strchr(s, '}')) && (t = strchr(t, '=')))
{
- char tmpbuf[1024];
+ char tmpbuf[sizeof tokenbuf];
STRLEN len;
for (t++; isSPACE(*t); t++) ;
if (isIDFIRST(*t)) {
- t = scan_word(t, tmpbuf, TRUE, &len);
+ t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len);
if (*t != '(' && perl_get_cv(tmpbuf, FALSE))
warn("You need to quote \"%s\"", tmpbuf);
}
@@ -2264,8 +2270,8 @@ yylex()
else if (strchr("&*<%", *s) && isIDFIRST(s[1]))
expect = XTERM; /* e.g. print $fh &sub */
else if (isIDFIRST(*s)) {
- char tmpbuf[1024];
- scan_word(s, tmpbuf, TRUE, &len);
+ char tmpbuf[sizeof tokenbuf];
+ scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
if (keyword(tmpbuf, len))
expect = XTERM; /* e.g. print $fh length() */
else {
@@ -2290,7 +2296,7 @@ yylex()
if (expect == XOPERATOR)
no_op("Array", s);
tokenbuf[0] = '@';
- s = scan_ident(s, bufend, tokenbuf+1, FALSE);
+ s = scan_ident(s, bufend, tokenbuf + 1, sizeof tokenbuf - 1, FALSE);
if (!tokenbuf[1]) {
if (s == bufend)
yyerror("Final @ should be \\@ or @name");
@@ -2456,7 +2462,7 @@ yylex()
keylookup:
bufptr = s;
- s = scan_word(s, tokenbuf, FALSE, &len);
+ s = scan_word(s, tokenbuf, sizeof tokenbuf, FALSE, &len);
/* Some keywords can be followed by any delimiter, including ':' */
tmp = (len == 1 && strchr("msyq", tokenbuf[0]) ||
@@ -2520,7 +2526,8 @@ yylex()
/* Get the rest if it looks like a package qualifier */
if (*s == '\'' || *s == ':' && s[1] == ':') {
- s = scan_word(s, tokenbuf + len, TRUE, &len);
+ s = scan_word(s, tokenbuf + len, sizeof tokenbuf - len,
+ TRUE, &len);
if (!len)
croak("Bad name after %s::", tokenbuf);
}
@@ -2746,7 +2753,7 @@ yylex()
if (*s == ':' && s[1] == ':') {
s += 2;
d = s;
- s = scan_word(s, tokenbuf, FALSE, &len);
+ s = scan_word(s, tokenbuf, sizeof tokenbuf, FALSE, &len);
tmp = keyword(tokenbuf, len);
if (tmp < 0)
tmp = -tmp;
@@ -3451,9 +3458,9 @@ yylex()
s = skipspace(s);
if (isIDFIRST(*s) || *s == '\'' || *s == ':') {
- char tmpbuf[128];
+ char tmpbuf[sizeof tokenbuf];
expect = XBLOCK;
- d = scan_word(s, tmpbuf, TRUE, &len);
+ d = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
if (strchr(tmpbuf, ':'))
sv_setpv(subname, tmpbuf);
else {
@@ -3529,9 +3536,6 @@ yylex()
case KEY_sysopen:
LOP(OP_SYSOPEN,XTERM);
- case KEY_systell:
- UNI(OP_SYSTELL);
-
case KEY_sysseek:
LOP(OP_SYSSEEK,XTERM);
@@ -4190,7 +4194,6 @@ I32 len;
if (strEQ(d,"sysopen")) return -KEY_sysopen;
if (strEQ(d,"sysread")) return -KEY_sysread;
if (strEQ(d,"sysseek")) return -KEY_sysseek;
- if (strEQ(d,"systell")) return -KEY_systell;
break;
case 8:
if (strEQ(d,"syswrite")) return -KEY_syswrite;
@@ -4330,14 +4333,18 @@ char *what;
}
static char *
-scan_word(s, dest, allow_package, slp)
+scan_word(s, dest, destlen, allow_package, slp)
register char *s;
char *dest;
+STRLEN destlen;
int allow_package;
STRLEN *slp;
{
register char *d = dest;
+ register char *e = d + destlen - 3; /* two-character token, ending NUL */
for (;;) {
+ if (d >= e)
+ croak(too_long);
if (isALNUM(*s))
*d++ = *s++;
else if (*s == '\'' && allow_package && isIDFIRST(s[1])) {
@@ -4358,13 +4365,15 @@ STRLEN *slp;
}
static char *
-scan_ident(s,send,dest,ck_uni)
+scan_ident(s, send, dest, destlen, ck_uni)
register char *s;
register char *send;
char *dest;
+STRLEN destlen;
I32 ck_uni;
{
register char *d;
+ register char *e;
char *bracket = 0;
char funny = *s++;
@@ -4373,12 +4382,18 @@ I32 ck_uni;
if (isSPACE(*s))
s = skipspace(s);
d = dest;
+ e = d + destlen - 3; /* two-character token, ending NUL */
if (isDIGIT(*s)) {
- while (isDIGIT(*s))
+ while (isDIGIT(*s)) {
+ if (d >= e)
+ croak(too_long);
*d++ = *s++;
+ }
}
else {
for (;;) {
+ if (d >= e)
+ croak(too_long);
if (isALNUM(*s))
*d++ = *s++;
else if (*s == '\'' && isIDFIRST(s[1])) {
View Lorry Controller Status