From d976ac8220f8890bb7663152c4870f60e8e018c8 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Fri, 10 Jan 1997 02:45:11 -0500 Subject: Fix for anon-lists with tied entries coredump [George Hartlieb, a MLDBM user reported this problem in private mail.] The following hypothetical construct: for $k (keys %o) { foo([$o{$k}]); } coredumps reliably when %o is a tied hash and the FETCH for the value $o{$k} is substantial enough to cause a stack reallocation. Patch against 3_19 attached. - Sarathy. gsar@engin.umich.edu P.S: Whatever happened to the stack-of-stacks patch? Even the first version of that patch would have eliminated this problem. There may be many more places where such a fix may be necessary--it's impossible to find them all. Please, let's atleast include a #ifdef-ed version of that patch! p5p-msgid: <199701100745.CAA13057@aatma.engin.umich.edu> --- pp.c | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/pp.c b/pp.c index 7a24843f5d..e4e00ce948 100644 --- a/pp.c +++ b/pp.c @@ -2110,10 +2110,11 @@ PP(pp_lslice) PP(pp_anonlist) { - dSP; dMARK; + dSP; dMARK; dORIGMARK; I32 items = SP - MARK; - SP = MARK; - XPUSHs((SV*)sv_2mortal((SV*)av_make(items, MARK+1))); + SV *av = sv_2mortal((SV*)av_make(items, MARK+1)); + SP = ORIGMARK; /* av_make() might realloc stack_sp */ + XPUSHs(av); RETURN; } -- cgit v1.2.1 From a4c70ab8da3ec1d87c83e5c617f4550814ec1724 Mon Sep 17 00:00:00 2001 From: Dominic Dunlop Date: Wed, 8 Jan 1997 12:07:18 +0100 Subject: Make MachTen hints file warn about db-recno failures Subject: Patch: make hints files warn about db-recno failures (redux) Sigh. Somehow, the patch for hints for machten.sh was missed out of my submission, and so didn't make it into 5.003_20. Here you go: p5p-msgid: --- hints/machten.sh | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/hints/machten.sh b/hints/machten.sh index f6f75d6616..c40d1e5cd1 100644 --- a/hints/machten.sh +++ b/hints/machten.sh @@ -1,5 +1,5 @@ # machten.sh -# This is for MachTen 4.0.2. It might work on other versions too. +# This is for MachTen 4.0.3. It might work on other versions too. # # MachTen users might need a fixed tr from ftp.tenon.com. This should # be described in the MachTen release notes. @@ -13,6 +13,7 @@ # Martijn Koster # Richard Yeh # +# Warn about test failure due to old Berkeley db -- Dominc Dunlop 970105 # Do not use perl's malloc; SysV IPC OK -- Neil Cutcliffe, Tenon 961030 # File::Find's use of link count disabled by Dominic Dunlop 960528 # Perl's use of sigsetjmp etc. disabled by Dominic Dunlop 960521 @@ -23,8 +24,7 @@ # know how to use it yet. # # Updated by Dominic Dunlop -# Wed Nov 13 11:47:09 WET 1996 - +# Sun Jan 5 11:33:51 WET 1997 # Power MachTen is a real memory system and its standard malloc # has been optimized for this. Using this malloc instead of Perl's @@ -70,3 +70,4 @@ Hmm...You had some extra variables I don't know about...I'll try to keep 'em. Read the File::Find documentation for more information. EOM +test -r ./broken-db.msg && . ./broken-db.msg -- cgit v1.2.1 From 50e0d465254be88fb90ac23584812a529741b4b1 Mon Sep 17 00:00:00 2001 From: Ollivier Robert Date: Wed, 8 Jan 1997 14:37:47 +0100 Subject: 5.003_20, FreeBSD 3.0 and minor patch FreeBSD caerdonn.eurocontrol.fr 3.0-CURRENT FreeBSD 3.0-CURRENT #0: Mon Jan 6 10:35:39 MET 1997 roberto@caerdonn.eurocontrol.fr:/src/src/sys/compile/CAERDONN i386 lib/textwrap......ok lib/timelocal.....ok All tests successful. u=0.421875 s=0.328125 cu=20.6484 cs=6.28125 files=142 tests=3412 Also please include the following patch in _21 (or 5.004 whichever is planned): p5p-msgid: --- Configure | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Configure b/Configure index 9211439ce2..2fd5c72b73 100755 --- a/Configure +++ b/Configure @@ -4691,7 +4691,7 @@ if "$useshrplib"; then xxx="-R $shrpdir" ;; freebsd) - xxx="-Wl,-R,$shrpdir" + xxx="-Wl,-R$shrpdir" ;; linux|irix*) xxx="-Wl,-rpath,$shrpdir" -- cgit v1.2.1 From 88f0eda82bb679b4e6445ccb17e18d0781c6a5da Mon Sep 17 00:00:00 2001 From: Wayne Scott Date: Wed, 8 Jan 1997 15:25:19 -0800 Subject: Don't search for pod if path is already valid Subject: Re: perldoc problem? > perldoc doesn't seem to work on absolute paths. Eg if you > try > perldoc /pdx/wmt/rtl/bin/analyze_netlist > it waits and then complains. Wheras if you actually do > cd /pdx/wmt/rtl/bin;perldoc analyze_netlist > it works I've been waiting for this fix to happen for sometime. This change to perldoc fixes the problem. -Wayne p5p-msgid: <199701082325.PAA04521@pdxlx008.intel.com> --- utils/perldoc.PL | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/utils/perldoc.PL b/utils/perldoc.PL index e0f8a43b86..88608cf5d7 100644 --- a/utils/perldoc.PL +++ b/utils/perldoc.PL @@ -154,6 +154,10 @@ sub containspod { my $ret; my $i; my $dir; + + if (-f $s and containspod $s) { + return $s; + } for ($i=0;$i<@dirs;$i++) { $dir = $dirs[$i]; ($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS; -- cgit v1.2.1 From a2333f3625faa17fb193cfa25c3d598cb59f105f Mon Sep 17 00:00:00 2001 From: Gisle Aas Date: Thu, 3 Oct 1996 00:00:35 +0200 Subject: Yet another perldoc option Subject: Re: Yet another perldoc option I have added a new option to perldoc that just make it print the file name of the module found. This enables me to say things like: $ grep VERSION $(perldoc -l lwp) which I find handy. This is also handy for various scripts that want to reuse perldoc's module search algorithm. Perhaps this really should have been made into a proper module. The 'l' was inspired by grep(1). p5p-msgid: <199610022200.AAA15334@furubotn.sn.no> --- utils/perldoc.PL | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/utils/perldoc.PL b/utils/perldoc.PL index 88608cf5d7..7d62c07f81 100644 --- a/utils/perldoc.PL +++ b/utils/perldoc.PL @@ -47,7 +47,7 @@ print OUT <<'!NO!SUBS!'; if(@ARGV<1) { die < 1; +usage("only one of -t, -u, -m or -l") if $opt_t + $opt_u + $opt_m + $opt_l > 1; if ($opt_t) { require Pod::Text; import Pod::Text; } @@ -222,6 +223,11 @@ if(!@found) { exit ($Is_VMS ? 98962 : 1); } +if ($opt_l) { + print join("\n", @found), "\n"; + exit; +} + if( ! -t STDOUT ) { $opt_f = 1 } unless($Is_VMS) { @@ -301,7 +307,7 @@ perldoc - Look up Perl documentation in pod format. =head1 SYNOPSIS -B [B<-h>] [B<-v>] [B<-t>] [B<-u>] PageName|ModuleName|ProgramName +B [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] PageName|ModuleName|ProgramName =head1 DESCRIPTION @@ -342,6 +348,10 @@ This may be useful if the docs don't explain a function in the detail you need, and you'd like to inspect the code directly; perldoc will find the file for you and simply hand it off for display. +=item B<-l> file name only + +Display the file name of the module found. + =item B The item you want to look up. Nested modules (such as C) @@ -368,10 +378,6 @@ Kenneth Albanowski Minor updates by Andy Dougherty -=head1 SEE ALSO - -=head1 DIAGNOSTICS - =cut # -- cgit v1.2.1 From 7c36043de26da560a0f7eb04f36d232762c0092c Mon Sep 17 00:00:00 2001 From: Roderick Schertler Date: Tue, 7 Jan 1997 22:54:14 -0500 Subject: Re: perldoc, temp files, async pagers Then again, your suggestion of having perldoc check $PERLDOC_PAGER first shouldn't offend anybody. p5p-msgid: --- utils/perldoc.PL | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/utils/perldoc.PL b/utils/perldoc.PL index 7d62c07f81..3106cbc2bc 100644 --- a/utils/perldoc.PL +++ b/utils/perldoc.PL @@ -234,13 +234,11 @@ unless($Is_VMS) { $tmp = "/tmp/perldoc1.$$"; push @pagers, qw( more less pg view cat ); unshift @pagers, $ENV{PAGER} if $ENV{PAGER}; - $goodresult = 0; } else { $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$; push @pagers, qw( most more less type/page ); - unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER}; - $goodresult = 1; } +unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER}; if ($opt_m) { foreach $pager (@pagers) { -- cgit v1.2.1 From b2a07c1c241ec86f010fc0ea3bfa54c8ec28be90 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Mon, 13 Jan 1997 15:13:12 -0500 Subject: Document use of pos() and /\G/ Subject: Re: resetting pos broken in _20 On Mon, 13 Jan 1997 12:49:24 EST, Ilya Zakharevich wrote: >Gurusamy Sarathy writes: >> What's wrong with saying >> C after /g fails, to get the behavior >> you want? > >Since this has different semantics. You need to get `pos' before each >match, and reset it after each failing match. > > /=/g; /;/g; /=/g; /;/g; > >may give you non-monotoneous movement of `pos' over the string, which >is a bad thing. Ahh, of course. >But I still do not understand what you mean by "having pos at >end". The bug was that position is reset at failing match, probably >you have some other case in mind? Never mind, I was missing the possibility of chaining //g matches with the \G escape :-( >I did not realize that pos was available at perl 4.?, bug-for-bug >compatibility may be a reason if this was so for so many years... The bug fix seems to make a lot sense (to me) now. \G was essentially useless without the new "incompatiblity", eh? Here's a pod update that documents current behavior in all the places I could think of. - Sarathy. gsar@engin.umich.edu p5p-msgid: <199701132013.PAA26606@aatma.engin.umich.edu> --- pod/perlfunc.pod | 4 +++- pod/perlnews.pod | 13 ++++++++++++- pod/perlop.pod | 29 ++++++++++++++++++++++++++++- pod/perlre.pod | 5 ++++- pod/perltrap.pod | 20 ++++++++++++++++++++ 5 files changed, 67 insertions(+), 4 deletions(-) diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index c1cd67d8ba..65bba93bbb 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -2132,7 +2132,9 @@ like shift(). Returns the offset of where the last C search left off for the variable is in question ($_ is used when the variable is not specified). May be -modified to change that offset. +modified to change that offset. Such modification will also influence +the C<\G> zero-width assertion in regular expressions. See L and +L. =item print FILEHANDLE LIST diff --git a/pod/perlnews.pod b/pod/perlnews.pod index e6d1225a76..3ddb1e07c2 100644 --- a/pod/perlnews.pod +++ b/pod/perlnews.pod @@ -23,7 +23,8 @@ file in the distribution for details. There is a new Configure question that asks if you want to maintain binary compatibility with Perl 5.003. If you choose binary compatibility, you do not have to recompile your extensions, but you -might have symbol conflicts if you embed Perl in another application. +might have symbol conflicts if you embed Perl in another application, +just as in the 5.003 release. =head2 New Opcode Module and Revised Safe Module @@ -186,6 +187,16 @@ function whose prototype you want to retrieve. Functions documented in the Camel to default to $_ now in fact do, and all those that do are so documented in L. +=head2 C does not trigger a pos() reset on failure + +The C match iteration construct used to reset the iteration +when it failed to match (so that the next C match would start at +the beginning of the string). You now have to explicitly do a +C to reset the "last match" position, or modify the +string in some way. This change makes it practical to chain C +matches together in conjunction with ordinary matches using the C<\G> +zero-width assertion. See L and L. + =back =head2 New Built-in Methods diff --git a/pod/perlop.pod b/pod/perlop.pod index a8f34c0e57..dd3aeab663 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -695,7 +695,10 @@ In a scalar context, C iterates through the string, returning TRUE each time it matches, and FALSE when it eventually runs out of matches. (In other words, it remembers where it left off last time and restarts the search at that point. You can actually find the current -match position of a string using the pos() function--see L.) +match position of a string or set it using the pos() function--see +L.) Note that you can use this feature to stack C +matches or intermix C matches with C. + If you modify the string in any way, the match position is reset to the beginning. Examples: @@ -711,6 +714,30 @@ beginning. Examples: } print "$sentences\n"; + # using m//g with \G + $_ = "ppooqppq"; + while ($i++ < 2) { + print "1: '"; + print $1 while /(o)/g; print "', pos=", pos, "\n"; + print "2: '"; + print $1 if /\G(q)/; print "', pos=", pos, "\n"; + print "3: '"; + print $1 while /(p)/g; print "', pos=", pos, "\n"; + } + +The last example should print: + + 1: 'oo', pos=4 + 2: 'q', pos=4 + 3: 'pp', pos=7 + 1: '', pos=7 + 2: 'q', pos=7 + 3: '', pos=7 + +Note how C matches change the value reported by C, but the +non-global match doesn't. + + =item q/STRING/ =item C<'STRING'> diff --git a/pod/perlre.pod b/pod/perlre.pod index 12f9f51016..a4c0a7d9de 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -174,7 +174,10 @@ represents backspace rather than a word boundary.) The C<\A> and C<\Z> are just like "^" and "$" except that they won't match multiple times when the C modifier is used, while "^" and "$" will match at every internal line boundary. To match the actual end of the string, not ignoring newline, -you can use C<\Z(?!\n)>. +you can use C<\Z(?!\n)>. The C<\G> assertion can be used to mix global +matches (using C) and non-global ones, as described in L. +The actual location where C<\G> will match can also be influenced +by using C as an lvalue. See L. When the bracketing construct C<( ... )> is used, \EdigitE matches the digit'th substring. Outside of the pattern, always use "$" instead of "\" diff --git a/pod/perltrap.pod b/pod/perltrap.pod index b8247a4208..4b56dd23d8 100644 --- a/pod/perltrap.pod +++ b/pod/perltrap.pod @@ -1108,6 +1108,26 @@ repeatedly, like C or C. # perl5 prints: perl5 +=item * Regular Expression + +Under perl4 and upto version 5.003, a failed C match used to +reset the internal iterator, so that subsequent C match attempts +began from the beginning of the string. In perl version 5.004 and later, +failed C matches do not reset the iterator position (which can be +found using the C function--see L). + + $test = "foop"; + for (1..3) { + print $1 while ($test =~ /(o)/g); + # pos $test = 0; # to get old behavior + } + + # perl4 prints: oooooo + # perl5.004 prints: oo + +You may always reset the iterator yourself as shown in the commented line +to get the old behavior. + =back =head2 Subroutine, Signal, Sorting Traps -- cgit v1.2.1 From b88f04ff2985d0899964b90ae56789d88f6b353e Mon Sep 17 00:00:00 2001 From: Roderick Schertler Date: Tue, 7 Jan 1997 22:55:33 -0500 Subject: Misc. doc patches missing in _20 Subject: doc patches missing in _20 Here are a couple of the doc patches I sent to the list which didn't get into _20. The first looks like an oversight (a related hunk got in), but perhaps the second was left out intentionally, in anticipation of changes in signal restart handling? These are re-diffed against _20. p5p-msgid: <102.852695733@eeyore.ibcinc.com> --- pod/perlsub.pod | 26 ++++++++++++++++++++++++++ pod/perlvar.pod | 16 ++++++++++++++++ 2 files changed, 42 insertions(+) diff --git a/pod/perlsub.pod b/pod/perlsub.pod index bd3eb18154..2d3e666256 100644 --- a/pod/perlsub.pod +++ b/pod/perlsub.pod @@ -754,6 +754,32 @@ starts scribbling on your @_ parameter list. This is all very powerful, of course, and should be used only in moderation to make the world a better place. +=head2 Constant Functions + +Functions with a prototype of C<()> are potential candidates for +inlining. If the result after optimization and constant folding is a +constant then it will be used in place of calls to the function. + +All of the following functions would be inlined. + + sub PI () { 3.14159 } + sub ST_DEV () { 0 } + sub ST_INO () { 1 } + + sub FLAG_FOO () { 1 << 8 } + sub FLAG_BAR () { 1 << 9 } + sub FLAG_MASK () { FLAG_FOO | FLAG_BAR } + + sub OPT_BAZ () { 1 } + sub BAZ_VAL () { + if (OPT_BAZ) { + return 23; + } + else { + return 42; + } + } + If you redefine a subroutine which was eligible for inlining you'll get a mandatory warning. (You can use this warning to tell whether or not a particular subroutine is considered constant.) The warning is diff --git a/pod/perlvar.pod b/pod/perlvar.pod index a049e9d5a1..de9bd22348 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -698,6 +698,22 @@ sometimes it's a string representing the function, and sometimes it's going to call the subroutine call right then and there! Best to be sure and quote it or take a reference to it. *Plumber works too. See L. +If your system has the sigaction() function then signal handlers are +installed using it. This means you get reliable signal handling. If +your system has the SA_RESTART flag it is used when signals handlers are +installed. This means that system calls for which it is supported +continue rather than returning when a signal arrives. If you want your +system calls to be interrupted by signal delivery then do something like +this: + + use POSIX ':signal_h'; + + my $alarm = 0; + sigaction SIGALRM, new POSIX::SigAction sub { $alarm = 1 } + or die "Error setting SIGALRM handler: $!\n"; + +See L. + Certain internal hooks can be also set using the %SIG hash. The routine indicated by C<$SIG{__WARN__}> is called when a warning message is about to be printed. The warning message is passed as the first -- cgit v1.2.1 From a9bc755754f0db5e848e65dfd2e63a96af50ffd4 Mon Sep 17 00:00:00 2001 From: Ilya Zakharevich Date: Sun, 12 Jan 1997 16:22:47 -0500 Subject: Fix overloading via inherited autoloaded functions Subject: Re: overloading broken in _20, or am I dense? Randal Schwartz writes: > > > This code works fine with _11, but breaks with _20. Did I mess > something up? Or is something seriously broken in _20? (This is at > the heart of making LWP work again.) > > #!/home/merlyn/test/bin/perl > > BEGIN { > package A; > > sub as_string { > shift->{"string"}; > } > } > > BEGIN { > package B; > @ISA = qw(A); > use overload ('""' => 'as_string', 'fallback' => 1); > > sub new { > my $self = bless {}, shift; > $self->{"string"} = shift; > $self; > } > } > > $thing = new B "newbie"; > ## print $thing->as_string; > print "$thing"; The patch below updates the following files: gv.c pp.c t/op/overload.t pod/perldiag.pod lib/overload.pm It fixes the above bug, another bug with autoloaded overloading subroutines via inheritance (grok!), adds a way to do gv_findmeth without creating import stubs (undocumented yet - give -1 as level), and sneaks in a long-awaited ;-) feature *{\&subr}. Final implementation of overloading does not use the above feature, but I know a lot of uses for debugging. Anyway, feel free to remove the first chunk of the patch if you feel offended by the above feature. Tested with _17. Enjoy, p5p-msgid: <199701131022.FAA22830@monk.mps.ohio-state.edu> --- gv.c | 59 +++++++++++++++++++++++++++++++++++++++++++---------- lib/overload.pm | 30 ++++++++++++++++++++++++--- pod/perldiag.pod | 11 ++++++++++ pp.c | 2 ++ t/pragma/overload.t | 24 +++++++++++++++++++--- 5 files changed, 109 insertions(+), 17 deletions(-) diff --git a/gv.c b/gv.c index 5ffa11b02e..2e2bc193d5 100644 --- a/gv.c +++ b/gv.c @@ -129,7 +129,7 @@ STRLEN len; I32 level; { AV* av; - GV* topgv; + GV* topgv = NULL; GV* gv; GV** gvp; HV* lastchance; @@ -137,12 +137,14 @@ I32 level; if (!stash) return 0; - if (level > 100) + if ((level > 100) || (level < -100)) croak("Recursive inheritance detected"); - gvp = (GV**)hv_fetch(stash, name, len, TRUE); + gvp = (GV**)hv_fetch(stash, name, len, (level >= 0)); DEBUG_o( deb("Looking for method %s in package %s\n",name,HvNAME(stash)) ); + if (!gvp) goto recurse; + topgv = *gvp; if (SvTYPE(topgv) != SVt_PVGV) gv_init(topgv, stash, name, len, TRUE); @@ -162,6 +164,7 @@ I32 level; } /* Now cv = 0, and there is no cv in topgv. */ + recurse: gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE); if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) { SV** svp = AvARRAY(av); @@ -175,19 +178,19 @@ I32 level; SvPVX(sv), HvNAME(stash)); continue; } - gv = gv_fetchmeth(basestash, name, len, level + 1); - if (gv) { + gv = gv_fetchmeth(basestash, name, len, level + (level >= 0 ? 1 : -1)); + if (gv && topgv) { GvCV(topgv) = GvCV(gv); /* cache the CV */ GvCVGEN(topgv) = sub_generation; /* valid for now */ SvREFCNT_inc(GvCV(gv)); return gv; - } + } else if (gv) return gv; } } - if (!level) { + if ((level == 0) || (level == -1)) { /* topgv is present. */ if (lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE)) { - if (gv = gv_fetchmeth(lastchance, name, len, level + 1)) { + if (gv = gv_fetchmeth(lastchance, name, len, level + (level >= 0 ? 1 : -1))) { GvCV(topgv) = GvCV(gv); /* cache the CV */ GvCVGEN(topgv) = sub_generation; /* valid for now */ SvREFCNT_inc(GvCV(gv)); @@ -968,8 +971,42 @@ HV* stash; *buf = '('; /* A cooky: "(". */ strcpy(buf + 1, cp); - gv = gv_fetchmeth(stash, buf, strlen(buf), 0); /* fills the stash! */ - if(gv && (cv = GvCV(gv))) filled = 1; + DEBUG_o( deb("Checking overloading of `%s' in package `%.256s'\n", + cp, HvNAME(stash)) ); + gv = gv_fetchmeth(stash, buf, strlen(buf), -1); /* no filling stash! */ + if(gv && (cv = GvCV(gv))) { + char *name = buf; + if (GvNAMELEN(CvGV(cv)) == 3 && strEQ(GvNAME(CvGV(cv)), "nil") + && strEQ(HvNAME(GvSTASH(CvGV(cv))), "overload")) { + /* GvSV contains the name of the method. */ + GV *ngv; + + DEBUG_o( deb("Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n", + SvPV(GvSV(gv), na), cp, HvNAME(stash)) ); + if (SvPOK(GvSV(gv)) + && (ngv = gv_fetchmethod(stash, SvPVX(GvSV(gv))))) { + name = SvPVX(GvSV(gv)); + cv = GvCV(gv = ngv); + } else { + /* Can be an import stub (created by `can'). */ + if (GvCVGEN(gv)) { + croak("Stub found while resolving method `%.256s' overloading `%s' in package `%.256s'", + (SvPOK(GvSV(gv)) ? SvPVX(GvSV(gv)) : "???" ), + cp, HvNAME(stash)); + } else + croak("Cannot resolve method `%.256s' overloading `%s' in package `%.256s'", + (SvPOK(GvSV(gv)) ? SvPVX(GvSV(gv)) : "???" ), + cp, HvNAME(stash)); + } + /* If the sub is only a stub then we may have a gv to AUTOLOAD */ + gv = (GV*)*hv_fetch(GvSTASH(gv), name, strlen(name), TRUE); + cv = GvCV(gv); + } + DEBUG_o( deb("Overloading `%s' in package `%.256s' via `%.256s::%.256s' \n", + cp, HvNAME(stash), HvNAME(GvSTASH(CvGV(cv))), + GvNAME(CvGV(cv))) ); + filled = 1; + } #endif amt.table[i]=(CV*)SvREFCNT_inc(cv); } @@ -1255,7 +1292,7 @@ int flags; case dec_amg: SvSetSV(left,res); return left; case not_amg: -ans=!SvOK(res); break; + ans=!SvOK(res); break; } return ans? &sv_yes: &sv_no; } else if (method==copy_amg) { diff --git a/lib/overload.pm b/lib/overload.pm index ec874ec8d7..a07e91513e 100644 --- a/lib/overload.pm +++ b/lib/overload.pm @@ -14,7 +14,8 @@ sub OVERLOAD { } else { $sub = $arg{$_}; if (not ref $sub and $sub !~ /::/) { - $sub = "${'package'}::$sub"; + $ {$package . "::(" . $_} = $sub; + $sub = \&nil; } #print STDERR "Setting `$ {'package'}::\cO$_' to \\&`$sub'.\n"; *{$package . "::(" . $_} = \&{ $sub }; @@ -49,16 +50,28 @@ sub Overloaded { $package->can('()'); } +sub ov_method { + my $globref = shift; + return undef unless $globref; + my $sub = \&{*$globref}; + return $sub if $sub ne \&nil; + return shift->can($ {*$globref}); +} + sub OverloadedStringify { my $package = shift; $package = ref $package if ref $package; - $package->can('(""') + #$package->can('(""') + ov_method mycan($package, '(""'), $package; } sub Method { my $package = shift; $package = ref $package if ref $package; - $package->can('(' . shift) + #my $meth = $package->can('(' . shift); + ov_method mycan($package, '(' . shift), $package; + #return $meth if $meth ne \&nil; + #return $ {*{$meth}}; } sub AddrRef { @@ -76,6 +89,17 @@ sub StrVal { "$_[0]"; } +sub mycan { # Real can would leave stubs. + my ($package, $meth) = @_; + return \*{$package . "::$meth"} if defined &{$package . "::$meth"}; + my $p; + foreach $p (@{"${package}::ISA"}) { + my $out = mycan($p, $meth); + return $out if $out; + } + return undef; +} + 1; __END__ diff --git a/pod/perldiag.pod b/pod/perldiag.pod index fb0a2d76c0..ba7308f289 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1487,6 +1487,17 @@ will extend the buffer and zero pad the new area. (F) An attempt was made to use an entry in an overloading table that somehow no longer points to a valid method. See L. +=item Stub found while resolving method `%s' overloading `%s' in package `%s' + +(P) Overloading resolution over @ISA tree may be broken by importing stubs. +Stubs should never be implicitely created, but explicit calls to C +may break this. + +=item Cannot resolve method `%s' overloading `%s' in package `s' + +(P) Internal error trying to resolve overloading specified by a method +name (as opposed to a subroutine reference). + =item Operator or semicolon missing before %s (S) You used a variable or subroutine call where the parser was diff --git a/pp.c b/pp.c index e4e00ce948..8710b5418d 100644 --- a/pp.c +++ b/pp.c @@ -119,6 +119,8 @@ PP(pp_rv2gv) GvIOp(gv) = (IO *)sv; SvREFCNT_inc(sv); sv = (SV*) gv; + } else if (SvTYPE(sv) == SVt_PVCV) { + sv = (SV*) CvGV(sv); } else if (SvTYPE(sv) != SVt_PVGV) DIE("Not a GLOB reference"); } diff --git a/t/pragma/overload.t b/t/pragma/overload.t index 9c897c31dc..42d045741d 100755 --- a/t/pragma/overload.t +++ b/t/pragma/overload.t @@ -291,7 +291,7 @@ test($@ =~ /no method found/); # 96 sub { *{"Oscalar::$AUTOLOAD"} = sub {"_!_" . shift() . "_!_"} ; goto &{"Oscalar::$AUTOLOAD"}}; -eval "package Oscalar; use overload '~' => 'comple'"; +eval "package Oscalar; sub comple; use overload '~' => 'comple'"; $na = eval { ~$a }; # Hash was not updated test($@ =~ /no method found/); # 97 @@ -299,6 +299,7 @@ test($@ =~ /no method found/); # 97 bless \$x, Oscalar; $na = eval { ~$a }; # Hash updated +warn "`$na', $@" if $@; test !$@; # 98 test($na eq '_!_xx_!_'); # 99 @@ -315,7 +316,7 @@ print $@; test !$@; # 101 test($na eq '_!_xx_!_'); # 102 -eval "package Oscalar; use overload '>>' => 'rshft'"; +eval "package Oscalar; sub rshft; use overload '>>' => 'rshft'"; $na = eval { $aI >> 1 }; # Hash was not updated test($@ =~ /no method found/); # 103 @@ -330,6 +331,7 @@ print $@; test !$@; # 104 test($na eq '_!_xx_!_'); # 105 +# warn overload::Method($a, '0+'), "\n"; test (overload::Method($a, '0+') eq \&Oscalar::numify); # 106 test (overload::Method($aI,'0+') eq \&Oscalar::numify); # 107 test (overload::Overloaded($aI)); # 108 @@ -341,5 +343,21 @@ test (! defined overload::Method($a, '<')); # 111 test (overload::StrVal($aI) =~ /^OscalarI=SCALAR\(0x[\da-fA-F]+\)$/); # 112 test (overload::StrVal(\$aI) eq "@{[\$aI]}"); # 113 +# Check overloading by methods (specified deep in the ISA tree). +{ + package OscalarII; + @ISA = 'OscalarI'; + sub Oscalar::lshft {"_<<_" . shift() . "_<<_"} + eval "package OscalarI; use overload '<<' => 'lshft', '|' => 'lshft'"; +} + +$aaII = "087"; +$aII = \$aaII; +bless $aII, 'OscalarII'; +bless \$fake, 'OscalarI'; # update the hash +test(($aI | 3) eq '_<<_xx_<<_'); # 114 +# warn $aII << 3; +test(($aII << 3) eq '_<<_087_<<_'); # 115 + # Last test is: -sub last {113} +sub last {115} -- cgit v1.2.1 From 9a3e71f668bd84b1cf53dd3ea10f588d59ecfebb Mon Sep 17 00:00:00 2001 From: Ilya Zakharevich Date: Thu, 9 Jan 1997 17:02:16 -0500 Subject: Perl 5.003_20: OS/2 patches Chip Salzenberg writes: > > It's all become so routine: > > file: $CPAN/authors/id/CHIPS/perl5.003_20.pat.gz Below are latest os/2-related patches. **** Note the first chunk **** It shows that under OS/2 4-argument select was writing over memory (256 bites = 32 bytes) over what is typically 1-char malloc area. Since an exception of the general rule is needed on linux and OS/2, can we trust this rule at all? There may be zillions of obscure little-endian systems where select sets all the bytes it cares about instead of just the passed number. If one wants a Configure test for this, here is the skeleton: #include #include char buffer[81] = "01234567890123456789012345678901234567890123456789012345678901234567890123456789"; char buffer1[81] = "01234567890123456789012345678901234567890123456789012345678901234567890123456789"; int main (int argc, char* argv[], char* envp[]) { int i = 80; buffer[0] = 2; /* stdout */ select(8, NULL, (fd_set *)buffer, NULL, NULL); while (i > 0 && buffer1[i] == buffer[i]) i--; printf("%i bytes overwritten.\n", i+1); exit(0); } Enjoy, Ilya This patch does the following: a) substitutes BSD (s)random instead of broken EMX's one; b) removes rsignal from os2/os2.c since it it exported now; c) defines `register' to none if better debugging is deemed necessary. d) fixes broken pp_sselect. p5p-msgid: <199701101102.GAA19051@monk.mps.ohio-state.edu> --- hints/os2.sh | 4 +++- os2/Changes | 5 +++++ os2/os2.c | 16 ---------------- os2/os2ish.h | 7 +++++++ pp_sys.c | 2 +- 5 files changed, 16 insertions(+), 18 deletions(-) diff --git a/hints/os2.sh b/hints/os2.sh index 59087e3888..9bce2a594c 100644 --- a/hints/os2.sh +++ b/hints/os2.sh @@ -129,7 +129,9 @@ fi # [Maybe we should just remove c from $libswanted ?] -libs='-lsocket -lm' +# Test would pick up wrong rand, so we hardwire the value for random() +libs='-lsocket -lm -lbsd' +randbits=31 archobjs="os2$obj_ext dl_os2$obj_ext" # Run files without extension with sh: diff --git a/os2/Changes b/os2/Changes index 83af2d8893..902783295f 100644 --- a/os2/Changes +++ b/os2/Changes @@ -122,3 +122,8 @@ after 5.003_08: after 5.003_11: Functions emx_{malloc,realloc,calloc,free} are exported from DLL. get_sysinfo() bugs corrected (flags were not used and wrongly defined). + +after 5.003_20: + _isterm is substituted instead of isatty, s?random instead of srand. + `register' disabled if -DDEBUGGING and not AOUT build: stupid SD386. + 3-argument select() was stomping over memory. diff --git a/os2/os2.c b/os2/os2.c index c9d1e55f6c..701bb52a3c 100644 --- a/os2/os2.c +++ b/os2/os2.c @@ -158,22 +158,6 @@ getpriority(int which /* ignored */, int pid) /* spawn */ typedef void (*Sigfunc) _((int)); -static -Sigfunc rsignal(signo,handler) -int signo; -Sigfunc handler; -{ - struct sigaction act,oact; - - act.sa_handler = handler; - sigemptyset(&act.sa_mask); - act.sa_flags = 0; - if (sigaction(signo, &act, &oact) < 0) - return(SIG_ERR); - else - return(oact.sa_handler); -} - static int result(int flag, int pid) { diff --git a/os2/os2ish.h b/os2/os2ish.h index b2e1f66c78..44aee84152 100644 --- a/os2/os2ish.h +++ b/os2/os2ish.h @@ -99,6 +99,8 @@ char *my_tmpnam (char *); #define tmpfile my_tmpfile #define tmpnam my_tmpnam #define isatty _isterm +#define rand random +#define srand srandom /* * fwrite1() should be a routine with the same calling sequence as fwrite(), @@ -155,6 +157,11 @@ void *emx_realloc (void *, size_t); #endif +/* With SD386 it is impossible to debug register variables. */ +#if !defined(PERL_IS_AOUT) && defined(DEBUGGING) && !defined(register) +# define register +#endif + /* Our private OS/2 specific data. */ typedef struct OS2_Perl_data { diff --git a/pp_sys.c b/pp_sys.c index f24c8abf77..13e11b5adb 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -675,7 +675,7 @@ PP(pp_sselect) } #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 -#ifdef __linux__ +#if defined(__linux__) || defined(OS2) growsize = sizeof(fd_set); #else growsize = maxlen; /* little endians can use vecs directly */ -- cgit v1.2.1 From 8a1e91d771b51ae31eed1ac5944c63934213fb07 Mon Sep 17 00:00:00 2001 From: John Stoffel Date: Mon, 13 Jan 1997 04:42:50 -0500 Subject: Irix 6.3 & 6.4 and perl5.003_20 >>>>> "John" == John Stoffel writes: John> With a little bit of work I've gotten perl5.003_20 to compile John> and pass all tests under Irix 6.4 on an Origin2000 box. The John> trick is to realize that 'nm' output can't be parsed on this John> machine. Here's the hints file to use for _21 when it's John> released. Chip et al, I've also gotten it to compile and pass all tests under Irix 6.3 on an O2, but I had to make some additions. I've put both hints files below, which are the same except for the comments really, but in case they need any changes, they can be made pretty easily now. p5p-msgid: <199701132242.RAA14601@jfs.Fluent.COM> --- hints/irix_6_3.sh | 16 ++++++++++++++++ hints/irix_6_4.sh | 16 ++++++++++++++++ 2 files changed, 32 insertions(+) create mode 100644 hints/irix_6_3.sh create mode 100644 hints/irix_6_4.sh diff --git a/hints/irix_6_3.sh b/hints/irix_6_3.sh new file mode 100644 index 0000000000..11bd82ac38 --- /dev/null +++ b/hints/irix_6_3.sh @@ -0,0 +1,16 @@ +# hints/irix_6_3.sh +# +# Created by John Stoffel (jfs@fluent.com), 01/13/1997 +# Based on the Irix 6.2 hints file, but simplified. + +# Configure can't parse 'nm' output on Irix 6.3 +usenm='n' + +# This keeps optimizer warnings quiet. +ccflags="$ccflags -Olimit 3000" + +# Gets rid of some extra libs that don't seem to be really needed. +# See the Irix 6.2 hints file for some justifications. +set `echo X "$libswanted "|sed -e 's/ sun / /' -e 's/ crypt / /' -e 's/ bsd / /' -e 's/ PW / /' -e 's/ dl / /' -e 's/ socket / /' -e 's/ nsl / /'` +shift +libswanted="$*" diff --git a/hints/irix_6_4.sh b/hints/irix_6_4.sh new file mode 100644 index 0000000000..b5a994525a --- /dev/null +++ b/hints/irix_6_4.sh @@ -0,0 +1,16 @@ +# hints/irix_6_4.sh +# +# Created by John Stoffel (jfs@fluent.com), 01/13/1997 +# Based on the Irix 6.2 hints file, but simplified. + +# Configure can't parse 'nm' output on Irix 6.4 +usenm='n' + +# This keeps optimizer warnings quiet. +ccflags="$ccflags -Olimit 3000" + +# Gets rid of some extra libs that don't seem to be really needed. +# See the Irix 6.2 hints file for some justifications. +set `echo X "$libswanted "|sed -e 's/ sun / /' -e 's/ crypt / /' -e 's/ bsd / /' -e 's/ PW / /' -e 's/ dl / /' -e 's/ socket / /' -e 's/ nsl / /'` +shift +libswanted="$*" -- cgit v1.2.1 From 174150afa5efdafc0e94a18211d3c9aa06b15cd9 Mon Sep 17 00:00:00 2001 From: Ilya Zakharevich Date: Tue, 7 Jan 1997 07:56:02 -0500 Subject: Patch for Object subroutines The following script segfaults with _17 (): #!./perl my $x; BEGIN { $x = sub {print "in sub.\n"; undef $x}; sub X::DESTROY { print "Destroying.\n"} bless $x, 'X'; } # At this moment refcount of $x and &$x are 1 (we need a closure for this # because of a sub leak). &$x(); print "x: `$x'.\n"; --- cop.h | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cop.h b/cop.h index 543c039f85..20301ff4e0 100644 --- a/cop.h +++ b/cop.h @@ -46,6 +46,8 @@ struct block_sub { cx->blk_sub.dfoutgv = defoutgv; \ (void)SvREFCNT_inc(cx->blk_sub.dfoutgv) +/* We muck with cxstack_ix since _dec may call a DESTROY, overwriting cx. */ + #define POPSUB(cx) \ if (cx->blk_sub.hasargs) { /* put back old @_ */ \ GvAV(defgv) = cx->blk_sub.savearray; \ @@ -55,7 +57,9 @@ struct block_sub { if (cx->blk_sub.hasargs) { \ SvREFCNT_inc((SV*)cx->blk_sub.argarray); \ } \ + cxstack_ix++; \ SvREFCNT_dec((SV*)cx->blk_sub.cv); \ + cxstack_ix--; \ } \ } -- cgit v1.2.1 From a3270a1d7469cab9221ab0050a0e6695bd0047d8 Mon Sep 17 00:00:00 2001 From: Raphael Manfredi Date: Tue, 14 Jan 1997 22:16:28 +0100 Subject: Full documentation generation patch I propose the following patch for perl5.004. It automates the generation of the documentation and is derived from the pioneer work of Tom Christiansen, which was sub-documented, unfortunately. It allows one to run 'roffitall' to generate the full manual and table of contents, based on existing installed files only. Next step: automate the maintainance of the roffitall file list, or generate it automatically... Well, the current version should be OK for 5.004. --- pod/parsetoc | 66 +++++++++++++++ pod/roffitall | 251 +++++++++++++++++++++++++++++++++++++++------------------- 2 files changed, 234 insertions(+), 83 deletions(-) create mode 100644 pod/parsetoc diff --git a/pod/parsetoc b/pod/parsetoc new file mode 100644 index 0000000000..cbb80ee8cd --- /dev/null +++ b/pod/parsetoc @@ -0,0 +1,66 @@ +# feed this into perl + eval 'exec perl -S $0 ${1+"$@"}' + if $running_under_some_shell; + +# Usage: parsetoc PerlTOC.xxx.raw +# +# Post-processes roffitall output. Called from roffitall to produce +# a formatted table of contents. +# +# Author: Tom Christiansen + +print <<'EOF'; +.de NP +'.sp 0.8i +.tl ''- % -'' +'bp +'sp 0.5i +.tl ''\fB\s+2Perl Table of Contents\s0\fR'' +'sp 0.3i +.. +.wh -1i NP +.af % i +.sp 0.5i +.tl ''\fB\s+5Perl Table of Contents\s0\fR'' +.sp 0.5i +.nf +.na +EOF +while (<>) { + #chomp; + s/Index://; + ($type, $page, $desc) = split ' ', $_, 3; + $desc =~ s/^"(.*)"$/$1/; + if ($type eq 'Title') { + ($name = $desc) =~ s/ .*//; + next; + } elsif ($type eq 'Name') { + #print STDERR $page, "\t", $desc; + print ".ne 5\n"; + print ".in 0\n"; + print ".sp\n"; + print ".ft B\n"; + print "$desc\n"; + print ".ft P\n"; + print ".in 5n\n"; + } elsif ($type eq 'Header') { + print ".br\n", $page, "\t", $desc; + } elsif ($type eq 'Subsection') { + print ".br\n", $page, "\t\t", $desc; + } elsif ($type eq 'Item') { + next if $desc =~ /\\bu/; + next unless $name =~ /POSIX|func/i; + print ".br\n", $page, "\t\t\t", $desc; + } +} +__END__ +Index:Title 1 "PERL 1" +Index:Name 1 "perl - Practical Extraction and Report Language" +Index:Header 1 "NAME" +Index:Header 1 "SYNOPSIS" +Index:Header 2 "DESCRIPTION" +Index:Item 2 "\(bu Many usability enhancements" +Index:Item 2 "\(bu Simplified grammar" +Index:Item 2 "\(bu Lexical scoping" +Index:Item 2 "\(bu Arbitrarily nested data structures" +Index:Item 2 "\(bu Modularity and reusability" diff --git a/pod/roffitall b/pod/roffitall index 3df9386103..abc71a6dfa 100755 --- a/pod/roffitall +++ b/pod/roffitall @@ -1,86 +1,171 @@ #!/bin/sh -#psroff -t -man -rC1 -rD1 -rF1 > /tmp/PerlDoc.ps 2>/tmp/PerlTOC.raw \ -nroff -man -rC1 -rD1 -rF1 > /tmp/PerlDoc.txt 2>/tmp/PerlTOC.nr.raw \ - /usr/local/man/man1/perl.1 \ - /usr/local/man/man1/perlnews.1 \ - /usr/local/man/man1/perldata.1 \ - /usr/local/man/man1/perlsyn.1 \ - /usr/local/man/man1/perlop.1 \ - /usr/local/man/man1/perlre.1 \ - /usr/local/man/man1/perlrun.1 \ - /usr/local/man/man1/perllocale.1 \ - /usr/local/man/man1/perlfunc.1 \ - /usr/local/man/man1/perlvar.1 \ - /usr/local/man/man1/perlsub.1 \ - /usr/local/man/man1/perlmod.1 \ - /usr/local/man/man1/perlref.1 \ - /usr/local/man/man1/perldsc.1 \ - /usr/local/man/man1/perllol.1 \ - /usr/local/man/man1/perlobj.1 \ - /usr/local/man/man1/perltie.1 \ - /usr/local/man/man1/perlbot.1 \ - /usr/local/man/man1/perldebug.1 \ - /usr/local/man/man1/perldiag.1 \ - /usr/local/man/man1/perlform.1 \ - /usr/local/man/man1/perlipc.1 \ - /usr/local/man/man1/perlsec.1 \ - /usr/local/man/man1/perltrap.1 \ - /usr/local/man/man1/perlstyle.1 \ - /usr/local/man/man1/perlxs.1 \ - /usr/local/man/man1/perlxstut.1 \ - /usr/local/man/man1/perlguts.1 \ - /usr/local/man/man1/perlcall.1 \ - /usr/local/man/man1/perlembed.1 \ - /usr/local/man/man1/perlpod.1 \ - /usr/local/man/man1/perlbook.1 \ +# +# Usage: roffitall [-nroff|-psroff|-groff] +# +# Authors: Tom Christiansen, Raphael Manfredi + +me=roffitall +tmp=. + +#manroot=/usr/local +#libroot=/usr/local + +manroot=$HOME/usr +libroot=$HOME/usr/lib/perl5 + +case "$1" in +-nroff) cmd="nroff -man"; ext='txt';; +-psroff) cmd="psroff -t"; ext='ps';; +-groff) cmd="groff -man"; ext='ps';; +*) + echo "Usage: roffitall [-nroff|-psroff|-groff]" >&2 + exit 1 + ;; +esac + +toroff=` + echo \ + $manroot/man/man1/perl.1 \ + $manroot/man/man1/perlnews.1 \ + $manroot/man/man1/perldata.1 \ + $manroot/man/man1/perlsyn.1 \ + $manroot/man/man1/perlop.1 \ + $manroot/man/man1/perlre.1 \ + $manroot/man/man1/perlrun.1 \ + $manroot/man/man1/perllocale.1 \ + $manroot/man/man1/perlfunc.1 \ + $manroot/man/man1/perlvar.1 \ + $manroot/man/man1/perlsub.1 \ + $manroot/man/man1/perlmod.1 \ + $manroot/man/man1/perlref.1 \ + $manroot/man/man1/perldsc.1 \ + $manroot/man/man1/perllol.1 \ + $manroot/man/man1/perlobj.1 \ + $manroot/man/man1/perltie.1 \ + $manroot/man/man1/perlbot.1 \ + $manroot/man/man1/perldebug.1 \ + $manroot/man/man1/perldiag.1 \ + $manroot/man/man1/perlform.1 \ + $manroot/man/man1/perlipc.1 \ + $manroot/man/man1/perlsec.1 \ + $manroot/man/man1/perltrap.1 \ + $manroot/man/man1/perlstyle.1 \ + $manroot/man/man1/perlapio.1 \ + $manroot/man/man1/perlxs.1 \ + $manroot/man/man1/perlxstut.1 \ + $manroot/man/man1/perlguts.1 \ + $manroot/man/man1/perlcall.1 \ + $manroot/man/man1/perlembed.1 \ + $manroot/man/man1/perlpod.1 \ + $manroot/man/man1/perlbook.1 \ \ - /usr/local/man/man3/diagnostics.3 \ - /usr/local/man/man3/integer.3 \ - /usr/local/man/man3/less.3 \ - /usr/local/man/man3/lib.3 \ - /usr/local/man/man3/overload.3 \ - /usr/local/man/man3/sigtrap.3 \ - /usr/local/man/man3/strict.3 \ - /usr/local/man/man3/subs.3 \ + $libroot/man/man3/blib.3 \ + $libroot/man/man3/diagnostics.3 \ + $libroot/man/man3/integer.3 \ + $libroot/man/man3/less.3 \ + $libroot/man/man3/lib.3 \ + $libroot/man/man3/localle.3 \ + $libroot/man/man3/overload.3 \ + $libroot/man/man3/sigtrap.3 \ + $libroot/man/man3/strict.3 \ + $libroot/man/man3/subs.3 \ + $libroot/man/man3/vars.3 \ \ - /usr/local/man/man3/AnyDBM_File.3 \ - /usr/local/man/man3/AutoLoader.3 \ - /usr/local/man/man3/AutoSplit.3 \ - /usr/local/man/man3/Benchmark.3 \ - /usr/local/man/man3/Carp.3 \ - /usr/local/man/man3/Config.3 \ - /usr/local/man/man3/Cwd.3 \ - /usr/local/man/man3/DB_File.3 \ - /usr/local/man/man3/Devel::SelfStubber.3 \ - /usr/local/man/man3/DynaLoader.3 \ - /usr/local/man/man3/English.3 \ - /usr/local/man/man3/Env.3 \ - /usr/local/man/man3/Exporter.3 \ - /usr/local/man/man3/ExtUtils::Liblist.3 \ - /usr/local/man/man3/ExtUtils::MakeMaker.3 \ - /usr/local/man/man3/ExtUtils::Manifest.3 \ - /usr/local/man/man3/ExtUtils::Mkbootstrap.3 \ - /usr/local/man/man3/Fcntl.3 \ - /usr/local/man/man3/File::Basename.3 \ - /usr/local/man/man3/File::CheckTree.3 \ - /usr/local/man/man3/File::Find.3 \ - /usr/local/man/man3/FileHandle.3 \ - /usr/local/man/man3/File::Path.3 \ - /usr/local/man/man3/Getopt::Long.3 \ - /usr/local/man/man3/Getopt::Std.3 \ - /usr/local/man/man3/I18N::Collate.3 \ - /usr/local/man/man3/IPC::Open2.3 \ - /usr/local/man/man3/IPC::Open3.3 \ - /usr/local/man/man3/Net::Ping.3 \ - /usr/local/man/man3/POSIX.3 \ - /usr/local/man/man3/Safe.3 \ - /usr/local/man/man3/SelfLoader.3 \ - /usr/local/man/man3/Socket.3 \ - /usr/local/man/man3/Sys::Hostname.3 \ - /usr/local/man/man3/Term::Cap.3 \ - /usr/local/man/man3/Term::Complete.3 \ - /usr/local/man/man3/Test::Harness.3 \ - /usr/local/man/man3/Text::Abbrev.3 \ - /usr/local/man/man3/Text::Soundex.3 \ - /usr/local/man/man3/TieHash.3 \ - /usr/local/man/man3/Time::Local.3 + $libroot/man/man3/AnyDBM_File.3 \ + $libroot/man/man3/AutoLoader.3 \ + $libroot/man/man3/AutoSplit.3 \ + $libroot/man/man3/Benchmark.3 \ + $libroot/man/man3/Carp.3 \ + $libroot/man/man3/Config.3 \ + $libroot/man/man3/Cwd.3 \ + $libroot/man/man3/DB_File.3 \ + $libroot/man/man3/Devel::SelfStubber.3 \ + $libroot/man/man3/DynaLoader.3 \ + $libroot/man/man3/English.3 \ + $libroot/man/man3/Env.3 \ + $libroot/man/man3/Exporter.3 \ + $libroot/man/man3/ExtUtils::Embed.3 \ + $libroot/man/man3/ExtUtils::Install.3 \ + $libroot/man/man3/ExtUtils::Liblist.3 \ + $libroot/man/man3/ExtUtils::MakeMaker.3 \ + $libroot/man/man3/ExtUtils::Manifest.3 \ + $libroot/man/man3/ExtUtils::Mkbootstrap.3 \ + $libroot/man/man3/ExtUtils::Mksymlists.3 \ + $libroot/man/man3/Fatal.3 \ + $libroot/man/man3/Fcntl.3 \ + $libroot/man/man3/File::Basename.3 \ + $libroot/man/man3/File::CheckTree.3 \ + $libroot/man/man3/File::Copy.3 \ + $libroot/man/man3/File::Compare.3 \ + $libroot/man/man3/File::Find.3 \ + $libroot/man/man3/File::Path.3 \ + $libroot/man/man3/File::stat.3 \ + $libroot/man/man3/FileCache.3 \ + $libroot/man/man3/FileHandle.3 \ + $libroot/man/man3/FindBin.3 \ + $libroot/man/man3/Getopt::Long.3 \ + $libroot/man/man3/Getopt::Std.3 \ + $libroot/man/man3/I18N::Collate.3 \ + $libroot/man/man3/IO.3 \ + $libroot/man/man3/IO::File.3 \ + $libroot/man/man3/IO::Handle.3 \ + $libroot/man/man3/IO::Pipe.3 \ + $libroot/man/man3/IO::Seekable.3 \ + $libroot/man/man3/IO::Select.3 \ + $libroot/man/man3/IO::Socket.3 \ + $libroot/man/man3/IPC::Open2.3 \ + $libroot/man/man3/IPC::Open3.3 \ + $libroot/man/man3/Math::BigFloat.3 \ + $libroot/man/man3/Math::BigInt.3 \ + $libroot/man/man3/Math::Complex.3 \ + $libroot/man/man3/Net::Ping.3 \ + $libroot/man/man3/Net::hostent.3 \ + $libroot/man/man3/Net::netent.3 \ + $libroot/man/man3/Net::protoent.3 \ + $libroot/man/man3/Net::servent.3 \ + $libroot/man/man3/Opcode.3 \ + $libroot/man/man3/POSIX.3 \ + $libroot/man/man3/Pod::Text.3 \ + $libroot/man/man3/Safe.3 \ + $libroot/man/man3/Search::Dict.3 \ + $libroot/man/man3/SelectSaver.3 \ + $libroot/man/man3/SelfLoader.3 \ + $libroot/man/man3/Shell.3 \ + $libroot/man/man3/Socket.3 \ + $libroot/man/man3/Symbol.3 \ + $libroot/man/man3/Sys::Hostname.3 \ + $libroot/man/man3/Sys::Syslog.3 \ + $libroot/man/man3/Term::Cap.3 \ + $libroot/man/man3/Term::Complete.3 \ + $libroot/man/man3/Test::Harness.3 \ + $libroot/man/man3/Text::Abbrev.3 \ + $libroot/man/man3/Text::ParseWords.3 \ + $libroot/man/man3/Text::Soundex.3 \ + $libroot/man/man3/Text::Tabs.3 \ + $libroot/man/man3/Tie::Hash.3 \ + $libroot/man/man3/Tie::RefHash.3 \ + $libroot/man/man3/Tie::Scalar.3 \ + $libroot/man/man3/Tie::SubstrHash.3 \ + $libroot/man/man3/Time::Local.3 \ + $libroot/man/man3/Time::gmtime.3 \ + $libroot/man/man3/Time::localtime.3 \ + $libroot/man/man3/Time::tm.3 \ + $libroot/man/man3/UNIVERSAL.3 \ + $libroot/man/man3/User::grent.3 \ + $libroot/man/man3/User::pwent.3 | \ +perl -ne 'map { -r && print "$_ " } split'` + +#psroff -t -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.ps 2>$tmp/PerlTOC.raw +#nroff -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.txt 2>$tmp/PerlTOC.nr.raw + +run="$cmd -rC1 -rD1 -rF1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw" +echo "$me: running $run" +eval $run $toroff +echo "$me: parsing TOC" +./parsetoc $tmp/PerlTOC.$ext.raw > $tmp/PerlTOC.tmp.man +run="$cmd $tmp/PerlTOC.tmp.man >$tmp/PerlTOC.$ext" +echo "$me: running $run" +eval $run +rm -f $tmp/PerlTOC.tmp.man $tmp/PerlTOC.$ext.raw +echo "$me: leaving you with $tmp/PerlDoc.$ext and $tmp/PerlTOC.$ext" + -- cgit v1.2.1 From 74c80e585086695d5428ab316ca82fd6931aeabd Mon Sep 17 00:00:00 2001 From: "John Q. Linux" Date: Fri, 10 Jan 1997 19:47:16 -0800 Subject: Forbid ++ and -- on readonly values Subject: You can ++ and -- readonly integer scalars? (patch included) I managed to find an illustration of the bug in a perl one-liner: perl -e '*a = \100; $a++; print "$a\n"' 101 Perhaps that's been fixed in one of the beta releases which I'm not running; or perhaps I'm the only one who finds that slightly incorrect. If so, ignore the rest of this message. You can modify readonly scalars using any of the pre/post increment/decrement operators. Apparently, the only readonly checking is done for cases like '100++'. I managed to find the relevant code and add some SvREADONLY checks. It now dies on the inc/dec of readonly scalars with the appropriate nasty message. I just thought I'd share my patch. Ashley Winters p5p-msgid: --- pp.c | 6 ++++++ pp_hot.c | 2 ++ 2 files changed, 8 insertions(+) diff --git a/pp.c b/pp.c index 48e332198b..f4cdc2dd63 100644 --- a/pp.c +++ b/pp.c @@ -575,6 +575,8 @@ PP(pp_undef) PP(pp_predec) { dSP; + if (SvREADONLY(TOPs)) + croak(no_modify); if (SvIOK(TOPs)) { if (SvIVX(TOPs) == IV_MIN) { sv_setnv(TOPs, (double)SvIVX(TOPs) - 1.0); @@ -593,6 +595,8 @@ PP(pp_predec) PP(pp_postinc) { dSP; dTARGET; + if (SvREADONLY(TOPs)) + croak(no_modify); sv_setsv(TARG, TOPs); if (SvIOK(TOPs)) { if (SvIVX(TOPs) == IV_MAX) { @@ -615,6 +619,8 @@ PP(pp_postinc) PP(pp_postdec) { dSP; dTARGET; + if(SvREADONLY(TOPs)) + croak(no_modify); sv_setsv(TARG, TOPs); if (SvIOK(TOPs)) { if (SvIVX(TOPs) == IV_MIN) { diff --git a/pp_hot.c b/pp_hot.c index 150afe27f0..f1ee8f2c84 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -251,6 +251,8 @@ PP(pp_eq) PP(pp_preinc) { dSP; + if (SvREADONLY(TOPs)) + croak(no_modify); if (SvIOK(TOPs)) { if (SvIVX(TOPs) == IV_MAX) { sv_setnv(TOPs, (double)(SvIVX(TOPs)) + 1.0 ); -- cgit v1.2.1