home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
perl501m.zip
/
patches
/
patch.1l
< prev
next >
Wrap
Text File
|
1995-06-06
|
21KB
|
819 lines
# This is my patch patch.1l for perl5.001. See description below.
# Andy Dougherty doughera@lafcol.lafayette.edu
#
# Please execute the following commands before applying this patch.
# (You can feed this patch to 'sh' to do so.)
# This hint file works for NeXT 3.2 or 3.3.
mv hints/next_3_2.sh hints/next_3.sh
exit
This is my patch patch.1l for perl5.001.
To apply, change to your perl directory, run the command above, then
apply with
patch -p1 -N < thispatch.
This patch fixes all the Configure & build problems for which I have a
solution.
After you apply this patch, I would recommend:
make distclean # or at the very least rm config.sh
sh Configure [whatever options you use]
make depend
make
make test
Patch and enjoy,
Andy Dougherty doughera@lafcol.lafayette.edu
Dept. of Physics
Lafayette College, Easton PA 18042
Here are the file-by-file contents:
Changes.Conf
Updated a bit.
Configure
Now honors hints on <pwd.h>-related things (for CX/UX, in particular).
Now honors previous values of d_stdio_ptr_lval and d_stdio_cnt_lval.
DB test programs now conditionally include 'const'.
MANIFEST
Updated.
config_H
Updated.
config_h.SH
Include trailing /**/ on STDIO_..._LVALUE defines.
hints/cxux.sh
Simplified.
Include info about failing test.
hints/epix.sh
A guess at a dynamic loading fix.
hints/next_3.sh
Add a few comments.
lib/Benchmark.pm
Ensure numeric context on number of loop iterations.
op.c
Spider's padlex and goto &$nonesuch patches.
perl.c
fputs("\tUnofficial patchlevel 1l.\n",stdout);
pp_ctl.c
pp_hot.c
scope.c
Spider's padlex and goto &$nonesuch patches.
Index: Changes.Conf
*** perl5.001k/Changes.Conf Thu May 25 15:34:26 1995
--- perl5.001l/Changes.Conf Tue Jun 6 13:23:58 1995
***************
*** 22,27 ****
--- 22,43 ----
Many hint file updates.
+ Upgrade Traps and Pitfalls:
+
+ Since a lot has changed in the build process, you are probably best off
+ starting with a fresh copy of the perl5.002 sources. In particular,
+ your 5.000 or 5.001 config.sh will contain several variables that are no
+ longer needed. Further, improvements in the Configure tests may mean
+ that some of the answers will be different than they were in previous
+ versions, and which answer to keep can be difficult to sort out.
+ Therefore, you are probably better off ignoring your old config.sh, as
+ in the following:
+
+ make distclean # (if you've built perl before)
+ sh Configure [whatever options you like]
+ make depend
+ make
+ make test
-------------
Version 5.001
***************
*** 120,131 ****
make test
<mv old architecture-dependent library to new location, if needed>
make install
-
-
-
-
-
-
-
-
--- 136,139 ----
Index: Configure
Prereq: 3.0.1.7
*** perl5.001k/Configure Mon Jun 5 12:23:03 1995
--- perl5.001l/Configure Tue Jun 6 12:29:51 1995
***************
*** 20,26 ****
# $Id: Head.U,v 3.0.1.7 1995/03/21 08:46:15 ram Exp $
#
! # Generated on Mon Jun 5 12:18:53 EDT 1995 [metaconfig 3.0 PL55]
cat >/tmp/c1$$ <<EOF
ARGGGHHHH!!!!!
--- 20,26 ----
# $Id: Head.U,v 3.0.1.7 1995/03/21 08:46:15 ram Exp $
#
! # Generated on Tue Jun 6 12:25:20 EDT 1995 [metaconfig 3.0 PL55]
cat >/tmp/c1$$ <<EOF
ARGGGHHHH!!!!!
***************
*** 5180,5233 ****
set pipe d_pipe
eval $inlibc
! : see if this is a pwd system
! echo " "
! xxx=`./findhdr pwd.h`
! if $test "$xxx"; then
! i_pwd="$define"
! echo "<pwd.h> found." >&4
$cppstdin $cppflags $cppminus < $xxx >$$.h
if $contains 'pw_quota' $$.h >/dev/null 2>&1; then
! d_pwquota="$define"
else
! d_pwquota="$undef"
fi
if $contains 'pw_age' $$.h >/dev/null 2>&1; then
! d_pwage="$define"
else
! d_pwage="$undef"
fi
if $contains 'pw_change' $$.h >/dev/null 2>&1; then
! d_pwchange="$define"
else
! d_pwchange="$undef"
fi
if $contains 'pw_class' $$.h >/dev/null 2>&1; then
! d_pwclass="$define"
else
! d_pwclass="$undef"
fi
if $contains 'pw_expire' $$.h >/dev/null 2>&1; then
! d_pwexpire="$define"
else
! d_pwexpire="$undef"
fi
if $contains 'pw_comment' $$.h >/dev/null 2>&1; then
! d_pwcomment="$define"
else
! d_pwcomment="$undef"
fi
$rm -f $$.h
! else
! i_pwd="$undef"
! d_pwquota="$undef"
! d_pwage="$undef"
! d_pwchange="$undef"
! d_pwclass="$undef"
! d_pwexpire="$undef"
! d_pwcomment="$undef"
! echo "<pwd.h> NOT found." >&4
! fi
: see if readdir and friends exist
set readdir d_readdir
--- 5180,5254 ----
set pipe d_pipe
eval $inlibc
! : see if this is a pwd.h system
! set pwd.h i_pwd
! eval $inhdr
!
! case "$i_pwd" in
! $define)
! xxx=`./findhdr pwd.h`
$cppstdin $cppflags $cppminus < $xxx >$$.h
+
if $contains 'pw_quota' $$.h >/dev/null 2>&1; then
! val="$define"
else
! val="$undef"
fi
+ set d_pwquota
+ eval $setvar
+
if $contains 'pw_age' $$.h >/dev/null 2>&1; then
! val="$define"
else
! val="$undef"
fi
+ set d_pwage
+ eval $setvar
+
if $contains 'pw_change' $$.h >/dev/null 2>&1; then
! val="$define"
else
! val="$undef"
fi
+ set d_pwchange
+ eval $setvar
+
if $contains 'pw_class' $$.h >/dev/null 2>&1; then
! val="$define"
else
! val="$undef"
fi
+ set d_pwclass
+ eval $setvar
+
if $contains 'pw_expire' $$.h >/dev/null 2>&1; then
! val="$define"
else
! val="$undef"
fi
+ set d_pwexpire
+ eval $setvar
+
if $contains 'pw_comment' $$.h >/dev/null 2>&1; then
! val="$define"
else
! val="$undef"
fi
+ set d_pwcomment
+ eval $setvar
+
$rm -f $$.h
! ;;
! *)
! val="$undef";
! set d_pwquota; eval $setvar
! set d_pwage; eval $setvar
! set d_pwchange; eval $setvar
! set d_pwclass; eval $setvar
! set d_pwexpire; eval $setvar
! set d_pwcomment; eval $setvar
! ;;
! esac
: see if readdir and friends exist
set readdir d_readdir
***************
*** 5615,5625 ****
--- 5636,5650 ----
'') stdio_ptr='((fp)->_IO_read_ptr)'
ptr_lval=$define
;;
+ *) ptr_lval=$d_stdio_ptr_lval
+ ;;
esac
case "$stdio_cnt" in
'') stdio_cnt='((fp)->_IO_read_end - (fp)->_IO_read_ptr)'
cnt_lval=$undef
;;
+ *) cnt_lval=$d_stdio_cnt_lval
+ ;;
esac
case "$stdio_base" in
'') stdio_base='((fp)->_IO_read_base)';;
***************
*** 5632,5642 ****
--- 5657,5671 ----
'') stdio_ptr='((fp)->_ptr)'
ptr_lval=$define
;;
+ *) ptr_lval=$d_stdio_ptr_lval
+ ;;
esac
case "$stdio_cnt" in
'') stdio_cnt='((fp)->_cnt)'
cnt_lval=$define
;;
+ *) cnt_lval=$d_stdio_cnt_lval
+ ;;
esac
case "$stdio_base" in
'') stdio_base='((fp)->_base)';;
***************
*** 6384,6394 ****
: Check the return type needed for hash
echo " "
echo "Checking return type needed for hash for Berkeley DB ..." >&4
! $cat >try.c <<'EOCP'
#include <sys/types.h>
#include <db.h>
u_int32_t hash_cb (ptr, size)
! void *ptr;
size_t size;
{
}
--- 6413,6427 ----
: Check the return type needed for hash
echo " "
echo "Checking return type needed for hash for Berkeley DB ..." >&4
! $cat >try.c <<EOCP
! #$d_const HASCONST
! #ifndef HASCONST
! #define const
! #endif
#include <sys/types.h>
#include <db.h>
u_int32_t hash_cb (ptr, size)
! const void *ptr;
size_t size;
{
}
***************
*** 6420,6431 ****
: Check the return type needed for prefix
echo " "
echo "Checking return type needed for prefix for Berkeley DB ..." >&4
! cat >try.c <<'EOCP'
#include <sys/types.h>
#include <db.h>
size_t prefix_cb (key1, key2)
! DBT *key1;
! DBT *key2;
{
}
BTREEINFO info;
--- 6453,6468 ----
: Check the return type needed for prefix
echo " "
echo "Checking return type needed for prefix for Berkeley DB ..." >&4
! cat >try.c <<EOCP
! #$d_const HASCONST
! #ifndef HASCONST
! #define const
! #endif
#include <sys/types.h>
#include <db.h>
size_t prefix_cb (key1, key2)
! const DBT *key1;
! const DBT *key2;
{
}
BTREEINFO info;
Index: MANIFEST
*** perl5.001k/MANIFEST Tue Jun 6 14:17:58 1995
--- perl5.001l/MANIFEST Tue Jun 6 14:07:25 1995
***************
*** 209,216 ****
hints/mpeix.sh Hints for named architecture
hints/ncr_tower.sh Hints for named architecture
hints/netbsd.sh Hints for named architecture
hints/next_3_0.sh Hints for named architecture
- hints/next_3_2.sh Hints for named architecture
hints/opus.sh Hints for named architecture
hints/powerunix.sh Hints for named architecture
hints/sco_2_3_0.sh Hints for named architecture
--- 209,216 ----
hints/mpeix.sh Hints for named architecture
hints/ncr_tower.sh Hints for named architecture
hints/netbsd.sh Hints for named architecture
+ hints/next_3.sh Hints for named architecture
hints/next_3_0.sh Hints for named architecture
hints/opus.sh Hints for named architecture
hints/powerunix.sh Hints for named architecture
hints/sco_2_3_0.sh Hints for named architecture
Index: config_H
Prereq: 3.0.1.3
*** perl5.001k/config_H Mon Jun 5 12:19:31 1995
--- perl5.001l/config_H Tue Jun 6 13:16:32 1995
***************
*** 14,20 ****
* $Id: Config_h.U,v 3.0.1.3 1995/01/30 14:25:39 ram Exp $
*/
! /* Configuration time: Fri Jun 2 14:50:10 EDT 1995
* Configured by: andy
* Target system: crystal crystal 3.2 2 i386
*/
--- 14,20 ----
* $Id: Config_h.U,v 3.0.1.3 1995/01/30 14:25:39 ram Exp $
*/
! /* Configuration time: Tue Jun 6 12:34:26 EDT 1995
* Configured by: andy
* Target system: crystal crystal 3.2 2 i386
*/
***************
*** 773,781 ****
*/
#ifdef USE_STDIO_PTR
#define FILE_ptr(fp) ((fp)->_ptr)
! #define STDIO_PTR_LVALUE
#define FILE_cnt(fp) ((fp)->_cnt)
! #define STDIO_CNT_LVALUE
#endif
/* FILE_base:
--- 773,781 ----
*/
#ifdef USE_STDIO_PTR
#define FILE_ptr(fp) ((fp)->_ptr)
! #define STDIO_PTR_LVALUE /**/
#define FILE_cnt(fp) ((fp)->_cnt)
! #define STDIO_CNT_LVALUE /**/
#endif
/* FILE_base:
Index: config_h.SH
Prereq: 3.0.1.3
*** perl5.001k/config_h.SH Mon Jun 5 12:23:03 1995
--- perl5.001l/config_h.SH Tue Jun 6 12:29:51 1995
***************
*** 787,795 ****
*/
#ifdef USE_STDIO_PTR
#define FILE_ptr(fp) $stdio_ptr
! #$d_stdio_ptr_lval STDIO_PTR_LVALUE
#define FILE_cnt(fp) $stdio_cnt
! #$d_stdio_cnt_lval STDIO_CNT_LVALUE
#endif
/* FILE_base:
--- 787,795 ----
*/
#ifdef USE_STDIO_PTR
#define FILE_ptr(fp) $stdio_ptr
! #$d_stdio_ptr_lval STDIO_PTR_LVALUE /**/
#define FILE_cnt(fp) $stdio_cnt
! #$d_stdio_cnt_lval STDIO_CNT_LVALUE /**/
#endif
/* FILE_base:
Index: hints/cxux.sh
*** perl5.001k/hints/cxux.sh Wed May 31 09:15:30 1995
--- perl5.001l/hints/cxux.sh Tue Jun 6 11:41:36 1995
***************
*** 75,104 ****
lddlflags='-Zlink=so'
# Configure imagines that it sees a pw_quota field, but it is really in a
! # different structure than the one it thinks it is looking at. WARNING:
! # Setting this here in the hints file doesn't help. You need to fix this by
! # editing config.sh after Configure asks you to fix things with a shell
! # escape! (Maybe Configure should actually try to compile a routine to
! # test each field, but what a pain that would be...).
! #
! # Perhaps I should create a config.over file and add this to it now?
! #
d_pwquota='undef'
- echo ''
- echo ''
- echo WARNING: Edit config.sh when Configure offers to let you do so at the
- echo end of the configuration process and manually change d_pwquota from
- echo define to undef \(or you may want to create a config.over file now\).
- echo ''
- echo ''
-
- # The following silly shell variable is set just so it will be printed out
- # immediately prior to asking the user to edit config.sh :-).
- #
- dont_forget_to_fix_d_pwquota_in_config_to_be_undef="really"
!
! # Configure sometime finds what it believes to be ndbm header files on the
# system and imagines that we have the NDBM library, but we really don't.
# There is something there that once resembled ndbm, but it is purely
# for internal use in some tool and has been hacked beyond recognition
--- 75,84 ----
lddlflags='-Zlink=so'
# Configure imagines that it sees a pw_quota field, but it is really in a
! # different structure than the one it thinks it is looking at.
d_pwquota='undef'
! # Configure sometimes finds what it believes to be ndbm header files on the
# system and imagines that we have the NDBM library, but we really don't.
# There is something there that once resembled ndbm, but it is purely
# for internal use in some tool and has been hacked beyond recognition
***************
*** 110,112 ****
--- 90,101 ----
#
d_mymalloc='undef'
usemymalloc='n'
+
+ cat <<'EOM'
+
+ You will get a failure on lib/posix.t test 16 because ungetc() on
+ stdin does not work if no characters have been read from stdin.
+ If you type a character at the terminal where you are running
+ the tests, you can fool it into thinking it worked.
+
+ EOM
Index: hints/epix.sh
*** perl5.001k/hints/epix.sh Wed May 31 11:59:28 1995
--- perl5.001l/hints/epix.sh Mon Jun 5 17:01:13 1995
***************
*** 61,66 ****
--- 61,68 ----
fi
lddlflags="-G $ldflags" # Probably needed for dynamic loading
+ # We _do_ want the -L paths in ldflags, but we don't want the -non_shared.
+ lddlflags=`echo $lddlflags | sed 's/-non_shared//'`
cat <<'EOM' >&4
Index: hints/next_3.sh
*** perl5.001k/hints/next_3.sh Mon Apr 10 10:14:22 1995
--- perl5.001l/hints/next_3.sh Tue Jun 6 14:06:24 1995
***************
*** 1,6 ****
--- 1,10 ----
# This file has been put together by Anno Siegel <siegel@zrz.TU-Berlin.DE>
# and Andreas Koenig <k@franz.ww.TU-Berlin.DE>. Comments, questions, and
# improvements welcome!
+ #
+ # These hints work for NeXT 3.2 and 3.3. 3.0 has it's own
+ # special hint file.
+
ccflags='-DUSE_NEXT_CTYPE'
POSIX_cflags='ccflags="-posix $ccflags"'
ldflags='-u libsys_s'
***************
*** 35,38 ****
if [ `arch` = "hppa" ]; then
pp_cflags='optimize="-g"'
fi
-
--- 39,41 ----
Index: lib/Benchmark.pm
*** perl5.001k/lib/Benchmark.pm Thu May 25 11:15:48 1995
--- perl5.001l/lib/Benchmark.pm Tue Jun 6 12:20:18 1995
***************
*** 242,247 ****
--- 242,248 ----
# Last updated: Sept 8th 94 by Tim Bunce
#
+ use Carp;
use Exporter;
@ISA=(Exporter);
@EXPORT=qw(timeit timethis timethese timediff timestr);
***************
*** 315,320 ****
--- 316,325 ----
sub runloop {
my($n, $c) = @_;
+
+ $n+=0; # force numeric now, so garbage won't creep into the eval
+ croak "negativ loopcount $n" if $n<0;
+ confess "Usage: runloop(number, string)" unless defined $c;
my($t0, $t1, $td); # before, after, difference
# find package of caller so we can execute code there
***************
*** 326,332 ****
my $subcode = "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }";
my $subref = eval $subcode;
! die "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
print STDERR "runloop $n '$subcode'\n" if ($debug);
$t0 = &new;
--- 331,337 ----
my $subcode = "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }";
my $subref = eval $subcode;
! croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
print STDERR "runloop $n '$subcode'\n" if ($debug);
$t0 = &new;
Index: op.c
*** perl5.001k/op.c Wed Mar 15 09:29:47 1995
--- perl5.001l/op.c Tue Jun 6 12:18:47 1995
***************
*** 2627,2633 ****
SAVESPTR(curpad);
curpad = 0;
! if (!SvFLAGS(cv) & SVpcv_CLONED)
op_free(CvROOT(cv));
CvROOT(cv) = Nullop;
if (CvPADLIST(cv)) {
--- 2627,2633 ----
SAVESPTR(curpad);
curpad = 0;
! if (!(SvFLAGS(cv) & SVpcv_CLONED))
op_free(CvROOT(cv));
CvROOT(cv) = Nullop;
if (CvPADLIST(cv)) {
***************
*** 2761,2766 ****
--- 2761,2767 ----
CvOUTSIDE(cv) = CvOUTSIDE(compcv);
CvOUTSIDE(compcv) = 0;
CvPADLIST(cv) = CvPADLIST(compcv);
+ CvPADLIST(compcv) = 0;
SvREFCNT_dec(compcv);
}
else {
Index: perl.c
*** perl5.001k/perl.c Thu Jun 1 11:38:05 1995
--- perl5.001l/perl.c Tue Jun 6 14:41:07 1995
***************
*** 996,1002 ****
return s;
case 'v':
printf("\nThis is perl, version %s\n\n",patchlevel);
! fputs("\tUnofficial patchlevel 1j.\n",stdout);
fputs("\nCopyright 1987-1994, Larry Wall\n",stdout);
#ifdef MSDOS
fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n",
--- 996,1002 ----
return s;
case 'v':
printf("\nThis is perl, version %s\n\n",patchlevel);
! fputs("\tUnofficial patchlevel 1l.\n",stdout);
fputs("\nCopyright 1987-1994, Larry Wall\n",stdout);
#ifdef MSDOS
fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n",
Index: pp_ctl.c
*** perl5.001k/pp_ctl.c Wed May 24 11:48:36 1995
--- perl5.001l/pp_ctl.c Tue Jun 6 12:18:48 1995
***************
*** 1533,1538 ****
--- 1533,1547 ----
I32 items = 0;
I32 oldsave;
+ if (!CvROOT(cv) && !CvXSUB(cv)) {
+ if (CvGV(cv)) {
+ SV *tmpstr = sv_newmortal();
+ gv_efullname(tmpstr, CvGV(cv));
+ DIE("Goto undefined subroutine &%s",SvPVX(tmpstr));
+ }
+ DIE("Goto undefined subroutine");
+ }
+
/* First do some returnish stuff. */
cxix = dopoptosub(cxstack_ix);
if (cxix < 0)
***************
*** 1591,1597 ****
GvENAME(CvGV(cv)));
if (CvDEPTH(cv) > AvFILL(padlist)) {
AV *newpad = newAV();
! AV *oldpad = (AV*)AvARRAY(svp[CvDEPTH(cv)-1]);
I32 ix = AvFILL((AV*)svp[1]);
svp = AvARRAY(svp[0]);
for ( ;ix > 0; ix--) {
--- 1600,1606 ----
GvENAME(CvGV(cv)));
if (CvDEPTH(cv) > AvFILL(padlist)) {
AV *newpad = newAV();
! SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
I32 ix = AvFILL((AV*)svp[1]);
svp = AvARRAY(svp[0]);
for ( ;ix > 0; ix--) {
***************
*** 1600,1606 ****
if (SvFLAGS(svp[ix]) & SVf_FAKE) {
/* outer lexical? */
av_store(newpad, ix,
! SvREFCNT_inc(AvARRAY(oldpad)[ix]) );
}
else { /* our own lexical */
if (*name == '@')
--- 1609,1615 ----
if (SvFLAGS(svp[ix]) & SVf_FAKE) {
/* outer lexical? */
av_store(newpad, ix,
! SvREFCNT_inc(oldpad[ix]) );
}
else { /* our own lexical */
if (*name == '@')
Index: pp_hot.c
*** perl5.001k/pp_hot.c Thu May 25 14:27:29 1995
--- perl5.001l/pp_hot.c Tue Jun 6 12:18:49 1995
***************
*** 1687,1693 ****
if (CvDEPTH(cv) > AvFILL(padlist)) {
AV *av;
AV *newpad = newAV();
! AV *oldpad = (AV*)AvARRAY(svp[CvDEPTH(cv)-1]);
I32 ix = AvFILL((AV*)svp[1]);
svp = AvARRAY(svp[0]);
for ( ;ix > 0; ix--) {
--- 1687,1693 ----
if (CvDEPTH(cv) > AvFILL(padlist)) {
AV *av;
AV *newpad = newAV();
! SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
I32 ix = AvFILL((AV*)svp[1]);
svp = AvARRAY(svp[0]);
for ( ;ix > 0; ix--) {
***************
*** 1695,1701 ****
char *name = SvPVX(svp[ix]);
if (SvFLAGS(svp[ix]) & SVf_FAKE) { /* outer lexical? */
av_store(newpad, ix,
! SvREFCNT_inc(AvARRAY(oldpad)[ix]) );
}
else { /* our own lexical */
if (*name == '@')
--- 1695,1701 ----
char *name = SvPVX(svp[ix]);
if (SvFLAGS(svp[ix]) & SVf_FAKE) { /* outer lexical? */
av_store(newpad, ix,
! SvREFCNT_inc(oldpad[ix]) );
}
else { /* our own lexical */
if (*name == '@')
Index: scope.c
*** perl5.001k/scope.c Tue Jan 17 15:50:19 1995
--- perl5.001l/scope.c Tue Jun 6 12:18:49 1995
***************
*** 276,282 ****
IV *ivp;
{
SSCHECK(3);
! SSPUSHINT(*ivp);
SSPUSHPTR(ivp);
SSPUSHINT(SAVEt_IV);
}
--- 276,282 ----
IV *ivp;
{
SSCHECK(3);
! SSPUSHIV(*ivp);
SSPUSHPTR(ivp);
SSPUSHINT(SAVEt_IV);
}
***************
*** 365,371 ****
SV** svp;
{
SSCHECK(2);
! SSPUSHPTR(svp);
SSPUSHINT(SAVEt_CLEARSV);
}
--- 365,371 ----
SV** svp;
{
SSCHECK(2);
! SSPUSHLONG((long)(svp-curpad));
SSPUSHINT(SAVEt_CLEARSV);
}
***************
*** 540,546 ****
Safefree((char*)ptr);
break;
case SAVEt_CLEARSV:
! ptr = SSPOPPTR;
sv = *(SV**)ptr;
if (SvREFCNT(sv) <= 1) { /* Can clear pad variable in place. */
if (SvTHINKFIRST(sv)) {
--- 540,546 ----
Safefree((char*)ptr);
break;
case SAVEt_CLEARSV:
! ptr = (void*)&curpad[SSPOPLONG];
sv = *(SV**)ptr;
if (SvREFCNT(sv) <= 1) { /* Can clear pad variable in place. */
if (SvTHINKFIRST(sv)) {
***************
*** 573,584 ****
--- 573,586 ----
}
}
else { /* Someone has a claim on this, so abandon it. */
+ U32 padflags = SvFLAGS(sv) & (SVs_PADBUSY|SVs_PADMY|SVs_PADTMP);
SvREFCNT_dec(sv); /* Cast current value to the winds. */
switch (SvTYPE(sv)) { /* Console ourselves with a new value */
case SVt_PVAV: *(SV**)ptr = (SV*)newAV(); break;
case SVt_PVHV: *(SV**)ptr = (SV*)newHV(); break;
default: *(SV**)ptr = NEWSV(0,0); break;
}
+ SvFLAGS(*(SV**)ptr) |= padflags; /* preserve pad nature */
}
break;
case SAVEt_DELETE:
End of patch.