From: Nick Ing-Simmons Date: Thu, 30 May 2002 06:45:56 +0000 (+0000) Subject: Integrate all but lib/File/stat.t which seems broken. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=51077201bf64ca460983010aa8b90b2241c04094;p=p5sagit%2Fp5-mst-13.2.git Integrate all but lib/File/stat.t which seems broken. p4raw-id: //depot/perlio@16871 --- diff --git a/Changes b/Changes index d6ff1d9..2653f6d 100644 --- a/Changes +++ b/Changes @@ -28,6 +28,263 @@ example from http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/ Version v5.7.X Development release working toward v5.8 -------------- ____________________________________________________________________________ +[ 16859] By: jhi on 2002/05/29 13:25:31 + Log: Spelling bee. + Branch: perl + ! t/op/tie.t +____________________________________________________________________________ +[ 16858] By: jhi on 2002/05/29 13:21:58 + Log: Recover some of the #16845. + Branch: perl + ! sv.c t/op/tie.t t/run/fresh_perl.t +____________________________________________________________________________ +[ 16857] By: jhi on 2002/05/29 12:47:02 + Log: Retract #16855 until settled. + Branch: perl + ! utfebcdic.h +____________________________________________________________________________ +[ 16856] By: jhi on 2002/05/29 12:31:35 + Log: OS/2: more missing definitions. + Branch: perl + ! os2/os2ish.h +____________________________________________________________________________ +[ 16855] By: jhi on 2002/05/29 12:28:17 + Log: Subject: UTF-EBCDIC for POSIX-BC (Malformed UTF-8 character) + From: "Roca Carrio, Ignasi (PO EP)" + Date: Wed, 29 May 2002 13:16:16 +0200 + Message-ID: <318B95F90D8BD41194A5009027FD5FFBCE6CED@madrid14.mad.fsc.net> + Branch: perl + ! utfebcdic.h +____________________________________________________________________________ +[ 16854] By: jhi on 2002/05/29 12:16:08 + Log: PPPort: fix up SvPVbyte if in 5.6.1 (borrowed from Digest::MD5) + Branch: perl + ! ext/Devel/PPPort/PPPort.pm +____________________________________________________________________________ +[ 16853] By: jhi on 2002/05/29 11:58:43 + Log: Subject: Re: [PATCHES] Re: libwin32 on Cygwin? + From: "Gerrit P. Haase" + Date: Wed, 29 May 2002 08:06:43 +0200 + Message-ID: <1881715214417.20020529080643@familiehaase.de> + Branch: perl + ! perl.h +____________________________________________________________________________ +[ 16852] By: jhi on 2002/05/29 11:53:12 + Log: OS/2: more missing headers from John Poltorak. + Branch: perl + ! os2/os2ish.h +____________________________________________________________________________ +[ 16851] By: jhi on 2002/05/29 11:48:35 + Log: Subject: Re: forewarning: usedevel and versiononly + From: "H.Merijn Brand" + Date: Wed, 29 May 2002 09:41:23 +0200 + Message-Id: <20020529081515.D570.H.M.BRAND@hccnet.nl> + + More 5.7.3 -> 5.8.0. + Branch: perl + ! cygwin/perlld.in epoc/createpkg.pl ext/Encode/bin/enc2xs + ! ext/Encode/bin/piconv lib/ExtUtils/MM_NW5.pm +____________________________________________________________________________ +[ 16850] By: ams on 2002/05/29 06:48:19 + Log: Lots of spring cleaning. (No functional changes.) + Branch: perl + ! ext/Storable/ChangeLog ext/Storable/Makefile.PL + ! ext/Storable/README ext/Storable/Storable.pm + ! ext/Storable/Storable.xs ext/Storable/t/blessed.t + ! ext/Storable/t/canonical.t ext/Storable/t/compat06.t + ! ext/Storable/t/dclone.t ext/Storable/t/downgrade.t + ! ext/Storable/t/forgive.t ext/Storable/t/freeze.t + ! ext/Storable/t/lock.t ext/Storable/t/overload.t + ! ext/Storable/t/recurse.t ext/Storable/t/restrict.t + ! ext/Storable/t/retrieve.t ext/Storable/t/st-dump.pl + ! ext/Storable/t/store.t ext/Storable/t/tied.t + ! ext/Storable/t/tied_hook.t ext/Storable/t/tied_items.t + ! ext/Storable/t/utf8.t ext/Storable/t/utf8hash.t +____________________________________________________________________________ +[ 16849] By: jhi on 2002/05/29 01:16:23 + Log: pod cleanups. + Branch: perl + ! README.aix README.cygwin README.jp README.ko README.macos + ! README.tw pod/perl561delta.pod pod/perldelta.pod + ! pod/perlfaq4.pod pod/perlfaq5.pod pod/perlfunc.pod + ! pod/perlhack.pod pod/perlipc.pod pod/perlsub.pod + ! pod/perlthrtut.pod pod/perlunicode.pod pod/perluniintro.pod +____________________________________________________________________________ +[ 16848] By: jhi on 2002/05/29 00:44:59 + Log: Regen perltoc. + Branch: perl + ! pod/perltoc.pod +____________________________________________________________________________ +[ 16847] By: jhi on 2002/05/28 22:15:44 + Log: Subject: [PATCH] cross-compilation support for WinCE for non-core extensions + From: "Vadim Konovalov" + Date: Wed, 29 May 2002 02:48:15 +0400 + Message-ID: <000701c20699$c3684a30$c25cc3d9@vad> + Branch: perl + ! wince/Makefile.ce +____________________________________________________________________________ +[ 16846] By: jhi on 2002/05/28 22:10:51 + Log: Subject: [PATCH: perl@16826] small updates to DCL portions of perl kit + From: PPrymmer@factset.com + Date: Tue, 28 May 2002 18:34:55 -0400 + Message-ID: + Branch: perl + ! configure.com vms/genopt.com +____________________________________________________________________________ +[ 16845] By: jhi on 2002/05/28 22:05:55 + Log: Retract #16820, #16819, #16810, #16669, #16531, #16530, #16501 + to restore some level of sanity in the tied scalars can of worms. + Branch: perl + ! mg.c pp_sys.c sv.c t/op/tie.t t/run/fresh_perl.t +____________________________________________________________________________ +[ 16844] By: gsar on 2002/05/28 22:05:38 + Log: extension of change#16332: isolate signal diddling to the main + interpreter (fixes signal-related races, e.g. when multiple + threads run system()) + Branch: maint-5.6/perl + ! util.c +____________________________________________________________________________ +[ 16843] By: jhi on 2002/05/28 20:35:59 + Log: Bump the version numbers to five-eight-oh. + Branch: perl + ! Configure NetWare/Makefile NetWare/config_H.wc + ! Porting/config.sh Porting/config_H README.tru64 epoc/config.sh + ! patchlevel.h t/op/ver.t uconfig.h uconfig.sh utils/h2xs.PL + ! vos/config.alpha.h vos/config.ga.h win32/Makefile + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + ! win32/config_H.vc64 win32/makefile.mk wince/Makefile.ce + ! wince/config_H.ce +____________________________________________________________________________ +[ 16842] By: ams on 2002/05/28 19:34:27 + Log: Subject: Minor INSTALL patch + From: Andy Dougherty + Date: Tue, 28 May 2002 16:08:30 -0400 (EDT) + Message-Id: + Branch: perl + ! INSTALL +____________________________________________________________________________ +[ 16841] By: ams on 2002/05/28 19:01:22 + Log: Add integer.t to MANIFEST. + Branch: perl + ! ext/Storable/MANIFEST +____________________________________________________________________________ +[ 16840] By: jhi on 2002/05/28 17:49:08 + Log: Subject: [Encode] 1.74 released -- final for 5.8.0-RC1 + From: Dan Kogai + Date: Wed, 29 May 2002 03:43:57 +0900 + Message-Id: + Branch: perl + + ext/Encode/ucm/ctrl.ucm ext/Encode/ucm/null.ucm + ! MANIFEST ext/Encode/AUTHORS ext/Encode/Byte/Makefile.PL + ! ext/Encode/CN/Makefile.PL ext/Encode/Changes + ! ext/Encode/EBCDIC/Makefile.PL ext/Encode/Encode.pm + ! ext/Encode/Encode.xs ext/Encode/Encode/Makefile_PL.e2x + ! ext/Encode/JP/Makefile.PL ext/Encode/KR/Makefile.PL + ! ext/Encode/MANIFEST ext/Encode/Makefile.PL + ! ext/Encode/Symbol/Makefile.PL ext/Encode/TW/Makefile.PL + ! ext/Encode/bin/enc2xs ext/Encode/lib/Encode/Supported.pod + ! ext/Encode/t/mime-header.t +____________________________________________________________________________ +[ 16839] By: jhi on 2002/05/28 17:18:28 + Log: OS/2: bug found by John Poltorak. + Branch: perl + ! lib/ExtUtils/MM_OS2.pm +____________________________________________________________________________ +[ 16838] By: gsar on 2002/05/28 14:14:29 + Log: makefiles should not clobber lib/Thread directory (some Thread + files seem to live there rather than in ext, for some reason) + Branch: perl + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 16837] By: jhi on 2002/05/28 14:06:42 + Log: Subject: [PATCH] Bug fix for charnames::vianame + From: SADAHIRO Tomoyuki + Date: Tue, 28 May 2002 23:53:39 +0900 + Message-Id: <20020528234907.310A.BQW10602@nifty.com> + Branch: perl + ! lib/charnames.pm lib/charnames.t +____________________________________________________________________________ +[ 16836] By: jhi on 2002/05/28 13:43:39 + Log: Test output tweak. + Branch: perl + ! lib/ExtUtils/t/Embed.t +____________________________________________________________________________ +[ 16835] By: jhi on 2002/05/28 13:32:46 + Log: More charnames tweaks. + Branch: perl + ! lib/charnames.pm lib/charnames.t +____________________________________________________________________________ +[ 16834] By: jhi on 2002/05/28 13:24:16 + Log: Subject: [PATCH] Doc fix for charnames::vianame + From: SADAHIRO Tomoyuki + Date: Tue, 28 May 2002 22:46:41 +0900 + Message-Id: <20020528223607.9EBF.BQW10602@nifty.com> + Branch: perl + ! lib/charnames.pm +____________________________________________________________________________ +[ 16833] By: jhi on 2002/05/28 13:23:03 + Log: Subject: [PATCH 5.7.3 TEST] Embed.t fails on Win32 + From: "Yves Orton" + Date: Tue, 28 May 2002 15:43:12 +0200 + Message-ID: + Branch: perl + ! lib/ExtUtils/t/Embed.t +____________________________________________________________________________ +[ 16832] By: jhi on 2002/05/28 13:14:21 + Log: metaconfig unit change for #16831. + Branch: metaconfig/U/perl + ! gccvers.U +____________________________________________________________________________ +[ 16831] By: jhi on 2002/05/28 13:14:02 + Log: gcc 3 defensiveness from H. Merijn B and Rafael. + Branch: perl + ! Configure +____________________________________________________________________________ +[ 16830] By: jhi on 2002/05/28 12:55:29 + Log: Retract the Straps part of #16829 for now since + the subtest 44 of t/strap.t started failing. + Branch: perl + ! lib/Test/Harness/Straps.pm +____________________________________________________________________________ +[ 16829] By: jhi on 2002/05/28 12:26:34 + Log: Subject: [PATCH bleadperl] Test::Harness and skiping tests functionality + From: Nikola Knezevic + Date: Tue, 28 May 2002 08:17:53 +0200 + Message-ID: <40949173.20020528081753@tesla.rcub.bg.ac.yu> + Branch: perl + ! ext/POSIX/t/waitpid.t lib/Test/Harness.pm + ! lib/Test/Harness/Straps.pm t/op/64bitint.t t/test.pl +____________________________________________________________________________ +[ 16828] By: nick on 2002/05/28 08:00:28 + Log: Integrate mainline + Branch: perlio + !> Changes Makefile.micro README.netware README.tru64 + !> ext/Devel/Peek/Peek.pm ext/Errno/Errno_pm.PL + !> ext/IO/lib/IO/Dir.pm ext/IO/lib/IO/Handle.pm + !> ext/IO/lib/IO/Seekable.pm ext/IO/lib/IO/Socket/UNIX.pm + !> ext/IPC/SysV/Msg.pm ext/IPC/SysV/Semaphore.pm + !> ext/IPC/SysV/SysV.pm ext/List/Util/lib/List/Util.pm + !> ext/Time/HiRes/HiRes.pm lib/Tie/RefHash.pm lib/attributes.pm + !> mg.c patchlevel.h pod/perltodo.pod sv.c t/lib/warnings/pp_hot + !> uconfig.h util.c +____________________________________________________________________________ +[ 16827] By: jhi on 2002/05/28 00:46:23 + Log: Tru64: sockatmark trouble. + Branch: perl + ! README.tru64 +____________________________________________________________________________ +[ 16826] By: jhi on 2002/05/27 23:48:31 + Log: Update Changes. + Branch: perl + ! Changes patchlevel.h +____________________________________________________________________________ +[ 16825] By: pudge on 2002/05/27 22:55:07 + Log: Integrate perl + Branch: macperl + +> ext/Storable/t/integer.t + ! macos/MPVersion.r macos/config.sh + !> (integrate 60 files) +____________________________________________________________________________ [ 16824] By: jhi on 2002/05/27 20:58:48 Log: Todo update. Branch: perl diff --git a/Porting/patching.pod b/Porting/patching.pod index 3849051..14b39e2 100644 --- a/Porting/patching.pod +++ b/Porting/patching.pod @@ -272,11 +272,15 @@ This should work for most patches: =item Mailers Please, please, please (get the point? 8-) don't use a mailer that -word wraps your patch or that MIME encodes it. Both of these leave -the patch essentially worthless to the maintainer. +word wraps your patch. This leaves the patch essentially worthless +to the maintainers. -If you have no choice in mailers and no way to get your hands on a -better one there is, of course, a perl solution. Just do this: +Unfortunately many mailers word wrap the main text of messages, but +luckily you can usually send your patches as email attachments without +them getting "helpfully" word wrapped. + +If you have no choice in mailers and no way to get your hands on +a better one, there is, of course, a Perl solution. Just do this: perl -ne 'print pack("u*",$_)' patch > patch.uue diff --git a/cygwin/perlld.in b/cygwin/perlld.in index 85d4996..4281be6 100644 --- a/cygwin/perlld.in +++ b/cygwin/perlld.in @@ -46,7 +46,7 @@ if ($args !~ /\-o (\S+)/) { $path =~ s,[/\\](\.[/\\])*,/,g; } if ($dllname =~ /\./) { $libname =$`; } else { $libname =$dllname; }; - my $v_e_r_s = '5_7_3'; + my $v_e_r_s = '5_8_0'; if ( $dllname =~ /.*perl.*/) { $dllname ="cygperl$v_e_r_s.dll"; } else { diff --git a/epoc/createpkg.pl b/epoc/createpkg.pl index c4032bf..1190923 100644 --- a/epoc/createpkg.pl +++ b/epoc/createpkg.pl @@ -3,7 +3,7 @@ use File::Find; use Cwd; -$VERSION="5.7.3"; +$VERSION="5.8.0"; $EPOC_VERSION=1; diff --git a/ext/Devel/PPPort/PPPort.pm b/ext/Devel/PPPort/PPPort.pm index b2688cb..ea3bdc2 100644 --- a/ext/Devel/PPPort/PPPort.pm +++ b/ext/Devel/PPPort/PPPort.pm @@ -55,19 +55,44 @@ it returns FALSE. =head1 ppport.h The file written by this module, typically C, provides access -to the following Perl API if not already available: +to the following Perl API if not already available (and in some cases [*] +even if available, access to a fixed interface): + aMY_CXT + aMY_CXT_ + _aMY_CXT + aTHX + aTHX_ + AvFILLp + boolSV(b) DEFSV + dMY_CXT + dMY_CXT_SV + dNOOP + dTHR + dTHX + dTHXa + dTHXoa ERRSV - INT2PTR(any,d) + gv_stashpvn(str,len,flags) + INT2PTR(type,int) + IVdf MY_CXT MY_CXT_INIT + newCONSTSUB(stash,name,sv) + newRV_inc(sv) + newRV_noinc(sv) + newSVpvn(data,len) NOOP + NV + NVef + NVff + NVgf PERL_REVISION PERL_SUBVERSION PERL_UNUSED_DECL + PERL_UNUSED_DECL PERL_VERSION - PL_Sv PL_compiling PL_copline PL_curcop @@ -80,32 +105,27 @@ to the following Perl API if not already available: PL_rsfp_filters PL_rsfpv PL_stdingv + PL_Sv PL_sv_no PL_sv_undef PL_sv_yes - PTR2IV(d) - SAVE_DEFSV - START_MY_CXT - _aMY_CXT - _pMY_CXT - aMY_CXT - aMY_CXT_ - aTHX - aTHX_ - boolSV(b) - dMY_CXT - dMY_CXT_SV - dNOOP - dTHR - gv_stashpvn(str,len,flags) - newCONSTSUB(stash,name,sv) - newRV_inc(sv) - newRV_noinc(sv) - newSVpvn(data,len) pMY_CXT pMY_CXT_ + _pMY_CXT pTHX pTHX_ + PTR2IV(ptr) + PTR2NV(ptr) + PTR2ul(ptr) + PTR2UV(ptr) + SAVE_DEFSV + START_MY_CXT + SvPVbyte(sv,lp) [*] + UVof + UVSIZE + UVuf + UVxf + UVXf =head1 AUTHOR @@ -690,6 +710,24 @@ typedef NVTYPE NV; # define AvFILLp AvFILL #endif +#ifdef SvPVbyte +# if PERL_REVISION == 5 && PERL_VERSION < 7 + /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */ +# undef SvPVbyte +# define SvPVbyte(sv, lp) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp)) + static char * + my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp) + { + sv_utf8_downgrade(sv,0); + return SvPV(sv,*lp); + } +# endif +#else +# define SvPVbyte SvPV +#endif + #endif /* _P_P_PORTABILITY_H_ */ /* End of File ppport.h */ diff --git a/ext/Encode/bin/enc2xs b/ext/Encode/bin/enc2xs index 6f6b10f..7b4c538 100644 --- a/ext/Encode/bin/enc2xs +++ b/ext/Encode/bin/enc2xs @@ -1061,7 +1061,7 @@ the pod and to add more tests. Now issue a command all Perl Mongers love: - $ perl5.7.3 Makefile.PL + $ perl Makefile.PL Writing Makefile for Encode::My =item 4. diff --git a/ext/Encode/bin/piconv b/ext/Encode/bin/piconv index 81f3403..6aae2a5 100644 --- a/ext/Encode/bin/piconv +++ b/ext/Encode/bin/piconv @@ -1,7 +1,7 @@ #!./perl # $Id: piconv,v 1.24 2002/04/22 02:45:50 dankogai Exp $ # -use 5.7.3; +use 5.8.0; use strict; use Encode ; use Encode::Alias; diff --git a/lib/ExtUtils/MM_NW5.pm b/lib/ExtUtils/MM_NW5.pm index 3c8b1a7..54a7df5 100644 --- a/lib/ExtUtils/MM_NW5.pm +++ b/lib/ExtUtils/MM_NW5.pm @@ -327,7 +327,7 @@ MAKE_FRAG MAKE_FRAG } - $m .= ' $(LD) $(LDFLAGS) $(OBJECT:.obj=.obj) -desc "Perl 5.7.3 Extension ($(BASEEXT)) XS_VERSION: $(XS_VERSION)" -nlmversion $(NLM_VERSION)'; + $m .= ' $(LD) $(LDFLAGS) $(OBJECT:.obj=.obj) -desc "Perl 5.8.0 Extension ($(BASEEXT)) XS_VERSION: $(XS_VERSION)" -nlmversion $(NLM_VERSION)'; # Taking care of long names like FileHandle, ByteLoader, SDBM_File etc if($self->{NLM_SHORT_NAME}) { diff --git a/os2/os2ish.h b/os2/os2ish.h index 360da42..22ea083 100644 --- a/os2/os2ish.h +++ b/os2/os2ish.h @@ -357,6 +357,8 @@ void *emx_realloc (void *, size_t); #include /* before the following definitions */ #include /* before the following definitions */ +#include +#include #define chdir _chdir2 #define getcwd _getcwd2 @@ -372,6 +374,16 @@ void *emx_realloc (void *, size_t); #define PERLIO_IS_BINMODE_FD(fd) _PERLIO_IS_BINMODE_FD(fd) +#ifdef __GNUG__ +# define HAS_BOOL +#endif +#ifndef HAS_BOOL +# define bool char +# define HAS_BOOL 1 +#endif + +extern int* _fd_flags(int fd); /* where's the real prototype of this? */ + static inline bool _PERLIO_IS_BINMODE_FD(int fd) { diff --git a/patchlevel.h b/patchlevel.h index 76841bc..7f404f1 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -79,7 +79,7 @@ #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT) static char *local_patches[] = { NULL - ,"DEVEL16824" + ,"DEVEL16859" ,NULL }; diff --git a/perl.h b/perl.h index d8147a9..1c1da45 100644 --- a/perl.h +++ b/perl.h @@ -77,6 +77,12 @@ # endif #endif +/* undef WIN32 when building on Cygwin (for libwin32) - gph */ +#ifdef __CYGWIN__ +# undef WIN32 +# undef _WIN32 +#endif + /* Use the reentrant APIs like localtime_r and getpwent_r */ /* Win32 has naturally threadsafe libraries, no need to use any _r variants. */ #if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32) && !defined(__APPLE__) diff --git a/pp_pack.c b/pp_pack.c index 4cf3b93..d3fd37a 100644 --- a/pp_pack.c +++ b/pp_pack.c @@ -2232,9 +2232,9 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beg case 'w': while (len-- > 0) { fromstr = NEXTFROM; - adouble = SvNV(fromstr); + anv = SvNV(fromstr); - if (adouble < 0) + if (anv < 0) Perl_croak(aTHX_ "Cannot compress negative numbers"); /* 0xFFFFFFFFFFFFFFFF may cast to 18446744073709551616.0, @@ -2242,7 +2242,7 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beg any negative IVs will have already been got by the croak() above. IOK is untrue for fractions, so we test them against UV_MAX_P1. */ - if (SvIOK(fromstr) || adouble < UV_MAX_P1) + if (SvIOK(fromstr) || anv < UV_MAX_P1) { char buf[(sizeof(UV)*8)/7+1]; char *in = buf + sizeof(buf); @@ -2277,17 +2277,17 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beg SvREFCNT_dec(norm); /* free norm */ } else if (SvNOKp(fromstr)) { - char buf[sizeof(double) * 2]; /* 8/7 <= 2 */ + char buf[sizeof(NV) * 2]; /* 8/7 <= 2 */ char *in = buf + sizeof(buf); - adouble = Perl_floor(adouble); + anv = Perl_floor(anv); do { - double next = floor(adouble / 128); - *--in = (unsigned char)(adouble - (next * 128)) | 0x80; + NV next = Perl_floor(anv / 128); + *--in = (unsigned char)(anv - (next * 128)) | 0x80; if (in <= buf) /* this cannot happen ;-) */ Perl_croak(aTHX_ "Cannot compress integer"); - adouble = next; - } while (adouble > 0); + anv = next; + } while (anv > 0); buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */ sv_catpvn(cat, in, (buf + sizeof(buf)) - in); } diff --git a/sv.c b/sv.c index 8b707f7..18fdfc1 100644 --- a/sv.c +++ b/sv.c @@ -4461,7 +4461,13 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable, /* Some magic sontains a reference loop, where the sv and object refer to each other. To prevent a reference loop that would prevent such objects being freed, we look for such loops and if we find one we - avoid incrementing the object refcount. */ + avoid incrementing the object refcount. + + Note we cannot do this to avoid self-tie loops as intervening RV must + have its REFCNT incremented to keep it in existence - instead we could + special case them in sv_free() -- NI-S + + */ if (!obj || obj == sv || how == PERL_MAGIC_arylen || how == PERL_MAGIC_qr || diff --git a/t/base/num.t b/t/base/num.t index 37ef9fa..97fa312 100644 --- a/t/base/num.t +++ b/t/base/num.t @@ -109,14 +109,25 @@ print $a + 1 == 1001 ? "ok 30\n" : "not ok 30 #" . $a + 1 . "\n"; # back to some basic stringify tests # we expect NV stringification to work according to C sprintf %.*g rules -$a = 0.01; "$a"; -print $a eq "0.01" ? "ok 31\n" : "not ok 31 # $a\n"; +if ($^O eq 'os2') { # In the long run, fix this. For 5.8.0, deal. + $a = 0.01; "$a"; + print $a eq "0.01" || $a eq '1e-02' ? "ok 31\n" : "not ok 31 # $a\n"; -$a = 0.001; "$a"; -print $a eq "0.001" ? "ok 32\n" : "not ok 32 # $a\n"; + $a = 0.001; "$a"; + print $a eq "0.001" || $a eq '1e-03' ? "ok 32\n" : "not ok 32 # $a\n"; -$a = 0.0001; "$a"; -print $a eq "0.0001" ? "ok 33\n" : "not ok 33 # $a\n"; + $a = 0.0001; "$a"; + print $a eq "0.0001" || $a eq '1e-04' ? "ok 33\n" : "not ok 33 # $a\n"; +} else { + $a = 0.01; "$a"; + print $a eq "0.01" ? "ok 31\n" : "not ok 31 # $a\n"; + + $a = 0.001; "$a"; + print $a eq "0.001" ? "ok 32\n" : "not ok 32 # $a\n"; + + $a = 0.0001; "$a"; + print $a eq "0.0001" ? "ok 33\n" : "not ok 33 # $a\n"; +} $a = 0.00009; "$a"; print $a eq "9e-05" || $a eq "9e-005" ? "ok 34\n" : "not ok 34 # $a\n"; diff --git a/t/harness b/t/harness index fafba45..455a1f9 100644 --- a/t/harness +++ b/t/harness @@ -80,6 +80,7 @@ if (@ARGV) { warn "$0: cannot open $mani: $!\n"; } push @tests, ; + push @tests, ; } } if ($^O eq 'MSWin32') { diff --git a/t/op/tie.t b/t/op/tie.t index f8f2322..334b5b4 100755 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -3,7 +3,7 @@ # This test harness will (eventually) test the "tie" functionality # without the need for a *DBM* implementation. -# Currently it only tests the untie warning +# Currently it only tests the untie warning chdir 't' if -d 't'; @INC = '../lib'; @@ -138,7 +138,7 @@ untie %h; EXPECT ######## -# strict error behaviour, with 2 extra references +# strict error behaviour, with 2 extra references use warnings 'untie'; use Tie::Hash ; $a = tie %h, Tie::StdHash; @@ -171,7 +171,7 @@ sub Self::DESTROY { $b = $_[0] + 1; } tie %c, 'Self', \%c; } EXPECT -Self-ties of arrays and hashes are not supported +Self-ties of arrays and hashes are not supported ######## # Allowed scalar self-ties my ($a, $b) = (0, 0); @@ -206,8 +206,38 @@ EXPECT # correct unlocalisation of tied hashes (patch #16431) use Tie::Hash ; tie %tied, Tie::StdHash; -{ local $hash{'foo'} } print "exist1\n" if exists $hash{'foo'}; -{ local $tied{'foo'} } print "exist2\n" if exists $tied{'foo'}; -{ local $ENV{'foo'} } print "exist3\n" if exists $ENV{'foo'}; +{ local $hash{'foo'} } warn "plain hash bad unlocalize" if exists $hash{'foo'}; +{ local $tied{'foo'} } warn "tied hash bad unlocalize" if exists $tied{'foo'}; +{ local $ENV{'foo'} } warn "%ENV bad unlocalize" if exists $ENV{'foo'}; EXPECT +######## +# Allowed glob self-ties +my $destroyed = 0; +my $printed = 0; +sub Self2::TIEHANDLE { bless $_[1], $_[0] } +sub Self2::DESTROY { $destroyed = 1; } +sub Self2::PRINT { $printed = 1; } +{ + use Symbol; + my $c = gensym; + tie *$c, 'Self2', $c; + print $c 'Hello'; +} +die "self-tied glob not PRINTed" unless $printed == 1; +die "self-tied glob not DESTROYed" unless $destroyed == 1; +EXPECT +######## + +# Allowed IO self-ties +my $destroyed = 0; +sub Self3::TIEHANDLE { bless $_[1], $_[0] } +sub Self3::DESTROY { $destroyed = 1; } +{ + use Symbol 'geniosym'; + my $c = geniosym; + tie *$c, 'Self3', $c; +} +die "self-tied IO not DESTROYed" unless $destroyed == 1; +EXPECT +######## diff --git a/t/run/fresh_perl.t b/t/run/fresh_perl.t index 9ed6023..3c0a925 100644 --- a/t/run/fresh_perl.t +++ b/t/run/fresh_perl.t @@ -821,12 +821,6 @@ $人++; # a child is born print $人, "\n"; EXPECT 3 -######## -# TODO An attempt at lvalueable barewords broke this -tie FH, 'main'; -EXPECT -Can't modify constant item in tie at - line 2, near "'main';" -Execution of - aborted due to compilation errors. ######## example from Camel 5, ch. 15, pp.406 (with use vars) # SKIP: ord "A" == 193 # EBCDIC use strict;