diff options
| -rw-r--r-- | Changes | 316 | ||||
| -rw-r--r-- | embed.h | 1 | ||||
| -rwxr-xr-x | embed.pl | 1 | ||||
| -rw-r--r-- | ext/SDBM_File/sdbm/dba.c | 11 | ||||
| -rw-r--r-- | ext/SDBM_File/sdbm/dbd.c | 15 | ||||
| -rw-r--r-- | ext/SDBM_File/sdbm/dbe.c | 20 | ||||
| -rw-r--r-- | ext/SDBM_File/sdbm/dbm.c | 23 | ||||
| -rw-r--r-- | ext/SDBM_File/sdbm/dbu.c | 18 | ||||
| -rw-r--r-- | gv.c | 2 | ||||
| -rw-r--r-- | mg.c | 3 | ||||
| -rw-r--r-- | objXSUB.h | 2 | ||||
| -rw-r--r-- | op.c | 16 | ||||
| -rw-r--r-- | perl.c | 34 | ||||
| -rw-r--r-- | pod/perldelta.pod | 7 | ||||
| -rw-r--r-- | pp_ctl.c | 76 | ||||
| -rw-r--r-- | pp_sys.c | 18 | ||||
| -rw-r--r-- | proto.h | 1 | ||||
| -rw-r--r-- | sv.c | 20 | ||||
| -rwxr-xr-x | t/comp/proto.t | 5 | ||||
| -rwxr-xr-x[-rw-r--r--] | t/op/filetest.t | 0 | ||||
| -rwxr-xr-x[-rw-r--r--] | t/op/subst_amp.t | 0 | ||||
| -rw-r--r-- | t/pragma/strict-subs | 22 | ||||
| -rw-r--r-- | toke.c | 3 | ||||
| -rw-r--r-- | util.c | 18 | ||||
| -rw-r--r-- | win32/Makefile | 30 | ||||
| -rw-r--r-- | win32/dl_win32.xs | 15 | ||||
| -rw-r--r-- | win32/makefile.mk | 41 | ||||
| -rw-r--r-- | win32/win32.c | 241 | ||||
| -rw-r--r-- | win32/win32.h | 14 | ||||
| -rw-r--r-- | x2p/hash.c | 7 |
30 files changed, 735 insertions, 245 deletions
@@ -75,7 +75,321 @@ indicator: ---------------- -Version 5.005_57 Development release working toward 5.006 +Version 5.005_58 Development release working toward 5.006 +---------------- + +____________________________________________________________________________ +[ 3515] By: gsar on 1999/06/02 00:48:50 + Log: remove stray K&R-isms + Branch: perl + ! ext/SDBM_File/sdbm/dba.c ext/SDBM_File/sdbm/dbd.c + ! ext/SDBM_File/sdbm/dbe.c ext/SDBM_File/sdbm/dbm.c + ! ext/SDBM_File/sdbm/dbu.c mg.c op.c pp_ctl.c pp_sys.c sv.c + ! toke.c util.c win32/win32.c x2p/hash.c +____________________________________________________________________________ +[ 3514] By: gsar on 1999/06/01 15:55:55 + Log: change#3447 didn't do enough to exempt Foo->bar(qw/.../) from + strict 'subs' + Branch: perl + ! op.c t/pragma/strict-subs +____________________________________________________________________________ +[ 3513] By: jhi on 1999/06/01 07:17:05 + Log: Patch applying of #3499 had gone awry. + Branch: cfgperl + ! ext/ByteLoader/bytecode.h ext/ByteLoader/byterun.h +____________________________________________________________________________ +[ 3512] By: gsar on 1999/05/31 19:21:30 + Log: tighter -help output + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 3511] By: gsar on 1999/05/31 17:18:23 + Log: fix memory leak in C<eval 'return sub {...}'> + Branch: perl + ! embed.h embed.pl objXSUB.h pp_ctl.c proto.h +____________________________________________________________________________ +[ 3510] By: gsar on 1999/05/31 14:11:46 + Log: tweak C++isms + Branch: perl + ! win32/dl_win32.xs win32/win32.c +____________________________________________________________________________ +[ 3509] By: jhi on 1999/05/30 13:02:26 + Log: Cleanup of #3488. + Branch: cfgperl + ! Configure config_h.SH +____________________________________________________________________________ +[ 3508] By: jhi on 1999/05/30 11:16:01 + Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu> + To: Mailing list Perl5 <perl5-porters@perl.org> + Subject: [PATCH 5.005_57] Teach Socket and io_unix.t the syntax of OS/2 + Date: Sat, 29 May 1999 20:18:13 -0400 + Message-ID: <19990529201813.B9489@monk.mps.ohio-state.edu> + Branch: cfgperl + ! ext/Socket/Socket.xs os2/os2ish.h t/lib/io_unix.t +____________________________________________________________________________ +[ 3507] By: jhi on 1999/05/29 20:05:40 + Log: From: Mark-Jason Dominus <mjd@plover.com> + To: perl5-porters@perl.com + Subject: PATCH (5.005_57): Document use of `SPECIAL' flag for `pushre': + Date: Sat, 29 May 1999 14:45:10 -0400 + Message-ID: <19990529184510.27557.qmail@plover.com> + Branch: cfgperl + ! op.h +____________________________________________________________________________ +[ 3506] By: gsar on 1999/05/29 16:49:39 + Log: avoid gv_check() recursive pit + Branch: perl + ! gv.c +____________________________________________________________________________ +[ 3505] By: jhi on 1999/05/29 11:38:16 + Log: From: jan.dubois@ibm.net (Jan Dubois) + To: Gurusamy Sarathy <gsar@activestate.com> + Cc: perl5-porters@perl.org + Subject: [PATCH 5.005_57]Safeguard against unimplemented functions in pwuid.t and grent.t + Date: Sat, 29 May 1999 08:46:22 +0200 + Message-ID: <374f8007.2016008@smtp1.ibm.net> + Branch: cfgperl + ! t/op/grent.t t/op/pwent.t +____________________________________________________________________________ +[ 3504] By: jhi on 1999/05/29 11:07:10 + Log: QNX needs <sys/select.h> to define fd_set. + + From: Norton Allen <allen@huarp.harvard.edu> + To: perl5-porters@perl.org + Subject: [19990526.016] Not OK: perl 5.00503 on x86-qnx 424 + Date: Wed, 26 May 1999 13:51:27 -0400 (EDT) + Message-Id: <199905261751.NAA20966@bottesini.harvard.edu> + Branch: cfgperl + ! ext/IO/poll.c +____________________________________________________________________________ +[ 3503] By: jhi on 1999/05/29 10:53:31 + Log: From: jan.dubois@ibm.net (Jan Dubois) + To: Gurusamy Sarathy <gsar@activestate.com>, perl5-porters@perl.org + Subject: [PATCH all versions] (was Re: Unitialized Value Complaints in Math::BigFloat) + Date: Fri, 28 May 1999 20:14:35 +0200 + Message-ID: <3751daa4.7188847@smtp1.ibm.net> + Branch: cfgperl + ! lib/Math/BigFloat.pm +____________________________________________________________________________ +[ 3502] By: jhi on 1999/05/29 10:44:44 + Log: Make Configure support the change #3367, + SysV shadow passwords. + Branch: cfgperl + ! Configure config_h.SH pp_sys.c +____________________________________________________________________________ +[ 3501] By: gsar on 1999/05/28 21:22:23 + Log: add wide versions of win32 system calls (first step in + globalization); delayload winsock for performance if compiling + with VC 6.0 + Branch: perl + ! win32/Makefile win32/dl_win32.xs win32/makefile.mk + ! win32/win32.c win32/win32.h +____________________________________________________________________________ +[ 3500] By: jhi on 1999/05/28 21:17:24 + Log: The new t/lib/io_linenum.t was using stricture + before @INC was set up. + Branch: cfgperl + ! t/lib/io_linenum.t +____________________________________________________________________________ +[ 3499] By: jhi on 1999/05/28 17:13:23 + Log: From: Tom Hughes <tom@compton.nu> + To: perl5-porters@perl.org + Subject: [PATCH 5.005_57] ByteLoader mark 2 + Date: Wed, 26 May 1999 23:59:49 +0100 + Message-ID: <bf337a0849.tom@compton.compton.nu> + + plus resolve tiny conflict with #3479 + plus regen_headers. + Branch: cfgperl + + ext/ByteLoader/bytecode.h ext/ByteLoader/byterun.c + + ext/ByteLoader/byterun.h + - bytecode.h byterun.c byterun.h + ! MANIFEST Makefile.SH bytecode.pl embed.h embedvar.h ext/B/B.pm + ! ext/B/B.xs ext/B/B/Bytecode.pm ext/B/Makefile.PL + ! ext/ByteLoader/ByteLoader.pm ext/ByteLoader/ByteLoader.xs + ! ext/ByteLoader/Makefile.PL global.sym intrpvar.h objXSUB.h + ! perl.h perlvars.h proto.h util.c utils/Makefile +____________________________________________________________________________ +[ 3498] By: jhi on 1999/05/28 16:53:04 + Log: From: Mark-Jason Dominus <mjd@plover.com> + To: perl5-porters@perl.com + Subject: PATCH (5.005_57): defined(@a) now deprecated + Date: Thu, 27 May 1999 16:05:44 -0400 + Message-ID: <19990527200544.13330.qmail@plover.com> + Branch: cfgperl + ! lib/Carp.pm op.c opcode.h opcode.pl pod/perldelta.pod + ! pod/perldiag.pod pod/perlfunc.pod pp_proto.h t/pragma/warn/op +____________________________________________________________________________ +[ 3497] By: jhi on 1999/05/28 16:50:54 + Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu> + To: perl5-porters@perl.org (Mailing list Perl5) + Subject: [PATCH 5.00557] Cosmetic OS/2-related patches + Date: Fri, 28 May 1999 12:13:00 -0400 (EDT) + Message-Id: <199905281613.MAA02048@monk.mps.ohio-state.edu> + Branch: cfgperl + ! MANIFEST Makefile.SH ext/POSIX/POSIX.xs hints/os2.sh + ! os2/Makefile.SHs t/io/pipe.t t/lib/io_sock.t +____________________________________________________________________________ +[ 3496] By: jhi on 1999/05/28 16:48:39 + Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu> + To: perl5-porters@perl.org (Mailing list Perl5) + Subject: [PATCH 5.00557] Required OS/2-related patches + Date: Fri, 28 May 1999 12:11:48 -0400 (EDT) + Message-Id: <199905281611.MAA02037@monk.mps.ohio-state.edu> + Branch: cfgperl + ! os2/os2.c t/lib/bigfloatpm.t t/lib/io_unix.t t/op/groups.t + ! t/op/stat.t util.c +____________________________________________________________________________ +[ 3495] By: jhi on 1999/05/28 16:45:56 + Log: From: Paul Johnson <pjcj@transeda.com> + To: perl5-porters <perl5-porters@perl.org> + Subject: [PATCH 5.005_57] Provide more useful test okay percentage + Date: Fri, 28 May 1999 15:13:54 +0100 + Message-ID: <19990528151354.B289@west-tip.transeda.com> + Branch: cfgperl + ! t/TEST +____________________________________________________________________________ +[ 3494] By: jhi on 1999/05/28 16:44:34 + Log: From: Paul Johnson <pjcj@transeda.com> + To: perl5-porters <perl5-porters@perl.org> + Subject: [PATCH 5.005_57] Fixes related to working local $. + Date: Fri, 28 May 1999 15:11:18 +0100 + Message-ID: <19990528151118.A289@west-tip.transeda.com> + Branch: cfgperl + ! ext/IO/lib/IO/Handle.pm pod/perlvar.pod t/lib/io_linenum.t +____________________________________________________________________________ +[ 3493] By: gsar on 1999/05/28 16:37:26 + Log: change#3449 wasn't doing enough + Branch: perl + ! op.c t/comp/proto.t +____________________________________________________________________________ +[ 3492] By: jhi on 1999/05/28 08:12:23 + Log: From: paul.marquess@bt.com + To: doughera@lafayette.edu + Cc: perl5-porters@perl.org + Subject: RE: [19990527.002] DBM Filters in _57 cause problems in NDBM_File + Date: Thu, 27 May 1999 23:31:38 +0100 + Message-ID: <5104D4DBC598D211B5FE0000F8FE7EB29C6C03@mbtlipnt02.btlabs.bt.co.uk> + + Had to be applied manually; some mailer had munged the patch slightly. + Branch: cfgperl + ! ext/NDBM_File/NDBM_File.xs +____________________________________________________________________________ +[ 3491] By: jhi on 1999/05/28 07:51:17 + Log: From: "Vishal Bhatia" <vishalb@my-deja.com> + To: perl5-porters@perl.org + Subject: [PATCH 5.005_57] fixing eval in the compiler + Date: Thu, 27 May 1999 07:56:54 -0700 + Message-ID: <JDIKFDKKLGHHBAAA@my-deja.com> + Branch: cfgperl + ! cc_runtime.h scope.h +____________________________________________________________________________ +[ 3490] By: jhi on 1999/05/28 07:47:06 + Log: From: Andy Dougherty <doughera@lafayette.edu> + To: perlbug@perl.com + Cc: Jarkko Hietaniemi <jhi@iki.fi> + Subject: [PATCH] Configure updates for ISC 4.1 + Date: Thu, 27 May 1999 15:19:21 -0400 (EDT) + Message-Id: <Pine.GSU.4.05.9905271513500.22115-100000@newton.phys> + Branch: cfgperl + ! Configure config_h.SH +____________________________________________________________________________ +[ 3489] By: jhi on 1999/05/28 07:39:17 + Log: Integrate from mainperl. + Branch: cfgperl + !> malloc.c win32/makedef.pl win32/win32.c +____________________________________________________________________________ +[ 3488] By: jhi on 1999/05/27 16:57:19 + Log: From: Andy Dougherty <doughera@lafayette.edu> + To: Perl Porters <perl5-porters@perl.org> + Subject: [PATCH] Re: 5.005_57 NOT OK on SunOS 4.1.3 + Date: Thu, 27 May 1999 12:26:28 -0400 (EDT) + Message-Id: <Pine.GSU.4.05.9905271120230.22115-100000@newton.phys> + Branch: cfgperl + ! Configure config_h.SH hints/sunos_4_1.sh util.c +____________________________________________________________________________ +[ 3487] By: gsar on 1999/05/27 03:56:20 + Log: make win32_spawnvp() inherit standard handles even when they + may be redirected + Branch: perl + ! win32/win32.c +____________________________________________________________________________ +[ 3486] By: jhi on 1999/05/26 19:55:52 + Log: From: Andy Dougherty <doughera@lafayette.edu> + To: perl5-porters@perl.org + Subject: Re: BUG -> [19990526.004] perl5.005_57 error in util.c on sun4-solaris2.6 + Date: Wed, 26 May 1999 14:49:52 -0400 (EDT) + Message-Id: <Pine.GSU.4.05.9905261448310.19172-100000@newton.phys> + Branch: cfgperl + ! util.c +____________________________________________________________________________ +[ 3485] By: chip on 1999/05/26 17:19:11 + Log: Look for Linux FILE structure in libio.h, for glibc-2.1. + Branch: maint-5.004/perl + ! Configure +____________________________________________________________________________ +[ 3484] By: gsar on 1999/05/26 01:56:28 + Log: fix missing exported symbol + Branch: perl + ! malloc.c win32/makedef.pl +____________________________________________________________________________ +[ 3483] By: jhi on 1999/05/25 23:08:07 + Log: Configure -Dopenbsd_distribution to build for the OpenBSD tree. + + From: "Todd C. Miller" <Todd.Miller@courtesan.com> + To: perlbug@perl.com + Subject: OpenBSD hints file update + Date: Tue, 25 May 1999 12:12:38 -0600 (MDT) + Message-Id: <199905251812.MAA06032@xerxes.courtesan.com> + Branch: cfgperl + ! hints/openbsd.sh +____________________________________________________________________________ +[ 3482] By: jhi on 1999/05/25 23:01:25 + Log: From: Tom Hughes <tom@compton.nu> + To: perl5-porters@perl.org + Subject: [PATCH 5.005_57] Make Configure recognise glibc 2.1 stdio + Date: Tue, 25 May 1999 23:10:23 +0100 + Message-ID: <1ed7f10749.tom@compton.compton.nu> + Branch: cfgperl + ! Configure config_h.SH +____________________________________________________________________________ +[ 3481] By: jhi on 1999/05/25 22:31:50 + Log: 3479, 3480, 3481 seems logical. + Branch: cfgperl + !> hints/aix.sh +____________________________________________________________________________ +[ 3480] By: jhi on 1999/05/25 22:13:39 + Log: The change #3479 wasn't perfect. + Branch: perl + ! hints/aix.sh +____________________________________________________________________________ +[ 3479] By: jhi on 1999/05/25 21:59:21 + Log: Cures for _57 in AIX 4.1.5.0. + (1) The lddlflags lost its -lc by change #3660 + (and the politeness of change #3257). + (2) optype_size must end up in perl.exp (as PL_optype_size). + Added it to perlvars.h, fixed bytecode.pl, + regen'ed the relevant headers. + Branch: cfgperl + ! bytecode.h bytecode.pl byterun.h embed.h embedvar.h objXSUB.h + ! perlvars.h + Branch: perl + ! hints/aix.sh +____________________________________________________________________________ +[ 3478] By: jhi on 1999/05/25 20:13:47 + Log: Integrate from mainperl. + Branch: cfgperl + +> pod/perltootc.pod + !> (integrate 101 files) +____________________________________________________________________________ +[ 3477] By: gsar on 1999/05/25 10:43:48 + Log: here be 5.005_57 + Branch: perl + ! Changes MANIFEST Porting/makerel + !> Changes5.005 + +---------------- +Version 5.005_57 ---------------- ____________________________________________________________________________ @@ -1176,6 +1176,7 @@ #define force_word CPerlObj::Perl_force_word #define form CPerlObj::Perl_form #define fprintf CPerlObj::Perl_fprintf +#define free_closures CPerlObj::Perl_free_closures #define free_tmps CPerlObj::Perl_free_tmps #define gen_constant_list CPerlObj::Perl_gen_constant_list #define get_db_sub CPerlObj::Perl_get_db_sub @@ -258,6 +258,7 @@ my @staticfuncs = qw( dopoptoloop dopoptosub dopoptosub_at + free_closures save_lines doeval doopen_pmc diff --git a/ext/SDBM_File/sdbm/dba.c b/ext/SDBM_File/sdbm/dba.c index 9f987fd88e..7406776398 100644 --- a/ext/SDBM_File/sdbm/dba.c +++ b/ext/SDBM_File/sdbm/dba.c @@ -11,8 +11,7 @@ char *progname; extern void oops(); int -main(argc, argv) -char **argv; +main(int argc, char **argv) { int n; char *p; @@ -40,8 +39,8 @@ char **argv; return 0; } -sdump(pagf) -int pagf; +void +sdump(int pagf) { register b; register n = 0; @@ -70,8 +69,8 @@ int pagf; oops("read failed: block %d", n); } -pagestat(pag) -char *pag; +int +pagestat(char *pag) { register n; register free; diff --git a/ext/SDBM_File/sdbm/dbd.c b/ext/SDBM_File/sdbm/dbd.c index f60f91a5f5..0a58d9a0f4 100644 --- a/ext/SDBM_File/sdbm/dbd.c +++ b/ext/SDBM_File/sdbm/dbd.c @@ -14,8 +14,7 @@ extern void oops(); #define empty(page) (((short *) page)[0] == 0) int -main(argc, argv) -char **argv; +main(int argc, char **argv) { int n; char *p; @@ -42,8 +41,8 @@ char **argv; return 0; } -sdump(pagf) -int pagf; +void +sdump(int pagf) { register r; register n = 0; @@ -68,8 +67,8 @@ int pagf; #ifdef OLD -dispage(pag) -char *pag; +int +dispage(char *pag) { register i, n; register off; @@ -90,8 +89,8 @@ char *pag; } } #else -dispage(pag) -char *pag; +void +dispage(char *pag) { register i, n; register off; diff --git a/ext/SDBM_File/sdbm/dbe.c b/ext/SDBM_File/sdbm/dbe.c index 9f44180f39..166e64efdf 100644 --- a/ext/SDBM_File/sdbm/dbe.c +++ b/ext/SDBM_File/sdbm/dbe.c @@ -52,10 +52,7 @@ char *optarg; /* Global argument pointer. */ #endif char -getopt(argc, argv, optstring) -int argc; -char **argv; -char *optstring; +getopt(int argc, char **argv, char *optstring) { register int c; register char *place; @@ -131,8 +128,7 @@ char *optstring; void -print_datum(db) -datum db; +print_datum(datum db) { int i; @@ -152,8 +148,7 @@ datum db; datum -read_datum(s) -char *s; +read_datum(char *s) { datum db; char *p; @@ -197,8 +192,7 @@ char *s; char * -key2s(db) -datum db; +key2s(datum db) { char *buf; char *p1, *p2; @@ -211,10 +205,8 @@ datum db; return buf; } - -main(argc, argv) -int argc; -char **argv; +int +main(int argc, char **argv) { typedef enum { YOW, FETCH, STORE, DELETE, SCAN, REGEXP diff --git a/ext/SDBM_File/sdbm/dbm.c b/ext/SDBM_File/sdbm/dbm.c index 1388230e2d..dc47d7001d 100644 --- a/ext/SDBM_File/sdbm/dbm.c +++ b/ext/SDBM_File/sdbm/dbm.c @@ -27,8 +27,8 @@ static DBM *cur_db = NODB; static char no_db[] = "dbm: no open database\n"; -dbminit(file) - char *file; +int +dbminit(char *file) { if (cur_db != NODB) dbm_close(cur_db); @@ -43,8 +43,7 @@ dbminit(file) } long -forder(key) -datum key; +forder(datum key) { if (cur_db == NODB) { printf(no_db); @@ -54,8 +53,7 @@ datum key; } datum -fetch(key) -datum key; +fetch(datum key) { datum item; @@ -67,8 +65,8 @@ datum key; return (dbm_fetch(cur_db, key)); } -delete(key) -datum key; +int +delete(datum key) { if (cur_db == NODB) { printf(no_db); @@ -79,8 +77,8 @@ datum key; return (dbm_delete(cur_db, key)); } -store(key, dat) -datum key, dat; +int +store(datum key, datum dat) { if (cur_db == NODB) { printf(no_db); @@ -93,7 +91,7 @@ datum key, dat; } datum -firstkey() +firstkey(void) { datum item; @@ -106,8 +104,7 @@ firstkey() } datum -nextkey(key) -datum key; +nextkey(datum key) { datum item; diff --git a/ext/SDBM_File/sdbm/dbu.c b/ext/SDBM_File/sdbm/dbu.c index a3c0004da9..e68b78de44 100644 --- a/ext/SDBM_File/sdbm/dbu.c +++ b/ext/SDBM_File/sdbm/dbu.c @@ -65,9 +65,7 @@ static cmd *parse(); static void badk(), doit(), prdatum(); int -main(argc, argv) -int argc; -char *argv[]; +main(int argc, char **argv) { int c; register cmd *act; @@ -98,9 +96,7 @@ char *argv[]; } static void -doit(act, file) -register cmd *act; -char *file; +doit(register cmd *act, char *file) { datum key; datum val; @@ -197,8 +193,7 @@ char *file; } static void -badk(word) -char *word; +badk(char *word) { register int i; @@ -214,8 +209,7 @@ char *word; } static cmd * -parse(str) -register char *str; +parse(register char *str) { register int i = CTABSIZ; register cmd *p; @@ -227,9 +221,7 @@ register char *str; } static void -prdatum(stream, d) -FILE *stream; -datum d; +prdatum(FILE *stream, datum d) { register int c; register char *p = d.dptr; @@ -892,7 +892,7 @@ gv_check(HV *stash) if (HeKEY(entry)[HeKLEN(entry)-1] == ':' && (gv = (GV*)HeVAL(entry)) && (hv = GvHV(gv)) && HvNAME(hv)) { - if (hv != PL_defstash) + if (hv != PL_defstash && hv != stash) gv_check(hv); /* nested package */ } else if (isALPHA(*HeKEY(entry))) { @@ -434,8 +434,7 @@ magic_len(SV *sv, MAGIC *mg) #if 0 static char * -printW(sv) -SV * sv ; +printW(SV *sv) { #if 1 return "" ; @@ -1207,6 +1207,8 @@ #define form pPerl->Perl_form #undef fprintf #define fprintf pPerl->Perl_fprintf +#undef free_closures +#define free_closures pPerl->Perl_free_closures #undef free_tmps #define free_tmps pPerl->Perl_free_tmps #undef gen_constant_list @@ -3638,8 +3638,7 @@ cv_undef(CV *cv) #ifdef DEBUG_CLOSURES STATIC void -cv_dump(cv) -CV* cv; +cv_dump(CV *cv) { CV *outside = CvOUTSIDE(cv); AV* padlist = CvPADLIST(cv); @@ -5405,6 +5404,11 @@ ck_subr(OP *o) else if (cvop->op_type == OP_METHOD) { if (o2->op_type == OP_CONST) o2->op_private &= ~OPpCONST_STRICT; + else if (o2->op_type == OP_LIST) { + OP *o = ((UNOP*)o2)->op_first->op_sibling; + if (o && o->op_type == OP_CONST) + o->op_private &= ~OPpCONST_STRICT; + } } o->op_private |= (PL_hints & HINT_STRICT_REFS); if (PERLDB_SUB && PL_curstash != PL_debstash) @@ -5457,10 +5461,12 @@ ck_subr(OP *o) { GV *gv = (GV*)((SVOP*)gvop)->op_sv; OP *sibling = o2->op_sibling; + SV *n = newSVpvn("",0); op_free(o2); - o2 = newSVOP(OP_CONST, 0, - newSVpvn(GvNAME(gv), - GvNAMELEN(gv))); + gv_fullname3(n, gv, ""); + if (SvCUR(n)>6 && strnEQ(SvPVX(n),"main::",6)) + sv_chop(n, SvPVX(n)+6); + o2 = newSVOP(OP_CONST, 0, n); prev->op_sibling = o2; o2->op_sibling = sibling; } @@ -1550,25 +1550,25 @@ usage(char *name) /* XXX move this out into a module ? */ "-0[octal] specify record separator (\\0, if no argument)", "-a autosplit mode with -n or -p (splits $_ into @F)", "-c check syntax only (runs BEGIN and END blocks)", -"-d[:debugger] run scripts under debugger", -"-D[number/list] set debugging flags (argument is a bit mask or flags)", -"-e 'command' one line of script. Several -e's allowed. Omit [programfile].", -"-F/pattern/ split() pattern for autosplit (-a). The //'s are optional.", -"-i[extension] edit <> files in place (make backup if extension supplied)", -"-Idirectory specify @INC/#include directory (may be used more than once)", +"-d[:debugger] run program under debugger", +"-D[number/list] set debugging flags (argument is a bit mask or alphabets)", +"-e 'command' one line of program (several -e's allowed, omit programfile)", +"-F/pattern/ split() pattern for -a switch (//'s are optional)", +"-i[extension] edit <> files in place (makes backup if extension supplied)", +"-Idirectory specify @INC/#include directory (several -I's allowed)", "-l[octal] enable line ending processing, specifies line terminator", -"-[mM][-]module.. executes `use/no module...' before executing your script.", -"-n assume 'while (<>) { ... }' loop around your script", -"-p assume loop like -n but print line also like sed", -"-P run script through C preprocessor before compilation", -"-s enable some switch parsing for switches after script name", -"-S look for the script using PATH environment variable", -"-T turn on tainting checks", -"-u dump core after parsing script", +"-[mM][-]module execute `use/no module...' before executing program", +"-n assume 'while (<>) { ... }' loop around program", +"-p assume loop like -n but print line also, like sed", +"-P run program through C preprocessor before compilation", +"-s enable rudimentary parsing for switches after programfile", +"-S look for programfile using PATH environment variable", +"-T enable tainting checks", +"-u dump core after parsing program", "-U allow unsafe operations", -"-v print version number, patchlevel plus VERY IMPORTANT perl info", -"-V[:variable] print perl configuration information", -"-w TURN WARNINGS ON FOR COMPILATION OF YOUR SCRIPT. Recommended.", +"-v print version, subversion (includes VERY IMPORTANT perl info)", +"-V[:variable] print configuration summary (or a single Config.pm variable)", +"-w enable many useful warnings (RECOMMENDED)", "-x[directory] strip off text before #!perl line and perhaps cd to directory", "\n", NULL diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 06346a645b..9408d32c9d 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -496,13 +496,6 @@ to skip installing perl also as /usr/bin/perl. This is useful if you prefer not to modify /usr/bin for some reason or another but harmful because many scripts assume to find Perl in /usr/bin/perl. -=head1 Configuration Changes - -You can use "Configure -Uinstallusrbinperl" which causes installperl -to skip installing perl also as /usr/bin/perl. This is useful if you -prefer not to modify /usr/bin for some reason or another but harmful -because many scripts assume to find Perl in /usr/bin/perl. - =head1 BUGS If you find what you think is a bug, you might check the headers of @@ -49,6 +49,7 @@ static I32 amagic_ncmp _((SV *a, SV *b)); static I32 amagic_i_ncmp _((SV *a, SV *b)); static I32 amagic_cmp _((SV *str1, SV *str2)); static I32 amagic_cmp_locale _((SV *str1, SV *str2)); +static void free_closures _((void)); #endif PP(pp_wantarray) @@ -1324,6 +1325,42 @@ dounwind(I32 cxix) } } +/* + * Closures mentioned at top level of eval cannot be referenced + * again, and their presence indirectly causes a memory leak. + * (Note that the fact that compcv and friends are still set here + * is, AFAIK, an accident.) --Chip + * + * XXX need to get comppad et al from eval's cv rather than + * relying on the incidental global values. + */ +STATIC void +free_closures(void) +{ + dTHR; + SV **svp = AvARRAY(PL_comppad_name); + I32 ix; + for (ix = AvFILLp(PL_comppad_name); ix >= 0; ix--) { + SV *sv = svp[ix]; + if (sv && sv != &PL_sv_undef && *SvPVX(sv) == '&') { + SvREFCNT_dec(sv); + svp[ix] = &PL_sv_undef; + + sv = PL_curpad[ix]; + if (CvCLONE(sv)) { + SvREFCNT_dec(CvOUTSIDE(sv)); + CvOUTSIDE(sv) = Nullcv; + } + else { + SvREFCNT_dec(sv); + sv = NEWSV(0,0); + SvPADTMP_on(sv); + PL_curpad[ix] = sv; + } + } + } +} + OP * die_where(char *message, STRLEN msglen) { @@ -1804,6 +1841,9 @@ PP(pp_return) break; case CXt_EVAL: POPEVAL(cx); + if (AvFILLp(PL_comppad_name) >= 0) + free_closures(); + lex_end(); if (optype == OP_REQUIRE && (MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) ) { @@ -3083,35 +3123,8 @@ PP(pp_leaveeval) } PL_curpm = newpm; /* Don't pop $1 et al till now */ - /* - * Closures mentioned at top level of eval cannot be referenced - * again, and their presence indirectly causes a memory leak. - * (Note that the fact that compcv and friends are still set here - * is, AFAIK, an accident.) --Chip - */ - if (AvFILLp(PL_comppad_name) >= 0) { - SV **svp = AvARRAY(PL_comppad_name); - I32 ix; - for (ix = AvFILLp(PL_comppad_name); ix >= 0; ix--) { - SV *sv = svp[ix]; - if (sv && sv != &PL_sv_undef && *SvPVX(sv) == '&') { - SvREFCNT_dec(sv); - svp[ix] = &PL_sv_undef; - - sv = PL_curpad[ix]; - if (CvCLONE(sv)) { - SvREFCNT_dec(CvOUTSIDE(sv)); - CvOUTSIDE(sv) = Nullcv; - } - else { - SvREFCNT_dec(sv); - sv = NEWSV(0,0); - SvPADTMP_on(sv); - PL_curpad[ix] = sv; - } - } - } - } + if (AvFILLp(PL_comppad_name) >= 0) + free_closures(); #ifdef DEBUGGING assert(CvDEPTH(PL_compcv) == 1); @@ -3578,10 +3591,7 @@ STATIC void #ifdef PERL_OBJECT qsortsv(SV ** array, size_t num_elts, SVCOMPARE compare) #else -qsortsv( - SV ** array, - size_t num_elts, - I32 (*compare)(SV *a, SV *b)) +qsortsv(SV ** array, size_t num_elts, I32 (*compare)(SV *a, SV *b)) #endif { register SV * temp; @@ -230,7 +230,8 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true"; || defined(HAS_SETREGID) || defined(HAS_SETRESGID)) /* The Hard Way. */ STATIC int -emulate_eaccess (const char* path, int mode) { +emulate_eaccess (const char* path, int mode) +{ Uid_t ruid = getuid(); Uid_t euid = geteuid(); Gid_t rgid = getgid(); @@ -294,7 +295,8 @@ emulate_eaccess (const char* path, int mode) { #if !defined(PERL_EFF_ACCESS_R_OK) STATIC int -emulate_eaccess (const char* path, int mode) { +emulate_eaccess (const char* path, int mode) +{ croak("switching effective uid is not implemented"); /*NOTREACHED*/ return -1; @@ -3175,10 +3177,8 @@ PP(pp_readlink) } #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) -static int -dooneliner(cmd, filename) -char *cmd; -char *filename; +STATIC int +dooneliner(char *cmd, char *filename) { char *save_filename = filename; char *cmdline; @@ -4962,10 +4962,8 @@ fcntl_emulate_flock(int fd, int operation) # define F_TEST 3 /* Test a region for other processes locks */ # endif -static int -lockf_emulate_flock (fd, operation) -int fd; -int operation; +STATIC int +lockf_emulate_flock (int fd, int operation) { int i; int save_errno; @@ -760,6 +760,7 @@ I32 dopoptolabel _((char *label)); I32 dopoptoloop _((I32 startingblock)); I32 dopoptosub _((I32 startingblock)); I32 dopoptosub_at _((PERL_CONTEXT* cxstk, I32 startingblock)); +void free_closures _((void)); void save_lines _((AV *array, SV *sv)); OP *doeval _((int gimme, OP** startop)); PerlIO *doopen_pmc _((const char *name, const char *mode)); @@ -116,9 +116,8 @@ static I32 registry_size; #define REG_ADD(sv) REG_REPLACE(sv,Nullsv,sv) #define REG_REMOVE(sv) REG_REPLACE(sv,sv,Nullsv) -static void -reg_add(sv) -SV* sv; +STATIC void +reg_add(SV *sv) { if (PL_sv_count >= (registry_size >> 1)) { @@ -144,17 +143,15 @@ SV* sv; ++PL_sv_count; } -static void -reg_remove(sv) -SV* sv; +STATIC void +reg_remove(SV *sv) { REG_REMOVE(sv); --PL_sv_count; } -static void -visit(f) -SVFUNC f; +STATIC void +visit(SVFUNC f) { I32 i; @@ -166,10 +163,7 @@ SVFUNC f; } void -sv_add_arena(ptr, size, flags) -char* ptr; -U32 size; -U32 flags; +sv_add_arena(char *ptr, U32 size, U32 flags) { if (!(flags & SVf_FAKE)) Safefree(ptr); diff --git a/t/comp/proto.t b/t/comp/proto.t index 3474a7e1ba..6d60342b5f 100755 --- a/t/comp/proto.t +++ b/t/comp/proto.t @@ -419,6 +419,7 @@ print "ok ", $i++, "\n"; sub star (*&) { &{$_[1]} } sub star2 (**&) { &{$_[2]} } sub BAR { "quux" } +sub Bar::BAZ { "quuz" } my $star = 'FOO'; star FOO, sub { print "ok $i\n" if $_[0] eq 'FOO' }; $i++; star(FOO, sub { print "ok $i\n" if $_[0] eq 'FOO' }); $i++; @@ -432,8 +433,8 @@ star \*FOO, sub { print "ok $i\n" if $_[0] eq \*FOO }; $i++; star(\*FOO, sub { print "ok $i\n" if $_[0] eq \*FOO }); $i++; star2 FOO, BAR, sub { print "ok $i\n" if $_[0] eq 'FOO' and $_[1] eq 'BAR' }; $i++; -star2(BAR, FOO, sub { print "ok $i\n" - if $_[0] eq 'BAR' and $_[1] eq 'FOO' }); $i++; +star2(Bar::BAZ, FOO, sub { print "ok $i\n" + if $_[0] eq 'Bar::BAZ' and $_[1] eq 'FOO' }); $i++; star2 BAR(), FOO, sub { print "ok $i\n" if $_[0] eq 'quux' and $_[1] eq 'FOO' }; $i++; star2(FOO, BAR(), sub { print "ok $i\n" diff --git a/t/op/filetest.t b/t/op/filetest.t index 1e095be7e1..1e095be7e1 100644..100755 --- a/t/op/filetest.t +++ b/t/op/filetest.t diff --git a/t/op/subst_amp.t b/t/op/subst_amp.t index e2e7c0e542..e2e7c0e542 100644..100755 --- a/t/op/subst_amp.t +++ b/t/op/subst_amp.t diff --git a/t/pragma/strict-subs b/t/pragma/strict-subs index 61ec286eb6..deeb381473 100644 --- a/t/pragma/strict-subs +++ b/t/pragma/strict-subs @@ -277,3 +277,25 @@ my $a = Fred ; EXPECT Bareword "Fred" not allowed while "strict subs" in use at - line 8. Execution of - aborted due to compilation errors. +######## + +# see if Foo->Bar(...) etc work under strictures +use strict; +package Foo; sub Bar { print "@_\n" } +Foo->Bar('a',1); +Bar Foo ('b',2); +Foo->Bar(qw/c 3/); +Bar Foo (qw/d 4/); +Foo::->Bar('A',1); +Bar Foo:: ('B',2); +Foo::->Bar(qw/C 3/); +Bar Foo:: (qw/D 4/); +EXPECT +Foo a 1 +Foo b 2 +Foo c 3 +Foo d 4 +Foo A 1 +Foo B 2 +Foo C 3 +Foo D 4 @@ -504,7 +504,8 @@ skipspace(register char *s) } STATIC void -check_uni(void) { +check_uni(void) +{ char *s; char ch; char *t; @@ -1797,8 +1797,7 @@ setenv_getix(char *nam) #ifdef UNLINK_ALL_VERSIONS I32 -unlnk(f) /* unlink all versions of a file */ -char *f; +unlnk(char *f) /* unlink all versions of a file */ { I32 i; @@ -1983,8 +1982,7 @@ my_ntohl(long l) #define HTOV(name,type) \ type \ - name (n) \ - register type n; \ + name (register type n) \ { \ union { \ type value; \ @@ -2000,8 +1998,7 @@ my_ntohl(long l) #define VTOH(name,type) \ type \ - name (n) \ - register type n; \ + name (register type n) \ { \ union { \ type value; \ @@ -2185,9 +2182,7 @@ dump_fds(char *s) #ifndef HAS_DUP2 int -dup2(oldfd,newfd) -int oldfd; -int newfd; +dup2(int oldfd, int newfd) { #if defined(HAS_FCNTL) && defined(F_DUPFD) if (oldfd == newfd) @@ -2459,12 +2454,11 @@ int pclose(); #ifdef HAS_FORK int /* Cannot prototype with I32 in os2ish.h. */ -my_syspclose(ptr) +my_syspclose(PerlIO *ptr) #else I32 -my_pclose(ptr) +my_pclose(PerlIO *ptr) #endif -PerlIO *ptr; { /* Needs work for PerlIO ! */ FILE *f = PerlIO_findFILE(ptr); diff --git a/win32/Makefile b/win32/Makefile index 086da4c6bf..3d8570e21b 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -42,9 +42,11 @@ INST_VER = \5.00557 #USE_MULTI = define # -# uncomment next line if you are using Visual C++ 2.x +# uncomment one of the following lines if you are using either +# Visual C++ 2.x or Visual C++ 6.x (aka Visual Studio 98) # #CCTYPE = MSVC20 +#CCTYPE = MSVC60 # # uncomment next line if you want to use the perl object @@ -58,15 +60,6 @@ INST_VER = \5.00557 #CFG = Debug # -# uncomment next option if you want to use the VC++ compiler optimization. -# Warning: This is known to produce incorrect code for compiler versions -# earlier than VC++ 98 (Visual Studio 6.0). VC++ 98 generates code that -# successfully passes the Perl regression test suite. It hasn't yet been -# widely tested with real applications though. -# -#CFG = Optimize - -# # uncomment to enable use of PerlCRT.DLL when using the Visual C compiler. # Highly recommended. It has patches that fix known bugs in MSVCRT.DLL. # This currently requires VC 5.0 with Service Pack 3. @@ -187,6 +180,20 @@ ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE) !ENDIF !ENDIF +# Visual Studio 98 specific +!IF "$(CCTYPE)" == "MSVC60" + +# VC 6.0 can load the socket dll on demand. Makes the test suite +# run in about 10% less time. +DELAYLOAD = -DELAYLOAD:wsock32.dll delayimp.lib + +# VC 6.0 seems capable of compiling perl correctly with optimizations +# enabled. Anything earlier fails tests. +!IF "$(CFG)" == "" +CFG = Optimize +!ENDIF +!ENDIF + ARCHDIR = ..\lib\$(ARCHNAME) COREDIR = ..\lib\CORE AUTODIR = ..\lib\auto @@ -251,7 +258,8 @@ LINK_DBG = -release OPTIMIZE = $(OPTIMIZE) $(CXX_FLAG) !ENDIF -LIBBASEFILES = $(CRYPT_LIB) oldnames.lib kernel32.lib user32.lib gdi32.lib \ +LIBBASEFILES = $(DELAYLOAD) $(CRYPT_LIB) \ + oldnames.lib kernel32.lib user32.lib gdi32.lib \ winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \ oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ version.lib odbc32.lib odbccp32.lib diff --git a/win32/dl_win32.xs b/win32/dl_win32.xs index 3473520372..6c1b424740 100644 --- a/win32/dl_win32.xs +++ b/win32/dl_win32.xs @@ -102,9 +102,18 @@ dl_load_file(filename,flags=0) int flags PREINIT: CODE: + { + WCHAR wfilename[MAX_PATH]; DLDEBUG(1,PerlIO_printf(PerlIO_stderr(),"dl_load_file(%s):\n", filename)); - if (dl_static_linked(filename) == 0) - RETVAL = (void*) LoadLibraryEx(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ; + if (dl_static_linked(filename) == 0) { + if (USING_WIDE()) { + A2WHELPER(filename, wfilename, sizeof(wfilename), GETINTERPMODE()); + RETVAL = (void*) LoadLibraryExW(wfilename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH); + } + else { + RETVAL = (void*) LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH); + } + } else RETVAL = (void*) GetModuleHandle(NULL); DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL)); @@ -114,7 +123,7 @@ dl_load_file(filename,flags=0) OS_Error_String(PERL_OBJECT_THIS)) ; else sv_setiv( ST(0), (IV)RETVAL); - + } void * dl_find_symbol(libhandle, symbolname) diff --git a/win32/makefile.mk b/win32/makefile.mk index d50408ab19..c6605ec0b9 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -46,11 +46,17 @@ INST_VER *= \5.00557 #USE_MULTI *= define # -# uncomment one -# +# uncomment exactly one of the following +# +# Visual C++ 2.x #CCTYPE *= MSVC20 +# Visual C++ > 2.x and < 6.x #CCTYPE *= MSVC +# Visual C++ >= 6.x +#CCTYPE *= MSVC60 +# Borland 5.02 or later CCTYPE *= BORLAND +# mingw32/egcs or mingw32/gcc #CCTYPE *= GCC # @@ -62,25 +68,15 @@ CCTYPE *= BORLAND # # uncomment next line if you want debug version of perl (big,slow) +# If not enabled, we automatically try to use maximum optimization +# with all compilers that are known to have a working optimizer. # #CFG *= Debug # -# uncomment next option if you want to use the VC++ compiler optimization. -# This option is only relevant for the Microsoft compiler; we automatically -# use maximum optimization with the other compilers (unless you specify a -# DEBUGGING build). -# Warning: This is known to produce incorrect code for compiler versions -# earlier than VC++ 98 (Visual Studio 6.0). VC++ 98 generates code that -# successfully passes the Perl regression test suite. It hasn't yet been -# widely tested with real applications though. -# -#CFG *= Optimize - -# # uncomment to enable use of PerlCRT.DLL when using the Visual C compiler. # Highly recommended. It has patches that fix known bugs in MSVCRT.DLL. -# This currently requires VC 5.0 with Service Pack 3. +# This currently requires VC 5.0 with Service Pack 3 or later. # Get it from CPAN at http://www.perl.com/CPAN/authors/id/D/DO/DOUGL/ # and follow the directions in the package to install. # @@ -196,6 +192,18 @@ ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-thread ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE) .ENDIF +# Visual Studio 98 specific +.IF "$(CCTYPE)" == "MSVC60" + +# VC 6.0 can load the socket dll on demand. Makes the test suite +# run in about 10% less time. +DELAYLOAD *= -DELAYLOAD:wsock32.dll delayimp.lib + +# VC 6.0 seems capable of compiling perl correctly with optimizations +# enabled. Anything earlier fails tests. +CFG *= Optimize +.ENDIF + ARCHDIR = ..\lib\$(ARCHNAME) COREDIR = ..\lib\CORE AUTODIR = ..\lib\auto @@ -334,7 +342,8 @@ OPTIMIZE = -Od $(RUNTIME) -DNDEBUG LINK_DBG = -release .ENDIF -LIBBASEFILES = $(CRYPT_LIB) oldnames.lib kernel32.lib user32.lib gdi32.lib \ +LIBBASEFILES = $(DELAYLOAD) $(CRYPT_LIB) \ + oldnames.lib kernel32.lib user32.lib gdi32.lib \ winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \ oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ version.lib odbc32.lib odbccp32.lib diff --git a/win32/win32.c b/win32/win32.c index 9361191ec0..49a487e559 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -127,12 +127,14 @@ static char crypt_buffer[30]; #endif int -IsWin95(void) { +IsWin95(void) +{ return (os_id() == VER_PLATFORM_WIN32_WINDOWS); } int -IsWinNT(void) { +IsWinNT(void) +{ return (os_id() == VER_PLATFORM_WIN32_NT); } @@ -669,8 +671,12 @@ win32_opendir(char *filename) long idx; char scanname[MAX_PATH+3]; struct stat sbuf; - WIN32_FIND_DATA FindData; + WIN32_FIND_DATAA aFindData; + WIN32_FIND_DATAW wFindData; HANDLE fh; + char buffer[MAX_PATH*2]; + WCHAR wbuffer[MAX_PATH]; + char* ptr; len = strlen(filename); if (len > MAX_PATH) @@ -700,7 +706,13 @@ win32_opendir(char *filename) scanname[len] = '\0'; /* do the FindFirstFile call */ - fh = FindFirstFile(scanname, &FindData); + if (USING_WIDE()) { + A2WHELPER(scanname, wbuffer, sizeof(wbuffer), GETINTERPMODE()); + fh = FindFirstFileW(wbuffer, &wFindData); + } + else { + fh = FindFirstFileA(scanname, &aFindData); + } if (fh == INVALID_HANDLE_VALUE) { /* FindFirstFile() fails on empty drives! */ if (GetLastError() == ERROR_FILE_NOT_FOUND) @@ -712,11 +724,18 @@ win32_opendir(char *filename) /* now allocate the first part of the string table for * the filenames that we find. */ - idx = strlen(FindData.cFileName)+1; + if (USING_WIDE()) { + W2AHELPER(wFindData.cFileName, buffer, sizeof(buffer), GETINTERPMODE()); + ptr = buffer; + } + else { + ptr = aFindData.cFileName; + } + idx = strlen(ptr)+1; New(1304, p->start, idx, char); if (p->start == NULL) croak("opendir: malloc failed!\n"); - strcpy(p->start, FindData.cFileName); + strcpy(p->start, ptr); p->nfiles++; /* loop finding all the files that match the wildcard @@ -724,15 +743,21 @@ win32_opendir(char *filename) * the variable idx should point one past the null terminator * of the previous string found. */ - while (FindNextFile(fh, &FindData)) { - len = strlen(FindData.cFileName); + while (USING_WIDE() + ? FindNextFileW(fh, &wFindData) + : FindNextFileA(fh, &aFindData)) { + if (USING_WIDE()) { + W2AHELPER(wFindData.cFileName, buffer, sizeof(buffer), GETINTERPMODE()); + } + /* ptr is set above to the correct area */ + len = strlen(ptr); /* bump the string table size by enough for the * new name and it's null terminator */ Renew(p->start, idx+len+1, char); if (p->start == NULL) croak("opendir: malloc failed!\n"); - strcpy(&p->start[idx], FindData.cFileName); + strcpy(&p->start[idx], ptr); p->nfiles++; idx += len+1; } @@ -930,6 +955,7 @@ win32_stat(const char *path, struct stat *buffer) char t[MAX_PATH+1]; int l = strlen(path); int res; + WCHAR wbuffer[MAX_PATH]; if (l > 1) { switch(path[l - 1]) { @@ -951,13 +977,25 @@ win32_stat(const char *path, struct stat *buffer) break; } } - res = stat(path,buffer); + if (USING_WIDE()) { + A2WHELPER(path, wbuffer, sizeof(wbuffer), GETINTERPMODE()); + res = _wstat(wbuffer, (struct _stat *)buffer); + } + else { + res = stat(path, buffer); + } if (res < 0) { /* CRT is buggy on sharenames, so make sure it really isn't. * XXX using GetFileAttributesEx() will enable us to set * buffer->st_*time (but note that's not available on the * Windows of 1995) */ - DWORD r = GetFileAttributes(path); + DWORD r; + if (USING_WIDE()) { + r = GetFileAttributesW(wbuffer); + } + else { + r = GetFileAttributesA(path); + } if (r != 0xffffffff && (r & FILE_ATTRIBUTE_DIRECTORY)) { /* buffer may still contain old garbage since stat() failed */ Zero(buffer, 1, struct stat); @@ -973,7 +1011,9 @@ win32_stat(const char *path, struct stat *buffer) && (path[2] == '\\' || path[2] == '/')) { /* The drive can be inaccessible, some _stat()s are buggy */ - if (!GetVolumeInformation(path,NULL,0,NULL,NULL,NULL,NULL,0)) { + if (USING_WIDE() + ? !GetVolumeInformationW(wbuffer,NULL,0,NULL,NULL,NULL,NULL,0) + : !GetVolumeInformationA(path,NULL,0,NULL,NULL,NULL,NULL,0)) { errno = ENOENT; return -1; } @@ -1083,19 +1123,46 @@ DllExport char * win32_getenv(const char *name) { static char *curitem = Nullch; /* XXX threadead */ - static DWORD curlen = 0; /* XXX threadead */ + static WCHAR *wCuritem = (WCHAR*)Nullch; /* XXX threadead */ + static DWORD curlen = 0, wCurlen = 0;/* XXX threadead */ + WCHAR wBuffer[MAX_PATH]; DWORD needlen; + if (USING_WIDE()) { + if (!wCuritem) { + wCurlen = 512; + New(1306,wCuritem,wCurlen,WCHAR); + } + } if (!curitem) { curlen = 512; New(1305,curitem,curlen,char); } - needlen = GetEnvironmentVariable(name,curitem,curlen); + if (USING_WIDE()) { + A2WHELPER(name, wBuffer, sizeof(wBuffer), GETINTERPMODE()); + needlen = GetEnvironmentVariableW(wBuffer,wCuritem,wCurlen); + } + else + needlen = GetEnvironmentVariableA(name,curitem,curlen); if (needlen != 0) { - while (needlen > curlen) { - Renew(curitem,needlen,char); - curlen = needlen; - needlen = GetEnvironmentVariable(name,curitem,curlen); + if (USING_WIDE()) { + while (needlen > wCurlen) { + Renew(wCuritem,needlen,WCHAR); + wCurlen = needlen; + needlen = GetEnvironmentVariableW(wBuffer,wCuritem,wCurlen); + } + if (needlen > curlen) { + Renew(curitem,needlen,char); + curlen = needlen; + } + W2AHELPER(wCuritem, curitem, curlen, GETINTERPMODE()); + } + else { + while (needlen > curlen) { + Renew(curitem,needlen,char); + curlen = needlen; + needlen = GetEnvironmentVariableA(name,curitem,curlen); + } } } else { @@ -1124,31 +1191,47 @@ win32_putenv(const char *name) { char* curitem; char* val; - int relval = -1; + WCHAR* wCuritem; + WCHAR* wVal; + int length, relval = -1; if(name) { - New(1309,curitem,strlen(name)+1,char); - strcpy(curitem, name); - val = strchr(curitem, '='); - if(val) { - /* The sane way to deal with the environment. - * Has these advantages over putenv() & co.: - * * enables us to store a truly empty value in the - * environment (like in UNIX). - * * we don't have to deal with RTL globals, bugs and leaks. - * * Much faster. - * Why you may want to enable USE_WIN32_RTL_ENV: - * * environ[] and RTL functions will not reflect changes, - * which might be an issue if extensions want to access - * the env. via RTL. This cuts both ways, since RTL will - * not see changes made by extensions that call the Win32 - * functions directly, either. - * GSAR 97-06-07 - */ - *val++ = '\0'; - if(SetEnvironmentVariable(curitem, *val ? val : NULL)) - relval = 0; + if (USING_WIDE()) { + length = strlen(name)+1; + New(1309,wCuritem,length,WCHAR); + A2WHELPER(name, wCuritem, length*2, GETINTERPMODE()); + wVal = wcschr(wCuritem, '='); + if(wVal) { + *wVal++ = '\0'; + if(SetEnvironmentVariableW(wCuritem, *wVal ? wVal : NULL)) + relval = 0; + } + Safefree(wCuritem); + } + else { + New(1309,curitem,strlen(name)+1,char); + strcpy(curitem, name); + val = strchr(curitem, '='); + if(val) { + /* The sane way to deal with the environment. + * Has these advantages over putenv() & co.: + * * enables us to store a truly empty value in the + * environment (like in UNIX). + * * we don't have to deal with RTL globals, bugs and leaks. + * * Much faster. + * Why you may want to enable USE_WIN32_RTL_ENV: + * * environ[] and RTL functions will not reflect changes, + * which might be an issue if extensions want to access + * the env. via RTL. This cuts both ways, since RTL will + * not see changes made by extensions that call the Win32 + * functions directly, either. + * GSAR 97-06-07 + */ + *val++ = '\0'; + if(SetEnvironmentVariableA(curitem, *val ? val : NULL)) + relval = 0; + } + Safefree(curitem); } - Safefree(curitem); } return relval; } @@ -1220,8 +1303,16 @@ win32_utime(const char *filename, struct utimbuf *times) FILETIME ftAccess; FILETIME ftWrite; struct utimbuf TimeBuffer; + WCHAR wbuffer[MAX_PATH]; - int rc = utime(filename,times); + int rc; + if (USING_WIDE()) { + A2WHELPER(filename, wbuffer, sizeof(wbuffer), GETINTERPMODE()); + rc = _wutime(wbuffer, (struct _utimbuf*)times); + } + else { + rc = utime(filename, times); + } /* EACCES: path specifies directory or readonly file */ if (rc == 0 || errno != EACCES /* || !IsWinNT() */) return rc; @@ -1233,9 +1324,16 @@ win32_utime(const char *filename, struct utimbuf *times) } /* This will (and should) still fail on readonly files */ - handle = CreateFile(filename, GENERIC_READ | GENERIC_WRITE, - FILE_SHARE_READ | FILE_SHARE_DELETE, NULL, - OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); + if (USING_WIDE()) { + handle = CreateFileW(wbuffer, GENERIC_READ | GENERIC_WRITE, + FILE_SHARE_READ | FILE_SHARE_DELETE, NULL, + OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); + } + else { + handle = CreateFileA(filename, GENERIC_READ | GENERIC_WRITE, + FILE_SHARE_READ | FILE_SHARE_DELETE, NULL, + OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); + } if (handle == INVALID_HANDLE_VALUE) return rc; @@ -1770,11 +1868,20 @@ win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp) return fwrite(buf, size, count, fp); } +#define MODE_SIZE 10 + DllExport FILE * win32_fopen(const char *filename, const char *mode) { + WCHAR wMode[MODE_SIZE], wBuffer[MAX_PATH]; if (stricmp(filename, "/dev/null")==0) - return fopen("NUL", mode); + filename = "NUL"; + + if (USING_WIDE()) { + A2WHELPER(mode, wMode, sizeof(wMode), GETINTERPMODE()); + A2WHELPER(filename, wBuffer, sizeof(wBuffer), GETINTERPMODE()); + return _wfopen(wBuffer, wMode); + } return fopen(filename, mode); } @@ -1784,16 +1891,28 @@ win32_fopen(const char *filename, const char *mode) #endif DllExport FILE * -win32_fdopen( int handle, const char *mode) +win32_fdopen(int handle, const char *mode) { + WCHAR wMode[MODE_SIZE]; + if (USING_WIDE()) { + A2WHELPER(mode, wMode, sizeof(wMode), GETINTERPMODE()); + return _wfdopen(handle, wMode); + } return fdopen(handle, (char *) mode); } DllExport FILE * -win32_freopen( const char *path, const char *mode, FILE *stream) +win32_freopen(const char *path, const char *mode, FILE *stream) { + WCHAR wMode[MODE_SIZE], wBuffer[MAX_PATH]; if (stricmp(path, "/dev/null")==0) - return freopen("NUL", mode, stream); + path = "NUL"; + + if (USING_WIDE()) { + A2WHELPER(mode, wMode, sizeof(wMode), GETINTERPMODE()); + A2WHELPER(path, wBuffer, sizeof(wBuffer), GETINTERPMODE()); + return _wfreopen(wBuffer, wMode, stream); + } return freopen(path, mode, stream); } @@ -2026,12 +2145,24 @@ win32_pclose(FILE *pf) DllExport int win32_rename(const char *oname, const char *newname) { + WCHAR wOldName[MAX_PATH]; + WCHAR wNewName[MAX_PATH]; + BOOL bResult; /* XXX despite what the documentation says about MoveFileEx(), * it doesn't work under Windows95! */ if (IsWinNT()) { - if (!MoveFileEx(oname,newname, - MOVEFILE_COPY_ALLOWED|MOVEFILE_REPLACE_EXISTING)) { + if (USING_WIDE()) { + A2WHELPER(oname, wOldName, sizeof(wOldName), GETINTERPMODE()); + A2WHELPER(newname, wNewName, sizeof(wNewName), GETINTERPMODE()); + bResult = MoveFileExW(wOldName,wNewName, + MOVEFILE_COPY_ALLOWED|MOVEFILE_REPLACE_EXISTING); + } + else { + bResult = MoveFileExA(oname,newname, + MOVEFILE_COPY_ALLOWED|MOVEFILE_REPLACE_EXISTING); + } + if (!bResult) { DWORD err = GetLastError(); switch (err) { case ERROR_BAD_NET_NAME: @@ -2147,13 +2278,19 @@ win32_open(const char *path, int flag, ...) { va_list ap; int pmode; + WCHAR wBuffer[MAX_PATH]; va_start(ap, flag); pmode = va_arg(ap, int); va_end(ap); if (stricmp(path, "/dev/null")==0) - return open("NUL", flag, pmode); + path = "NUL"; + + if (USING_WIDE()) { + A2WHELPER(path, wBuffer, sizeof(wBuffer), GETINTERPMODE()); + return _wopen(wBuffer, flag, pmode); + } return open(path,flag,pmode); } diff --git a/win32/win32.h b/win32/win32.h index bfca44a1b2..a539a16854 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -392,5 +392,19 @@ struct thread_intern { # endif /* !USE_DECLSPEC_THREAD */ #endif /* USE_THREADS */ +/* UNICODE<>ANSI translation helpers */ +/* Use CP_ACP when mode is ANSI */ +/* Use CP_UTF8 when mode is UTF8 */ + +#define A2WHELPER(lpa, lpw, nChars, acp)\ + lpw[0] = 0, MultiByteToWideChar(acp, 0, lpa, -1, lpw, nChars) + +#define W2AHELPER(lpw, lpa, nChars, acp)\ + lpa[0] = '\0', WideCharToMultiByte(acp, 0, lpw, -1, lpa, nChars, NULL, NULL) + +/* place holders for now */ +#define USING_WIDE() 0 +#define GETINTERPMODE() CP_ACP + #endif /* _INC_WIN32_PERL5 */ diff --git a/x2p/hash.c b/x2p/hash.c index f11f7dfc55..77b9ad8fd1 100644 --- a/x2p/hash.c +++ b/x2p/hash.c @@ -89,9 +89,7 @@ hstore(register HASH *tb, char *key, STR *val) #ifdef NOTUSED bool -hdelete(tb,key) -register HASH *tb; -char *key; +hdelete(register HASH *tb, char *key) { register char *s; register int i; @@ -178,8 +176,7 @@ hnew(void) } #ifdef NOTUSED -hshow(tb) -register HASH *tb; +hshow(register HASH *tb) { fprintf(stderr,"%5d %4d (%2d%%)\n", tb->tbl_max+1, |