diff options
44 files changed, 1734 insertions, 199 deletions
@@ -75,10 +75,478 @@ indicator: ---------------- -Version v5.5.650 Development release working toward v5.6 +Version v5.5.660 Development release working toward v5.6 ---------------- ____________________________________________________________________________ +[ 5112] By: gsar on 2000/02/15 20:57:12 + Log: fix change#5104 under useithreads + Branch: perl + ! op.c +____________________________________________________________________________ +[ 5111] By: gsar on 2000/02/15 20:45:10 + Log: export list tweak needed by change#5103 + Branch: perl + ! makedef.pl +____________________________________________________________________________ +[ 5110] By: gsar on 2000/02/15 19:32:56 + Log: add XS version of Sys::Hostname (from Greg Bacon + <gbacon@itsc.uah.edu>) + Branch: perl + + ext/Sys/Hostname/Hostname.pm ext/Sys/Hostname/Hostname.xs + + ext/Sys/Hostname/Makefile.PL + - lib/Sys/Hostname.pm + ! MANIFEST ext/DynaLoader/Makefile.PL ext/Sys/Syslog/Makefile.PL + ! pod/perldelta.pod t/lib/hostname.t win32/Makefile + ! win32/makefile.mk +____________________________________________________________________________ +[ 5109] By: gsar on 2000/02/15 18:35:28 + Log: UNIVERSAL::can and UNIVERSAL::isa should return undef when + given undefined values (from Graham Barr <gbarr@pobox.com>) + Branch: perl + ! universal.c +____________________________________________________________________________ +[ 5108] By: gsar on 2000/02/15 18:25:05 + Log: avoid accidental #line directives (from Rick Delaney + <rick@consumercontact.com>) + Branch: perl + ! pod/perlsyn.pod toke.c +____________________________________________________________________________ +[ 5107] By: gsar on 2000/02/15 18:04:31 + Log: locale guards needed (from Simon Cozens <simon@brecon.co.uk>) + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 5106] By: gsar on 2000/02/15 18:02:17 + Log: incorrect docs about delete() (spotted by Martyn Pearce + <martyn@inpharmatica.co.uk>) + Branch: perl + ! pod/perldelta.pod pod/perlfunc.pod +____________________________________________________________________________ +[ 5105] By: gsar on 2000/02/15 17:43:27 + Log: s/use vars/our/ (from Gisle Aas) + Branch: perl + ! bytecode.pl +____________________________________________________________________________ +[ 5104] By: gsar on 2000/02/15 17:42:06 + Log: optimize pseudohash slice in array slice at compile time (from + John Tobey <jtobey@john-edwin-tobey.org>) + Branch: perl + ! op.c t/lib/fields.t +____________________________________________________________________________ +[ 5103] By: gsar on 2000/02/15 17:18:12 + Log: provide malloc stats via get_mstats() (from Ilya Zakharevich) + Branch: perl + ! embed.h embed.pl global.sym makedef.pl malloc.c objXSUB.h + ! perl.h perlapi.c proto.h vos/vos_dummies.c +____________________________________________________________________________ +[ 5102] By: gsar on 2000/02/15 17:05:12 + Log: doc patches from Rick Delaney and Chris Nandor; update Todo-5.6 + Branch: perl + ! Todo-5.6 pod/perldata.pod pod/perlport.pod +____________________________________________________________________________ +[ 5101] By: gsar on 2000/02/15 17:02:51 + Log: fix regen_headers target to make all the autogenerated files + writable first + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 5100] By: gsar on 2000/02/15 16:41:53 + Log: fix misoptimization of C<my($x,$y); $x = $y = 1 + $z;> (from + Ilya Zakharevich) + Branch: perl + ! op.c t/op/lex_assign.t +____________________________________________________________________________ +[ 5099] By: gsar on 2000/02/15 16:17:36 + Log: more complete File::Spec support for Mac and VMS, tests (from + Barrie Slaymaker <barries@slaysys.com>) + Branch: perl + ! lib/File/Spec/Mac.pm lib/File/Spec/Unix.pm + ! lib/File/Spec/VMS.pm lib/File/Spec/Win32.pm t/lib/filespec.t +____________________________________________________________________________ +[ 5098] By: gsar on 2000/02/15 16:10:46 + Log: fix incompatibility with bison generated parser (from + Ignasi Roca <ignasi.roca@fujitsu.siemens.es>) + Branch: perl + ! toke.c +____________________________________________________________________________ +[ 5097] By: gsar on 2000/02/15 16:07:17 + Log: propagate st_mode bits to group/other for Borland build + (from Vadim Konovalov <vkonovalov@lucent.com>) + Branch: perl + ! win32/win32.c +____________________________________________________________________________ +[ 5096] By: jhi on 2000/02/15 14:22:23 + Log: Integrate with Sarathy. + Branch: cfgperl + !> win32/Makefile win32/bin/exetype.pl win32/makefile.mk +____________________________________________________________________________ +[ 5095] By: jhi on 2000/02/15 14:19:22 + Log: cc_r can be in different places (/usr/ibmcxx/bin or /usr/bin), + easier just to drop the paranoid test. + Branch: cfgperl + ! hints/aix.sh +____________________________________________________________________________ +[ 5094] By: gsar on 2000/02/15 05:42:17 + Log: update exetype.pl tool + Branch: perl + ! win32/Makefile win32/bin/exetype.pl win32/makefile.mk +____________________________________________________________________________ +[ 5093] By: jhi on 2000/02/15 05:24:02 + Log: Integrate with Sarathy. + Branch: cfgperl + !> Porting/pumpkin.pod embed.h embed.pl ext/DB_File/DB_File.xs + !> ext/GDBM_File/GDBM_File.xs ext/NDBM_File/NDBM_File.xs + !> ext/ODBM_File/ODBM_File.xs ext/SDBM_File/SDBM_File.xs hv.c + !> perl.c proto.h sv.c t/op/ord.t t/pragma/warnings.t +____________________________________________________________________________ +[ 5092] By: jhi on 2000/02/15 05:22:09 + Log: Unroll the libs scan thanks to HP-UX. + Branch: cfgperl + ! Configure config_h.SH hints/hpux.sh + Branch: metaconfig + ! U/modified/libpth.U U/modified/libs.U + Branch: metaconfig/U/perl + ! Extensions.U dlsrc.U +____________________________________________________________________________ +[ 5091] By: gsar on 2000/02/15 05:17:56 + Log: fix leaks in *DBM_File; safemalloc()ed things need to be freed with + safefree() rather than Safefree() + Branch: perl + ! ext/DB_File/DB_File.xs ext/GDBM_File/GDBM_File.xs + ! ext/NDBM_File/NDBM_File.xs ext/ODBM_File/ODBM_File.xs + ! ext/SDBM_File/SDBM_File.xs +____________________________________________________________________________ +[ 5090] By: gsar on 2000/02/15 04:54:17 + Log: fix memory leak in C<$x = *Y> provoked by change#4198, which + introduced XPVMG storage in arenas + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 5089] By: jhi on 2000/02/15 00:41:36 + Log: AIX perl linkage tweakage. + Branch: cfgperl + ! Makefile.SH +____________________________________________________________________________ +[ 5088] By: jhi on 2000/02/15 00:07:06 + Log: abort instead of just promising. + Branch: cfgperl + ! hints/aix.sh +____________________________________________________________________________ +[ 5087] By: jhi on 2000/02/14 23:51:05 + Log: silly compilers don't know that croak() exits + and complain about unitialized RETVALs + Branch: cfgperl + ! ext/Sys/Syslog/Syslog.xs +____________________________________________________________________________ +[ 5086] By: jhi on 2000/02/14 21:13:24 + Log: Add lseektype and lseeksize to myconfig. + Branch: cfgperl + ! myconfig.SH +____________________________________________________________________________ +[ 5085] By: gsar on 2000/02/14 18:51:11 + Log: avoid warnings + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 5084] By: gsar on 2000/02/14 18:26:08 + Log: fix small interpreter leaks identified by Purify + Branch: perl + ! Porting/pumpkin.pod embed.h embed.pl hv.c perl.c proto.h sv.c + ! t/op/ord.t t/pragma/warnings.t +____________________________________________________________________________ +[ 5083] By: jhi on 2000/02/14 17:50:52 + Log: Remove tagged core files. + Branch: cfgperl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 5082] By: jhi on 2000/02/14 17:41:07 + Log: Prefer full_ar. + Branch: cfgperl + ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 5081] By: jhi on 2000/02/14 17:20:32 + Log: Add ivtype, ivsize, nvtype, nvsize to myconfig. + Branch: cfgperl + ! myconfig.SH +____________________________________________________________________________ +[ 5080] By: jhi on 2000/02/14 15:33:03 + Log: Integrate with Sarathy. + Branch: cfgperl + !> Porting/pumpkin.pod av.c malloc.c sv.c +____________________________________________________________________________ +[ 5079] By: gsar on 2000/02/14 08:50:06 + Log: notes about running Purify + Branch: perl + ! Porting/pumpkin.pod av.c sv.c +____________________________________________________________________________ +[ 5078] By: gsar on 2000/02/14 07:27:21 + Log: use system malloc() instead of sbrk() in Perl_malloc() under -DPURIFY + Branch: perl + ! malloc.c +____________________________________________________________________________ +[ 5077] By: gsar on 2000/02/14 07:25:44 + Log: integrate cfgperl contents into mainline + Branch: perl + !> Configure Porting/Glossary Porting/config.sh Porting/config_H + !> config_h.SH epoc/config.sh hints/aix.sh hints/hpux.sh + !> hints/irix_6.sh hints/solaris_2.sh perl.h pod/perldelta.pod + !> vms/subconfigure.com vos/config.def vos/config.h + !> vos/config_h.SH_orig win32/config.bc win32/config.gc + !> win32/config.vc win32/config_H.bc win32/config_H.gc + !> win32/config_H.vc +____________________________________________________________________________ +[ 5076] By: jhi on 2000/02/14 05:01:56 + Log: Integrate with Sarathy. + Branch: cfgperl + !> embed.h embed.pl objXSUB.h perl.c perlapi.c proto.h sv.c +____________________________________________________________________________ +[ 5075] By: jhi on 2000/02/14 04:56:52 + Log: Configure -A stopped processing of any further options. + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig + ! U/modified/Options.U +____________________________________________________________________________ +[ 5074] By: gsar on 2000/02/14 04:45:01 + Log: remove outdated -DPURIFY code--it reports bogus errors during global + destruction since we actually depend on SVs being in arenas there + Branch: perl + ! embed.h embed.pl objXSUB.h perl.c perlapi.c proto.h sv.c +____________________________________________________________________________ +[ 5073] By: jhi on 2000/02/13 19:28:17 + Log: Integrate with Sarathy. + Branch: cfgperl + - Todo-5.005 + !> cop.h op.c perl.c pp_ctl.c regcomp.c regexec.c scope.c sv.c + !> util.c +____________________________________________________________________________ +[ 5072] By: gsar on 2000/02/13 19:02:07 + Log: more purification (pp_require() could access free memory; vdie() + could think message was random length when passed a null argument; + utilize() didn't set up the hash for the method name leading to + pp_method_named() accessing random state; PL_curpm wasn't zeroed + properly) + Branch: perl + ! cop.h op.c perl.c pp_ctl.c regcomp.c regexec.c scope.c sv.c + ! util.c +____________________________________________________________________________ +[ 5071] By: jhi on 2000/02/12 19:59:35 + Log: uselonglong sits deep. + Branch: cfgperl + ! Configure config_h.SH hints/solaris_2.sh + Branch: metaconfig/U/perl + ! use64bits.U +____________________________________________________________________________ +[ 5070] By: jhi on 2000/02/12 01:25:41 + Log: megalomaniac 64-bit update: most importantly, + uselonglong is eradicated, only backward + compatibility hooks in use64bits remain. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH epoc/config.sh hints/aix.sh hints/hpux.sh + ! hints/irix_6.sh hints/solaris_2.sh perl.h vms/subconfigure.com + ! vos/config.def vos/config.h vos/config_h.SH_orig + ! win32/config.bc win32/config.gc win32/config.vc + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + Branch: metaconfig + ! U/a_dvisory/quadtype.U U/modified/libpth.U U/modified/libs.U + Branch: metaconfig/U/perl + ! use64bits.U +____________________________________________________________________________ +[ 5069] By: jhi on 2000/02/11 21:13:41 + Log: undo #5064 for now; there seems to be no good selection + of flags to add the new option. + Branch: cfgperl + ! hints/hpux.sh +____________________________________________________________________________ +[ 5068] By: jhi on 2000/02/11 21:01:21 + Log: Guard against accidental long long use. + Branch: cfgperl + ! perl.h +____________________________________________________________________________ +[ 5067] By: jhi on 2000/02/11 19:50:32 + Log: logic fixes + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig/U/perl + ! uselonglong.U +____________________________________________________________________________ +[ 5066] By: jhi on 2000/02/11 19:32:30 + Log: Clarify 64-bit issues. + Branch: cfgperl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 5065] By: jhi on 2000/02/11 18:13:29 + Log: Integrate with Sarathy. + Branch: cfgperl + !> ext/Devel/Peek/Peek.xs regcomp.c t/comp/require.t t/comp/use.t + !> toke.c +____________________________________________________________________________ +[ 5064] By: jhi on 2000/02/11 18:11:47 + Log: Silence linker warnings about binary backward incompatibilities. + Branch: cfgperl + ! hints/hpux.sh +____________________________________________________________________________ +[ 5063] By: gsar on 2000/02/11 16:36:14 + Log: fix uninitialized memory reads found by purify + Branch: perl + ! ext/Devel/Peek/Peek.xs regcomp.c +____________________________________________________________________________ +[ 5062] By: jhi on 2000/02/11 00:11:39 + Log: de-fancify the largefiles hints + Branch: cfgperl + ! hints/hpux.sh +____________________________________________________________________________ +[ 5061] By: gsar on 2000/02/10 19:17:09 + Log: longstanding bug in parsing "require VERSION", could reallocate + current line and not know it; exposed by change#5004; manifested + as parse failure of C<{require 5.003}> + Branch: perl + ! t/comp/require.t t/comp/use.t toke.c +____________________________________________________________________________ +[ 5060] By: jhi on 2000/02/10 13:29:25 + Log: Integrate with Sarathy. + Branch: cfgperl + !> makedef.pl pp_ctl.c t/op/write.t win32/vdir.h +____________________________________________________________________________ +[ 5059] By: gsar on 2000/02/10 06:21:21 + Log: make global symbol exports AIX-specific + Branch: perl + ! makedef.pl +____________________________________________________________________________ +[ 5058] By: gsar on 2000/02/10 06:16:57 + Log: integrate cfgperl contents into mainline + Branch: perl + !> Configure Makefile.SH Porting/Glossary Porting/config.sh + !> Porting/config_H config_h.SH makedef.pl perl.h + !> vms/subconfigure.com vos/config.def win32/config.bc + !> win32/config.gc win32/config.vc win32/config_H.bc + !> win32/config_H.gc win32/config_H.vc win32/config_h.PL + !> win32/config_sh.PL +____________________________________________________________________________ +[ 5057] By: gsar on 2000/02/10 01:08:01 + Log: windows bugfixes for virtual directories under USE_ITHREADS: + allows path mapping to unknown devices to work properly; + special file names like CONOUT$ can be opened with sysopen() + again + Branch: perl + ! win32/vdir.h +____________________________________________________________________________ +[ 5056] By: gsar on 2000/02/10 00:56:27 + Log: formline() could wipe out readonly-ness, freeing constants + prematurely, or affect cloning of pad constants + Branch: perl + ! pp_ctl.c t/op/write.t +____________________________________________________________________________ +[ 5055] By: jhi on 2000/02/09 19:48:58 + Log: Regenerate Configure for I_SYSLOG. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH +____________________________________________________________________________ +[ 5054] By: jhi on 2000/02/09 19:38:04 + Log: fix AIX and multiplicity problems + Branch: cfgperl + ! Makefile.SH makedef.pl +____________________________________________________________________________ +[ 5053] By: bailey on 2000/02/09 10:58:11 + Log: remove redundant archcore directory prefix in installperl + Branch: vmsperl + ! installperl +____________________________________________________________________________ +[ 5052] By: bailey on 2000/02/09 10:44:22 + Log: Work around prefixing bug in older DECC preprocessors + Branch: vmsperl + ! vms/vms.c vms/vmsish.h +____________________________________________________________________________ +[ 5051] By: bailey on 2000/02/09 09:52:06 + Log: Eliminate unnecessary (and sometimes confounding) test for + word boundary + Branch: vmsperl + ! lib/ExtUtils/MM_VMS.pm +____________________________________________________________________________ +[ 5050] By: bailey on 2000/02/09 09:29:06 + Log: Minor fixes to assuage picky compilers (unsigned comparisons and + alias rules lead to compilation warnings) + Branch: vmsperl + ! av.c mg.h pp_sys.c scope.c sv.c vms/vms.c +____________________________________________________________________________ +[ 5049] By: bailey on 2000/02/09 09:09:45 + Log: Resync with mainline + Branch: vmsperl + +> Todo-5.6 ext/Sys/Syslog/Makefile.PL ext/Sys/Syslog/Syslog.pm + +> ext/Sys/Syslog/Syslog.xs lib/Pod/Find.pm lib/Pod/ParseUtils.pm + +> pod/perlapi.pod pod/perlintern.pod pod/perlunicode.pod + +> t/op/exists_sub.t t/op/ver.t t/pragma/diagnostics.t + +> vos/config.def vos/config.pl win32/bin/exetype.pl + - Todo-5.005 lib/Sys/Syslog.pm lib/caller.pm + ! vms/subconfigure.com + !> (integrate 358 files) +____________________________________________________________________________ +[ 5048] By: jhi on 2000/02/09 03:54:05 + Log: OS/2 gcc doesn't like -o foo.exe and -Zexe simultaneously + (reported by Yitzchak Scott-Thoennes in p5p) + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig + ! U/modified/Cppsym.U +____________________________________________________________________________ +[ 5047] By: jhi on 2000/02/09 02:56:43 + Log: (fake) use of getcwd. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH perl.h +____________________________________________________________________________ +[ 5046] By: jhi on 2000/02/09 02:22:50 + Log: lib scan fix + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig + ! U/modified/libs.U +____________________________________________________________________________ +[ 5045] By: jhi on 2000/02/09 02:17:34 + Log: Reintroduce #5019 via metaconfig. + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig + ! U/installdirs/inc_version_list.U +____________________________________________________________________________ +[ 5044] By: jhi on 2000/02/09 02:07:08 + Log: Add/restore probes for getcwd/mk*temp*/mmap. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH perl.h vms/subconfigure.com vos/config.def + ! win32/config.bc win32/config.gc win32/config.vc + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + ! win32/config_h.PL win32/config_sh.PL + Branch: metaconfig + ! U/modified/d_mkstemp.U U/modified/libs.U + Branch: metaconfig/U/perl + + d_mkdtemp.U d_mkstemps.U +____________________________________________________________________________ +[ 5043] By: jhi on 2000/02/08 20:58:02 + Log: Integrate with Sarathy. + Branch: cfgperl + +> Todo-5.6 t/op/ver.t win32/bin/exetype.pl + !> (integrate 110 files) +____________________________________________________________________________ +[ 5042] By: gsar on 2000/02/08 20:32:12 + Log: avoid exiting just because we didn't scan for libm ('libs' may still + have it, but we avoided scan for things in 'libs') + Branch: perl + ! Configure + +---------------- +Version v5.5.650 +---------------- + +____________________________________________________________________________ +[ 5041] By: gsar on 2000/02/08 07:57:11 + Log: update Changes + Branch: perl + ! Changes +____________________________________________________________________________ [ 5040] By: gsar on 2000/02/08 07:51:20 Log: documentation patches (from Michael Schwern and Yitzchak Scott-Thoennes) @@ -364,6 +364,9 @@ ext/SDBM_File/typemap SDBM extension interface types ext/Socket/Makefile.PL Socket extension makefile writer ext/Socket/Socket.pm Socket extension Perl module ext/Socket/Socket.xs Socket extension external subroutines +ext/Sys/Hostname/Makefile.PL Sys::Hostname extension makefile writer +ext/Sys/Hostname/Hostname.pm Sys::Hostname extension Perl module +ext/Sys/Hostname/Hostname.xs Sys::Hostname extension external subroutines ext/Sys/Syslog/Makefile.PL Sys::Syslog extension makefile writer ext/Sys/Syslog/Syslog.pm Sys::Syslog extension Perl module ext/Sys/Syslog/Syslog.xs Sys::Syslog extension external subroutines @@ -646,7 +649,6 @@ lib/SelectSaver.pm Enforce proper select scoping lib/SelfLoader.pm Load functions only on demand lib/Shell.pm Make AUTOLOADed system() calls lib/Symbol.pm Symbol table manipulation routines -lib/Sys/Hostname.pm Hostname methods lib/Term/Cap.pm Perl module supporting termcap usage lib/Term/Complete.pm A command completion subroutine lib/Term/ReadLine.pm Stub readline library diff --git a/Makefile.SH b/Makefile.SH index 4cfba37d44..1646478bc0 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -597,24 +597,29 @@ SYMH = perlvars.h intrpvar.h thrdvar.h CHMOD_W = chmod +w # The following files are generated automatically -# keywords.h: keywords.pl -# opcode.h: opcode.pl -# pp_proto.h: opcode.pl -# pp.sym: opcode.pl -# embed.h: embed.pl [* needs pp.sym generated by opcode.pl! *] -# embedvar.h: embed.pl [* needs pp.sym generated by opcode.pl! *] -# ext/ByteLoader/byterun.h: bytecode.pl -# ext/ByteLoader/byterun.c: bytecode.pl -# ext/B/Asmdata.pm: bytecode.pl -# global.sym: embed.pl -# regnodes.h: regcomp.pl -# warnings.h lib/warnings.pm: warnings.pl +# keywords.pl: keywords.h +# opcode.pl: opcode.h opnames.h pp_proto.h pp.sym +# [* embed.pl needs pp.sym generated by opcode.pl! *] +# embed.pl: proto.h embed.h embedvar.h global.sym objXSUB.h +# perlapi.h perlapi.c pod/perlintern.pod +# pod/perlapi.pod +# bytecode.pl: ext/ByteLoader/byterun.h ext/ByteLoader/byterun.c +# ext/B/B/Asmdata.pm +# regcomp.pl: regnodes.h +# warnings.pl: warnings.h lib/warnings.pm # The correct versions should be already supplied with the perl kit, # in case you don't have perl available. -# To force them to run, type +# To force them to be regenerated, type # make regen_headers + +AUTOGEN_FILES = keywords.h opcode.h opnames.h pp_proto.h pp.sym embed.h \ + embedvar.h global.sym pod/perlintern.pod pod/perlapi.pod \ + objXSUB.h perlapi.h perlapi.c ext/ByteLoader/byterun.h \ + ext/ByteLoader/byterun.c ext/B/B/Asmdata.pm regnodes.h \ + warnings.h lib/warnings.pm + regen_headers: FORCE - $(CHMOD_W) proto.h warnings.h lib/warnings.pm + $(CHMOD_W) $(AUTOGEN_FILES) perl keywords.pl perl opcode.pl perl embed.pl @@ -1,3 +1,7 @@ +Bugs + perl_run() can longjmp out + fix small memory leaks on compile-time failures + Unicode support finish byte <-> utf8 and localencoding <-> utf8 conversions make "$bytestr$charstr" do the right conversion @@ -64,7 +68,6 @@ Win32 stuff work out DLL versioning Miscellaneous - magic_setisa should be made to update %FIELDS [???] add new modules (Archive::Tar, Compress::Zlib, CPAN::FTP?) replace pod2html with new PodtoHtml? (requires other modules from CPAN) automate testing with large parts of CPAN diff --git a/bytecode.pl b/bytecode.pl index 00df48b957..0ffe8e4443 100644 --- a/bytecode.pl +++ b/bytecode.pl @@ -47,7 +47,7 @@ package B::Asmdata; use Exporter; @ISA = qw(Exporter); @EXPORT_OK = qw(%insn_data @insn_name @optype @specialsv_name); -use vars qw(%insn_data @insn_name @optype @specialsv_name); +our(%insn_data, @insn_name, @optype, @specialsv_name); EOT print ASMDATA_PM <<"EOT"; @@ -730,6 +730,7 @@ #define yywarn Perl_yywarn #if defined(MYMALLOC) #define dump_mstats Perl_dump_mstats +#define get_mstats Perl_get_mstats #endif #define safesysmalloc Perl_safesysmalloc #define safesyscalloc Perl_safesyscalloc @@ -2141,6 +2142,7 @@ #define yywarn(a) Perl_yywarn(aTHX_ a) #if defined(MYMALLOC) #define dump_mstats(a) Perl_dump_mstats(aTHX_ a) +#define get_mstats(a,b,c) Perl_get_mstats(aTHX_ a,b,c) #endif #define safesysmalloc Perl_safesysmalloc #define safesyscalloc Perl_safesyscalloc @@ -4196,6 +4198,8 @@ #if defined(MYMALLOC) #define Perl_dump_mstats CPerlObj::Perl_dump_mstats #define dump_mstats Perl_dump_mstats +#define Perl_get_mstats CPerlObj::Perl_get_mstats +#define get_mstats Perl_get_mstats #endif #define Perl_safesysmalloc CPerlObj::Perl_safesysmalloc #define safesysmalloc Perl_safesysmalloc @@ -2049,6 +2049,7 @@ p |int |yyparse p |int |yywarn |char* s #if defined(MYMALLOC) Ap |void |dump_mstats |char* s +Ap |int |get_mstats |perl_mstats_t *buf|int buflen|int level #endif Anp |Malloc_t|safesysmalloc |MEM_SIZE nbytes Anp |Malloc_t|safesyscalloc |MEM_SIZE elements|MEM_SIZE size diff --git a/ext/DynaLoader/Makefile.PL b/ext/DynaLoader/Makefile.PL index e4493b4332..bcd45ae757 100644 --- a/ext/DynaLoader/Makefile.PL +++ b/ext/DynaLoader/Makefile.PL @@ -12,7 +12,8 @@ WriteMakefile( 'XSLoader_pm.PL'=>'XSLoader.pm'}, PM => {'DynaLoader.pm' => '$(INST_LIBDIR)/DynaLoader.pm', 'XSLoader.pm' => '$(INST_LIBDIR)/XSLoader.pm'}, - clean => {FILES => 'DynaLoader.c DynaLoader.xs DynaLoader.pm'}, + clean => {FILES => 'DynaLoader.c DynaLoader.xs DynaLoader.pm ' . + 'XSLoader.pm'}, ); sub MY::postamble { diff --git a/lib/Sys/Hostname.pm b/ext/Sys/Hostname/Hostname.pm index 63415a6bfe..1efc897c3b 100644 --- a/lib/Sys/Hostname.pm +++ b/ext/Sys/Hostname/Hostname.pm @@ -1,41 +1,31 @@ package Sys::Hostname; -use Carp; -require Exporter; -@ISA = qw(Exporter); -@EXPORT = qw(hostname); - -=head1 NAME - -Sys::Hostname - Try every conceivable way to get hostname - -=head1 SYNOPSIS - - use Sys::Hostname; - $host = hostname; - -=head1 DESCRIPTION +use strict; -Attempts several methods of getting the system hostname and -then caches the result. It tries C<syscall(SYS_gethostname)>, -C<`hostname`>, C<`uname -n`>, and the file F</com/host>. -If all that fails it C<croak>s. +use Carp; -All nulls, returns, and newlines are removed from the result. +require Exporter; +use XSLoader (); +require AutoLoader; -=head1 AUTHOR +our @ISA = qw/ Exporter AutoLoader /; +our @EXPORT = qw/ hostname /; -David Sundstrom E<lt>F<sunds@asictest.sc.ti.com>E<gt> +our $VERSION = '1.1'; -Texas Instruments +our $host; -=cut +XSLoader::load 'Sys::Hostname', $VERSION; sub hostname { # method 1 - we already know it return $host if defined $host; + # method 1' - try to ask the system + $host = ghname(); + return $host if defined $host; + if ($^O eq 'VMS') { # method 2 - no sockets ==> return DECnet node name @@ -70,8 +60,10 @@ sub hostname { return $host; } else { # Unix + # is anyone going to make it here? # method 2 - syscall is preferred since it avoids tainting problems + # XXX: is it such a good idea to return hostname untainted? eval { local $SIG{__DIE__}; require "syscall.ph"; @@ -113,6 +105,7 @@ sub hostname { # method 6 - Apollo pre-SR10 || eval { local $SIG{__DIE__}; + my($a,$b,$c,$d); ($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6); } @@ -126,3 +119,35 @@ sub hostname { } 1; + +__END__ + +=head1 NAME + +Sys::Hostname - Try every conceivable way to get hostname + +=head1 SYNOPSIS + + use Sys::Hostname; + $host = hostname; + +=head1 DESCRIPTION + +Attempts several methods of getting the system hostname and +then caches the result. It tries the first available of the C +library's gethostname(), C<`$Config{aphostname}`>, uname(2), +C<syscall(SYS_gethostname)>, C<`hostname`>, C<`uname -n`>, +and the file F</com/host>. If all that fails it C<croak>s. + +All NULs, returns, and newlines are removed from the result. + +=head1 AUTHOR + +David Sundstrom E<lt>F<sunds@asictest.sc.ti.com>E<gt> + +Texas Instruments + +XS code added by Greg Bacon E<lt>F<gbacon@cs.uah.edu>E<gt> + +=cut + diff --git a/ext/Sys/Hostname/Hostname.xs b/ext/Sys/Hostname/Hostname.xs new file mode 100644 index 0000000000..98c07cf58a --- /dev/null +++ b/ext/Sys/Hostname/Hostname.xs @@ -0,0 +1,77 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#if defined(I_UNISTD) && defined(HAS_GETHOSTNAME) +# include <unistd.h> +#endif + +/* a reasonable default */ +#ifndef MAXHOSTNAMELEN +# define MAXHOSTNAMELEN 256 +#endif + +/* swiped from POSIX.xs */ +#if defined(__VMS) && !defined(__POSIX_SOURCE) +# if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) +# include <utsname.h> +# endif +#endif + +#if defined(HAS_UNAME) && !defined(WIN32) +/* XXX need i_sys_utsname in config.sh */ +# include <sys/utsname.h> +#endif + +MODULE = Sys::Hostname PACKAGE = Sys::Hostname + +void +ghname() + PREINIT: + IV retval = -1; + SV *sv; + PPCODE: + EXTEND(SP, 1); +#ifdef HAS_GETHOSTNAME + { + char tmps[MAXHOSTNAMELEN]; + retval = PerlSock_gethostname(tmps, sizeof(tmps)); + sv = newSVpvn(tmps, strlen(tmps)); + } +#else +# ifdef HAS_PHOSTNAME + { + PerlIO *io; + char tmps[MAXHOSTNAMELEN]; + char *p = tmps; + char c; + io = PerlProc_popen(PHOSTNAME, "r"); + if (!io) + goto check_out; + while (PerlIO_read(io, &c, sizeof(c)) == 1) { + if (isSPACE(c) || p - tmps >= sizeof(tmps)) + break; + *p++ = c; + } + PerlProc_pclose(io); + *p = '\0'; + retval = 0; + sv = newSVpvn(tmps, strlen(tmps)); + } +# else +# ifdef HAS_UNAME + { + struct utsname u; + if (PerlEnv_uname(&u) == -1) + goto check_out; + sv = newSVpvn(u.nodename, strlen(u.nodename)); + retval = 0; + } +# endif +# endif +#endif + check_out: + if (retval == -1) + XSRETURN_UNDEF; + else + PUSHs(sv_2mortal(sv)); diff --git a/ext/Sys/Hostname/Makefile.PL b/ext/Sys/Hostname/Makefile.PL new file mode 100644 index 0000000000..a0892f643e --- /dev/null +++ b/ext/Sys/Hostname/Makefile.PL @@ -0,0 +1,8 @@ +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Sys::Hostname', + VERSION_FROM => 'Hostname.pm', + MAN3PODS => {}, # Pods will be built by installman. + XSPROTOARG => '-noprototypes', +); diff --git a/ext/Sys/Syslog/Makefile.PL b/ext/Sys/Syslog/Makefile.PL index 253130a506..e5edf3e1ba 100644 --- a/ext/Sys/Syslog/Makefile.PL +++ b/ext/Sys/Syslog/Makefile.PL @@ -3,5 +3,6 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Sys::Syslog', VERSION_FROM => 'Syslog.pm', + MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes', ); diff --git a/global.sym b/global.sym index 2f750fa170..1451d85db8 100644 --- a/global.sym +++ b/global.sym @@ -452,6 +452,7 @@ Perl_vwarn Perl_warner Perl_vwarner Perl_dump_mstats +Perl_get_mstats Perl_safesysmalloc Perl_safesyscalloc Perl_safesysrealloc diff --git a/lib/File/Spec/Mac.pm b/lib/File/Spec/Mac.pm index e1f3c175ab..14da25a773 100644 --- a/lib/File/Spec/Mac.pm +++ b/lib/File/Spec/Mac.pm @@ -218,6 +218,174 @@ sub path { return split(/,/, $ENV{Commands}); } +=item splitpath + +=cut + +sub splitpath { + my ($self,$path, $nofile) = @_; + + my ($volume,$directory,$file) = ('','',''); + + if ( $nofile ) { + ( $volume, $directory ) = $path =~ m@((?:[^:]+(?::|$))?)(.*)@; + } + else { + $path =~ + m@^( (?: [^:]+: )? ) + ( (?: .*: )? ) + ( .* ) + @x; + $volume = $1; + $directory = $2; + $file = $3; + } + + # Make sure non-empty volumes and directories end in ':' + $volume .= ':' if $volume =~ m@[^:]$@ ; + $directory .= ':' if $directory =~ m@[^:]$@ ; + return ($volume,$directory,$file); +} + + +=item splitdir + +=cut + +sub splitdir { + my ($self,$directories) = @_ ; + # + # split() likes to forget about trailing null fields, so here we + # check to be sure that there will not be any before handling the + # simple case. + # + if ( $directories !~ m@:$@ ) { + return split( m@:@, $directories ); + } + else { + # + # since there was a trailing separator, add a file name to the end, + # then do the split, then replace it with ''. + # + my( @directories )= split( m@:@, "${directories}dummy" ) ; + $directories[ $#directories ]= '' ; + return @directories ; + } +} + + +=item catpath + +=cut + +sub catpath { + my $self = shift ; + + my $result = shift ; + $result =~ s@^([^/])@/$1@ ; + + my $segment ; + for $segment ( @_ ) { + if ( $result =~ m@[^/]$@ && $segment =~ m@^[^/]@ ) { + $result .= "/$segment" ; + } + elsif ( $result =~ m@/$@ && $segment =~ m@^/@ ) { + $result =~ s@/+$@/@; + $segment =~ s@^/+@@; + $result .= "$segment" ; + } + else { + $result .= $segment ; + } + } + + return $result ; +} + +=item abs2rel + +=cut + +sub abs2rel { + my($self,$path,$base) = @_; + + # Clean up $path + if ( ! $self->file_name_is_absolute( $path ) ) { + $path = $self->rel2abs( $path ) ; + } + + # Figure out the effective $base and clean it up. + if ( !defined( $base ) || $base eq '' ) { + $base = cwd() ; + } + elsif ( ! $self->file_name_is_absolute( $base ) ) { + $base = $self->rel2abs( $base ) ; + } + + # Now, remove all leading components that are the same + my @pathchunks = $self->splitdir( $path ); + my @basechunks = $self->splitdir( $base ); + + while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) { + shift @pathchunks ; + shift @basechunks ; + } + + $path = join( ':', @pathchunks ); + + # @basechunks now contains the number of directories to climb out of. + $base = ':' x @basechunks ; + + return "$base:$path" ; +} + +=item rel2abs + +Converts a relative path to an absolute path. + + $abs_path = $File::Spec->rel2abs( $destination ) ; + $abs_path = $File::Spec->rel2abs( $destination, $base ) ; + +If $base is not present or '', then L<cwd()> is used. If $base is relative, +then it is converted to absolute form using L</rel2abs()>. This means that it +is taken to be relative to L<cwd()>. + +On systems with the concept of a volume, this assumes that both paths +are on the $base volume, and ignores the $destination volume. + +On systems that have a grammar that indicates filenames, this ignores the +$base filename as well. Otherwise all path components are assumed to be +directories. + +If $path is absolute, it is cleaned up and returned using L</canonpath()>. + +Based on code written by Shigio Yamaguchi. + +No checks against the filesystem are made. + +=cut + +sub rel2abs($;$;) { + my ($self,$path,$base ) = @_; + + if ( ! $self->file_name_is_absolute( $path ) ) { + if ( !defined( $base ) || $base eq '' ) { + $base = cwd() ; + } + elsif ( ! $self->file_name_is_absolute( $base ) ) { + $base = $self->rel2abs( $base ) ; + } + else { + $base = $self->canonpath( $base ) ; + } + + $path = $self->canonpath("$base$path") ; + } + + return $path ; +} + + =back =head1 SEE ALSO diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm index 85df2c2d3b..d47a60e9cc 100644 --- a/lib/File/Spec/Unix.pm +++ b/lib/File/Spec/Unix.pm @@ -26,28 +26,15 @@ No physical check on the filesystem, but a logical cleanup of a path. On UNIX eliminated successive slashes and successive "/.". $cpath = File::Spec->canonpath( $path ) ; - $cpath = File::Spec->canonpath( $path, $reduce_ricochet ) ; - -If $reduce_ricochet is present and true, then "dirname/.." -constructs are eliminated from the path. Without $reduce_ricochet, -if dirname is a symbolic link, then "a/dirname/../b" will often -take you to someplace other than "a/b". This is sometimes desirable. -If it's not, setting $reduce_ricochet causes the "dirname/.." to -be removed from this path, resulting in "a/b". This may make -your perl more portable and robust, unless you want to -ricochet (some scripts depend on it). =cut sub canonpath { - my ($self,$path,$reduce_ricochet) = @_; + my ($self,$path) = @_; $path =~ s|/+|/|g unless($^O eq 'cygwin'); # xx////xx -> xx/xx $path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx $path =~ s|^(\./)+|| unless $path eq "./"; # ./xx -> xx $path =~ s|^/(\.\./)+|/|; # /../../xx -> xx - if ( $reduce_ricochet ) { - while ( $path =~ s@[^/]+/\.\.(?:/|$)@@ ) {}# xx/.. -> xx - } $path =~ s|/$|| unless $path eq "/"; # xx/ -> xx return $path; } @@ -281,8 +268,8 @@ sub splitdir { =item catpath Takes volume, directory and file portions and returns an entire path. Under -Unix, $volume is ignored, and this is just like catfile(). On other OSs, -the $volume become significant. +Unix, $volume is ignored, and directory and file are catenated. A '/' is +inserted if need be. On other OSs, $volume is significant. =cut diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm index 79491463cd..71c38f222f 100644 --- a/lib/File/Spec/VMS.pm +++ b/lib/File/Spec/VMS.pm @@ -263,6 +263,220 @@ sub file_name_is_absolute { $file =~ /:[^<\[]/); } +=item splitpath + + ($volume,$directories,$file) = File::Spec->splitpath( $path ); + ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); + +Splits a VMS path in to volume, directory, and filename portions. +Ignores $no_file, if present, since VMS paths indicate the 'fileness' of a +file. + +The results can be passed to L</catpath()> to get back a path equivalent to +(usually identical to) the original path. + +=cut + +sub splitpath { + my $self = shift ; + my ($path, $nofile) = @_; + + my ($volume,$directory,$file) ; + + if ( $path =~ m{/} ) { + $path =~ + m{^ ( (?: /[^/]* )? ) + ( (?: .*/(?:[^/]+.dir)? )? ) + (.*) + }x; + $volume = $1; + $directory = $2; + $file = $3; + } + else { + $path =~ + m{^ ( (?: (?: (?: [\w\$-]+ (?: "[^"]*")?:: )? [\w\$-]+: )? ) ) + ( (?:\[.*\])? ) + (.*) + }x; + $volume = $1; + $directory = $2; + $file = $3; + } + + $directory = $1 + if $directory =~ /^\[(.*)\]$/ ; + + return ($volume,$directory,$file); +} + + +=item splitdir + +The opposite of L</catdir()>. + + @dirs = File::Spec->splitdir( $directories ); + +$directories must be only the directory portion of the path. + +'[' and ']' delimiters are optional. An empty string argument is +equivalent to '[]': both return an array with no elements. + +=cut + +sub splitdir { + my $self = shift ; + my $directories = $_[0] ; + + return File::Spec::Unix::splitdir( $self, @_ ) + if ( $directories =~ m{/} ) ; + + $directories =~ s/^\[(.*)\]$/$1/ ; + + # + # split() likes to forget about trailing null fields, so here we + # check to be sure that there will not be any before handling the + # simple case. + # + if ( $directories !~ m{\.$} ) { + return split( m{\.}, $directories ); + } + else { + # + # since there was a trailing separator, add a file name to the end, + # then do the split, then replace it with ''. + # + my( @directories )= split( m{\.}, "${directories}dummy" ) ; + $directories[ $#directories ]= '' ; + return @directories ; + } +} + + +sub catpath { + my $self = shift; + + return File::Spec::Unix::catpath( $self, @_ ) + if ( join( '', @_ ) =~ m{/} ) ; + + my ($volume,$directory,$file) = @_; + + $volume .= ':' + if $volume =~ /[^:]$/ ; + + $directory = "[$directory" + if $directory =~ /^[^\[]/ ; + + $directory .= ']' + if $directory =~ /[^\]]$/ ; + + return "$volume$directory$file" ; +} + + +sub abs2rel { + my $self = shift; + + return File::Spec::Unix::abs2rel( $self, @_ ) + if ( join( '', @_ ) =~ m{/} ) ; + + my($path,$base) = @_; + + # Note: we use '/' to glue things together here, then let canonpath() + # clean them up at the end. + + # Clean up $path + if ( ! $self->file_name_is_absolute( $path ) ) { + $path = $self->rel2abs( $path ) ; + } + else { + $path = $self->canonpath( $path ) ; + } + + # Figure out the effective $base and clean it up. + if ( ! $self->file_name_is_absolute( $base ) ) { + $base = $self->rel2abs( $base ) ; + } + elsif ( !defined( $base ) || $base eq '' ) { + $base = cwd() ; + } + else { + $base = $self->canonpath( $base ) ; + } + + # Split up paths + my ( undef, $path_directories, $path_file ) = + $self->splitpath( $path, 1 ) ; + + $path_directories = $1 + if $path_directories =~ /^\[(.*)\]$/ ; + + my ( undef, $base_directories, undef ) = + $self->splitpath( $base, 1 ) ; + + $base_directories = $1 + if $base_directories =~ /^\[(.*)\]$/ ; + + # Now, remove all leading components that are the same + my @pathchunks = $self->splitdir( $path_directories ); + my @basechunks = $self->splitdir( $base_directories ); + + while ( @pathchunks && + @basechunks && + lc( $pathchunks[0] ) eq lc( $basechunks[0] ) + ) { + shift @pathchunks ; + shift @basechunks ; + } + + # @basechunks now contains the directories to climb out of, + # @pathchunks now has the directories to descend in to. + $path_directories = '-.' x @basechunks . join( '.', @pathchunks ) ; + $path_directories =~ s{\.$}{} ; + return $self->catpath( '', $path_directories, $path_file ) ; +} + + +sub rel2abs($;$;) { + my $self = shift ; + return File::Spec::Unix::rel2abs( $self, @_ ) + if ( join( '', @_ ) =~ m{/} ) ; + + my ($path,$base ) = @_; + # Clean up and split up $path + if ( ! $self->file_name_is_absolute( $path ) ) { + # Figure out the effective $base and clean it up. + if ( !defined( $base ) || $base eq '' ) { + $base = cwd() ; + } + elsif ( ! $self->file_name_is_absolute( $base ) ) { + $base = $self->rel2abs( $base ) ; + } + else { + $base = $self->canonpath( $base ) ; + } + + # Split up paths + my ( undef, $path_directories, $path_file ) = + $self->splitpath( $path ) ; + + my ( $base_volume, $base_directories, undef ) = + $self->splitpath( $base ) ; + + my $sep = '' ; + $sep = '.' + if ( $base_directories =~ m{[^.]$} && + $path_directories =~ m{^[^.]} + ) ; + $base_directories = "$base_directories$sep$path_directories" ; + + $path = $self->catpath( $base_volume, $base_directories, $path_file ); + } + + return $self->canonpath( $path ) ; +} + + =back =head1 SEE ALSO diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm index 120b799cd2..f1c6ccf8c7 100644 --- a/lib/File/Spec/Win32.pm +++ b/lib/File/Spec/Win32.pm @@ -95,7 +95,7 @@ path. On UNIX eliminated successive slashes and successive "/.". =cut sub canonpath { - my ($self,$path,$reduce_ricochet) = @_; + my ($self,$path) = @_; $path =~ s/^([a-z]:)/\u$1/; $path =~ s|/|\\|g; $path =~ s|([^\\])\\+|$1\\|g; # xx////xx -> xx/xx @@ -120,7 +120,7 @@ Separators accepted are \ and /. Volumes can be drive letters or UNC sharenames (\\server\share). -The results can be passed to L</catpath()> to get back a path equivalent to +The results can be passed to L</catpath> to get back a path equivalent to (usually identical to) the original path. =cut @@ -130,21 +130,21 @@ sub splitpath { my ($volume,$directory,$file) = ('','',''); if ( $nofile ) { $path =~ - m@^( (?:[a-zA-Z]:|(?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+)? ) + m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? ) (.*) - @x; + }x; $volume = $1; $directory = $2; } else { $path =~ - m@^ ( (?: [a-zA-Z]: | - (?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+ + m{^ ( (?: [a-zA-Z]: | + (?:\\\\|//)[^\\/]+[\\/][^\\/]+ )? ) ( (?:.*[\\\\/](?:\.\.?$)?)? ) (.*) - @x; + }x; $volume = $1; $directory = $2; $file = $3; @@ -221,8 +221,8 @@ sub catpath { # If the volume is not just A:, make sure the glue separator is # there, reusing whatever separator is first in the $volume if possible. if ( $volume !~ m@^[a-zA-Z]:$@ && - $volume !~ m@[\\/]$@ && - $file !~ m@^[\\/]@ + $volume =~ m@[^\\/]$@ && + $file =~ m@[^\\/]@ ) { $volume =~ m@([\\/])@ ; my $sep = $1 ? $1 : '\\' ; @@ -248,7 +248,7 @@ then it is converted to absolute form using L</rel2abs()>. This means that it is taken to be relative to L<cwd()>. On systems with the concept of a volume, this assumes that both paths -are on the $destination volume, and ignores the $base volume. +are on the $destination volume, and ignores the $base volume. On systems that have a grammar that indicates filenames, this ignores the $base filename as well. Otherwise all path components are assumed to be @@ -325,8 +325,11 @@ sub abs2rel { $path_directories = "$base_directories$path_directories" ; } + # It makes no sense to add a relative path to a UNC volume + $path_volume = '' unless $path_volume =~ m{^[A-Z]:}i ; + return $self->canonpath( - $self->catpath( $path_volume, $path_directories, $path_file ) + $self->catpath($path_volume, $path_directories, $path_file ) ) ; } @@ -359,10 +362,8 @@ No checks against the filesystem are made. sub rel2abs($;$;) { my ($self,$path,$base ) = @_; - # Clean up and split up $path if ( ! $self->file_name_is_absolute( $path ) ) { - # Figure out the effective $base and clean it up. if ( ! $self->file_name_is_absolute( $base ) ) { $base = $self->rel2abs( $base ) ; } @@ -373,7 +374,6 @@ sub rel2abs($;$;) { $base = $self->canonpath( $base ) ; } - # Split up paths my ( undef, $path_directories, $path_file ) = $self->splitpath( $path, 1 ) ; diff --git a/makedef.pl b/makedef.pl index d0ac96d444..0d7707695c 100644 --- a/makedef.pl +++ b/makedef.pl @@ -344,6 +344,7 @@ else { if ($define{'MYMALLOC'}) { emit_symbols [qw( Perl_dump_mstats + Perl_get_mstats Perl_malloc Perl_mfree Perl_realloc @@ -359,6 +360,7 @@ else { skip_symbols [qw( PL_malloc_mutex Perl_dump_mstats + Perl_get_mstats Perl_malloc Perl_mfree Perl_realloc @@ -1818,88 +1818,126 @@ Perl_malloced_size(void *p) # else # define MIN_EVEN_REPORT MIN_BUCKET # endif -/* - * mstats - print out statistics about malloc - * - * Prints two lines of numbers, one showing the length of the free list - * for each size category, the second showing the number of mallocs - - * frees for each size category. - */ -void -Perl_dump_mstats(pTHX_ char *s) + +int +Perl_get_mstats(pTHX_ perl_mstats_t *buf, int buflen, int level) { #ifdef DEBUGGING_MSTATS register int i, j; register union overhead *p; - int topbucket=0, topbucket_ev=0, topbucket_odd=0, totfree=0, total=0; - u_int nfree[NBUCKETS]; - int total_chain = 0; struct chunk_chain_s* nextchain; + buf->topbucket = buf->topbucket_ev = buf->topbucket_odd + = buf->totfree = buf->total = buf->total_chain = 0; + + buf->minbucket = MIN_BUCKET; MALLOC_LOCK; for (i = MIN_BUCKET ; i < NBUCKETS; i++) { for (j = 0, p = nextf[i]; p; p = p->ov_next, j++) ; - nfree[i] = j; - totfree += nfree[i] * BUCKET_SIZE_REAL(i); - total += nmalloc[i] * BUCKET_SIZE_REAL(i); + if (i < buflen) { + buf->nfree[i] = j; + buf->ntotal[i] = nmalloc[i]; + } + buf->totfree += j * BUCKET_SIZE_REAL(i); + buf->total += nmalloc[i] * BUCKET_SIZE_REAL(i); if (nmalloc[i]) { - i % 2 ? (topbucket_odd = i) : (topbucket_ev = i); - topbucket = i; + i % 2 ? (buf->topbucket_odd = i) : (buf->topbucket_ev = i); + buf->topbucket = i; } } nextchain = chunk_chain; while (nextchain) { - total_chain += nextchain->size; + buf->total_chain += nextchain->size; nextchain = nextchain->next; } + buf->total_sbrk = goodsbrk + sbrk_slack; + buf->sbrks = sbrks; + buf->sbrk_good = sbrk_good; + buf->sbrk_slack = sbrk_slack; + buf->start_slack = start_slack; + buf->sbrked_remains = sbrked_remains; MALLOC_UNLOCK; + if (level) { + for (i = MIN_BUCKET ; i < NBUCKETS; i++) { + if (i >= buflen) + break; + buf->bucket_mem_size[i] = BUCKET_SIZE(i); + buf->bucket_available_size[i] = BUCKET_SIZE_REAL(i); + } + } +#endif /* defined DEBUGGING_MSTATS */ +} +/* + * mstats - print out statistics about malloc + * + * Prints two lines of numbers, one showing the length of the free list + * for each size category, the second showing the number of mallocs - + * frees for each size category. + */ +void +Perl_dump_mstats(pTHX_ char *s) +{ +#ifdef DEBUGGING_MSTATS + register int i, j; + register union overhead *p; + perl_mstats_t buffer; + unsigned long nf[NBUCKETS]; + unsigned long nt[NBUCKETS]; + struct chunk_chain_s* nextchain; + + buffer.nfree = nf; + buffer.ntotal = nt; + get_mstats(&buffer, NBUCKETS, 0); + if (s) PerlIO_printf(Perl_error_log, "Memory allocation statistics %s (buckets %ld(%ld)..%ld(%ld)\n", s, (long)BUCKET_SIZE_REAL(MIN_BUCKET), (long)BUCKET_SIZE(MIN_BUCKET), - (long)BUCKET_SIZE_REAL(topbucket), (long)BUCKET_SIZE(topbucket)); - PerlIO_printf(Perl_error_log, "%8d free:", totfree); - for (i = MIN_EVEN_REPORT; i <= topbucket; i += BUCKETS_PER_POW2) { + (long)BUCKET_SIZE_REAL(buffer.topbucket), + (long)BUCKET_SIZE(buffer.topbucket)); + PerlIO_printf(Perl_error_log, "%8d free:", buffer.totfree); + for (i = MIN_EVEN_REPORT; i <= buffer.topbucket; i += BUCKETS_PER_POW2) { PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) ? " %5d" : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")), - nfree[i]); + buffer.nfree[i]); } #ifdef BUCKETS_ROOT2 PerlIO_printf(Perl_error_log, "\n\t "); - for (i = MIN_BUCKET + 1; i <= topbucket_odd; i += BUCKETS_PER_POW2) { + for (i = MIN_BUCKET + 1; i <= buffer.topbucket_odd; i += BUCKETS_PER_POW2) { PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) ? " %5d" : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")), - nfree[i]); + buffer.nfree[i]); } #endif - PerlIO_printf(Perl_error_log, "\n%8d used:", total - totfree); - for (i = MIN_EVEN_REPORT; i <= topbucket; i += BUCKETS_PER_POW2) { + PerlIO_printf(Perl_error_log, "\n%8d used:", buffer.total - buffer.totfree); + for (i = MIN_EVEN_REPORT; i <= buffer.topbucket; i += BUCKETS_PER_POW2) { PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) ? " %5d" : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")), - nmalloc[i] - nfree[i]); + buffer.ntotal[i] - buffer.nfree[i]); } #ifdef BUCKETS_ROOT2 PerlIO_printf(Perl_error_log, "\n\t "); - for (i = MIN_BUCKET + 1; i <= topbucket_odd; i += BUCKETS_PER_POW2) { + for (i = MIN_BUCKET + 1; i <= buffer.topbucket_odd; i += BUCKETS_PER_POW2) { PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) ? " %5d" : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")), - nmalloc[i] - nfree[i]); + buffer.ntotal[i] - buffer.nfree[i]); } #endif PerlIO_printf(Perl_error_log, "\nTotal sbrk(): %d/%d:%d. Odd ends: pad+heads+chain+tail: %d+%d+%d+%d.\n", - goodsbrk + sbrk_slack, sbrks, sbrk_good, sbrk_slack, - start_slack, total_chain, sbrked_remains); + buffer.total_sbrk, buffer.sbrks, buffer.sbrk_good, + buffer.sbrk_slack, buffer.start_slack, + buffer.total_chain, buffer.sbrked_remains); #endif /* DEBUGGING_MSTATS */ } #endif /* lint */ @@ -1830,6 +1830,10 @@ #define Perl_dump_mstats pPerl->Perl_dump_mstats #undef dump_mstats #define dump_mstats Perl_dump_mstats +#undef Perl_get_mstats +#define Perl_get_mstats pPerl->Perl_get_mstats +#undef get_mstats +#define get_mstats Perl_get_mstats #endif #undef Perl_safesysmalloc #define Perl_safesysmalloc pPerl->Perl_safesysmalloc @@ -5719,7 +5719,9 @@ Perl_ck_sassign(pTHX_ OP *o) OP *kid = cLISTOPo->op_first; /* has a disposable target? */ if ((PL_opargs[kid->op_type] & OA_TARGLEX) - && !(kid->op_flags & OPf_STACKED)) + && !(kid->op_flags & OPf_STACKED) + /* Cannot steal the second time! */ + && !(kid->op_private & OPpTARGET_MY)) { OP *kkid = kid->op_sibling; @@ -6456,11 +6458,12 @@ Perl_peep(pTHX_ register OP *o) UNOP *rop; SV *lexname; GV **fields; - SV **svp, **indsvp; + SV **svp, **indsvp, *sv; I32 ind; char *key; STRLEN keylen; + o->op_seq = PL_op_seqmax++; if ((o->op_private & (OPpLVAL_INTRO)) || ((BINOP*)o)->op_last->op_type != OP_CONST) break; @@ -6487,8 +6490,76 @@ Perl_peep(pTHX_ register OP *o) rop->op_ppaddr = PL_ppaddr[OP_RV2AV]; o->op_type = OP_AELEM; o->op_ppaddr = PL_ppaddr[OP_AELEM]; + sv = newSViv(ind); + if (SvREADONLY(*svp)) + SvREADONLY_on(sv); + SvFLAGS(sv) |= (SvFLAGS(*svp) + & (SVs_PADBUSY|SVs_PADTMP|SVs_PADMY)); SvREFCNT_dec(*svp); - *svp = newSViv(ind); + *svp = sv; + break; + } + + case OP_HSLICE: { + UNOP *rop; + SV *lexname; + GV **fields; + SV **svp, **indsvp, *sv; + I32 ind; + char *key; + STRLEN keylen; + SVOP *first_key_op, *key_op; + + o->op_seq = PL_op_seqmax++; + if ((o->op_private & (OPpLVAL_INTRO)) + /* I bet there's always a pushmark... */ + || ((LISTOP*)o)->op_first->op_sibling->op_type != OP_LIST) + /* hmmm, no optimization if list contains only one key. */ + break; + rop = (UNOP*)((LISTOP*)o)->op_last; + if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV) + break; + lexname = *av_fetch(PL_comppad_name, rop->op_first->op_targ, TRUE); + if (!SvOBJECT(lexname)) + break; + fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE); + if (!fields || !GvHV(*fields)) + break; + /* Again guessing that the pushmark can be jumped over.... */ + first_key_op = (SVOP*)((LISTOP*)((LISTOP*)o)->op_first->op_sibling) + ->op_first->op_sibling; + /* Check that the key list contains only constants. */ + for (key_op = first_key_op; key_op; + key_op = (SVOP*)key_op->op_sibling) + if (key_op->op_type != OP_CONST) + break; + if (key_op) + break; + rop->op_type = OP_RV2AV; + rop->op_ppaddr = PL_ppaddr[OP_RV2AV]; + o->op_type = OP_ASLICE; + o->op_ppaddr = PL_ppaddr[OP_ASLICE]; + for (key_op = first_key_op; key_op; + key_op = (SVOP*)key_op->op_sibling) { + svp = cSVOPx_svp(key_op); + key = SvPV(*svp, keylen); + indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE); + if (!indsvp) { + Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" " + "in variable %s of type %s", + key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname))); + } + ind = SvIV(*indsvp); + if (ind < 1) + Perl_croak(aTHX_ "Bad index while coercing array into hash"); + sv = newSViv(ind); + if (SvREADONLY(*svp)) + SvREADONLY_on(sv); + SvFLAGS(sv) |= (SvFLAGS(*svp) + & (SVs_PADBUSY|SVs_PADTMP|SVs_PADMY)); + SvREFCNT_dec(*svp); + *svp = sv; + } break; } diff --git a/patchlevel.h b/patchlevel.h index 3c6f5a7c92..b36e20c4ff 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -5,7 +5,7 @@ #define PERL_REVISION 5 /* age */ #define PERL_VERSION 5 /* epoch */ -#define PERL_SUBVERSION 650 /* generation */ +#define PERL_SUBVERSION 660 /* generation */ /* The following numbers describe the earliest compatible version of Perl ("compatibility" here being defined as sufficient binary/API @@ -523,11 +523,15 @@ perl_destruct(pTHXx) PL_formtarget = Nullsv; /* free locale stuff */ +#ifdef USE_LOCALE_COLLATE Safefree(PL_collation_name); PL_collation_name = Nullch; +#endif +#ifdef USE_LOCALE_NUMERIC Safefree(PL_numeric_name); PL_numeric_name = Nullch; +#endif /* clear utf8 character classes */ SvREFCNT_dec(PL_utf8_alnum); @@ -529,6 +529,19 @@ Malloc_t Perl_realloc (Malloc_t where, MEM_SIZE nbytes); * that causes clashes with case-insensitive linkers */ Free_t Perl_mfree (Malloc_t where); +typedef struct perl_mstats perl_mstats_t; + +struct perl_mstats { + unsigned long *nfree; + unsigned long *ntotal; + long topbucket, topbucket_ev, topbucket_odd, totfree, total, total_chain; + long total_sbrk, sbrks, sbrk_good, sbrk_slack, start_slack, sbrked_remains; + long minbucket; + /* Level 1 info */ + unsigned long *bucket_mem_size; + unsigned long *bucket_available_size; +}; + # define safemalloc Perl_malloc # define safecalloc Perl_calloc # define saferealloc Perl_realloc @@ -3301,6 +3301,13 @@ Perl_dump_mstats(pTHXo_ char* s) { ((CPerlObj*)pPerl)->Perl_dump_mstats(s); } + +#undef Perl_get_mstats +int +Perl_get_mstats(pTHXo_ perl_mstats_t *buf, int buflen, int level) +{ + return ((CPerlObj*)pPerl)->Perl_get_mstats(buf, buflen, level); +} #endif #undef Perl_safesysmalloc diff --git a/pod/perldata.pod b/pod/perldata.pod index 0b83214a73..a122d34c80 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -600,16 +600,16 @@ of how to arrange for an output ordering. =head2 Slices -A common way access an array or a hash is one scalar element at a time. -You can also subscript a list to get a single element from it. +A common way to access an array or a hash is one scalar element at a +time. You can also subscript a list to get a single element from it. $whoami = $ENV{"USER"}; # one element from the hash $parent = $ISA[0]; # one element from the array $dir = (getpwnam("daemon"))[7]; # likewise, but with list A slice accesses several elements of a list, an array, or a hash -simultaneously using a list of subscripts. It's a more convenient -that writing out the individual elements as a list of separate +simultaneously using a list of subscripts. It's more convenient +than writing out the individual elements as a list of separate scalar values. ($him, $her) = @folks[0,-1]; # array slice @@ -633,8 +633,8 @@ The previous assignments are exactly equivalent to ($folks[0], $folks[-1]) = ($folks[0], $folks[-1]); Since changing a slice changes the original array or hash that it's -slicing, a C<foreach> construct will alter through some--or even -all--of the values of the array or hash. +slicing, a C<foreach> construct will alter some--or even all--of the +values of the array or hash. foreach (@array[ 4 .. 10 ]) { s/peter/paul/ } @@ -644,15 +644,16 @@ all--of the values of the array or hash. s/(\w+)/\u\L$1/g; # "titlecase" words } -You couldn't just loop through C<values %hash> to do this because -that function produces a new list which is a copy of the values, -so changing them doesn't change the original. - A slice of an empty list is still an empty list. Thus: @a = ()[1,0]; # @a has no elements @b = (@a)[0,1]; # @b has no elements - @b = (1,undef)[1,0,1]; # @b has three elements + @c = (0,1)[2,3]; # @c has no elements + +But: + + @a = (1)[1,0]; # @a has two elements + @b = (1,undef)[1,0,2]; # @b has three elements This makes it easy to write loops that terminate when a null list is returned: diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 740a2fb094..46dd6564e4 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -532,10 +532,10 @@ C<oct()>: Perl now allows the arrow to be omitted in many constructs involving subroutine calls through references. For example, -C<$foo[10]->('foo')> may now be written C<$foo[10]('foo')>. +C<$foo[10]-E<gt>('foo')> may now be written C<$foo[10]('foo')>. This is rather similar to how the arrow may be omitted from -C<$foo[10]->{'foo'}>. Note however, that the arrow is still -required for C<foo(10)->('bar')>. +C<$foo[10]-E<gt>{'foo'}>. Note however, that the arrow is still +required for C<foo(10)-E<gt>('bar')>. =head2 exists() is supported on subroutine names @@ -549,15 +549,17 @@ The exists() and delete() builtins now work on simple arrays as well. The behavior is similar to that on hash elements. exists() can be used to check whether an array element has been -initialized without autovivifying it. If the array is tied, the -EXISTS() method in the corresponding tied package will be invoked. +initialized. This avoids autovivifying array elements that don't exist. +If the array is tied, the EXISTS() method in the corresponding tied +package will be invoked. delete() may be used to remove an element from the array and return it. The array element at that position returns to its unintialized state, so that testing for the same element with exists() will return false. If the element happens to be the one at the end, the size of -the array also shrinks by one. If the array is tied, the DELETE() method -in the corresponding tied package will be invoked. +the array also shrinks up to the highest element that tests true for +exists(), or 0 if none such is found. If the array is tied, the DELETE() +method in the corresponding tied package will be invoked. See L<perlfunc/exists> and L<perlfunc/delete> for examples. @@ -567,7 +569,7 @@ The length argument of C<syswrite()> has become optional. =head2 File and directory handles can be autovivified -Similar to how constructs such as C<$x->[0]> autovivify a reference, +Similar to how constructs such as C<$x-E<gt>[0]> autovivify a reference, handle constructors (open(), opendir(), pipe(), socketpair(), sysopen(), socket(), and accept()) now autovivify a file or directory handle if the handle passed to them is an uninitialized scalar variable. This @@ -964,7 +966,7 @@ array element in that slot. =head2 Pseudo-hashes work better Dereferencing some types of reference values in a pseudo-hash, -such as C<$ph->{foo}[1]>, was accidentally disallowed. This has +such as C<$ph-E<gt>{foo}[1]>, was accidentally disallowed. This has been corrected. When applied to a pseudo-hash element, exists() now reports whether @@ -1625,6 +1627,11 @@ fixed. Sys::Syslog now uses XSUBs to access facilities from syslog.h so it no longer requires syslog.ph to exist. +=item Sys::Hostname + +Sys::Hostname now uses XSUBs to call the C library's gethostname() or +uname() if they exist. + =item Time::Local The timelocal() and timegm() functions used to silently return bogus diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 88cbb0a6e5..e8f4fe0880 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -929,8 +929,9 @@ See also L</undef>, L</exists>, L</ref>. Given an expression that specifies a hash element, array element, hash slice, or array slice, deletes the specified element(s) from the hash or array. -If the array elements happen to be at the end of the array, the size -of the array will shrink by that number of elements. +In the case of an array, if the array elements happen to be at the end, +the size of the array will shrink to the highest element that tests +true for exists() (or 0 if no such element exists). Returns each element so deleted or the undefined value if there was no such element. Deleting from C<$ENV{}> modifies the environment. Deleting from @@ -939,7 +940,9 @@ from a C<tie>d hash or array may not necessarily return anything. Deleting an array element effectively returns that position of the array to its initial, uninitialized state. Subsequently testing for the same -element with exists() will return false. See L</exists>. +element with exists() will return false. Note that deleting array +elements in the middle of an array will not shift the index of the ones +after them down--use splice() for that. See L</exists>. The following (inefficiently) deletes all the values of %HASH and @ARRAY: diff --git a/pod/perlport.pod b/pod/perlport.pod index 7a500f8838..7533abd2f2 100644 --- a/pod/perlport.pod +++ b/pod/perlport.pod @@ -90,7 +90,7 @@ Perl uses C<\n> to represent the "logical" newline, where what is logical may depend on the platform in use. In MacPerl, C<\n> always means C<\015>. In DOSish perls, C<\n> usually means C<\012>, but when accessing a file in "text" mode, STDIO translates it to (or -from) C<\015\012>, depending on whether your reading or writing. +from) C<\015\012>, depending on whether you're reading or writing. Unix does the same thing on ttys in canonical mode. C<\015\012> is commonly referred to as CRLF. @@ -1675,6 +1675,10 @@ Not useful. (S<RISC OS>) =over 4 +=item v1.46, 12 February 2000 + +Updates for VOS and MPE/iX. (Peter Prymmer) Other small changes. + =item v1.45, 20 December 1999 Small changes from 5.005_63 distribution, more changes to EBCDIC info. @@ -1786,4 +1790,4 @@ E<lt>pudge@pobox.comE<gt>. =head1 VERSION -Version 1.45, last modified 20 December 1999 +Version 1.46, last modified 12 February 2000 diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod index f07bdfeabf..7b9590e4de 100644 --- a/pod/perlsyn.pod +++ b/pod/perlsyn.pod @@ -593,7 +593,7 @@ this, one can control Perl's idea of filenames and line numbers in error or warning messages (especially for strings that are processed with C<eval()>). The syntax for this mechanism is the same as for most C preprocessors: it matches the regular expression -C</^#\s*line\s+(\d+)\s*(?:\s"([^"]*)")?/> with C<$1> being the line +C</^#\s*line\s+(\d+)\s*(?:\s"([^"]+)")?\s*$/> with C<$1> being the line number for the next line, and C<$2> being the optional filename (specified within quotes). @@ -820,6 +820,7 @@ PERL_CALLCONV int Perl_yyparse(pTHX); PERL_CALLCONV int Perl_yywarn(pTHX_ char* s); #if defined(MYMALLOC) PERL_CALLCONV void Perl_dump_mstats(pTHX_ char* s); +PERL_CALLCONV int Perl_get_mstats(pTHX_ perl_mstats_t *buf, int buflen, int level); #endif PERL_CALLCONV Malloc_t Perl_safesysmalloc(MEM_SIZE nbytes); PERL_CALLCONV Malloc_t Perl_safesyscalloc(MEM_SIZE elements, MEM_SIZE size); diff --git a/t/lib/fields.t b/t/lib/fields.t index 74be2c2a4f..01f93892b0 100755 --- a/t/lib/fields.t +++ b/t/lib/fields.t @@ -90,7 +90,7 @@ my %expect = ( 'Foo::Bar::Baz' => 'b1:1,b2:2,b3:3,foo:4,bar:5,baz:6', ); -print "1..", int(keys %expect)+5, "\n"; +print "1..", int(keys %expect)+7, "\n"; my $testno = 0; while (my($class, $exp) = each %expect) { no strict 'refs'; @@ -117,6 +117,14 @@ eval q(my D3 $obj3 = $obj2; $obj3->{notthere} = ""); print "not " unless $@ && $@ =~ /^No such pseudo-hash field "notthere"/; print "ok ", ++$testno, "\n"; +# Slices +@$obj1{"_b1", "b1"} = (17, 29); +print "not " unless "@$obj1[1,2]" eq "17 29"; +print "ok ", ++$testno, "\n"; +@$obj1[1,2] = (44,28); +print "not " unless "@$obj1{'b1','_b1','b1'}" eq "28 44 28"; +print "ok ", ++$testno, "\n"; + #fields::_dump(); # check if diff --git a/t/lib/filespec.t b/t/lib/filespec.t index 3aeed17958..9c273d2f26 100755 --- a/t/lib/filespec.t +++ b/t/lib/filespec.t @@ -6,38 +6,378 @@ BEGIN { unshift @INC, '../lib'; } -print "1..4\n"; +# Each element in this array is a single test. Storing them this way makes +# maintenance easy, and should be OK since perl should be pretty functional +# before these tests are run. -use File::Spec; +@tests = ( +# Function Expected +[ "Unix->catfile('a','b','c')", 'a/b/c' ], +[ "Unix->splitpath('file')", ',,file' ], +[ "Unix->splitpath('/d1/d2/d3/')", ',/d1/d2/d3/,' ], +[ "Unix->splitpath('d1/d2/d3/')", ',d1/d2/d3/,' ], +[ "Unix->splitpath('/d1/d2/d3/.')", ',/d1/d2/d3/.,' ], +[ "Unix->splitpath('/d1/d2/d3/..')", ',/d1/d2/d3/..,' ], +[ "Unix->splitpath('/d1/d2/d3/.file')", ',/d1/d2/d3/,.file' ], +[ "Unix->splitpath('d1/d2/d3/file')", ',d1/d2/d3/,file' ], +[ "Unix->splitpath('/../../d1/')", ',/../../d1/,' ], +[ "Unix->splitpath('/././d1/')", ',/././d1/,' ], -if (File::Spec->catfile('a','b','c') eq 'a/b/c') { - print "ok 1\n"; -} else { - print "not ok 1\n"; -} +[ "Unix->catpath('','','file')", 'file' ], +[ "Unix->catpath('','/d1/d2/d3/','')", '/d1/d2/d3/' ], +[ "Unix->catpath('','d1/d2/d3/','')", 'd1/d2/d3/' ], +[ "Unix->catpath('','/d1/d2/d3/.','')", '/d1/d2/d3/.' ], +[ "Unix->catpath('','/d1/d2/d3/..','')", '/d1/d2/d3/..' ], +[ "Unix->catpath('','/d1/d2/d3/','.file')", '/d1/d2/d3/.file' ], +[ "Unix->catpath('','d1/d2/d3/','file')", 'd1/d2/d3/file' ], +[ "Unix->catpath('','/../../d1/','')", '/../../d1/' ], +[ "Unix->catpath('','/././d1/','')", '/././d1/' ], +[ "Unix->catpath('d1','d2/d3/','')", 'd2/d3/' ], +[ "Unix->catpath('d1','d2','d3/')", 'd2/d3/' ], -use File::Spec::OS2; +[ "Unix->splitdir('')", '' ], +[ "Unix->splitdir('/d1/d2/d3/')", ',d1,d2,d3,' ], +[ "Unix->splitdir('d1/d2/d3/')", 'd1,d2,d3,' ], +[ "Unix->splitdir('/d1/d2/d3')", ',d1,d2,d3' ], +[ "Unix->splitdir('d1/d2/d3')", 'd1,d2,d3' ], -if (File::Spec::OS2->catfile('a','b','c') eq 'a/b/c') { - print "ok 2\n"; -} else { - print "not ok 2\n"; -} +[ "Unix->catdir()", '' ], +[ "Unix->catdir('/')", '/' ], +[ "Unix->catdir('','d1','d2','d3','')", '/d1/d2/d3' ], +[ "Unix->catdir('d1','d2','d3','')", 'd1/d2/d3' ], +[ "Unix->catdir('','d1','d2','d3')", '/d1/d2/d3' ], +[ "Unix->catdir('d1','d2','d3')", 'd1/d2/d3' ], + +[ "Unix->catfile('a','b','c')", 'a/b/c' ], + +[ "Unix->canonpath('')", '' ], +[ "Unix->canonpath('///../../..//./././a//b/.././c/././')", '/a/b/../c' ], +[ "Unix->canonpath('/.')", '/.' ], + +[ "Unix->abs2rel('/t1/t2/t3','/t1/t2/t3')", '' ], +[ "Unix->abs2rel('/t1/t2/t4','/t1/t2/t3')", '../t4' ], +[ "Unix->abs2rel('/t1/t2','/t1/t2/t3')", '..' ], +[ "Unix->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')", 't4' ], +[ "Unix->abs2rel('/t4/t5/t6','/t1/t2/t3')", '../../../t4/t5/t6' ], +#[ "Unix->abs2rel('../t4','/t1/t2/t3')", '../t4' ], +[ "Unix->abs2rel('/','/t1/t2/t3')", '../../..' ], +[ "Unix->abs2rel('///','/t1/t2/t3')", '../../..' ], +[ "Unix->abs2rel('/.','/t1/t2/t3')", '../../../.' ], +[ "Unix->abs2rel('/./','/t1/t2/t3')", '../../..' ], +#[ "Unix->abs2rel('../t4','/t1/t2/t3')", '../t4' ], + +[ "Unix->rel2abs('t4','/t1/t2/t3')", '/t1/t2/t3/t4' ], +[ "Unix->rel2abs('t4/t5','/t1/t2/t3')", '/t1/t2/t3/t4/t5' ], +[ "Unix->rel2abs('.','/t1/t2/t3')", '/t1/t2/t3' ], +[ "Unix->rel2abs('..','/t1/t2/t3')", '/t1/t2/t3/..' ], +[ "Unix->rel2abs('../t4','/t1/t2/t3')", '/t1/t2/t3/../t4' ], +[ "Unix->rel2abs('/t1','/t1/t2/t3')", '/t1' ], + +[ "Win32->splitpath('file')", ',,file' ], +[ "Win32->splitpath('\\d1/d2\\d3/')", ',\\d1/d2\\d3/,' ], +[ "Win32->splitpath('d1/d2\\d3/')", ',d1/d2\\d3/,' ], +[ "Win32->splitpath('\\d1/d2\\d3/.')", ',\\d1/d2\\d3/.,' ], +[ "Win32->splitpath('\\d1/d2\\d3/..')", ',\\d1/d2\\d3/..,' ], +[ "Win32->splitpath('\\d1/d2\\d3/.file')", ',\\d1/d2\\d3/,.file' ], +[ "Win32->splitpath('\\d1/d2\\d3/file')", ',\\d1/d2\\d3/,file' ], +[ "Win32->splitpath('d1/d2\\d3/file')", ',d1/d2\\d3/,file' ], +[ "Win32->splitpath('C:\\d1/d2\\d3/')", 'C:,\\d1/d2\\d3/,' ], +[ "Win32->splitpath('C:d1/d2\\d3/')", 'C:,d1/d2\\d3/,' ], +[ "Win32->splitpath('C:\\d1/d2\\d3/file')", 'C:,\\d1/d2\\d3/,file' ], +[ "Win32->splitpath('C:d1/d2\\d3/file')", 'C:,d1/d2\\d3/,file' ], +[ "Win32->splitpath('C:\\../d2\\d3/file')", 'C:,\\../d2\\d3/,file' ], +[ "Win32->splitpath('C:../d2\\d3/file')", 'C:,../d2\\d3/,file' ], +[ "Win32->splitpath('\\../..\\d1/')", ',\\../..\\d1/,' ], +[ "Win32->splitpath('\\./.\\d1/')", ',\\./.\\d1/,' ], +[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/')", '\\\\node\\share,\\d1/d2\\d3/,' ], +[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/file')", '\\\\node\\share,\\d1/d2\\d3/,file' ], +[ "Win32->splitpath('\\\\node\\share\\d1/d2\\file')", '\\\\node\\share,\\d1/d2\\,file' ], +[ "Win32->splitpath('file',1)", ',file,' ], +[ "Win32->splitpath('\\d1/d2\\d3/',1)", ',\\d1/d2\\d3/,' ], +[ "Win32->splitpath('d1/d2\\d3/',1)", ',d1/d2\\d3/,' ], +[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/',1)", '\\\\node\\share,\\d1/d2\\d3/,' ], + +[ "Win32->catpath('','','file')", 'file' ], +[ "Win32->catpath('','\\d1/d2\\d3/','')", '\\d1/d2\\d3/' ], +[ "Win32->catpath('','d1/d2\\d3/','')", 'd1/d2\\d3/' ], +[ "Win32->catpath('','\\d1/d2\\d3/.','')", '\\d1/d2\\d3/.' ], +[ "Win32->catpath('','\\d1/d2\\d3/..','')", '\\d1/d2\\d3/..' ], +[ "Win32->catpath('','\\d1/d2\\d3/','.file')", '\\d1/d2\\d3/.file' ], +[ "Win32->catpath('','\\d1/d2\\d3/','file')", '\\d1/d2\\d3/file' ], +[ "Win32->catpath('','d1/d2\\d3/','file')", 'd1/d2\\d3/file' ], +[ "Win32->catpath('C:','\\d1/d2\\d3/','')", 'C:\\d1/d2\\d3/' ], +[ "Win32->catpath('C:','d1/d2\\d3/','')", 'C:d1/d2\\d3/' ], +[ "Win32->catpath('C:','\\d1/d2\\d3/','file')", 'C:\\d1/d2\\d3/file' ], +[ "Win32->catpath('C:','d1/d2\\d3/','file')", 'C:d1/d2\\d3/file' ], +[ "Win32->catpath('C:','\\../d2\\d3/','file')", 'C:\\../d2\\d3/file' ], +[ "Win32->catpath('C:','../d2\\d3/','file')", 'C:../d2\\d3/file' ], +[ "Win32->catpath('','\\../..\\d1/','')", '\\../..\\d1/' ], +[ "Win32->catpath('','\\./.\\d1/','')", '\\./.\\d1/' ], +[ "Win32->catpath('\\\\node\\share','\\d1/d2\\d3/','')", '\\\\node\\share\\d1/d2\\d3/' ], +[ "Win32->catpath('\\\\node\\share','\\d1/d2\\d3/','file')", '\\\\node\\share\\d1/d2\\d3/file' ], +[ "Win32->catpath('\\\\node\\share','\\d1/d2\\','file')", '\\\\node\\share\\d1/d2\\file' ], + +[ "Win32->splitdir('')", '' ], +[ "Win32->splitdir('\\d1/d2\\d3/')", ',d1,d2,d3,' ], +[ "Win32->splitdir('d1/d2\\d3/')", 'd1,d2,d3,' ], +[ "Win32->splitdir('\\d1/d2\\d3')", ',d1,d2,d3' ], +[ "Win32->splitdir('d1/d2\\d3')", 'd1,d2,d3' ], + +[ "Win32->catdir()", '' ], +[ "Win32->catdir('')", '\\' ], +[ "Win32->catdir('/')", '\\' ], +[ "Win32->catdir('//d1','d2')", '\\\\d1\\d2' ], +[ "Win32->catdir('','/d1','d2')", '\\\\d1\\d2' ], +[ "Win32->catdir('','','/d1','d2')", '\\\\\\d1\\d2' ], +[ "Win32->catdir('','//d1','d2')", '\\\\\\d1\\d2' ], +[ "Win32->catdir('','','//d1','d2')", '\\\\\\\\d1\\d2' ], +[ "Win32->catdir('','d1','','d2','')", '\\d1\\d2' ], +[ "Win32->catdir('','d1','d2','d3','')", '\\d1\\d2\\d3' ], +[ "Win32->catdir('d1','d2','d3','')", 'd1\\d2\\d3' ], +[ "Win32->catdir('','d1','d2','d3')", '\\d1\\d2\\d3' ], +[ "Win32->catdir('d1','d2','d3')", 'd1\\d2\\d3' ], +[ "Win32->catdir('A:/d1','d2','d3')", 'A:\\d1\\d2\\d3' ], +[ "Win32->catdir('A:/d1','d2','d3','')", 'A:\\d1\\d2\\d3' ], +#[ "Win32->catdir('A:/d1','B:/d2','d3','')", 'A:\\d1\\d2\\d3' ], +[ "Win32->catdir('A:/d1','B:/d2','d3','')", 'A:\\d1\\B:\\d2\\d3' ], +[ "Win32->catdir('A:/')", 'A:\\' ], + +[ "Win32->catfile('a','b','c')", 'a\\b\\c' ], + +[ "Win32->canonpath('')", '' ], +[ "Win32->canonpath('a:')", 'A:' ], +[ "Win32->canonpath('A:f')", 'A:f' ], +[ "Win32->canonpath('//a\\b//c')", '\\\\a\\b\\c' ], +[ "Win32->canonpath('/a/..../c')", '\\a\\....\\c' ], +[ "Win32->canonpath('//a/b\\c')", '\\\\a\\b\\c' ], +[ "Win32->canonpath('////')", '\\\\\\' ], +[ "Win32->canonpath('//')", '\\' ], +[ "Win32->canonpath('/.')", '\\.' ], +[ "Win32->canonpath('//a/b/../../c')", '\\\\a\\b\\..\\..\\c' ], +[ "Win32->canonpath('//a/../../c')", '\\\\a\\..\\..\\c' ], + +[ "Win32->abs2rel('/t1/t2/t3','/t1/t2/t3')", '' ], +[ "Win32->abs2rel('/t1/t2/t4','/t1/t2/t3')", '..\\t4' ], +[ "Win32->abs2rel('/t1/t2','/t1/t2/t3')", '..' ], +[ "Win32->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')", 't4' ], +[ "Win32->abs2rel('/t4/t5/t6','/t1/t2/t3')", '..\\..\\..\\t4\\t5\\t6' ], +#[ "Win32->abs2rel('../t4','/t1/t2/t3')", '\\t1\\t2\\t3\\..\\t4' ], +[ "Win32->abs2rel('/','/t1/t2/t3')", '..\\..\\..' ], +[ "Win32->abs2rel('///','/t1/t2/t3')", '..\\..\\..' ], +[ "Win32->abs2rel('/.','/t1/t2/t3')", '..\\..\\..\\.' ], +[ "Win32->abs2rel('/./','/t1/t2/t3')", '..\\..\\..' ], +[ "Win32->abs2rel('\\\\a/t1/t2/t4','/t2/t3')", '..\\t4' ], +[ "Win32->abs2rel('//a/t1/t2/t4','/t2/t3')", '..\\t4' ], + +[ "Win32->rel2abs('temp','C:/')", 'C:\\temp' ], +[ "Win32->rel2abs('temp','C:/a')", 'C:\\a\\temp' ], +[ "Win32->rel2abs('temp','C:/a/')", 'C:\\a\\temp' ], +[ "Win32->rel2abs('../','C:/')", 'C:\\..' ], +[ "Win32->rel2abs('../','C:/a')", 'C:\\a\\..' ], +[ "Win32->rel2abs('temp','//prague_main/work/')", '\\\\prague_main\\work\\temp' ], +[ "Win32->rel2abs('../temp','//prague_main/work/')", '\\\\prague_main\\work\\..\\temp' ], +[ "Win32->rel2abs('temp','//prague_main/work')", '\\\\prague_main\\work\\temp' ], +[ "Win32->rel2abs('../','//prague_main/work')", '\\\\prague_main\\work\\..' ], + +[ "VMS->splitpath('file')", ',,file' ], +[ "VMS->splitpath('[d1.d2.d3]')", ',d1.d2.d3,' ], +[ "VMS->splitpath('[.d1.d2.d3]')", ',.d1.d2.d3,' ], +[ "VMS->splitpath('[d1.d2.d3]file')", ',d1.d2.d3,file' ], +[ "VMS->splitpath('d1/d2/d3/file')", ',d1/d2/d3/,file' ], +[ "VMS->splitpath('/d1/d2/d3/file')", '/d1,/d2/d3/,file' ], +[ "VMS->splitpath('[.d1.d2.d3]file')", ',.d1.d2.d3,file' ], +[ "VMS->splitpath('node::volume:[d1.d2.d3]')", 'node::volume:,d1.d2.d3,' ], +[ "VMS->splitpath('node::volume:[d1.d2.d3]file')", 'node::volume:,d1.d2.d3,file' ], +[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]')", 'node"access_spec"::volume:,d1.d2.d3,' ], +[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]file')", 'node"access_spec"::volume:,d1.d2.d3,file' ], + +[ "VMS->catpath('','','file')", 'file' ], +[ "VMS->catpath('','[d1.d2.d3]','')", '[d1.d2.d3]' ], +[ "VMS->catpath('','[.d1.d2.d3]','')", '[.d1.d2.d3]' ], +[ "VMS->catpath('','[d1.d2.d3]','file')", '[d1.d2.d3]file' ], +[ "VMS->catpath('','[.d1.d2.d3]','file')", '[.d1.d2.d3]file' ], +[ "VMS->catpath('','d1/d2/d3','file')", 'd1/d2/d3/file' ], +[ "VMS->catpath('v','d1/d2/d3','file')", 'd1/d2/d3/file' ], +[ "VMS->catpath('node::volume:','[d1.d2.d3]','')", 'node::volume:[d1.d2.d3]' ], +[ "VMS->catpath('node::volume:','[d1.d2.d3]','file')", 'node::volume:[d1.d2.d3]file' ], +[ "VMS->catpath('node\"access_spec\"::volume:','[d1.d2.d3]','')", 'node"access_spec"::volume:[d1.d2.d3]' ], +[ "VMS->catpath('node\"access_spec\"::volume:','[d1.d2.d3]','file')", 'node"access_spec"::volume:[d1.d2.d3]file' ], + +[ "VMS->canonpath('')", '' ], +# There's no VMS specific canonpath +#[ "VMS->canonpath('volume:[d1]file')", 'volume:[d1]file' ], +#[ "VMS->canonpath('LOGICAL:[LOGICAL]LOGICAL')", 'LOGICAL:[VULCAN]LOGICAL' ], +#[ "VMS->canonpath('volume:[d1]d2.dir')", 'volume:[d1.d2]' ], +#[ "VMS->canonpath('volume:[d1]d2.dir;1')", 'volume:[d1.d2]' ], +#[ "VMS->canonpath('volume:[d1.d2.--]file')", 'volume:[d1.d2.-.-]file' ], +[ "VMS->canonpath('///../../..//./././a//b/.././c/././')", '/a/b/../c' ], + +[ "VMS->splitdir('')", '' ], +[ "VMS->splitdir('[]')", '' ], +[ "VMS->splitdir('d1.d2.d3')", 'd1,d2,d3' ], +[ "VMS->splitdir('[d1.d2.d3]')", 'd1,d2,d3' ], +[ "VMS->splitdir('.d1.d2.d3')", ',d1,d2,d3' ], +[ "VMS->splitdir('[.d1.d2.d3]')", ',d1,d2,d3' ], +[ "VMS->splitdir('.-.d2.d3')", ',-,d2,d3' ], +[ "VMS->splitdir('[.-.d2.d3]')", ',-,d2,d3' ], + +[ "VMS->catdir('')", '[]' ], +[ "VMS->catdir('d1','d2','d3')", '[d1.d2.d3]' ], +[ "VMS->catdir('d1','d2/','d3')", '[d1.d2.d3]' ], +[ "VMS->catdir('','d1','d2','d3')", '[.d1.d2.d3]' ], +[ "VMS->catdir('','-','d2','d3')", '[.-.d2.d3]' ], +[ "VMS->catdir('','-','d2','d3')", '[.-.d2.d3]' ], +[ "VMS->catdir('','-','','d3')", '[.-.d3]' ], +[ "VMS->catdir('[]','<->','[]','[d3]')", '[.-.d3]' ], +[ "VMS->catdir('dir.dir','d2.dir','d3.dir')", '[dir.d2.d3]' ], +[ "VMS->catdir('[.name]')", '[.name]' ], +[ "VMS->catdir('[.name]','[.name]')", '[.name.name]'], +[ "VMS->catdir('a:[.name]','b:[.name]')", '[.name.name]'], +[ "VMS->catdir('LOGICAL:[.LOGICAL]LOGICAL','LOGICAL:[.LOGICAL]LOGICAL')", '[.LOGICAL.LOGICAL]'], +[ "VMS->catdir('LOGICAL','LOGICAL')", '[VULCAN.VULCAN]'], + +[ "VMS->abs2rel('node::volume:[t1.t2.t3]','[t1.t2.t3]')", '' ], +[ "VMS->abs2rel('node::volume:[t1.t2.t4]','[t1.t2.t3]')", '[-.t4]' ], +[ "VMS->abs2rel('[t1.t2.t3]','[t1.t2.t3]')", '' ], +[ "VMS->abs2rel('[t1.t2.t3]file','[t1.t2.t3]')", 'file' ], +[ "VMS->abs2rel('[t1.t2.t4]','[t1.t2.t3]')", '[-.t4]' ], +[ "VMS->abs2rel('[t1.t2]file','[t1.t2.t3]')", '[-]file' ], +[ "VMS->abs2rel('[t1.t2.t3.t4]','[t1.t2.t3]')", '[t4]' ], +[ "VMS->abs2rel('[t4.t5.t6]','[t1.t2.t3]')", '[-.-.-.t4.t5.t6]' ], +#[ "VMS->abs2rel('[]','[t1.t2.t3]')", '[-.-.-]' ], +#[ "VMS->abs2rel('[..]','[t1.t2.t3]')", '[-.-.-]' ], +#[ "VMS->abs2rel('[.]','[t1.t2.t3]')", '[-.-.-]' ], +#[ "VMS->abs2rel('[..]','[t1.t2.t3]')", '[-.-.-]' ], +#[ "VMS->abs2rel('a:[t1.t2.t4]','[t1.t2.t3]')", '[-.t4]' ], +#[ "VMS->abs2rel('[a.-.b.c.-]','[t1.t2.t3]')", '[-.-.-.b]' ], -use File::Spec::Win32; +[ "VMS->rel2abs('[.t4]','[t1.t2.t3]')", '[t1.t2.t3.t4]' ], +[ "VMS->rel2abs('[.t4.t5]','[t1.t2.t3]')", '[t1.t2.t3.t4.t5]' ], +[ "VMS->rel2abs('[]','[t1.t2.t3]')", '[t1.t2.t3]' ], +[ "VMS->rel2abs('[-]','[t1.t2.t3]')", '[t1.t2.t3.-]' ], +[ "VMS->rel2abs('[-.t4]','[t1.t2.t3]')", '[t1.t2.t3.-.t4]' ], +[ "VMS->rel2abs('[t1]','[t1.t2.t3]')", '[t1]' ], -if (File::Spec::Win32->catfile('a','b','c') eq 'a\b\c') { - print "ok 3\n"; -} else { - print "not ok 3\n"; +[ "OS2->catdir('A:/d1','B:/d2','d3','')", 'A:/d1/B:/d2/d3' ], +[ "OS2->catfile('a','b','c')", 'a/b/c' ], + +[ "Mac->splitpath('file')", ',,file' ], +[ "Mac->splitpath(':file')", ',:,file' ], +[ "Mac->splitpath(':d1',1)", ',:d1:,' ], +[ "Mac->splitpath('d1',1)", 'd1:,,' ], +[ "Mac->splitpath('d1:d2:d3:')", 'd1:,d2:d3:,' ], +[ "Mac->splitpath('d1:d2:d3',1)", 'd1:,d2:d3:,' ], +[ "Mac->splitpath(':d1:d2:d3:')", ',:d1:d2:d3:,' ], +[ "Mac->splitpath(':d1:d2:d3:',1)", ',:d1:d2:d3:,' ], +[ "Mac->splitpath('d1:d2:d3:file')", 'd1:,d2:d3:,file' ], +[ "Mac->splitpath('d1:d2:d3',1)", 'd1:,d2:d3:,' ], + +[ "Mac->catdir('')", ':' ], +[ "Mac->catdir('d1','d2','d3')", 'd1:d2:d3:' ], +[ "Mac->catdir('d1','d2/','d3')", 'd1:d2/:d3:' ], +[ "Mac->catdir('','d1','d2','d3')", ':d1:d2:d3:' ], +[ "Mac->catdir('','','d2','d3')", '::d2:d3:' ], +[ "Mac->catdir('','','','d3')", ':::d3:' ], +[ "Mac->catdir(':name')", ':name:' ], +[ "Mac->catdir(':name',':name')", ':name:name:' ], + +[ "Mac->catfile('a','b','c')", 'a:b:c' ], + +[ "Mac->canonpath('')", '' ], +[ "Mac->canonpath(':')", ':' ], +[ "Mac->canonpath('::')", '::' ], +[ "Mac->canonpath('a::')", 'a::' ], +[ "Mac->canonpath(':a::')", ':a::' ], + +[ "Mac->abs2rel('t1:t2:t3','t1:t2:t3')", ':' ], +[ "Mac->abs2rel('t1:t2','t1:t2:t3')", '::' ], +[ "Mac->abs2rel('t1:t4','t1:t2:t3')", ':::t4' ], +[ "Mac->abs2rel('t1:t2:t4','t1:t2:t3')", '::t4' ], +[ "Mac->abs2rel('t1:t2:t3:t4','t1:t2:t3')", ':t4' ], +[ "Mac->abs2rel('t4:t5:t6','t1:t2:t3')", '::::t4:t5:t6' ], +[ "Mac->abs2rel('t1','t1:t2:t3')", ':::' ], + +[ "Mac->rel2abs(':t4','t1:t2:t3')", 't1:t2:t3:t4' ], +[ "Mac->rel2abs(':t4:t5','t1:t2:t3')", 't1:t2:t3:t4:t5' ], +[ "Mac->rel2abs('','t1:t2:t3')", '' ], +[ "Mac->rel2abs('::','t1:t2:t3')", 't1:t2:t3::' ], +[ "Mac->rel2abs('::t4','t1:t2:t3')", 't1:t2:t3::t4' ], +[ "Mac->rel2abs('t1','t1:t2:t3')", 't1' ], +) ; + +# Grab all of the plain routines from File::Spec +use File::Spec @File::Spec::EXPORT_OK ; + +require File::Spec::Unix ; +require File::Spec::Win32 ; + +eval { + require VMS::Filespec ; +} ; + +if ( $@ ) { + # Not pretty, but it allows testing of things not implemented soley + # on VMS. It might be better to change File::Spec::VMS to do this, + # making it more usable when running on (say) Unix but working with + # VMS paths. + eval { + sub File::Spec::VMS::unixify { die "unixify() only provided on VMS" } ; + sub File::Spec::VMS::vmspath { die "vmspath() only provided on VMS" } ; + } ; + $INC{"VMS/Filespec.pm"} = 1 ; } +require File::Spec::VMS ; -use File::Spec::Mac; +require File::Spec::OS2 ; +require File::Spec::Mac ; -if (File::Spec::Mac->catfile('a','b','c') eq 'a:b:c') { - print "ok 4\n"; -} else { - print "not ok 4\n"; +print "1..", scalar( @tests ), "\n" ; + +my $current_test= 1 ; + +# Set up for logical interpolation in ::VMS->canonpath() and ::VMS->catdir() +%ENV = ( 'LOGICAL' => 'VULCAN' ) ; + +# Test out the class methods +for ( @tests ) { + tryfunc( @$_ ) ; } + + +# +# Tries a named function with the given args and compares the result against +# an expected result. Works with functions that return scalars or arrays. +# +sub tryfunc { + my $function = shift ; + my $expected = shift ; + + $function =~ s#\\#\\\\#g ; + + my $got ; + if ( $function =~ /^[^\$].*->/ ) { + $got = eval( "join( ',', File::Spec::$function )" ) ; + } + else { + $got = eval( "join( ',', $function )" ) ; + } + + if ( $@ ) { + if ( $@ =~ /only provided on VMS/ ) { + print "ok $current_test # skip $function \n" ; + } + else { + chomp $@ ; + print "not ok $current_test # $function: $@\n" ; + } + } + elsif ( !defined( $got ) || $got ne $expected ) { + print "not ok $current_test # $function: got '$got', expected '$expected'\n" ; + } + else { + print "ok $current_test # $function\n" ; + } + ++$current_test ; +} diff --git a/t/lib/hostname.t b/t/lib/hostname.t index 30dcf0f0b7..6f61fb9dad 100755 --- a/t/lib/hostname.t +++ b/t/lib/hostname.t @@ -15,5 +15,6 @@ if ($@) { print "1..0\n" if $@ =~ /Cannot get host name/; } else { print "1..1\n"; + print "# \$host = `$host'\n"; print "ok 1\n"; } diff --git a/t/op/lex_assign.t b/t/op/lex_assign.t index 56ddfff866..2fb059d8d8 100755 --- a/t/op/lex_assign.t +++ b/t/op/lex_assign.t @@ -24,7 +24,7 @@ sub subb {"in s"} @INPUT = <DATA>; @simple_input = grep /^\s*\w+\s*\$\w+\s*[#\n]/, @INPUT; -print "1..", (9 + @INPUT + @simple_input), "\n"; +print "1..", (10 + @INPUT + @simple_input), "\n"; $ord = 0; sub wrn {"@_"} @@ -96,6 +96,18 @@ print "ok $ord\n"; } +# Chains of assignments + +my ($l1, $l2, $l3, $l4); +my $zzzz = 12; +$zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 1 + $zzzz; + +$ord++; +print "# $zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 13\nnot " + unless $zzz1 == 13 and $zzz2 == 13 and $l1 == 13 + and $l2 == 13 and $l3 == 13 and $l4 == 13; +print "ok $ord\n"; + for (@INPUT) { $ord++; ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/; @@ -464,17 +464,22 @@ S_incline(pTHX_ char *s) dTHR; char *t; char *n; + char *e; char ch; - int sawline = 0; CopLINE_inc(PL_curcop); if (*s++ != '#') return; while (*s == ' ' || *s == '\t') s++; - if (strnEQ(s, "line ", 5)) { - s += 5; - sawline = 1; - } + if (strnEQ(s, "line", 4)) + s += 4; + else + return; + if (*s == ' ' || *s == '\t') + s++; + else + return; + while (*s == ' ' || *s == '\t') s++; if (!isDIGIT(*s)) return; n = s; @@ -482,13 +487,19 @@ S_incline(pTHX_ char *s) s++; while (*s == ' ' || *s == '\t') s++; - if (*s == '"' && (t = strchr(s+1, '"'))) + if (*s == '"' && (t = strchr(s+1, '"'))) { s++; + e = t + 1; + } else { - if (!sawline) - return; /* false alarm */ for (t = s; !isSPACE(*t); t++) ; + e = t; } + while (*e == ' ' || *e == '\t' || *e == '\r' || *e == '\f') + e++; + if (*e != '\n' && *e != '\0') + return; /* false alarm */ + ch = *t; *t = '\0'; if (t - s > 0) @@ -7141,7 +7152,12 @@ Perl_yyerror(pTHX_ char *s) } else if (yychar > 255) where = "next token ???"; +#ifdef USE_PURE_BISON +/* GNU Bison sets the value -2 */ + else if (yychar == -2) { +#else else if ((yychar & 127) == 127) { +#endif if (PL_lex_state == LEX_NORMAL || (PL_lex_state == LEX_KNOWNEXT && PL_lex_defer == LEX_NORMAL)) where = "at end of line"; diff --git a/universal.c b/universal.c index 1e5a1a0efe..6ccff2f003 100644 --- a/universal.c +++ b/universal.c @@ -140,6 +140,10 @@ XS(XS_UNIVERSAL_isa) Perl_croak(aTHX_ "Usage: UNIVERSAL::isa(reference, kind)"); sv = ST(0); + + if (!SvOK(sv) || !(SvROK(sv) || SvCUR(sv))) + XSRETURN_UNDEF; + name = (char *)SvPV(ST(1),n_a); ST(0) = boolSV(sv_derived_from(sv, name)); @@ -159,6 +163,10 @@ XS(XS_UNIVERSAL_can) Perl_croak(aTHX_ "Usage: UNIVERSAL::can(object-ref, method)"); sv = ST(0); + + if (!SvOK(sv) || !(SvROK(sv) || SvCUR(sv))) + XSRETURN_UNDEF; + name = (char *)SvPV(ST(1),n_a); rv = &PL_sv_undef; diff --git a/vos/vos_dummies.c b/vos/vos_dummies.c index 3c0852db60..ec4964574e 100644 --- a/vos/vos_dummies.c +++ b/vos/vos_dummies.c @@ -86,6 +86,11 @@ extern void Perl_dump_mstats (char *s) bomb ("Perl_dump_mstats"); } +extern int Perl_get_mstats (struct perl_mstats *buf, int buflen, int level) +{ + bomb ("Perl_get_mstats"); +} + extern pid_t waitpid (pid_t pid, int *stat_loc, int options) { diff --git a/win32/Makefile b/win32/Makefile index 774e18bd54..4203378ec4 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -29,7 +29,7 @@ INST_TOP = $(INST_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. # -INST_VER = \5.5.650 +INST_VER = \5.5.660 # # Comment this out if you DON'T want your perl installation to have @@ -621,7 +621,8 @@ SETARGV_OBJ = setargv$(o) !ENDIF DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re \ - Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob + Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob \ + Sys/Hostname STATIC_EXT = DynaLoader NONXS_EXT = Errno @@ -642,6 +643,7 @@ PEEK = $(EXTDIR)\Devel\Peek\Peek BYTELOADER = $(EXTDIR)\ByteLoader\ByteLoader DPROF = $(EXTDIR)\Devel\DProf\DProf GLOB = $(EXTDIR)\File\Glob\Glob +HOSTNAME = $(EXTDIR)\Sys\Hostname\Hostname SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll @@ -658,6 +660,7 @@ RE_DLL = $(AUTODIR)\re\re.dll BYTELOADER_DLL = $(AUTODIR)\ByteLoader\ByteLoader.dll DPROF_DLL = $(AUTODIR)\Devel\DProf\DProf.dll GLOB_DLL = $(AUTODIR)\File\Glob\Glob.dll +HOSTNAME_DLL = $(AUTODIR)\Sys\Hostname\Hostname.dll ERRNO_PM = $(LIBDIR)\Errno.pm @@ -676,7 +679,8 @@ EXTENSION_C = \ $(B).c \ $(BYTELOADER).c \ $(DPROF).c \ - $(GLOB).c + $(GLOB).c \ + $(HOSTNAME).c EXTENSION_DLL = \ $(SOCKET_DLL) \ @@ -693,7 +697,8 @@ EXTENSION_DLL = \ $(THREAD_DLL) \ $(BYTELOADER_DLL) \ $(DPROF_DLL) \ - $(GLOB_DLL) + $(GLOB_DLL) \ + $(HOSTNAME_DLL) EXTENSION_PM = \ $(ERRNO_PM) @@ -958,6 +963,12 @@ $(SOCKET_DLL): $(PERLEXE) $(SOCKET).xs $(MAKE) cd ..\..\win32 +$(HOSTNAME_DLL): $(PERLEXE) $(HOSTNAME).xs + cd $(EXTDIR)\Sys\$(*B) + ..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl + $(MAKE) + cd ..\..\..\win32 + $(BYTELOADER_DLL): $(PERLEXE) $(BYTELOADER).xs cd $(EXTDIR)\$(*B) ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl diff --git a/win32/config_H.bc b/win32/config_H.bc index 698131cac2..085d8ef027 100644 --- a/win32/config_H.bc +++ b/win32/config_H.bc @@ -1108,7 +1108,7 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "c:\\perl\\5.5.650\\lib\\MSWin32-x86" /**/ +#define ARCHLIB "c:\\perl\\5.5.660\\lib\\MSWin32-x86" /**/ /*#define ARCHLIB_EXP "" /**/ /* ARCHNAME: @@ -1139,8 +1139,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "c:\\perl\\5.5.650\\bin\\MSWin32-x86" /**/ -#define BIN_EXP "c:\\perl\\5.5.650\\bin\\MSWin32-x86" /**/ +#define BIN "c:\\perl\\5.5.660\\bin\\MSWin32-x86" /**/ +#define BIN_EXP "c:\\perl\\5.5.660\\bin\\MSWin32-x86" /**/ /* PERL_BINCOMPAT_5005: * This symbol, if defined, indicates that Perl 5.006 should be @@ -2572,8 +2572,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "c:\\perl\\5.5.650\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib("5.5.650")) /**/ +#define PRIVLIB "c:\\perl\\5.5.660\\lib" /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.5.660")) /**/ /* PTRSIZE: * This symbol contains the size of a pointer, so that the C preprocessor @@ -2671,7 +2671,7 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "c:\\perl\\site\\5.5.650\\lib\\MSWin32-x86" /**/ +#define SITEARCH "c:\\perl\\site\\5.5.660\\lib\\MSWin32-x86" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -2689,8 +2689,8 @@ * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITELIB "c:\\perl\\site\\5.5.650\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib("5.5.650")) /**/ +#define SITELIB "c:\\perl\\site\\5.5.660\\lib" /**/ +#define SITELIB_EXP (win32_get_sitelib("5.5.660")) /**/ /* Size_t: * This symbol holds the type used to declare length parameters diff --git a/win32/config_H.gc b/win32/config_H.gc index bd5def2ee8..6a328778c5 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -1108,7 +1108,7 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "c:\\perl\\5.5.650\\lib\\MSWin32-x86" /**/ +#define ARCHLIB "c:\\perl\\5.5.660\\lib\\MSWin32-x86" /**/ /*#define ARCHLIB_EXP "" /**/ /* ARCHNAME: @@ -1139,8 +1139,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "c:\\perl\\5.5.650\\bin\\MSWin32-x86" /**/ -#define BIN_EXP "c:\\perl\\5.5.650\\bin\\MSWin32-x86" /**/ +#define BIN "c:\\perl\\5.5.660\\bin\\MSWin32-x86" /**/ +#define BIN_EXP "c:\\perl\\5.5.660\\bin\\MSWin32-x86" /**/ /* PERL_BINCOMPAT_5005: * This symbol, if defined, indicates that Perl 5.006 should be @@ -2572,8 +2572,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "c:\\perl\\5.5.650\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib("5.5.650")) /**/ +#define PRIVLIB "c:\\perl\\5.5.660\\lib" /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.5.660")) /**/ /* PTRSIZE: * This symbol contains the size of a pointer, so that the C preprocessor @@ -2671,7 +2671,7 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "c:\\perl\\site\\5.5.650\\lib\\MSWin32-x86" /**/ +#define SITEARCH "c:\\perl\\site\\5.5.660\\lib\\MSWin32-x86" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -2689,8 +2689,8 @@ * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITELIB "c:\\perl\\site\\5.5.650\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib("5.5.650")) /**/ +#define SITELIB "c:\\perl\\site\\5.5.660\\lib" /**/ +#define SITELIB_EXP (win32_get_sitelib("5.5.660")) /**/ /* Size_t: * This symbol holds the type used to declare length parameters diff --git a/win32/config_H.vc b/win32/config_H.vc index 2543f1d07c..5408521f86 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -1108,7 +1108,7 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "c:\\perl\\5.5.650\\lib\\MSWin32-x86" /**/ +#define ARCHLIB "c:\\perl\\5.5.660\\lib\\MSWin32-x86" /**/ /*#define ARCHLIB_EXP "" /**/ /* ARCHNAME: @@ -1139,8 +1139,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "c:\\perl\\5.5.650\\bin\\MSWin32-x86" /**/ -#define BIN_EXP "c:\\perl\\5.5.650\\bin\\MSWin32-x86" /**/ +#define BIN "c:\\perl\\5.5.660\\bin\\MSWin32-x86" /**/ +#define BIN_EXP "c:\\perl\\5.5.660\\bin\\MSWin32-x86" /**/ /* PERL_BINCOMPAT_5005: * This symbol, if defined, indicates that Perl 5.006 should be @@ -2572,8 +2572,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "c:\\perl\\5.5.650\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib("5.5.650")) /**/ +#define PRIVLIB "c:\\perl\\5.5.660\\lib" /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.5.660")) /**/ /* PTRSIZE: * This symbol contains the size of a pointer, so that the C preprocessor @@ -2671,7 +2671,7 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "c:\\perl\\site\\5.5.650\\lib\\MSWin32-x86" /**/ +#define SITEARCH "c:\\perl\\site\\5.5.660\\lib\\MSWin32-x86" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -2689,8 +2689,8 @@ * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITELIB "c:\\perl\\site\\5.5.650\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib("5.5.650")) /**/ +#define SITELIB "c:\\perl\\site\\5.5.660\\lib" /**/ +#define SITELIB_EXP (win32_get_sitelib("5.5.660")) /**/ /* Size_t: * This symbol holds the type used to declare length parameters diff --git a/win32/makefile.mk b/win32/makefile.mk index 5e8a3efac7..fd5733f516 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -33,7 +33,7 @@ INST_TOP *= $(INST_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. # -INST_VER *= \5.5.650 +INST_VER *= \5.5.660 # # Comment this out if you DON'T want your perl installation to have @@ -742,7 +742,8 @@ SETARGV_OBJ = setargv$(o) .ENDIF DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re \ - Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob + Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob \ + Sys/Hostname STATIC_EXT = DynaLoader NONXS_EXT = Errno @@ -763,6 +764,7 @@ PEEK = $(EXTDIR)\Devel\Peek\Peek BYTELOADER = $(EXTDIR)\ByteLoader\ByteLoader DPROF = $(EXTDIR)\Devel\DProf\DProf GLOB = $(EXTDIR)\File\Glob\Glob +HOSTNAME = $(EXTDIR)\Sys\Hostname\Hostname SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll @@ -779,6 +781,7 @@ RE_DLL = $(AUTODIR)\re\re.dll BYTELOADER_DLL = $(AUTODIR)\ByteLoader\ByteLoader.dll DPROF_DLL = $(AUTODIR)\Devel\DProf\DProf.dll GLOB_DLL = $(AUTODIR)\File\Glob\Glob.dll +HOSTNAME_DLL = $(AUTODIR)\Sys\Hostname\Hostname.dll ERRNO_PM = $(LIBDIR)\Errno.pm @@ -797,7 +800,8 @@ EXTENSION_C = \ $(B).c \ $(BYTELOADER).c \ $(DPROF).c \ - $(GLOB).c + $(GLOB).c \ + $(HOSTNAME).c EXTENSION_DLL = \ $(SOCKET_DLL) \ @@ -814,7 +818,8 @@ EXTENSION_DLL = \ $(THREAD_DLL) \ $(BYTELOADER_DLL) \ $(DPROF_DLL) \ - $(GLOB_DLL) + $(GLOB_DLL) \ + $(HOSTNAME_DLL) EXTENSION_PM = \ $(ERRNO_PM) @@ -1183,6 +1188,11 @@ $(SOCKET_DLL): $(PERLEXE) $(SOCKET).xs ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl cd $(EXTDIR)\$(*B) && $(MAKE) +$(HOSTNAME_DLL): $(PERLEXE) $(HOSTNAME).xs + cd $(EXTDIR)\Sys\$(*B) && \ + ..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl + cd $(EXTDIR)\Sys\$(*B) && $(MAKE) + $(BYTELOADER_DLL): $(PERLEXE) $(BYTELOADER).xs cd $(EXTDIR)\$(*B) && \ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl diff --git a/win32/win32.c b/win32/win32.c index 71097ea1ae..b17275928a 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -1132,6 +1132,7 @@ win32_stat(const char *path, struct stat *sbuf) if (S_ISDIR(sbuf->st_mode)) sbuf->st_mode |= S_IWRITE | S_IEXEC; else if (S_ISREG(sbuf->st_mode)) { + int perms; if (l >= 4 && path[l-4] == '.') { const char *e = path + l - 3; if (strnicmp(e,"exe",3) @@ -1144,6 +1145,9 @@ win32_stat(const char *path, struct stat *sbuf) } else sbuf->st_mode &= ~S_IEXEC; + /* Propagate permissions to _group_ and _others_ */ + perms = sbuf->st_mode & (S_IREAD|S_IWRITE|S_IEXEC); + sbuf->st_mode |= (perms>>3) | (perms>>6); } #endif } |